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

Functions

program dchkaa
 DCHKAA More...
 
program dchkab
 DCHKAB More...
 
subroutine dchkeq (THRESH, NOUT)
 DCHKEQ More...
 
subroutine dchkgb (DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NNS, NSVAL, THRESH, TSTERR, A, LA, AFAC, LAFAC, B, X, XACT, WORK, RWORK, IWORK, NOUT)
 DCHKGB More...
 
subroutine dchkge (DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NNS, NSVAL, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
 DCHKGE More...
 
subroutine dchkgt (DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR, A, AF, B, X, XACT, WORK, RWORK, IWORK, NOUT)
 DCHKGT More...
 
subroutine dchklq (DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL, NRHS, THRESH, TSTERR, NMAX, A, AF, AQ, AL, AC, B, X, XACT, TAU, WORK, RWORK, NOUT)
 DCHKLQ More...
 
subroutine dchkpb (DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
 DCHKPB More...
 
subroutine dchkpo (DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
 DCHKPO More...
 
subroutine dchkpp (DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
 DCHKPP More...
 
subroutine dchkps (DOTYPE, NN, NVAL, NNB, NBVAL, NRANK, RANKVAL, THRESH, TSTERR, NMAX, A, AFAC, PERM, PIV, WORK, RWORK, NOUT)
 DCHKPS More...
 
subroutine dchkpt (DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR, A, D, E, B, X, XACT, WORK, RWORK, NOUT)
 DCHKPT More...
 
subroutine dchkq3 (DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL, THRESH, A, COPYA, S, TAU, WORK, IWORK, NOUT)
 DCHKQ3 More...
 
subroutine dchkql (DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL, NRHS, THRESH, TSTERR, NMAX, A, AF, AQ, AL, AC, B, X, XACT, TAU, WORK, RWORK, NOUT)
 DCHKQL More...
 
subroutine dchkqr (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)
 DCHKQR More...
 
subroutine dchkqrt (THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, NBVAL, NOUT)
 DCHKQRT More...
 
subroutine dchkqrtp (THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, NBVAL, NOUT)
 DCHKQRTP More...
 
program dchkrfp
 DCHKRFP More...
 
subroutine dchkrq (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)
 DCHKRQ More...
 
subroutine dchksp (DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
 DCHKSP More...
 
subroutine dchksy (DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
 DCHKSY More...
 
subroutine dchksy_rook (DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
 DCHKSY_ROOK More...
 
subroutine dchktb (DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR, NMAX, AB, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
 DCHKTB More...
 
subroutine dchktp (DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR, NMAX, AP, AINVP, B, X, XACT, WORK, RWORK, IWORK, NOUT)
 DCHKTP More...
 
subroutine dchktr (DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL, THRESH, TSTERR, NMAX, A, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
 DCHKTR More...
 
subroutine dchktz (DOTYPE, NM, MVAL, NN, NVAL, THRESH, TSTERR, A, COPYA, S, TAU, WORK, NOUT)
 DCHKTZ More...
 
subroutine ddrvab (DOTYPE, NM, MVAL, NNS, NSVAL, THRESH, NMAX, A, AFAC, B, X, WORK, RWORK, SWORK, IWORK, NOUT)
 DDRVAB More...
 
subroutine ddrvac (DOTYPE, NM, MVAL, NNS, NSVAL, THRESH, NMAX, A, AFAC, B, X, WORK, RWORK, SWORK, NOUT)
 DDRVAC More...
 
subroutine ddrvgb (DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, A, LA, AFB, LAFB, ASAV, B, BSAV, X, XACT, S, WORK, RWORK, IWORK, NOUT)
 DDRVGB More...
 
subroutine ddrvge (DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX, A, AFAC, ASAV, B, BSAV, X, XACT, S, WORK, RWORK, IWORK, NOUT)
 DDRVGE More...
 
subroutine ddrvgt (DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, A, AF, B, X, XACT, WORK, RWORK, IWORK, NOUT)
 DDRVGT More...
 
subroutine ddrvls (DOTYPE, NM, MVAL, NN, NVAL, NNS, NSVAL, NNB, NBVAL, NXVAL, THRESH, TSTERR, A, COPYA, B, COPYB, C, S, COPYS, WORK, IWORK, NOUT)
 DDRVLS More...
 
subroutine ddrvpb (DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX, A, AFAC, ASAV, B, BSAV, X, XACT, S, WORK, RWORK, IWORK, NOUT)
 DDRVPB More...
 
subroutine ddrvpo (DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX, A, AFAC, ASAV, B, BSAV, X, XACT, S, WORK, RWORK, IWORK, NOUT)
 DDRVPO More...
 
subroutine ddrvpp (DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX, A, AFAC, ASAV, B, BSAV, X, XACT, S, WORK, RWORK, IWORK, NOUT)
 DDRVPP More...
 
subroutine ddrvpt (DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, A, D, E, B, X, XACT, WORK, RWORK, NOUT)
 DDRVPT More...
 
subroutine ddrvrf1 (NOUT, NN, NVAL, THRESH, A, LDA, ARF, WORK)
 DDRVRF1 More...
 
subroutine ddrvrf2 (NOUT, NN, NVAL, A, LDA, ARF, AP, ASAV)
 DDRVRF2 More...
 
subroutine ddrvrf3 (NOUT, NN, NVAL, THRESH, A, LDA, ARF, B1, B2, D_WORK_DLANGE, D_WORK_DGEQRF, TAU)
 DDRVRF3 More...
 
subroutine ddrvrf4 (NOUT, NN, NVAL, THRESH, C1, C2, LDC, CRF, A, LDA, D_WORK_DLANGE)
 DDRVRF4 More...
 
subroutine ddrvrfp (NOUT, NN, NVAL, NNS, NSVAL, NNT, NTVAL, THRESH, A, ASAV, AFAC, AINV, B, BSAV, XACT, X, ARF, ARFINV, D_WORK_DLATMS, D_WORK_DPOT01, D_TEMP_DPOT02, D_TEMP_DPOT03, D_WORK_DLANSY, D_WORK_DPOT02, D_WORK_DPOT03)
 DDRVRFP More...
 
subroutine ddrvsp (DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
 DDRVSP More...
 
subroutine ddrvsy (DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
 DDRVSY More...
 
subroutine ddrvsy_rook (DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
 DDRVSY_ROOK More...
 
subroutine debchvxx (THRESH, PATH)
 DEBCHVXX More...
 
subroutine derrab (NUNIT)
 DERRAB More...
 
subroutine derrac (NUNIT)
 DERRAC More...
 
subroutine derrge (PATH, NUNIT)
 DERRGE More...
 
subroutine derrgt (PATH, NUNIT)
 DERRGT More...
 
subroutine derrlq (PATH, NUNIT)
 DERRLQ More...
 
subroutine derrls (PATH, NUNIT)
 DERRLS More...
 
subroutine derrpo (PATH, NUNIT)
 DERRPO More...
 
subroutine derrps (PATH, NUNIT)
 DERRPS More...
 
subroutine derrql (PATH, NUNIT)
 DERRQL More...
 
subroutine derrqp (PATH, NUNIT)
 DERRQP More...
 
subroutine derrqr (PATH, NUNIT)
 DERRQR More...
 
subroutine derrqrt (PATH, NUNIT)
 DERRQRT More...
 
subroutine derrqrtp (PATH, NUNIT)
 DERRQRTP More...
 
subroutine derrrfp (NUNIT)
 DERRRFP More...
 
subroutine derrrq (PATH, NUNIT)
 DERRRQ More...
 
subroutine derrsy (PATH, NUNIT)
 DERRSY More...
 
subroutine derrtr (PATH, NUNIT)
 DERRTR More...
 
subroutine derrtz (PATH, NUNIT)
 DERRTZ More...
 
subroutine derrvx (PATH, NUNIT)
 DERRVX More...
 
subroutine dgbt01 (M, N, KL, KU, A, LDA, AFAC, LDAFAC, IPIV, WORK, RESID)
 DGBT01 More...
 
subroutine dgbt02 (TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, RESID)
 DGBT02 More...
 
subroutine dgbt05 (TRANS, N, KL, KU, NRHS, AB, LDAB, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
 DGBT05 More...
 
subroutine dgelqs (M, N, NRHS, A, LDA, TAU, B, LDB, WORK, LWORK, INFO)
 DGELQS More...
 
logical function dgennd (M, N, A, LDA)
 DGENND More...
 
subroutine dgeqls (M, N, NRHS, A, LDA, TAU, B, LDB, WORK, LWORK, INFO)
 DGEQLS More...
 
subroutine dgeqrs (M, N, NRHS, A, LDA, TAU, B, LDB, WORK, LWORK, INFO)
 DGEQRS More...
 
subroutine dgerqs (M, N, NRHS, A, LDA, TAU, B, LDB, WORK, LWORK, INFO)
 DGERQS More...
 
subroutine dget01 (M, N, A, LDA, AFAC, LDAFAC, IPIV, RWORK, RESID)
 DGET01 More...
 
subroutine dget02 (TRANS, M, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
 DGET02 More...
 
subroutine dget03 (N, A, LDA, AINV, LDAINV, WORK, LDWORK, RWORK, RCOND, RESID)
 DGET03 More...
 
subroutine dget04 (N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
 DGET04 More...
 
double precision function dget06 (RCOND, RCONDC)
 DGET06 More...
 
subroutine dget07 (TRANS, N, NRHS, A, LDA, B, LDB, X, LDX, XACT, LDXACT, FERR, CHKFERR, BERR, RESLTS)
 DGET07 More...
 
subroutine dget08 (TRANS, M, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
 DGET08 More...
 
subroutine dgtt01 (N, DL, D, DU, DLF, DF, DUF, DU2, IPIV, WORK, LDWORK, RWORK, RESID)
 DGTT01 More...
 
subroutine dgtt02 (TRANS, N, NRHS, DL, D, DU, X, LDX, B, LDB, RESID)
 DGTT02 More...
 
subroutine dgtt05 (TRANS, N, NRHS, DL, D, DU, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
 DGTT05 More...
 
subroutine dlahilb (N, NRHS, A, LDA, X, LDX, B, LDB, WORK, INFO)
 DLAHILB More...
 
subroutine dlaord (JOB, N, X, INCX)
 DLAORD More...
 
subroutine dlaptm (N, NRHS, ALPHA, D, E, X, LDX, BETA, B, LDB)
 DLAPTM More...
 
subroutine dlarhs (PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
 DLARHS More...
 
subroutine dlatb4 (PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
 DLATB4 More...
 
subroutine dlatb5 (PATH, IMAT, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
 DLATB5 More...
 
subroutine dlattb (IMAT, UPLO, TRANS, DIAG, ISEED, N, KD, AB, LDAB, B, WORK, INFO)
 DLATTB More...
 
subroutine dlattp (IMAT, UPLO, TRANS, DIAG, ISEED, N, A, B, WORK, INFO)
 DLATTP More...
 
subroutine dlattr (IMAT, UPLO, TRANS, DIAG, ISEED, N, A, LDA, B, WORK, INFO)
 DLATTR More...
 
subroutine dlavsp (UPLO, TRANS, DIAG, N, NRHS, A, IPIV, B, LDB, INFO)
 DLAVSP More...
 
subroutine dlavsy (UPLO, TRANS, DIAG, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
 DLAVSY More...
 
subroutine dlavsy_rook (UPLO, TRANS, DIAG, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
 DLAVSY_ROOK More...
 
subroutine dlqt01 (M, N, A, AF, Q, L, LDA, TAU, WORK, LWORK, RWORK, RESULT)
 DLQT01 More...
 
subroutine dlqt02 (M, N, K, A, AF, Q, L, LDA, TAU, WORK, LWORK, RWORK, RESULT)
 DLQT02 More...
 
subroutine dlqt03 (M, N, K, AF, C, CC, Q, LDA, TAU, WORK, LWORK, RWORK, RESULT)
 DLQT03 More...
 
subroutine dpbt01 (UPLO, N, KD, A, LDA, AFAC, LDAFAC, RWORK, RESID)
 DPBT01 More...
 
subroutine dpbt02 (UPLO, N, KD, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
 DPBT02 More...
 
subroutine dpbt05 (UPLO, N, KD, NRHS, AB, LDAB, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
 DPBT05 More...
 
subroutine dpot01 (UPLO, N, A, LDA, AFAC, LDAFAC, RWORK, RESID)
 DPOT01 More...
 
subroutine dpot02 (UPLO, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
 DPOT02 More...
 
subroutine dpot03 (UPLO, N, A, LDA, AINV, LDAINV, WORK, LDWORK, RWORK, RCOND, RESID)
 DPOT03 More...
 
subroutine dpot05 (UPLO, N, NRHS, A, LDA, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
 DPOT05 More...
 
subroutine dpot06 (UPLO, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
 DPOT06 More...
 
subroutine dppt01 (UPLO, N, A, AFAC, RWORK, RESID)
 DPPT01 More...
 
subroutine dppt02 (UPLO, N, NRHS, A, X, LDX, B, LDB, RWORK, RESID)
 DPPT02 More...
 
subroutine dppt03 (UPLO, N, A, AINV, WORK, LDWORK, RWORK, RCOND, RESID)
 DPPT03 More...
 
subroutine dppt05 (UPLO, N, NRHS, AP, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
 DPPT05 More...
 
subroutine dpst01 (UPLO, N, A, LDA, AFAC, LDAFAC, PERM, LDPERM, PIV, RWORK, RESID, RANK)
 DPST01 More...
 
subroutine dptt01 (N, D, E, DF, EF, WORK, RESID)
 DPTT01 More...
 
subroutine dptt02 (N, NRHS, D, E, X, LDX, B, LDB, RESID)
 DPTT02 More...
 
subroutine dptt05 (N, NRHS, D, E, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
 DPTT05 More...
 
subroutine dqlt01 (M, N, A, AF, Q, L, LDA, TAU, WORK, LWORK, RWORK, RESULT)
 DQLT01 More...
 
subroutine dqlt02 (M, N, K, A, AF, Q, L, LDA, TAU, WORK, LWORK, RWORK, RESULT)
 DQLT02 More...
 
subroutine dqlt03 (M, N, K, AF, C, CC, Q, LDA, TAU, WORK, LWORK, RWORK, RESULT)
 DQLT03 More...
 
double precision function dqpt01 (M, N, K, A, AF, LDA, TAU, JPVT, WORK, LWORK)
 DQPT01 More...
 
subroutine dqrt01 (M, N, A, AF, Q, R, LDA, TAU, WORK, LWORK, RWORK, RESULT)
 DQRT01 More...
 
subroutine dqrt01p (M, N, A, AF, Q, R, LDA, TAU, WORK, LWORK, RWORK, RESULT)
 DQRT01P More...
 
subroutine dqrt02 (M, N, K, A, AF, Q, R, LDA, TAU, WORK, LWORK, RWORK, RESULT)
 DQRT02 More...
 
subroutine dqrt03 (M, N, K, AF, C, CC, Q, LDA, TAU, WORK, LWORK, RWORK, RESULT)
 DQRT03 More...
 
subroutine dqrt04 (M, N, NB, RESULT)
 DQRT04 More...
 
subroutine dqrt05 (M, N, L, NB, RESULT)
 DQRT05 More...
 
double precision function dqrt11 (M, K, A, LDA, TAU, WORK, LWORK)
 DQRT11 More...
 
double precision function dqrt12 (M, N, A, LDA, S, WORK, LWORK)
 DQRT12 More...
 
subroutine dqrt13 (SCALE, M, N, A, LDA, NORMA, ISEED)
 DQRT13 More...
 
double precision function dqrt14 (TRANS, M, N, NRHS, A, LDA, X, LDX, WORK, LWORK)
 DQRT14 More...
 
subroutine dqrt15 (SCALE, RKSEL, M, N, NRHS, A, LDA, B, LDB, S, RANK, NORMA, NORMB, ISEED, WORK, LWORK)
 DQRT15 More...
 
subroutine dqrt16 (TRANS, M, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
 DQRT16 More...
 
double precision function dqrt17 (TRANS, IRESID, M, N, NRHS, A, LDA, X, LDX, B, LDB, C, WORK, LWORK)
 DQRT17 More...
 
subroutine drqt01 (M, N, A, AF, Q, R, LDA, TAU, WORK, LWORK, RWORK, RESULT)
 DRQT01 More...
 
subroutine drqt02 (M, N, K, A, AF, Q, R, LDA, TAU, WORK, LWORK, RWORK, RESULT)
 DRQT02 More...
 
subroutine drqt03 (M, N, K, AF, C, CC, Q, LDA, TAU, WORK, LWORK, RWORK, RESULT)
 DRQT03 More...
 
double precision function drzt01 (M, N, A, AF, LDA, TAU, WORK, LWORK)
 DRZT01 More...
 
double precision function drzt02 (M, N, AF, LDA, TAU, WORK, LWORK)
 DRZT02 More...
 
subroutine dspt01 (UPLO, N, A, AFAC, IPIV, C, LDC, RWORK, RESID)
 DSPT01 More...
 
subroutine dsyt01 (UPLO, N, A, LDA, AFAC, LDAFAC, IPIV, C, LDC, RWORK, RESID)
 DSYT01 More...
 
subroutine dsyt01_rook (UPLO, N, A, LDA, AFAC, LDAFAC, IPIV, C, LDC, RWORK, RESID)
 DSYT01_ROOK More...
 
subroutine dtbt02 (UPLO, TRANS, DIAG, N, KD, NRHS, AB, LDAB, X, LDX, B, LDB, WORK, RESID)
 DTBT02 More...
 
subroutine dtbt03 (UPLO, TRANS, DIAG, N, KD, NRHS, AB, LDAB, SCALE, CNORM, TSCAL, X, LDX, B, LDB, WORK, RESID)
 DTBT03 More...
 
subroutine dtbt05 (UPLO, TRANS, DIAG, N, KD, NRHS, AB, LDAB, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
 DTBT05 More...
 
subroutine dtbt06 (RCOND, RCONDC, UPLO, DIAG, N, KD, AB, LDAB, WORK, RAT)
 DTBT06 More...
 
subroutine dtpt01 (UPLO, DIAG, N, AP, AINVP, RCOND, WORK, RESID)
 DTPT01 More...
 
subroutine dtpt02 (UPLO, TRANS, DIAG, N, NRHS, AP, X, LDX, B, LDB, WORK, RESID)
 DTPT02 More...
 
subroutine dtpt03 (UPLO, TRANS, DIAG, N, NRHS, AP, SCALE, CNORM, TSCAL, X, LDX, B, LDB, WORK, RESID)
 DTPT03 More...
 
subroutine dtpt05 (UPLO, TRANS, DIAG, N, NRHS, AP, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
 DTPT05 More...
 
subroutine dtpt06 (RCOND, RCONDC, UPLO, DIAG, N, AP, WORK, RAT)
 DTPT06 More...
 
subroutine dtrt01 (UPLO, DIAG, N, A, LDA, AINV, LDAINV, RCOND, WORK, RESID)
 DTRT01 More...
 
subroutine dtrt02 (UPLO, TRANS, DIAG, N, NRHS, A, LDA, X, LDX, B, LDB, WORK, RESID)
 DTRT02 More...
 
subroutine dtrt03 (UPLO, TRANS, DIAG, N, NRHS, A, LDA, SCALE, CNORM, TSCAL, X, LDX, B, LDB, WORK, RESID)
 DTRT03 More...
 
subroutine dtrt05 (UPLO, TRANS, DIAG, N, NRHS, A, LDA, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
 DTRT05 More...
 
subroutine dtrt06 (RCOND, RCONDC, UPLO, DIAG, N, A, LDA, WORK, RAT)
 DTRT06 More...
 
subroutine sdrvsy_rook (DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
 SDRVSY_ROOK More...
 

Detailed Description

This is the group of double LAPACK TESTING LIN routines.

Function Documentation

program dchkaa ( )

DCHKAA

Purpose:
 DCHKAA is the main test program for the DOUBLE PRECISION LAPACK
 linear equation routines

 The program must be driven by a short data file. The first 15 records
 (not including the first comment  line) specify problem dimensions
 and program options using list-directed input. The remaining lines
 specify the LAPACK test paths and the number of matrix types to use
 in testing.  An annotated example of a data file can be obtained by
 deleting the first 3 characters from the following 40 lines:
 Data file for testing DOUBLE PRECISION LAPACK linear eqn. routines
 7                      Number of values of M
 0 1 2 3 5 10 16        Values of M (row dimension)
 7                      Number of values of N
 0 1 2 3 5 10 16        Values of N (column dimension)
 1                      Number of values of NRHS
 2                      Values of NRHS (number of right hand sides)
 5                      Number of values of NB
 1 3 3 3 20             Values of NB (the blocksize)
 1 0 5 9 1              Values of NX (crossover point)
 3                      Number of values of RANK
 30 50 90               Values of rank (as a % of N)
 20.0                   Threshold value of test ratio
 T                      Put T to test the LAPACK routines
 T                      Put T to test the driver routines
 T                      Put T to test the error exits
 DGE   11               List types on next line if 0 < NTYPES < 11
 DGB    8               List types on next line if 0 < NTYPES <  8
 DGT   12               List types on next line if 0 < NTYPES < 12
 DPO    9               List types on next line if 0 < NTYPES <  9
 DPS    9               List types on next line if 0 < NTYPES <  9
 DPP    9               List types on next line if 0 < NTYPES <  9
 DPB    8               List types on next line if 0 < NTYPES <  8
 DPT   12               List types on next line if 0 < NTYPES < 12
 DSY   10               List types on next line if 0 < NTYPES < 10
 DSR   10               List types on next line if 0 < NTYPES < 10
 DSP   10               List types on next line if 0 < NTYPES < 10
 DTR   18               List types on next line if 0 < NTYPES < 18
 DTP   18               List types on next line if 0 < NTYPES < 18
 DTB   17               List types on next line if 0 < NTYPES < 17
 DQR    8               List types on next line if 0 < NTYPES <  8
 DRQ    8               List types on next line if 0 < NTYPES <  8
 DLQ    8               List types on next line if 0 < NTYPES <  8
 DQL    8               List types on next line if 0 < NTYPES <  8
 DQP    6               List types on next line if 0 < NTYPES <  6
 DTZ    3               List types on next line if 0 < NTYPES <  3
 DLS    6               List types on next line if 0 < NTYPES <  6
 DEQ
 DQT
 DQX
  NMAX    INTEGER
          The maximum allowable value for M and N.

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

  MAXRHS  INTEGER
          The maximum number of right hand sides

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

  NIN     INTEGER
          The unit number for input

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

Definition at line 107 of file dchkaa.f.

Here is the call graph for this function:

program dchkab ( )

DCHKAB

Purpose:
 DCHKAB is the test program for the DOUBLE PRECISION LAPACK
 DSGESV/DSPOSV 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 10 lines:
 Data file for testing DOUBLE PRECISION LAPACK DSGESV
 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 routines
 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 dchkab.f.

Here is the call graph for this function:

subroutine dchkeq ( double precision  THRESH,
integer  NOUT 
)

DCHKEQ

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

Here is the call graph for this function:

Here is the caller graph for this function:

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

DCHKGB

Purpose:
 DCHKGB tests DGBTRF, -TRS, -RFS, and -CON
Parameters
[in]DOTYPE
          DOTYPE is LOGICAL array, dimension (NTYPES)
          The matrix types to be used for testing.  Matrices of type j
          (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) =
          .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.
[in]NM
          NM is INTEGER
          The number of values of M contained in the vector MVAL.
[in]MVAL
          MVAL is INTEGER array, dimension (NM)
          The values of the matrix row dimension M.
[in]NN
          NN is INTEGER
          The number of values of N contained in the vector NVAL.
[in]NVAL
          NVAL is INTEGER array, dimension (NN)
          The values of the matrix column dimension N.
[in]NNB
          NNB is INTEGER
          The number of values of NB contained in the vector NBVAL.
[in]NBVAL
          NBVAL is INTEGER array, dimension (NNB)
          The values of the blocksize NB.
[in]NNS
          NNS is INTEGER
          The number of values of NRHS contained in the vector NSVAL.
[in]NSVAL
          NSVAL is INTEGER array, dimension (NNS)
          The values of the number of right hand sides NRHS.
[in]THRESH
          THRESH is 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 DOUBLE PRECISION 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 DOUBLE PRECISION 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 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,NMAX))
[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 2011

Definition at line 193 of file dchkgb.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 a( * ), afac( * ), b( * ), rwork( * ),
209  $ work( * ), x( * ), xact( * )
210 * ..
211 *
212 * =====================================================================
213 *
214 * .. Parameters ..
215  DOUBLE PRECISION one, zero
216  parameter( one = 1.0d+0, zero = 0.0d+0 )
217  INTEGER ntypes, ntests
218  parameter( ntypes = 8, ntests = 7 )
219  INTEGER nbw, ntran
220  parameter( nbw = 4, ntran = 3 )
221 * ..
222 * .. Local Scalars ..
223  LOGICAL trfcon, zerot
224  CHARACTER dist, norm, trans, TYPE, xtype
225  CHARACTER*3 path
226  INTEGER i, i1, i2, ikl, iku, im, imat, in, inb, info,
227  $ ioff, irhs, itran, izero, j, k, kl, koff, ku,
228  $ lda, ldafac, ldb, m, mode, n, nb, nerrs, nfail,
229  $ nimat, nkl, nku, nrhs, nrun
230  DOUBLE PRECISION ainvnm, anorm, anormi, anormo, cndnum, rcond,
231  $ rcondc, rcondi, rcondo
232 * ..
233 * .. Local Arrays ..
234  CHARACTER transs( ntran )
235  INTEGER iseed( 4 ), iseedy( 4 ), klval( nbw ),
236  $ kuval( nbw )
237  DOUBLE PRECISION result( ntests )
238 * ..
239 * .. External Functions ..
240  DOUBLE PRECISION dget06, dlangb, dlange
241  EXTERNAL dget06, dlangb, dlange
242 * ..
243 * .. External Subroutines ..
244  EXTERNAL alaerh, alahd, alasum, dcopy, derrge, dgbcon,
247  $ xlaenv
248 * ..
249 * .. Intrinsic Functions ..
250  INTRINSIC max, min
251 * ..
252 * .. Scalars in Common ..
253  LOGICAL lerr, ok
254  CHARACTER*32 srnamt
255  INTEGER infot, nunit
256 * ..
257 * .. Common blocks ..
258  COMMON / infoc / infot, nunit, ok, lerr
259  COMMON / srnamc / srnamt
260 * ..
261 * .. Data statements ..
262  DATA iseedy / 1988, 1989, 1990, 1991 / ,
263  $ transs / 'N', 'T', 'C' /
264 * ..
265 * .. Executable Statements ..
266 *
267 * Initialize constants and the random number seed.
268 *
269  path( 1: 1 ) = 'Double precision'
270  path( 2: 3 ) = 'GB'
271  nrun = 0
272  nfail = 0
273  nerrs = 0
274  DO 10 i = 1, 4
275  iseed( i ) = iseedy( i )
276  10 CONTINUE
277 *
278 * Test the error exits
279 *
280  IF( tsterr )
281  $ CALL derrge( path, nout )
282  infot = 0
283  CALL xlaenv( 2, 2 )
284 *
285 * Initialize the first value for the lower and upper bandwidths.
286 *
287  klval( 1 ) = 0
288  kuval( 1 ) = 0
289 *
290 * Do for each value of M in MVAL
291 *
292  DO 160 im = 1, nm
293  m = mval( im )
294 *
295 * Set values to use for the lower bandwidth.
296 *
297  klval( 2 ) = m + ( m+1 ) / 4
298 *
299 * KLVAL( 2 ) = MAX( M-1, 0 )
300 *
301  klval( 3 ) = ( 3*m-1 ) / 4
302  klval( 4 ) = ( m+1 ) / 4
303 *
304 * Do for each value of N in NVAL
305 *
306  DO 150 in = 1, nn
307  n = nval( in )
308  xtype = 'N'
309 *
310 * Set values to use for the upper bandwidth.
311 *
312  kuval( 2 ) = n + ( n+1 ) / 4
313 *
314 * KUVAL( 2 ) = MAX( N-1, 0 )
315 *
316  kuval( 3 ) = ( 3*n-1 ) / 4
317  kuval( 4 ) = ( n+1 ) / 4
318 *
319 * Set limits on the number of loop iterations.
320 *
321  nkl = min( m+1, 4 )
322  IF( n.EQ.0 )
323  $ nkl = 2
324  nku = min( n+1, 4 )
325  IF( m.EQ.0 )
326  $ nku = 2
327  nimat = ntypes
328  IF( m.LE.0 .OR. n.LE.0 )
329  $ nimat = 1
330 *
331  DO 140 ikl = 1, nkl
332 *
333 * Do for KL = 0, (5*M+1)/4, (3M-1)/4, and (M+1)/4. This
334 * order makes it easier to skip redundant values for small
335 * values of M.
336 *
337  kl = klval( ikl )
338  DO 130 iku = 1, nku
339 *
340 * Do for KU = 0, (5*N+1)/4, (3N-1)/4, and (N+1)/4. This
341 * order makes it easier to skip redundant values for
342 * small values of N.
343 *
344  ku = kuval( iku )
345 *
346 * Check that A and AFAC are big enough to generate this
347 * matrix.
348 *
349  lda = kl + ku + 1
350  ldafac = 2*kl + ku + 1
351  IF( ( lda*n ).GT.la .OR. ( ldafac*n ).GT.lafac ) THEN
352  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
353  $ CALL alahd( nout, path )
354  IF( n*( kl+ku+1 ).GT.la ) THEN
355  WRITE( nout, fmt = 9999 )la, m, n, kl, ku,
356  $ n*( kl+ku+1 )
357  nerrs = nerrs + 1
358  END IF
359  IF( n*( 2*kl+ku+1 ).GT.lafac ) THEN
360  WRITE( nout, fmt = 9998 )lafac, m, n, kl, ku,
361  $ n*( 2*kl+ku+1 )
362  nerrs = nerrs + 1
363  END IF
364  GO TO 130
365  END IF
366 *
367  DO 120 imat = 1, nimat
368 *
369 * Do the tests only if DOTYPE( IMAT ) is true.
370 *
371  IF( .NOT.dotype( imat ) )
372  $ GO TO 120
373 *
374 * Skip types 2, 3, or 4 if the matrix size is too
375 * small.
376 *
377  zerot = imat.GE.2 .AND. imat.LE.4
378  IF( zerot .AND. n.LT.imat-1 )
379  $ GO TO 120
380 *
381  IF( .NOT.zerot .OR. .NOT.dotype( 1 ) ) THEN
382 *
383 * Set up parameters with DLATB4 and generate a
384 * test matrix with DLATMS.
385 *
386  CALL dlatb4( 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 = 'DLATMS'
394  CALL dlatms( 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 DLATMS.
399 *
400  IF( info.NE.0 ) THEN
401  CALL alaerh( path, 'DLATMS', 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 dcopy( 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 dcopy( 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 = DLANGB( 'O', N, KL, KU, A, LDA, RWORK )
454 * ANORMI = DLANGB( '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 dlacpy( 'Full', kl+ku+1, n, a, lda,
466  $ afac( kl+1 ), ldafac )
467  srnamt = 'DGBTRF'
468  CALL dgbtrf( m, n, kl, ku, afac, ldafac, iwork,
469  $ info )
470 *
471 * Check error code from DGBTRF.
472 *
473  IF( info.NE.izero )
474  $ CALL alaerh( path, 'DGBTRF', 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 dgbt01( 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 = dlangb( 'O', n, kl, ku, a, lda, rwork )
505  anormi = dlangb( '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 dlaset( 'Full', n, n, zero, one, work,
514  $ ldb )
515  srnamt = 'DGBTRS'
516  CALL dgbtrs( '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 = dlange( '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 = dlange( '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 = 'DLARHS'
572  CALL dlarhs( path, xtype, ' ', trans, n,
573  $ n, kl, ku, nrhs, a, lda,
574  $ xact, ldb, b, ldb, iseed,
575  $ info )
576  xtype = 'C'
577  CALL dlacpy( 'Full', n, nrhs, b, ldb, x,
578  $ ldb )
579 *
580  srnamt = 'DGBTRS'
581  CALL dgbtrs( trans, n, kl, ku, nrhs, afac,
582  $ ldafac, iwork, x, ldb, info )
583 *
584 * Check error code from DGBTRS.
585 *
586  IF( info.NE.0 )
587  $ CALL alaerh( path, 'DGBTRS', info, 0,
588  $ trans, n, n, kl, ku, -1,
589  $ imat, nfail, nerrs, nout )
590 *
591  CALL dlacpy( 'Full', n, nrhs, b, ldb,
592  $ work, ldb )
593  CALL dgbt02( 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 dget04( 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 = 'DGBRFS'
609  CALL dgbrfs( trans, n, kl, ku, nrhs, a,
610  $ lda, afac, ldafac, iwork, b,
611  $ ldb, x, ldb, rwork,
612  $ rwork( nrhs+1 ), work,
613  $ iwork( n+1 ), info )
614 *
615 * Check error code from DGBRFS.
616 *
617  IF( info.NE.0 )
618  $ CALL alaerh( path, 'DGBRFS', info, 0,
619  $ trans, n, n, kl, ku, nrhs,
620  $ imat, nfail, nerrs, nout )
621 *
622  CALL dget04( n, nrhs, x, ldb, xact, ldb,
623  $ rcondc, result( 4 ) )
624  CALL dgbt05( trans, n, kl, ku, nrhs, a,
625  $ lda, b, ldb, x, ldb, xact,
626  $ ldb, rwork, rwork( nrhs+1 ),
627  $ result( 5 ) )
628  DO 60 k = 2, 6
629  IF( result( k ).GE.thresh ) THEN
630  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
631  $ CALL alahd( nout, path )
632  WRITE( nout, fmt = 9996 )trans, n,
633  $ kl, ku, nrhs, imat, k,
634  $ result( k )
635  nfail = nfail + 1
636  END IF
637  60 CONTINUE
638  nrun = nrun + 5
639  70 CONTINUE
640  80 CONTINUE
641 *
642 *+ TEST 7:
643 * Get an estimate of RCOND = 1/CNDNUM.
644 *
645  90 CONTINUE
646  DO 100 itran = 1, 2
647  IF( itran.EQ.1 ) THEN
648  anorm = anormo
649  rcondc = rcondo
650  norm = 'O'
651  ELSE
652  anorm = anormi
653  rcondc = rcondi
654  norm = 'I'
655  END IF
656  srnamt = 'DGBCON'
657  CALL dgbcon( norm, n, kl, ku, afac, ldafac,
658  $ iwork, anorm, rcond, work,
659  $ iwork( n+1 ), info )
660 *
661 * Check error code from DGBCON.
662 *
663  IF( info.NE.0 )
664  $ CALL alaerh( path, 'DGBCON', info, 0,
665  $ norm, n, n, kl, ku, -1, imat,
666  $ nfail, nerrs, nout )
667 *
668  result( 7 ) = dget06( rcond, rcondc )
669 *
670 * Print information about the tests that did
671 * not pass the threshold.
672 *
673  IF( result( 7 ).GE.thresh ) THEN
674  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
675  $ CALL alahd( nout, path )
676  WRITE( nout, fmt = 9995 )norm, n, kl, ku,
677  $ imat, 7, result( 7 )
678  nfail = nfail + 1
679  END IF
680  nrun = nrun + 1
681  100 CONTINUE
682 *
683  110 CONTINUE
684  120 CONTINUE
685  130 CONTINUE
686  140 CONTINUE
687  150 CONTINUE
688  160 CONTINUE
689 *
690 * Print a summary of the results.
691 *
692  CALL alasum( path, nout, nfail, nrun, nerrs )
693 *
694  9999 FORMAT( ' *** In DCHKGB, LA=', i5, ' is too small for M=', i5,
695  $ ', N=', i5, ', KL=', i4, ', KU=', i4,
696  $ / ' ==> Increase LA to at least ', i5 )
697  9998 FORMAT( ' *** In DCHKGB, LAFAC=', i5, ' is too small for M=', i5,
698  $ ', N=', i5, ', KL=', i4, ', KU=', i4,
699  $ / ' ==> Increase LAFAC to at least ', i5 )
700  9997 FORMAT( ' M =', i5, ', N =', i5, ', KL=', i5, ', KU=', i5,
701  $ ', NB =', i4, ', type ', i1, ', test(', i1, ')=', g12.5 )
702  9996 FORMAT( ' TRANS=''', a1, ''', N=', i5, ', KL=', i5, ', KU=', i5,
703  $ ', NRHS=', i3, ', type ', i1, ', test(', i1, ')=', g12.5 )
704  9995 FORMAT( ' NORM =''', a1, ''', N=', i5, ', KL=', i5, ', KU=', i5,
705  $ ',', 10x, ' type ', i1, ', test(', i1, ')=', g12.5 )
706 *
707  RETURN
708 *
709 * End of DCHKGB
710 *
subroutine dlaset(UPLO, M, N, ALPHA, BETA, A, LDA)
DLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
Definition: dlaset.f:112
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 dlacpy(UPLO, M, N, A, LDA, B, LDB)
DLACPY copies all or part of one two-dimensional array to another.
Definition: dlacpy.f:105
subroutine dgbt01(M, N, KL, KU, A, LDA, AFAC, LDAFAC, IPIV, WORK, RESID)
DGBT01
Definition: dgbt01.f:128
subroutine dgbrfs(TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, LDAFB, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO)
DGBRFS
Definition: dgbrfs.f:207
subroutine dgbt02(TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, RESID)
DGBT02
Definition: dgbt02.f:141
subroutine dgbtrf(M, N, KL, KU, AB, LDAB, IPIV, INFO)
DGBTRF
Definition: dgbtrf.f:146
subroutine dlatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
DLATB4
Definition: dlatb4.f:122
subroutine dgbt05(TRANS, N, KL, KU, NRHS, AB, LDAB, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
DGBT05
Definition: dgbt05.f:178
double precision function dlange(NORM, M, N, A, LDA, WORK)
DLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
Definition: dlange.f:116
subroutine dgbcon(NORM, N, KL, KU, AB, LDAB, IPIV, ANORM, RCOND, WORK, IWORK, INFO)
DGBCON
Definition: dgbcon.f:148
subroutine alahd(IOUNIT, PATH)
ALAHD
Definition: alahd.f:95
subroutine dlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
DLATMS
Definition: dlatms.f:323
subroutine derrge(PATH, NUNIT)
DERRGE
Definition: derrge.f:57
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
Definition: alasum.f:75
subroutine dget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
DGET04
Definition: dget04.f:104
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
Definition: xlaenv.f:83
double precision function dlangb(NORM, N, KL, KU, AB, LDAB, WORK)
DLANGB returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
Definition: dlangb.f:126
subroutine dcopy(N, DX, INCX, DY, INCY)
DCOPY
Definition: dcopy.f:53
subroutine dgbtrs(TRANS, N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB, INFO)
DGBTRS
Definition: dgbtrs.f:140
subroutine dlarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
DLARHS
Definition: dlarhs.f:206

Here is the call graph for this function:

Here is the caller graph for this function:

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

DCHKGE

Purpose:
 DCHKGE tests DGETRF, -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 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(2*NMAX,2*NSMAX+NWORK))
[out]IWORK
          IWORK is INTEGER array, dimension (2*NMAX)
[in]NOUT
          NOUT is INTEGER
          The unit number for output.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
November 2011

Definition at line 187 of file dchkge.f.

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

Here is the call graph for this function:

Here is the caller graph for this function:

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

DCHKGT

Purpose:
 DCHKGT tests DGTTRF, -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 DOUBLE PRECISION array, dimension (NMAX*4)
[out]AF
          AF is DOUBLE PRECISION array, dimension (NMAX*4)
[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))
[out]IWORK
          IWORK is INTEGER array, dimension (2*NMAX)
[in]NOUT
          NOUT is INTEGER
          The unit number for output.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
November 2011

Definition at line 148 of file dchkgt.f.

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

Here is the call graph for this function:

Here is the caller graph for this function:

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

DCHKLQ

Purpose:
 DCHKLQ tests DGELQF, DORGLQ and DORMLQ.
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 DOUBLE PRECISION array, dimension (NMAX*NMAX)
[out]AF
          AF is DOUBLE PRECISION array, dimension (NMAX*NMAX)
[out]AQ
          AQ is DOUBLE PRECISION array, dimension (NMAX*NMAX)
[out]AL
          AL is DOUBLE PRECISION array, dimension (NMAX*NMAX)
[out]AC
          AC is DOUBLE PRECISION array, dimension (NMAX*NMAX)
[out]B
          B is DOUBLE PRECISION array, dimension (NMAX*NRHS)
[out]X
          X is DOUBLE PRECISION array, dimension (NMAX*NRHS)
[out]XACT
          XACT is DOUBLE PRECISION array, dimension (NMAX*NRHS)
[out]TAU
          TAU is DOUBLE PRECISION array, dimension (NMAX)
[out]WORK
          WORK is DOUBLE PRECISION 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 dchklq.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 a( * ), ac( * ), af( * ), al( * ), aq( * ),
214  $ b( * ), rwork( * ), tau( * ), work( * ),
215  $ x( * ), xact( * )
216 * ..
217 *
218 * =====================================================================
219 *
220 * .. Parameters ..
221  INTEGER ntests
222  parameter( ntests = 7 )
223  INTEGER ntypes
224  parameter( ntypes = 8 )
225  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, derrlq, dgelqs, dget02,
243  $ dlqt03, xlaenv
244 * ..
245 * .. Intrinsic Functions ..
246  INTRINSIC max, min
247 * ..
248 * .. Scalars in Common ..
249  LOGICAL lerr, ok
250  CHARACTER*32 srnamt
251  INTEGER infot, nunit
252 * ..
253 * .. Common blocks ..
254  COMMON / infoc / infot, nunit, ok, lerr
255  COMMON / srnamc / srnamt
256 * ..
257 * .. Data statements ..
258  DATA iseedy / 1988, 1989, 1990, 1991 /
259 * ..
260 * .. Executable Statements ..
261 *
262 * Initialize constants and the random number seed.
263 *
264  path( 1: 1 ) = 'Double 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 derrlq( 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 DLATB4 and generate a test matrix
301 * with DLATMS.
302 *
303  CALL dlatb4( path, imat, m, n, TYPE, kl, ku, anorm, mode,
304  $ cndnum, dist )
305 *
306  srnamt = 'DLATMS'
307  CALL dlatms( 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 DLATMS.
312 *
313  IF( info.NE.0 ) THEN
314  CALL alaerh( path, 'DLATMS', 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 DLQT01; other values are
321 * used in the calls of DLQT02, 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 DGELQF
356 *
357  CALL dlqt01( m, n, a, af, aq, al, lda, tau,
358  $ work, lwork, rwork, result( 1 ) )
359  ELSE IF( m.LE.n ) THEN
360 *
361 * Test DORGLQ, using factorization
362 * returned by DLQT01
363 *
364  CALL dlqt02( m, n, k, a, af, aq, al, lda, tau,
365  $ work, lwork, rwork, result( 1 ) )
366  ELSE
367  result( 1 ) = zero
368  result( 2 ) = zero
369  END IF
370  IF( m.GE.k ) THEN
371 *
372 * Test DORMLQ, using factorization returned
373 * by DLQT01
374 *
375  CALL dlqt03( m, n, k, af, ac, al, aq, lda, tau,
376  $ work, lwork, rwork, result( 3 ) )
377  nt = nt + 4
378 *
379 * If M>=N and K=N, call DGELQS to solve a system
380 * with NRHS right hand sides and compute the
381 * residual.
382 *
383  IF( k.EQ.m .AND. inb.EQ.1 ) THEN
384 *
385 * Generate a solution and set the right
386 * hand side.
387 *
388  srnamt = 'DLARHS'
389  CALL dlarhs( path, 'New', 'Full',
390  $ 'No transpose', m, n, 0, 0,
391  $ nrhs, a, lda, xact, lda, b, lda,
392  $ iseed, info )
393 *
394  CALL dlacpy( 'Full', m, nrhs, b, lda, x,
395  $ lda )
396  srnamt = 'DGELQS'
397  CALL dgelqs( m, n, nrhs, af, lda, tau, x,
398  $ lda, work, lwork, info )
399 *
400 * Check error code from DGELQS.
401 *
402  IF( info.NE.0 )
403  $ CALL alaerh( path, 'DGELQS', info, 0, ' ',
404  $ m, n, nrhs, -1, nb, imat,
405  $ nfail, nerrs, nout )
406 *
407  CALL dget02( 'No transpose', m, n, nrhs, a,
408  $ lda, x, lda, b, lda, rwork,
409  $ result( 7 ) )
410  nt = nt + 1
411  ELSE
412  result( 7 ) = zero
413  END IF
414  ELSE
415  result( 3 ) = zero
416  result( 4 ) = zero
417  result( 5 ) = zero
418  result( 6 ) = zero
419  END IF
420 *
421 * Print information about the tests that did not
422 * pass the threshold.
423 *
424  DO 20 i = 1, nt
425  IF( result( i ).GE.thresh ) THEN
426  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
427  $ CALL alahd( nout, path )
428  WRITE( nout, fmt = 9999 )m, n, k, nb, nx,
429  $ imat, i, result( i )
430  nfail = nfail + 1
431  END IF
432  20 CONTINUE
433  nrun = nrun + nt
434  30 CONTINUE
435  40 CONTINUE
436  50 CONTINUE
437  60 CONTINUE
438  70 CONTINUE
439 *
440 * Print a summary of the results.
441 *
442  CALL alasum( path, nout, nfail, nrun, nerrs )
443 *
444  9999 FORMAT( ' M=', i5, ', N=', i5, ', K=', i5, ', NB=', i4, ', NX=',
445  $ i5, ', type ', i2, ', test(', i2, ')=', g12.5 )
446  RETURN
447 *
448 * End of DCHKLQ
449 *
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
Definition: alaerh.f:149
subroutine dlacpy(UPLO, M, N, A, LDA, B, LDB)
DLACPY copies all or part of one two-dimensional array to another.
Definition: dlacpy.f:105
subroutine dlqt01(M, N, A, AF, Q, L, LDA, TAU, WORK, LWORK, RWORK, RESULT)
DLQT01
Definition: dlqt01.f:128
subroutine dget02(TRANS, M, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
DGET02
Definition: dget02.f:135
subroutine dlatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
DLATB4
Definition: dlatb4.f:122
subroutine dlqt03(M, N, K, AF, C, CC, Q, LDA, TAU, WORK, LWORK, RWORK, RESULT)
DLQT03
Definition: dlqt03.f:138
subroutine dgelqs(M, N, NRHS, A, LDA, TAU, B, LDB, WORK, LWORK, INFO)
DGELQS
Definition: dgelqs.f:123
subroutine alahd(IOUNIT, PATH)
ALAHD
Definition: alahd.f:95
subroutine dlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
DLATMS
Definition: dlatms.f:323
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
Definition: alasum.f:75
subroutine derrlq(PATH, NUNIT)
DERRLQ
Definition: derrlq.f:57
subroutine dlqt02(M, N, K, A, AF, Q, L, LDA, TAU, WORK, LWORK, RWORK, RESULT)
DLQT02
Definition: dlqt02.f:137
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
Definition: xlaenv.f:83
subroutine dlarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
DLARHS
Definition: dlarhs.f:206

Here is the call graph for this function:

Here is the caller graph for this function:

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

DCHKPB

Purpose:
 DCHKPB tests DPBTRF, -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))
[out]IWORK
          IWORK is INTEGER array, dimension (NMAX)
[in]NOUT
          NOUT is INTEGER
          The unit number for output.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
November 2011

Definition at line 174 of file dchkpb.f.

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

Here is the call graph for this function:

Here is the caller graph for this function:

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

DCHKPO

Purpose:
 DCHKPO tests DPOTRF, -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 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))
[out]IWORK
          IWORK is INTEGER array, dimension (NMAX)
[in]NOUT
          NOUT is INTEGER
          The unit number for output.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
November 2011

Definition at line 174 of file dchkpo.f.

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

Here is the call graph for this function:

Here is the caller graph for this function:

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

DCHKPP

Purpose:
 DCHKPP tests DPPTRF, -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 DOUBLE PRECISION array, dimension
                      (NMAX*(NMAX+1)/2)
[out]AFAC
          AFAC is DOUBLE PRECISION array, dimension
                      (NMAX*(NMAX+1)/2)
[out]AINV
          AINV is DOUBLE PRECISION array, dimension
                      (NMAX*(NMAX+1)/2)
[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))
[out]IWORK
          IWORK is INTEGER array, dimension (NMAX)
[in]NOUT
          NOUT is INTEGER
          The unit number for output.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
November 2011

Definition at line 165 of file dchkpp.f.

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

Here is the call graph for this function:

Here is the caller graph for this function:

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

DCHKPS

Purpose:
 DCHKPS tests DPSTRF.
Parameters
[in]DOTYPE
          DOTYPE is LOGICAL array, dimension (NTYPES)
          The matrix types to be used for testing.  Matrices of type j
          (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) =
          .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.
[in]NN
          NN is INTEGER
          The number of values of N contained in the vector NVAL.
[in]NVAL
          NVAL is INTEGER array, dimension (NN)
          The values of the matrix dimension N.
[in]NNB
          NNB is INTEGER
          The number of values of NB contained in the vector NBVAL.
[in]NBVAL
          NBVAL is INTEGER array, dimension (NBVAL)
          The values of the block size NB.
[in]NRANK
          NRANK is INTEGER
          The number of values of RANK contained in the vector RANKVAL.
[in]RANKVAL
          RANKVAL is INTEGER array, dimension (NBVAL)
          The values of the block size NB.
[in]THRESH
          THRESH is 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]PERM
          PERM is DOUBLE PRECISION array, dimension (NMAX*NMAX)
[out]PIV
          PIV is INTEGER array, dimension (NMAX)
[out]WORK
          WORK is DOUBLE PRECISION array, dimension (NMAX*3)
[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 156 of file dchkps.f.

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

DCHKPT

Purpose:
 DCHKPT tests DPTTRF, -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 DOUBLE PRECISION array, dimension (NMAX*2)
[out]D
          D is DOUBLE PRECISION array, dimension (NMAX*2)
[out]E
          E is DOUBLE PRECISION array, dimension (NMAX*2)
[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 148 of file dchkpt.f.

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

Here is the call graph for this function:

Here is the caller graph for this function:

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

DCHKQ3

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

Definition at line 155 of file dchkq3.f.

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

DCHKQL

Purpose:
 DCHKQL tests DGEQLF, DORGQL and DORMQL.
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 DOUBLE PRECISION array, dimension (NMAX*NMAX)
[out]AF
          AF is DOUBLE PRECISION array, dimension (NMAX*NMAX)
[out]AQ
          AQ is DOUBLE PRECISION array, dimension (NMAX*NMAX)
[out]AL
          AL is DOUBLE PRECISION array, dimension (NMAX*NMAX)
[out]AC
          AC is DOUBLE PRECISION array, dimension (NMAX*NMAX)
[out]B
          B is DOUBLE PRECISION array, dimension (NMAX*NRHS)
[out]X
          X is DOUBLE PRECISION array, dimension (NMAX*NRHS)
[out]XACT
          XACT is DOUBLE PRECISION array, dimension (NMAX*NRHS)
[out]TAU
          TAU is DOUBLE PRECISION array, dimension (NMAX)
[out]WORK
          WORK is DOUBLE PRECISION 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 2015

Definition at line 198 of file dchkql.f.

198 *
199 * -- LAPACK test routine (version 3.6.0) --
200 * -- LAPACK is a software package provided by Univ. of Tennessee, --
201 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
202 * November 2015
203 *
204 * .. Scalar Arguments ..
205  LOGICAL tsterr
206  INTEGER nm, nmax, nn, nnb, nout, nrhs
207  DOUBLE PRECISION thresh
208 * ..
209 * .. Array Arguments ..
210  LOGICAL dotype( * )
211  INTEGER mval( * ), nbval( * ), nval( * ),
212  $ nxval( * )
213  DOUBLE PRECISION a( * ), ac( * ), af( * ), al( * ), aq( * ),
214  $ b( * ), rwork( * ), tau( * ), work( * ),
215  $ x( * ), xact( * )
216 * ..
217 *
218 * =====================================================================
219 *
220 * .. Parameters ..
221  INTEGER ntests
222  parameter( ntests = 7 )
223  INTEGER ntypes
224  parameter( ntypes = 8 )
225  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, derrql, dgeqls, dget02,
243  $ dqlt03, xlaenv
244 * ..
245 * .. Intrinsic Functions ..
246  INTRINSIC max, min
247 * ..
248 * .. Scalars in Common ..
249  LOGICAL lerr, ok
250  CHARACTER*32 srnamt
251  INTEGER infot, nunit
252 * ..
253 * .. Common blocks ..
254  COMMON / infoc / infot, nunit, ok, lerr
255  COMMON / srnamc / srnamt
256 * ..
257 * .. Data statements ..
258  DATA iseedy / 1988, 1989, 1990, 1991 /
259 * ..
260 * .. Executable Statements ..
261 *
262 * Initialize constants and the random number seed.
263 *
264  path( 1: 1 ) = 'Double precision'
265  path( 2: 3 ) = 'QL'
266  nrun = 0
267  nfail = 0
268  nerrs = 0
269  DO 10 i = 1, 4
270  iseed( i ) = iseedy( i )
271  10 CONTINUE
272 *
273 * Test the error exits
274 *
275  IF( tsterr )
276  $ CALL derrql( 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 DLATB4 and generate a test matrix
301 * with DLATMS.
302 *
303  CALL dlatb4( path, imat, m, n, TYPE, kl, ku, anorm, mode,
304  $ cndnum, dist )
305 *
306  srnamt = 'DLATMS'
307  CALL dlatms( 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 DLATMS.
312 *
313  IF( info.NE.0 ) THEN
314  CALL alaerh( path, 'DLATMS', 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 DQLT01; other values are
321 * used in the calls of DQLT02, 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 DGEQLF
356 *
357  CALL dqlt01( m, n, a, af, aq, al, lda, tau,
358  $ work, lwork, rwork, result( 1 ) )
359  ELSE IF( m.GE.n ) THEN
360 *
361 * Test DORGQL, using factorization
362 * returned by DQLT01
363 *
364  CALL dqlt02( 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 DORMQL, using factorization returned
370 * by DQLT01
371 *
372  CALL dqlt03( 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 DGEQLS to solve a system
377 * with NRHS right hand sides and compute the
378 * residual.
379 *
380  IF( k.EQ.n .AND. inb.EQ.1 ) THEN
381 *
382 * Generate a solution and set the right
383 * hand side.
384 *
385  srnamt = 'DLARHS'
386  CALL dlarhs( path, 'New', 'Full',
387  $ 'No transpose', m, n, 0, 0,
388  $ nrhs, a, lda, xact, lda, b, lda,
389  $ iseed, info )
390 *
391  CALL dlacpy( 'Full', m, nrhs, b, lda, x,
392  $ lda )
393  srnamt = 'DGEQLS'
394  CALL dgeqls( m, n, nrhs, af, lda, tau, x,
395  $ lda, work, lwork, info )
396 *
397 * Check error code from DGEQLS.
398 *
399  IF( info.NE.0 )
400  $ CALL alaerh( path, 'DGEQLS', info, 0, ' ',
401  $ m, n, nrhs, -1, nb, imat,
402  $ nfail, nerrs, nout )
403 *
404  CALL dget02( 'No transpose', m, n, nrhs, a,
405  $ lda, x( m-n+1 ), lda, b, lda,
406  $ rwork, result( 7 ) )
407  nt = nt + 1
408  END IF
409  END IF
410 *
411 * Print information about the tests that did not
412 * pass the threshold.
413 *
414  DO 20 i = 1, nt
415  IF( result( i ).GE.thresh ) THEN
416  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
417  $ CALL alahd( nout, path )
418  WRITE( nout, fmt = 9999 )m, n, k, nb, nx,
419  $ imat, i, result( i )
420  nfail = nfail + 1
421  END IF
422  20 CONTINUE
423  nrun = nrun + nt
424  30 CONTINUE
425  40 CONTINUE
426  50 CONTINUE
427  60 CONTINUE
428  70 CONTINUE
429 *
430 * Print a summary of the results.
431 *
432  CALL alasum( path, nout, nfail, nrun, nerrs )
433 *
434  9999 FORMAT( ' M=', i5, ', N=', i5, ', K=', i5, ', NB=', i4, ', NX=',
435  $ i5, ', type ', i2, ', test(', i2, ')=', g12.5 )
436  RETURN
437 *
438 * End of DCHKQL
439 *
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
Definition: alaerh.f:149
subroutine dlacpy(UPLO, M, N, A, LDA, B, LDB)
DLACPY copies all or part of one two-dimensional array to another.
Definition: dlacpy.f:105
subroutine dgeqls(M, N, NRHS, A, LDA, TAU, B, LDB, WORK, LWORK, INFO)
DGEQLS
Definition: dgeqls.f:124
subroutine derrql(PATH, NUNIT)
DERRQL
Definition: derrql.f:57
subroutine dget02(TRANS, M, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
DGET02
Definition: dget02.f:135
subroutine dqlt01(M, N, A, AF, Q, L, LDA, TAU, WORK, LWORK, RWORK, RESULT)
DQLT01
Definition: dqlt01.f:128
subroutine dlatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
DLATB4
Definition: dlatb4.f:122
subroutine alahd(IOUNIT, PATH)
ALAHD
Definition: alahd.f:95
subroutine dqlt02(M, N, K, A, AF, Q, L, LDA, TAU, WORK, LWORK, RWORK, RESULT)
DQLT02
Definition: dqlt02.f:138
subroutine dlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
DLATMS
Definition: dlatms.f:323
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
Definition: alasum.f:75
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
Definition: xlaenv.f:83
subroutine dqlt03(M, N, K, AF, C, CC, Q, LDA, TAU, WORK, LWORK, RWORK, RESULT)
DQLT03
Definition: dqlt03.f:138
subroutine dlarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
DLARHS
Definition: dlarhs.f:206

Here is the call graph for this function:

Here is the caller graph for this function:

subroutine dchkqr ( 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,
double precision, dimension( * )  A,
double precision, dimension( * )  AF,
double precision, dimension( * )  AQ,
double precision, dimension( * )  AR,
double precision, dimension( * )  AC,
double precision, dimension( * )  B,
double precision, dimension( * )  X,
double precision, dimension( * )  XACT,
double precision, dimension( * )  TAU,
double precision, dimension( * )  WORK,
double precision, dimension( * )  RWORK,
integer, dimension( * )  IWORK,
integer  NOUT 
)

DCHKQR

Purpose:
 DCHKQR tests DGEQRF, DORGQR and DORMQR.
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 DOUBLE PRECISION array, dimension (NMAX*NMAX)
[out]AF
          AF is DOUBLE PRECISION array, dimension (NMAX*NMAX)
[out]AQ
          AQ is DOUBLE PRECISION array, dimension (NMAX*NMAX)
[out]AR
          AR is DOUBLE PRECISION array, dimension (NMAX*NMAX)
[out]AC
          AC is DOUBLE PRECISION array, dimension (NMAX*NMAX)
[out]B
          B is DOUBLE PRECISION array, dimension (NMAX*NRHS)
[out]X
          X is DOUBLE PRECISION array, dimension (NMAX*NRHS)
[out]XACT
          XACT is DOUBLE PRECISION array, dimension (NMAX*NRHS)
[out]TAU
          TAU is DOUBLE PRECISION array, dimension (NMAX)
[out]WORK
          WORK is DOUBLE PRECISION array, dimension (NMAX*NMAX)
[out]RWORK
          RWORK is DOUBLE PRECISION array, dimension (NMAX)
[out]IWORK
          IWORK is INTEGER array, dimension (NMAX)
[in]NOUT
          NOUT is INTEGER
          The unit number for output.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
November 2015

Definition at line 203 of file dchkqr.f.

203 *
204 * -- LAPACK test routine (version 3.6.0) --
205 * -- LAPACK is a software package provided by Univ. of Tennessee, --
206 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
207 * November 2015
208 *
209 * .. Scalar Arguments ..
210  LOGICAL tsterr
211  INTEGER nm, nmax, nn, nnb, nout, nrhs
212  DOUBLE PRECISION thresh
213 * ..
214 * .. Array Arguments ..
215  LOGICAL dotype( * )
216  INTEGER iwork( * ), mval( * ), nbval( * ), nval( * ),
217  $ nxval( * )
218  DOUBLE PRECISION a( * ), ac( * ), af( * ), aq( * ), ar( * ),
219  $ b( * ), rwork( * ), tau( * ), work( * ),
220  $ x( * ), xact( * )
221 * ..
222 *
223 * =====================================================================
224 *
225 * .. Parameters ..
226  INTEGER ntests
227  parameter( ntests = 9 )
228  INTEGER ntypes
229  parameter( ntypes = 8 )
230  DOUBLE PRECISION zero
231  parameter( zero = 0.0d0 )
232 * ..
233 * .. Local Scalars ..
234  CHARACTER dist, type
235  CHARACTER*3 path
236  INTEGER i, ik, im, imat, in, inb, info, k, kl, ku, lda,
237  $ lwork, m, minmn, mode, n, nb, nerrs, nfail, nk,
238  $ nrun, nt, nx
239  DOUBLE PRECISION anorm, cndnum
240 * ..
241 * .. Local Arrays ..
242  INTEGER iseed( 4 ), iseedy( 4 ), kval( 4 )
243  DOUBLE PRECISION result( ntests )
244 * ..
245 * .. External Functions ..
246  LOGICAL dgennd
247  EXTERNAL dgennd
248 * ..
249 * .. External Subroutines ..
250  EXTERNAL alaerh, alahd, alasum, derrqr, dgeqrs, dget02,
253 * ..
254 * .. Intrinsic Functions ..
255  INTRINSIC max, min
256 * ..
257 * .. Scalars in Common ..
258  LOGICAL lerr, ok
259  CHARACTER*32 srnamt
260  INTEGER infot, nunit
261 * ..
262 * .. Common blocks ..
263  COMMON / infoc / infot, nunit, ok, lerr
264  COMMON / srnamc / srnamt
265 * ..
266 * .. Data statements ..
267  DATA iseedy / 1988, 1989, 1990, 1991 /
268 * ..
269 * .. Executable Statements ..
270 *
271 * Initialize constants and the random number seed.
272 *
273  path( 1: 1 ) = 'Double precision'
274  path( 2: 3 ) = 'QR'
275  nrun = 0
276  nfail = 0
277  nerrs = 0
278  DO 10 i = 1, 4
279  iseed( i ) = iseedy( i )
280  10 CONTINUE
281 *
282 * Test the error exits
283 *
284  IF( tsterr )
285  $ CALL derrqr( path, nout )
286  infot = 0
287  CALL xlaenv( 2, 2 )