1*> \brief \b ZDRVSY_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 ZDRVSY_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* DOUBLE PRECISION THRESH 19* .. 20* .. Array Arguments .. 21* LOGICAL DOTYPE( * ) 22* INTEGER IWORK( * ), NVAL( * ) 23* DOUBLE PRECISION RWORK( * ) 24* COMPLEX*16 A( * ), AFAC( * ), AINV( * ), B( * ), E( *), 25* $ WORK( * ), X( * ), XACT( * ) 26* .. 27* 28* 29*> \par Purpose: 30* ============= 31*> 32*> \verbatim 33*> 34*> ZDRVSY_RK tests the driver routines ZSYSV_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 DOUBLE PRECISION 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*16 array, dimension (NMAX*NMAX) 91*> \endverbatim 92*> 93*> \param[out] AFAC 94*> \verbatim 95*> AFAC is COMPLEX*16 array, dimension (NMAX*NMAX) 96*> \endverbatim 97*> 98*> \param[out] E 99*> \verbatim 100*> E is COMPLEX*16 array, dimension (NMAX) 101*> \endverbatim 102*> 103*> \param[out] AINV 104*> \verbatim 105*> AINV is COMPLEX*16 array, dimension (NMAX*NMAX) 106*> \endverbatim 107*> 108*> \param[out] B 109*> \verbatim 110*> B is COMPLEX*16 array, dimension (NMAX*NRHS) 111*> \endverbatim 112*> 113*> \param[out] X 114*> \verbatim 115*> X is COMPLEX*16 array, dimension (NMAX*NRHS) 116*> \endverbatim 117*> 118*> \param[out] XACT 119*> \verbatim 120*> XACT is COMPLEX*16 array, dimension (NMAX*NRHS) 121*> \endverbatim 122*> 123*> \param[out] WORK 124*> \verbatim 125*> WORK is COMPLEX*16 array, dimension (NMAX*max(2,NRHS)) 126*> \endverbatim 127*> 128*> \param[out] RWORK 129*> \verbatim 130*> RWORK is DOUBLE PRECISION 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 complex16_lin 153* 154* ===================================================================== 155 SUBROUTINE ZDRVSY_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 DOUBLE PRECISION THRESH 167* .. 168* .. Array Arguments .. 169 LOGICAL DOTYPE( * ) 170 INTEGER IWORK( * ), NVAL( * ) 171 DOUBLE PRECISION RWORK( * ) 172 COMPLEX*16 A( * ), AFAC( * ), AINV( * ), B( * ), E( * ), 173 $ WORK( * ), X( * ), XACT( * ) 174* .. 175* 176* ===================================================================== 177* 178* .. Parameters .. 179 DOUBLE PRECISION ONE, ZERO 180 PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 ) 181 INTEGER NTYPES, NTESTS 182 PARAMETER ( NTYPES = 11, 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 DOUBLE PRECISION AINVNM, ANORM, CNDNUM, RCONDC 194* .. 195* .. Local Arrays .. 196 CHARACTER FACTS( NFACT ), UPLOS( 2 ) 197 INTEGER ISEED( 4 ), ISEEDY( 4 ) 198 DOUBLE PRECISION RESULT( NTESTS ) 199 200* .. 201* .. External Functions .. 202 DOUBLE PRECISION ZLANSY 203 EXTERNAL ZLANSY 204* .. 205* .. External Subroutines .. 206 EXTERNAL ALADHD, ALAERH, ALASVM, XLAENV, ZERRVX, ZGET04, 207 $ ZLACPY, ZLARHS, ZLATB4, ZLATMS, ZLATSY, 208 $ ZSYSV_RK, ZSYT01_3, ZSYT02, ZSYTRF_RK, ZSYTRI_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 ) = 'Zomplex precision' 233 PATH( 2: 3 ) = 'SK' 234* 235* Path to generate matrices 236* 237 MATPATH( 1: 1 ) = 'Zomplex precision' 238 MATPATH( 2: 3 ) = 'SY' 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 ZERRVX( 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 IF( IMAT.NE.NTYPES ) THEN 291* 292* Begin generate the test matrix A. 293* 294* Set up parameters with ZLATB4 for the matrix generator 295* based on the type of matrix to be generated. 296* 297 CALL ZLATB4( MATPATH, IMAT, N, N, TYPE, KL, KU, ANORM, 298 $ MODE, CNDNUM, DIST ) 299* 300* Generate a matrix with ZLATMS. 301* 302 SRNAMT = 'ZLATMS' 303 CALL ZLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE, 304 $ CNDNUM, ANORM, KL, KU, UPLO, A, LDA, 305 $ WORK, INFO ) 306* 307* Check error code from DLATMS and handle error. 308* 309 IF( INFO.NE.0 ) THEN 310 CALL ALAERH( PATH, 'ZLATMS', INFO, 0, UPLO, N, N, 311 $ -1, -1, -1, IMAT, NFAIL, NERRS, NOUT ) 312 GO TO 160 313 END IF 314* 315* For types 3-6, zero one or more rows and columns of 316* the matrix to test that INFO is returned correctly. 317* 318 IF( ZEROT ) THEN 319 IF( IMAT.EQ.3 ) THEN 320 IZERO = 1 321 ELSE IF( IMAT.EQ.4 ) THEN 322 IZERO = N 323 ELSE 324 IZERO = N / 2 + 1 325 END IF 326* 327 IF( IMAT.LT.6 ) THEN 328* 329* Set row and column IZERO to zero. 330* 331 IF( IUPLO.EQ.1 ) THEN 332 IOFF = ( IZERO-1 )*LDA 333 DO 20 I = 1, IZERO - 1 334 A( IOFF+I ) = ZERO 335 20 CONTINUE 336 IOFF = IOFF + IZERO 337 DO 30 I = IZERO, N 338 A( IOFF ) = ZERO 339 IOFF = IOFF + LDA 340 30 CONTINUE 341 ELSE 342 IOFF = IZERO 343 DO 40 I = 1, IZERO - 1 344 A( IOFF ) = ZERO 345 IOFF = IOFF + LDA 346 40 CONTINUE 347 IOFF = IOFF - IZERO 348 DO 50 I = IZERO, N 349 A( IOFF+I ) = ZERO 350 50 CONTINUE 351 END IF 352 ELSE 353 IF( IUPLO.EQ.1 ) THEN 354* 355* Set the first IZERO rows and columns to zero. 356* 357 IOFF = 0 358 DO 70 J = 1, N 359 I2 = MIN( J, IZERO ) 360 DO 60 I = 1, I2 361 A( IOFF+I ) = ZERO 362 60 CONTINUE 363 IOFF = IOFF + LDA 364 70 CONTINUE 365 ELSE 366* 367* Set the first IZERO rows and columns to zero. 368* 369 IOFF = 0 370 DO 90 J = 1, N 371 I1 = MAX( J, IZERO ) 372 DO 80 I = I1, N 373 A( IOFF+I ) = ZERO 374 80 CONTINUE 375 IOFF = IOFF + LDA 376 90 CONTINUE 377 END IF 378 END IF 379 ELSE 380 IZERO = 0 381 END IF 382 ELSE 383* 384* IMAT = NTYPES: Use a special block diagonal matrix to 385* test alternate code for the 2-by-2 blocks. 386* 387 CALL ZLATSY( UPLO, N, A, LDA, ISEED ) 388 END IF 389* 390 DO 150 IFACT = 1, NFACT 391* 392* Do first for FACT = 'F', then for other values. 393* 394 FACT = FACTS( IFACT ) 395* 396* Compute the condition number for comparison with 397* the value returned by ZSYSVX_ROOK. 398* 399 IF( ZEROT ) THEN 400 IF( IFACT.EQ.1 ) 401 $ GO TO 150 402 RCONDC = ZERO 403* 404 ELSE IF( IFACT.EQ.1 ) THEN 405* 406* Compute the 1-norm of A. 407* 408 ANORM = ZLANSY( '1', UPLO, N, A, LDA, RWORK ) 409* 410* Factor the matrix A. 411* 412 413 CALL ZLACPY( UPLO, N, N, A, LDA, AFAC, LDA ) 414 CALL ZSYTRF_RK( UPLO, N, AFAC, LDA, E, IWORK, AINV, 415 $ LWORK, INFO ) 416* 417* Compute inv(A) and take its norm. 418* 419 CALL ZLACPY( UPLO, N, N, AFAC, LDA, AINV, LDA ) 420 LWORK = (N+NB+1)*(NB+3) 421* 422* We need to compute the inverse to compute 423* RCONDC that is used later in TEST3. 424* 425 CALL ZSYTRI_3( UPLO, N, AINV, LDA, E, IWORK, 426 $ WORK, LWORK, INFO ) 427 AINVNM = ZLANSY( '1', UPLO, N, AINV, LDA, RWORK ) 428* 429* Compute the 1-norm condition number of A. 430* 431 IF( ANORM.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN 432 RCONDC = ONE 433 ELSE 434 RCONDC = ( ONE / ANORM ) / AINVNM 435 END IF 436 END IF 437* 438* Form an exact solution and set the right hand side. 439* 440 SRNAMT = 'ZLARHS' 441 CALL ZLARHS( MATPATH, XTYPE, UPLO, ' ', N, N, KL, KU, 442 $ NRHS, A, LDA, XACT, LDA, B, LDA, ISEED, 443 $ INFO ) 444 XTYPE = 'C' 445* 446* --- Test ZSYSV_RK --- 447* 448 IF( IFACT.EQ.2 ) THEN 449 CALL ZLACPY( UPLO, N, N, A, LDA, AFAC, LDA ) 450 CALL ZLACPY( 'Full', N, NRHS, B, LDA, X, LDA ) 451* 452* Factor the matrix and solve the system using 453* ZSYSV_RK. 454* 455 SRNAMT = 'ZSYSV_RK' 456 CALL ZSYSV_RK( UPLO, N, NRHS, AFAC, LDA, E, IWORK, 457 $ X, LDA, WORK, LWORK, INFO ) 458* 459* Adjust the expected value of INFO to account for 460* pivoting. 461* 462 K = IZERO 463 IF( K.GT.0 ) THEN 464 100 CONTINUE 465 IF( IWORK( K ).LT.0 ) THEN 466 IF( IWORK( K ).NE.-K ) THEN 467 K = -IWORK( K ) 468 GO TO 100 469 END IF 470 ELSE IF( IWORK( K ).NE.K ) THEN 471 K = IWORK( K ) 472 GO TO 100 473 END IF 474 END IF 475* 476* Check error code from ZSYSV_RK and handle error. 477* 478 IF( INFO.NE.K ) THEN 479 CALL ALAERH( PATH, 'ZSYSV_RK', INFO, K, UPLO, 480 $ N, N, -1, -1, NRHS, IMAT, NFAIL, 481 $ NERRS, NOUT ) 482 GO TO 120 483 ELSE IF( INFO.NE.0 ) THEN 484 GO TO 120 485 END IF 486* 487*+ TEST 1 Reconstruct matrix from factors and compute 488* residual. 489* 490 CALL ZSYT01_3( UPLO, N, A, LDA, AFAC, LDA, E, 491 $ IWORK, AINV, LDA, RWORK, 492 $ RESULT( 1 ) ) 493* 494*+ TEST 2 Compute residual of the computed solution. 495* 496 CALL ZLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA ) 497 CALL ZSYT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK, 498 $ LDA, RWORK, RESULT( 2 ) ) 499* 500*+ TEST 3 501* Check solution from generated exact solution. 502* 503 CALL ZGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC, 504 $ RESULT( 3 ) ) 505 NT = 3 506* 507* Print information about the tests that did not pass 508* the threshold. 509* 510 DO 110 K = 1, NT 511 IF( RESULT( K ).GE.THRESH ) THEN 512 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 513 $ CALL ALADHD( NOUT, PATH ) 514 WRITE( NOUT, FMT = 9999 )'ZSYSV_RK', UPLO, 515 $ N, IMAT, K, RESULT( K ) 516 NFAIL = NFAIL + 1 517 END IF 518 110 CONTINUE 519 NRUN = NRUN + NT 520 120 CONTINUE 521 END IF 522* 523 150 CONTINUE 524* 525 160 CONTINUE 526 170 CONTINUE 527 180 CONTINUE 528* 529* Print a summary of the results. 530* 531 CALL ALASVM( PATH, NOUT, NFAIL, NRUN, NERRS ) 532* 533 9999 FORMAT( 1X, A, ', UPLO=''', A1, ''', N =', I5, ', type ', I2, 534 $ ', test ', I2, ', ratio =', G12.5 ) 535 RETURN 536* 537* End of ZDRVSY_RK 538* 539 END 540