LAPACK: TESTING/LIN/cchkpo.f Source File

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