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