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