LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
cchktp.f
Go to the documentation of this file.
00001 *> \brief \b CCHKTP
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 CCHKTP( DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR,
00012 *                          NMAX, AP, AINVP, 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            AINVP( * ), AP( * ), B( * ), WORK( * ), X( * ),
00025 *      $                   XACT( * )
00026 *       ..
00027 *  
00028 *
00029 *> \par Purpose:
00030 *  =============
00031 *>
00032 *> \verbatim
00033 *>
00034 *> CCHKTP tests CTPTRI, -TRS, -RFS, and -CON, and CLATPS
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 column 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 leading dimension of the work arrays.  NMAX >= the
00090 *>          maximumm value of N in NVAL.
00091 *> \endverbatim
00092 *>
00093 *> \param[out] AP
00094 *> \verbatim
00095 *>          AP is COMPLEX array, dimension (NMAX*(NMAX+1)/2)
00096 *> \endverbatim
00097 *>
00098 *> \param[out] AINVP
00099 *> \verbatim
00100 *>          AINVP is COMPLEX array, dimension (NMAX*(NMAX+1)/2)
00101 *> \endverbatim
00102 *>
00103 *> \param[out] B
00104 *> \verbatim
00105 *>          B is COMPLEX array, dimension (NMAX*NSMAX)
00106 *>          where NSMAX is the largest entry in NSVAL.
00107 *> \endverbatim
00108 *>
00109 *> \param[out] X
00110 *> \verbatim
00111 *>          X is COMPLEX array, dimension (NMAX*NSMAX)
00112 *> \endverbatim
00113 *>
00114 *> \param[out] XACT
00115 *> \verbatim
00116 *>          XACT is COMPLEX array, dimension (NMAX*NSMAX)
00117 *> \endverbatim
00118 *>
00119 *> \param[out] WORK
00120 *> \verbatim
00121 *>          WORK is COMPLEX array, dimension
00122 *>                      (NMAX*max(3,NSMAX))
00123 *> \endverbatim
00124 *>
00125 *> \param[out] RWORK
00126 *> \verbatim
00127 *>          RWORK is REAL array, dimension
00128 *>                      (max(NMAX,2*NSMAX))
00129 *> \endverbatim
00130 *>
00131 *> \param[in] NOUT
00132 *> \verbatim
00133 *>          NOUT is INTEGER
00134 *>          The unit number for output.
00135 *> \endverbatim
00136 *
00137 *  Authors:
00138 *  ========
00139 *
00140 *> \author Univ. of Tennessee 
00141 *> \author Univ. of California Berkeley 
00142 *> \author Univ. of Colorado Denver 
00143 *> \author NAG Ltd. 
00144 *
00145 *> \date November 2011
00146 *
00147 *> \ingroup complex_lin
00148 *
00149 *  =====================================================================
00150       SUBROUTINE CCHKTP( DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR,
00151      $                   NMAX, AP, AINVP, B, X, XACT, WORK, RWORK,
00152      $                   NOUT )
00153 *
00154 *  -- LAPACK test routine (version 3.4.0) --
00155 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00156 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00157 *     November 2011
00158 *
00159 *     .. Scalar Arguments ..
00160       LOGICAL            TSTERR
00161       INTEGER            NMAX, NN, NNS, NOUT
00162       REAL               THRESH
00163 *     ..
00164 *     .. Array Arguments ..
00165       LOGICAL            DOTYPE( * )
00166       INTEGER            NSVAL( * ), NVAL( * )
00167       REAL               RWORK( * )
00168       COMPLEX            AINVP( * ), AP( * ), B( * ), WORK( * ), X( * ),
00169      $                   XACT( * )
00170 *     ..
00171 *
00172 *  =====================================================================
00173 *
00174 *     .. Parameters ..
00175       INTEGER            NTYPE1, NTYPES
00176       PARAMETER          ( NTYPE1 = 10, NTYPES = 18 )
00177       INTEGER            NTESTS
00178       PARAMETER          ( NTESTS = 9 )
00179       INTEGER            NTRAN
00180       PARAMETER          ( NTRAN = 3 )
00181       REAL               ONE, ZERO
00182       PARAMETER          ( ONE = 1.0E+0, ZERO = 0.0E+0 )
00183 *     ..
00184 *     .. Local Scalars ..
00185       CHARACTER          DIAG, NORM, TRANS, UPLO, XTYPE
00186       CHARACTER*3        PATH
00187       INTEGER            I, IDIAG, IMAT, IN, INFO, IRHS, ITRAN, IUPLO,
00188      $                   K, LAP, LDA, N, NERRS, NFAIL, NRHS, NRUN
00189       REAL               AINVNM, ANORM, RCOND, RCONDC, RCONDI, RCONDO,
00190      $                   SCALE
00191 *     ..
00192 *     .. Local Arrays ..
00193       CHARACTER          TRANSS( NTRAN ), UPLOS( 2 )
00194       INTEGER            ISEED( 4 ), ISEEDY( 4 )
00195       REAL               RESULT( NTESTS )
00196 *     ..
00197 *     .. External Functions ..
00198       LOGICAL            LSAME
00199       REAL               CLANTP
00200       EXTERNAL           LSAME, CLANTP
00201 *     ..
00202 *     .. External Subroutines ..
00203       EXTERNAL           ALAERH, ALAHD, ALASUM, CCOPY, CERRTR, CGET04,
00204      $                   CLACPY, CLARHS, CLATPS, CLATTP, CTPCON, CTPRFS,
00205      $                   CTPT01, CTPT02, CTPT03, CTPT05, CTPT06, CTPTRI,
00206      $                   CTPTRS
00207 *     ..
00208 *     .. Scalars in Common ..
00209       LOGICAL            LERR, OK
00210       CHARACTER*32       SRNAMT
00211       INTEGER            INFOT, IOUNIT
00212 *     ..
00213 *     .. Common blocks ..
00214       COMMON             / INFOC / INFOT, IOUNIT, OK, LERR
00215       COMMON             / SRNAMC / SRNAMT
00216 *     ..
00217 *     .. Intrinsic Functions ..
00218       INTRINSIC          MAX
00219 *     ..
00220 *     .. Data statements ..
00221       DATA               ISEEDY / 1988, 1989, 1990, 1991 /
00222       DATA               UPLOS / 'U', 'L' / , TRANSS / 'N', 'T', 'C' /
00223 *     ..
00224 *     .. Executable Statements ..
00225 *
00226 *     Initialize constants and the random number seed.
00227 *
00228       PATH( 1: 1 ) = 'Complex precision'
00229       PATH( 2: 3 ) = 'TP'
00230       NRUN = 0
00231       NFAIL = 0
00232       NERRS = 0
00233       DO 10 I = 1, 4
00234          ISEED( I ) = ISEEDY( I )
00235    10 CONTINUE
00236 *
00237 *     Test the error exits
00238 *
00239       IF( TSTERR )
00240      $   CALL CERRTR( PATH, NOUT )
00241       INFOT = 0
00242 *
00243       DO 110 IN = 1, NN
00244 *
00245 *        Do for each value of N in NVAL
00246 *
00247          N = NVAL( IN )
00248          LDA = MAX( 1, N )
00249          LAP = LDA*( LDA+1 ) / 2
00250          XTYPE = 'N'
00251 *
00252          DO 70 IMAT = 1, NTYPE1
00253 *
00254 *           Do the tests only if DOTYPE( IMAT ) is true.
00255 *
00256             IF( .NOT.DOTYPE( IMAT ) )
00257      $         GO TO 70
00258 *
00259             DO 60 IUPLO = 1, 2
00260 *
00261 *              Do first for UPLO = 'U', then for UPLO = 'L'
00262 *
00263                UPLO = UPLOS( IUPLO )
00264 *
00265 *              Call CLATTP to generate a triangular test matrix.
00266 *
00267                SRNAMT = 'CLATTP'
00268                CALL CLATTP( IMAT, UPLO, 'No transpose', DIAG, ISEED, N,
00269      $                      AP, X, WORK, RWORK, INFO )
00270 *
00271 *              Set IDIAG = 1 for non-unit matrices, 2 for unit.
00272 *
00273                IF( LSAME( DIAG, 'N' ) ) THEN
00274                   IDIAG = 1
00275                ELSE
00276                   IDIAG = 2
00277                END IF
00278 *
00279 *+    TEST 1
00280 *              Form the inverse of A.
00281 *
00282                IF( N.GT.0 )
00283      $            CALL CCOPY( LAP, AP, 1, AINVP, 1 )
00284                SRNAMT = 'CTPTRI'
00285                CALL CTPTRI( UPLO, DIAG, N, AINVP, INFO )
00286 *
00287 *              Check error code from CTPTRI.
00288 *
00289                IF( INFO.NE.0 )
00290      $            CALL ALAERH( PATH, 'CTPTRI', INFO, 0, UPLO // DIAG, N,
00291      $                         N, -1, -1, -1, IMAT, NFAIL, NERRS, NOUT )
00292 *
00293 *              Compute the infinity-norm condition number of A.
00294 *
00295                ANORM = CLANTP( 'I', UPLO, DIAG, N, AP, RWORK )
00296                AINVNM = CLANTP( 'I', UPLO, DIAG, N, AINVP, RWORK )
00297                IF( ANORM.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN
00298                   RCONDI = ONE
00299                ELSE
00300                   RCONDI = ( ONE / ANORM ) / AINVNM
00301                END IF
00302 *
00303 *              Compute the residual for the triangular matrix times its
00304 *              inverse.  Also compute the 1-norm condition number of A.
00305 *
00306                CALL CTPT01( UPLO, DIAG, N, AP, AINVP, RCONDO, RWORK,
00307      $                      RESULT( 1 ) )
00308 *
00309 *              Print the test ratio if it is .GE. THRESH.
00310 *
00311                IF( RESULT( 1 ).GE.THRESH ) THEN
00312                   IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
00313      $               CALL ALAHD( NOUT, PATH )
00314                   WRITE( NOUT, FMT = 9999 )UPLO, DIAG, N, IMAT, 1,
00315      $               RESULT( 1 )
00316                   NFAIL = NFAIL + 1
00317                END IF
00318                NRUN = NRUN + 1
00319 *
00320                DO 40 IRHS = 1, NNS
00321                   NRHS = NSVAL( IRHS )
00322                   XTYPE = 'N'
00323 *
00324                   DO 30 ITRAN = 1, NTRAN
00325 *
00326 *                 Do for op(A) = A, A**T, or A**H.
00327 *
00328                      TRANS = TRANSS( ITRAN )
00329                      IF( ITRAN.EQ.1 ) THEN
00330                         NORM = 'O'
00331                         RCONDC = RCONDO
00332                      ELSE
00333                         NORM = 'I'
00334                         RCONDC = RCONDI
00335                      END IF
00336 *
00337 *+    TEST 2
00338 *                 Solve and compute residual for op(A)*x = b.
00339 *
00340                      SRNAMT = 'CLARHS'
00341                      CALL CLARHS( PATH, XTYPE, UPLO, TRANS, N, N, 0,
00342      $                            IDIAG, NRHS, AP, LAP, XACT, LDA, B,
00343      $                            LDA, ISEED, INFO )
00344                      XTYPE = 'C'
00345                      CALL CLACPY( 'Full', N, NRHS, B, LDA, X, LDA )
00346 *
00347                      SRNAMT = 'CTPTRS'
00348                      CALL CTPTRS( UPLO, TRANS, DIAG, N, NRHS, AP, X,
00349      $                            LDA, INFO )
00350 *
00351 *                 Check error code from CTPTRS.
00352 *
00353                      IF( INFO.NE.0 )
00354      $                  CALL ALAERH( PATH, 'CTPTRS', INFO, 0,
00355      $                               UPLO // TRANS // DIAG, N, N, -1,
00356      $                               -1, -1, IMAT, NFAIL, NERRS, NOUT )
00357 *
00358                      CALL CTPT02( UPLO, TRANS, DIAG, N, NRHS, AP, X,
00359      $                            LDA, B, LDA, WORK, RWORK,
00360      $                            RESULT( 2 ) )
00361 *
00362 *+    TEST 3
00363 *                 Check solution from generated exact solution.
00364 *
00365                      CALL CGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC,
00366      $                            RESULT( 3 ) )
00367 *
00368 *+    TESTS 4, 5, and 6
00369 *                 Use iterative refinement to improve the solution and
00370 *                 compute error bounds.
00371 *
00372                      SRNAMT = 'CTPRFS'
00373                      CALL CTPRFS( UPLO, TRANS, DIAG, N, NRHS, AP, B,
00374      $                            LDA, X, LDA, RWORK, RWORK( NRHS+1 ),
00375      $                            WORK, RWORK( 2*NRHS+1 ), INFO )
00376 *
00377 *                 Check error code from CTPRFS.
00378 *
00379                      IF( INFO.NE.0 )
00380      $                  CALL ALAERH( PATH, 'CTPRFS', INFO, 0,
00381      $                               UPLO // TRANS // DIAG, N, N, -1,
00382      $                               -1, NRHS, IMAT, NFAIL, NERRS,
00383      $                               NOUT )
00384 *
00385                      CALL CGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC,
00386      $                            RESULT( 4 ) )
00387                      CALL CTPT05( UPLO, TRANS, DIAG, N, NRHS, AP, B,
00388      $                            LDA, X, LDA, XACT, LDA, RWORK,
00389      $                            RWORK( NRHS+1 ), RESULT( 5 ) )
00390 *
00391 *                    Print information about the tests that did not pass
00392 *                    the threshold.
00393 *
00394                      DO 20 K = 2, 6
00395                         IF( RESULT( K ).GE.THRESH ) THEN
00396                            IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
00397      $                        CALL ALAHD( NOUT, PATH )
00398                            WRITE( NOUT, FMT = 9998 )UPLO, TRANS, DIAG,
00399      $                        N, NRHS, IMAT, K, RESULT( K )
00400                            NFAIL = NFAIL + 1
00401                         END IF
00402    20                CONTINUE
00403                      NRUN = NRUN + 5
00404    30             CONTINUE
00405    40          CONTINUE
00406 *
00407 *+    TEST 7
00408 *                 Get an estimate of RCOND = 1/CNDNUM.
00409 *
00410                DO 50 ITRAN = 1, 2
00411                   IF( ITRAN.EQ.1 ) THEN
00412                      NORM = 'O'
00413                      RCONDC = RCONDO
00414                   ELSE
00415                      NORM = 'I'
00416                      RCONDC = RCONDI
00417                   END IF
00418                   SRNAMT = 'CTPCON'
00419                   CALL CTPCON( NORM, UPLO, DIAG, N, AP, RCOND, WORK,
00420      $                         RWORK, INFO )
00421 *
00422 *                 Check error code from CTPCON.
00423 *
00424                   IF( INFO.NE.0 )
00425      $               CALL ALAERH( PATH, 'CTPCON', INFO, 0,
00426      $                            NORM // UPLO // DIAG, N, N, -1, -1,
00427      $                            -1, IMAT, NFAIL, NERRS, NOUT )
00428 *
00429                   CALL CTPT06( RCOND, RCONDC, UPLO, DIAG, N, AP, RWORK,
00430      $                         RESULT( 7 ) )
00431 *
00432 *                 Print the test ratio if it is .GE. THRESH.
00433 *
00434                   IF( RESULT( 7 ).GE.THRESH ) THEN
00435                      IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
00436      $                  CALL ALAHD( NOUT, PATH )
00437                      WRITE( NOUT, FMT = 9997 ) 'CTPCON', NORM, UPLO,
00438      $                  DIAG, N, IMAT, 7, RESULT( 7 )
00439                      NFAIL = NFAIL + 1
00440                   END IF
00441                   NRUN = NRUN + 1
00442    50          CONTINUE
00443    60       CONTINUE
00444    70    CONTINUE
00445 *
00446 *        Use pathological test matrices to test CLATPS.
00447 *
00448          DO 100 IMAT = NTYPE1 + 1, NTYPES
00449 *
00450 *           Do the tests only if DOTYPE( IMAT ) is true.
00451 *
00452             IF( .NOT.DOTYPE( IMAT ) )
00453      $         GO TO 100
00454 *
00455             DO 90 IUPLO = 1, 2
00456 *
00457 *              Do first for UPLO = 'U', then for UPLO = 'L'
00458 *
00459                UPLO = UPLOS( IUPLO )
00460                DO 80 ITRAN = 1, NTRAN
00461 *
00462 *                 Do for op(A) = A, A**T, or A**H.
00463 *
00464                   TRANS = TRANSS( ITRAN )
00465 *
00466 *                 Call CLATTP to generate a triangular test matrix.
00467 *
00468                   SRNAMT = 'CLATTP'
00469                   CALL CLATTP( IMAT, UPLO, TRANS, DIAG, ISEED, N, AP, X,
00470      $                         WORK, RWORK, INFO )
00471 *
00472 *+    TEST 8
00473 *                 Solve the system op(A)*x = b.
00474 *
00475                   SRNAMT = 'CLATPS'
00476                   CALL CCOPY( N, X, 1, B, 1 )
00477                   CALL CLATPS( UPLO, TRANS, DIAG, 'N', N, AP, B, SCALE,
00478      $                         RWORK, INFO )
00479 *
00480 *                 Check error code from CLATPS.
00481 *
00482                   IF( INFO.NE.0 )
00483      $               CALL ALAERH( PATH, 'CLATPS', INFO, 0,
00484      $                            UPLO // TRANS // DIAG // 'N', N, N,
00485      $                            -1, -1, -1, IMAT, NFAIL, NERRS, NOUT )
00486 *
00487                   CALL CTPT03( UPLO, TRANS, DIAG, N, 1, AP, SCALE,
00488      $                         RWORK, ONE, B, LDA, X, LDA, WORK,
00489      $                         RESULT( 8 ) )
00490 *
00491 *+    TEST 9
00492 *                 Solve op(A)*x = b again with NORMIN = 'Y'.
00493 *
00494                   CALL CCOPY( N, X, 1, B( N+1 ), 1 )
00495                   CALL CLATPS( UPLO, TRANS, DIAG, 'Y', N, AP, B( N+1 ),
00496      $                         SCALE, RWORK, INFO )
00497 *
00498 *                 Check error code from CLATPS.
00499 *
00500                   IF( INFO.NE.0 )
00501      $               CALL ALAERH( PATH, 'CLATPS', INFO, 0,
00502      $                            UPLO // TRANS // DIAG // 'Y', N, N,
00503      $                            -1, -1, -1, IMAT, NFAIL, NERRS, NOUT )
00504 *
00505                   CALL CTPT03( UPLO, TRANS, DIAG, N, 1, AP, SCALE,
00506      $                         RWORK, ONE, B( N+1 ), LDA, X, LDA, WORK,
00507      $                         RESULT( 9 ) )
00508 *
00509 *                 Print information about the tests that did not pass
00510 *                 the threshold.
00511 *
00512                   IF( RESULT( 8 ).GE.THRESH ) THEN
00513                      IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
00514      $                  CALL ALAHD( NOUT, PATH )
00515                      WRITE( NOUT, FMT = 9996 )'CLATPS', UPLO, TRANS,
00516      $                  DIAG, 'N', N, IMAT, 8, RESULT( 8 )
00517                      NFAIL = NFAIL + 1
00518                   END IF
00519                   IF( RESULT( 9 ).GE.THRESH ) THEN
00520                      IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
00521      $                  CALL ALAHD( NOUT, PATH )
00522                      WRITE( NOUT, FMT = 9996 )'CLATPS', UPLO, TRANS,
00523      $                  DIAG, 'Y', N, IMAT, 9, RESULT( 9 )
00524                      NFAIL = NFAIL + 1
00525                   END IF
00526                   NRUN = NRUN + 2
00527    80          CONTINUE
00528    90       CONTINUE
00529   100    CONTINUE
00530   110 CONTINUE
00531 *
00532 *     Print a summary of the results.
00533 *
00534       CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS )
00535 *
00536  9999 FORMAT( ' UPLO=''', A1, ''', DIAG=''', A1, ''', N=', I5,
00537      $      ', type ', I2, ', test(', I2, ')= ', G12.5 )
00538  9998 FORMAT( ' UPLO=''', A1, ''', TRANS=''', A1, ''', DIAG=''', A1,
00539      $      ''', N=', I5, ''', NRHS=', I5, ', type ', I2, ', test(',
00540      $      I2, ')= ', G12.5 )
00541  9997 FORMAT( 1X, A, '( ''', A1, ''', ''', A1, ''', ''', A1, ''',',
00542      $      I5, ', ... ), type ', I2, ', test(', I2, ')=', G12.5 )
00543  9996 FORMAT( 1X, A, '( ''', A1, ''', ''', A1, ''', ''', A1, ''', ''',
00544      $      A1, ''',', I5, ', ... ), type ', I2, ', test(', I2, ')=',
00545      $      G12.5 )
00546       RETURN
00547 *
00548 *     End of CCHKTP
00549 *
00550       END
 All Files Functions