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