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