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

Functions

program cchkaa
 CCHKAA More...
 
subroutine cchkeq (THRESH, NOUT)
 CCHKEQ More...
 
subroutine cchkgb (DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NNS, NSVAL, THRESH, TSTERR, A, LA, AFAC, LAFAC, B, X, XACT, WORK, RWORK, IWORK, NOUT)
 CCHKGB More...
 
subroutine cchkge (DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NNS, NSVAL, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
 CCHKGE More...
 
subroutine cchkgt (DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR, A, AF, B, X, XACT, WORK, RWORK, IWORK, NOUT)
 CCHKGT More...
 
subroutine cchkhe (DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
 CCHKHE More...
 
subroutine cchkhe_rook (DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
 CCHKHE_ROOK More...
 
subroutine cchkhp (DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
 CCHKHP More...
 
subroutine cchklq (DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL, NRHS, THRESH, TSTERR, NMAX, A, AF, AQ, AL, AC, B, X, XACT, TAU, WORK, RWORK, NOUT)
 CCHKLQ More...
 
subroutine cchkpb (DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, NOUT)
 CCHKPB More...
 
subroutine cchkpo (DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, NOUT)
 CCHKPO More...
 
subroutine cchkpp (DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, NOUT)
 CCHKPP More...
 
subroutine cchkps (DOTYPE, NN, NVAL, NNB, NBVAL, NRANK, RANKVAL, THRESH, TSTERR, NMAX, A, AFAC, PERM, PIV, WORK, RWORK, NOUT)
 CCHKPS More...
 
subroutine cchkpt (DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR, A, D, E, B, X, XACT, WORK, RWORK, NOUT)
 CCHKPT More...
 
subroutine cchkq3 (DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL, THRESH, A, COPYA, S, TAU, WORK, RWORK, IWORK, NOUT)
 CCHKQ3 More...
 
subroutine cchkql (DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL, NRHS, THRESH, TSTERR, NMAX, A, AF, AQ, AL, AC, B, X, XACT, TAU, WORK, RWORK, NOUT)
 CCHKQL More...
 
subroutine cchkqr (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)
 CCHKQR More...
 
subroutine cchkqrt (THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, NBVAL, NOUT)
 CCHKQRT More...
 
subroutine cchkqrtp (THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, NBVAL, NOUT)
 CCHKQRTP More...
 
program cchkrfp
 CCHKRFP More...
 
subroutine cchkrq (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)
 CCHKRQ More...
 
subroutine cchksp (DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
 CCHKSP More...
 
subroutine cchksy (DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
 CCHKSY More...
 
subroutine cchksy_rook (DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
 CCHKSY_ROOK More...
 
subroutine cchktb (DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR, NMAX, AB, AINV, B, X, XACT, WORK, RWORK, NOUT)
 CCHKTB More...
 
subroutine cchktp (DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR, NMAX, AP, AINVP, B, X, XACT, WORK, RWORK, NOUT)
 CCHKTP More...
 
subroutine cchktr (DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL, THRESH, TSTERR, NMAX, A, AINV, B, X, XACT, WORK, RWORK, NOUT)
 CCHKTR More...
 
subroutine cchktz (DOTYPE, NM, MVAL, NN, NVAL, THRESH, TSTERR, A, COPYA, S, TAU, WORK, RWORK, NOUT)
 CCHKTZ More...
 
subroutine cdrvgb (DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, A, LA, AFB, LAFB, ASAV, B, BSAV, X, XACT, S, WORK, RWORK, IWORK, NOUT)
 CDRVGB More...
 
subroutine cdrvge (DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX, A, AFAC, ASAV, B, BSAV, X, XACT, S, WORK, RWORK, IWORK, NOUT)
 CDRVGE More...
 
subroutine cdrvgt (DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, A, AF, B, X, XACT, WORK, RWORK, IWORK, NOUT)
 CDRVGT More...
 
subroutine cdrvhe (DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
 CDRVHE More...
 
subroutine cdrvhe_rook (DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
 CDRVHE_ROOK More...
 
subroutine cdrvhp (DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
 CDRVHP More...
 
subroutine cdrvls (DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL, NNB, NBVAL, NXVAL, THRESH, TSTERR, A, COPYA, B, COPYB, C, S, COPYS, WORK, RWORK, IWORK, NOUT)
 CDRVLS More...
 
subroutine cdrvpb (DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX, A, AFAC, ASAV, B, BSAV, X, XACT, S, WORK, RWORK, NOUT)
 CDRVPB More...
 
subroutine cdrvpo (DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX, A, AFAC, ASAV, B, BSAV, X, XACT, S, WORK, RWORK, NOUT)
 CDRVPO More...
 
subroutine cdrvpp (DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX, A, AFAC, ASAV, B, BSAV, X, XACT, S, WORK, RWORK, NOUT)
 CDRVPP More...
 
subroutine cdrvpt (DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, A, D, E, B, X, XACT, WORK, RWORK, NOUT)
 CDRVPT More...
 
subroutine cdrvrf1 (NOUT, NN, NVAL, THRESH, A, LDA, ARF, WORK)
 CDRVRF1 More...
 
subroutine cdrvrf2 (NOUT, NN, NVAL, A, LDA, ARF, AP, ASAV)
 CDRVRF2 More...
 
subroutine cdrvrf3 (NOUT, NN, NVAL, THRESH, A, LDA, ARF, B1, B2, S_WORK_CLANGE, C_WORK_CGEQRF, TAU)
 CDRVRF3 More...
 
subroutine cdrvrf4 (NOUT, NN, NVAL, THRESH, C1, C2, LDC, CRF, A, LDA, S_WORK_CLANGE)
 CDRVRF4 More...
 
subroutine cdrvrfp (NOUT, NN, NVAL, NNS, NSVAL, NNT, NTVAL, THRESH, A, ASAV, AFAC, AINV, B, BSAV, XACT, X, ARF, ARFINV, C_WORK_CLATMS, C_WORK_CPOT02, C_WORK_CPOT03, S_WORK_CLATMS, S_WORK_CLANHE, S_WORK_CPOT01, S_WORK_CPOT02, S_WORK_CPOT03)
 CDRVRFP More...
 
subroutine cdrvsp (DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
 CDRVSP More...
 
subroutine cdrvsy (DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
 CDRVSY More...
 
subroutine cdrvsy_rook (DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
 CDRVSY_ROOK More...
 
subroutine cebchvxx (THRESH, PATH)
 CEBCHVXX More...
 
subroutine cerrge (PATH, NUNIT)
 CERRGE More...
 
subroutine cerrgt (PATH, NUNIT)
 CERRGT More...
 
subroutine cerrhe (PATH, NUNIT)
 CERRHE More...
 
subroutine cerrlq (PATH, NUNIT)
 CERRLQ More...
 
subroutine cerrls (PATH, NUNIT)
 CERRLS More...
 
subroutine cerrpo (PATH, NUNIT)
 CERRPO More...
 
subroutine cerrps (PATH, NUNIT)
 CERRPS More...
 
subroutine cerrql (PATH, NUNIT)
 CERRQL More...
 
subroutine cerrqp (PATH, NUNIT)
 CERRQP More...
 
subroutine cerrqr (PATH, NUNIT)
 CERRQR More...
 
subroutine cerrqrt (PATH, NUNIT)
 CERRQRT More...
 
subroutine cerrqrtp (PATH, NUNIT)
 CERRQRTP More...
 
subroutine cerrrfp (NUNIT)
 CERRRFP More...
 
subroutine cerrrq (PATH, NUNIT)
 CERRRQ More...
 
subroutine cerrsy (PATH, NUNIT)
 CERRSY More...
 
subroutine cerrtr (PATH, NUNIT)
 CERRTR More...
 
subroutine cerrtz (PATH, NUNIT)
 CERRTZ More...
 
subroutine cerrvx (PATH, NUNIT)
 CERRVX More...
 
subroutine cgbt01 (M, N, KL, KU, A, LDA, AFAC, LDAFAC, IPIV, WORK, RESID)
 CGBT01 More...
 
subroutine cgbt02 (TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, RESID)
 CGBT02 More...
 
subroutine cgbt05 (TRANS, N, KL, KU, NRHS, AB, LDAB, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
 CGBT05 More...
 
subroutine cgelqs (M, N, NRHS, A, LDA, TAU, B, LDB, WORK, LWORK, INFO)
 CGELQS More...
 
logical function cgennd (M, N, A, LDA)
 CGENND More...
 
subroutine cgeqls (M, N, NRHS, A, LDA, TAU, B, LDB, WORK, LWORK, INFO)
 CGEQLS More...
 
subroutine cgeqrs (M, N, NRHS, A, LDA, TAU, B, LDB, WORK, LWORK, INFO)
 CGEQRS More...
 
subroutine cgerqs (M, N, NRHS, A, LDA, TAU, B, LDB, WORK, LWORK, INFO)
 CGERQS More...
 
subroutine cget01 (M, N, A, LDA, AFAC, LDAFAC, IPIV, RWORK, RESID)
 CGET01 More...
 
subroutine cget02 (TRANS, M, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
 CGET02 More...
 
subroutine cget03 (N, A, LDA, AINV, LDAINV, WORK, LDWORK, RWORK, RCOND, RESID)
 CGET03 More...
 
subroutine cget04 (N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
 CGET04 More...
 
subroutine cget07 (TRANS, N, NRHS, A, LDA, B, LDB, X, LDX, XACT, LDXACT, FERR, CHKFERR, BERR, RESLTS)
 CGET07 More...
 
subroutine cgtt01 (N, DL, D, DU, DLF, DF, DUF, DU2, IPIV, WORK, LDWORK, RWORK, RESID)
 CGTT01 More...
 
subroutine cgtt02 (TRANS, N, NRHS, DL, D, DU, X, LDX, B, LDB, RESID)
 CGTT02 More...
 
subroutine cgtt05 (TRANS, N, NRHS, DL, D, DU, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
 CGTT05 More...
 
subroutine chet01 (UPLO, N, A, LDA, AFAC, LDAFAC, IPIV, C, LDC, RWORK, RESID)
 CHET01 More...
 
subroutine chet01_rook (UPLO, N, A, LDA, AFAC, LDAFAC, IPIV, C, LDC, RWORK, RESID)
 CHET01_ROOK More...
 
subroutine chkxer (SRNAMT, INFOT, NOUT, LERR, OK)
 CHKXER More...
 
subroutine chpt01 (UPLO, N, A, AFAC, IPIV, C, LDC, RWORK, RESID)
 CHPT01 More...
 
subroutine clahilb (N, NRHS, A, LDA, X, LDX, B, LDB, WORK, INFO, PATH)
 CLAHILB More...
 
subroutine claipd (N, A, INDA, VINDA)
 CLAIPD More...
 
subroutine claptm (UPLO, N, NRHS, ALPHA, D, E, X, LDX, BETA, B, LDB)
 CLAPTM More...
 
subroutine clarhs (PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
 CLARHS More...
 
subroutine clatb4 (PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
 CLATB4 More...
 
subroutine clatb5 (PATH, IMAT, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
 CLATB5 More...
 
subroutine clatsp (UPLO, N, X, ISEED)
 CLATSP More...
 
subroutine clatsy (UPLO, N, X, LDX, ISEED)
 CLATSY More...
 
subroutine clattb (IMAT, UPLO, TRANS, DIAG, ISEED, N, KD, AB, LDAB, B, WORK, RWORK, INFO)
 CLATTB More...
 
subroutine clattp (IMAT, UPLO, TRANS, DIAG, ISEED, N, AP, B, WORK, RWORK, INFO)
 CLATTP More...
 
subroutine clattr (IMAT, UPLO, TRANS, DIAG, ISEED, N, A, LDA, B, WORK, RWORK, INFO)
 CLATTR More...
 
subroutine clavhe (UPLO, TRANS, DIAG, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
 CLAVHE More...
 
subroutine clavhe_rook (UPLO, TRANS, DIAG, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
 CLAVHE_ROOK More...
 
subroutine clavhp (UPLO, TRANS, DIAG, N, NRHS, A, IPIV, B, LDB, INFO)
 CLAVHP More...
 
subroutine clavsp (UPLO, TRANS, DIAG, N, NRHS, A, IPIV, B, LDB, INFO)
 CLAVSP More...
 
subroutine clavsy (UPLO, TRANS, DIAG, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
 CLAVSY More...
 
subroutine clavsy_rook (UPLO, TRANS, DIAG, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
 CLAVSY_ROOK More...
 
subroutine clqt01 (M, N, A, AF, Q, L, LDA, TAU, WORK, LWORK, RWORK, RESULT)
 CLQT01 More...
 
subroutine clqt02 (M, N, K, A, AF, Q, L, LDA, TAU, WORK, LWORK, RWORK, RESULT)
 CLQT02 More...
 
subroutine clqt03 (M, N, K, AF, C, CC, Q, LDA, TAU, WORK, LWORK, RWORK, RESULT)
 CLQT03 More...
 
subroutine cpbt01 (UPLO, N, KD, A, LDA, AFAC, LDAFAC, RWORK, RESID)
 CPBT01 More...
 
subroutine cpbt02 (UPLO, N, KD, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
 CPBT02 More...
 
subroutine cpbt05 (UPLO, N, KD, NRHS, AB, LDAB, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
 CPBT05 More...
 
subroutine cpot01 (UPLO, N, A, LDA, AFAC, LDAFAC, RWORK, RESID)
 CPOT01 More...
 
subroutine cpot02 (UPLO, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
 CPOT02 More...
 
subroutine cpot03 (UPLO, N, A, LDA, AINV, LDAINV, WORK, LDWORK, RWORK, RCOND, RESID)
 CPOT03 More...
 
subroutine cpot05 (UPLO, N, NRHS, A, LDA, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
 CPOT05 More...
 
subroutine cppt01 (UPLO, N, A, AFAC, RWORK, RESID)
 CPPT01 More...
 
subroutine cppt02 (UPLO, N, NRHS, A, X, LDX, B, LDB, RWORK, RESID)
 CPPT02 More...
 
subroutine cppt03 (UPLO, N, A, AINV, WORK, LDWORK, RWORK, RCOND, RESID)
 CPPT03 More...
 
subroutine cppt05 (UPLO, N, NRHS, AP, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
 CPPT05 More...
 
subroutine cpst01 (UPLO, N, A, LDA, AFAC, LDAFAC, PERM, LDPERM, PIV, RWORK, RESID, RANK)
 CPST01 More...
 
subroutine cptt01 (N, D, E, DF, EF, WORK, RESID)
 CPTT01 More...
 
subroutine cptt02 (UPLO, N, NRHS, D, E, X, LDX, B, LDB, RESID)
 CPTT02 More...
 
subroutine cptt05 (N, NRHS, D, E, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
 CPTT05 More...
 
subroutine cqlt01 (M, N, A, AF, Q, L, LDA, TAU, WORK, LWORK, RWORK, RESULT)
 CQLT01 More...
 
subroutine cqlt02 (M, N, K, A, AF, Q, L, LDA, TAU, WORK, LWORK, RWORK, RESULT)
 CQLT02 More...
 
subroutine cqlt03 (M, N, K, AF, C, CC, Q, LDA, TAU, WORK, LWORK, RWORK, RESULT)
 CQLT03 More...
 
real function cqpt01 (M, N, K, A, AF, LDA, TAU, JPVT, WORK, LWORK)
 CQPT01 More...
 
subroutine cqrt01 (M, N, A, AF, Q, R, LDA, TAU, WORK, LWORK, RWORK, RESULT)
 CQRT01 More...
 
subroutine cqrt01p (M, N, A, AF, Q, R, LDA, TAU, WORK, LWORK, RWORK, RESULT)
 CQRT01P More...
 
subroutine cqrt02 (M, N, K, A, AF, Q, R, LDA, TAU, WORK, LWORK, RWORK, RESULT)
 CQRT02 More...
 
subroutine cqrt03 (M, N, K, AF, C, CC, Q, LDA, TAU, WORK, LWORK, RWORK, RESULT)
 CQRT03 More...
 
subroutine cqrt04 (M, N, NB, RESULT)
 CQRT04 More...
 
subroutine cqrt05 (M, N, L, NB, RESULT)
 CQRT05 More...
 
real function cqrt11 (M, K, A, LDA, TAU, WORK, LWORK)
 CQRT11 More...
 
real function cqrt12 (M, N, A, LDA, S, WORK, LWORK, RWORK)
 CQRT12 More...
 
subroutine cqrt13 (SCALE, M, N, A, LDA, NORMA, ISEED)
 CQRT13 More...
 
real function cqrt14 (TRANS, M, N, NRHS, A, LDA, X, LDX, WORK, LWORK)
 CQRT14 More...
 
subroutine cqrt15 (SCALE, RKSEL, M, N, NRHS, A, LDA, B, LDB, S, RANK, NORMA, NORMB, ISEED, WORK, LWORK)
 CQRT15 More...
 
subroutine cqrt16 (TRANS, M, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
 CQRT16 More...
 
real function cqrt17 (TRANS, IRESID, M, N, NRHS, A, LDA, X, LDX, B, LDB, C, WORK, LWORK)
 CQRT17 More...
 
subroutine crqt01 (M, N, A, AF, Q, R, LDA, TAU, WORK, LWORK, RWORK, RESULT)
 CRQT01 More...
 
subroutine crqt02 (M, N, K, A, AF, Q, R, LDA, TAU, WORK, LWORK, RWORK, RESULT)
 CRQT02 More...
 
subroutine crqt03 (M, N, K, AF, C, CC, Q, LDA, TAU, WORK, LWORK, RWORK, RESULT)
 CRQT03 More...
 
real function crzt01 (M, N, A, AF, LDA, TAU, WORK, LWORK)
 CRZT01 More...
 
real function crzt02 (M, N, AF, LDA, TAU, WORK, LWORK)
 CRZT02 More...
 
subroutine csbmv (UPLO, N, K, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
 CSBMV More...
 
subroutine cspt01 (UPLO, N, A, AFAC, IPIV, C, LDC, RWORK, RESID)
 CSPT01 More...
 
subroutine cspt02 (UPLO, N, NRHS, A, X, LDX, B, LDB, RWORK, RESID)
 CSPT02 More...
 
subroutine cspt03 (UPLO, N, A, AINV, WORK, LDW, RWORK, RCOND, RESID)
 CSPT03 More...
 
subroutine csyt01 (UPLO, N, A, LDA, AFAC, LDAFAC, IPIV, C, LDC, RWORK, RESID)
 CSYT01 More...
 
subroutine csyt01_rook (UPLO, N, A, LDA, AFAC, LDAFAC, IPIV, C, LDC, RWORK, RESID)
 CSYT01_ROOK More...
 
subroutine csyt02 (UPLO, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
 CSYT02 More...
 
subroutine csyt03 (UPLO, N, A, LDA, AINV, LDAINV, WORK, LDWORK, RWORK, RCOND, RESID)
 CSYT03 More...
 
subroutine ctbt02 (UPLO, TRANS, DIAG, N, KD, NRHS, AB, LDAB, X, LDX, B, LDB, WORK, RWORK, RESID)
 CTBT02 More...
 
subroutine ctbt03 (UPLO, TRANS, DIAG, N, KD, NRHS, AB, LDAB, SCALE, CNORM, TSCAL, X, LDX, B, LDB, WORK, RESID)
 CTBT03 More...
 
subroutine ctbt05 (UPLO, TRANS, DIAG, N, KD, NRHS, AB, LDAB, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
 CTBT05 More...
 
subroutine ctbt06 (RCOND, RCONDC, UPLO, DIAG, N, KD, AB, LDAB, RWORK, RAT)
 CTBT06 More...
 
subroutine ctpt01 (UPLO, DIAG, N, AP, AINVP, RCOND, RWORK, RESID)
 CTPT01 More...
 
subroutine ctpt02 (UPLO, TRANS, DIAG, N, NRHS, AP, X, LDX, B, LDB, WORK, RWORK, RESID)
 CTPT02 More...
 
subroutine ctpt03 (UPLO, TRANS, DIAG, N, NRHS, AP, SCALE, CNORM, TSCAL, X, LDX, B, LDB, WORK, RESID)
 CTPT03 More...
 
subroutine ctpt05 (UPLO, TRANS, DIAG, N, NRHS, AP, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
 CTPT05 More...
 
subroutine ctpt06 (RCOND, RCONDC, UPLO, DIAG, N, AP, RWORK, RAT)
 CTPT06 More...
 
subroutine ctrt01 (UPLO, DIAG, N, A, LDA, AINV, LDAINV, RCOND, RWORK, RESID)
 CTRT01 More...
 
subroutine ctrt02 (UPLO, TRANS, DIAG, N, NRHS, A, LDA, X, LDX, B, LDB, WORK, RWORK, RESID)
 CTRT02 More...
 
subroutine ctrt03 (UPLO, TRANS, DIAG, N, NRHS, A, LDA, SCALE, CNORM, TSCAL, X, LDX, B, LDB, WORK, RESID)
 CTRT03 More...
 
subroutine ctrt05 (UPLO, TRANS, DIAG, N, NRHS, A, LDA, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
 CTRT05 More...
 
subroutine ctrt06 (RCOND, RCONDC, UPLO, DIAG, N, A, LDA, RWORK, RAT)
 CTRT06 More...
 

Detailed Description

This is the group of complex LAPACK TESTING LIN routines.

Function Documentation

program cchkaa ( )

CCHKAA

Purpose:
 CCHKAA is the main test program for the COMPLEX 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 42 lines:
 Data file for testing COMPLEX LAPACK linear equation 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)
 30.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
 CGE   11               List types on next line if 0 < NTYPES < 11
 CGB    8               List types on next line if 0 < NTYPES <  8
 CGT   12               List types on next line if 0 < NTYPES < 12
 CPO    9               List types on next line if 0 < NTYPES <  9
 CPO    9               List types on next line if 0 < NTYPES <  9
 CPP    9               List types on next line if 0 < NTYPES <  9
 CPB    8               List types on next line if 0 < NTYPES <  8
 CPT   12               List types on next line if 0 < NTYPES < 12
 CHE   10               List types on next line if 0 < NTYPES < 10
 CHR   10               List types on next line if 0 < NTYPES < 10
 CHP   10               List types on next line if 0 < NTYPES < 10
 CSY   11               List types on next line if 0 < NTYPES < 11
 CSR   11               List types on next line if 0 < NTYPES < 11
 CSP   11               List types on next line if 0 < NTYPES < 11
 CTR   18               List types on next line if 0 < NTYPES < 18
 CTP   18               List types on next line if 0 < NTYPES < 18
 CTB   17               List types on next line if 0 < NTYPES < 17
 CQR    8               List types on next line if 0 < NTYPES <  8
 CRQ    8               List types on next line if 0 < NTYPES <  8
 CLQ    8               List types on next line if 0 < NTYPES <  8
 CQL    8               List types on next line if 0 < NTYPES <  8
 CQP    6               List types on next line if 0 < NTYPES <  6
 CTZ    3               List types on next line if 0 < NTYPES <  3
 CLS    6               List types on next line if 0 < NTYPES <  6
 CEQ
 CQT
 CQX
  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
November 2015

Definition at line 110 of file cchkaa.f.

Here is the call graph for this function:

subroutine cchkeq ( real  THRESH,
integer  NOUT 
)

CCHKEQ

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

Here is the call graph for this function:

Here is the caller graph for this function:

subroutine cchkgb ( 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,
complex, dimension( * )  A,
integer  LA,
complex, dimension( * )  AFAC,
integer  LAFAC,
complex, dimension( * )  B,
complex, dimension( * )  X,
complex, dimension( * )  XACT,
complex, dimension( * )  WORK,
real, dimension( * )  RWORK,
integer, dimension( * )  IWORK,
integer  NOUT 
)

CCHKGB

Purpose:
 CCHKGB tests CGBTRF, -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 COMPLEX 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 COMPLEX 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 COMPLEX array, dimension (NMAX*NSMAX)
[out]X
          X is COMPLEX array, dimension (NMAX*NSMAX)
[out]XACT
          XACT is COMPLEX array, dimension (NMAX*NSMAX)
[out]WORK
          WORK is COMPLEX 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 (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 cchkgb.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 rwork( * )
209  COMPLEX a( * ), afac( * ), b( * ), work( * ), x( * ),
210  $ xact( * )
211 * ..
212 *
213 * =====================================================================
214 *
215 * .. Parameters ..
216  REAL one, zero
217  parameter( one = 1.0e+0, zero = 0.0e+0 )
218  INTEGER ntypes, ntests
219  parameter( ntypes = 8, ntests = 7 )
220  INTEGER nbw, ntran
221  parameter( nbw = 4, ntran = 3 )
222 * ..
223 * .. Local Scalars ..
224  LOGICAL trfcon, zerot
225  CHARACTER dist, norm, trans, TYPE, xtype
226  CHARACTER*3 path
227  INTEGER i, i1, i2, ikl, iku, im, imat, in, inb, info,
228  $ ioff, irhs, itran, izero, j, k, kl, koff, ku,
229  $ lda, ldafac, ldb, m, mode, n, nb, nerrs, nfail,
230  $ nimat, nkl, nku, nrhs, nrun
231  REAL ainvnm, anorm, anormi, anormo, cndnum, rcond,
232  $ rcondc, rcondi, rcondo
233 * ..
234 * .. Local Arrays ..
235  CHARACTER transs( ntran )
236  INTEGER iseed( 4 ), iseedy( 4 ), klval( nbw ),
237  $ kuval( nbw )
238  REAL result( ntests )
239 * ..
240 * .. External Functions ..
241  REAL clangb, clange, sget06
242  EXTERNAL clangb, clange, sget06
243 * ..
244 * .. External Subroutines ..
245  EXTERNAL alaerh, alahd, alasum, ccopy, cerrge, cgbcon,
248  $ xlaenv
249 * ..
250 * .. Intrinsic Functions ..
251  INTRINSIC cmplx, max, min
252 * ..
253 * .. Scalars in Common ..
254  LOGICAL lerr, ok
255  CHARACTER*32 srnamt
256  INTEGER infot, nunit
257 * ..
258 * .. Common blocks ..
259  COMMON / infoc / infot, nunit, ok, lerr
260  COMMON / srnamc / srnamt
261 * ..
262 * .. Data statements ..
263  DATA iseedy / 1988, 1989, 1990, 1991 / ,
264  $ transs / 'N', 'T', 'C' /
265 * ..
266 * .. Executable Statements ..
267 *
268 * Initialize constants and the random number seed.
269 *
270  path( 1: 1 ) = 'Complex precision'
271  path( 2: 3 ) = 'GB'
272  nrun = 0
273  nfail = 0
274  nerrs = 0
275  DO 10 i = 1, 4
276  iseed( i ) = iseedy( i )
277  10 CONTINUE
278 *
279 * Test the error exits
280 *
281  IF( tsterr )
282  $ CALL cerrge( path, nout )
283  infot = 0
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 CLATB4 and generate a
384 * test matrix with CLATMS.
385 *
386  CALL clatb4( 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 = 'CLATMS'
394  CALL clatms( 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 CLATMS.
399 *
400  IF( info.NE.0 ) THEN
401  CALL alaerh( path, 'CLATMS', 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 ccopy( 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 ccopy( 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 = CLANGB( 'O', N, KL, KU, A, LDA, RWORK )
454 * ANORMI = CLANGB( '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 clacpy( 'Full', kl+ku+1, n, a, lda,
466  $ afac( kl+1 ), ldafac )
467  srnamt = 'CGBTRF'
468  CALL cgbtrf( m, n, kl, ku, afac, ldafac, iwork,
469  $ info )
470 *
471 * Check error code from CGBTRF.
472 *
473  IF( info.NE.izero )
474  $ CALL alaerh( path, 'CGBTRF', 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 cgbt01( 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 = clangb( 'O', n, kl, ku, a, lda, rwork )
505  anormi = clangb( '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 claset( 'Full', n, n, cmplx( zero ),
514  $ cmplx( one ), work, ldb )
515  srnamt = 'CGBTRS'
516  CALL cgbtrs( '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 = clange( '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 = clange( '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 = 'CLARHS'
572  CALL clarhs( path, xtype, ' ', trans, n,
573  $ n, kl, ku, nrhs, a, lda,
574  $ xact, ldb, b, ldb, iseed,
575  $ info )
576  xtype = 'C'
577  CALL clacpy( 'Full', n, nrhs, b, ldb, x,
578  $ ldb )
579 *
580  srnamt = 'CGBTRS'
581  CALL cgbtrs( trans, n, kl, ku, nrhs, afac,
582  $ ldafac, iwork, x, ldb, info )
583 *
584 * Check error code from CGBTRS.
585 *
586  IF( info.NE.0 )
587  $ CALL alaerh( path, 'CGBTRS', info, 0,
588  $ trans, n, n, kl, ku, -1,
589  $ imat, nfail, nerrs, nout )
590 *
591  CALL clacpy( 'Full', n, nrhs, b, ldb,
592  $ work, ldb )
593  CALL cgbt02( 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 cget04( 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 = 'CGBRFS'
609  CALL cgbrfs( trans, n, kl, ku, nrhs, a,
610  $ lda, afac, ldafac, iwork, b,
611  $ ldb, x, ldb, rwork,
612  $ rwork( nrhs+1 ), work,
613  $ rwork( 2*nrhs+1 ), info )
614 *
615 * Check error code from CGBRFS.
616 *
617  IF( info.NE.0 )
618  $ CALL alaerh( path, 'CGBRFS', info, 0,
619  $ trans, n, n, kl, ku, nrhs,
620  $ imat, nfail, nerrs, nout )
621 *
622  CALL cget04( n, nrhs, x, ldb, xact, ldb,
623  $ rcondc, result( 4 ) )
624  CALL cgbt05( trans, n, kl, ku, nrhs, a,
625  $ lda, b, ldb, x, ldb, xact,
626  $ ldb, rwork, rwork( nrhs+1 ),
627  $ result( 5 ) )
628 *
629 * Print information about the tests that did
630 * not pass the threshold.
631 *
632  DO 60 k = 2, 6
633  IF( result( k ).GE.thresh ) THEN
634  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
635  $ CALL alahd( nout, path )
636  WRITE( nout, fmt = 9996 )trans, n,
637  $ kl, ku, nrhs, imat, k,
638  $ result( k )
639  nfail = nfail + 1
640  END IF
641  60 CONTINUE
642  nrun = nrun + 5
643  70 CONTINUE
644  80 CONTINUE
645 *
646 *+ TEST 7:
647 * Get an estimate of RCOND = 1/CNDNUM.
648 *
649  90 CONTINUE
650  DO 100 itran = 1, 2
651  IF( itran.EQ.1 ) THEN
652  anorm = anormo
653  rcondc = rcondo
654  norm = 'O'
655  ELSE
656  anorm = anormi
657  rcondc = rcondi
658  norm = 'I'
659  END IF
660  srnamt = 'CGBCON'
661  CALL cgbcon( norm, n, kl, ku, afac, ldafac,
662  $ iwork, anorm, rcond, work,
663  $ rwork, info )
664 *
665 * Check error code from CGBCON.
666 *
667  IF( info.NE.0 )
668  $ CALL alaerh( path, 'CGBCON', info, 0,
669  $ norm, n, n, kl, ku, -1, imat,
670  $ nfail, nerrs, nout )
671 *
672  result( 7 ) = sget06( rcond, rcondc )
673 *
674 * Print information about the tests that did
675 * not pass the threshold.
676 *
677  IF( result( 7 ).GE.thresh ) THEN
678  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
679  $ CALL alahd( nout, path )
680  WRITE( nout, fmt = 9995 )norm, n, kl, ku,
681  $ imat, 7, result( 7 )
682  nfail = nfail + 1
683  END IF
684  nrun = nrun + 1
685  100 CONTINUE
686  110 CONTINUE
687  120 CONTINUE
688  130 CONTINUE
689  140 CONTINUE
690  150 CONTINUE
691  160 CONTINUE
692 *
693 * Print a summary of the results.
694 *
695  CALL alasum( path, nout, nfail, nrun, nerrs )
696 *
697  9999 FORMAT( ' *** In CCHKGB, LA=', i5, ' is too small for M=', i5,
698  $ ', N=', i5, ', KL=', i4, ', KU=', i4,
699  $ / ' ==> Increase LA to at least ', i5 )
700  9998 FORMAT( ' *** In CCHKGB, LAFAC=', i5, ' is too small for M=', i5,
701  $ ', N=', i5, ', KL=', i4, ', KU=', i4,
702  $ / ' ==> Increase LAFAC to at least ', i5 )
703  9997 FORMAT( ' M =', i5, ', N =', i5, ', KL=', i5, ', KU=', i5,
704  $ ', NB =', i4, ', type ', i1, ', test(', i1, ')=', g12.5 )
705  9996 FORMAT( ' TRANS=''', a1, ''', N=', i5, ', KL=', i5, ', KU=', i5,
706  $ ', NRHS=', i3, ', type ', i1, ', test(', i1, ')=', g12.5 )
707  9995 FORMAT( ' NORM =''', a1, ''', N=', i5, ', KL=', i5, ', KU=', i5,
708  $ ',', 10x, ' type ', i1, ', test(', i1, ')=', g12.5 )
709 *
710  RETURN
711 *
712 * End of CCHKGB
713 *
subroutine claset(UPLO, M, N, ALPHA, BETA, A, LDA)
CLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
Definition: claset.f:108
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
Definition: alaerh.f:149
subroutine cgbtrs(TRANS, N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB, INFO)
CGBTRS
Definition: cgbtrs.f:140
subroutine cgbrfs(TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, LDAFB, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
CGBRFS
Definition: cgbrfs.f:208
subroutine cgbt05(TRANS, N, KL, KU, NRHS, AB, LDAB, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
CGBT05
Definition: cgbt05.f:178
subroutine clatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
CLATB4
Definition: clatb4.f:123
subroutine cget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
CGET04
Definition: cget04.f:104
real function sget06(RCOND, RCONDC)
SGET06
Definition: sget06.f:57
subroutine clarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
CLARHS
Definition: clarhs.f:211
real function clangb(NORM, N, KL, KU, AB, LDAB, WORK)
CLANGB returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
Definition: clangb.f:127
subroutine cgbtrf(M, N, KL, KU, AB, LDAB, IPIV, INFO)
CGBTRF
Definition: cgbtrf.f:146
subroutine alahd(IOUNIT, PATH)
ALAHD
Definition: alahd.f:95
subroutine cerrge(PATH, NUNIT)
CERRGE
Definition: cerrge.f:57
subroutine clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
Definition: clacpy.f:105
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
Definition: alasum.f:75
subroutine ccopy(N, CX, INCX, CY, INCY)
CCOPY
Definition: ccopy.f:52
subroutine cgbt01(M, N, KL, KU, A, LDA, AFAC, LDAFAC, IPIV, WORK, RESID)
CGBT01
Definition: cgbt01.f:128
subroutine cgbt02(TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, RESID)
CGBT02
Definition: cgbt02.f:141
real function clange(NORM, M, N, A, LDA, WORK)
CLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
Definition: clange.f:117
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
Definition: xlaenv.f:83
subroutine clatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
CLATMS
Definition: clatms.f:334
subroutine cgbcon(NORM, N, KL, KU, AB, LDAB, IPIV, ANORM, RCOND, WORK, RWORK, INFO)
CGBCON
Definition: cgbcon.f:149

Here is the call graph for this function:

Here is the caller graph for this function:

subroutine cchkge ( 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,
complex, dimension( * )  A,
complex, dimension( * )  AFAC,
complex, dimension( * )  AINV,
complex, dimension( * )  B,
complex, dimension( * )  X,
complex, dimension( * )  XACT,
complex, dimension( * )  WORK,
real, dimension( * )  RWORK,
integer, dimension( * )  IWORK,
integer  NOUT 
)

CCHKGE

Purpose:
 CCHKGE tests CGETRF, -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 COMPLEX array, dimension (NMAX*NMAX)
[out]AFAC
          AFAC is COMPLEX array, dimension (NMAX*NMAX)
[out]AINV
          AINV is COMPLEX array, dimension (NMAX*NMAX)
[out]B
          B is COMPLEX array, dimension (NMAX*NSMAX)
          where NSMAX is the largest entry in NSVAL.
[out]X
          X is COMPLEX array, dimension (NMAX*NSMAX)
[out]XACT
          XACT is COMPLEX array, dimension (NMAX*NSMAX)
[out]WORK
          WORK is COMPLEX 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 (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 188 of file cchkge.f.

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

Here is the call graph for this function:

Here is the caller graph for this function:

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

CCHKGT

Purpose:
 CCHKGT tests CGTTRF, -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 COMPLEX array, dimension (NMAX*4)
[out]AF
          AF is COMPLEX array, dimension (NMAX*4)
[out]B
          B is COMPLEX array, dimension (NMAX*NSMAX)
          where NSMAX is the largest entry in NSVAL.
[out]X
          X is COMPLEX array, dimension (NMAX*NSMAX)
[out]XACT
          XACT is COMPLEX array, dimension (NMAX*NSMAX)
[out]WORK
          WORK is COMPLEX 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 149 of file cchkgt.f.

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

Here is the call graph for this function:

Here is the caller graph for this function:

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

CCHKHE

Purpose:
 CCHKHE tests CHETRF, -TRI2, -TRS, -TRS2, -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 COMPLEX array, dimension (NMAX*NMAX)
[out]AFAC
          AFAC is COMPLEX array, dimension (NMAX*NMAX)
[out]AINV
          AINV is COMPLEX array, dimension (NMAX*NMAX)
[out]B
          B is COMPLEX array, dimension (NMAX*NSMAX)
          where NSMAX is the largest entry in NSVAL.
[out]X
          X is COMPLEX array, dimension (NMAX*NSMAX)
[out]XACT
          XACT is COMPLEX array, dimension (NMAX*NSMAX)
[out]WORK
          WORK is COMPLEX 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 2013

Definition at line 173 of file cchkhe.f.

173 *
174 * -- LAPACK test routine (version 3.5.0) --
175 * -- LAPACK is a software package provided by Univ. of Tennessee, --
176 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
177 * November 2013
178 *
179 * .. Scalar Arguments ..
180  LOGICAL tsterr
181  INTEGER nmax, nn, nnb, nns, nout
182  REAL thresh
183 * ..
184 * .. Array Arguments ..
185  LOGICAL dotype( * )
186  INTEGER iwork( * ), nbval( * ), nsval( * ), nval( * )
187  REAL rwork( * )
188  COMPLEX a( * ), afac( * ), ainv( * ), b( * ),
189  $ work( * ), x( * ), xact( * )
190 * ..
191 *
192 * =====================================================================
193 *
194 * .. Parameters ..
195  REAL zero
196  parameter( zero = 0.0e+0 )
197  COMPLEX czero
198  parameter( czero = ( 0.0e+0, 0.0e+0 ) )
199  INTEGER ntypes
200  parameter( ntypes = 10 )
201  INTEGER ntests
202  parameter( ntests = 9 )
203 * ..
204 * .. Local Scalars ..
205  LOGICAL trfcon, zerot
206  CHARACTER dist, TYPE, uplo, xtype
207  CHARACTER*3 path
208  INTEGER i, i1, i2, imat, in, inb, info, ioff, irhs,
209  $ iuplo, izero, j, k, kl, ku, lda, lwork, mode,
210  $ n, nb, nerrs, nfail, nimat, nrhs, nrun, nt
211  REAL anorm, cndnum, rcond, rcondc
212 * ..
213 * .. Local Arrays ..
214  CHARACTER uplos( 2 )
215  INTEGER iseed( 4 ), iseedy( 4 )
216  REAL result( ntests )
217 * ..
218 * .. External Functions ..
219  REAL clanhe, sget06
220  EXTERNAL clanhe, sget06
221 * ..
222 * .. External Subroutines ..
223  EXTERNAL alaerh, alahd, alasum, cerrhe, cget04, checon,
226  $ cpot03, cpot05, xlaenv
227 * ..
228 * .. Intrinsic Functions ..
229  INTRINSIC max, min
230 * ..
231 * .. Scalars in Common ..
232  LOGICAL lerr, ok
233  CHARACTER*32 srnamt
234  INTEGER infot, nunit
235 * ..
236 * .. Common blocks ..
237  COMMON / infoc / infot, nunit, ok, lerr
238  COMMON / srnamc / srnamt
239 * ..
240 * .. Data statements ..
241  DATA iseedy / 1988, 1989, 1990, 1991 /
242  DATA uplos / 'U', 'L' /
243 * ..
244 * .. Executable Statements ..
245 *
246 * Initialize constants and the random number seed.
247 *
248  path( 1: 1 ) = 'Complex precision'
249  path( 2: 3 ) = 'HE'
250  nrun = 0
251  nfail = 0
252  nerrs = 0
253  DO 10 i = 1, 4
254  iseed( i ) = iseedy( i )
255  10 CONTINUE
256 *
257 * Test the error exits
258 *
259  IF( tsterr )
260  $ CALL cerrhe( path, nout )
261  infot = 0
262 *
263 * Set the minimum block size for which the block routine should
264 * be used, which will be later returned by ILAENV
265 *
266  CALL xlaenv( 2, 2 )
267 *
268 * Do for each value of N in NVAL
269 *
270  DO 180 in = 1, nn
271  n = nval( in )
272  lda = max( n, 1 )
273  xtype = 'N'
274  nimat = ntypes
275  IF( n.LE.0 )
276  $ nimat = 1
277 *
278  izero = 0
279 *
280 * Do for each value of matrix type IMAT
281 *
282  DO 170 imat = 1, nimat
283 *
284 * Do the tests only if DOTYPE( IMAT ) is true.
285 *
286  IF( .NOT.dotype( imat ) )
287  $ GO TO 170
288 *
289 * Skip types 3, 4, 5, or 6 if the matrix size is too small.
290 *
291  zerot = imat.GE.3 .AND. imat.LE.6
292  IF( zerot .AND. n.LT.imat-2 )
293  $ GO TO 170
294 *
295 * Do first for UPLO = 'U', then for UPLO = 'L'
296 *
297  DO 160 iuplo = 1, 2
298  uplo = uplos( iuplo )
299 *
300 * Begin generate test matrix A.
301 *
302 *
303 * Set up parameters with CLATB4 for the matrix generator
304 * based on the type of matrix to be generated.
305 *
306  CALL clatb4( path, imat, n, n, TYPE, kl, ku, anorm, mode,
307  $ cndnum, dist )
308 *
309 * Generate a matrix with CLATMS.
310 *
311  srnamt = 'CLATMS'
312  CALL clatms( n, n, dist, iseed, TYPE, rwork, mode,
313  $ cndnum, anorm, kl, ku, uplo, a, lda, work,
314  $ info )
315 *
316 * Check error code from CLATMS and handle error.
317 *
318  IF( info.NE.0 ) THEN
319  CALL alaerh( path, 'CLATMS', info, 0, uplo, n, n, -1,
320  $ -1, -1, imat, nfail, nerrs, nout )
321 *
322 * Skip all tests for this generated matrix
323 *
324  GO TO 160
325  END IF
326 *
327 * For matrix types 3-6, zero one or more rows and
328 * columns of the matrix to test that INFO is returned
329 * correctly.
330 *
331  IF( zerot ) THEN
332  IF( imat.EQ.3 ) THEN
333  izero = 1
334  ELSE IF( imat.EQ.4 ) THEN
335  izero = n
336  ELSE
337  izero = n / 2 + 1
338  END IF
339 *
340  IF( imat.LT.6 ) THEN
341 *
342 * Set row and column IZERO to zero.
343 *
344  IF( iuplo.EQ.1 ) THEN
345  ioff = ( izero-1 )*lda
346  DO 20 i = 1, izero - 1
347  a( ioff+i ) = czero
348  20 CONTINUE
349  ioff = ioff + izero
350  DO 30 i = izero, n
351  a( ioff ) = czero
352  ioff = ioff + lda
353  30 CONTINUE
354  ELSE
355  ioff = izero
356  DO 40 i = 1, izero - 1
357  a( ioff ) = czero
358  ioff = ioff + lda
359  40 CONTINUE
360  ioff = ioff - izero
361  DO 50 i = izero, n
362  a( ioff+i ) = czero
363  50 CONTINUE
364  END IF
365  ELSE
366  IF( iuplo.EQ.1 ) THEN
367 *
368 * Set the first IZERO rows and columns to zero.
369 *
370  ioff = 0
371  DO 70 j = 1, n
372  i2 = min( j, izero )
373  DO 60 i = 1, i2
374  a( ioff+i ) = czero
375  60 CONTINUE
376  ioff = ioff + lda
377  70 CONTINUE
378  ELSE
379 *
380 * Set the last IZERO rows and columns to zero.
381 *
382  ioff = 0
383  DO 90 j = 1, n
384  i1 = max( j, izero )
385  DO 80 i = i1, n
386  a( ioff+i ) = czero
387  80 CONTINUE
388  ioff = ioff + lda
389  90 CONTINUE
390  END IF
391  END IF
392  ELSE
393  izero = 0
394  END IF
395 *
396 * Set the imaginary part of the diagonals.
397 *
398  CALL claipd( n, a, lda+1, 0 )
399 *
400 * End generate test matrix A.
401 *
402 *
403 * Do for each value of NB in NBVAL
404 *
405  DO 150 inb = 1, nnb
406 *
407 * Set the optimal blocksize, which will be later
408 * returned by ILAENV.
409 *
410  nb = nbval( inb )
411  CALL xlaenv( 1, nb )
412 *
413 * Copy the test matrix A into matrix AFAC which
414 * will be factorized in place. This is needed to
415 * preserve the test matrix A for subsequent tests.
416 *
417  CALL clacpy( uplo, n, n, a, lda, afac, lda )
418 *
419 * Compute the L*D*L**T or U*D*U**T factorization of the
420 * matrix. IWORK stores details of the interchanges and
421 * the block structure of D. AINV is a work array for
422 * block factorization, LWORK is the length of AINV.
423 *
424  lwork = max( 2, nb )*lda
425  srnamt = 'CHETRF'
426  CALL chetrf( uplo, n, afac, lda, iwork, ainv, lwork,
427  $ info )
428 *
429 * Adjust the expected value of INFO to account for
430 * pivoting.
431 *
432  k = izero
433  IF( k.GT.0 ) THEN
434  100 CONTINUE
435  IF( iwork( k ).LT.0 ) THEN
436  IF( iwork( k ).NE.-k ) THEN
437  k = -iwork( k )
438  GO TO 100
439  END IF
440  ELSE IF( iwork( k ).NE.k ) THEN
441  k = iwork( k )
442  GO TO 100
443  END IF
444  END IF
445 *
446 * Check error code from CHETRF and handle error.
447 *
448  IF( info.NE.k )
449  $ CALL alaerh( path, 'CHETRF', info, k, uplo, n, n,
450  $ -1, -1, nb, imat, nfail, nerrs, nout )
451 *
452 * Set the condition estimate flag if the INFO is not 0.
453 *
454  IF( info.NE.0 ) THEN
455  trfcon = .true.
456  ELSE
457  trfcon = .false.
458  END IF
459 *
460 *+ TEST 1
461 * Reconstruct matrix from factors and compute residual.
462 *
463  CALL chet01( uplo, n, a, lda, afac, lda, iwork, ainv,
464  $ lda, rwork, result( 1 ) )
465  nt = 1
466 *
467 *+ TEST 2
468 * Form the inverse and compute the residual,
469 * if the factorization was competed without INFO > 0
470 * (i.e. there is no zero rows and columns).
471 * Do it only for the first block size.
472 *
473  IF( inb.EQ.1 .AND. .NOT.trfcon ) THEN
474  CALL clacpy( uplo, n, n, afac, lda, ainv, lda )
475  srnamt = 'CHETRI2'
476  lwork = (n+nb+1)*(nb+3)
477  CALL chetri2( uplo, n, ainv, lda, iwork, work,
478  $ lwork, info )
479 *
480 * Check error code from CHETRI2 and handle error.
481 *
482  IF( info.NE.0 )
483  $ CALL alaerh( path, 'CHETRI2', info, -1, uplo, n,
484  $ n, -1, -1, -1, imat, nfail, nerrs,
485  $ nout )
486 *
487 * Compute the residual for a symmetric matrix times
488 * its inverse.
489 *
490  CALL cpot03( uplo, n, a, lda, ainv, lda, work, lda,
491  $ rwork, rcondc, result( 2 ) )
492  nt = 2
493  END IF
494 *
495 * Print information about the tests that did not pass
496 * the threshold.
497 *
498  DO 110 k = 1, nt
499  IF( result( k ).GE.thresh ) THEN
500  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
501  $ CALL alahd( nout, path )
502  WRITE( nout, fmt = 9999 )uplo, n, nb, imat, k,
503  $ result( k )
504  nfail = nfail + 1
505  END IF
506  110 CONTINUE
507  nrun = nrun + nt
508 *
509 * Skip the other tests if this is not the first block
510 * size.
511 *
512  IF( inb.GT.1 )
513  $ GO TO 150
514 *
515 * Do only the condition estimate if INFO is not 0.
516 *
517  IF( trfcon ) THEN
518  rcondc = zero
519  GO TO 140
520  END IF
521 *
522 * Do for each value of NRHS in NSVAL.
523 *
524  DO 130 irhs = 1, nns
525  nrhs = nsval( irhs )
526 *
527 *+ TEST 3 (Using TRS)
528 * Solve and compute residual for A * X = B.
529 *
530 * Choose a set of NRHS random solution vectors
531 * stored in XACT and set up the right hand side B
532 *
533  srnamt = 'CLARHS'
534  CALL clarhs( path, xtype, uplo, ' ', n, n, kl, ku,
535  $ nrhs, a, lda, xact, lda, b, lda,
536  $ iseed, info )
537  CALL clacpy( 'Full', n, nrhs, b, lda, x, lda )
538 *
539  srnamt = 'CHETRS'
540  CALL chetrs( uplo, n, nrhs, afac, lda, iwork, x,
541  $ lda, info )
542 *
543 * Check error code from CHETRS and handle error.
544 *
545  IF( info.NE.0 )
546  $ CALL alaerh( path, 'CHETRS', info, 0, uplo, n,
547  $ n, -1, -1, nrhs, imat, nfail,
548  $ nerrs, nout )
549 *
550  CALL clacpy( 'Full', n, nrhs, b, lda, work, lda )
551 *
552 * Compute the residual for the solution
553 *
554  CALL cpot02( uplo, n, nrhs, a, lda, x, lda, work,
555  $ lda, rwork, result( 3 ) )
556 *
557 *+ TEST 4 (Using TRS2)
558 * Solve and compute residual for A * X = B.
559 *
560 * Choose a set of NRHS random solution vectors
561 * stored in XACT and set up the right hand side B
562 *
563  srnamt = 'CLARHS'
564  CALL clarhs( path, xtype, uplo, ' ', n, n, kl, ku,
565  $ nrhs, a, lda, xact, lda, b, lda,
566  $ iseed, info )
567  CALL clacpy( 'Full', n, nrhs, b, lda, x, lda )
568 *
569  srnamt = 'CHETRS2'
570  CALL chetrs2( uplo, n, nrhs, afac, lda, iwork, x,
571  $ lda, work, info )
572 *
573 * Check error code from CHETRS2 and handle error.
574 *
575  IF( info.NE.0 )
576  $ CALL alaerh( path, 'CHETRS2', info, 0, uplo, n,
577  $ n, -1, -1, nrhs, imat, nfail,
578  $ nerrs, nout )
579 *
580  CALL clacpy( 'Full', n, nrhs, b, lda, work, lda )
581 *
582 * Compute the residual for the solution
583 *
584  CALL cpot02( uplo, n, nrhs, a, lda, x, lda, work,
585  $ lda, rwork, result( 4 ) )
586 *
587 *+ TEST 5
588 * Check solution from generated exact solution.
589 *
590  CALL cget04( n, nrhs, x, lda, xact, lda, rcondc,
591  $ result( 5 ) )
592 *
593 *+ TESTS 6, 7, and 8
594 * Use iterative refinement to improve the solution.
595 *
596  srnamt = 'CHERFS'
597  CALL cherfs( uplo, n, nrhs, a, lda, afac, lda,
598  $ iwork, b, lda, x, lda, rwork,
599  $ rwork( nrhs+1 ), work,
600  $ rwork( 2*nrhs+1 ), info )
601 *
602 * Check error code from CHERFS and handle error.
603 *
604  IF( info.NE.0 )
605  $ CALL alaerh( path, 'CHERFS', info, 0, uplo, n,
606  $ n, -1, -1, nrhs, imat, nfail,
607  $ nerrs, nout )
608 *
609  CALL cget04( n, nrhs, x, lda, xact, lda, rcondc,
610  $ result( 6 ) )
611  CALL cpot05( uplo, n, nrhs, a, lda, b, lda, x, lda,
612  $ xact, lda, rwork, rwork( nrhs+1 ),
613  $ result( 7 ) )
614 *
615 * Print information about the tests that did not pass
616 * the threshold.
617 *
618  DO 120 k = 3, 8
619  IF( result( k ).GE.thresh ) THEN
620  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
621  $ CALL alahd( nout, path )
622  WRITE( nout, fmt = 9998 )uplo, n, nrhs,
623  $ imat, k, result( k )
624  nfail = nfail + 1
625  END IF
626  120 CONTINUE
627  nrun = nrun + 6
628 *
629 * End do for each value of NRHS in NSVAL.
630 *
631  130 CONTINUE
632 *
633 *+ TEST 9
634 * Get an estimate of RCOND = 1/CNDNUM.
635 *
636  140 CONTINUE
637  anorm = clanhe( '1', uplo, n, a, lda, rwork )
638  srnamt = 'CHECON'
639  CALL checon( uplo, n, afac, lda, iwork, anorm, rcond,
640  $ work, info )
641 *
642 * Check error code from CHECON and handle error.
643 *
644  IF( info.NE.0 )
645  $ CALL alaerh( path, 'CHECON', info, 0, uplo, n, n,
646  $ -1, -1, -1, imat, nfail, nerrs, nout )
647 *
648 * Compute the test ratio to compare values of RCOND
649 *
650  result( 9 ) = sget06( rcond, rcondc )
651 *
652 * Print information about the tests that did not pass
653 * the threshold.
654 *
655  IF( result( 9 ).GE.thresh ) THEN
656  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
657  $ CALL alahd( nout, path )
658  WRITE( nout, fmt = 9997 )uplo, n, imat, 8,
659  $ result( 9 )
660  nfail = nfail + 1
661  END IF
662  nrun = nrun + 1
663  150 CONTINUE
664  160 CONTINUE
665  170 CONTINUE
666  180 CONTINUE
667 *
668 * Print a summary of the results.
669 *
670  CALL alasum( path, nout, nfail, nrun, nerrs )
671 *
672  9999 FORMAT( ' UPLO = ''', a1, ''', N =', i5, ', NB =', i4, ', type ',
673  $ i2, ', test ', i2, ', ratio =', g12.5 )
674  9998 FORMAT( ' UPLO = ''', a1, ''', N =', i5, ', NRHS=', i3, ', type ',
675  $ i2, ', test(', i2, ') =', g12.5 )
676  9997 FORMAT( ' UPLO = ''', a1, ''', N =', i5, ',', 10x, ' type ', i2,
677  $ ', test(', i2, ') =', g12.5 )
678  RETURN
679 *
680 * End of CCHKHE
681 *
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
Definition: alaerh.f:149
real function clanhe(NORM, UPLO, N, A, LDA, WORK)
CLANHE returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a complex Hermitian matrix.
Definition: clanhe.f:126
subroutine chetrs(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
CHETRS
Definition: chetrs.f:122
subroutine chet01(UPLO, N, A, LDA, AFAC, LDAFAC, IPIV, C, LDC, RWORK, RESID)
CHET01
Definition: chet01.f:128
subroutine cpot05(UPLO, N, NRHS, A, LDA, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
CPOT05
Definition: cpot05.f:167
subroutine claipd(N, A, INDA, VINDA)
CLAIPD
Definition: claipd.f:85
subroutine chetrf(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
CHETRF
Definition: chetrf.f:179
subroutine clatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
CLATB4
Definition: clatb4.f:123
subroutine cget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
CGET04
Definition: cget04.f:104
real function sget06(RCOND, RCONDC)
SGET06
Definition: sget06.f:57
subroutine checon(UPLO, N, A, LDA, IPIV, ANORM, RCOND, WORK, INFO)
CHECON
Definition: checon.f:127
subroutine chetri2(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
CHETRI2
Definition: chetri2.f:129
subroutine clarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
CLARHS
Definition: clarhs.f:211
subroutine alahd(IOUNIT, PATH)
ALAHD
Definition: alahd.f:95
subroutine chetrs2(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, INFO)
CHETRS2
Definition: chetrs2.f:129
subroutine clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
Definition: clacpy.f:105
subroutine cherfs(UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
CHERFS
Definition: cherfs.f:194
subroutine cerrhe(PATH, NUNIT)
CERRHE
Definition: cerrhe.f:57
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
Definition: alasum.f:75
subroutine cpot03(UPLO, N, A, LDA, AINV, LDAINV, WORK, LDWORK, RWORK, RCOND, RESID)
CPOT03
Definition: cpot03.f:128
subroutine cpot02(UPLO, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
CPOT02
Definition: cpot02.f:129
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
Definition: xlaenv.f:83
subroutine clatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
CLATMS
Definition: clatms.f:334

Here is the call graph for this function:

Here is the caller graph for this function:

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

CCHKHE_ROOK

Purpose:
 CCHKHE_ROOK tests CHETRF_ROOK, -TRI_ROOK, -TRS_ROOK,
 and -CON_ROOK.
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 COMPLEX array, dimension (NMAX*NMAX)
[out]AFAC
          AFAC is COMPLEX array, dimension (NMAX*NMAX)
[out]AINV
          AINV is COMPLEX array, dimension (NMAX*NMAX)
[out]B
          B is COMPLEX array, dimension (NMAX*NSMAX)
          where NSMAX is the largest entry in NSVAL.
[out]X
          X is COMPLEX array, dimension (NMAX*NSMAX)
[out]XACT
          XACT is COMPLEX array, dimension (NMAX*NSMAX)
[out]WORK
          WORK is COMPLEX 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 2015

Definition at line 174 of file cchkhe_rook.f.

174 *
175 * -- LAPACK test routine (version 3.6.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 2015
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 rwork( * )
189  COMPLEX a( * ), afac( * ), ainv( * ), b( * ),
190  $ work( * ), x( * ), xact( * )
191 * ..
192 *
193 * =====================================================================
194 *
195 * .. Parameters ..
196  REAL zero, one
197  parameter( zero = 0.0e+0, one = 1.0e+0 )
198  REAL onehalf
199  parameter( onehalf = 0.5e+0 )
200  REAL eight, sevten
201  parameter( eight = 8.0e+0, sevten = 17.0e+0 )
202  COMPLEX czero
203  parameter( czero = ( 0.0e+0, 0.0e+0 ) )
204  INTEGER ntypes
205  parameter( ntypes = 10 )
206  INTEGER ntests
207  parameter( ntests = 7 )
208 * ..
209 * .. Local Scalars ..
210  LOGICAL trfcon, zerot
211  CHARACTER dist, TYPE, uplo, xtype
212  CHARACTER*3 path, matpath
213  INTEGER i, i1, i2, imat, in, inb, info, ioff, irhs,
214  $ itemp, itemp2, iuplo, izero, j, k, kl, ku, lda,
215  $ lwork, mode, n, nb, nerrs, nfail, nimat, nrhs,
216  $ nrun, nt
217  REAL alpha, anorm, cndnum, const, sing_max,
218  $ sing_min, rcond, rcondc, stemp
219 * ..
220 * .. Local Arrays ..
221  CHARACTER uplos( 2 )
222  INTEGER iseed( 4 ), iseedy( 4 ), idummy( 1 )
223  REAL result( ntests )
224  COMPLEX block( 2, 2 ), cdummy( 1 )
225 * ..
226 * .. External Functions ..
227  REAL clange, clanhe, sget06
228  EXTERNAL clange, clanhe, sget06
229 * ..
230 * .. External Subroutines ..
231  EXTERNAL alaerh, alahd, alasum, cerrhe, cgesvd, cget04,
235 * ..
236 * .. Intrinsic Functions ..
237  INTRINSIC conjg, max, min, sqrt
238 * ..
239 * .. Scalars in Common ..
240  LOGICAL lerr, ok
241  CHARACTER*32 srnamt
242  INTEGER infot, nunit
243 * ..
244 * .. Common blocks ..
245  COMMON / infoc / infot, nunit, ok, lerr
246  COMMON / srnamc / srnamt
247 * ..
248 * .. Data statements ..
249  DATA iseedy / 1988, 1989, 1990, 1991 /
250  DATA uplos / 'U', 'L' /
251 * ..
252 * .. Executable Statements ..
253 *
254 * Initialize constants and the random number seed.
255 *
256  alpha = ( one+sqrt( sevten ) ) / eight
257 *
258 * Test path
259 *
260  path( 1: 1 ) = 'Complex precision'
261  path( 2: 3 ) = 'HR'
262 *
263 * Path to generate matrices
264 *
265  matpath( 1: 1 ) = 'Complex precision'
266  matpath( 2: 3 ) = 'HE'
267 *
268  nrun = 0
269  nfail = 0
270  nerrs = 0
271  DO 10 i = 1, 4
272  iseed( i ) = iseedy( i )
273  10 CONTINUE
274 *
275 * Test the error exits
276 *
277  IF( tsterr )
278  $ CALL cerrhe( path, nout )
279  infot = 0
280 *
281 * Set the minimum block size for which the block routine should
282 * be used, which will be later returned by ILAENV
283 *
284  CALL xlaenv( 2, 2 )
285 *
286 * Do for each value of N in NVAL
287 *
288  DO 270 in = 1, nn
289  n = nval( in )
290  lda = max( n, 1 )
291  xtype = 'N'
292  nimat = ntypes
293  IF( n.LE.0 )
294  $ nimat = 1
295 *
296  izero = 0
297 *
298 * Do for each value of matrix type IMAT
299 *
300  DO 260 imat = 1, nimat
301 *
302 * Do the tests only if DOTYPE( IMAT ) is true.
303 *
304  IF( .NOT.dotype( imat ) )
305  $ GO TO 260
306 *
307 * Skip types 3, 4, 5, or 6 if the matrix size is too small.
308 *
309  zerot = imat.GE.3 .AND. imat.LE.6
310  IF( zerot .AND. n.LT.imat-2 )
311  $ GO TO 260
312 *
313 * Do first for UPLO = 'U', then for UPLO = 'L'
314 *
315  DO 250 iuplo = 1, 2
316  uplo = uplos( iuplo )
317 *
318 * Begin generate the test matrix A.
319 *
320 * Set up parameters with CLATB4 for the matrix generator
321 * based on the type of matrix to be generated.
322 *
323  CALL clatb4( matpath, imat, n, n, TYPE, kl, ku, anorm,
324  $ mode, cndnum, dist )
325 *
326 * Generate a matrix with CLATMS.
327 *
328  srnamt = 'CLATMS'
329  CALL clatms( n, n, dist, iseed, TYPE, rwork, mode,
330  $ cndnum, anorm, kl, ku, uplo, a, lda,
331  $ work, info )
332 *
333 * Check error code from CLATMS and handle error.
334 *
335  IF( info.NE.0 ) THEN
336  CALL alaerh( path, 'CLATMS', info, 0, uplo, n, n,
337  $ -1, -1, -1, imat, nfail, nerrs, nout )
338 *
339 * Skip all tests for this generated matrix
340 *
341  GO TO 250
342  END IF
343 *
344 * For matrix types 3-6, zero one or more rows and
345 * columns of the matrix to test that INFO is returned
346 * correctly.
347 *
348  IF( zerot ) THEN
349  IF( imat.EQ.3 ) THEN
350  izero = 1
351  ELSE IF( imat.EQ.4 ) THEN
352  izero = n
353  ELSE
354  izero = n / 2 + 1
355  END IF
356 *
357  IF( imat.LT.6 ) THEN
358 *
359 * Set row and column IZERO to zero.
360 *
361  IF( iuplo.EQ.1 ) THEN
362  ioff = ( izero-1 )*lda
363  DO 20 i = 1, izero - 1
364  a( ioff+i ) = czero
365  20 CONTINUE
366  ioff = ioff + izero
367  DO 30 i = izero, n
368  a( ioff ) = czero
369  ioff = ioff + lda
370  30 CONTINUE
371  ELSE
372  ioff = izero
373  DO 40 i = 1, izero - 1
374  a( ioff ) = czero
375  ioff = ioff + lda
376  40 CONTINUE
377  ioff = ioff - izero
378  DO 50 i = izero, n
379  a( ioff+i ) = czero
380  50 CONTINUE
381  END IF
382  ELSE
383  IF( iuplo.EQ.1 ) THEN
384 *
385 * Set the first IZERO rows and columns to zero.
386 *
387  ioff = 0
388  DO 70 j = 1, n
389  i2 = min( j, izero )
390  DO 60 i = 1, i2
391  a( ioff+i ) = czero
392  60 CONTINUE
393  ioff = ioff + lda
394  70 CONTINUE
395  ELSE
396 *
397 * Set the last IZERO rows and columns to zero.
398 *
399  ioff = 0
400  DO 90 j = 1, n
401  i1 = max( j, izero )
402  DO 80 i = i1, n
403  a( ioff+i ) = czero
404  80 CONTINUE
405  ioff = ioff + lda
406  90 CONTINUE
407  END IF
408  END IF
409  ELSE
410  izero = 0
411  END IF
412 *
413 * End generate the test matrix A.
414 *
415 *
416 * Do for each value of NB in NBVAL
417 *
418  DO 240 inb = 1, nnb
419 *
420 * Set the optimal blocksize, which will be later
421 * returned by ILAENV.
422 *
423  nb = nbval( inb )
424  CALL xlaenv( 1, nb )
425 *
426 * Copy the test matrix A into matrix AFAC which
427 * will be factorized in place. This is needed to
428 * preserve the test matrix A for subsequent tests.
429 *
430  CALL clacpy( uplo, n, n, a, lda, afac, lda )
431 *
432 * Compute the L*D*L**T or U*D*U**T factorization of the
433 * matrix. IWORK stores details of the interchanges and
434 * the block structure of D. AINV is a work array for
435 * block factorization, LWORK is the length of AINV.
436 *
437  lwork = max( 2, nb )*lda
438  srnamt = 'CHETRF_ROOK'
439  CALL chetrf_rook( uplo, n, afac, lda, iwork, ainv,
440  $ lwork, info )
441 *
442 * Adjust the expected value of INFO to account for
443 * pivoting.
444 *
445  k = izero
446  IF( k.GT.0 ) THEN
447  100 CONTINUE
448  IF( iwork( k ).LT.0 ) THEN
449  IF( iwork( k ).NE.-k ) THEN
450  k = -iwork( k )
451  GO TO 100
452  END IF
453  ELSE IF( iwork( k ).NE.k ) THEN
454  k = iwork( k )
455  GO TO 100
456  END IF
457  END IF
458 *
459 * Check error code from CHETRF_ROOK and handle error.
460 *
461  IF( info.NE.k)
462  $ CALL alaerh( path, 'CHETRF_ROOK', info, k,
463  $ uplo, n, n, -1, -1, nb, imat,
464  $ nfail, nerrs, nout )
465 *
466 * Set the condition estimate flag if the INFO is not 0.
467 *
468  IF( info.NE.0 ) THEN
469  trfcon = .true.
470  ELSE
471  trfcon = .false.
472  END IF
473 *
474 *+ TEST 1
475 * Reconstruct matrix from factors and compute residual.
476 *
477  CALL chet01_rook( uplo, n, a, lda, afac, lda, iwork,
478  $ ainv, lda, rwork, result( 1 ) )
479  nt = 1
480 *
481 *+ TEST 2
482 * Form the inverse and compute the residual,
483 * if the factorization was competed without INFO > 0
484 * (i.e. there is no zero rows and columns).
485 * Do it only for the first block size.
486 *
487  IF( inb.EQ.1 .AND. .NOT.trfcon ) THEN
488  CALL clacpy( uplo, n, n, afac, lda, ainv, lda )
489  srnamt = 'CHETRI_ROOK'
490  CALL chetri_rook( uplo, n, ainv, lda, iwork, work,
491  $ info )
492 *
493 * Check error code from CHETRI_ROOK and handle error.
494 *
495  IF( info.NE.0 )
496  $ CALL alaerh( path, 'CHETRI_ROOK', info, -1,
497  $ uplo, n, n, -1, -1, -1, imat,
498  $ nfail, nerrs, nout )
499 *
500 * Compute the residual for a Hermitian matrix times
501 * its inverse.
502 *
503  CALL cpot03( uplo, n, a, lda, ainv, lda, work, lda,
504  $ rwork, rcondc, result( 2 ) )
505  nt = 2
506  END IF
507 *
508 * Print information about the tests that did not pass
509 * the threshold.
510 *
511  DO 110 k = 1, nt
512  IF( result( k ).GE.thresh ) THEN
513  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
514  $ CALL alahd( nout, path )
515  WRITE( nout, fmt = 9999 )uplo, n, nb, imat, k,
516  $ result( k )
517  nfail = nfail + 1
518  END IF
519  110 CONTINUE
520  nrun = nrun + nt
521 *
522 *+ TEST 3
523 * Compute largest element in U or L
524 *
525  result( 3 ) = zero
526  stemp = zero
527 *
528  const = ( ( alpha**2-one ) / ( alpha**2-onehalf ) ) /
529  $ ( one-alpha )
530 *
531  IF( iuplo.EQ.1 ) THEN
532 *
533 * Compute largest element in U
534 *
535  k = n
536  120 CONTINUE
537  IF( k.LE.1 )
538  $ GO TO 130
539 *
540  IF( iwork( k ).GT.zero ) THEN
541 *
542 * Get max absolute value from elements
543 * in column k in U
544 *
545  stemp = clange( 'M', k-1, 1,
546  $ afac( ( k-1 )*lda+1 ), lda, rwork )
547  ELSE
548 *
549 * Get max absolute value from elements
550 * in columns k and k-1 in U
551 *
552  stemp = clange( 'M', k-2, 2,
553  $ afac( ( k-2 )*lda+1 ), lda, rwork )
554  k = k - 1
555 *
556  END IF
557 *
558 * STEMP should be bounded by CONST
559 *
560  stemp = stemp - const + thresh
561  IF( stemp.GT.result( 3 ) )
562  $ result( 3 ) = stemp
563 *
564  k = k - 1
565 *
566  GO TO 120
567  130 CONTINUE
568 *
569  ELSE
570 *
571 * Compute largest element in L
572 *
573  k = 1
574  140 CONTINUE
575  IF( k.GE.n )
576  $ GO TO 150
577 *
578  IF( iwork( k ).GT.zero ) THEN
579 *
580 * Get max absolute value from elements
581 * in column k in L
582 *
583  stemp = clange( 'M', n-k, 1,
584  $ afac( ( k-1 )*lda+k+1 ), lda, rwork )
585  ELSE
586 *
587 * Get max absolute value from elements
588 * in columns k and k+1 in L
589 *
590  stemp = clange( 'M', n-k-1, 2,
591  $ afac( ( k-1 )*lda+k+2 ), lda, rwork )
592  k = k + 1
593 *
594  END IF
595 *
596 * STEMP should be bounded by CONST
597 *
598  stemp = stemp - const + thresh
599  IF( stemp.GT.result( 3 ) )
600  $ result( 3 ) = stemp
601 *
602  k = k + 1
603 *
604  GO TO 140
605  150 CONTINUE
606  END IF
607 *
608 *
609 *+ TEST 4
610 * Compute largest 2-Norm (condition number)
611 * of 2-by-2 diag blocks
612 *
613  result( 4 ) = zero
614  stemp = zero
615 *
616  const = ( ( alpha**2-one ) / ( alpha**2-onehalf ) )*
617  $ ( ( one + alpha ) / ( one - alpha ) )
618  CALL clacpy( uplo, n, n, afac, lda, ainv, lda )
619 *
620  IF( iuplo.EQ.1 ) THEN
621 *
622 * Loop backward for UPLO = 'U'
623 *
624  k = n
625  160 CONTINUE
626  IF( k.LE.1 )
627  $ GO TO 170
628 *
629  IF( iwork( k ).LT.zero ) THEN
630 *
631 * Get the two singular values
632 * (real and non-negative) of a 2-by-2 block,
633 * store them in RWORK array
634 *
635  block( 1, 1 ) = afac( ( k-2 )*lda+k-1 )
636  block( 1, 2 ) = afac( (k-1)*lda+k-1 )
637  block( 2, 1 ) = conjg( block( 1, 2 ) )
638  block( 2, 2 ) = afac( (k-1)*lda+k )
639 *
640  CALL cgesvd( 'N', 'N', 2, 2, block, 2, rwork,
641  $ cdummy, 1, cdummy, 1,
642  $ work, 6, rwork( 3 ), info )
643 *
644 *
645  sing_max = rwork( 1 )
646  sing_min = rwork( 2 )
647 *
648  stemp = sing_max / sing_min
649 *
650 * STEMP should be bounded by CONST
651 *
652  stemp = stemp - const + thresh
653  IF( stemp.GT.result( 4 ) )
654  $ result( 4 ) = stemp
655  k = k - 1
656 *
657  END IF
658 *
659  k = k - 1
660 *
661  GO TO 160
662  170 CONTINUE
663 *
664  ELSE
665 *
666 * Loop forward for UPLO = 'L'
667 *
668  k = 1
669  180 CONTINUE
670  IF( k.GE.n )
671  $ GO TO 190
672 *
673  IF( iwork( k ).LT.zero ) THEN
674 *
675 * Get the two singular values
676 * (real and non-negative) of a 2-by-2 block,
677 * store them in RWORK array
678 *
679  block( 1, 1 ) = afac( ( k-1 )*lda+k )
680  block( 2, 1 ) = afac( ( k-1 )*lda+k+1 )
681  block( 1, 2 ) = conjg( block( 2, 1 ) )
682  block( 2, 2 ) = afac( k*lda+k+1 )
683 *
684  CALL cgesvd( 'N', 'N', 2, 2, block, 2, rwork,
685  $ cdummy, 1, cdummy, 1,
686  $ work, 6, rwork(3), info )
687 *
688  sing_max = rwork( 1 )
689  sing_min = rwork( 2 )
690 *
691  stemp = sing_max / sing_min
692 *
693 * STEMP should be bounded by CONST
694 *
695  stemp = stemp - const + thresh
696  IF( stemp.GT.result( 4 ) )
697  $ result( 4 ) = stemp
698  k = k + 1
699 *
700  END IF
701 *
702  k = k + 1
703 *
704  GO TO 180
705  190 CONTINUE
706  END IF
707 *
708 * Print information about the tests that did not pass
709 * the threshold.
710 *
711  DO 200 k = 3, 4
712  IF( result( k ).GE.thresh ) THEN
713  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
714  $ CALL alahd( nout, path )
715  WRITE( nout, fmt = 9999 )uplo, n, nb, imat, k,
716  $ result( k )
717  nfail = nfail + 1
718  END IF
719  200 CONTINUE
720  nrun = nrun + 2
721 *
722 * Skip the other tests if this is not the first block
723 * size.
724 *
725  IF( inb.GT.1 )
726  $ GO TO 240
727 *
728 * Do only the condition estimate if INFO is not 0.
729 *
730  IF( trfcon ) THEN
731  rcondc = zero
732  GO TO 230
733  END IF
734 *
735 * Do for each value of NRHS in NSVAL.
736 *
737  DO 220 irhs = 1, nns
738  nrhs = nsval( irhs )
739 *
740 * Begin loop over NRHS values
741 *
742 *
743 *+ TEST 5 ( Using TRS_ROOK)
744 * Solve and compute residual for A * X = B.
745 *
746 * Choose a set of NRHS random solution vectors
747 * stored in XACT and set up the right hand side B
748 *
749  srnamt = 'CLARHS'
750  CALL clarhs( matpath, xtype, uplo, ' ', n, n,
751  $ kl, ku, nrhs, a, lda, xact, lda,
752  $ b, lda, iseed, info )
753  CALL clacpy( 'Full', n, nrhs, b, lda, x, lda )
754 *
755  srnamt = 'CHETRS_ROOK'
756  CALL chetrs_rook( uplo, n, nrhs, afac, lda, iwork,
757  $ x, lda, info )
758 *
759 * Check error code from CHETRS_ROOK and handle error.
760 *
761  IF( info.NE.0 )
762  $ CALL alaerh( path, 'CHETRS_ROOK', info, 0,
763  $ uplo, n, n, -1, -1, nrhs, imat,
764  $ nfail, nerrs, nout )
765 *
766  CALL clacpy( 'Full', n, nrhs, b, lda, work, lda )
767 *
768 * Compute the residual for the solution
769 *
770  CALL cpot02( uplo, n, nrhs, a, lda, x, lda, work,
771  $ lda, rwork, result( 5 ) )
772 *
773 *+ TEST 6
774 * Check solution from generated exact solution.
775 *
776  CALL cget04( n, nrhs, x, lda, xact, lda, rcondc,
777  $ result( 6 ) )
778 *
779 * Print information about the tests that did not pass
780 * the threshold.
781 *
782  DO 210 k = 5, 6
783  IF( result( k ).GE.thresh ) THEN
784  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
785  $ CALL alahd( nout, path )
786  WRITE( nout, fmt = 9998 )uplo, n, nrhs,
787  $ imat, k, result( k )
788  nfail = nfail + 1
789  END IF
790  210 CONTINUE
791  nrun = nrun + 2
792 *
793 * End do for each value of NRHS in NSVAL.
794 *
795  220 CONTINUE
796 *
797 *+ TEST 7
798 * Get an estimate of RCOND = 1/CNDNUM.
799 *
800  230 CONTINUE
801  anorm = clanhe( '1', uplo, n, a, lda, rwork )
802  srnamt = 'CHECON_ROOK'
803  CALL checon_rook( uplo, n, afac, lda, iwork, anorm,
804  $ rcond, work, info )
805 *
806 * Check error code from CHECON_ROOK and handle error.
807 *
808  IF( info.NE.0 )
809  $ CALL alaerh( path, 'CHECON_ROOK', info, 0,
810  $ uplo, n, n, -1, -1, -1, imat,
811  $ nfail, nerrs, nout )
812 *
813 * Compute the test ratio to compare values of RCOND
814 *
815  result( 7 ) = sget06( rcond, rcondc )
816 *
817 * Print information about the tests that did not pass
818 * the threshold.
819 *
820  IF( result( 7 ).GE.thresh ) THEN
821  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
822  $ CALL alahd( nout, path )
823  WRITE( nout, fmt = 9997 )uplo, n, imat, 7,
824  $ result( 7 )
825  nfail = nfail + 1
826  END IF
827  nrun = nrun + 1
828  240 CONTINUE
829 *
830  250 CONTINUE
831  260 CONTINUE
832  270 CONTINUE
833 *
834 * Print a summary of the results.
835 *
836  CALL alasum( path, nout, nfail, nrun, nerrs )
837 *
838  9999 FORMAT( ' UPLO = ''', a1, ''', N =', i5, ', NB =', i4, ', type ',
839  $ i2, ', test ', i2, ', ratio =', g12.5 )
840  9998 FORMAT( ' UPLO = ''', a1, ''', N =', i5, ', NRHS=', i3, ', type ',
841  $ i2, ', test ', i2, ', ratio =', g12.5 )
842  9997 FORMAT( ' UPLO = ''', a1, ''', N =', i5, ',', 10x, ' type ', i2,
843  $ ', test ', i2, ', ratio =', g12.5 )
844  RETURN
845 *
846 * End of CCHKHE_ROOK
847 *
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
Definition: alaerh.f:149
real function clanhe(NORM, UPLO, N, A, LDA, WORK)
CLANHE returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a complex Hermitian matrix.
Definition: clanhe.f:126
subroutine checon_rook(UPLO, N, A, LDA, IPIV, ANORM, RCOND, WORK, INFO)
CHECON_ROOK estimates the reciprocal of the condition number fort HE matrices using factorization obt...
Definition: checon_rook.f:141
subroutine clatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
CLATB4
Definition: clatb4.f:123
subroutine cget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
CGET04
Definition: cget04.f:104
real function sget06(RCOND, RCONDC)
SGET06
Definition: sget06.f:57
subroutine chetrs_rook(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
CHETRS_ROOK computes the solution to a system of linear equations A * X = B for HE matrices using fac...
Definition: chetrs_rook.f:138
subroutine clarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
CLARHS
Definition: clarhs.f:211
subroutine cgesvd(JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, WORK, LWORK, RWORK, INFO)
CGESVD computes the singular value decomposition (SVD) for GE matrices
Definition: cgesvd.f:216
subroutine chetrf_rook(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
CHETRF_ROOK computes the factorization of a complex Hermitian indefinite matrix using the bounded Bun...
Definition: chetrf_rook.f:214
subroutine alahd(IOUNIT, PATH)
ALAHD
Definition: alahd.f:95
subroutine clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
Definition: clacpy.f:105
subroutine cerrhe(PATH, NUNIT)
CERRHE
Definition: cerrhe.f:57
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
Definition: alasum.f:75
subroutine chet01_rook(UPLO, N, A, LDA, AFAC, LDAFAC, IPIV, C, LDC, RWORK, RESID)
CHET01_ROOK
Definition: chet01_rook.f:127
subroutine cpot03(UPLO, N, A, LDA, AINV, LDAINV, WORK, LDWORK, RWORK, RCOND, RESID)
CPOT03
Definition: cpot03.f:128
subroutine chetri_rook(UPLO, N, A, LDA, IPIV, WORK, INFO)
CHETRI_ROOK computes the inverse of HE matrix using the factorization obtained with the bounded Bunch...
Definition: chetri_rook.f:130
subroutine cpot02(UPLO, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
CPOT02
Definition: cpot02.f:129
real function clange(NORM, M, N, A, LDA, WORK)
CLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
Definition: clange.f:117
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
Definition: xlaenv.f:83
subroutine clatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
CLATMS
Definition: clatms.f:334

Here is the call graph for this function:

Here is the caller graph for this function:

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

CCHKHP

Purpose:
 CCHKHP tests CHPTRF, -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 COMPLEX array, dimension
                      (NMAX*(NMAX+1)/2)
[out]AFAC
          AFAC is COMPLEX array, dimension
                      (NMAX*(NMAX+1)/2)
[out]AINV
          AINV is COMPLEX array, dimension
                      (NMAX*(NMAX+1)/2)
[out]B
          B is COMPLEX array, dimension (NMAX*NSMAX)
          where NSMAX is the largest entry in NSVAL.
[out]X
          X is COMPLEX array, dimension (NMAX*NSMAX)
[out]XACT
          XACT is COMPLEX array, dimension (NMAX*NSMAX)
[out]WORK
          WORK is COMPLEX array, dimension
                      (NMAX*max(2,NSMAX))
[out]RWORK
          RWORK is REAL array,
                                 dimension (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 166 of file cchkhp.f.

166 *
167 * -- LAPACK test routine (version 3.4.0) --
168 * -- LAPACK is a software package provided by Univ. of Tennessee, --
169 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
170 * November 2011
171 *
172 * .. Scalar Arguments ..
173  LOGICAL tsterr
174  INTEGER nmax, nn, nns, nout
175  REAL thresh
176 * ..
177 * .. Array Arguments ..
178  LOGICAL dotype( * )
179  INTEGER iwork( * ), nsval( * ), nval( * )
180  REAL rwork( * )
181  COMPLEX a( * ), afac( * ), ainv( * ), b( * ),
182  $ work( * ), x( * ), xact( * )
183 * ..
184 *
185 * =====================================================================
186 *
187 * .. Parameters ..
188  REAL zero
189  parameter( zero = 0.0e+0 )
190  INTEGER ntypes
191  parameter( ntypes = 10 )
192  INTEGER ntests
193  parameter( ntests = 8 )
194 * ..
195 * .. Local Scalars ..
196  LOGICAL trfcon, zerot
197  CHARACTER dist, packit, TYPE, uplo, xtype
198  CHARACTER*3 path
199  INTEGER i, i1, i2, imat, in, info, ioff, irhs, iuplo,
200  $ izero, j, k, kl, ku, lda, mode, n, nerrs,
201  $ nfail, nimat, npp, nrhs, nrun, nt
202  REAL anorm, cndnum, rcond, rcondc
203 * ..
204 * .. Local Arrays ..
205  CHARACTER uplos( 2 )
206  INTEGER iseed( 4 ), iseedy( 4 )
207  REAL result( ntests )
208 * ..
209 * .. External Functions ..
210  LOGICAL lsame
211  REAL clanhp, sget06
212  EXTERNAL lsame, clanhp, sget06
213 * ..
214 * .. External Subroutines ..
215  EXTERNAL alaerh, alahd, alasum, ccopy, cerrsy, cget04,
218  $ cppt03, cppt05
219 * ..
220 * .. Intrinsic Functions ..
221  INTRINSIC max, min
222 * ..
223 * .. Scalars in Common ..
224  LOGICAL lerr, ok
225  CHARACTER*32 srnamt
226  INTEGER infot, nunit
227 * ..
228 * .. Common blocks ..
229  COMMON / infoc / infot, nunit, ok, lerr
230  COMMON / srnamc / srnamt
231 * ..
232 * .. Data statements ..
233  DATA iseedy / 1988, 1989, 1990, 1991 /
234  DATA uplos / 'U', 'L' /
235 * ..
236 * .. Executable Statements ..
237 *
238 * Initialize constants and the random number seed.
239 *
240  path( 1: 1 ) = 'Complex precision'
241  path( 2: 3 ) = 'HP'
242  nrun = 0
243  nfail = 0
244  nerrs = 0
245  DO 10 i = 1, 4
246  iseed( i ) = iseedy( i )
247  10 CONTINUE
248 *
249 * Test the error exits
250 *
251  IF( tsterr )
252  $ CALL cerrsy( path, nout )
253  infot = 0
254 *
255 * Do for each value of N in NVAL
256 *
257  DO 170 in = 1, nn
258  n = nval( in )
259  lda = max( n, 1 )
260  xtype = 'N'
261  nimat = ntypes
262  IF( n.LE.0 )
263  $ nimat = 1
264 *
265  izero = 0
266  DO 160 imat = 1, nimat
267 *
268 * Do the tests only if DOTYPE( IMAT ) is true.
269 *
270  IF( .NOT.dotype( imat ) )
271  $ GO TO 160
272 *
273 * Skip types 3, 4, 5, or 6 if the matrix size is too small.
274 *
275  zerot = imat.GE.3 .AND. imat.LE.6
276  IF( zerot .AND. n.LT.imat-2 )
277  $ GO TO 160
278 *
279 * Do first for UPLO = 'U', then for UPLO = 'L'
280 *
281  DO 150 iuplo = 1, 2
282  uplo = uplos( iuplo )
283  IF( lsame( uplo, 'U' ) ) THEN
284  packit = 'C'
285  ELSE
286  packit = 'R'
287  END IF
288 *
289 * Set up parameters with CLATB4 and generate a test matrix
290 * with CLATMS.
291 *
292  CALL clatb4( path, imat, n, n, TYPE, kl, ku, anorm, mode,
293  $ cndnum, dist )
294 *
295  srnamt = 'CLATMS'
296  CALL clatms( n, n, dist, iseed, TYPE, rwork, mode,
297  $ cndnum, anorm, kl, ku, packit, a, lda, work,
298  $ info )
299 *
300 * Check error code from CLATMS.
301 *
302  IF( info.NE.0 ) THEN
303  CALL alaerh( path, 'CLATMS', info, 0, uplo, n, n, -1,
304  $ -1, -1, imat, nfail, nerrs, nout )
305  GO TO 150
306  END IF
307 *
308 * For types 3-6, zero one or more rows and columns of
309 * the matrix to test that INFO is returned correctly.
310 *
311  IF( zerot ) THEN
312  IF( imat.EQ.3 ) THEN
313  izero = 1
314  ELSE IF( imat.EQ.4 ) THEN
315  izero = n
316  ELSE
317  izero = n / 2 + 1
318  END IF
319 *
320  IF( imat.LT.6 ) THEN
321 *
322 * Set row and column IZERO to zero.
323 *
324  IF( iuplo.EQ.1 ) THEN
325  ioff = ( izero-1 )*izero / 2
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 + i
333  30 CONTINUE
334  ELSE
335  ioff = izero
336  DO 40 i = 1, izero - 1
337  a( ioff ) = zero
338  ioff = ioff + n - i
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  ioff = 0
347  IF( iuplo.EQ.1 ) THEN
348 *
349 * Set the first IZERO rows and columns to zero.
350 *
351  DO 70 j = 1, n
352  i2 = min( j, izero )
353  DO 60 i = 1, i2
354  a( ioff+i ) = zero
355  60 CONTINUE
356  ioff = ioff + j
357  70 CONTINUE
358  ELSE
359 *
360 * Set the last IZERO rows and columns to zero.
361 *
362  DO 90 j = 1, n
363  i1 = max( j, izero )
364  DO 80 i = i1, n
365  a( ioff+i ) = zero
366  80 CONTINUE
367  ioff = ioff + n - j
368  90 CONTINUE
369  END IF
370  END IF
371  ELSE
372  izero = 0
373  END IF
374 *
375 * Set the imaginary part of the diagonals.
376 *
377  IF( iuplo.EQ.1 ) THEN
378  CALL claipd( n, a, 2, 1 )
379  ELSE
380  CALL claipd( n, a, n, -1 )
381  END IF
382 *
383 * Compute the L*D*L' or U*D*U' factorization of the matrix.
384 *
385  npp = n*( n+1 ) / 2
386  CALL ccopy( npp, a, 1, afac, 1 )
387  srnamt = 'CHPTRF'
388  CALL chptrf( uplo, n, afac, iwork, info )
389 *
390 * Adjust the expected value of INFO to account for
391 * pivoting.
392 *
393  k = izero
394  IF( k.GT.0 ) THEN
395  100 CONTINUE
396  IF( iwork( k ).LT.0 ) THEN
397  IF( iwork( k ).NE.-k ) THEN
398  k = -iwork( k )
399  GO TO 100
400  END IF
401  ELSE IF( iwork( k ).NE.k ) THEN
402  k = iwork( k )
403  GO TO 100
404  END IF
405  END IF
406 *
407 * Check error code from CHPTRF.
408 *
409  IF( info.NE.k )
410  $ CALL alaerh( path, 'CHPTRF', info, k, uplo, n, n, -1,
411  $ -1, -1, imat, nfail, nerrs, nout )
412  IF( info.NE.0 ) THEN
413  trfcon = .true.
414  ELSE
415  trfcon = .false.
416  END IF
417 *
418 *+ TEST 1
419 * Reconstruct matrix from factors and compute residual.
420 *
421  CALL chpt01( uplo, n, a, afac, iwork, ainv, lda, rwork,
422  $ result( 1 ) )
423  nt = 1
424 *
425 *+ TEST 2
426 * Form the inverse and compute the residual.
427 *
428  IF( .NOT.trfcon ) THEN
429  CALL ccopy( npp, afac, 1, ainv, 1 )
430  srnamt = 'CHPTRI'
431  CALL chptri( uplo, n, ainv, iwork, work, info )
432 *
433 * Check error code from CHPTRI.
434 *
435  IF( info.NE.0 )
436  $ CALL alaerh( path, 'CHPTRI', info, 0, uplo, n, n,
437  $ -1, -1, -1, imat, nfail, nerrs, nout )
438 *
439  CALL cppt03( uplo, n, a, ainv, work, lda, rwork,
440  $ rcondc, result( 2 ) )
441  nt = 2
442  END IF
443 *
444 * Print information about the tests that did not pass
445 * the threshold.
446 *
447  DO 110 k = 1, nt
448  IF( result( k ).GE.thresh ) THEN
449  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
450  $ CALL alahd( nout, path )
451  WRITE( nout, fmt = 9999 )uplo, n, imat, k,
452  $ result( k )
453  nfail = nfail + 1
454  END IF
455  110 CONTINUE
456  nrun = nrun + nt
457 *
458 * Do only the condition estimate if INFO is not 0.
459 *
460  IF( trfcon ) THEN
461  rcondc = zero
462  GO TO 140
463  END IF
464 *
465  DO 130 irhs = 1, nns
466  nrhs = nsval( irhs )
467 *
468 *+ TEST 3
469 * Solve and compute residual for A * X = B.
470 *
471  srnamt = 'CLARHS'
472  CALL clarhs( path, xtype, uplo, ' ', n, n, kl, ku,
473  $ nrhs, a, lda, xact, lda, b, lda, iseed,
474  $ info )
475  xtype = 'C'
476  CALL clacpy( 'Full', n, nrhs, b, lda, x, lda )
477 *
478  srnamt = 'CHPTRS'
479  CALL chptrs( uplo, n, nrhs, afac, iwork, x, lda,
480  $ info )
481 *
482 * Check error code from CHPTRS.
483 *
484  IF( info.NE.0 )
485  $ CALL alaerh( path, 'CHPTRS', info, 0, uplo, n, n,
486  $ -1, -1, nrhs, imat, nfail, nerrs,
487  $ nout )
488 *
489  CALL clacpy( 'Full', n, nrhs, b, lda, work, lda )
490  CALL cppt02( uplo, n, nrhs, a, x, lda, work, lda,
491  $ rwork, result( 3 ) )
492 *
493 *+ TEST 4
494 * Check solution from generated exact solution.
495 *
496  CALL cget04( n, nrhs, x, lda, xact, lda, rcondc,
497  $ result( 4 ) )
498 *
499 *+ TESTS 5, 6, and 7
500 * Use iterative refinement to improve the solution.
501 *
502  srnamt = 'CHPRFS'
503  CALL chprfs( uplo, n, nrhs, a, afac, iwork, b, lda, x,
504  $ lda, rwork, rwork( nrhs+1 ), work,
505  $ rwork( 2*nrhs+1 ), info )
506 *
507 * Check error code from CHPRFS.
508 *
509  IF( info.NE.0 )
510  $ CALL alaerh( path, 'CHPRFS', info, 0, uplo, n, n,
511  $ -1, -1, nrhs, imat, nfail, nerrs,
512  $ nout )
513 *
514  CALL cget04( n, nrhs, x, lda, xact, lda, rcondc,
515  $ result( 5 ) )
516  CALL cppt05( uplo, n, nrhs, a, b, lda, x, lda, xact,
517  $ lda, rwork, rwork( nrhs+1 ),
518  $ result( 6 ) )
519 *
520 * Print information about the tests that did not pass
521 * the threshold.
522 *
523  DO 120 k = 3, 7
524  IF( result( k ).GE.thresh ) THEN
525  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
526  $ CALL alahd( nout, path )
527  WRITE( nout, fmt = 9998 )uplo, n, nrhs, imat,
528  $ k, result( k )
529  nfail = nfail + 1
530  END IF
531  120 CONTINUE
532  nrun = nrun + 5
533  130 CONTINUE
534 *
535 *+ TEST 8
536 * Get an estimate of RCOND = 1/CNDNUM.
537 *
538  140 CONTINUE
539  anorm = clanhp( '1', uplo, n, a, rwork )
540  srnamt = 'CHPCON'
541  CALL chpcon( uplo, n, afac, iwork, anorm, rcond, work,
542  $ info )
543 *
544 * Check error code from CHPCON.
545 *
546  IF( info.NE.0 )
547  $ CALL alaerh( path, 'CHPCON', info, 0, uplo, n, n, -1,
548  $ -1, -1, imat, nfail, nerrs, nout )
549 *
550  result( 8 ) = sget06( rcond, rcondc )
551 *
552 * Print the test ratio if it is .GE. THRESH.
553 *
554  IF( result( 8 ).GE.thresh ) THEN
555  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
556  $ CALL alahd( nout, path )
557  WRITE( nout, fmt = 9999 )uplo, n, imat, 8,
558  $ result( 8 )
559  nfail = nfail + 1
560  END IF
561  nrun = nrun + 1
562  150 CONTINUE
563  160 CONTINUE
564  170 CONTINUE
565 *
566 * Print a summary of the results.
567 *
568  CALL alasum( path, nout, nfail, nrun, nerrs )
569 *
570  9999 FORMAT( ' UPLO = ''', a1, ''', N =', i5, ', type ', i2, ', test ',
571  $ i2, ', ratio =', g12.5 )
572  9998 FORMAT( ' UPLO = ''', a1, ''', N =', i5, ', NRHS=', i3, ', type ',
573  $ i2, ', test(', i2, ') =', g12.5 )
574  RETURN
575 *
576 * End of CCHKHP
577 *
subroutine chpt01(UPLO, N, A, AFAC, IPIV, C, LDC, RWORK, RESID)
CHPT01
Definition: chpt01.f:115
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
Definition: alaerh.f:149
real function clanhp(NORM, UPLO, N, AP, WORK)
CLANHP returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a complex Hermitian matrix supplied in packed form.
Definition: clanhp.f:119
subroutine cppt05(UPLO, N, NRHS, AP, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
CPPT05
Definition: cppt05.f:159
subroutine chptri(UPLO, N, AP, IPIV, WORK, INFO)
CHPTRI
Definition: chptri.f:111
subroutine claipd(N, A, INDA, VINDA)
CLAIPD
Definition: claipd.f:85
subroutine clatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
CLATB4
Definition: clatb4.f:123
subroutine cget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
CGET04
Definition: cget04.f:104
real function sget06(RCOND, RCONDC)
SGET06
Definition: sget06.f:57
subroutine clarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
CLARHS
Definition: clarhs.f:211
subroutine chprfs(UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
CHPRFS
Definition: chprfs.f:182
subroutine chpcon(UPLO, N, AP, IPIV, ANORM, RCOND, WORK, INFO)
CHPCON
Definition: chpcon.f:120
subroutine alahd(IOUNIT, PATH)
ALAHD
Definition: alahd.f:95
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:55
subroutine clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
Definition: clacpy.f:105
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
Definition: alasum.f:75
subroutine ccopy(N, CX, INCX, CY, INCY)
CCOPY
Definition: ccopy.f:52
subroutine cppt02(UPLO, N, NRHS, A, X, LDX, B, LDB, RWORK, RESID)
CPPT02
Definition: cppt02.f:125
subroutine cppt03(UPLO, N, A, AINV, WORK, LDWORK, RWORK, RCOND, RESID)
CPPT03
Definition: cppt03.f:112
subroutine chptrf(UPLO, N, AP, IPIV, INFO)
CHPTRF
Definition: chptrf.f:161
subroutine clatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
CLATMS
Definition: clatms.f:334
subroutine chptrs(UPLO, N, NRHS, AP, IPIV, B, LDB, INFO)
CHPTRS
Definition: chptrs.f:117
subroutine cerrsy(PATH, NUNIT)
CERRSY
Definition: cerrsy.f:57

Here is the call graph for this function:

Here is the caller graph for this function:

subroutine cchklq ( 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,
complex, dimension( * )  A,
complex, dimension( * )  AF,
complex, dimension( * )  AQ,
complex, dimension( * )  AL,
complex, dimension( * )  AC,
complex, dimension( * )  B,
complex, dimension( * )  X,
complex, dimension( * )  XACT,
complex, dimension( * )  TAU,
complex, dimension( * )  WORK,
real, dimension( * )  RWORK,
integer  NOUT 
)

CCHKLQ

Purpose:
 CCHKLQ tests CGELQF, CUNGLQ and CUNMLQ.
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 COMPLEX array, dimension (NMAX*NMAX)
[out]AF
          AF is COMPLEX array, dimension (NMAX*NMAX)
[out]AQ
          AQ is COMPLEX array, dimension (NMAX*NMAX)
[out]AL
          AL is COMPLEX array, dimension (NMAX*NMAX)
[out]AC
          AC is COMPLEX array, dimension (NMAX*NMAX)
[out]B
          B is COMPLEX array, dimension (NMAX*NRHS)
[out]X
          X is COMPLEX array, dimension (NMAX*NRHS)
[out]XACT
          XACT is COMPLEX array, dimension (NMAX*NRHS)
[out]TAU
          TAU is COMPLEX array, dimension (NMAX)
[out]WORK
          WORK is COMPLEX 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 cchklq.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 rwork( * )
214  COMPLEX a( * ), ac( * ), af( * ), al( * ), aq( * ),
215  $ b( * ), tau( * ), work( * ), 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, cerrlq, cgelqs, cget02,
243  $ clqt03, 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 ) = 'Complex 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 cerrlq( 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 CLATB4 and generate a test matrix
301 * with CLATMS.
302 *
303  CALL clatb4( path, imat, m, n, TYPE, kl, ku, anorm, mode,
304  $ cndnum, dist )
305 *
306  srnamt = 'CLATMS'
307  CALL clatms( 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 CLATMS.
312 *
313  IF( info.NE.0 ) THEN
314  CALL alaerh( path, 'CLATMS', 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 CLQT01; other values are
321 * used in the calls of CLQT02, 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 CGELQF
356 *
357  CALL clqt01( m, n, a, af, aq, al, lda, tau,
358  $ work, lwork, rwork, result( 1 ) )
359  ELSE IF( m.LE.n ) THEN
360 *
361 * Test CUNGLQ, using factorization
362 * returned by CLQT01
363 *
364  CALL clqt02( 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 CUNMLQ, using factorization returned
370 * by CLQT01
371 *
372  CALL clqt03( 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 CGELQS 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 = 'CLARHS'
386  CALL clarhs( path, 'New', 'Full',
387  $ 'No transpose', m, n, 0, 0,
388  $ nrhs, a, lda, xact, lda, b, lda,
389  $ iseed, info )
390 *
391  CALL clacpy( 'Full', m, nrhs, b, lda, x,
392  $ lda )
393  srnamt = 'CGELQS'
394  CALL cgelqs( m, n, nrhs, af, lda, tau, x,
395  $ lda, work, lwork, info )
396 *
397 * Check error code from CGELQS.
398 *
399  IF( info.NE.0 )
400  $ CALL alaerh( path, 'CGELQS', info, 0, ' ',
401  $ m, n, nrhs, -1, nb, imat,
402  $ nfail, nerrs, nout )
403 *
404  CALL cget02( '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 CCHKLQ
439 *
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
Definition: alaerh.f:149
subroutine cget02(TRANS, M, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
CGET02
Definition: cget02.f:135
subroutine cerrlq(PATH, NUNIT)
CERRLQ
Definition: cerrlq.f:57
subroutine clqt02(M, N, K, A, AF, Q, L, LDA, TAU, WORK, LWORK, RWORK, RESULT)
CLQT02
Definition: clqt02.f:137
subroutine clqt01(M, N, A, AF, Q, L, LDA, TAU, WORK, LWORK, RWORK, RESULT)
CLQT01
Definition: clqt01.f:128
subroutine clatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
CLATB4
Definition: clatb4.f:123
subroutine clqt03(M, N, K, AF, C, CC, Q, LDA, TAU, WORK, LWORK, RWORK, RESULT)
CLQT03
Definition: clqt03.f:138
subroutine clarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
CLARHS
Definition: clarhs.f:211
subroutine cgelqs(M, N, NRHS, A, LDA, TAU, B, LDB, WORK, LWORK, INFO)
CGELQS
Definition: cgelqs.f:123
subroutine alahd(IOUNIT, PATH)
ALAHD
Definition: alahd.f:95
subroutine clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
Definition: clacpy.f:105
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
Definition: alasum.f:75
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
Definition: xlaenv.f:83
subroutine clatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
CLATMS
Definition: clatms.f:334

Here is the call graph for this function:

Here is the caller graph for this function:

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

CCHKPB

Purpose:
 CCHKPB tests CPBTRF, -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))
[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 170 of file cchkpb.f.

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

Here is the call graph for this function:

Here is the caller graph for this function:

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

CCHKPO

Purpose:
 CCHKPO tests CPOTRF, -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 COMPLEX array, dimension (NMAX*NMAX)
[out]AFAC
          AFAC is COMPLEX array, dimension (NMAX*NMAX)
[out]AINV
          AINV is COMPLEX array, dimension (NMAX*NMAX)
[out]B
          B is COMPLEX array, dimension (NMAX*NSMAX)
          where NSMAX is the largest entry in NSVAL.
[out]X
          X is COMPLEX array, dimension (NMAX*NSMAX)
[out]XACT
          XACT is COMPLEX array, dimension (NMAX*NSMAX)
[out]WORK
          WORK is COMPLEX array, dimension
                      (NMAX*max(3,NSMAX))
[out]RWORK
          RWORK is REAL array, dimension
                      (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 170 of file cchkpo.f.

170 *
171 * -- LAPACK test routine (version 3.4.0) --
172 * -- LAPACK is a software package provided by Univ. of Tennessee, --
173 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
174 * November 2011
175 *
176 * .. Scalar Arguments ..
177  LOGICAL tsterr
178  INTEGER nmax, nn, nnb, nns, nout
179  REAL thresh
180 * ..
181 * .. Array Arguments ..
182  LOGICAL dotype( * )
183  INTEGER nbval( * ), nsval( * ), nval( * )
184  REAL rwork( * )
185  COMPLEX a( * ), afac( * ), ainv( * ), b( * ),
186  $ work( * ), x( * ), xact( * )
187 * ..
188 *
189 * =====================================================================
190 *
191 * .. Parameters ..
192  COMPLEX czero
193  parameter( czero = ( 0.0e+0, 0.0e+0 ) )
194  INTEGER ntypes
195  parameter( ntypes = 9 )
196  INTEGER ntests
197  parameter( ntests = 8 )
198 * ..
199 * .. Local Scalars ..
200  LOGICAL zerot
201  CHARACTER dist, TYPE, uplo, xtype
202  CHARACTER*3 path
203  INTEGER i, imat, in, inb, info, ioff, irhs, iuplo,
204  $ izero, k, kl, ku, lda, mode, n, nb, nerrs,
205  $ nfail, nimat, nrhs, nrun
206  REAL anorm, cndnum, rcond, rcondc
207 * ..
208 * .. Local Arrays ..
209  CHARACTER uplos( 2 )
210  INTEGER iseed( 4 ), iseedy( 4 )
211  REAL result( ntests )
212 * ..
213 * .. External Functions ..
214  REAL clanhe, sget06
215  EXTERNAL clanhe, sget06
216 * ..
217 * .. External Subroutines ..
218  EXTERNAL alaerh, alahd, alasum, cerrpo, cget04, clacpy,
221  $ cpotrs, xlaenv
222 * ..
223 * .. Scalars in Common ..
224  LOGICAL lerr, ok
225  CHARACTER*32 srnamt
226  INTEGER infot, nunit
227 * ..
228 * .. Common blocks ..
229  COMMON / infoc / infot, nunit, ok, lerr
230  COMMON / srnamc / srnamt
231 * ..
232 * .. Intrinsic Functions ..
233  INTRINSIC max
234 * ..
235 * .. Data statements ..
236  DATA iseedy / 1988, 1989, 1990, 1991 /
237  DATA uplos / 'U', 'L' /
238 * ..
239 * .. Executable Statements ..
240 *
241 * Initialize constants and the random number seed.
242 *
243  path( 1: 1 ) = 'Complex precision'
244  path( 2: 3 ) = 'PO'
245  nrun = 0
246  nfail = 0
247  nerrs = 0
248  DO 10 i = 1, 4
249  iseed( i ) = iseedy( i )
250  10 CONTINUE
251 *
252 * Test the error exits
253 *
254  IF( tsterr )
255  $ CALL cerrpo( path, nout )
256  infot = 0
257 *
258 * Do for each value of N in NVAL
259 *
260  DO 120 in = 1, nn
261  n = nval( in )
262  lda = max( n, 1 )
263  xtype = 'N'
264  nimat = ntypes
265  IF( n.LE.0 )
266  $ nimat = 1
267 *
268  izero = 0
269  DO 110 imat = 1, nimat
270 *
271 * Do the tests only if DOTYPE( IMAT ) is true.
272 *
273  IF( .NOT.dotype( imat ) )
274  $ GO TO 110
275 *
276 * Skip types 3, 4, or 5 if the matrix size is too small.
277 *
278  zerot = imat.GE.3 .AND. imat.LE.5
279  IF( zerot .AND. n.LT.imat-2 )
280  $ GO TO 110
281 *
282 * Do first for UPLO = 'U', then for UPLO = 'L'
283 *
284  DO 100 iuplo = 1, 2
285  uplo = uplos( iuplo )
286 *
287 * Set up parameters with CLATB4 and generate a test matrix
288 * with CLATMS.
289 *
290  CALL clatb4( path, imat, n, n, TYPE, kl, ku, anorm, mode,
291  $ cndnum, dist )
292 *
293  srnamt = 'CLATMS'
294  CALL clatms( n, n, dist, iseed, TYPE, rwork, mode,
295  $ cndnum, anorm, kl, ku, uplo, a, lda, work,
296  $ info )
297 *
298 * Check error code from CLATMS.
299 *
300  IF( info.NE.0 ) THEN
301  CALL alaerh( path, 'CLATMS', info, 0, uplo, n, n, -1,
302  $ -1, -1, imat, nfail, nerrs, nout )
303  GO TO 100
304  END IF
305 *
306 * For types 3-5, zero one row and column of the matrix to
307 * test that INFO is returned correctly.
308 *
309  IF( zerot ) THEN
310  IF( imat.EQ.3 ) THEN
311  izero = 1
312  ELSE IF( imat.EQ.4 ) THEN
313  izero = n
314  ELSE
315  izero = n / 2 + 1
316  END IF
317  ioff = ( izero-1 )*lda
318 *
319 * Set row and column IZERO of A to 0.
320 *
321  IF( iuplo.EQ.1 ) THEN
322  DO 20 i = 1, izero - 1
323  a( ioff+i ) = czero
324  20 CONTINUE
325  ioff = ioff + izero
326  DO 30 i = izero, n
327  a( ioff ) = czero
328  ioff = ioff + lda
329  30 CONTINUE
330  ELSE
331  ioff = izero
332  DO 40 i = 1, izero - 1
333  a( ioff ) = czero
334  ioff = ioff + lda
335  40 CONTINUE
336  ioff = ioff - izero
337  DO 50 i = izero, n
338  a( ioff+i ) = czero
339  50 CONTINUE
340  END IF
341  ELSE
342  izero = 0
343  END IF
344 *
345 * Set the imaginary part of the diagonals.
346 *
347  CALL claipd( n, a, lda+1, 0 )
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 clacpy( uplo, n, n, a, lda, afac, lda )
358  srnamt = 'CPOTRF'
359  CALL cpotrf( uplo, n, afac, lda, info )
360 *
361 * Check error code from CPOTRF.
362 *
363  IF( info.NE.izero ) THEN
364  CALL alaerh( path, 'CPOTRF', 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 clacpy( uplo, n, n, afac, lda, ainv, lda )
379  CALL cpot01( 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 clacpy( uplo, n, n, afac, lda, ainv, lda )
386  srnamt = 'CPOTRI'
387  CALL cpotri( uplo, n, ainv, lda, info )
388 *
389 * Check error code from CPOTRI.
390 *
391  IF( info.NE.0 )
392  $ CALL alaerh( path, 'CPOTRI', info, 0, uplo, n, n,
393  $ -1, -1, -1, imat, nfail, nerrs, nout )
394 *
395  CALL cpot03( 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 = 'CLARHS'
425  CALL clarhs( path, xtype, uplo, ' ', n, n, kl, ku,
426  $ nrhs, a, lda, xact, lda, b, lda,
427  $ iseed, info )
428  CALL clacpy( 'Full', n, nrhs, b, lda, x, lda )
429 *
430  srnamt = 'CPOTRS'
431  CALL cpotrs( uplo, n, nrhs, afac, lda, x, lda,
432  $ info )
433 *
434 * Check error code from CPOTRS.
435 *
436  IF( info.NE.0 )
437  $ CALL alaerh( path, 'CPOTRS', info, 0, uplo, n,
438  $ n, -1, -1, nrhs, imat, nfail,
439  $ nerrs, nout )
440 *
441  CALL clacpy( 'Full', n, nrhs, b, lda, work, lda )
442  CALL cpot02( 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 cget04( 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 = 'CPORFS'
455  CALL cporfs( uplo, n, nrhs, a, lda, afac, lda, b,
456  $ lda, x, lda, rwork, rwork( nrhs+1 ),
457  $ work, rwork( 2*nrhs+1 ), info )
458 *
459 * Check error code from CPORFS.
460 *
461  IF( info.NE.0 )
462  $ CALL alaerh( path, 'CPORFS', info, 0, uplo, n,
463  $ n, -1, -1, nrhs, imat, nfail,
464  $ nerrs, nout )
465 *
466  CALL cget04( n, nrhs, x, lda, xact, lda, rcondc,
467  $ result( 5 ) )
468  CALL cpot05( 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 = clanhe( '1', uplo, n, a, lda, rwork )
491  srnamt = 'CPOCON'
492  CALL cpocon( uplo, n, afac, lda, anorm, rcond, work,
493  $ rwork, info )
494 *
495 * Check error code from CPOCON.
496 *
497  IF( info.NE.0 )
498  $ CALL alaerh( path, 'CPOCON', 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 CCHKPO
531 *
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
Definition: alaerh.f:149
real function clanhe(NORM, UPLO, N, A, LDA, WORK)
CLANHE returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a complex Hermitian matrix.
Definition: clanhe.f:126
subroutine cpot05(UPLO, N, NRHS, A, LDA, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
CPOT05
Definition: cpot05.f:167
subroutine claipd(N, A, INDA, VINDA)
CLAIPD
Definition: claipd.f:85
subroutine clatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
CLATB4
Definition: clatb4.f:123
subroutine cget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
CGET04
Definition: cget04.f:104
subroutine cerrpo(PATH, NUNIT)
CERRPO
Definition: cerrpo.f:57
real function sget06(RCOND, RCONDC)
SGET06
Definition: sget06.f:57
subroutine clarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
CLARHS
Definition: clarhs.f:211
subroutine alahd(IOUNIT, PATH)
ALAHD
Definition: alahd.f:95
subroutine clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
Definition: clacpy.f:105
subroutine cpotrs(UPLO, N, NRHS, A, LDA, B, LDB, INFO)
CPOTRS
Definition: cpotrs.f:112
subroutine cpotrf(UPLO, N, A, LDA, INFO)
CPOTRF
Definition: cpotrf.f:109
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
Definition: alasum.f:75
subroutine cpotri(UPLO, N, A, LDA, INFO)
CPOTRI
Definition: cpotri.f:97
subroutine cpot03(UPLO, N, A, LDA, AINV, LDAINV, WORK, LDWORK, RWORK, RCOND, RESID)
CPOT03
Definition: cpot03.f:128
subroutine cpot02(UPLO, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
CPOT02
Definition: cpot02.f:129
subroutine cpot01(UPLO, N, A, LDA, AFAC, LDAFAC, RWORK, RESID)
CPOT01
Definition: cpot01.f:108
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
Definition: xlaenv.f:83
subroutine clatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
CLATMS
Definition: clatms.f:334
subroutine cporfs(UPLO, N, NRHS, A, LDA, AF, LDAF, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
CPORFS
Definition: cporfs.f:185
subroutine cpocon(UPLO, N, A, LDA, ANORM, RCOND, WORK, RWORK, INFO)
CPOCON
Definition: cpocon.f:123

Here is the call graph for this function:

Here is the caller graph for this function:

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

CCHKPP

Purpose:
 CCHKPP tests CPPTRF, -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 COMPLEX array, dimension
                      (NMAX*(NMAX+1)/2)
[out]AFAC
          AFAC is COMPLEX array, dimension
                      (NMAX*(NMAX+1)/2)
[out]AINV
          AINV is COMPLEX array, dimension
                      (NMAX*(NMAX+1)/2)
[out]B
          B is COMPLEX array, dimension (NMAX*NSMAX)
          where NSMAX is the largest entry in NSVAL.
[out]X
          X is COMPLEX array, dimension (NMAX*NSMAX)
[out]XACT
          XACT is COMPLEX array, dimension (NMAX*NSMAX)
[out]WORK
          WORK is COMPLEX 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 161 of file cchkpp.f.

161 *
162 * -- LAPACK test routine (version 3.4.0) --
163 * -- LAPACK is a software package provided by Univ. of Tennessee, --
164 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
165 * November 2011
166 *
167 * .. Scalar Arguments ..
168  LOGICAL tsterr
169  INTEGER nmax, nn, nns, nout
170  REAL thresh
171 * ..
172 * .. Array Arguments ..
173  LOGICAL dotype( * )
174  INTEGER nsval( * ), nval( * )
175  REAL rwork( * )
176  COMPLEX a( * ), afac( * ), ainv( * ), b( * ),
177  $ work( * ), x( * ), xact( * )
178 * ..
179 *
180 * =====================================================================
181 *
182 * .. Parameters ..
183  REAL zero
184  parameter( zero = 0.0e+0 )
185  INTEGER ntypes
186  parameter( ntypes = 9 )
187  INTEGER ntests
188  parameter( ntests = 8 )
189 * ..
190 * .. Local Scalars ..
191  LOGICAL zerot
192  CHARACTER dist, packit, TYPE, uplo, xtype
193  CHARACTER*3 path
194  INTEGER i, imat, in, info, ioff, irhs, iuplo, izero, k,
195  $ kl, ku, lda, mode, n, nerrs, nfail, nimat, npp,
196  $ nrhs, nrun
197  REAL anorm, cndnum, rcond, rcondc
198 * ..
199 * .. Local Arrays ..
200  CHARACTER packs( 2 ), uplos( 2 )
201  INTEGER iseed( 4 ), iseedy( 4 )
202  REAL result( ntests )
203 * ..
204 * .. External Functions ..
205  REAL clanhp, sget06
206  EXTERNAL clanhp, sget06
207 * ..
208 * .. External Subroutines ..
209  EXTERNAL alaerh, alahd, alasum, ccopy, cerrpo, cget04,
210  $ clacpy, claipd, clarhs,