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