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

Functions

program zchkaa
 ZCHKAA More...
 
program zchkab
 ZCHKAB More...
 
subroutine zchkeq (THRESH, NOUT)
 ZCHKEQ More...
 
subroutine zchkgb (DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NNS, NSVAL, THRESH, TSTERR, A, LA, AFAC, LAFAC, B, X, XACT, WORK, RWORK, IWORK, NOUT)
 ZCHKGB More...
 
subroutine zchkge (DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NNS, NSVAL, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
 ZCHKGE More...
 
subroutine zchkgt (DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR, A, AF, B, X, XACT, WORK, RWORK, IWORK, NOUT)
 ZCHKGT More...
 
subroutine zchkhe (DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
 ZCHKHE More...
 
subroutine zchkhe_rook (DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
 ZCHKHE_ROOK More...
 
subroutine zchkhp (DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
 ZCHKHP More...
 
subroutine zchklq (DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL, NRHS, THRESH, TSTERR, NMAX, A, AF, AQ, AL, AC, B, X, XACT, TAU, WORK, RWORK, NOUT)
 ZCHKLQ More...
 
subroutine zchkpb (DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, NOUT)
 ZCHKPB More...
 
subroutine zchkpo (DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, NOUT)
 ZCHKPO More...
 
subroutine zchkpp (DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, NOUT)
 ZCHKPP More...
 
subroutine zchkps (DOTYPE, NN, NVAL, NNB, NBVAL, NRANK, RANKVAL, THRESH, TSTERR, NMAX, A, AFAC, PERM, PIV, WORK, RWORK, NOUT)
 ZCHKPS More...
 
subroutine zchkpt (DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR, A, D, E, B, X, XACT, WORK, RWORK, NOUT)
 ZCHKPT More...
 
subroutine zchkq3 (DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL, THRESH, A, COPYA, S, TAU, WORK, RWORK, IWORK, NOUT)
 ZCHKQ3 More...
 
subroutine zchkql (DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL, NRHS, THRESH, TSTERR, NMAX, A, AF, AQ, AL, AC, B, X, XACT, TAU, WORK, RWORK, NOUT)
 ZCHKQL More...
 
subroutine zchkqr (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)
 ZCHKQR More...
 
subroutine zchkqrt (THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, NBVAL, NOUT)
 ZCHKQRT More...
 
subroutine zchkqrtp (THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, NBVAL, NOUT)
 ZCHKQRTP More...
 
program zchkrfp
 ZCHKRFP More...
 
subroutine zchkrq (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)
 ZCHKRQ More...
 
subroutine zchksp (DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
 ZCHKSP More...
 
subroutine zchksy (DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
 ZCHKSY More...
 
subroutine zchksy_rook (DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
 ZCHKSY_ROOK More...
 
subroutine zchktb (DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR, NMAX, AB, AINV, B, X, XACT, WORK, RWORK, NOUT)
 ZCHKTB More...
 
subroutine zchktp (DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR, NMAX, AP, AINVP, B, X, XACT, WORK, RWORK, NOUT)
 ZCHKTP More...
 
subroutine zchktr (DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL, THRESH, TSTERR, NMAX, A, AINV, B, X, XACT, WORK, RWORK, NOUT)
 ZCHKTR More...
 
subroutine zchktz (DOTYPE, NM, MVAL, NN, NVAL, THRESH, TSTERR, A, COPYA, S, TAU, WORK, RWORK, NOUT)
 ZCHKTZ More...
 
subroutine zdrvab (DOTYPE, NM, MVAL, NNS, NSVAL, THRESH, NMAX, A, AFAC, B, X, WORK, RWORK, SWORK, IWORK, NOUT)
 ZDRVAB More...
 
subroutine zdrvac (DOTYPE, NM, MVAL, NNS, NSVAL, THRESH, NMAX, A, AFAC, B, X, WORK, RWORK, SWORK, NOUT)
 ZDRVAC More...
 
subroutine zdrvgb (DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, A, LA, AFB, LAFB, ASAV, B, BSAV, X, XACT, S, WORK, RWORK, IWORK, NOUT)
 ZDRVGB More...
 
subroutine zdrvge (DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX, A, AFAC, ASAV, B, BSAV, X, XACT, S, WORK, RWORK, IWORK, NOUT)
 ZDRVGE More...
 
subroutine zdrvgt (DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, A, AF, B, X, XACT, WORK, RWORK, IWORK, NOUT)
 ZDRVGT More...
 
subroutine zdrvhe (DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
 ZDRVHE More...
 
subroutine zdrvhe_rook (DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
 ZDRVHE_ROOK More...
 
subroutine zdrvhp (DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
 ZDRVHP More...
 
subroutine zdrvls (DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL, NNB, NBVAL, NXVAL, THRESH, TSTERR, A, COPYA, B, COPYB, C, S, COPYS, WORK, RWORK, IWORK, NOUT)
 ZDRVLS More...
 
subroutine zdrvpb (DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX, A, AFAC, ASAV, B, BSAV, X, XACT, S, WORK, RWORK, NOUT)
 ZDRVPB More...
 
subroutine zdrvpo (DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX, A, AFAC, ASAV, B, BSAV, X, XACT, S, WORK, RWORK, NOUT)
 ZDRVPO More...
 
subroutine zdrvpp (DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX, A, AFAC, ASAV, B, BSAV, X, XACT, S, WORK, RWORK, NOUT)
 ZDRVPP More...
 
subroutine zdrvpt (DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, A, D, E, B, X, XACT, WORK, RWORK, NOUT)
 ZDRVPT More...
 
subroutine zdrvrf1 (NOUT, NN, NVAL, THRESH, A, LDA, ARF, WORK)
 ZDRVRF1 More...
 
subroutine zdrvrf2 (NOUT, NN, NVAL, A, LDA, ARF, AP, ASAV)
 ZDRVRF2 More...
 
subroutine zdrvrf3 (NOUT, NN, NVAL, THRESH, A, LDA, ARF, B1, B2, D_WORK_ZLANGE, Z_WORK_ZGEQRF, TAU)
 ZDRVRF3 More...
 
subroutine zdrvrf4 (NOUT, NN, NVAL, THRESH, C1, C2, LDC, CRF, A, LDA, D_WORK_ZLANGE)
 ZDRVRF4 More...
 
subroutine zdrvrfp (NOUT, NN, NVAL, NNS, NSVAL, NNT, NTVAL, THRESH, A, ASAV, AFAC, AINV, B, BSAV, XACT, X, ARF, ARFINV, Z_WORK_ZLATMS, Z_WORK_ZPOT02, Z_WORK_ZPOT03, D_WORK_ZLATMS, D_WORK_ZLANHE, D_WORK_ZPOT01, D_WORK_ZPOT02, D_WORK_ZPOT03)
 ZDRVRFP More...
 
subroutine zdrvsp (DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
 ZDRVSP More...
 
subroutine zdrvsy (DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
 ZDRVSY More...
 
subroutine zdrvsy_rook (DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
 ZDRVSY_ROOK More...
 
subroutine zebchvxx (THRESH, PATH)
 ZEBCHVXX More...
 
subroutine zerrab (NUNIT)
 ZERRAB More...
 
subroutine zerrac (NUNIT)
 ZERRAC More...
 
subroutine zerrge (PATH, NUNIT)
 ZERRGE More...
 
subroutine zerrgt (PATH, NUNIT)
 ZERRGT More...
 
subroutine zerrhe (PATH, NUNIT)
 ZERRHE More...
 
subroutine zerrlq (PATH, NUNIT)
 ZERRLQ More...
 
subroutine zerrls (PATH, NUNIT)
 ZERRLS More...
 
subroutine zerrpo (PATH, NUNIT)
 ZERRPO More...
 
subroutine zerrps (PATH, NUNIT)
 ZERRPS More...
 
subroutine zerrql (PATH, NUNIT)
 ZERRQL More...
 
subroutine zerrqp (PATH, NUNIT)
 ZERRQP More...
 
subroutine zerrqr (PATH, NUNIT)
 ZERRQR More...
 
subroutine zerrqrt (PATH, NUNIT)
 ZERRQRT More...
 
subroutine zerrqrtp (PATH, NUNIT)
 ZERRQRTP More...
 
subroutine zerrrfp (NUNIT)
 ZERRRFP More...
 
subroutine zerrrq (PATH, NUNIT)
 ZERRRQ More...
 
subroutine zerrsy (PATH, NUNIT)
 ZERRSY More...
 
subroutine zerrtr (PATH, NUNIT)
 ZERRTR More...
 
subroutine zerrtz (PATH, NUNIT)
 ZERRTZ More...
 
subroutine zerrvx (PATH, NUNIT)
 ZERRVX More...
 
subroutine zgbt01 (M, N, KL, KU, A, LDA, AFAC, LDAFAC, IPIV, WORK, RESID)
 ZGBT01 More...
 
subroutine zgbt02 (TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, RESID)
 ZGBT02 More...
 
subroutine zgbt05 (TRANS, N, KL, KU, NRHS, AB, LDAB, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
 ZGBT05 More...
 
subroutine zgelqs (M, N, NRHS, A, LDA, TAU, B, LDB, WORK, LWORK, INFO)
 ZGELQS More...
 
logical function zgennd (M, N, A, LDA)
 ZGENND More...
 
subroutine zgeqls (M, N, NRHS, A, LDA, TAU, B, LDB, WORK, LWORK, INFO)
 ZGEQLS More...
 
subroutine zgeqrs (M, N, NRHS, A, LDA, TAU, B, LDB, WORK, LWORK, INFO)
 ZGEQRS More...
 
subroutine zgerqs (M, N, NRHS, A, LDA, TAU, B, LDB, WORK, LWORK, INFO)
 ZGERQS More...
 
subroutine zget01 (M, N, A, LDA, AFAC, LDAFAC, IPIV, RWORK, RESID)
 ZGET01 More...
 
subroutine zget02 (TRANS, M, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
 ZGET02 More...
 
subroutine zget03 (N, A, LDA, AINV, LDAINV, WORK, LDWORK, RWORK, RCOND, RESID)
 ZGET03 More...
 
subroutine zget04 (N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
 ZGET04 More...
 
subroutine zget07 (TRANS, N, NRHS, A, LDA, B, LDB, X, LDX, XACT, LDXACT, FERR, CHKFERR, BERR, RESLTS)
 ZGET07 More...
 
subroutine zget08 (TRANS, M, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
 ZGET08 More...
 
subroutine zgtt01 (N, DL, D, DU, DLF, DF, DUF, DU2, IPIV, WORK, LDWORK, RWORK, RESID)
 ZGTT01 More...
 
subroutine zgtt02 (TRANS, N, NRHS, DL, D, DU, X, LDX, B, LDB, RESID)
 ZGTT02 More...
 
subroutine zgtt05 (TRANS, N, NRHS, DL, D, DU, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
 ZGTT05 More...
 
subroutine zhet01 (UPLO, N, A, LDA, AFAC, LDAFAC, IPIV, C, LDC, RWORK, RESID)
 ZHET01 More...
 
subroutine zhet01_rook (UPLO, N, A, LDA, AFAC, LDAFAC, IPIV, C, LDC, RWORK, RESID)
 ZHET01_ROOK More...
 
subroutine zhpt01 (UPLO, N, A, AFAC, IPIV, C, LDC, RWORK, RESID)
 ZHPT01 More...
 
subroutine zlahilb (N, NRHS, A, LDA, X, LDX, B, LDB, WORK, INFO, PATH)
 ZLAHILB More...
 
subroutine zlaipd (N, A, INDA, VINDA)
 ZLAIPD More...
 
subroutine zlaptm (UPLO, N, NRHS, ALPHA, D, E, X, LDX, BETA, B, LDB)
 ZLAPTM More...
 
subroutine zlarhs (PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
 ZLARHS More...
 
subroutine zlatb4 (PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
 ZLATB4 More...
 
subroutine zlatb5 (PATH, IMAT, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
 ZLATB5 More...
 
subroutine zlatsp (UPLO, N, X, ISEED)
 ZLATSP More...
 
subroutine zlatsy (UPLO, N, X, LDX, ISEED)
 ZLATSY More...
 
subroutine zlattb (IMAT, UPLO, TRANS, DIAG, ISEED, N, KD, AB, LDAB, B, WORK, RWORK, INFO)
 ZLATTB More...
 
subroutine zlattp (IMAT, UPLO, TRANS, DIAG, ISEED, N, AP, B, WORK, RWORK, INFO)
 ZLATTP More...
 
subroutine zlattr (IMAT, UPLO, TRANS, DIAG, ISEED, N, A, LDA, B, WORK, RWORK, INFO)
 ZLATTR More...
 
subroutine zlavhe (UPLO, TRANS, DIAG, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
 ZLAVHE More...
 
subroutine zlavhe_rook (UPLO, TRANS, DIAG, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
 ZLAVHE_ROOK More...
 
subroutine zlavhp (UPLO, TRANS, DIAG, N, NRHS, A, IPIV, B, LDB, INFO)
 ZLAVHP More...
 
subroutine zlavsp (UPLO, TRANS, DIAG, N, NRHS, A, IPIV, B, LDB, INFO)
 ZLAVSP More...
 
subroutine zlavsy (UPLO, TRANS, DIAG, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
 ZLAVSY More...
 
subroutine zlavsy_rook (UPLO, TRANS, DIAG, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
 ZLAVSY_ROOK More...
 
subroutine zlqt01 (M, N, A, AF, Q, L, LDA, TAU, WORK, LWORK, RWORK, RESULT)
 ZLQT01 More...
 
subroutine zlqt02 (M, N, K, A, AF, Q, L, LDA, TAU, WORK, LWORK, RWORK, RESULT)
 ZLQT02 More...
 
subroutine zlqt03 (M, N, K, AF, C, CC, Q, LDA, TAU, WORK, LWORK, RWORK, RESULT)
 ZLQT03 More...
 
subroutine zpbt01 (UPLO, N, KD, A, LDA, AFAC, LDAFAC, RWORK, RESID)
 ZPBT01 More...
 
subroutine zpbt02 (UPLO, N, KD, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
 ZPBT02 More...
 
subroutine zpbt05 (UPLO, N, KD, NRHS, AB, LDAB, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
 ZPBT05 More...
 
subroutine zpot01 (UPLO, N, A, LDA, AFAC, LDAFAC, RWORK, RESID)
 ZPOT01 More...
 
subroutine zpot02 (UPLO, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
 ZPOT02 More...
 
subroutine zpot03 (UPLO, N, A, LDA, AINV, LDAINV, WORK, LDWORK, RWORK, RCOND, RESID)
 ZPOT03 More...
 
subroutine zpot05 (UPLO, N, NRHS, A, LDA, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
 ZPOT05 More...
 
subroutine zpot06 (UPLO, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
 ZPOT06 More...
 
subroutine zppt01 (UPLO, N, A, AFAC, RWORK, RESID)
 ZPPT01 More...
 
subroutine zppt02 (UPLO, N, NRHS, A, X, LDX, B, LDB, RWORK, RESID)
 ZPPT02 More...
 
subroutine zppt03 (UPLO, N, A, AINV, WORK, LDWORK, RWORK, RCOND, RESID)
 ZPPT03 More...
 
subroutine zppt05 (UPLO, N, NRHS, AP, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
 ZPPT05 More...
 
subroutine zpst01 (UPLO, N, A, LDA, AFAC, LDAFAC, PERM, LDPERM, PIV, RWORK, RESID, RANK)
 ZPST01 More...
 
subroutine zptt01 (N, D, E, DF, EF, WORK, RESID)
 ZPTT01 More...
 
subroutine zptt02 (UPLO, N, NRHS, D, E, X, LDX, B, LDB, RESID)
 ZPTT02 More...
 
subroutine zptt05 (N, NRHS, D, E, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
 ZPTT05 More...
 
subroutine zqlt01 (M, N, A, AF, Q, L, LDA, TAU, WORK, LWORK, RWORK, RESULT)
 ZQLT01 More...
 
subroutine zqlt02 (M, N, K, A, AF, Q, L, LDA, TAU, WORK, LWORK, RWORK, RESULT)
 ZQLT02 More...
 
subroutine zqlt03 (M, N, K, AF, C, CC, Q, LDA, TAU, WORK, LWORK, RWORK, RESULT)
 ZQLT03 More...
 
double precision function zqpt01 (M, N, K, A, AF, LDA, TAU, JPVT, WORK, LWORK)
 ZQPT01 More...
 
subroutine zqrt01 (M, N, A, AF, Q, R, LDA, TAU, WORK, LWORK, RWORK, RESULT)
 ZQRT01 More...
 
subroutine zqrt01p (M, N, A, AF, Q, R, LDA, TAU, WORK, LWORK, RWORK, RESULT)
 ZQRT01P More...
 
subroutine zqrt02 (M, N, K, A, AF, Q, R, LDA, TAU, WORK, LWORK, RWORK, RESULT)
 ZQRT02 More...
 
subroutine zqrt03 (M, N, K, AF, C, CC, Q, LDA, TAU, WORK, LWORK, RWORK, RESULT)
 ZQRT03 More...
 
subroutine zqrt04 (M, N, NB, RESULT)
 ZQRT04 More...
 
subroutine zqrt05 (M, N, L, NB, RESULT)
 ZQRT05 More...
 
double precision function zqrt11 (M, K, A, LDA, TAU, WORK, LWORK)
 ZQRT11 More...
 
double precision function zqrt12 (M, N, A, LDA, S, WORK, LWORK, RWORK)
 ZQRT12 More...
 
subroutine zqrt13 (SCALE, M, N, A, LDA, NORMA, ISEED)
 ZQRT13 More...
 
double precision function zqrt14 (TRANS, M, N, NRHS, A, LDA, X, LDX, WORK, LWORK)
 ZQRT14 More...
 
subroutine zqrt15 (SCALE, RKSEL, M, N, NRHS, A, LDA, B, LDB, S, RANK, NORMA, NORMB, ISEED, WORK, LWORK)
 ZQRT15 More...
 
subroutine zqrt16 (TRANS, M, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
 ZQRT16 More...
 
double precision function zqrt17 (TRANS, IRESID, M, N, NRHS, A, LDA, X, LDX, B, LDB, C, WORK, LWORK)
 ZQRT17 More...
 
subroutine zrqt01 (M, N, A, AF, Q, R, LDA, TAU, WORK, LWORK, RWORK, RESULT)
 ZRQT01 More...
 
subroutine zrqt02 (M, N, K, A, AF, Q, R, LDA, TAU, WORK, LWORK, RWORK, RESULT)
 ZRQT02 More...
 
subroutine zrqt03 (M, N, K, AF, C, CC, Q, LDA, TAU, WORK, LWORK, RWORK, RESULT)
 ZRQT03 More...
 
double precision function zrzt01 (M, N, A, AF, LDA, TAU, WORK, LWORK)
 ZRZT01 More...
 
double precision function zrzt02 (M, N, AF, LDA, TAU, WORK, LWORK)
 ZRZT02 More...
 
subroutine zsbmv (UPLO, N, K, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
 ZSBMV More...
 
subroutine zspt01 (UPLO, N, A, AFAC, IPIV, C, LDC, RWORK, RESID)
 ZSPT01 More...
 
subroutine zspt02 (UPLO, N, NRHS, A, X, LDX, B, LDB, RWORK, RESID)
 ZSPT02 More...
 
subroutine zspt03 (UPLO, N, A, AINV, WORK, LDW, RWORK, RCOND, RESID)
 ZSPT03 More...
 
subroutine zsyt01 (UPLO, N, A, LDA, AFAC, LDAFAC, IPIV, C, LDC, RWORK, RESID)
 ZSYT01 More...
 
subroutine zsyt01_rook (UPLO, N, A, LDA, AFAC, LDAFAC, IPIV, C, LDC, RWORK, RESID)
 ZSYT01_ROOK More...
 
subroutine zsyt02 (UPLO, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
 ZSYT02 More...
 
subroutine zsyt03 (UPLO, N, A, LDA, AINV, LDAINV, WORK, LDWORK, RWORK, RCOND, RESID)
 ZSYT03 More...
 
subroutine ztbt02 (UPLO, TRANS, DIAG, N, KD, NRHS, AB, LDAB, X, LDX, B, LDB, WORK, RWORK, RESID)
 ZTBT02 More...
 
subroutine ztbt03 (UPLO, TRANS, DIAG, N, KD, NRHS, AB, LDAB, SCALE, CNORM, TSCAL, X, LDX, B, LDB, WORK, RESID)
 ZTBT03 More...
 
subroutine ztbt05 (UPLO, TRANS, DIAG, N, KD, NRHS, AB, LDAB, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
 ZTBT05 More...
 
subroutine ztbt06 (RCOND, RCONDC, UPLO, DIAG, N, KD, AB, LDAB, RWORK, RAT)
 ZTBT06 More...
 
subroutine ztpt01 (UPLO, DIAG, N, AP, AINVP, RCOND, RWORK, RESID)
 ZTPT01 More...
 
subroutine ztpt02 (UPLO, TRANS, DIAG, N, NRHS, AP, X, LDX, B, LDB, WORK, RWORK, RESID)
 ZTPT02 More...
 
subroutine ztpt03 (UPLO, TRANS, DIAG, N, NRHS, AP, SCALE, CNORM, TSCAL, X, LDX, B, LDB, WORK, RESID)
 ZTPT03 More...
 
subroutine ztpt05 (UPLO, TRANS, DIAG, N, NRHS, AP, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
 ZTPT05 More...
 
subroutine ztpt06 (RCOND, RCONDC, UPLO, DIAG, N, AP, RWORK, RAT)
 ZTPT06 More...
 
subroutine ztrt01 (UPLO, DIAG, N, A, LDA, AINV, LDAINV, RCOND, RWORK, RESID)
 ZTRT01 More...
 
subroutine ztrt02 (UPLO, TRANS, DIAG, N, NRHS, A, LDA, X, LDX, B, LDB, WORK, RWORK, RESID)
 ZTRT02 More...
 
subroutine ztrt03 (UPLO, TRANS, DIAG, N, NRHS, A, LDA, SCALE, CNORM, TSCAL, X, LDX, B, LDB, WORK, RESID)
 ZTRT03 More...
 
subroutine ztrt05 (UPLO, TRANS, DIAG, N, NRHS, A, LDA, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
 ZTRT05 More...
 
subroutine ztrt06 (RCOND, RCONDC, UPLO, DIAG, N, A, LDA, RWORK, RAT)
 ZTRT06 More...
 

Detailed Description

This is the group of complex16 LAPACK TESTING LIN routines.

Function Documentation

program zchkaa ( )

ZCHKAA

Purpose:
 ZCHKAA is the main test program for the COMPLEX*16 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*16 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
 ZGE   11               List types on next line if 0 < NTYPES < 11
 ZGB    8               List types on next line if 0 < NTYPES <  8
 ZGT   12               List types on next line if 0 < NTYPES < 12
 ZPO    9               List types on next line if 0 < NTYPES <  9
 ZPS    9               List types on next line if 0 < NTYPES <  9
 ZPP    9               List types on next line if 0 < NTYPES <  9
 ZPB    8               List types on next line if 0 < NTYPES <  8
 ZPT   12               List types on next line if 0 < NTYPES < 12
 ZHE   10               List types on next line if 0 < NTYPES < 10
 ZHR   10               List types on next line if 0 < NTYPES < 10
 ZHP   10               List types on next line if 0 < NTYPES < 10
 ZSY   11               List types on next line if 0 < NTYPES < 11
 ZSR   11               List types on next line if 0 < NTYPES < 11
 ZSP   11               List types on next line if 0 < NTYPES < 11
 ZTR   18               List types on next line if 0 < NTYPES < 18
 ZTP   18               List types on next line if 0 < NTYPES < 18
 ZTB   17               List types on next line if 0 < NTYPES < 17
 ZQR    8               List types on next line if 0 < NTYPES <  8
 ZRQ    8               List types on next line if 0 < NTYPES <  8
 ZLQ    8               List types on next line if 0 < NTYPES <  8
 ZQL    8               List types on next line if 0 < NTYPES <  8
 ZQP    6               List types on next line if 0 < NTYPES <  6
 ZTZ    3               List types on next line if 0 < NTYPES <  3
 ZLS    6               List types on next line if 0 < NTYPES <  6
 ZEQ
 ZQT
 ZQX
  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 zchkaa.f.

Here is the call graph for this function:

program zchkab ( )

ZCHKAB

Purpose:
 ZCHKAB is the test program for the COMPLEX*16 LAPACK
 ZCGESV/ZCPOSV routine

 The program must be driven by a short data file. The first 5 records
 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 9 lines:
 Data file for testing COMPLEX*16 LAPACK ZCGESV
 7                      Number of values of M
 0 1 2 3 5 10 16        Values of M (row dimension)
 1                      Number of values of NRHS
 2                      Values of NRHS (number of right hand sides)
 20.0                   Threshold value of test ratio
 T                      Put T to test the LAPACK routine
 T                      Put T to test the error exits
 DGE    11              List types on next line if 0 < NTYPES < 11
 DPO    9               List types on next line if 0 < NTYPES <  9
  NMAX    INTEGER
          The maximum allowable value for N

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

  MAXRHS  INTEGER
          The maximum number of right hand sides

  NIN     INTEGER
          The unit number for input

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

Definition at line 74 of file zchkab.f.

Here is the call graph for this function:

subroutine zchkeq ( double precision  THRESH,
integer  NOUT 
)

ZCHKEQ

Purpose:
 ZCHKEQ tests ZGEEQU, ZGBEQU, ZPOEQU, ZPPEQU and ZPBEQU
Parameters
[in]THRESH
          THRESH is DOUBLE PRECISION
          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 zchkeq.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  DOUBLE PRECISION thresh
65 * ..
66 *
67 * =====================================================================
68 *
69 * .. Parameters ..
70  DOUBLE PRECISION zero, one, ten
71  parameter( zero = 0.0d0, one = 1.0d+0, ten = 1.0d1 )
72  COMPLEX*16 czero
73  parameter( czero = ( 0.0d0, 0.0d0 ) )
74  COMPLEX*16 cone
75  parameter( cone = ( 1.0d0, 0.0d0 ) )
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  DOUBLE PRECISION ccond, eps, norm, ratio, rcmax, rcmin, rcond
87 * ..
88 * .. Local Arrays ..
89  DOUBLE PRECISION c( nsz ), pow( npow ), r( nsz ), reslts( 5 ),
90  $ rpow( npow )
91  COMPLEX*16 a( nsz, nsz ), ab( nszb, nsz ), ap( nszp )
92 * ..
93 * .. External Functions ..
94  DOUBLE PRECISION dlamch
95  EXTERNAL dlamch
96 * ..
97 * .. External Subroutines ..
98  EXTERNAL zgbequ, zgeequ, zpbequ, zpoequ, zppequ
99 * ..
100 * .. Intrinsic Functions ..
101  INTRINSIC abs, max, min
102 * ..
103 * .. Executable Statements ..
104 *
105  path( 1: 1 ) = 'Zomplex precision'
106  path( 2: 3 ) = 'EQ'
107 *
108  eps = dlamch( '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 ZGEEQU
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 zgeequ( 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 zgeequ( 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 zgeequ( 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 ZGBEQU
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 zgbequ( 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 ZPOEQU
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 zpoequ( 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 zpoequ( 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 ZPPEQU
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 zppequ( '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 zppequ( '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 zppequ( '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 ZPBEQU
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 zpbequ( '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 zpbequ( '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 zpbequ( '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 zpbequ( '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( ' ZGEEQU failed test with value ', d10.3, ' exceeding',
481  $ ' threshold ', d10.3 )
482  9997 FORMAT( ' ZGBEQU failed test with value ', d10.3, ' exceeding',
483  $ ' threshold ', d10.3 )
484  9996 FORMAT( ' ZPOEQU failed test with value ', d10.3, ' exceeding',
485  $ ' threshold ', d10.3 )
486  9995 FORMAT( ' ZPPEQU failed test with value ', d10.3, ' exceeding',
487  $ ' threshold ', d10.3 )
488  9994 FORMAT( ' ZPBEQU failed test with value ', d10.3, ' exceeding',
489  $ ' threshold ', d10.3 )
490  RETURN
491 *
492 * End of ZCHKEQ
493 *
subroutine zgbequ(M, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND, AMAX, INFO)
ZGBEQU
Definition: zgbequ.f:156
double precision function dlamch(CMACH)
DLAMCH
Definition: dlamch.f:65
subroutine zpbequ(UPLO, N, KD, AB, LDAB, S, SCOND, AMAX, INFO)
ZPBEQU
Definition: zpbequ.f:132
subroutine zppequ(UPLO, N, AP, S, SCOND, AMAX, INFO)
ZPPEQU
Definition: zppequ.f:119
subroutine zgeequ(M, N, A, LDA, R, C, ROWCND, COLCND, AMAX, INFO)
ZGEEQU
Definition: zgeequ.f:142
subroutine zpoequ(N, A, LDA, S, SCOND, AMAX, INFO)
ZPOEQU
Definition: zpoequ.f:115

Here is the call graph for this function:

Here is the caller graph for this function:

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

ZCHKGB

Purpose:
 ZCHKGB tests ZGBTRF, -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 DOUBLE PRECISION
          The threshold value for the test ratios.  A result is
          included in the output file if RESULT >= THRESH.  To have
          every test ratio printed, use THRESH = 0.
[in]TSTERR
          TSTERR is LOGICAL
          Flag that indicates whether error exits are to be tested.
[out]A
          A is COMPLEX*16 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*16 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*16 array, dimension (NMAX*NSMAX)
[out]X
          X is COMPLEX*16 array, dimension (NMAX*NSMAX)
[out]XACT
          XACT is COMPLEX*16 array, dimension (NMAX*NSMAX)
[out]WORK
          WORK is COMPLEX*16 array, dimension
                      (NMAX*max(3,NSMAX,NMAX))
[out]RWORK
          RWORK is DOUBLE PRECISION 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 zchkgb.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  DOUBLE PRECISION thresh
203 * ..
204 * .. Array Arguments ..
205  LOGICAL dotype( * )
206  INTEGER iwork( * ), mval( * ), nbval( * ), nsval( * ),
207  $ nval( * )
208  DOUBLE PRECISION rwork( * )
209  COMPLEX*16 a( * ), afac( * ), b( * ), work( * ), x( * ),
210  $ xact( * )
211 * ..
212 *
213 * =====================================================================
214 *
215 * .. Parameters ..
216  DOUBLE PRECISION one, zero
217  parameter( one = 1.0d+0, zero = 0.0d+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  DOUBLE PRECISION 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  DOUBLE PRECISION result( ntests )
239 * ..
240 * .. External Functions ..
241  DOUBLE PRECISION dget06, zlangb, zlange
242  EXTERNAL dget06, zlangb, zlange
243 * ..
244 * .. External Subroutines ..
245  EXTERNAL alaerh, alahd, alasum, xlaenv, zcopy, zerrge,
248  $ zlatms
249 * ..
250 * .. Intrinsic Functions ..
251  INTRINSIC dcmplx, 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 ) = 'Zomplex 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 zerrge( 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 ZLATB4 and generate a
384 * test matrix with ZLATMS.
385 *
386  CALL zlatb4( 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 = 'ZLATMS'
394  CALL zlatms( 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 ZLATMS.
399 *
400  IF( info.NE.0 ) THEN
401  CALL alaerh( path, 'ZLATMS', 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 zcopy( 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 zcopy( 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 = ZLANGB( 'O', N, KL, KU, A, LDA, RWORK )
454 * ANORMI = ZLANGB( '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 zlacpy( 'Full', kl+ku+1, n, a, lda,
466  $ afac( kl+1 ), ldafac )
467  srnamt = 'ZGBTRF'
468  CALL zgbtrf( m, n, kl, ku, afac, ldafac, iwork,
469  $ info )
470 *
471 * Check error code from ZGBTRF.
472 *
473  IF( info.NE.izero )
474  $ CALL alaerh( path, 'ZGBTRF', 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 zgbt01( 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 = zlangb( 'O', n, kl, ku, a, lda, rwork )
505  anormi = zlangb( '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 zlaset( 'Full', n, n, dcmplx( zero ),
514  $ dcmplx( one ), work, ldb )
515  srnamt = 'ZGBTRS'
516  CALL zgbtrs( '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 = zlange( '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 = zlange( '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 = 'ZLARHS'
572  CALL zlarhs( path, xtype, ' ', trans, n,
573  $ n, kl, ku, nrhs, a, lda,
574  $ xact, ldb, b, ldb, iseed,
575  $ info )
576  xtype = 'C'
577  CALL zlacpy( 'Full', n, nrhs, b, ldb, x,
578  $ ldb )
579 *
580  srnamt = 'ZGBTRS'
581  CALL zgbtrs( trans, n, kl, ku, nrhs, afac,
582  $ ldafac, iwork, x, ldb, info )
583 *
584 * Check error code from ZGBTRS.
585 *
586  IF( info.NE.0 )
587  $ CALL alaerh( path, 'ZGBTRS', info, 0,
588  $ trans, n, n, kl, ku, -1,
589  $ imat, nfail, nerrs, nout )
590 *
591  CALL zlacpy( 'Full', n, nrhs, b, ldb,
592  $ work, ldb )
593  CALL zgbt02( 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 zget04( 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 = 'ZGBRFS'
609  CALL zgbrfs( 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 ZGBRFS.
616 *
617  IF( info.NE.0 )
618  $ CALL alaerh( path, 'ZGBRFS', info, 0,
619  $ trans, n, n, kl, ku, nrhs,
620  $ imat, nfail, nerrs, nout )
621 *
622  CALL zget04( n, nrhs, x, ldb, xact, ldb,
623  $ rcondc, result( 4 ) )
624  CALL zgbt05( 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 = 'ZGBCON'
661  CALL zgbcon( norm, n, kl, ku, afac, ldafac,
662  $ iwork, anorm, rcond, work,
663  $ rwork, info )
664 *
665 * Check error code from ZGBCON.
666 *
667  IF( info.NE.0 )
668  $ CALL alaerh( path, 'ZGBCON', info, 0,
669  $ norm, n, n, kl, ku, -1, imat,
670  $ nfail, nerrs, nout )
671 *
672  result( 7 ) = dget06( 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 ZCHKGB, 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 ZCHKGB, 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 ZCHKGB
713 *
subroutine zgbtrf(M, N, KL, KU, AB, LDAB, IPIV, INFO)
ZGBTRF
Definition: zgbtrf.f:146
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
Definition: alaerh.f:149
double precision function dget06(RCOND, RCONDC)
DGET06
Definition: dget06.f:57
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
Definition: zlacpy.f:105
subroutine zcopy(N, ZX, INCX, ZY, INCY)
ZCOPY
Definition: zcopy.f:52
subroutine zgbt02(TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, RESID)
ZGBT02
Definition: zgbt02.f:141
subroutine zgbt01(M, N, KL, KU, A, LDA, AFAC, LDAFAC, IPIV, WORK, RESID)
ZGBT01
Definition: zgbt01.f:128
subroutine zgbtrs(TRANS, N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB, INFO)
ZGBTRS
Definition: zgbtrs.f:140
subroutine zgbt05(TRANS, N, KL, KU, NRHS, AB, LDAB, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
ZGBT05
Definition: zgbt05.f:178
subroutine zgbrfs(TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, LDAFB, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
ZGBRFS
Definition: zgbrfs.f:208
subroutine zgbcon(NORM, N, KL, KU, AB, LDAB, IPIV, ANORM, RCOND, WORK, RWORK, INFO)
ZGBCON
Definition: zgbcon.f:149
subroutine zlatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
ZLATB4
Definition: zlatb4.f:123
subroutine zlaset(UPLO, M, N, ALPHA, BETA, A, LDA)
ZLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
Definition: zlaset.f:108
subroutine alahd(IOUNIT, PATH)
ALAHD
Definition: alahd.f:95
double precision function zlangb(NORM, N, KL, KU, AB, LDAB, WORK)
ZLANGB returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
Definition: zlangb.f:127
double precision function zlange(NORM, M, N, A, LDA, WORK)
ZLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
Definition: zlange.f:117
subroutine zget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
ZGET04
Definition: zget04.f:104
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
Definition: alasum.f:75
subroutine zlarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
ZLARHS
Definition: zlarhs.f:211
subroutine zerrge(PATH, NUNIT)
ZERRGE
Definition: zerrge.f:57
subroutine zlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
ZLATMS
Definition: zlatms.f:334
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
Definition: xlaenv.f:83

Here is the call graph for this function:

Here is the caller graph for this function:

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

ZCHKGE

Purpose:
 ZCHKGE tests ZGETRF, -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 DOUBLE PRECISION
          The threshold value for the test ratios.  A result is
          included in the output file if RESULT >= THRESH.  To have
          every test ratio printed, use THRESH = 0.
[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*16 array, dimension (NMAX*NMAX)
[out]AFAC
          AFAC is COMPLEX*16 array, dimension (NMAX*NMAX)
[out]AINV
          AINV is COMPLEX*16 array, dimension (NMAX*NMAX)
[out]B
          B is COMPLEX*16 array, dimension (NMAX*NSMAX)
          where NSMAX is the largest entry in NSVAL.
[out]X
          X is COMPLEX*16 array, dimension (NMAX*NSMAX)
[out]XACT
          XACT is COMPLEX*16 array, dimension (NMAX*NSMAX)
[out]WORK
          WORK is COMPLEX*16 array, dimension
                      (NMAX*max(3,NSMAX))
[out]RWORK
          RWORK is DOUBLE PRECISION 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 zchkge.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  DOUBLE PRECISION thresh
198 * ..
199 * .. Array Arguments ..
200  LOGICAL dotype( * )
201  INTEGER iwork( * ), mval( * ), nbval( * ), nsval( * ),
202  $ nval( * )
203  DOUBLE PRECISION rwork( * )
204  COMPLEX*16 a( * ), afac( * ), ainv( * ), b( * ),
205  $ work( * ), x( * ), xact( * )
206 * ..
207 *
208 * =====================================================================
209 *
210 * .. Parameters ..
211  DOUBLE PRECISION one, zero
212  parameter( one = 1.0d+0, zero = 0.0d+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  DOUBLE PRECISION 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  DOUBLE PRECISION result( ntests )
234 * ..
235 * .. External Functions ..
236  DOUBLE PRECISION dget06, zlange
237  EXTERNAL dget06, zlange
238 * ..
239 * .. External Subroutines ..
240  EXTERNAL alaerh, alahd, alasum, xlaenv, zerrge, zgecon,
243  $ zlatb4, zlatms
244 * ..
245 * .. Intrinsic Functions ..
246  INTRINSIC dcmplx, 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 ) = 'Zomplex 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 zerrge( 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 ZLATB4 and generate a test matrix
311 * with ZLATMS.
312 *
313  CALL zlatb4( path, imat, m, n, TYPE, kl, ku, anorm, mode,
314  $ cndnum, dist )
315 *
316  srnamt = 'ZLATMS'
317  CALL zlatms( 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 ZLATMS.
322 *
323  IF( info.NE.0 ) THEN
324  CALL alaerh( path, 'ZLATMS', 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 zlaset( 'Full', m, n-izero+1, dcmplx( zero ),
347  $ dcmplx( 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 = ZLANGE( 'O', M, N, A, LDA, RWORK )
357 * ANORMI = ZLANGE( '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 zlacpy( 'Full', m, n, a, lda, afac, lda )
368  srnamt = 'ZGETRF'
369  CALL zgetrf( m, n, afac, lda, iwork, info )
370 *
371 * Check error code from ZGETRF.
372 *
373  IF( info.NE.izero )
374  $ CALL alaerh( path, 'ZGETRF', 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 zlacpy( 'Full', m, n, afac, lda, ainv, lda )
383  CALL zget01( 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 zlacpy( 'Full', n, n, afac, lda, ainv, lda )
393  srnamt = 'ZGETRI'
394  nrhs = nsval( 1 )
395  lwork = nmax*max( 3, nrhs )
396  CALL zgetri( n, ainv, lda, iwork, work, lwork,
397  $ info )
398 *
399 * Check error code from ZGETRI.
400 *
401  IF( info.NE.0 )
402  $ CALL alaerh( path, 'ZGETRI', 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 zget03( n, a, lda, ainv, lda, work, lda,
411  $ rwork, rcondo, result( 2 ) )
412  anormo = zlange( 'O', m, n, a, lda, rwork )
413 *
414 * Compute the infinity-norm condition number of A.
415 *
416  anormi = zlange( 'I', m, n, a, lda, rwork )
417  ainvnm = zlange( '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 = zlange( 'O', m, n, a, lda, rwork )
430  anormi = zlange( '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 = 'ZLARHS'
474  CALL zlarhs( path, xtype, ' ', trans, n, n, kl,
475  $ ku, nrhs, a, lda, xact, lda, b,
476  $ lda, iseed, info )
477  xtype = 'C'
478 *
479  CALL zlacpy( 'Full', n, nrhs, b, lda, x, lda )
480  srnamt = 'ZGETRS'
481  CALL zgetrs( trans, n, nrhs, afac, lda, iwork,
482  $ x, lda, info )
483 *
484 * Check error code from ZGETRS.
485 *
486  IF( info.NE.0 )
487  $ CALL alaerh( path, 'ZGETRS', info, 0, trans,
488  $ n, n, -1, -1, nrhs, imat, nfail,
489  $ nerrs, nout )
490 *
491  CALL zlacpy( 'Full', n, nrhs, b, lda, work,
492  $ lda )
493  CALL zget02( 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 zget04( 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 = 'ZGERFS'
507  CALL zgerfs( 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 ZGERFS.
513 *
514  IF( info.NE.0 )
515  $ CALL alaerh( path, 'ZGERFS', info, 0, trans,
516  $ n, n, -1, -1, nrhs, imat, nfail,
517  $ nerrs, nout )
518 *
519  CALL zget04( n, nrhs, x, lda, xact, lda, rcondc,
520  $ result( 5 ) )
521  CALL zget07( 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 = 'ZGECON'
556  CALL zgecon( norm, n, afac, lda, anorm, rcond,
557  $ work, rwork, info )
558 *
559 * Check error code from ZGECON.
560 *
561  IF( info.NE.0 )
562  $ CALL alaerh( path, 'ZGECON', 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 ) = dget06( 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 ZCHKGE
603 *
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
Definition: alaerh.f:149
double precision function dget06(RCOND, RCONDC)
DGET06
Definition: dget06.f:57
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
Definition: zlacpy.f:105
subroutine zgetri(N, A, LDA, IPIV, WORK, LWORK, INFO)
ZGETRI
Definition: zgetri.f:116
subroutine zlatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
ZLATB4
Definition: zlatb4.f:123
subroutine zgecon(NORM, N, A, LDA, ANORM, RCOND, WORK, RWORK, INFO)
ZGECON
Definition: zgecon.f:126
subroutine zlaset(UPLO, M, N, ALPHA, BETA, A, LDA)
ZLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
Definition: zlaset.f:108
subroutine alahd(IOUNIT, PATH)
ALAHD
Definition: alahd.f:95
double precision function zlange(NORM, M, N, A, LDA, WORK)
ZLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
Definition: zlange.f:117
subroutine zget03(N, A, LDA, AINV, LDAINV, WORK, LDWORK, RWORK, RCOND, RESID)
ZGET03
Definition: zget03.f:112
subroutine zget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
ZGET04
Definition: zget04.f:104
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
Definition: alasum.f:75
subroutine zlarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
ZLARHS
Definition: zlarhs.f:211
subroutine zerrge(PATH, NUNIT)
ZERRGE
Definition: zerrge.f:57
subroutine zget02(TRANS, M, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
ZGET02
Definition: zget02.f:135
subroutine zget01(M, N, A, LDA, AFAC, LDAFAC, IPIV, RWORK, RESID)
ZGET01
Definition: zget01.f:110
subroutine zlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
ZLATMS
Definition: zlatms.f:334
subroutine zgetrf(M, N, A, LDA, IPIV, INFO)
ZGETRF VARIANT: Crout Level 3 BLAS version of the algorithm.
Definition: zgetrf.f:102
subroutine zget07(TRANS, N, NRHS, A, LDA, B, LDB, X, LDX, XACT, LDXACT, FERR, CHKFERR, BERR, RESLTS)
ZGET07
Definition: zget07.f:168
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
Definition: xlaenv.f:83
subroutine zgerfs(TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
ZGERFS
Definition: zgerfs.f:188
subroutine zgetrs(TRANS, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
ZGETRS
Definition: zgetrs.f:123

Here is the call graph for this function:

Here is the caller graph for this function:

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

ZCHKGT

Purpose:
 ZCHKGT tests ZGTTRF, -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 DOUBLE PRECISION
          The threshold value for the test ratios.  A result is
          included in the output file if RESULT >= THRESH.  To have
          every test ratio printed, use THRESH = 0.
[in]TSTERR
          TSTERR is LOGICAL
          Flag that indicates whether error exits are to be tested.
[out]A
          A is COMPLEX*16 array, dimension (NMAX*4)
[out]AF
          AF is COMPLEX*16 array, dimension (NMAX*4)
[out]B
          B is COMPLEX*16 array, dimension (NMAX*NSMAX)
          where NSMAX is the largest entry in NSVAL.
[out]X
          X is COMPLEX*16 array, dimension (NMAX*NSMAX)
[out]XACT
          XACT is COMPLEX*16 array, dimension (NMAX*NSMAX)
[out]WORK
          WORK is COMPLEX*16 array, dimension
                      (NMAX*max(3,NSMAX))
[out]RWORK
          RWORK is DOUBLE PRECISION 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 zchkgt.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  DOUBLE PRECISION thresh
159 * ..
160 * .. Array Arguments ..
161  LOGICAL dotype( * )
162  INTEGER iwork( * ), nsval( * ), nval( * )
163  DOUBLE PRECISION rwork( * )
164  COMPLEX*16 a( * ), af( * ), b( * ), work( * ), x( * ),
165  $ xact( * )
166 * ..
167 *
168 * =====================================================================
169 *
170 * .. Parameters ..
171  DOUBLE PRECISION one, zero
172  parameter( one = 1.0d+0, zero = 0.0d+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  DOUBLE PRECISION ainvnm, anorm, cond, rcond, rcondc, rcondi,
186  $ rcondo
187 * ..
188 * .. Local Arrays ..
189  CHARACTER transs( 3 )
190  INTEGER iseed( 4 ), iseedy( 4 )
191  DOUBLE PRECISION result( ntests )
192  COMPLEX*16 z( 3 )
193 * ..
194 * .. External Functions ..
195  DOUBLE PRECISION dget06, dzasum, zlangt
196  EXTERNAL dget06, dzasum, zlangt
197 * ..
198 * .. External Subroutines ..
199  EXTERNAL alaerh, alahd, alasum, zcopy, zdscal, zerrge,
202  $ zlatms
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 ) = 'Zomplex 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 zerrge( 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 ZLATB4.
256 *
257  CALL zlatb4( 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 = 'ZLATMS'
267  CALL zlatms( 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 ZLATMS.
272 *
273  IF( info.NE.0 ) THEN
274  CALL alaerh( path, 'ZLATMS', 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 zcopy( n-1, af( 4 ), 3, a, 1 )
282  CALL zcopy( n-1, af( 3 ), 3, a( n+m+1 ), 1 )
283  END IF
284  CALL zcopy( 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 zlarnv( 2, iseed, n+2*m, a )
296  IF( anorm.NE.one )
297  $ CALL zdscal( 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 zcopy( n+2*m, a, 1, af, 1 )
352  srnamt = 'ZGTTRF'
353  CALL zgttrf( n, af, af( m+1 ), af( n+m+1 ), af( n+2*m+1 ),
354  $ iwork, info )
355 *
356 * Check error code from ZGTTRF.
357 *
358  IF( info.NE.izero )
359  $ CALL alaerh( path, 'ZGTTRF', info, izero, ' ', n, n, 1,
360  $ 1, -1, imat, nfail, nerrs, nout )
361  trfcon = info.NE.0
362 *
363  CALL zgtt01( 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 = zlangt( norm, n, a, a( m+1 ), a( n+m+1 ) )
385 *
386  IF( .NOT.trfcon ) THEN
387 *
388 * Use ZGTTRS 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 zgttrs( 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, dzasum( 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 = 'ZGTCON'
424  CALL zgtcon( 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 ZGTCON.
429 *
430  IF( info.NE.0 )
431  $ CALL alaerh( path, 'ZGTCON', info, 0, norm, n, n, -1,
432  $ -1, -1, imat, nfail, nerrs, nout )
433 *
434  result( 7 ) = dget06( 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 zlarnv( 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 zlagtm( trans, n, nrhs, one, a, a( m+1 ),
475  $ a( n+m+1 ), xact, lda, zero, b, lda )
476 *
477 *+ TEST 2
478 * Solve op(A) * X = B and compute the residual.
479 *
480  CALL zlacpy( 'Full', n, nrhs, b, lda, x, lda )
481  srnamt = 'ZGTTRS'
482  CALL zgttrs( trans, n, nrhs, af, af( m+1 ),
483  $ af( n+m+1 ), af( n+2*m+1 ), iwork, x,
484  $ lda, info )
485 *
486 * Check error code from ZGTTRS.
487 *
488  IF( info.NE.0 )
489  $ CALL alaerh( path, 'ZGTTRS', info, 0, trans, n, n,
490  $ -1, -1, nrhs, imat, nfail, nerrs,
491  $ nout )
492 *
493  CALL zlacpy( 'Full', n, nrhs, b, lda, work, lda )
494  CALL zgtt02( trans, n, nrhs, a, a( m+1 ), a( n+m+1 ),
495  $ x, lda, work, lda, result( 2 ) )
496 *
497 *+ TEST 3
498 * Check solution from generated exact solution.
499 *
500  CALL zget04( n, nrhs, x, lda, xact, lda, rcondc,
501  $ result( 3 ) )
502 *
503 *+ TESTS 4, 5, and 6
504 * Use iterative refinement to improve the solution.
505 *
506  srnamt = 'ZGTRFS'
507  CALL zgtrfs( trans, n, nrhs, a, a( m+1 ), a( n+m+1 ),
508  $ af, af( m+1 ), af( n+m+1 ),
509  $ af( n+2*m+1 ), iwork, b, lda, x, lda,
510  $ rwork, rwork( nrhs+1 ), work,
511  $ rwork( 2*nrhs+1 ), info )
512 *
513 * Check error code from ZGTRFS.
514 *
515  IF( info.NE.0 )
516  $ CALL alaerh( path, 'ZGTRFS', info, 0, trans, n, n,
517  $ -1, -1, nrhs, imat, nfail, nerrs,
518  $ nout )
519 *
520  CALL zget04( n, nrhs, x, lda, xact, lda, rcondc,
521  $ result( 4 ) )
522  CALL zgtt05( trans, n, nrhs, a, a( m+1 ), a( n+m+1 ),
523  $ b, lda, x, lda, xact, lda, rwork,
524  $ rwork( nrhs+1 ), result( 5 ) )
525 *
526 * Print information about the tests that did not pass the
527 * threshold.
528 *
529  DO 70 k = 2, 6
530  IF( result( k ).GE.thresh ) THEN
531  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
532  $ CALL alahd( nout, path )
533  WRITE( nout, fmt = 9998 )trans, n, nrhs, imat,
534  $ k, result( k )
535  nfail = nfail + 1
536  END IF
537  70 CONTINUE
538  nrun = nrun + 5
539  80 CONTINUE
540  90 CONTINUE
541  100 CONTINUE
542  110 CONTINUE
543 *
544 * Print a summary of the results.
545 *
546  CALL alasum( path, nout, nfail, nrun, nerrs )
547 *
548  9999 FORMAT( 12x, 'N =', i5, ',', 10x, ' type ', i2, ', test(', i2,
549  $ ') = ', g12.5 )
550  9998 FORMAT( ' TRANS=''', a1, ''', N =', i5, ', NRHS=', i3, ', type ',
551  $ i2, ', test(', i2, ') = ', g12.5 )
552  9997 FORMAT( ' NORM =''', a1, ''', N =', i5, ',', 10x, ' type ', i2,
553  $ ', test(', i2, ') = ', g12.5 )
554  RETURN
555 *
556 * End of ZCHKGT
557 *
subroutine zlagtm(TRANS, N, NRHS, ALPHA, DL, D, DU, X, LDX, BETA, B, LDB)
ZLAGTM performs a matrix-matrix product of the form C = αAB+βC, where A is a tridiagonal matrix...
Definition: zlagtm.f:147
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
Definition: alaerh.f:149
double precision function dget06(RCOND, RCONDC)
DGET06
Definition: dget06.f:57
subroutine zgtrfs(TRANS, N, NRHS, DL, D, DU, DLF, DF, DUF, DU2, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
ZGTRFS
Definition: zgtrfs.f:212
subroutine zgttrf(N, DL, D, DU, DU2, IPIV, INFO)
ZGTTRF
Definition: zgttrf.f:126
subroutine zgtt05(TRANS, N, NRHS, DL, D, DU, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
ZGTT05
Definition: zgtt05.f:167
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
Definition: zlacpy.f:105
subroutine zcopy(N, ZX, INCX, ZY, INCY)
ZCOPY
Definition: zcopy.f:52
subroutine zgtt02(TRANS, N, NRHS, DL, D, DU, X, LDX, B, LDB, RESID)
ZGTT02
Definition: zgtt02.f:126
subroutine zgtcon(NORM, N, DL, D, DU, DU2, IPIV, ANORM, RCOND, WORK, INFO)
ZGTCON
Definition: zgtcon.f:143
double precision function dzasum(N, ZX, INCX)
DZASUM
Definition: dzasum.f:54
subroutine zlatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
ZLATB4
Definition: zlatb4.f:123
subroutine zgtt01(N, DL, D, DU, DLF, DF, DUF, DU2, IPIV, WORK, LDWORK, RWORK, RESID)
ZGTT01
Definition: zgtt01.f:136
subroutine alahd(IOUNIT, PATH)
ALAHD
Definition: alahd.f:95
subroutine zgttrs(TRANS, N, NRHS, DL, D, DU, DU2, IPIV, B, LDB, INFO)
ZGTTRS
Definition: zgttrs.f:140
subroutine zlarnv(IDIST, ISEED, N, X)
ZLARNV returns a vector of random numbers from a uniform or normal distribution.
Definition: zlarnv.f:101
subroutine zget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
ZGET04
Definition: zget04.f:104
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
Definition: alasum.f:75
subroutine zerrge(PATH, NUNIT)
ZERRGE
Definition: zerrge.f:57
subroutine zlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
ZLATMS
Definition: zlatms.f:334
subroutine zdscal(N, DA, ZX, INCX)
ZDSCAL
Definition: zdscal.f:54
double precision function zlangt(NORM, N, DL, D, DU)
ZLANGT returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
Definition: zlangt.f:108

Here is the call graph for this function:

Here is the caller graph for this function:

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

ZCHKHE

Purpose:
 ZCHKHE tests ZHETRF, -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 DOUBLE PRECISION
          The threshold value for the test ratios.  A result is
          included in the output file if RESULT >= THRESH.  To have
          every test ratio printed, use THRESH = 0.
[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*16 array, dimension (NMAX*NMAX)
[out]AFAC
          AFAC is COMPLEX*16 array, dimension (NMAX*NMAX)
[out]AINV
          AINV is COMPLEX*16 array, dimension (NMAX*NMAX)
[out]B
          B is COMPLEX*16 array, dimension (NMAX*NSMAX)
          where NSMAX is the largest entry in NSVAL.
[out]X
          X is COMPLEX*16 array, dimension (NMAX*NSMAX)
[out]XACT
          XACT is COMPLEX*16 array, dimension (NMAX*NSMAX)
[out]WORK
          WORK is COMPLEX*16 array, dimension (NMAX*max(3,NSMAX))
[out]RWORK
          RWORK is DOUBLE PRECISION 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 zchkhe.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  DOUBLE PRECISION thresh
183 * ..
184 * .. Array Arguments ..
185  LOGICAL dotype( * )
186  INTEGER iwork( * ), nbval( * ), nsval( * ), nval( * )
187  DOUBLE PRECISION rwork( * )
188  COMPLEX*16 a( * ), afac( * ), ainv( * ), b( * ),
189  $ work( * ), x( * ), xact( * )
190 * ..
191 *
192 * =====================================================================
193 *
194 * .. Parameters ..
195  DOUBLE PRECISION zero
196  parameter( zero = 0.0d+0 )
197  COMPLEX*16 czero
198  parameter( czero = ( 0.0d+0, 0.0d+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  DOUBLE PRECISION anorm, cndnum, rcond, rcondc
212 * ..
213 * .. Local Arrays ..
214  CHARACTER uplos( 2 )
215  INTEGER iseed( 4 ), iseedy( 4 )
216  DOUBLE PRECISION result( ntests )
217 * ..
218 * .. External Functions ..
219  DOUBLE PRECISION dget06, zlanhe
220  EXTERNAL dget06, zlanhe
221 * ..
222 * .. External Subroutines ..
223  EXTERNAL alaerh, alahd, alasum, xlaenv, zerrhe, zget04,
226  $ zpot02, zpot03, zpot05
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 ) = 'Zomplex 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 zerrhe( 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  DO 170 imat = 1, nimat
280 *
281 * Do the tests only if DOTYPE( IMAT ) is true.
282 *
283  IF( .NOT.dotype( imat ) )
284  $ GO TO 170
285 *
286 * Skip types 3, 4, 5, or 6 if the matrix size is too small.
287 *
288  zerot = imat.GE.3 .AND. imat.LE.6
289  IF( zerot .AND. n.LT.imat-2 )
290  $ GO TO 170
291 *
292 * Do first for UPLO = 'U', then for UPLO = 'L'
293 *
294  DO 160 iuplo = 1, 2
295  uplo = uplos( iuplo )
296 *
297 * Set up parameters with ZLATB4 for the matrix generator
298 * based on the type of matrix to be generated.
299 *
300  CALL zlatb4( path, imat, n, n, TYPE, kl, ku, anorm, mode,
301  $ cndnum, dist )
302 *
303 * Generate a matrix with ZLATMS.
304 *
305  srnamt = 'ZLATMS'
306  CALL zlatms( n, n, dist, iseed, TYPE, rwork, mode,
307  $ cndnum, anorm, kl, ku, uplo, a, lda, work,
308  $ info )
309 *
310 * Check error code from ZLATMS and handle error.
311 *
312  IF( info.NE.0 ) THEN
313  CALL alaerh( path, 'ZLATMS', info, 0, uplo, n, n, -1,
314  $ -1, -1, imat, nfail, nerrs, nout )
315 *
316 * Skip all tests for this generated matrix
317 *
318  GO TO 160
319  END IF
320 *
321 * For types 3-6, zero one or more rows and columns of
322 * the matrix to test that INFO is returned correctly.
323 *
324  IF( zerot ) THEN
325  IF( imat.EQ.3 ) THEN
326  izero = 1
327  ELSE IF( imat.EQ.4 ) THEN
328  izero = n
329  ELSE
330  izero = n / 2 + 1
331  END IF
332 *
333  IF( imat.LT.6 ) THEN
334 *
335 * Set row and column IZERO to zero.
336 *
337  IF( iuplo.EQ.1 ) THEN
338  ioff = ( izero-1 )*lda
339  DO 20 i = 1, izero - 1
340  a( ioff+i ) = czero
341  20 CONTINUE
342  ioff = ioff + izero
343  DO 30 i = izero, n
344  a( ioff ) = czero
345  ioff = ioff + lda
346  30 CONTINUE
347  ELSE
348  ioff = izero
349  DO 40 i = 1, izero - 1
350  a( ioff ) = czero
351  ioff = ioff + lda
352  40 CONTINUE
353  ioff = ioff - izero
354  DO 50 i = izero, n
355  a( ioff+i ) = czero
356  50 CONTINUE
357  END IF
358  ELSE
359  IF( iuplo.EQ.1 ) THEN
360 *
361 * Set the first IZERO rows and columns to zero.
362 *
363  ioff = 0
364  DO 70 j = 1, n
365  i2 = min( j, izero )
366  DO 60 i = 1, i2
367  a( ioff+i ) = czero
368  60 CONTINUE
369  ioff = ioff + lda
370  70 CONTINUE
371  ELSE
372 *
373 * Set the last IZERO rows and columns to zero.
374 *
375  ioff = 0
376  DO 90 j = 1, n
377  i1 = max( j, izero )
378  DO 80 i = i1, n
379  a( ioff+i ) = czero
380  80 CONTINUE
381  ioff = ioff + lda
382  90 CONTINUE
383  END IF
384  END IF
385  ELSE
386  izero = 0
387  END IF
388 *
389 * End generate test matrix A.
390 *
391 *
392 * Set the imaginary part of the diagonals.
393 *
394  CALL zlaipd( n, a, lda+1, 0 )
395 *
396 * Do for each value of NB in NBVAL
397 *
398  DO 150 inb = 1, nnb
399 *
400 * Set the optimal blocksize, which will be later
401 * returned by ILAENV.
402 *
403  nb = nbval( inb )
404  CALL xlaenv( 1, nb )
405 *
406 * Copy the test matrix A into matrix AFAC which
407 * will be factorized in place. This is needed to
408 * preserve the test matrix A for subsequent tests.
409 *
410  CALL zlacpy( uplo, n, n, a, lda, afac, lda )
411 *
412 * Compute the L*D*L**T or U*D*U**T factorization of the
413 * matrix. IWORK stores details of the interchanges and
414 * the block structure of D. AINV is a work array for
415 * block factorization, LWORK is the length of AINV.
416 *
417  lwork = max( 2, nb )*lda
418  srnamt = 'ZHETRF'
419  CALL zhetrf( uplo, n, afac, lda, iwork, ainv, lwork,
420  $ info )
421 *
422 * Adjust the expected value of INFO to account for
423 * pivoting.
424 *
425  k = izero
426  IF( k.GT.0 ) THEN
427  100 CONTINUE
428  IF( iwork( k ).LT.0 ) THEN
429  IF( iwork( k ).NE.-k ) THEN
430  k = -iwork( k )
431  GO TO 100
432  END IF
433  ELSE IF( iwork( k ).NE.k ) THEN
434  k = iwork( k )
435  GO TO 100
436  END IF
437  END IF
438 *
439 * Check error code from ZHETRF and handle error.
440 *
441  IF( info.NE.k )
442  $ CALL alaerh( path, 'ZHETRF', info, k, uplo, n, n,
443  $ -1, -1, nb, imat, nfail, nerrs, nout )
444 *
445 * Set the condition estimate flag if the INFO is not 0.
446 *
447  IF( info.NE.0 ) THEN
448  trfcon = .true.
449  ELSE
450  trfcon = .false.
451  END IF
452 *
453 *+ TEST 1
454 * Reconstruct matrix from factors and compute residual.
455 *
456  CALL zhet01( uplo, n, a, lda, afac, lda, iwork, ainv,
457  $ lda, rwork, result( 1 ) )
458  nt = 1
459 *
460 *+ TEST 2
461 * Form the inverse and compute the residual.
462 *
463  IF( inb.EQ.1 .AND. .NOT.trfcon ) THEN
464  CALL zlacpy( uplo, n, n, afac, lda, ainv, lda )
465  srnamt = 'ZHETRI2'
466  lwork = (n+nb+1)*(nb+3)
467  CALL zhetri2( uplo, n, ainv, lda, iwork, work,
468  $ lwork, info )
469 *
470 * Check error code from ZHETRI and handle error.
471 *
472  IF( info.NE.0 )
473  $ CALL alaerh( path, 'ZHETRI', info, -1, uplo, n,
474  $ n, -1, -1, -1, imat, nfail, nerrs,
475  $ nout )
476 *
477 * Compute the residual for a symmetric matrix times
478 * its inverse.
479 *
480  CALL zpot03( uplo, n, a, lda, ainv, lda, work, lda,
481  $ rwork, rcondc, result( 2 ) )
482  nt = 2
483  END IF
484 *
485 * Print information about the tests that did not pass
486 * the threshold.
487 *
488  DO 110 k = 1, nt
489  IF( result( k ).GE.thresh ) THEN
490  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
491  $ CALL alahd( nout, path )
492  WRITE( nout, fmt = 9999 )uplo, n, nb, imat, k,
493  $ result( k )
494  nfail = nfail + 1
495  END IF
496  110 CONTINUE
497  nrun = nrun + nt
498 *
499 * Skip the other tests if this is not the first block
500 * size.
501 *
502  IF( inb.GT.1 )
503  $ GO TO 150
504 *
505 * Do only the condition estimate if INFO is not 0.
506 *
507  IF( trfcon ) THEN
508  rcondc = zero
509  GO TO 140
510  END IF
511 *
512 * Do for each value of NRHS in NSVAL.
513 *
514  DO 130 irhs = 1, nns
515  nrhs = nsval( irhs )
516 *
517 *+ TEST 3 (Using TRS)
518 * Solve and compute residual for A * X = B.
519 *
520 * Choose a set of NRHS random solution vectors
521 * stored in XACT and set up the right hand side B
522 *
523  srnamt = 'ZLARHS'
524  CALL zlarhs( path, xtype, uplo, ' ', n, n, kl, ku,
525  $ nrhs, a, lda, xact, lda, b, lda,
526  $ iseed, info )
527  CALL zlacpy( 'Full', n, nrhs, b, lda, x, lda )
528 *
529  srnamt = 'ZHETRS'
530  CALL zhetrs( uplo, n, nrhs, afac, lda, iwork, x,
531  $ lda, info )
532 *
533 * Check error code from ZHETRS and handle error.
534 *
535  IF( info.NE.0 )
536  $ CALL alaerh( path, 'ZHETRS', info, 0, uplo, n,
537  $ n, -1, -1, nrhs, imat, nfail,
538  $ nerrs, nout )
539 *
540  CALL zlacpy( 'Full', n, nrhs, b, lda, work, lda )
541 *
542 * Compute the residual for the solution
543 *
544  CALL zpot02( uplo, n, nrhs, a, lda, x, lda, work,
545  $ lda, rwork, result( 3 ) )
546 *
547 *+ TEST 4 (Using TRS2)
548 * Solve and compute residual for A * X = B.
549 *
550 * Choose a set of NRHS random solution vectors
551 * stored in XACT and set up the right hand side B
552 *
553  srnamt = 'ZLARHS'
554  CALL zlarhs( path, xtype, uplo, ' ', n, n, kl, ku,
555  $ nrhs, a, lda, xact, lda, b, lda,
556  $ iseed, info )
557  CALL zlacpy( 'Full', n, nrhs, b, lda, x, lda )
558 *
559  srnamt = 'ZHETRS2'
560  CALL zhetrs2( uplo, n, nrhs, afac, lda, iwork, x,
561  $ lda, work, info )
562 *
563 * Check error code from ZHETRS2 and handle error.
564 *
565  IF( info.NE.0 )
566  $ CALL alaerh( path, 'ZHETRS2', info, 0, uplo, n,
567  $ n, -1, -1, nrhs, imat, nfail,
568  $ nerrs, nout )
569 *
570  CALL zlacpy( 'Full', n, nrhs, b, lda, work, lda )
571 *
572 * Compute the residual for the solution
573 *
574  CALL zpot02( uplo, n, nrhs, a, lda, x, lda, work,
575  $ lda, rwork, result( 4 ) )
576 *
577 *+ TEST 5
578 * Check solution from generated exact solution.
579 *
580  CALL zget04( n, nrhs, x, lda, xact, lda, rcondc,
581  $ result( 5 ) )
582 *
583 *+ TESTS 6, 7, and 8
584 * Use iterative refinement to improve the solution.
585 *
586  srnamt = 'ZHERFS'
587  CALL zherfs( uplo, n, nrhs, a, lda, afac, lda,
588  $ iwork, b, lda, x, lda, rwork,
589  $ rwork( nrhs+1 ), work,
590  $ rwork( 2*nrhs+1 ), info )
591 *
592 * Check error code from ZHERFS.
593 *
594  IF( info.NE.0 )
595  $ CALL alaerh( path, 'ZHERFS', info, 0, uplo, n,
596  $ n, -1, -1, nrhs, imat, nfail,
597  $ nerrs, nout )
598 *
599  CALL zget04( n, nrhs, x, lda, xact, lda, rcondc,
600  $ result( 6 ) )
601  CALL zpot05( uplo, n, nrhs, a, lda, b, lda, x, lda,
602  $ xact, lda, rwork, rwork( nrhs+1 ),
603  $ result( 7 ) )
604 *
605 * Print information about the tests that did not pass
606 * the threshold.
607 *
608  DO 120 k = 3, 8
609  IF( result( k ).GE.thresh ) THEN
610  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
611  $ CALL alahd( nout, path )
612  WRITE( nout, fmt = 9998 )uplo, n, nrhs,
613  $ imat, k, result( k )
614  nfail = nfail + 1
615  END IF
616  120 CONTINUE
617  nrun = nrun + 6
618 *
619 * End do for each value of NRHS in NSVAL.
620 *
621  130 CONTINUE
622 *
623 *+ TEST 9
624 * Get an estimate of RCOND = 1/CNDNUM.
625 *
626  140 CONTINUE
627  anorm = zlanhe( '1', uplo, n, a, lda, rwork )
628  srnamt = 'ZHECON'
629  CALL zhecon( uplo, n, afac, lda, iwork, anorm, rcond,
630  $ work, info )
631 *
632 * Check error code from ZHECON and handle error.
633 *
634  IF( info.NE.0 )
635  $ CALL alaerh( path, 'ZHECON', info, 0, uplo, n, n,
636  $ -1, -1, -1, imat, nfail, nerrs, nout )
637 *
638  result( 9 ) = dget06( rcond, rcondc )
639 *
640 * Print information about the tests that did not pass
641 * the threshold.
642 *
643  IF( result( 9 ).GE.thresh ) THEN
644  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
645  $ CALL alahd( nout, path )
646  WRITE( nout, fmt = 9997 )uplo, n, imat, 9,
647  $ result( 9 )
648  nfail = nfail + 1
649  END IF
650  nrun = nrun + 1
651  150 CONTINUE
652  160 CONTINUE
653  170 CONTINUE
654  180 CONTINUE
655 *
656 * Print a summary of the results.
657 *
658  CALL alasum( path, nout, nfail, nrun, nerrs )
659 *
660  9999 FORMAT( ' UPLO = ''', a1, ''', N =', i5, ', NB =', i4, ', type ',
661  $ i2, ', test ', i2, ', ratio =', g12.5 )
662  9998 FORMAT( ' UPLO = ''', a1, ''', N =', i5, ', NRHS=', i3, ', type ',
663  $ i2, ', test(', i2, ') =', g12.5 )
664  9997 FORMAT( ' UPLO = ''', a1, ''', N =', i5, ',', 10x, ' type ', i2,
665  $ ', test(', i2, ') =', g12.5 )
666  RETURN
667 *
668 * End of ZCHKHE
669 *
subroutine zhecon(UPLO, N, A, LDA, IPIV, ANORM, RCOND, WORK, INFO)
ZHECON
Definition: zhecon.f:127
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
Definition: alaerh.f:149
subroutine zerrhe(PATH, NUNIT)
ZERRHE
Definition: zerrhe.f:57
double precision function dget06(RCOND, RCONDC)
DGET06
Definition: dget06.f:57
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
Definition: zlacpy.f:105
subroutine zpot05(UPLO, N, NRHS, A, LDA, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
ZPOT05
Definition: zpot05.f:167
subroutine zhetrs2(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, INFO)
ZHETRS2
Definition: zhetrs2.f:129
subroutine zpot03(UPLO, N, A, LDA, AINV, LDAINV, WORK, LDWORK, RWORK, RCOND, RESID)
ZPOT03
Definition: zpot03.f:128
double precision function zlanhe(NORM, UPLO, N, A, LDA, WORK)
ZLANHE 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: zlanhe.f:126
subroutine zlatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
ZLATB4
Definition: zlatb4.f:123
subroutine zpot02(UPLO, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
ZPOT02
Definition: zpot02.f:129
subroutine alahd(IOUNIT, PATH)
ALAHD
Definition: alahd.f:95
subroutine zlaipd(N, A, INDA, VINDA)
ZLAIPD
Definition: zlaipd.f:85
subroutine zhetri2(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
ZHETRI2
Definition: zhetri2.f:129
subroutine zhet01(UPLO, N, A, LDA, AFAC, LDAFAC, IPIV, C, LDC, RWORK, RESID)
ZHET01
Definition: zhet01.f:128
subroutine zhetrf(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
ZHETRF
Definition: zhetrf.f:179
subroutine zget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
ZGET04
Definition: zget04.f:104
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
Definition: alasum.f:75
subroutine zlarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
ZLARHS
Definition: zlarhs.f:211
subroutine zherfs(UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
ZHERFS
Definition: zherfs.f:194
subroutine zlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
ZLATMS
Definition: zlatms.f:334
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
Definition: xlaenv.f:83
subroutine zhetrs(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
ZHETRS
Definition: zhetrs.f:122

Here is the call graph for this function:

Here is the caller graph for this function:

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

ZCHKHE_ROOK

Purpose:
 ZCHKHE_ROOK tests ZHETRF_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 DOUBLE PRECISION
          The threshold value for the test ratios.  A result is
          included in the output file if RESULT >= THRESH.  To have
          every test ratio printed, use THRESH = 0.
[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 CCOMPLEX*16 array, dimension (NMAX*NMAX)
[out]AFAC
          AFAC is COMPLEX*16 array, dimension (NMAX*NMAX)
[out]AINV
          AINV is COMPLEX*16 array, dimension (NMAX*NMAX)
[out]B
          B is CCOMPLEX*16 array, dimension (NMAX*NSMAX)
          where NSMAX is the largest entry in NSVAL.
[out]X
          X is COMPLEX*16 array, dimension (NMAX*NSMAX)
[out]XACT
          XACT is COMPLEX*16 array, dimension (NMAX*NSMAX)
[out]WORK
          WORK is COMPLEX*16 array, dimension (NMAX*max(3,NSMAX))
[out]RWORK
          RWORK is DOUBLE PRECISION 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 zchkhe_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  DOUBLE PRECISION thresh
184 * ..
185 * .. Array Arguments ..
186  LOGICAL dotype( * )
187  INTEGER iwork( * ), nbval( * ), nsval( * ), nval( * )
188  DOUBLE PRECISION rwork( * )
189  COMPLEX*16 a( * ), afac( * ), ainv( * ), b( * ),
190  $ work( * ), x( * ), xact( * )
191 * ..
192 *
193 * =====================================================================
194 *
195 * .. Parameters ..
196  DOUBLE PRECISION zero, one
197  parameter( zero = 0.0d+0, one = 1.0d+0 )
198  DOUBLE PRECISION onehalf
199  parameter( onehalf = 0.5d+0 )
200  DOUBLE PRECISION eight, sevten
201  parameter( eight = 8.0d+0, sevten = 17.0d+0 )
202  COMPLEX*16 czero
203  parameter( czero = ( 0.0d+0, 0.0d+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  DOUBLE PRECISION alpha, anorm, cndnum, const, sing_max,
218  $ sing_min, rcond, rcondc, dtemp
219 * ..
220 * .. Local Arrays ..
221  CHARACTER uplos( 2 )
222  INTEGER iseed( 4 ), iseedy( 4 ), idummy( 1 )
223  DOUBLE PRECISION result( ntests )
224  COMPLEX*16 block( 2, 2 ), zdummy( 1 )
225 * ..
226 * .. External Functions ..
227  DOUBLE PRECISION zlange, zlanhe, dget06
228  EXTERNAL zlange, zlanhe, dget06
229 * ..
230 * .. External Subroutines ..
231  EXTERNAL alaerh, alahd, alasum, zerrhe, zgesvd, zget04,
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 ) = 'Zomplex precision'
261  path( 2: 3 ) = 'HR'
262 *
263 * Path to generate matrices
264 *
265  matpath( 1: 1 ) = 'Zomplex 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 zerrhe( 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 ZLATB4 for the matrix generator
321 * based on the type of matrix to be generated.
322 *
323  CALL zlatb4( matpath, imat, n, n, TYPE, kl, ku, anorm,
324  $ mode, cndnum, dist )
325 *
326 * Generate a matrix with ZLATMS.
327 *
328  srnamt = 'ZLATMS'
329  CALL zlatms( n, n, dist, iseed, TYPE, rwork, mode,
330  $ cndnum, anorm, kl, ku, uplo, a, lda,
331  $ work, info )
332 *
333 * Check error code from ZLATMS and handle error.
334 *
335  IF( info.NE.0 ) THEN
336  CALL alaerh( path, 'ZLATMS', 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 zlacpy( 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 = 'ZHETRF_ROOK'
439  CALL zhetrf_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 ZHETRF_ROOK and handle error.
460 *
461  IF( info.NE.k)
462  $ CALL alaerh( path, 'ZHETRF_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 zhet01_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 zlacpy( uplo, n, n, afac, lda, ainv, lda )
489  srnamt = 'ZHETRI_ROOK'
490  CALL zhetri_rook( uplo, n, ainv, lda, iwork, work,
491  $ info )
492 *
493 * Check error code from ZHETRI_ROOK and handle error.
494 *
495  IF( info.NE.0 )
496  $ CALL alaerh( path, 'ZHETRI_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 zpot03( 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  dtemp = 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  dtemp = zlange( '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  dtemp = zlange( 'M', k-2, 2,
553  $ afac( ( k-2 )*lda+1 ), lda, rwork )
554  k = k - 1
555 *
556  END IF
557 *
558 * DTEMP should be bounded by CONST
559 *
560  dtemp = dtemp - const + thresh
561  IF( dtemp.GT.result( 3 ) )
562  $ result( 3 ) = dtemp
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  dtemp = zlange( '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  dtemp = zlange( 'M', n-k-1, 2,
591  $ afac( ( k-1 )*lda+k+2 ), lda, rwork )
592  k = k + 1
593 *
594  END IF
595 *
596 * DTEMP should be bounded by CONST
597 *
598  dtemp = dtemp - const + thresh
599  IF( dtemp.GT.result( 3 ) )
600  $ result( 3 ) = dtemp
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  dtemp = zero
615 *
616  const = ( ( alpha**2-one ) / ( alpha**2-onehalf ) )*
617  $ ( ( one + alpha ) / ( one - alpha ) )
618  CALL zlacpy( 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 zgesvd( 'N', 'N', 2, 2, block, 2, rwork,
641  $ zdummy, 1, zdummy, 1,
642  $ work, 6, rwork( 3 ), info )
643 *
644 *
645  sing_max = rwork( 1 )
646  sing_min = rwork( 2 )
647 *
648  dtemp = sing_max / sing_min
649 *
650 * DTEMP should be bounded by CONST
651 *
652  dtemp = dtemp - const + thresh
653  IF( dtemp.GT.result( 4 ) )
654  $ result( 4 ) = dtemp
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 zgesvd( 'N', 'N', 2, 2, block, 2, rwork,
685  $ zdummy, 1, zdummy, 1,
686  $ work, 6, rwork(3), info )
687 *
688  sing_max = rwork( 1 )
689  sing_min = rwork( 2 )
690 *
691  dtemp = sing_max / sing_min
692 *
693 * DTEMP should be bounded by CONST
694 *
695  dtemp = dtemp - const + thresh
696  IF( dtemp.GT.result( 4 ) )
697  $ result( 4 ) = dtemp
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 = 'ZLARHS'
750  CALL zlarhs( matpath, xtype, uplo, ' ', n, n,
751  $ kl, ku, nrhs, a, lda, xact, lda,
752  $ b, lda, iseed, info )
753  CALL zlacpy( 'Full', n, nrhs, b, lda, x, lda )
754 *
755  srnamt = 'ZHETRS_ROOK'
756  CALL zhetrs_rook( uplo, n, nrhs, afac, lda, iwork,
757  $ x, lda, info )
758 *
759 * Check error code from ZHETRS_ROOK and handle error.
760 *
761  IF( info.NE.0 )
762  $ CALL alaerh( path, 'ZHETRS_ROOK', info, 0,
763  $ uplo, n, n, -1, -1, nrhs, imat,
764  $ nfail, nerrs, nout )
765 *
766  CALL zlacpy( 'Full', n, nrhs, b, lda, work, lda )
767 *
768 * Compute the residual for the solution
769 *
770  CALL zpot02( 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 zget04( 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 = zlanhe( '1', uplo, n, a, lda, rwork )
802  srnamt = 'ZHECON_ROOK'
803  CALL zhecon_rook( uplo, n, afac, lda, iwork, anorm,
804  $ rcond, work, info )
805 *
806 * Check error code from ZHECON_ROOK and handle error.
807 *
808  IF( info.NE.0 )
809  $ CALL alaerh( path, 'ZHECON_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 ) = dget06( 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 ZCHKHE_ROOK
847 *
subroutine zhetrs_rook(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
ZHETRS_ROOK computes the solution to a system of linear equations A * X = B for HE matrices using fac...
Definition: zhetrs_rook.f:138
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
Definition: alaerh.f:149
subroutine zerrhe(PATH, NUNIT)
ZERRHE
Definition: zerrhe.f:57
double precision function dget06(RCOND, RCONDC)
DGET06
Definition: dget06.f:57
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
Definition: zlacpy.f:105
subroutine zhet01_rook(UPLO, N, A, LDA, AFAC, LDAFAC, IPIV, C, LDC, RWORK, RESID)
ZHET01_ROOK
Definition: zhet01_rook.f:127
subroutine zpot03(UPLO, N, A, LDA, AINV, LDAINV, WORK, LDWORK, RWORK, RCOND, RESID)
ZPOT03
Definition: zpot03.f:128
double precision function zlanhe(NORM, UPLO, N, A, LDA, WORK)
ZLANHE 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: zlanhe.f:126
subroutine zhetri_rook(UPLO, N, A, LDA, IPIV, WORK, INFO)
ZHETRI_ROOK computes the inverse of HE matrix using the factorization obtained with the bounded Bunch...
Definition: zhetri_rook.f:130
subroutine zlatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
ZLATB4
Definition: zlatb4.f:123
subroutine zpot02(UPLO, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
ZPOT02
Definition: zpot02.f:129
subroutine zhetrf_rook(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
ZHETRF_ROOK computes the factorization of a complex Hermitian indefinite matrix using the bounded Bun...
Definition: zhetrf_rook.f:214
subroutine alahd(IOUNIT, PATH)
ALAHD
Definition: alahd.f:95
subroutine zgesvd(JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, WORK, LWORK, RWORK, INFO)
ZGESVD computes the singular value decomposition (SVD) for GE matrices
Definition: zgesvd.f:216
double precision function zlange(NORM, M, N, A, LDA, WORK)
ZLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
Definition: zlange.f:117
subroutine zget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
ZGET04
Definition: zget04.f:104
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
Definition: alasum.f:75
subroutine zlarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
ZLARHS
Definition: zlarhs.f:211
subroutine zlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
ZLATMS
Definition: zlatms.f:334
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
Definition: xlaenv.f:83
subroutine zhecon_rook(UPLO, N, A, LDA, IPIV, ANORM, RCOND, WORK, INFO)
ZHECON_ROOK estimates the reciprocal of the condition number fort HE matrices using factorization obt...
Definition: zhecon_rook.f:141

Here is the call graph for this function:

Here is the caller graph for this function:

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

ZCHKHP

Purpose:
 ZCHKHP tests ZHPTRF, -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 DOUBLE PRECISION
          The threshold value for the test ratios.  A result is
          included in the output file if RESULT >= THRESH.  To have
          every test ratio printed, use THRESH = 0.
[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*16 array, dimension
                      (NMAX*(NMAX+1)/2)
[out]AFAC
          AFAC is COMPLEX*16 array, dimension
                      (NMAX*(NMAX+1)/2)
[out]AINV
          AINV is COMPLEX*16 array, dimension
                      (NMAX*(NMAX+1)/2)
[out]B
          B is COMPLEX*16 array, dimension (NMAX*NSMAX)
          where NSMAX is the largest entry in NSVAL.
[out]X
          X is COMPLEX*16 array, dimension (NMAX*NSMAX)
[out]XACT
          XACT is COMPLEX*16 array, dimension (NMAX*NSMAX)
[out]WORK
          WORK is COMPLEX*16 array, dimension
                      (NMAX*max(2,NSMAX))
[out]RWORK
          RWORK is DOUBLE PRECISION 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 zchkhp.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  DOUBLE PRECISION thresh
176 * ..
177 * .. Array Arguments ..
178  LOGICAL dotype( * )
179  INTEGER iwork( * ), nsval( * ), nval( * )
180  DOUBLE PRECISION rwork( * )
181  COMPLEX*16 a( * ), afac( * ), ainv( * ), b( * ),
182  $ work( * ), x( * ), xact( * )
183 * ..
184 *
185 * =====================================================================
186 *
187 * .. Parameters ..
188  DOUBLE PRECISION zero
189  parameter( zero = 0.0d+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  DOUBLE PRECISION anorm, cndnum, rcond, rcondc
203 * ..
204 * .. Local Arrays ..
205  CHARACTER uplos( 2 )
206  INTEGER iseed( 4 ), iseedy( 4 )
207  DOUBLE PRECISION result( ntests )
208 * ..
209 * .. External Functions ..
210  LOGICAL lsame
211  DOUBLE PRECISION dget06, zlanhp
212  EXTERNAL lsame, dget06, zlanhp
213 * ..
214 * .. External Subroutines ..
215  EXTERNAL alaerh, alahd, alasum, zcopy, zerrsy, zget04,
218  $ zppt03, zppt05
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 ) = 'Zomplex 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 zerrsy( 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 ZLATB4 and generate a test matrix
290 * with ZLATMS.
291 *
292  CALL zlatb4( path, imat, n, n, TYPE, kl, ku, anorm, mode,
293  $ cndnum, dist )
294 *
295  srnamt = 'ZLATMS'
296  CALL zlatms( n, n, dist, iseed, TYPE, rwork, mode,
297  $ cndnum, anorm, kl, ku, packit, a, lda, work,
298  $ info )
299 *
300 * Check error code from ZLATMS.
301 *
302  IF( info.NE.0 ) THEN
303  CALL alaerh( path, 'ZLATMS', 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 zlaipd( n, a, 2, 1 )
379  ELSE
380  CALL zlaipd( 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 zcopy( npp, a, 1, afac, 1 )
387  srnamt = 'ZHPTRF'
388  CALL zhptrf( 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 ZHPTRF.
408 *
409  IF( info.NE.k )
410  $ CALL alaerh( path, 'ZHPTRF', 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 zhpt01( 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 zcopy( npp, afac, 1, ainv, 1 )
430  srnamt = 'ZHPTRI'
431  CALL zhptri( uplo, n, ainv, iwork, work, info )
432 *
433 * Check error code from ZHPTRI.
434 *
435  IF( info.NE.0 )
436  $ CALL alaerh( path, 'ZHPTRI', info, 0, uplo, n, n,
437  $ -1, -1, -1, imat, nfail, nerrs, nout )
438 *
439  CALL zppt03( 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 = 'ZLARHS'
472  CALL zlarhs( path, xtype, uplo, ' ', n, n, kl, ku,
473  $ nrhs, a, lda, xact, lda, b, lda, iseed,
474  $ info )
475  xtype = 'C'
476  CALL zlacpy( 'Full', n, nrhs, b, lda, x, lda )
477 *
478  srnamt = 'ZHPTRS'
479  CALL zhptrs( uplo, n, nrhs, afac, iwork, x, lda,
480  $ info )
481 *
482 * Check error code from ZHPTRS.
483 *
484  IF( info.NE.0 )
485  $ CALL alaerh( path, 'ZHPTRS', info, 0, uplo, n, n,
486  $ -1, -1, nrhs, imat, nfail, nerrs,
487  $ nout )
488 *
489  CALL zlacpy( 'Full', n, nrhs, b, lda, work, lda )
490  CALL zppt02( 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 zget04( 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 = 'ZHPRFS'
503  CALL zhprfs( 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 ZHPRFS.
508 *
509  IF( info.NE.0 )
510  $ CALL alaerh( path, 'ZHPRFS', info, 0, uplo, n, n,
511  $ -1, -1, nrhs, imat, nfail, nerrs,
512  $ nout )
513 *
514  CALL zget04( n, nrhs, x, lda, xact, lda, rcondc,
515  $ result( 5 ) )
516  CALL zppt05( 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 = zlanhp( '1', uplo, n, a, rwork )
540  srnamt = 'ZHPCON'
541  CALL zhpcon( uplo, n, afac, iwork, anorm, rcond, work,
542  $ info )
543 *
544 * Check error code from ZHPCON.
545 *
546  IF( info.NE.0 )
547  $ CALL alaerh( path, 'ZHPCON', info, 0, uplo, n, n, -1,
548  $ -1, -1, imat, nfail, nerrs, nout )
549 *
550  result( 8 ) = dget06( 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 ZCHKHP
577 *
subroutine zerrsy(PATH, NUNIT)
ZERRSY
Definition: zerrsy.f:57
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
Definition: alaerh.f:149
double precision function dget06(RCOND, RCONDC)
DGET06
Definition: dget06.f:57
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
Definition: zlacpy.f:105
subroutine zcopy(N, ZX, INCX, ZY, INCY)
ZCOPY
Definition: zcopy.f:52
subroutine zppt03(UPLO, N, A, AINV, WORK, LDWORK, RWORK, RCOND, RESID)
ZPPT03
Definition: zppt03.f:112
subroutine zlatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
ZLATB4
Definition: zlatb4.f:123
subroutine zhptrf(UPLO, N, AP, IPIV, INFO)
ZHPTRF
Definition: zhptrf.f:161
subroutine zppt02(UPLO, N, NRHS, A, X, LDX, B, LDB, RWORK, RESID)
ZPPT02
Definition: zppt02.f:125
subroutine alahd(IOUNIT, PATH)
ALAHD
Definition: alahd.f:95
subroutine zlaipd(N, A, INDA, VINDA)
ZLAIPD
Definition: zlaipd.f:85
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:55
subroutine zhprfs(UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
ZHPRFS
Definition: zhprfs.f:182
double precision function zlanhp(NORM, UPLO, N, AP, WORK)
ZLANHP 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: zlanhp.f:119
subroutine zppt05(UPLO, N, NRHS, AP, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
ZPPT05
Definition: zppt05.f:159
subroutine zhpt01(UPLO, N, A, AFAC, IPIV, C, LDC, RWORK, RESID)
ZHPT01
Definition: zhpt01.f:115
subroutine zget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
ZGET04
Definition: zget04.f:104
subroutine zhpcon(UPLO, N, AP, IPIV, ANORM, RCOND, WORK, INFO)
ZHPCON
Definition: zhpcon.f:120
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
Definition: alasum.f:75
subroutine zlarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
ZLARHS
Definition: zlarhs.f:211
subroutine zhptrs(UPLO, N, NRHS, AP, IPIV, B, LDB, INFO)
ZHPTRS
Definition: zhptrs.f:117
subroutine zlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
ZLATMS
Definition: zlatms.f:334
subroutine zhptri(UPLO, N, AP, IPIV, WORK, INFO)
ZHPTRI
Definition: zhptri.f:111

Here is the call graph for this function:

Here is the caller graph for this function:

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

ZCHKLQ

Purpose:
 ZCHKLQ tests ZGELQF, ZUNGLQ 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 DOUBLE PRECISION
          The threshold value for the test ratios.  A result is
          included in the output file if RESULT >= THRESH.  To have
          every test ratio printed, use THRESH = 0.
[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*16 array, dimension (NMAX*NMAX)
[out]AF
          AF is COMPLEX*16 array, dimension (NMAX*NMAX)
[out]AQ
          AQ is COMPLEX*16 array, dimension (NMAX*NMAX)
[out]AL
          AL is COMPLEX*16 array, dimension (NMAX*NMAX)
[out]AC
          AC is COMPLEX*16 array, dimension (NMAX*NMAX)
[out]B
          B is COMPLEX*16 array, dimension (NMAX*NRHS)
[out]X
          X is COMPLEX*16 array, dimension (NMAX*NRHS)
[out]XACT
          XACT is COMPLEX*16 array, dimension (NMAX*NRHS)
[out]TAU
          TAU is COMPLEX*16 array, dimension (NMAX)
[out]WORK
          WORK is COMPLEX*16 array, dimension (NMAX*NMAX)
[out]RWORK
          RWORK is DOUBLE PRECISION 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 zchklq.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  DOUBLE PRECISION thresh
208 * ..
209 * .. Array Arguments ..
210  LOGICAL dotype( * )
211  INTEGER mval( * ), nbval( * ), nval( * ),
212  $ nxval( * )
213  DOUBLE PRECISION rwork( * )
214  COMPLEX*16 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  DOUBLE PRECISION zero
226  parameter( zero = 0.0d0 )
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  DOUBLE PRECISION anorm, cndnum
235 * ..
236 * .. Local Arrays ..
237  INTEGER iseed( 4 ), iseedy( 4 ), kval( 4 )
238  DOUBLE PRECISION result( ntests )
239 * ..
240 * .. External Subroutines ..
241  EXTERNAL alaerh, alahd, alasum, xlaenv, zerrlq, zgelqs,
243  $ zlqt02, zlqt03
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 ) = 'Zomplex 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 zerrlq( 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 ZLATB4 and generate a test matrix
301 * with ZLATMS.
302 *
303  CALL zlatb4( path, imat, m, n, TYPE, kl, ku, anorm, mode,
304  $ cndnum, dist )
305 *
306  srnamt = 'ZLATMS'
307  CALL zlatms( 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 ZLATMS.
312 *
313  IF( info.NE.0 ) THEN
314  CALL alaerh( path, 'ZLATMS', 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 ZLQT01; other values are
321 * used in the calls of ZLQT02, 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 ZGELQF
356 *
357  CALL zlqt01( m, n, a, af, aq, al, lda, tau,
358  $ work, lwork, rwork, result( 1 ) )
359  ELSE IF( m.LE.n ) THEN
360 *
361 * Test ZUNGLQ, using factorization
362 * returned by ZLQT01
363 *
364  CALL zlqt02( 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 ZUNMLQ, using factorization returned
370 * by ZLQT01
371 *
372  CALL zlqt03( 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 ZGELQS 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 = 'ZLARHS'
386  CALL zlarhs( path, 'New', 'Full',
387  $ 'No transpose', m, n, 0, 0,
388  $ nrhs, a, lda, xact, lda, b, lda,
389  $ iseed, info )
390 *
391  CALL zlacpy( 'Full', m, nrhs, b, lda, x,
392  $ lda )
393  srnamt = 'ZGELQS'
394  CALL zgelqs( m, n, nrhs, af, lda, tau, x,
395  $ lda, work, lwork, info )
396 *
397 * Check error code from ZGELQS.
398 *
399  IF( info.NE.0 )
400  $ CALL alaerh( path, 'ZGELQS', info, 0, ' ',
401  $ m, n, nrhs, -1, nb, imat,
402  $ nfail, nerrs, nout )
403 *
404  CALL zget02( '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 ZCHKLQ
439 *
subroutine zgelqs(M, N, NRHS, A, LDA, TAU, B, LDB, WORK, LWORK, INFO)
ZGELQS
Definition: zgelqs.f:123
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
Definition: alaerh.f:149
subroutine zlqt01(M, N, A, AF, Q, L, LDA, TAU, WORK, LWORK, RWORK, RESULT)
ZLQT01
Definition: zlqt01.f:128
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
Definition: zlacpy.f:105
subroutine zlatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
ZLATB4
Definition: zlatb4.f:123
subroutine alahd(IOUNIT, PATH)
ALAHD
Definition: alahd.f:95
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
Definition: alasum.f:75
subroutine zlarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
ZLARHS
Definition: zlarhs.f:211
subroutine zget02(TRANS, M, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
ZGET02
Definition: zget02.f:135
subroutine zlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
ZLATMS
Definition: zlatms.f:334
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
Definition: xlaenv.f:83
subroutine zlqt03(M, N, K, AF, C, CC, Q, LDA, TAU, WORK, LWORK, RWORK, RESULT)
ZLQT03
Definition: zlqt03.f:138
subroutine zerrlq(PATH, NUNIT)
ZERRLQ
Definition: zerrlq.f:57
subroutine zlqt02(M, N, K, A, AF, Q, L, LDA, TAU, WORK, LWORK, RWORK, RESULT)
ZLQT02
Definition: zlqt02.f:137

Here is the call graph for this function:

Here is the caller graph for this function:

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

ZCHKPB

Purpose:
 ZCHKPB tests ZPBTRF, -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 DOUBLE PRECISION
          The threshold value for the test ratios.  A result is
          included in the output file if RESULT >= THRESH.  To have
          every test ratio printed, use THRESH = 0.
[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 DOUBLE PRECISION array, dimension (NMAX*NMAX)
[out]AFAC
          AFAC is DOUBLE PRECISION array, dimension (NMAX*NMAX)
[out]AINV
          AINV is DOUBLE PRECISION array, dimension (NMAX*NMAX)
[out]B
          B is DOUBLE PRECISION array, dimension (NMAX*NSMAX)
          where NSMAX is the largest entry in NSVAL.
[out]X
          X is DOUBLE PRECISION array, dimension (NMAX*NSMAX)
[out]XACT
          XACT is DOUBLE PRECISION array, dimension (NMAX*NSMAX)
[out]WORK
          WORK is DOUBLE PRECISION array, dimension
                      (NMAX*max(3,NSMAX))
[out]RWORK
          RWORK is DOUBLE PRECISION 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 zchkpb.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  DOUBLE PRECISION thresh
180 * ..
181 * .. Array Arguments ..
182  LOGICAL dotype( * )
183  INTEGER nbval( * ), nsval( * ), nval( * )
184  DOUBLE PRECISION rwork( * )
185  COMPLEX*16 a( * ), afac( * ), ainv( * ), b( * ),
186  $ work( * ), x( * ), xact( * )
187 * ..
188 *
189 * =====================================================================
190 *
191 * .. Parameters ..
192  DOUBLE PRECISION one, zero
193  parameter( one = 1.0d+0, zero = 0.0d+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  DOUBLE PRECISION ainvnm, anorm, cndnum, rcond, rcondc
208 * ..
209 * .. Local Arrays ..
210  INTEGER iseed( 4 ), iseedy( 4 ), kdval( nbw )
211  DOUBLE PRECISION result( ntests )
212 * ..
213 * .. External Functions ..
214  DOUBLE PRECISION dget06, zlange, zlanhb
215  EXTERNAL dget06, zlange, zlanhb
216 * ..
217 * .. External Subroutines ..
218  EXTERNAL alaerh, alahd, alasum, xlaenv, zcopy, zerrpo,
221  $ zpbtrf, zpbtrs, zswap
222 * ..
223 * .. Intrinsic Functions ..
224  INTRINSIC dcmplx, 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 ) = 'Zomplex 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 zerrpo( 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 ZLATB4 and generate a test
314 * matrix with ZLATMS.
315 *
316  CALL zlatb4( path, imat, n, n, TYPE, kl, ku, anorm,
317  $ mode, cndnum, dist )
318 *
319  srnamt = 'ZLATMS'
320  CALL zlatms( 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 ZLATMS.
325 *
326  IF( info.NE.0 ) THEN
327  CALL alaerh( path, 'ZLATMS', 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 zcopy( izero-i1, work( iw ), 1,
341  $ a( ioff-izero+i1 ), 1 )
342  iw = iw + izero - i1
343  CALL zcopy( i2-izero+1, work( iw ), 1,
344  $ a( ioff ), max( ldab-1, 1 ) )
345  ELSE
346  ioff = ( i1-1 )*ldab + 1
347  CALL zcopy( 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 zcopy( 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 zswap( izero-i1, a( ioff-izero+i1 ), 1,
383  $ work( iw ), 1 )
384  iw = iw + izero - i1
385  CALL zswap( i2-izero+1, a( ioff ),
386  $ max( ldab-1, 1 ), work( iw ), 1 )
387  ELSE
388  ioff = ( i1-1 )*ldab + 1
389  CALL zswap( 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 zswap( 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 zlaipd( n, a( kd+1 ), ldab, 0 )
402  ELSE
403  CALL zlaipd( 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 zlacpy( 'Full', kd+1, n, a, ldab, afac, ldab )
416  srnamt = 'ZPBTRF'
417  CALL zpbtrf( uplo, n, kd, afac, ldab, info )
418 *
419 * Check error code from ZPBTRF.
420 *
421  IF( info.NE.izero ) THEN
422  CALL alaerh( path, 'ZPBTRF', 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 zlacpy( 'Full', kd+1, n, afac, ldab, ainv,
438  $ ldab )
439  CALL zpbt01( 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 zlaset( 'Full', n, n, dcmplx( zero ),
462  $ dcmplx( one ), ainv, lda )
463  srnamt = 'ZPBTRS'
464  CALL zpbtrs( uplo, n, kd, n, afac, ldab, ainv, lda,
465  $ info )
466 *
467 * Compute RCONDC = 1/(norm(A) * norm(inv(A))).
468 *
469  anorm = zlanhb( '1', uplo, n, kd, a, ldab, rwork )
470  ainvnm = zlange( '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 = 'ZLARHS'
484  CALL zlarhs( path, xtype, uplo, ' ', n, n, kd,
485  $ kd, nrhs, a, ldab, xact, lda, b,
486  $ lda, iseed, info )
487  CALL zlacpy( 'Full', n, nrhs, b, lda, x, lda )
488 *
489  srnamt = 'ZPBTRS'
490  CALL zpbtrs( uplo, n, kd, nrhs, afac, ldab, x,
491  $ lda, info )
492 *
493 * Check error code from ZPBTRS.
494 *
495  IF( info.NE.0 )
496  $ CALL alaerh( path, 'ZPBTRS', info, 0, uplo,
497  $ n, n, kd, kd, nrhs, imat, nfail,
498  $ nerrs, nout )
499 *
500  CALL zlacpy( 'Full', n, nrhs, b, lda, work,
501  $ lda )
502  CALL zpbt02( 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 zget04( 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 = 'ZPBRFS'
515  CALL zpbrfs( 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 ZPBRFS.
521 *
522  IF( info.NE.0 )
523  $ CALL alaerh( path, 'ZPBRFS', info, 0, uplo,
524  $ n, n, kd, kd, nrhs, imat, nfail,
525  $ nerrs, nout )
526 *
527  CALL zget04( n, nrhs, x, lda, xact, lda, rcondc,
528  $ result( 4 ) )
529  CALL zpbt05( 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 = 'ZPBCON'
552  CALL zpbcon( uplo, n, kd, afac, ldab, anorm, rcond,
553  $ work, rwork, info )
554 *
555 * Check error code from ZPBCON.
556 *
557  IF( info.NE.0 )
558  $ CALL alaerh( path, 'ZPBCON', info, 0, uplo, n,
559  $ n, kd, kd, -1, imat, nfail, nerrs,
560  $ nout )
561 *
562  result( 7 ) = dget06( 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 ZCHKPB
593 *
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
Definition: alaerh.f:149
double precision function dget06(RCOND, RCONDC)
DGET06
Definition: dget06.f:57
subroutine zpbrfs(UPLO, N, KD, NRHS, AB, LDAB, AFB, LDAFB, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
ZPBRFS
Definition: zpbrfs.f:191
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
Definition: zlacpy.f:105
subroutine zcopy(N, ZX, INCX, ZY, INCY)
ZCOPY
Definition: zcopy.f:52
subroutine zpbt01(UPLO, N, KD, A, LDA, AFAC, LDAFAC, RWORK, RESID)
ZPBT01
Definition: zpbt01.f:122
subroutine zpbt05(UPLO, N, KD, NRHS, AB, LDAB, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
ZPBT05
Definition: zpbt05.f:173
subroutine zpbcon(UPLO, N, KD, AB, LDAB, ANORM, RCOND, WORK, RWORK, INFO)
ZPBCON
Definition: zpbcon.f:135
subroutine zpbtrf(UPLO, N, KD, AB, LDAB, INFO)
ZPBTRF
Definition: zpbtrf.f:144
subroutine zlatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
ZLATB4
Definition: zlatb4.f:123
subroutine zlaset(UPLO, M, N, ALPHA, BETA, A, LDA)
ZLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
Definition: zlaset.f:108
subroutine alahd(IOUNIT, PATH)
ALAHD
Definition: alahd.f:95
subroutine zlaipd(N, A, INDA, VINDA)
ZLAIPD
Definition: zlaipd.f:85
double precision function zlanhb(NORM, UPLO, N, K, AB, LDAB, WORK)
ZLANHB 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: zlanhb.f:134
double precision function zlange(NORM, M, N, A, LDA, WORK)
ZLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
Definition: zlange.f:117
subroutine zget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
ZGET04
Definition: zget04.f:104
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
Definition: alasum.f:75
subroutine zlarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
ZLARHS
Definition: zlarhs.f:211
subroutine zpbt02(UPLO, N, KD, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
ZPBT02
Definition: zpbt02.f:138
subroutine zpbtrs(UPLO, N, KD, NRHS, AB, LDAB, B, LDB, INFO)
ZPBTRS
Definition: zpbtrs.f:123
subroutine zswap(N, ZX, INCX, ZY, INCY)
ZSWAP
Definition: zswap.f:52
subroutine zlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
ZLATMS
Definition: zlatms.f:334
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
Definition: xlaenv.f:83
subroutine zerrpo(PATH, NUNIT)
ZERRPO
Definition: zerrpo.f:57

Here is the call graph for this function:

Here is the caller graph for this function:

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

ZCHKPO

Purpose:
 ZCHKPO tests ZPOTRF, -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 DOUBLE PRECISION
          The threshold value for the test ratios.  A result is
          included in the output file if RESULT >= THRESH.  To have
          every test ratio printed, use THRESH = 0.
[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*16 array, dimension (NMAX*NMAX)
[out]AFAC
          AFAC is COMPLEX*16 array, dimension (NMAX*NMAX)
[out]AINV
          AINV is COMPLEX*16 array, dimension (NMAX*NMAX)
[out]B
          B is COMPLEX*16 array, dimension (NMAX*NSMAX)
          where NSMAX is the largest entry in NSVAL.
[out]X
          X is COMPLEX*16 array, dimension (NMAX*NSMAX)
[out]XACT
          XACT is COMPLEX*16 array, dimension (NMAX*NSMAX)
[out]WORK
          WORK is COMPLEX*16 array, dimension
                      (NMAX*max(3,NSMAX))
[out]RWORK
          RWORK is DOUBLE PRECISION 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 zchkpo.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  DOUBLE PRECISION thresh
180 * ..
181 * .. Array Arguments ..
182  LOGICAL dotype( * )
183  INTEGER nbval( * ), nsval( * ), nval( * )
184  DOUBLE PRECISION rwork( * )
185  COMPLEX*16 a( * ), afac( * ), ainv( * ), b( * ),
186  $ work( * ), x( * ), xact( * )
187 * ..
188 *
189 * =====================================================================
190 *
191 * .. Parameters ..
192  COMPLEX*16 czero
193  parameter( czero = ( 0.0d+0, 0.0d+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  DOUBLE PRECISION anorm, cndnum, rcond, rcondc
207 * ..
208 * .. Local Arrays ..
209  CHARACTER uplos( 2 )
210  INTEGER iseed( 4 ), iseedy( 4 )
211  DOUBLE PRECISION result( ntests )
212 * ..
213 * .. External Functions ..
214  DOUBLE PRECISION dget06, zlanhe
215  EXTERNAL dget06, zlanhe
216 * ..
217 * .. External Subroutines ..
218  EXTERNAL alaerh, alahd, alasum, xlaenv, zerrpo, zget04,
221  $ zpotri, zpotrs
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 ) = 'Zomplex 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 zerrpo( 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 ZLATB4 and generate a test matrix
288 * with ZLATMS.
289 *
290  CALL zlatb4( path, imat, n, n, TYPE, kl, ku, anorm, mode,
291  $ cndnum, dist )
292 *
293  srnamt = 'ZLATMS'
294  CALL zlatms( n, n, dist, iseed, TYPE, rwork, mode,
295  $ cndnum, anorm, kl, ku, uplo, a, lda, work,
296  $ info )
297 *
298 * Check error code from ZLATMS.
299 *
300  IF( info.NE.0 ) THEN
301  CALL alaerh( path, 'ZLATMS', 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 zlaipd( 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 zlacpy( uplo, n, n, a, lda, afac, lda )
358  srnamt = 'ZPOTRF'
359  CALL zpotrf( uplo, n, afac, lda, info )
360 *
361 * Check error code from ZPOTRF.
362 *
363  IF( info.NE.izero ) THEN
364  CALL alaerh( path, 'ZPOTRF', 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 zlacpy( uplo, n, n, afac, lda, ainv, lda )
379  CALL zpot01( 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 zlacpy( uplo, n, n, afac, lda, ainv, lda )
386  srnamt = 'ZPOTRI'
387  CALL zpotri( uplo, n, ainv, lda, info )
388 *
389 * Check error code from ZPOTRI.
390 *
391  IF( info.NE.0 )
392  $ CALL alaerh( path, 'ZPOTRI', info, 0, uplo, n, n,
393  $ -1, -1, -1, imat, nfail, nerrs, nout )
394 *
395  CALL zpot03( 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 = 'ZLARHS'
425  CALL zlarhs( path, xtype, uplo, ' ', n, n, kl, ku,
426  $ nrhs, a, lda, xact, lda, b, lda,
427  $ iseed, info )
428  CALL zlacpy( 'Full', n, nrhs, b, lda, x, lda )
429 *
430  srnamt = 'ZPOTRS'
431  CALL zpotrs( uplo, n, nrhs, afac, lda, x, lda,
432  $ info )
433 *
434 * Check error code from ZPOTRS.
435 *
436  IF( info.NE.0 )
437  $ CALL alaerh( path, 'ZPOTRS', info, 0, uplo, n,
438  $ n, -1, -1, nrhs, imat, nfail,
439  $ nerrs, nout )
440 *
441  CALL zlacpy( 'Full', n, nrhs, b, lda, work, lda )
442  CALL zpot02( 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 zget04( 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 = 'ZPORFS'
455  CALL zporfs( 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 ZPORFS.
460 *
461  IF( info.NE.0 )
462  $ CALL alaerh( path, 'ZPORFS', info, 0, uplo, n,
463  $ n, -1, -1, nrhs, imat, nfail,
464  $ nerrs, nout )
465 *
466  CALL zget04( n, nrhs, x, lda, xact, lda, rcondc,
467  $ result( 5 ) )
468  CALL zpot05( 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 = zlanhe( '1', uplo, n, a, lda, rwork )
491  srnamt = 'ZPOCON'
492  CALL zpocon( uplo, n, afac, lda, anorm, rcond, work,
493  $ rwork, info )
494 *
495 * Check error code from ZPOCON.
496 *
497  IF( info.NE.0 )
498  $ CALL alaerh( path, 'ZPOCON', info, 0, uplo, n, n,
499  $ -1, -1, -1, imat, nfail, nerrs, nout )
500 *
501  result( 8 ) = dget06( 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 ZCHKPO
531 *
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
Definition: alaerh.f:149
subroutine zpotrf(UPLO, N, A, LDA, INFO)
ZPOTRF VARIANT: right looking block version of the algorithm, calling Level 3 BLAS.
Definition: zpotrf.f:102
double precision function dget06(RCOND, RCONDC)
DGET06
Definition: dget06.f:57
subroutine zpotri(UPLO, N, A, LDA, INFO)
ZPOTRI
Definition: zpotri.f:97
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
Definition: zlacpy.f:105
subroutine zpot05(UPLO, N, NRHS, A, LDA, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
ZPOT05
Definition: zpot05.f:167
subroutine zpotrs(UPLO, N, NRHS, A, LDA, B, LDB, INFO)
ZPOTRS
Definition: zpotrs.f:112
subroutine zpot03(UPLO, N, A, LDA, AINV, LDAINV, WORK, LDWORK, RWORK, RCOND, RESID)
ZPOT03
Definition: zpot03.f:128
double precision function zlanhe(NORM, UPLO, N, A, LDA, WORK)
ZLANHE 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: zlanhe.f:126
subroutine zpot01(UPLO, N, A, LDA, AFAC, LDAFAC, RWORK, RESID)
ZPOT01
Definition: zpot01.f:108
subroutine zlatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
ZLATB4
Definition: zlatb4.f:123
subroutine zpot02(UPLO, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
ZPOT02
Definition: zpot02.f:129
subroutine zporfs(UPLO, N, NRHS, A, LDA, AF, LDAF, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
ZPORFS
Definition: zporfs.f:185
subroutine alahd(IOUNIT, PATH)
ALAHD
Definition: alahd.f:95
subroutine zlaipd(N, A, INDA, VINDA)
ZLAIPD
Definition: zlaipd.f:85
subroutine zget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
ZGET04
Definition: zget04.f:104
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
Definition: alasum.f:75
subroutine zlarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
ZLARHS
Definition: zlarhs.f:211
subroutine zlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
ZLATMS
Definition: zlatms.f:334
subroutine zpocon(UPLO, N, A, LDA, ANORM, RCOND, WORK, RWORK, INFO)
ZPOCON
Definition: zpocon.f:123
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
Definition: xlaenv.f:83
subroutine zerrpo(PATH, NUNIT)
ZERRPO
Definition: zerrpo.f:57

Here is the call graph for this function:

Here is the caller graph for this function:

subroutine zchkpp ( logical, dimension( * )  DOTYPE,
integer  NN,
integer,