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