1*> \brief \b CDRVHE_RK 2* 3* =========== DOCUMENTATION =========== 4* 5* Online html documentation available at 6* http://www.netlib.org/lapack/explore-html/ 7* 8* Definition: 9* =========== 10* 11* SUBROUTINE CDRVHE_RK( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, 12* NMAX, A, AFAC, E, AINV, B, X, XACT, WORK, 13* RWORK, IWORK, NOUT ) 14* 15* .. Scalar Arguments .. 16* LOGICAL TSTERR 17* INTEGER NMAX, NN, NOUT, NRHS 18* REAL THRESH 19* .. 20* .. Array Arguments .. 21* LOGICAL DOTYPE( * ) 22* INTEGER IWORK( * ), NVAL( * ) 23* REAL RWORK( * ) 24* COMPLEX A( * ), AFAC( * ), AINV( * ), B( * ), E( * ), 25* $ WORK( * ), X( * ), XACT( * ) 26* .. 27* 28* 29*> \par Purpose: 30* ============= 31*> 32*> \verbatim 33*> 34*> CDRVHE_RK tests the driver routines CHESV_RK. 35*> \endverbatim 36* 37* Arguments: 38* ========== 39* 40*> \param[in] DOTYPE 41*> \verbatim 42*> DOTYPE is LOGICAL array, dimension (NTYPES) 43*> The matrix types to be used for testing. Matrices of type j 44*> (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) = 45*> .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used. 46*> \endverbatim 47*> 48*> \param[in] NN 49*> \verbatim 50*> NN is INTEGER 51*> The number of values of N contained in the vector NVAL. 52*> \endverbatim 53*> 54*> \param[in] NVAL 55*> \verbatim 56*> NVAL is INTEGER array, dimension (NN) 57*> The values of the matrix dimension N. 58*> \endverbatim 59*> 60*> \param[in] NRHS 61*> \verbatim 62*> NRHS is INTEGER 63*> The number of right hand side vectors to be generated for 64*> each linear system. 65*> \endverbatim 66*> 67*> \param[in] THRESH 68*> \verbatim 69*> THRESH is REAL 70*> The threshold value for the test ratios. A result is 71*> included in the output file if RESULT >= THRESH. To have 72*> every test ratio printed, use THRESH = 0. 73*> \endverbatim 74*> 75*> \param[in] TSTERR 76*> \verbatim 77*> TSTERR is LOGICAL 78*> Flag that indicates whether error exits are to be tested. 79*> \endverbatim 80*> 81*> \param[in] NMAX 82*> \verbatim 83*> NMAX is INTEGER 84*> The maximum value permitted for N, used in dimensioning the 85*> work arrays. 86*> \endverbatim 87*> 88*> \param[out] A 89*> \verbatim 90*> A is COMPLEX array, dimension (NMAX*NMAX) 91*> \endverbatim 92*> 93*> \param[out] AFAC 94*> \verbatim 95*> AFAC is COMPLEX array, dimension (NMAX*NMAX) 96*> \endverbatim 97*> 98*> \param[out] E 99*> \verbatim 100*> E is COMPLEX array, dimension (NMAX) 101*> \endverbatim 102*> 103*> \param[out] AINV 104*> \verbatim 105*> AINV is COMPLEX array, dimension (NMAX*NMAX) 106*> \endverbatim 107*> 108*> \param[out] B 109*> \verbatim 110*> B is COMPLEX array, dimension (NMAX*NRHS) 111*> \endverbatim 112*> 113*> \param[out] X 114*> \verbatim 115*> X is COMPLEX array, dimension (NMAX*NRHS) 116*> \endverbatim 117*> 118*> \param[out] XACT 119*> \verbatim 120*> XACT is COMPLEX array, dimension (NMAX*NRHS) 121*> \endverbatim 122*> 123*> \param[out] WORK 124*> \verbatim 125*> WORK is COMPLEX array, dimension (NMAX*max(2,NRHS)) 126*> \endverbatim 127*> 128*> \param[out] RWORK 129*> \verbatim 130*> RWORK is REAL array, dimension (NMAX+2*NRHS) 131*> \endverbatim 132*> 133*> \param[out] IWORK 134*> \verbatim 135*> IWORK is INTEGER array, dimension (NMAX) 136*> \endverbatim 137*> 138*> \param[in] NOUT 139*> \verbatim 140*> NOUT is INTEGER 141*> The unit number for output. 142*> \endverbatim 143* 144* Authors: 145* ======== 146* 147*> \author Univ. of Tennessee 148*> \author Univ. of California Berkeley 149*> \author Univ. of Colorado Denver 150*> \author NAG Ltd. 151* 152*> \ingroup complex_lin 153* 154* ===================================================================== 155 SUBROUTINE CDRVHE_RK( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, 156 $ NMAX, A, AFAC, E, AINV, B, X, XACT, WORK, 157 $ RWORK, IWORK, NOUT ) 158* 159* -- LAPACK test routine -- 160* -- LAPACK is a software package provided by Univ. of Tennessee, -- 161* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 162* 163* .. Scalar Arguments .. 164 LOGICAL TSTERR 165 INTEGER NMAX, NN, NOUT, NRHS 166 REAL THRESH 167* .. 168* .. Array Arguments .. 169 LOGICAL DOTYPE( * ) 170 INTEGER IWORK( * ), NVAL( * ) 171 REAL RWORK( * ) 172 COMPLEX A( * ), AFAC( * ), AINV( * ), B( * ), E( * ), 173 $ WORK( * ), X( * ), XACT( * ) 174* .. 175* 176* ===================================================================== 177* 178* .. Parameters .. 179 REAL ONE, ZERO 180 PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 ) 181 INTEGER NTYPES, NTESTS 182 PARAMETER ( NTYPES = 10, NTESTS = 3 ) 183 INTEGER NFACT 184 PARAMETER ( NFACT = 2 ) 185* .. 186* .. Local Scalars .. 187 LOGICAL ZEROT 188 CHARACTER DIST, FACT, TYPE, UPLO, XTYPE 189 CHARACTER*3 MATPATH, PATH 190 INTEGER I, I1, I2, IFACT, IMAT, IN, INFO, IOFF, IUPLO, 191 $ IZERO, J, K, KL, KU, LDA, LWORK, MODE, N, 192 $ NB, NBMIN, NERRS, NFAIL, NIMAT, NRUN, NT 193 REAL AINVNM, ANORM, CNDNUM, RCONDC 194* .. 195* .. Local Arrays .. 196 CHARACTER FACTS( NFACT ), UPLOS( 2 ) 197 INTEGER ISEED( 4 ), ISEEDY( 4 ) 198 REAL RESULT( NTESTS ) 199 200* .. 201* .. External Functions .. 202 REAL CLANHE 203 EXTERNAL CLANHE 204* .. 205* .. External Subroutines .. 206 EXTERNAL ALADHD, ALAERH, ALASVM, XLAENV, CERRVX, CGET04, 207 $ CLACPY, CLARHS, CLATB4, CLATMS, CHESV_RK, 208 $ CHET01_3, CPOT02, CHETRF_RK, CHETRI_3 209* .. 210* .. Scalars in Common .. 211 LOGICAL LERR, OK 212 CHARACTER*32 SRNAMT 213 INTEGER INFOT, NUNIT 214* .. 215* .. Common blocks .. 216 COMMON / INFOC / INFOT, NUNIT, OK, LERR 217 COMMON / SRNAMC / SRNAMT 218* .. 219* .. Intrinsic Functions .. 220 INTRINSIC MAX, MIN 221* .. 222* .. Data statements .. 223 DATA ISEEDY / 1988, 1989, 1990, 1991 / 224 DATA UPLOS / 'U', 'L' / , FACTS / 'F', 'N' / 225* .. 226* .. Executable Statements .. 227* 228* Initialize constants and the random number seed. 229* 230* Test path 231* 232 PATH( 1: 1 ) = 'Complex precision' 233 PATH( 2: 3 ) = 'HK' 234* 235* Path to generate matrices 236* 237 MATPATH( 1: 1 ) = 'Complex precision' 238 MATPATH( 2: 3 ) = 'HE' 239* 240 NRUN = 0 241 NFAIL = 0 242 NERRS = 0 243 DO 10 I = 1, 4 244 ISEED( I ) = ISEEDY( I ) 245 10 CONTINUE 246 LWORK = MAX( 2*NMAX, NMAX*NRHS ) 247* 248* Test the error exits 249* 250 IF( TSTERR ) 251 $ CALL CERRVX( PATH, NOUT ) 252 INFOT = 0 253* 254* Set the block size and minimum block size for which the block 255* routine should be used, which will be later returned by ILAENV. 256* 257 NB = 1 258 NBMIN = 2 259 CALL XLAENV( 1, NB ) 260 CALL XLAENV( 2, NBMIN ) 261* 262* Do for each value of N in NVAL 263* 264 DO 180 IN = 1, NN 265 N = NVAL( IN ) 266 LDA = MAX( N, 1 ) 267 XTYPE = 'N' 268 NIMAT = NTYPES 269 IF( N.LE.0 ) 270 $ NIMAT = 1 271* 272 DO 170 IMAT = 1, NIMAT 273* 274* Do the tests only if DOTYPE( IMAT ) is true. 275* 276 IF( .NOT.DOTYPE( IMAT ) ) 277 $ GO TO 170 278* 279* Skip types 3, 4, 5, or 6 if the matrix size is too small. 280* 281 ZEROT = IMAT.GE.3 .AND. IMAT.LE.6 282 IF( ZEROT .AND. N.LT.IMAT-2 ) 283 $ GO TO 170 284* 285* Do first for UPLO = 'U', then for UPLO = 'L' 286* 287 DO 160 IUPLO = 1, 2 288 UPLO = UPLOS( IUPLO ) 289* 290* Begin generate the test matrix A. 291* 292* Set up parameters with CLATB4 for the matrix generator 293* based on the type of matrix to be generated. 294* 295 CALL CLATB4( MATPATH, IMAT, N, N, TYPE, KL, KU, ANORM, 296 $ MODE, CNDNUM, DIST ) 297* 298* Generate a matrix with CLATMS. 299* 300 SRNAMT = 'CLATMS' 301 CALL CLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE, 302 $ CNDNUM, ANORM, KL, KU, UPLO, A, LDA, 303 $ WORK, INFO ) 304* 305* Check error code from CLATMS and handle error. 306* 307 IF( INFO.NE.0 ) THEN 308 CALL ALAERH( PATH, 'CLATMS', INFO, 0, UPLO, N, N, 309 $ -1, -1, -1, IMAT, NFAIL, NERRS, NOUT ) 310 GO TO 160 311 END IF 312* 313* For types 3-6, zero one or more rows and columns of 314* the matrix to test that INFO is returned correctly. 315* 316 IF( ZEROT ) THEN 317 IF( IMAT.EQ.3 ) THEN 318 IZERO = 1 319 ELSE IF( IMAT.EQ.4 ) THEN 320 IZERO = N 321 ELSE 322 IZERO = N / 2 + 1 323 END IF 324* 325 IF( IMAT.LT.6 ) THEN 326* 327* Set row and column IZERO to zero. 328* 329 IF( IUPLO.EQ.1 ) THEN 330 IOFF = ( IZERO-1 )*LDA 331 DO 20 I = 1, IZERO - 1 332 A( IOFF+I ) = ZERO 333 20 CONTINUE 334 IOFF = IOFF + IZERO 335 DO 30 I = IZERO, N 336 A( IOFF ) = ZERO 337 IOFF = IOFF + LDA 338 30 CONTINUE 339 ELSE 340 IOFF = IZERO 341 DO 40 I = 1, IZERO - 1 342 A( IOFF ) = ZERO 343 IOFF = IOFF + LDA 344 40 CONTINUE 345 IOFF = IOFF - IZERO 346 DO 50 I = IZERO, N 347 A( IOFF+I ) = ZERO 348 50 CONTINUE 349 END IF 350 ELSE 351 IF( IUPLO.EQ.1 ) THEN 352* 353* Set the first IZERO rows and columns to zero. 354* 355 IOFF = 0 356 DO 70 J = 1, N 357 I2 = MIN( J, IZERO ) 358 DO 60 I = 1, I2 359 A( IOFF+I ) = ZERO 360 60 CONTINUE 361 IOFF = IOFF + LDA 362 70 CONTINUE 363 ELSE 364* 365* Set the first IZERO rows and columns to zero. 366* 367 IOFF = 0 368 DO 90 J = 1, N 369 I1 = MAX( J, IZERO ) 370 DO 80 I = I1, N 371 A( IOFF+I ) = ZERO 372 80 CONTINUE 373 IOFF = IOFF + LDA 374 90 CONTINUE 375 END IF 376 END IF 377 ELSE 378 IZERO = 0 379 END IF 380* 381* End generate the test matrix A. 382* 383* 384 DO 150 IFACT = 1, NFACT 385* 386* Do first for FACT = 'F', then for other values. 387* 388 FACT = FACTS( IFACT ) 389* 390* Compute the condition number 391* 392 IF( ZEROT ) THEN 393 IF( IFACT.EQ.1 ) 394 $ GO TO 150 395 RCONDC = ZERO 396* 397 ELSE IF( IFACT.EQ.1 ) THEN 398* 399* Compute the 1-norm of A. 400* 401 ANORM = CLANHE( '1', UPLO, N, A, LDA, RWORK ) 402* 403* Factor the matrix A. 404* 405 CALL CLACPY( UPLO, N, N, A, LDA, AFAC, LDA ) 406 CALL CHETRF_RK( UPLO, N, AFAC, LDA, E, IWORK, WORK, 407 $ LWORK, INFO ) 408* 409* Compute inv(A) and take its norm. 410* 411 CALL CLACPY( UPLO, N, N, AFAC, LDA, AINV, LDA ) 412 LWORK = (N+NB+1)*(NB+3) 413* 414* We need to compute the inverse to compute 415* RCONDC that is used later in TEST3. 416* 417 CALL CSYTRI_3( UPLO, N, AINV, LDA, E, IWORK, 418 $ WORK, LWORK, INFO ) 419 AINVNM = CLANHE( '1', UPLO, N, AINV, LDA, RWORK ) 420* 421* Compute the 1-norm condition number of A. 422* 423 IF( ANORM.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN 424 RCONDC = ONE 425 ELSE 426 RCONDC = ( ONE / ANORM ) / AINVNM 427 END IF 428 END IF 429* 430* Form an exact solution and set the right hand side. 431* 432 SRNAMT = 'CLARHS' 433 CALL CLARHS( MATPATH, XTYPE, UPLO, ' ', N, N, KL, KU, 434 $ NRHS, A, LDA, XACT, LDA, B, LDA, ISEED, 435 $ INFO ) 436 XTYPE = 'C' 437* 438* --- Test CHESV_RK --- 439* 440 IF( IFACT.EQ.2 ) THEN 441 CALL CLACPY( UPLO, N, N, A, LDA, AFAC, LDA ) 442 CALL CLACPY( 'Full', N, NRHS, B, LDA, X, LDA ) 443* 444* Factor the matrix and solve the system using 445* CHESV_RK. 446* 447 SRNAMT = 'CHESV_RK' 448 CALL CHESV_RK( UPLO, N, NRHS, AFAC, LDA, E, IWORK, 449 $ X, LDA, WORK, LWORK, INFO ) 450* 451* Adjust the expected value of INFO to account for 452* pivoting. 453* 454 K = IZERO 455 IF( K.GT.0 ) THEN 456 100 CONTINUE 457 IF( IWORK( K ).LT.0 ) THEN 458 IF( IWORK( K ).NE.-K ) THEN 459 K = -IWORK( K ) 460 GO TO 100 461 END IF 462 ELSE IF( IWORK( K ).NE.K ) THEN 463 K = IWORK( K ) 464 GO TO 100 465 END IF 466 END IF 467* 468* Check error code from CHESV_RK and handle error. 469* 470 IF( INFO.NE.K ) THEN 471 CALL ALAERH( PATH, 'CHESV_RK', INFO, K, UPLO, 472 $ N, N, -1, -1, NRHS, IMAT, NFAIL, 473 $ NERRS, NOUT ) 474 GO TO 120 475 ELSE IF( INFO.NE.0 ) THEN 476 GO TO 120 477 END IF 478* 479*+ TEST 1 Reconstruct matrix from factors and compute 480* residual. 481* 482 CALL CHET01_3( UPLO, N, A, LDA, AFAC, LDA, E, 483 $ IWORK, AINV, LDA, RWORK, 484 $ RESULT( 1 ) ) 485* 486*+ TEST 2 Compute residual of the computed solution. 487* 488 CALL CLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA ) 489 CALL CPOT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK, 490 $ LDA, RWORK, RESULT( 2 ) ) 491* 492*+ TEST 3 493* Check solution from generated exact solution. 494* 495 CALL CGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC, 496 $ RESULT( 3 ) ) 497 NT = 3 498* 499* Print information about the tests that did not pass 500* the threshold. 501* 502 DO 110 K = 1, NT 503 IF( RESULT( K ).GE.THRESH ) THEN 504 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 505 $ CALL ALADHD( NOUT, PATH ) 506 WRITE( NOUT, FMT = 9999 )'CHESV_RK', UPLO, 507 $ N, IMAT, K, RESULT( K ) 508 NFAIL = NFAIL + 1 509 END IF 510 110 CONTINUE 511 NRUN = NRUN + NT 512 120 CONTINUE 513 END IF 514* 515 150 CONTINUE 516* 517 160 CONTINUE 518 170 CONTINUE 519 180 CONTINUE 520* 521* Print a summary of the results. 522* 523 CALL ALASVM( PATH, NOUT, NFAIL, NRUN, NERRS ) 524* 525 9999 FORMAT( 1X, A, ', UPLO=''', A1, ''', N =', I5, ', type ', I2, 526 $ ', test ', I2, ', ratio =', G12.5 ) 527 RETURN 528* 529* End of CDRVHE_RK 530* 531 END 532