LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
cchkpp.f
Go to the documentation of this file.
00001 *> \brief \b CCHKPP
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 CCHKPP( DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR,
00012 *                          NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK,
00013 *                          NOUT )
00014 * 
00015 *       .. Scalar Arguments ..
00016 *       LOGICAL            TSTERR
00017 *       INTEGER            NMAX, NN, NNS, NOUT
00018 *       REAL               THRESH
00019 *       ..
00020 *       .. Array Arguments ..
00021 *       LOGICAL            DOTYPE( * )
00022 *       INTEGER            NSVAL( * ), NVAL( * )
00023 *       REAL               RWORK( * )
00024 *       COMPLEX            A( * ), AFAC( * ), AINV( * ), B( * ),
00025 *      $                   WORK( * ), X( * ), XACT( * )
00026 *       ..
00027 *  
00028 *
00029 *> \par Purpose:
00030 *  =============
00031 *>
00032 *> \verbatim
00033 *>
00034 *> CCHKPP tests CPPTRF, -TRI, -TRS, -RFS, and -CON
00035 *> \endverbatim
00036 *
00037 *  Arguments:
00038 *  ==========
00039 *
00040 *> \param[in] DOTYPE
00041 *> \verbatim
00042 *>          DOTYPE is LOGICAL array, dimension (NTYPES)
00043 *>          The matrix types to be used for testing.  Matrices of type j
00044 *>          (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) =
00045 *>          .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.
00046 *> \endverbatim
00047 *>
00048 *> \param[in] NN
00049 *> \verbatim
00050 *>          NN is INTEGER
00051 *>          The number of values of N contained in the vector NVAL.
00052 *> \endverbatim
00053 *>
00054 *> \param[in] NVAL
00055 *> \verbatim
00056 *>          NVAL is INTEGER array, dimension (NN)
00057 *>          The values of the matrix dimension N.
00058 *> \endverbatim
00059 *>
00060 *> \param[in] NNS
00061 *> \verbatim
00062 *>          NNS is INTEGER
00063 *>          The number of values of NRHS contained in the vector NSVAL.
00064 *> \endverbatim
00065 *>
00066 *> \param[in] NSVAL
00067 *> \verbatim
00068 *>          NSVAL is INTEGER array, dimension (NNS)
00069 *>          The values of the number of right hand sides NRHS.
00070 *> \endverbatim
00071 *>
00072 *> \param[in] THRESH
00073 *> \verbatim
00074 *>          THRESH is REAL
00075 *>          The threshold value for the test ratios.  A result is
00076 *>          included in the output file if RESULT >= THRESH.  To have
00077 *>          every test ratio printed, use THRESH = 0.
00078 *> \endverbatim
00079 *>
00080 *> \param[in] TSTERR
00081 *> \verbatim
00082 *>          TSTERR is LOGICAL
00083 *>          Flag that indicates whether error exits are to be tested.
00084 *> \endverbatim
00085 *>
00086 *> \param[in] NMAX
00087 *> \verbatim
00088 *>          NMAX is INTEGER
00089 *>          The maximum value permitted for N, used in dimensioning the
00090 *>          work arrays.
00091 *> \endverbatim
00092 *>
00093 *> \param[out] A
00094 *> \verbatim
00095 *>          A is COMPLEX array, dimension
00096 *>                      (NMAX*(NMAX+1)/2)
00097 *> \endverbatim
00098 *>
00099 *> \param[out] AFAC
00100 *> \verbatim
00101 *>          AFAC is COMPLEX array, dimension
00102 *>                      (NMAX*(NMAX+1)/2)
00103 *> \endverbatim
00104 *>
00105 *> \param[out] AINV
00106 *> \verbatim
00107 *>          AINV is COMPLEX array, dimension
00108 *>                      (NMAX*(NMAX+1)/2)
00109 *> \endverbatim
00110 *>
00111 *> \param[out] B
00112 *> \verbatim
00113 *>          B is COMPLEX array, dimension (NMAX*NSMAX)
00114 *>          where NSMAX is the largest entry in NSVAL.
00115 *> \endverbatim
00116 *>
00117 *> \param[out] X
00118 *> \verbatim
00119 *>          X is COMPLEX array, dimension (NMAX*NSMAX)
00120 *> \endverbatim
00121 *>
00122 *> \param[out] XACT
00123 *> \verbatim
00124 *>          XACT is COMPLEX array, dimension (NMAX*NSMAX)
00125 *> \endverbatim
00126 *>
00127 *> \param[out] WORK
00128 *> \verbatim
00129 *>          WORK is COMPLEX array, dimension
00130 *>                      (NMAX*max(3,NSMAX))
00131 *> \endverbatim
00132 *>
00133 *> \param[out] RWORK
00134 *> \verbatim
00135 *>          RWORK is REAL array, dimension
00136 *>                      (max(NMAX,2*NSMAX))
00137 *> \endverbatim
00138 *>
00139 *> \param[in] NOUT
00140 *> \verbatim
00141 *>          NOUT is INTEGER
00142 *>          The unit number for output.
00143 *> \endverbatim
00144 *
00145 *  Authors:
00146 *  ========
00147 *
00148 *> \author Univ. of Tennessee 
00149 *> \author Univ. of California Berkeley 
00150 *> \author Univ. of Colorado Denver 
00151 *> \author NAG Ltd. 
00152 *
00153 *> \date November 2011
00154 *
00155 *> \ingroup complex_lin
00156 *
00157 *  =====================================================================
00158       SUBROUTINE CCHKPP( DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR,
00159      $                   NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK,
00160      $                   NOUT )
00161 *
00162 *  -- LAPACK test routine (version 3.4.0) --
00163 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00164 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00165 *     November 2011
00166 *
00167 *     .. Scalar Arguments ..
00168       LOGICAL            TSTERR
00169       INTEGER            NMAX, NN, NNS, NOUT
00170       REAL               THRESH
00171 *     ..
00172 *     .. Array Arguments ..
00173       LOGICAL            DOTYPE( * )
00174       INTEGER            NSVAL( * ), NVAL( * )
00175       REAL               RWORK( * )
00176       COMPLEX            A( * ), AFAC( * ), AINV( * ), B( * ),
00177      $                   WORK( * ), X( * ), XACT( * )
00178 *     ..
00179 *
00180 *  =====================================================================
00181 *
00182 *     .. Parameters ..
00183       REAL               ZERO
00184       PARAMETER          ( ZERO = 0.0E+0 )
00185       INTEGER            NTYPES
00186       PARAMETER          ( NTYPES = 9 )
00187       INTEGER            NTESTS
00188       PARAMETER          ( NTESTS = 8 )
00189 *     ..
00190 *     .. Local Scalars ..
00191       LOGICAL            ZEROT
00192       CHARACTER          DIST, PACKIT, TYPE, UPLO, XTYPE
00193       CHARACTER*3        PATH
00194       INTEGER            I, IMAT, IN, INFO, IOFF, IRHS, IUPLO, IZERO, K,
00195      $                   KL, KU, LDA, MODE, N, NERRS, NFAIL, NIMAT, NPP,
00196      $                   NRHS, NRUN
00197       REAL               ANORM, CNDNUM, RCOND, RCONDC
00198 *     ..
00199 *     .. Local Arrays ..
00200       CHARACTER          PACKS( 2 ), UPLOS( 2 )
00201       INTEGER            ISEED( 4 ), ISEEDY( 4 )
00202       REAL               RESULT( NTESTS )
00203 *     ..
00204 *     .. External Functions ..
00205       REAL               CLANHP, SGET06
00206       EXTERNAL           CLANHP, SGET06
00207 *     ..
00208 *     .. External Subroutines ..
00209       EXTERNAL           ALAERH, ALAHD, ALASUM, CCOPY, CERRPO, CGET04,
00210      $                   CLACPY, CLAIPD, CLARHS, CLATB4, CLATMS, CPPCON,
00211      $                   CPPRFS, CPPT01, CPPT02, CPPT03, CPPT05, CPPTRF,
00212      $                   CPPTRI, CPPTRS
00213 *     ..
00214 *     .. Scalars in Common ..
00215       LOGICAL            LERR, OK
00216       CHARACTER*32       SRNAMT
00217       INTEGER            INFOT, NUNIT
00218 *     ..
00219 *     .. Common blocks ..
00220       COMMON             / INFOC / INFOT, NUNIT, OK, LERR
00221       COMMON             / SRNAMC / SRNAMT
00222 *     ..
00223 *     .. Intrinsic Functions ..
00224       INTRINSIC          MAX
00225 *     ..
00226 *     .. Data statements ..
00227       DATA               ISEEDY / 1988, 1989, 1990, 1991 /
00228       DATA               UPLOS / 'U', 'L' / , PACKS / 'C', 'R' /
00229 *     ..
00230 *     .. Executable Statements ..
00231 *
00232 *     Initialize constants and the random number seed.
00233 *
00234       PATH( 1: 1 ) = 'Complex precision'
00235       PATH( 2: 3 ) = 'PP'
00236       NRUN = 0
00237       NFAIL = 0
00238       NERRS = 0
00239       DO 10 I = 1, 4
00240          ISEED( I ) = ISEEDY( I )
00241    10 CONTINUE
00242 *
00243 *     Test the error exits
00244 *
00245       IF( TSTERR )
00246      $   CALL CERRPO( PATH, NOUT )
00247       INFOT = 0
00248 *
00249 *     Do for each value of N in NVAL
00250 *
00251       DO 110 IN = 1, NN
00252          N = NVAL( IN )
00253          LDA = MAX( N, 1 )
00254          XTYPE = 'N'
00255          NIMAT = NTYPES
00256          IF( N.LE.0 )
00257      $      NIMAT = 1
00258 *
00259          DO 100 IMAT = 1, NIMAT
00260 *
00261 *           Do the tests only if DOTYPE( IMAT ) is true.
00262 *
00263             IF( .NOT.DOTYPE( IMAT ) )
00264      $         GO TO 100
00265 *
00266 *           Skip types 3, 4, or 5 if the matrix size is too small.
00267 *
00268             ZEROT = IMAT.GE.3 .AND. IMAT.LE.5
00269             IF( ZEROT .AND. N.LT.IMAT-2 )
00270      $         GO TO 100
00271 *
00272 *           Do first for UPLO = 'U', then for UPLO = 'L'
00273 *
00274             DO 90 IUPLO = 1, 2
00275                UPLO = UPLOS( IUPLO )
00276                PACKIT = PACKS( IUPLO )
00277 *
00278 *              Set up parameters with CLATB4 and generate a test matrix
00279 *              with CLATMS.
00280 *
00281                CALL CLATB4( PATH, IMAT, N, N, TYPE, KL, KU, ANORM, MODE,
00282      $                      CNDNUM, DIST )
00283 *
00284                SRNAMT = 'CLATMS'
00285                CALL CLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE,
00286      $                      CNDNUM, ANORM, KL, KU, PACKIT, A, LDA, WORK,
00287      $                      INFO )
00288 *
00289 *              Check error code from CLATMS.
00290 *
00291                IF( INFO.NE.0 ) THEN
00292                   CALL ALAERH( PATH, 'CLATMS', INFO, 0, UPLO, N, N, -1,
00293      $                         -1, -1, IMAT, NFAIL, NERRS, NOUT )
00294                   GO TO 90
00295                END IF
00296 *
00297 *              For types 3-5, zero one row and column of the matrix to
00298 *              test that INFO is returned correctly.
00299 *
00300                IF( ZEROT ) THEN
00301                   IF( IMAT.EQ.3 ) THEN
00302                      IZERO = 1
00303                   ELSE IF( IMAT.EQ.4 ) THEN
00304                      IZERO = N
00305                   ELSE
00306                      IZERO = N / 2 + 1
00307                   END IF
00308 *
00309 *                 Set row and column IZERO of A to 0.
00310 *
00311                   IF( IUPLO.EQ.1 ) THEN
00312                      IOFF = ( IZERO-1 )*IZERO / 2
00313                      DO 20 I = 1, IZERO - 1
00314                         A( IOFF+I ) = ZERO
00315    20                CONTINUE
00316                      IOFF = IOFF + IZERO
00317                      DO 30 I = IZERO, N
00318                         A( IOFF ) = ZERO
00319                         IOFF = IOFF + I
00320    30                CONTINUE
00321                   ELSE
00322                      IOFF = IZERO
00323                      DO 40 I = 1, IZERO - 1
00324                         A( IOFF ) = ZERO
00325                         IOFF = IOFF + N - I
00326    40                CONTINUE
00327                      IOFF = IOFF - IZERO
00328                      DO 50 I = IZERO, N
00329                         A( IOFF+I ) = ZERO
00330    50                CONTINUE
00331                   END IF
00332                ELSE
00333                   IZERO = 0
00334                END IF
00335 *
00336 *              Set the imaginary part of the diagonals.
00337 *
00338                IF( IUPLO.EQ.1 ) THEN
00339                   CALL CLAIPD( N, A, 2, 1 )
00340                ELSE
00341                   CALL CLAIPD( N, A, N, -1 )
00342                END IF
00343 *
00344 *              Compute the L*L' or U'*U factorization of the matrix.
00345 *
00346                NPP = N*( N+1 ) / 2
00347                CALL CCOPY( NPP, A, 1, AFAC, 1 )
00348                SRNAMT = 'CPPTRF'
00349                CALL CPPTRF( UPLO, N, AFAC, INFO )
00350 *
00351 *              Check error code from CPPTRF.
00352 *
00353                IF( INFO.NE.IZERO ) THEN
00354                   CALL ALAERH( PATH, 'CPPTRF', INFO, IZERO, UPLO, N, N,
00355      $                         -1, -1, -1, IMAT, NFAIL, NERRS, NOUT )
00356                   GO TO 90
00357                END IF
00358 *
00359 *              Skip the tests if INFO is not 0.
00360 *
00361                IF( INFO.NE.0 )
00362      $            GO TO 90
00363 *
00364 *+    TEST 1
00365 *              Reconstruct matrix from factors and compute residual.
00366 *
00367                CALL CCOPY( NPP, AFAC, 1, AINV, 1 )
00368                CALL CPPT01( UPLO, N, A, AINV, RWORK, RESULT( 1 ) )
00369 *
00370 *+    TEST 2
00371 *              Form the inverse and compute the residual.
00372 *
00373                CALL CCOPY( NPP, AFAC, 1, AINV, 1 )
00374                SRNAMT = 'CPPTRI'
00375                CALL CPPTRI( UPLO, N, AINV, INFO )
00376 *
00377 *              Check error code from CPPTRI.
00378 *
00379                IF( INFO.NE.0 )
00380      $            CALL ALAERH( PATH, 'CPPTRI', INFO, 0, UPLO, N, N, -1,
00381      $                         -1, -1, IMAT, NFAIL, NERRS, NOUT )
00382 *
00383                CALL CPPT03( UPLO, N, A, AINV, WORK, LDA, RWORK, RCONDC,
00384      $                      RESULT( 2 ) )
00385 *
00386 *              Print information about the tests that did not pass
00387 *              the threshold.
00388 *
00389                DO 60 K = 1, 2
00390                   IF( RESULT( K ).GE.THRESH ) THEN
00391                      IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
00392      $                  CALL ALAHD( NOUT, PATH )
00393                      WRITE( NOUT, FMT = 9999 )UPLO, N, IMAT, K,
00394      $                  RESULT( K )
00395                      NFAIL = NFAIL + 1
00396                   END IF
00397    60          CONTINUE
00398                NRUN = NRUN + 2
00399 *
00400                DO 80 IRHS = 1, NNS
00401                   NRHS = NSVAL( IRHS )
00402 *
00403 *+    TEST 3
00404 *              Solve and compute residual for  A * X = B.
00405 *
00406                   SRNAMT = 'CLARHS'
00407                   CALL CLARHS( PATH, XTYPE, UPLO, ' ', N, N, KL, KU,
00408      $                         NRHS, A, LDA, XACT, LDA, B, LDA, ISEED,
00409      $                         INFO )
00410                   CALL CLACPY( 'Full', N, NRHS, B, LDA, X, LDA )
00411 *
00412                   SRNAMT = 'CPPTRS'
00413                   CALL CPPTRS( UPLO, N, NRHS, AFAC, X, LDA, INFO )
00414 *
00415 *              Check error code from CPPTRS.
00416 *
00417                   IF( INFO.NE.0 )
00418      $               CALL ALAERH( PATH, 'CPPTRS', INFO, 0, UPLO, N, N,
00419      $                            -1, -1, NRHS, IMAT, NFAIL, NERRS,
00420      $                            NOUT )
00421 *
00422                   CALL CLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA )
00423                   CALL CPPT02( UPLO, N, NRHS, A, X, LDA, WORK, LDA,
00424      $                         RWORK, RESULT( 3 ) )
00425 *
00426 *+    TEST 4
00427 *              Check solution from generated exact solution.
00428 *
00429                   CALL CGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC,
00430      $                         RESULT( 4 ) )
00431 *
00432 *+    TESTS 5, 6, and 7
00433 *              Use iterative refinement to improve the solution.
00434 *
00435                   SRNAMT = 'CPPRFS'
00436                   CALL CPPRFS( UPLO, N, NRHS, A, AFAC, B, LDA, X, LDA,
00437      $                         RWORK, RWORK( NRHS+1 ), WORK,
00438      $                         RWORK( 2*NRHS+1 ), INFO )
00439 *
00440 *              Check error code from CPPRFS.
00441 *
00442                   IF( INFO.NE.0 )
00443      $               CALL ALAERH( PATH, 'CPPRFS', INFO, 0, UPLO, N, N,
00444      $                            -1, -1, NRHS, IMAT, NFAIL, NERRS,
00445      $                            NOUT )
00446 *
00447                   CALL CGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC,
00448      $                         RESULT( 5 ) )
00449                   CALL CPPT05( UPLO, N, NRHS, A, B, LDA, X, LDA, XACT,
00450      $                         LDA, RWORK, RWORK( NRHS+1 ),
00451      $                         RESULT( 6 ) )
00452 *
00453 *                 Print information about the tests that did not pass
00454 *                 the threshold.
00455 *
00456                   DO 70 K = 3, 7
00457                      IF( RESULT( K ).GE.THRESH ) THEN
00458                         IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
00459      $                     CALL ALAHD( NOUT, PATH )
00460                         WRITE( NOUT, FMT = 9998 )UPLO, N, NRHS, IMAT,
00461      $                     K, RESULT( K )
00462                         NFAIL = NFAIL + 1
00463                      END IF
00464    70             CONTINUE
00465                   NRUN = NRUN + 5
00466    80          CONTINUE
00467 *
00468 *+    TEST 8
00469 *              Get an estimate of RCOND = 1/CNDNUM.
00470 *
00471                ANORM = CLANHP( '1', UPLO, N, A, RWORK )
00472                SRNAMT = 'CPPCON'
00473                CALL CPPCON( UPLO, N, AFAC, ANORM, RCOND, WORK, RWORK,
00474      $                      INFO )
00475 *
00476 *              Check error code from CPPCON.
00477 *
00478                IF( INFO.NE.0 )
00479      $            CALL ALAERH( PATH, 'CPPCON', INFO, 0, UPLO, N, N, -1,
00480      $                         -1, -1, IMAT, NFAIL, NERRS, NOUT )
00481 *
00482                RESULT( 8 ) = SGET06( RCOND, RCONDC )
00483 *
00484 *              Print the test ratio if greater than or equal to THRESH.
00485 *
00486                IF( RESULT( 8 ).GE.THRESH ) THEN
00487                   IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
00488      $               CALL ALAHD( NOUT, PATH )
00489                   WRITE( NOUT, FMT = 9999 )UPLO, N, IMAT, 8,
00490      $               RESULT( 8 )
00491                   NFAIL = NFAIL + 1
00492                END IF
00493                NRUN = NRUN + 1
00494 *
00495    90       CONTINUE
00496   100    CONTINUE
00497   110 CONTINUE
00498 *
00499 *     Print a summary of the results.
00500 *
00501       CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS )
00502 *
00503  9999 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ', type ', I2, ', test ',
00504      $      I2, ', ratio =', G12.5 )
00505  9998 FORMAT( ' UPLO = ''', A1, ''', N =', I5, ', NRHS=', I3, ', type ',
00506      $      I2, ', test(', I2, ') =', G12.5 )
00507       RETURN
00508 *
00509 *     End of CCHKPP
00510 *
00511       END
 All Files Functions