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