1*> \brief \b ZDRVAC 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 ZDRVAC( DOTYPE, NM, MVAL, NNS, NSVAL, THRESH, NMAX, 12* A, AFAC, B, X, WORK, 13* RWORK, SWORK, NOUT ) 14* 15* .. Scalar Arguments .. 16* INTEGER NMAX, NM, NNS, NOUT 17* DOUBLE PRECISION THRESH 18* .. 19* .. Array Arguments .. 20* LOGICAL DOTYPE( * ) 21* INTEGER MVAL( * ), NSVAL( * ) 22* DOUBLE PRECISION RWORK( * ) 23* COMPLEX SWORK(*) 24* COMPLEX*16 A( * ), AFAC( * ), B( * ), 25* $ WORK( * ), X( * ) 26* .. 27* 28* 29*> \par Purpose: 30* ============= 31*> 32*> \verbatim 33*> 34*> ZDRVAC tests ZCPOSV. 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] NM 49*> \verbatim 50*> NM is INTEGER 51*> The number of values of N contained in the vector MVAL. 52*> \endverbatim 53*> 54*> \param[in] MVAL 55*> \verbatim 56*> MVAL is INTEGER array, dimension (NM) 57*> The values of the matrix dimension N. 58*> \endverbatim 59*> 60*> \param[in] NNS 61*> \verbatim 62*> NNS is INTEGER 63*> The number of values of NRHS contained in the vector NSVAL. 64*> \endverbatim 65*> 66*> \param[in] NSVAL 67*> \verbatim 68*> NSVAL is INTEGER array, dimension (NNS) 69*> The values of the number of right hand sides NRHS. 70*> \endverbatim 71*> 72*> \param[in] THRESH 73*> \verbatim 74*> THRESH is DOUBLE PRECISION 75*> The threshold value for the test ratios. A result is 76*> included in the output file if RESULT >= THRESH. To have 77*> every test ratio printed, use THRESH = 0. 78*> \endverbatim 79*> 80*> \param[in] NMAX 81*> \verbatim 82*> NMAX is INTEGER 83*> The maximum value permitted for N, used in dimensioning the 84*> work arrays. 85*> \endverbatim 86*> 87*> \param[out] A 88*> \verbatim 89*> A is COMPLEX*16 array, dimension (NMAX*NMAX) 90*> \endverbatim 91*> 92*> \param[out] AFAC 93*> \verbatim 94*> AFAC is COMPLEX*16 array, dimension (NMAX*NMAX) 95*> \endverbatim 96*> 97*> \param[out] B 98*> \verbatim 99*> B is COMPLEX*16 array, dimension (NMAX*NSMAX) 100*> \endverbatim 101*> 102*> \param[out] X 103*> \verbatim 104*> X is COMPLEX*16 array, dimension (NMAX*NSMAX) 105*> \endverbatim 106*> 107*> \param[out] WORK 108*> \verbatim 109*> WORK is COMPLEX*16 array, dimension 110*> (NMAX*max(3,NSMAX)) 111*> \endverbatim 112*> 113*> \param[out] RWORK 114*> \verbatim 115*> RWORK is DOUBLE PRECISION array, dimension 116*> (max(2*NMAX,2*NSMAX+NWORK)) 117*> \endverbatim 118*> 119*> \param[out] SWORK 120*> \verbatim 121*> SWORK is COMPLEX array, dimension 122*> (NMAX*(NSMAX+NMAX)) 123*> \endverbatim 124*> 125*> \param[in] NOUT 126*> \verbatim 127*> NOUT is INTEGER 128*> The unit number for output. 129*> \endverbatim 130* 131* Authors: 132* ======== 133* 134*> \author Univ. of Tennessee 135*> \author Univ. of California Berkeley 136*> \author Univ. of Colorado Denver 137*> \author NAG Ltd. 138* 139*> \date December 2016 140* 141*> \ingroup complex16_lin 142* 143* ===================================================================== 144 SUBROUTINE ZDRVAC( DOTYPE, NM, MVAL, NNS, NSVAL, THRESH, NMAX, 145 $ A, AFAC, B, X, WORK, 146 $ RWORK, SWORK, NOUT ) 147* 148* -- LAPACK test routine (version 3.7.0) -- 149* -- LAPACK is a software package provided by Univ. of Tennessee, -- 150* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 151* December 2016 152* 153* .. Scalar Arguments .. 154 INTEGER NMAX, NM, NNS, NOUT 155 DOUBLE PRECISION THRESH 156* .. 157* .. Array Arguments .. 158 LOGICAL DOTYPE( * ) 159 INTEGER MVAL( * ), NSVAL( * ) 160 DOUBLE PRECISION RWORK( * ) 161 COMPLEX SWORK(*) 162 COMPLEX*16 A( * ), AFAC( * ), B( * ), 163 $ WORK( * ), X( * ) 164* .. 165* 166* ===================================================================== 167* 168* .. Parameters .. 169 DOUBLE PRECISION ZERO 170 PARAMETER ( ZERO = 0.0D+0 ) 171 INTEGER NTYPES 172 PARAMETER ( NTYPES = 9 ) 173 INTEGER NTESTS 174 PARAMETER ( NTESTS = 1 ) 175* .. 176* .. Local Scalars .. 177 LOGICAL ZEROT 178 CHARACTER DIST, TYPE, UPLO, XTYPE 179 CHARACTER*3 PATH 180 INTEGER I, IM, IMAT, INFO, IOFF, IRHS, IUPLO, 181 $ IZERO, KL, KU, LDA, MODE, N, 182 $ NERRS, NFAIL, NIMAT, NRHS, NRUN 183 DOUBLE PRECISION ANORM, CNDNUM 184* .. 185* .. Local Arrays .. 186 CHARACTER UPLOS( 2 ) 187 INTEGER ISEED( 4 ), ISEEDY( 4 ) 188 DOUBLE PRECISION RESULT( NTESTS ) 189* .. 190* .. Local Variables .. 191 INTEGER ITER, KASE 192* .. 193* .. External Subroutines .. 194 EXTERNAL ALAERH, ZLACPY, ZLAIPD, 195 $ ZLARHS, ZLATB4, ZLATMS, 196 $ ZPOT06, ZCPOSV 197* .. 198* .. Intrinsic Functions .. 199 INTRINSIC DBLE, MAX, SQRT 200* .. 201* .. Scalars in Common .. 202 LOGICAL LERR, OK 203 CHARACTER*32 SRNAMT 204 INTEGER INFOT, NUNIT 205* .. 206* .. Common blocks .. 207 COMMON / INFOC / INFOT, NUNIT, OK, LERR 208 COMMON / SRNAMC / SRNAMT 209* .. 210* .. Data statements .. 211 DATA ISEEDY / 1988, 1989, 1990, 1991 / 212 DATA UPLOS / 'U', 'L' / 213* .. 214* .. Executable Statements .. 215* 216* Initialize constants and the random number seed. 217* 218 KASE = 0 219 PATH( 1: 1 ) = 'Zomplex precision' 220 PATH( 2: 3 ) = 'PO' 221 NRUN = 0 222 NFAIL = 0 223 NERRS = 0 224 DO 10 I = 1, 4 225 ISEED( I ) = ISEEDY( I ) 226 10 CONTINUE 227* 228 INFOT = 0 229* 230* Do for each value of N in MVAL 231* 232 DO 120 IM = 1, NM 233 N = MVAL( IM ) 234 LDA = MAX( N, 1 ) 235 NIMAT = NTYPES 236 IF( N.LE.0 ) 237 $ NIMAT = 1 238* 239 DO 110 IMAT = 1, NIMAT 240* 241* Do the tests only if DOTYPE( IMAT ) is true. 242* 243 IF( .NOT.DOTYPE( IMAT ) ) 244 $ GO TO 110 245* 246* Skip types 3, 4, or 5 if the matrix size is too small. 247* 248 ZEROT = IMAT.GE.3 .AND. IMAT.LE.5 249 IF( ZEROT .AND. N.LT.IMAT-2 ) 250 $ GO TO 110 251* 252* Do first for UPLO = 'U', then for UPLO = 'L' 253* 254 DO 100 IUPLO = 1, 2 255 UPLO = UPLOS( IUPLO ) 256* 257* Set up parameters with ZLATB4 and generate a test matrix 258* with ZLATMS. 259* 260 CALL ZLATB4( PATH, IMAT, N, N, TYPE, KL, KU, ANORM, MODE, 261 $ CNDNUM, DIST ) 262* 263 SRNAMT = 'ZLATMS' 264 CALL ZLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE, 265 $ CNDNUM, ANORM, KL, KU, UPLO, A, LDA, WORK, 266 $ INFO ) 267* 268* Check error code from ZLATMS. 269* 270 IF( INFO.NE.0 ) THEN 271 CALL ALAERH( PATH, 'ZLATMS', INFO, 0, UPLO, N, N, -1, 272 $ -1, -1, IMAT, NFAIL, NERRS, NOUT ) 273 GO TO 100 274 END IF 275* 276* For types 3-5, zero one row and column of the matrix to 277* test that INFO is returned correctly. 278* 279 IF( ZEROT ) THEN 280 IF( IMAT.EQ.3 ) THEN 281 IZERO = 1 282 ELSE IF( IMAT.EQ.4 ) THEN 283 IZERO = N 284 ELSE 285 IZERO = N / 2 + 1 286 END IF 287 IOFF = ( IZERO-1 )*LDA 288* 289* Set row and column IZERO of A to 0. 290* 291 IF( IUPLO.EQ.1 ) THEN 292 DO 20 I = 1, IZERO - 1 293 A( IOFF+I ) = ZERO 294 20 CONTINUE 295 IOFF = IOFF + IZERO 296 DO 30 I = IZERO, N 297 A( IOFF ) = ZERO 298 IOFF = IOFF + LDA 299 30 CONTINUE 300 ELSE 301 IOFF = IZERO 302 DO 40 I = 1, IZERO - 1 303 A( IOFF ) = ZERO 304 IOFF = IOFF + LDA 305 40 CONTINUE 306 IOFF = IOFF - IZERO 307 DO 50 I = IZERO, N 308 A( IOFF+I ) = ZERO 309 50 CONTINUE 310 END IF 311 ELSE 312 IZERO = 0 313 END IF 314* 315* Set the imaginary part of the diagonals. 316* 317 CALL ZLAIPD( N, A, LDA+1, 0 ) 318* 319 DO 60 IRHS = 1, NNS 320 NRHS = NSVAL( IRHS ) 321 XTYPE = 'N' 322* 323* Form an exact solution and set the right hand side. 324* 325 SRNAMT = 'ZLARHS' 326 CALL ZLARHS( PATH, XTYPE, UPLO, ' ', N, N, KL, KU, 327 $ NRHS, A, LDA, X, LDA, B, LDA, 328 $ ISEED, INFO ) 329* 330* Compute the L*L' or U'*U factorization of the 331* matrix and solve the system. 332* 333 SRNAMT = 'ZCPOSV ' 334 KASE = KASE + 1 335* 336 CALL ZLACPY( 'All', N, N, A, LDA, AFAC, LDA) 337* 338 CALL ZCPOSV( UPLO, N, NRHS, AFAC, LDA, B, LDA, X, LDA, 339 $ WORK, SWORK, RWORK, ITER, INFO ) 340* 341 IF (ITER.LT.0) THEN 342 CALL ZLACPY( 'All', N, N, A, LDA, AFAC, LDA ) 343 ENDIF 344* 345* Check error code from ZCPOSV . 346* 347 IF( INFO.NE.IZERO ) THEN 348* 349 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) 350 $ CALL ALAHD( NOUT, PATH ) 351 NERRS = NERRS + 1 352* 353 IF( INFO.NE.IZERO .AND. IZERO.NE.0 ) THEN 354 WRITE( NOUT, FMT = 9988 )'ZCPOSV',INFO,IZERO,N, 355 $ IMAT 356 ELSE 357 WRITE( NOUT, FMT = 9975 )'ZCPOSV',INFO,N,IMAT 358 END IF 359 END IF 360* 361* Skip the remaining test if the matrix is singular. 362* 363 IF( INFO.NE.0 ) 364 $ GO TO 110 365* 366* Check the quality of the solution 367* 368 CALL ZLACPY( 'All', N, NRHS, B, LDA, WORK, LDA ) 369* 370 CALL ZPOT06( UPLO, N, NRHS, A, LDA, X, LDA, WORK, 371 $ LDA, RWORK, RESULT( 1 ) ) 372* 373* Check if the test passes the tesing. 374* Print information about the tests that did not 375* pass the testing. 376* 377* If iterative refinement has been used and claimed to 378* be successful (ITER>0), we want 379* NORM1(B - A*X)/(NORM1(A)*NORM1(X)*EPS*SRQT(N)) < 1 380* 381* If double precision has been used (ITER<0), we want 382* NORM1(B - A*X)/(NORM1(A)*NORM1(X)*EPS) < THRES 383* (Cf. the linear solver testing routines) 384* 385 IF ((THRESH.LE.0.0E+00) 386 $ .OR.((ITER.GE.0).AND.(N.GT.0) 387 $ .AND.(RESULT(1).GE.SQRT(DBLE(N)))) 388 $ .OR.((ITER.LT.0).AND.(RESULT(1).GE.THRESH))) THEN 389* 390 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) THEN 391 WRITE( NOUT, FMT = 8999 )'ZPO' 392 WRITE( NOUT, FMT = '( '' Matrix types:'' )' ) 393 WRITE( NOUT, FMT = 8979 ) 394 WRITE( NOUT, FMT = '( '' Test ratios:'' )' ) 395 WRITE( NOUT, FMT = 8960 )1 396 WRITE( NOUT, FMT = '( '' Messages:'' )' ) 397 END IF 398* 399 WRITE( NOUT, FMT = 9998 )UPLO, N, NRHS, IMAT, 1, 400 $ RESULT( 1 ) 401* 402 NFAIL = NFAIL + 1 403* 404 END IF 405* 406 NRUN = NRUN + 1 407* 408 60 CONTINUE 409 100 CONTINUE 410 110 CONTINUE 411 120 CONTINUE 412* 413* Print a summary of the results. 414* 415 IF( NFAIL.GT.0 ) THEN 416 WRITE( NOUT, FMT = 9996 )'ZCPOSV', NFAIL, NRUN 417 ELSE 418 WRITE( NOUT, FMT = 9995 )'ZCPOSV', NRUN 419 END IF 420 IF( NERRS.GT.0 ) THEN 421 WRITE( NOUT, FMT = 9994 )NERRS 422 END IF 423* 424 9998 FORMAT( ' UPLO=''', A1, ''', N =', I5, ', NRHS=', I3, ', type ', 425 $ I2, ', test(', I2, ') =', G12.5 ) 426 9996 FORMAT( 1X, A6, ': ', I6, ' out of ', I6, 427 $ ' tests failed to pass the threshold' ) 428 9995 FORMAT( /1X, 'All tests for ', A6, 429 $ ' routines passed the threshold ( ', I6, ' tests run)' ) 430 9994 FORMAT( 6X, I6, ' error messages recorded' ) 431* 432* SUBNAM, INFO, INFOE, N, IMAT 433* 434 9988 FORMAT( ' *** ', A6, ' returned with INFO =', I5, ' instead of ', 435 $ I5, / ' ==> N =', I5, ', type ', 436 $ I2 ) 437* 438* SUBNAM, INFO, N, IMAT 439* 440 9975 FORMAT( ' *** Error code from ', A6, '=', I5, ' for M=', I5, 441 $ ', type ', I2 ) 442 8999 FORMAT( / 1X, A3, ': positive definite dense matrices' ) 443 8979 FORMAT( 4X, '1. Diagonal', 24X, '7. Last n/2 columns zero', / 4X, 444 $ '2. Upper triangular', 16X, 445 $ '8. Random, CNDNUM = sqrt(0.1/EPS)', / 4X, 446 $ '3. Lower triangular', 16X, '9. Random, CNDNUM = 0.1/EPS', 447 $ / 4X, '4. Random, CNDNUM = 2', 13X, 448 $ '10. Scaled near underflow', / 4X, '5. First column zero', 449 $ 14X, '11. Scaled near overflow', / 4X, 450 $ '6. Last column zero' ) 451 8960 FORMAT( 3X, I2, ': norm_1( B - A * X ) / ', 452 $ '( norm_1(A) * norm_1(X) * EPS * SQRT(N) ) > 1 if ITERREF', 453 $ / 4x, 'or norm_1( B - A * X ) / ', 454 $ '( norm_1(A) * norm_1(X) * EPS ) > THRES if ZPOTRF' ) 455 456 RETURN 457* 458* End of ZDRVAC 459* 460 END 461