LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
dchkps.f
Go to the documentation of this file.
00001 *> \brief \b DCHKPS
00002 *
00003 *  =========== DOCUMENTATION ===========
00004 *
00005 * Online html documentation available at 
00006 *            http://www.netlib.org/lapack/explore-html/ 
00007 *
00008 *  Definition:
00009 *  ===========
00010 *
00011 *       SUBROUTINE DCHKPS( DOTYPE, NN, NVAL, NNB, NBVAL, NRANK, RANKVAL,
00012 *                          THRESH, TSTERR, NMAX, A, AFAC, PERM, PIV, WORK,
00013 *                          RWORK, NOUT )
00014 * 
00015 *       .. Scalar Arguments ..
00016 *       DOUBLE PRECISION   THRESH
00017 *       INTEGER            NMAX, NN, NNB, NOUT, NRANK
00018 *       LOGICAL            TSTERR
00019 *       ..
00020 *       .. Array Arguments ..
00021 *       DOUBLE PRECISION   A( * ), AFAC( * ), PERM( * ), RWORK( * ),
00022 *      $                   WORK( * )
00023 *       INTEGER            NBVAL( * ), NVAL( * ), PIV( * ), RANKVAL( * )
00024 *       LOGICAL            DOTYPE( * )
00025 *       ..
00026 *  
00027 *
00028 *> \par Purpose:
00029 *  =============
00030 *>
00031 *> \verbatim
00032 *>
00033 *> DCHKPS tests DPSTRF.
00034 *> \endverbatim
00035 *
00036 *  Arguments:
00037 *  ==========
00038 *
00039 *> \param[in] DOTYPE
00040 *> \verbatim
00041 *>          DOTYPE is LOGICAL array, dimension (NTYPES)
00042 *>          The matrix types to be used for testing.  Matrices of type j
00043 *>          (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) =
00044 *>          .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.
00045 *> \endverbatim
00046 *>
00047 *> \param[in] NN
00048 *> \verbatim
00049 *>          NN is INTEGER
00050 *>          The number of values of N contained in the vector NVAL.
00051 *> \endverbatim
00052 *>
00053 *> \param[in] NVAL
00054 *> \verbatim
00055 *>          NVAL is INTEGER array, dimension (NN)
00056 *>          The values of the matrix dimension N.
00057 *> \endverbatim
00058 *>
00059 *> \param[in] NNB
00060 *> \verbatim
00061 *>          NNB is INTEGER
00062 *>          The number of values of NB contained in the vector NBVAL.
00063 *> \endverbatim
00064 *>
00065 *> \param[in] NBVAL
00066 *> \verbatim
00067 *>          NBVAL is INTEGER array, dimension (NBVAL)
00068 *>          The values of the block size NB.
00069 *> \endverbatim
00070 *>
00071 *> \param[in] NRANK
00072 *> \verbatim
00073 *>          NRANK is INTEGER
00074 *>          The number of values of RANK contained in the vector RANKVAL.
00075 *> \endverbatim
00076 *>
00077 *> \param[in] RANKVAL
00078 *> \verbatim
00079 *>          RANKVAL is INTEGER array, dimension (NBVAL)
00080 *>          The values of the block size NB.
00081 *> \endverbatim
00082 *>
00083 *> \param[in] THRESH
00084 *> \verbatim
00085 *>          THRESH is DOUBLE PRECISION
00086 *>          The threshold value for the test ratios.  A result is
00087 *>          included in the output file if RESULT >= THRESH.  To have
00088 *>          every test ratio printed, use THRESH = 0.
00089 *> \endverbatim
00090 *>
00091 *> \param[in] TSTERR
00092 *> \verbatim
00093 *>          TSTERR is LOGICAL
00094 *>          Flag that indicates whether error exits are to be tested.
00095 *> \endverbatim
00096 *>
00097 *> \param[in] NMAX
00098 *> \verbatim
00099 *>          NMAX is INTEGER
00100 *>          The maximum value permitted for N, used in dimensioning the
00101 *>          work arrays.
00102 *> \endverbatim
00103 *>
00104 *> \param[out] A
00105 *> \verbatim
00106 *>          A is DOUBLE PRECISION array, dimension (NMAX*NMAX)
00107 *> \endverbatim
00108 *>
00109 *> \param[out] AFAC
00110 *> \verbatim
00111 *>          AFAC is DOUBLE PRECISION array, dimension (NMAX*NMAX)
00112 *> \endverbatim
00113 *>
00114 *> \param[out] PERM
00115 *> \verbatim
00116 *>          PERM is DOUBLE PRECISION array, dimension (NMAX*NMAX)
00117 *> \endverbatim
00118 *>
00119 *> \param[out] PIV
00120 *> \verbatim
00121 *>          PIV is INTEGER array, dimension (NMAX)
00122 *> \endverbatim
00123 *>
00124 *> \param[out] WORK
00125 *> \verbatim
00126 *>          WORK is DOUBLE PRECISION array, dimension (NMAX*3)
00127 *> \endverbatim
00128 *>
00129 *> \param[out] RWORK
00130 *> \verbatim
00131 *>          RWORK is DOUBLE PRECISION array, dimension (NMAX)
00132 *> \endverbatim
00133 *>
00134 *> \param[in] NOUT
00135 *> \verbatim
00136 *>          NOUT is INTEGER
00137 *>          The unit number for output.
00138 *> \endverbatim
00139 *
00140 *  Authors:
00141 *  ========
00142 *
00143 *> \author Univ. of Tennessee 
00144 *> \author Univ. of California Berkeley 
00145 *> \author Univ. of Colorado Denver 
00146 *> \author NAG Ltd. 
00147 *
00148 *> \date November 2011
00149 *
00150 *> \ingroup double_lin
00151 *
00152 *  =====================================================================
00153       SUBROUTINE DCHKPS( DOTYPE, NN, NVAL, NNB, NBVAL, NRANK, RANKVAL,
00154      $                   THRESH, TSTERR, NMAX, A, AFAC, PERM, PIV, WORK,
00155      $                   RWORK, NOUT )
00156 *
00157 *  -- LAPACK test routine (version 3.4.0) --
00158 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00159 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00160 *     November 2011
00161 *
00162 *     .. Scalar Arguments ..
00163       DOUBLE PRECISION   THRESH
00164       INTEGER            NMAX, NN, NNB, NOUT, NRANK
00165       LOGICAL            TSTERR
00166 *     ..
00167 *     .. Array Arguments ..
00168       DOUBLE PRECISION   A( * ), AFAC( * ), PERM( * ), RWORK( * ),
00169      $                   WORK( * )
00170       INTEGER            NBVAL( * ), NVAL( * ), PIV( * ), RANKVAL( * )
00171       LOGICAL            DOTYPE( * )
00172 *     ..
00173 *
00174 *  =====================================================================
00175 *
00176 *     .. Parameters ..
00177       DOUBLE PRECISION   ONE
00178       PARAMETER          ( ONE = 1.0D+0 )
00179       INTEGER            NTYPES
00180       PARAMETER          ( NTYPES = 9 )
00181 *     ..
00182 *     .. Local Scalars ..
00183       DOUBLE PRECISION   ANORM, CNDNUM, RESULT, TOL
00184       INTEGER            COMPRANK, I, IMAT, IN, INB, INFO, IRANK, IUPLO,
00185      $                   IZERO, KL, KU, LDA, MODE, N, NB, NERRS, NFAIL,
00186      $                   NIMAT, NRUN, RANK, RANKDIFF
00187       CHARACTER          DIST, TYPE, UPLO
00188       CHARACTER*3        PATH
00189 *     ..
00190 *     .. Local Arrays ..
00191       INTEGER            ISEED( 4 ), ISEEDY( 4 )
00192       CHARACTER          UPLOS( 2 )
00193 *     ..
00194 *     .. External Subroutines ..
00195       EXTERNAL           ALAERH, ALAHD, ALASUM, DERRPS, DLACPY, DLATB5,
00196      $                   DLATMT, DPST01, DPSTRF, XLAENV
00197 *     ..
00198 *     .. Scalars in Common ..
00199       INTEGER            INFOT, NUNIT
00200       LOGICAL            LERR, OK
00201       CHARACTER*32       SRNAMT
00202 *     ..
00203 *     .. Common blocks ..
00204       COMMON             / INFOC / INFOT, NUNIT, OK, LERR
00205       COMMON             / SRNAMC / SRNAMT
00206 *     ..
00207 *     .. Intrinsic Functions ..
00208       INTRINSIC          DBLE, MAX, CEILING
00209 *     ..
00210 *     .. Data statements ..
00211       DATA               ISEEDY / 1988, 1989, 1990, 1991 /
00212       DATA               UPLOS / 'U', 'L' /
00213 *     ..
00214 *     .. Executable Statements ..
00215 *
00216 *     Initialize constants and the random number seed.
00217 *
00218       PATH( 1: 1 ) = 'Double precision'
00219       PATH( 2: 3 ) = 'PS'
00220       NRUN = 0
00221       NFAIL = 0
00222       NERRS = 0
00223       DO 100 I = 1, 4
00224          ISEED( I ) = ISEEDY( I )
00225   100 CONTINUE
00226 *
00227 *     Test the error exits
00228 *
00229       IF( TSTERR )
00230      $   CALL DERRPS( PATH, NOUT )
00231       INFOT = 0
00232       CALL XLAENV( 2, 2 )
00233 *
00234 *     Do for each value of N in NVAL
00235 *
00236       DO 150 IN = 1, NN
00237          N = NVAL( IN )
00238          LDA = MAX( N, 1 )
00239          NIMAT = NTYPES
00240          IF( N.LE.0 )
00241      $      NIMAT = 1
00242 *
00243          IZERO = 0
00244          DO 140 IMAT = 1, NIMAT
00245 *
00246 *           Do the tests only if DOTYPE( IMAT ) is true.
00247 *
00248             IF( .NOT.DOTYPE( IMAT ) )
00249      $         GO TO 140
00250 *
00251 *              Do for each value of RANK in RANKVAL
00252 *
00253             DO 130 IRANK = 1, NRANK
00254 *
00255 *              Only repeat test 3 to 5 for different ranks
00256 *              Other tests use full rank
00257 *
00258                IF( ( IMAT.LT.3 .OR. IMAT.GT.5 ) .AND. IRANK.GT.1 )
00259      $            GO TO 130
00260 *
00261                RANK = CEILING( ( N * DBLE( RANKVAL( IRANK ) ) )
00262      $              / 100.D+0 )
00263 *
00264 *
00265 *           Do first for UPLO = 'U', then for UPLO = 'L'
00266 *
00267                DO 120 IUPLO = 1, 2
00268                   UPLO = UPLOS( IUPLO )
00269 *
00270 *              Set up parameters with DLATB5 and generate a test matrix
00271 *              with DLATMT.
00272 *
00273                   CALL DLATB5( PATH, IMAT, N, TYPE, KL, KU, ANORM,
00274      $                         MODE, CNDNUM, DIST )
00275 *
00276                   SRNAMT = 'DLATMT'
00277                   CALL DLATMT( N, N, DIST, ISEED, TYPE, RWORK, MODE,
00278      $                         CNDNUM, ANORM, RANK, KL, KU, UPLO, A,
00279      $                         LDA, WORK, INFO )
00280 *
00281 *              Check error code from DLATMT.
00282 *
00283                   IF( INFO.NE.0 ) THEN
00284                     CALL ALAERH( PATH, 'DLATMT', INFO, 0, UPLO, N,
00285      $                           N, -1, -1, -1, IMAT, NFAIL, NERRS,
00286      $                           NOUT )
00287                      GO TO 120
00288                   END IF
00289 *
00290 *              Do for each value of NB in NBVAL
00291 *
00292                   DO 110 INB = 1, NNB
00293                      NB = NBVAL( INB )
00294                      CALL XLAENV( 1, NB )
00295 *
00296 *                 Compute the pivoted L*L' or U'*U factorization
00297 *                 of the matrix.
00298 *
00299                      CALL DLACPY( UPLO, N, N, A, LDA, AFAC, LDA )
00300                      SRNAMT = 'DPSTRF'
00301 *
00302 *                 Use default tolerance
00303 *
00304                      TOL = -ONE
00305                      CALL DPSTRF( UPLO, N, AFAC, LDA, PIV, COMPRANK,
00306      $                            TOL, WORK, INFO )
00307 *
00308 *                 Check error code from DPSTRF.
00309 *
00310                      IF( (INFO.LT.IZERO)
00311      $                    .OR.(INFO.NE.IZERO.AND.RANK.EQ.N)
00312      $                    .OR.(INFO.LE.IZERO.AND.RANK.LT.N) ) THEN
00313                         CALL ALAERH( PATH, 'DPSTRF', INFO, IZERO,
00314      $                               UPLO, N, N, -1, -1, NB, IMAT,
00315      $                               NFAIL, NERRS, NOUT )
00316                         GO TO 110
00317                      END IF
00318 *
00319 *                 Skip the test if INFO is not 0.
00320 *
00321                      IF( INFO.NE.0 )
00322      $                  GO TO 110
00323 *
00324 *                 Reconstruct matrix from factors and compute residual.
00325 *
00326 *                 PERM holds permuted L*L^T or U^T*U
00327 *
00328                      CALL DPST01( UPLO, N, A, LDA, AFAC, LDA, PERM, LDA,
00329      $                            PIV, RWORK, RESULT, COMPRANK )
00330 *
00331 *                 Print information about the tests that did not pass
00332 *                 the threshold or where computed rank was not RANK.
00333 *
00334                      IF( N.EQ.0 )
00335      $                  COMPRANK = 0
00336                      RANKDIFF = RANK - COMPRANK
00337                      IF( RESULT.GE.THRESH ) THEN
00338                         IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
00339      $                     CALL ALAHD( NOUT, PATH )
00340                         WRITE( NOUT, FMT = 9999 )UPLO, N, RANK,
00341      $                     RANKDIFF, NB, IMAT, RESULT
00342                         NFAIL = NFAIL + 1
00343                      END IF
00344                      NRUN = NRUN + 1
00345   110             CONTINUE
00346 *
00347   120          CONTINUE
00348   130       CONTINUE
00349   140    CONTINUE
00350   150 CONTINUE
00351 *
00352 *     Print a summary of the results.
00353 *
00354       CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS )
00355 *
00356  9999 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ', RANK =', I3,
00357      $      ', Diff =', I5, ', NB =', I4, ', type ', I2, ', Ratio =',
00358      $      G12.5 )
00359       RETURN
00360 *
00361 *     End of DCHKPS
00362 *
00363       END
 All Files Functions