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