1*> \brief \b DERRED 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 DERRED( PATH, NUNIT ) 12* 13* .. Scalar Arguments .. 14* CHARACTER*3 PATH 15* INTEGER NUNIT 16* .. 17* 18* 19*> \par Purpose: 20* ============= 21*> 22*> \verbatim 23*> 24*> DERRED tests the error exits for the eigenvalue driver routines for 25*> DOUBLE PRECISION matrices: 26*> 27*> PATH driver description 28*> ---- ------ ----------- 29*> SEV DGEEV find eigenvalues/eigenvectors for nonsymmetric A 30*> SES DGEES find eigenvalues/Schur form for nonsymmetric A 31*> SVX DGEEVX SGEEV + balancing and condition estimation 32*> SSX DGEESX SGEES + balancing and condition estimation 33*> DBD DGESVD compute SVD of an M-by-N matrix A 34*> DGESDD compute SVD of an M-by-N matrix A (by divide and 35*> conquer) 36*> DGEJSV compute SVD of an M-by-N matrix A where M >= N 37*> DGESVDX compute SVD of an M-by-N matrix A(by bisection 38*> and inverse iteration) 39*> DGESVDQ compute SVD of an M-by-N matrix A(with a 40*> QR-Preconditioned ) 41*> \endverbatim 42* 43* Arguments: 44* ========== 45* 46*> \param[in] PATH 47*> \verbatim 48*> PATH is CHARACTER*3 49*> The LAPACK path name for the routines to be tested. 50*> \endverbatim 51*> 52*> \param[in] NUNIT 53*> \verbatim 54*> NUNIT is INTEGER 55*> The unit number for output. 56*> \endverbatim 57* 58* Authors: 59* ======== 60* 61*> \author Univ. of Tennessee 62*> \author Univ. of California Berkeley 63*> \author Univ. of Colorado Denver 64*> \author NAG Ltd. 65* 66*> \date June 2016 67* 68*> \ingroup double_eig 69* 70* ===================================================================== 71 SUBROUTINE DERRED( PATH, NUNIT ) 72* 73* -- LAPACK test routine (version 3.7.0) -- 74* -- LAPACK is a software package provided by Univ. of Tennessee, -- 75* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 76* June 2016 77* 78* .. Scalar Arguments .. 79 CHARACTER*3 PATH 80 INTEGER NUNIT 81* .. 82* 83* ===================================================================== 84* 85* .. Parameters .. 86 INTEGER NMAX 87 DOUBLE PRECISION ONE, ZERO 88 PARAMETER ( NMAX = 4, ONE = 1.0D0, ZERO = 0.0D0 ) 89* .. 90* .. Local Scalars .. 91 CHARACTER*2 C2 92 INTEGER I, IHI, ILO, INFO, J, NS, NT, SDIM 93 DOUBLE PRECISION ABNRM 94* .. 95* .. Local Arrays .. 96 LOGICAL B( NMAX ) 97 INTEGER IW( 2*NMAX ) 98 DOUBLE PRECISION A( NMAX, NMAX ), R1( NMAX ), R2( NMAX ), 99 $ S( NMAX ), U( NMAX, NMAX ), VL( NMAX, NMAX ), 100 $ VR( NMAX, NMAX ), VT( NMAX, NMAX ), 101 $ W( 10*NMAX ), WI( NMAX ), WR( NMAX ) 102* .. 103* .. External Subroutines .. 104 EXTERNAL CHKXER, DGEES, DGEESX, DGEEV, DGEEVX, DGEJSV, 105 $ DGESDD, DGESVD, DGESVDX, DGESVQ 106* .. 107* .. External Functions .. 108 LOGICAL DSLECT, LSAMEN 109 EXTERNAL DSLECT, LSAMEN 110* .. 111* .. Intrinsic Functions .. 112 INTRINSIC LEN_TRIM 113* .. 114* .. Arrays in Common .. 115 LOGICAL SELVAL( 20 ) 116 DOUBLE PRECISION SELWI( 20 ), SELWR( 20 ) 117* .. 118* .. Scalars in Common .. 119 LOGICAL LERR, OK 120 CHARACTER*32 SRNAMT 121 INTEGER INFOT, NOUT, SELDIM, SELOPT 122* .. 123* .. Common blocks .. 124 COMMON / INFOC / INFOT, NOUT, OK, LERR 125 COMMON / SRNAMC / SRNAMT 126 COMMON / SSLCT / SELOPT, SELDIM, SELVAL, SELWR, SELWI 127* .. 128* .. Executable Statements .. 129* 130 NOUT = NUNIT 131 WRITE( NOUT, FMT = * ) 132 C2 = PATH( 2: 3 ) 133* 134* Initialize A 135* 136 DO 20 J = 1, NMAX 137 DO 10 I = 1, NMAX 138 A( I, J ) = ZERO 139 10 CONTINUE 140 20 CONTINUE 141 DO 30 I = 1, NMAX 142 A( I, I ) = ONE 143 30 CONTINUE 144 OK = .TRUE. 145 NT = 0 146* 147 IF( LSAMEN( 2, C2, 'EV' ) ) THEN 148* 149* Test DGEEV 150* 151 SRNAMT = 'DGEEV ' 152 INFOT = 1 153 CALL DGEEV( 'X', 'N', 0, A, 1, WR, WI, VL, 1, VR, 1, W, 1, 154 $ INFO ) 155 CALL CHKXER( 'DGEEV ', INFOT, NOUT, LERR, OK ) 156 INFOT = 2 157 CALL DGEEV( 'N', 'X', 0, A, 1, WR, WI, VL, 1, VR, 1, W, 1, 158 $ INFO ) 159 CALL CHKXER( 'DGEEV ', INFOT, NOUT, LERR, OK ) 160 INFOT = 3 161 CALL DGEEV( 'N', 'N', -1, A, 1, WR, WI, VL, 1, VR, 1, W, 1, 162 $ INFO ) 163 CALL CHKXER( 'DGEEV ', INFOT, NOUT, LERR, OK ) 164 INFOT = 5 165 CALL DGEEV( 'N', 'N', 2, A, 1, WR, WI, VL, 1, VR, 1, W, 6, 166 $ INFO ) 167 CALL CHKXER( 'DGEEV ', INFOT, NOUT, LERR, OK ) 168 INFOT = 9 169 CALL DGEEV( 'V', 'N', 2, A, 2, WR, WI, VL, 1, VR, 1, W, 8, 170 $ INFO ) 171 CALL CHKXER( 'DGEEV ', INFOT, NOUT, LERR, OK ) 172 INFOT = 11 173 CALL DGEEV( 'N', 'V', 2, A, 2, WR, WI, VL, 1, VR, 1, W, 8, 174 $ INFO ) 175 CALL CHKXER( 'DGEEV ', INFOT, NOUT, LERR, OK ) 176 INFOT = 13 177 CALL DGEEV( 'V', 'V', 1, A, 1, WR, WI, VL, 1, VR, 1, W, 3, 178 $ INFO ) 179 CALL CHKXER( 'DGEEV ', INFOT, NOUT, LERR, OK ) 180 NT = NT + 7 181* 182 ELSE IF( LSAMEN( 2, C2, 'ES' ) ) THEN 183* 184* Test DGEES 185* 186 SRNAMT = 'DGEES ' 187 INFOT = 1 188 CALL DGEES( 'X', 'N', DSLECT, 0, A, 1, SDIM, WR, WI, VL, 1, W, 189 $ 1, B, INFO ) 190 CALL CHKXER( 'DGEES ', INFOT, NOUT, LERR, OK ) 191 INFOT = 2 192 CALL DGEES( 'N', 'X', DSLECT, 0, A, 1, SDIM, WR, WI, VL, 1, W, 193 $ 1, B, INFO ) 194 CALL CHKXER( 'DGEES ', INFOT, NOUT, LERR, OK ) 195 INFOT = 4 196 CALL DGEES( 'N', 'S', DSLECT, -1, A, 1, SDIM, WR, WI, VL, 1, W, 197 $ 1, B, INFO ) 198 CALL CHKXER( 'DGEES ', INFOT, NOUT, LERR, OK ) 199 INFOT = 6 200 CALL DGEES( 'N', 'S', DSLECT, 2, A, 1, SDIM, WR, WI, VL, 1, W, 201 $ 6, B, INFO ) 202 CALL CHKXER( 'DGEES ', INFOT, NOUT, LERR, OK ) 203 INFOT = 11 204 CALL DGEES( 'V', 'S', DSLECT, 2, A, 2, SDIM, WR, WI, VL, 1, W, 205 $ 6, B, INFO ) 206 CALL CHKXER( 'DGEES ', INFOT, NOUT, LERR, OK ) 207 INFOT = 13 208 CALL DGEES( 'N', 'S', DSLECT, 1, A, 1, SDIM, WR, WI, VL, 1, W, 209 $ 2, B, INFO ) 210 CALL CHKXER( 'DGEES ', INFOT, NOUT, LERR, OK ) 211 NT = NT + 6 212* 213 ELSE IF( LSAMEN( 2, C2, 'VX' ) ) THEN 214* 215* Test DGEEVX 216* 217 SRNAMT = 'DGEEVX' 218 INFOT = 1 219 CALL DGEEVX( 'X', 'N', 'N', 'N', 0, A, 1, WR, WI, VL, 1, VR, 1, 220 $ ILO, IHI, S, ABNRM, R1, R2, W, 1, IW, INFO ) 221 CALL CHKXER( 'DGEEVX', INFOT, NOUT, LERR, OK ) 222 INFOT = 2 223 CALL DGEEVX( 'N', 'X', 'N', 'N', 0, A, 1, WR, WI, VL, 1, VR, 1, 224 $ ILO, IHI, S, ABNRM, R1, R2, W, 1, IW, INFO ) 225 CALL CHKXER( 'DGEEVX', INFOT, NOUT, LERR, OK ) 226 INFOT = 3 227 CALL DGEEVX( 'N', 'N', 'X', 'N', 0, A, 1, WR, WI, VL, 1, VR, 1, 228 $ ILO, IHI, S, ABNRM, R1, R2, W, 1, IW, INFO ) 229 CALL CHKXER( 'DGEEVX', INFOT, NOUT, LERR, OK ) 230 INFOT = 4 231 CALL DGEEVX( 'N', 'N', 'N', 'X', 0, A, 1, WR, WI, VL, 1, VR, 1, 232 $ ILO, IHI, S, ABNRM, R1, R2, W, 1, IW, INFO ) 233 CALL CHKXER( 'DGEEVX', INFOT, NOUT, LERR, OK ) 234 INFOT = 5 235 CALL DGEEVX( 'N', 'N', 'N', 'N', -1, A, 1, WR, WI, VL, 1, VR, 236 $ 1, ILO, IHI, S, ABNRM, R1, R2, W, 1, IW, INFO ) 237 CALL CHKXER( 'DGEEVX', INFOT, NOUT, LERR, OK ) 238 INFOT = 7 239 CALL DGEEVX( 'N', 'N', 'N', 'N', 2, A, 1, WR, WI, VL, 1, VR, 1, 240 $ ILO, IHI, S, ABNRM, R1, R2, W, 1, IW, INFO ) 241 CALL CHKXER( 'DGEEVX', INFOT, NOUT, LERR, OK ) 242 INFOT = 11 243 CALL DGEEVX( 'N', 'V', 'N', 'N', 2, A, 2, WR, WI, VL, 1, VR, 1, 244 $ ILO, IHI, S, ABNRM, R1, R2, W, 6, IW, INFO ) 245 CALL CHKXER( 'DGEEVX', INFOT, NOUT, LERR, OK ) 246 INFOT = 13 247 CALL DGEEVX( 'N', 'N', 'V', 'N', 2, A, 2, WR, WI, VL, 1, VR, 1, 248 $ ILO, IHI, S, ABNRM, R1, R2, W, 6, IW, INFO ) 249 CALL CHKXER( 'DGEEVX', INFOT, NOUT, LERR, OK ) 250 INFOT = 21 251 CALL DGEEVX( 'N', 'N', 'N', 'N', 1, A, 1, WR, WI, VL, 1, VR, 1, 252 $ ILO, IHI, S, ABNRM, R1, R2, W, 1, IW, INFO ) 253 CALL CHKXER( 'DGEEVX', INFOT, NOUT, LERR, OK ) 254 INFOT = 21 255 CALL DGEEVX( 'N', 'V', 'N', 'N', 1, A, 1, WR, WI, VL, 1, VR, 1, 256 $ ILO, IHI, S, ABNRM, R1, R2, W, 2, IW, INFO ) 257 CALL CHKXER( 'DGEEVX', INFOT, NOUT, LERR, OK ) 258 INFOT = 21 259 CALL DGEEVX( 'N', 'N', 'V', 'V', 1, A, 1, WR, WI, VL, 1, VR, 1, 260 $ ILO, IHI, S, ABNRM, R1, R2, W, 3, IW, INFO ) 261 CALL CHKXER( 'DGEEVX', INFOT, NOUT, LERR, OK ) 262 NT = NT + 11 263* 264 ELSE IF( LSAMEN( 2, C2, 'SX' ) ) THEN 265* 266* Test DGEESX 267* 268 SRNAMT = 'DGEESX' 269 INFOT = 1 270 CALL DGEESX( 'X', 'N', DSLECT, 'N', 0, A, 1, SDIM, WR, WI, VL, 271 $ 1, R1( 1 ), R2( 1 ), W, 1, IW, 1, B, INFO ) 272 CALL CHKXER( 'DGEESX', INFOT, NOUT, LERR, OK ) 273 INFOT = 2 274 CALL DGEESX( 'N', 'X', DSLECT, 'N', 0, A, 1, SDIM, WR, WI, VL, 275 $ 1, R1( 1 ), R2( 1 ), W, 1, IW, 1, B, INFO ) 276 CALL CHKXER( 'DGEESX', INFOT, NOUT, LERR, OK ) 277 INFOT = 4 278 CALL DGEESX( 'N', 'N', DSLECT, 'X', 0, A, 1, SDIM, WR, WI, VL, 279 $ 1, R1( 1 ), R2( 1 ), W, 1, IW, 1, B, INFO ) 280 CALL CHKXER( 'DGEESX', INFOT, NOUT, LERR, OK ) 281 INFOT = 5 282 CALL DGEESX( 'N', 'N', DSLECT, 'N', -1, A, 1, SDIM, WR, WI, VL, 283 $ 1, R1( 1 ), R2( 1 ), W, 1, IW, 1, B, INFO ) 284 CALL CHKXER( 'DGEESX', INFOT, NOUT, LERR, OK ) 285 INFOT = 7 286 CALL DGEESX( 'N', 'N', DSLECT, 'N', 2, A, 1, SDIM, WR, WI, VL, 287 $ 1, R1( 1 ), R2( 1 ), W, 6, IW, 1, B, INFO ) 288 CALL CHKXER( 'DGEESX', INFOT, NOUT, LERR, OK ) 289 INFOT = 12 290 CALL DGEESX( 'V', 'N', DSLECT, 'N', 2, A, 2, SDIM, WR, WI, VL, 291 $ 1, R1( 1 ), R2( 1 ), W, 6, IW, 1, B, INFO ) 292 CALL CHKXER( 'DGEESX', INFOT, NOUT, LERR, OK ) 293 INFOT = 16 294 CALL DGEESX( 'N', 'N', DSLECT, 'N', 1, A, 1, SDIM, WR, WI, VL, 295 $ 1, R1( 1 ), R2( 1 ), W, 2, IW, 1, B, INFO ) 296 CALL CHKXER( 'DGEESX', INFOT, NOUT, LERR, OK ) 297 NT = NT + 7 298* 299 ELSE IF( LSAMEN( 2, C2, 'BD' ) ) THEN 300* 301* Test DGESVD 302* 303 SRNAMT = 'DGESVD' 304 INFOT = 1 305 CALL DGESVD( 'X', 'N', 0, 0, A, 1, S, U, 1, VT, 1, W, 1, INFO ) 306 CALL CHKXER( 'DGESVD', INFOT, NOUT, LERR, OK ) 307 INFOT = 2 308 CALL DGESVD( 'N', 'X', 0, 0, A, 1, S, U, 1, VT, 1, W, 1, INFO ) 309 CALL CHKXER( 'DGESVD', INFOT, NOUT, LERR, OK ) 310 INFOT = 2 311 CALL DGESVD( 'O', 'O', 0, 0, A, 1, S, U, 1, VT, 1, W, 1, INFO ) 312 CALL CHKXER( 'DGESVD', INFOT, NOUT, LERR, OK ) 313 INFOT = 3 314 CALL DGESVD( 'N', 'N', -1, 0, A, 1, S, U, 1, VT, 1, W, 1, 315 $ INFO ) 316 CALL CHKXER( 'DGESVD', INFOT, NOUT, LERR, OK ) 317 INFOT = 4 318 CALL DGESVD( 'N', 'N', 0, -1, A, 1, S, U, 1, VT, 1, W, 1, 319 $ INFO ) 320 CALL CHKXER( 'DGESVD', INFOT, NOUT, LERR, OK ) 321 INFOT = 6 322 CALL DGESVD( 'N', 'N', 2, 1, A, 1, S, U, 1, VT, 1, W, 5, INFO ) 323 CALL CHKXER( 'DGESVD', INFOT, NOUT, LERR, OK ) 324 INFOT = 9 325 CALL DGESVD( 'A', 'N', 2, 1, A, 2, S, U, 1, VT, 1, W, 5, INFO ) 326 CALL CHKXER( 'DGESVD', INFOT, NOUT, LERR, OK ) 327 INFOT = 11 328 CALL DGESVD( 'N', 'A', 1, 2, A, 1, S, U, 1, VT, 1, W, 5, INFO ) 329 CALL CHKXER( 'DGESVD', INFOT, NOUT, LERR, OK ) 330 NT = 8 331 IF( OK ) THEN 332 WRITE( NOUT, FMT = 9999 )SRNAMT( 1:LEN_TRIM( SRNAMT ) ), 333 $ NT 334 ELSE 335 WRITE( NOUT, FMT = 9998 ) 336 END IF 337* 338* Test DGESDD 339* 340 SRNAMT = 'DGESDD' 341 INFOT = 1 342 CALL DGESDD( 'X', 0, 0, A, 1, S, U, 1, VT, 1, W, 1, IW, INFO ) 343 CALL CHKXER( 'DGESDD', INFOT, NOUT, LERR, OK ) 344 INFOT = 2 345 CALL DGESDD( 'N', -1, 0, A, 1, S, U, 1, VT, 1, W, 1, IW, INFO ) 346 CALL CHKXER( 'DGESDD', INFOT, NOUT, LERR, OK ) 347 INFOT = 3 348 CALL DGESDD( 'N', 0, -1, A, 1, S, U, 1, VT, 1, W, 1, IW, INFO ) 349 CALL CHKXER( 'DGESDD', INFOT, NOUT, LERR, OK ) 350 INFOT = 5 351 CALL DGESDD( 'N', 2, 1, A, 1, S, U, 1, VT, 1, W, 5, IW, INFO ) 352 CALL CHKXER( 'DGESDD', INFOT, NOUT, LERR, OK ) 353 INFOT = 8 354 CALL DGESDD( 'A', 2, 1, A, 2, S, U, 1, VT, 1, W, 5, IW, INFO ) 355 CALL CHKXER( 'DGESDD', INFOT, NOUT, LERR, OK ) 356 INFOT = 10 357 CALL DGESDD( 'A', 1, 2, A, 1, S, U, 1, VT, 1, W, 5, IW, INFO ) 358 CALL CHKXER( 'DGESDD', INFOT, NOUT, LERR, OK ) 359 NT = 6 360 IF( OK ) THEN 361 WRITE( NOUT, FMT = 9999 )SRNAMT( 1:LEN_TRIM( SRNAMT ) ), 362 $ NT 363 ELSE 364 WRITE( NOUT, FMT = 9998 ) 365 END IF 366* 367* Test DGEJSV 368* 369 SRNAMT = 'DGEJSV' 370 INFOT = 1 371 CALL DGEJSV( 'X', 'U', 'V', 'R', 'N', 'N', 372 $ 0, 0, A, 1, S, U, 1, VT, 1, 373 $ W, 1, IW, INFO) 374 CALL CHKXER( 'DGEJSV', INFOT, NOUT, LERR, OK ) 375 INFOT = 2 376 CALL DGEJSV( 'G', 'X', 'V', 'R', 'N', 'N', 377 $ 0, 0, A, 1, S, U, 1, VT, 1, 378 $ W, 1, IW, INFO) 379 CALL CHKXER( 'DGEJSV', INFOT, NOUT, LERR, OK ) 380 INFOT = 3 381 CALL DGEJSV( 'G', 'U', 'X', 'R', 'N', 'N', 382 $ 0, 0, A, 1, S, U, 1, VT, 1, 383 $ W, 1, IW, INFO) 384 CALL CHKXER( 'DGEJSV', INFOT, NOUT, LERR, OK ) 385 INFOT = 4 386 CALL DGEJSV( 'G', 'U', 'V', 'X', 'N', 'N', 387 $ 0, 0, A, 1, S, U, 1, VT, 1, 388 $ W, 1, IW, INFO) 389 CALL CHKXER( 'DGEJSV', INFOT, NOUT, LERR, OK ) 390 INFOT = 5 391 CALL DGEJSV( 'G', 'U', 'V', 'R', 'X', 'N', 392 $ 0, 0, A, 1, S, U, 1, VT, 1, 393 $ W, 1, IW, INFO) 394 CALL CHKXER( 'DGEJSV', INFOT, NOUT, LERR, OK ) 395 INFOT = 6 396 CALL DGEJSV( 'G', 'U', 'V', 'R', 'N', 'X', 397 $ 0, 0, A, 1, S, U, 1, VT, 1, 398 $ W, 1, IW, INFO) 399 CALL CHKXER( 'DGEJSV', INFOT, NOUT, LERR, OK ) 400 INFOT = 7 401 CALL DGEJSV( 'G', 'U', 'V', 'R', 'N', 'N', 402 $ -1, 0, A, 1, S, U, 1, VT, 1, 403 $ W, 1, IW, INFO) 404 CALL CHKXER( 'DGEJSV', INFOT, NOUT, LERR, OK ) 405 INFOT = 8 406 CALL DGEJSV( 'G', 'U', 'V', 'R', 'N', 'N', 407 $ 0, -1, A, 1, S, U, 1, VT, 1, 408 $ W, 1, IW, INFO) 409 CALL CHKXER( 'DGEJSV', INFOT, NOUT, LERR, OK ) 410 INFOT = 10 411 CALL DGEJSV( 'G', 'U', 'V', 'R', 'N', 'N', 412 $ 2, 1, A, 1, S, U, 1, VT, 1, 413 $ W, 1, IW, INFO) 414 CALL CHKXER( 'DGEJSV', INFOT, NOUT, LERR, OK ) 415 INFOT = 13 416 CALL DGEJSV( 'G', 'U', 'V', 'R', 'N', 'N', 417 $ 2, 2, A, 2, S, U, 1, VT, 2, 418 $ W, 1, IW, INFO) 419 CALL CHKXER( 'DGEJSV', INFOT, NOUT, LERR, OK ) 420 INFOT = 15 421 CALL DGEJSV( 'G', 'U', 'V', 'R', 'N', 'N', 422 $ 2, 2, A, 2, S, U, 2, VT, 1, 423 $ W, 1, IW, INFO) 424 CALL CHKXER( 'DGEJSV', INFOT, NOUT, LERR, OK ) 425 NT = 11 426 IF( OK ) THEN 427 WRITE( NOUT, FMT = 9999 )SRNAMT( 1:LEN_TRIM( SRNAMT ) ), 428 $ NT 429 ELSE 430 WRITE( NOUT, FMT = 9998 ) 431 END IF 432* 433* Test DGESVDX 434* 435 SRNAMT = 'DGESVDX' 436 INFOT = 1 437 CALL DGESVDX( 'X', 'N', 'A', 0, 0, A, 1, ZERO, ZERO, 438 $ 0, 0, NS, S, U, 1, VT, 1, W, 1, IW, INFO ) 439 CALL CHKXER( 'DGESVDX', INFOT, NOUT, LERR, OK ) 440 INFOT = 2 441 CALL DGESVDX( 'N', 'X', 'A', 0, 0, A, 1, ZERO, ZERO, 442 $ 0, 0, NS, S, U, 1, VT, 1, W, 1, IW, INFO ) 443 CALL CHKXER( 'DGESVDX', INFOT, NOUT, LERR, OK ) 444 INFOT = 3 445 CALL DGESVDX( 'N', 'N', 'X', 0, 0, A, 1, ZERO, ZERO, 446 $ 0, 0, NS, S, U, 1, VT, 1, W, 1, IW, INFO ) 447 CALL CHKXER( 'DGESVDX', INFOT, NOUT, LERR, OK ) 448 INFOT = 4 449 CALL DGESVDX( 'N', 'N', 'A', -1, 0, A, 1, ZERO, ZERO, 450 $ 0, 0, NS, S, U, 1, VT, 1, W, 1, IW, INFO ) 451 CALL CHKXER( 'DGESVDX', INFOT, NOUT, LERR, OK ) 452 INFOT = 5 453 CALL DGESVDX( 'N', 'N', 'A', 0, -1, A, 1, ZERO, ZERO, 454 $ 0, 0, NS, S, U, 1, VT, 1, W, 1, IW, INFO ) 455 CALL CHKXER( 'DGESVDX', INFOT, NOUT, LERR, OK ) 456 INFOT = 7 457 CALL DGESVDX( 'N', 'N', 'A', 2, 1, A, 1, ZERO, ZERO, 458 $ 0, 0, NS, S, U, 1, VT, 1, W, 1, IW, INFO ) 459 CALL CHKXER( 'DGESVDX', INFOT, NOUT, LERR, OK ) 460 INFOT = 8 461 CALL DGESVDX( 'N', 'N', 'V', 2, 1, A, 2, -ONE, ZERO, 462 $ 0, 0, NS, S, U, 1, VT, 1, W, 1, IW, INFO ) 463 CALL CHKXER( 'DGESVDX', INFOT, NOUT, LERR, OK ) 464 INFOT = 9 465 CALL DGESVDX( 'N', 'N', 'V', 2, 1, A, 2, ONE, ZERO, 466 $ 0, 0, NS, S, U, 1, VT, 1, W, 1, IW, INFO ) 467 CALL CHKXER( 'DGESVDX', INFOT, NOUT, LERR, OK ) 468 INFOT = 10 469 CALL DGESVDX( 'N', 'N', 'I', 2, 2, A, 2, ZERO, ZERO, 470 $ 0, 1, NS, S, U, 1, VT, 1, W, 1, IW, INFO ) 471 CALL CHKXER( 'DGESVDX', INFOT, NOUT, LERR, OK ) 472 INFOT = 11 473 CALL DGESVDX( 'V', 'N', 'I', 2, 2, A, 2, ZERO, ZERO, 474 $ 1, 0, NS, S, U, 1, VT, 1, W, 1, IW, INFO ) 475 CALL CHKXER( 'DGESVDX', INFOT, NOUT, LERR, OK ) 476 INFOT = 15 477 CALL DGESVDX( 'V', 'N', 'A', 2, 2, A, 2, ZERO, ZERO, 478 $ 0, 0, NS, S, U, 1, VT, 1, W, 1, IW, INFO ) 479 CALL CHKXER( 'DGESVDX', INFOT, NOUT, LERR, OK ) 480 INFOT = 17 481 CALL DGESVDX( 'N', 'V', 'A', 2, 2, A, 2, ZERO, ZERO, 482 $ 0, 0, NS, S, U, 1, VT, 1, W, 1, IW, INFO ) 483 CALL CHKXER( 'DGESVDX', INFOT, NOUT, LERR, OK ) 484 NT = 12 485 IF( OK ) THEN 486 WRITE( NOUT, FMT = 9999 )SRNAMT( 1:LEN_TRIM( SRNAMT ) ), 487 $ NT 488 ELSE 489 WRITE( NOUT, FMT = 9998 ) 490 END IF 491* 492* Test DGESVDQ 493* 494 SRNAMT = 'DGESVDQ' 495 INFOT = 1 496 CALL DGESVDQ( 'X', 'P', 'T', 'A', 'A', 0, 0, A, 1, S, U, 497 $ 0, VT, 0, NS, IW, 1, W, 1, W, 1, INFO ) 498 CALL CHKXER( 'DGESVDQ', INFOT, NOUT, LERR, OK ) 499 INFOT = 2 500 CALL DGESVDQ( 'A', 'X', 'T', 'A', 'A', 0, 0, A, 1, S, U, 501 $ 0, VT, 0, NS, IW, 1, W, 1, W, 1, INFO ) 502 CALL CHKXER( 'DGESVDQ', INFOT, NOUT, LERR, OK ) 503 INFOT = 3 504 CALL DGESVDQ( 'A', 'P', 'X', 'A', 'A', 0, 0, A, 1, S, U, 505 $ 0, VT, 0, NS, IW, 1, W, 1, W, 1, INFO ) 506 CALL CHKXER( 'DGESVDQ', INFOT, NOUT, LERR, OK ) 507 INFOT = 4 508 CALL DGESVDQ( 'A', 'P', 'T', 'X', 'A', 0, 0, A, 1, S, U, 509 $ 0, VT, 0, NS, IW, 1, W, 1, W, 1, INFO ) 510 CALL CHKXER( 'DGESVDQ', INFOT, NOUT, LERR, OK ) 511 INFOT = 5 512 CALL DGESVDQ( 'A', 'P', 'T', 'A', 'X', 0, 0, A, 1, S, U, 513 $ 0, VT, 0, NS, IW, 1, W, 1, W, 1, INFO ) 514 CALL CHKXER( 'DGESVDQ', INFOT, NOUT, LERR, OK ) 515 INFOT = 6 516 CALL DGESVDQ( 'A', 'P', 'T', 'A', 'A', -1, 0, A, 1, S, U, 517 $ 0, VT, 0, NS, IW, 1, W, 1, W, 1, INFO ) 518 CALL CHKXER( 'DGESVDQ', INFOT, NOUT, LERR, OK ) 519 INFOT = 7 520 CALL DGESVDQ( 'A', 'P', 'T', 'A', 'A', 0, 1, A, 1, S, U, 521 $ 0, VT, 0, NS, IW, 1, W, 1, W, 1, INFO ) 522 CALL CHKXER( 'DGESVDQ', INFOT, NOUT, LERR, OK ) 523 INFOT = 9 524 CALL DGESVDQ( 'A', 'P', 'T', 'A', 'A', 1, 1, A, 0, S, U, 525 $ 0, VT, 0, NS, IW, 1, W, 1, W, 1, INFO ) 526 CALL CHKXER( 'DGESVDQ', INFOT, NOUT, LERR, OK ) 527 INFOT = 12 528 CALL DGESVDQ( 'A', 'P', 'T', 'A', 'A', 1, 1, A, 1, S, U, 529 $ -1, VT, 0, NS, IW, 1, W, 1, W, 1, INFO ) 530 CALL CHKXER( 'DGESVDQ', INFOT, NOUT, LERR, OK ) 531 INFOT = 14 532 CALL DGESVDQ( 'A', 'P', 'T', 'A', 'A', 1, 1, A, 1, S, U, 533 $ 1, VT, -1, NS, IW, 1, W, 1, W, 1, INFO ) 534 CALL CHKXER( 'DGESVDQ', INFOT, NOUT, LERR, OK ) 535 INFOT = 17 536 CALL DGESVDQ( 'A', 'P', 'T', 'A', 'A', 1, 1, A, 1, S, U, 537 $ 1, VT, 1, NS, IW, -5, W, 1, W, 1, INFO ) 538 CALL CHKXER( 'DGESVDQ', INFOT, NOUT, LERR, OK ) 539 NT = 11 540 IF( OK ) THEN 541 WRITE( NOUT, FMT = 9999 )SRNAMT( 1:LEN_TRIM( SRNAMT ) ), 542 $ NT 543 ELSE 544 WRITE( NOUT, FMT = 9998 ) 545 END IF 546 END IF 547* 548* Print a summary line. 549* 550 IF( .NOT.LSAMEN( 2, C2, 'BD' ) ) THEN 551 IF( OK ) THEN 552 WRITE( NOUT, FMT = 9999 )SRNAMT( 1:LEN_TRIM( SRNAMT ) ), 553 $ NT 554 ELSE 555 WRITE( NOUT, FMT = 9998 ) 556 END IF 557 END IF 558* 559 9999 FORMAT( 1X, A, ' passed the tests of the error exits (', I3, 560 $ ' tests done)' ) 561 9998 FORMAT( ' *** ', A, ' failed the tests of the error exits ***' ) 562 RETURN 563* 564* End of DERRED 565 END 566