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*> \endverbatim 38* 39* Arguments: 40* ========== 41* 42*> \param[in] PATH 43*> \verbatim 44*> PATH is CHARACTER*3 45*> The LAPACK path name for the routines to be tested. 46*> \endverbatim 47*> 48*> \param[in] NUNIT 49*> \verbatim 50*> NUNIT is INTEGER 51*> The unit number for output. 52*> \endverbatim 53* 54* Authors: 55* ======== 56* 57*> \author Univ. of Tennessee 58*> \author Univ. of California Berkeley 59*> \author Univ. of Colorado Denver 60*> \author NAG Ltd. 61* 62*> \date November 2011 63* 64*> \ingroup double_eig 65* 66* ===================================================================== 67 SUBROUTINE DERRED( PATH, NUNIT ) 68* 69* -- LAPACK test routine (version 3.4.0) -- 70* -- LAPACK is a software package provided by Univ. of Tennessee, -- 71* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 72* November 2011 73* 74* .. Scalar Arguments .. 75 CHARACTER*3 PATH 76 INTEGER NUNIT 77* .. 78* 79* ===================================================================== 80* 81* .. Parameters .. 82 INTEGER NMAX 83 DOUBLE PRECISION ONE, ZERO 84 PARAMETER ( NMAX = 4, ONE = 1.0D0, ZERO = 0.0D0 ) 85* .. 86* .. Local Scalars .. 87 CHARACTER*2 C2 88 INTEGER I, IHI, ILO, INFO, J, NT, SDIM 89 DOUBLE PRECISION ABNRM 90* .. 91* .. Local Arrays .. 92 LOGICAL B( NMAX ) 93 INTEGER IW( 2*NMAX ) 94 DOUBLE PRECISION A( NMAX, NMAX ), R1( NMAX ), R2( NMAX ), 95 $ S( NMAX ), U( NMAX, NMAX ), VL( NMAX, NMAX ), 96 $ VR( NMAX, NMAX ), VT( NMAX, NMAX ), 97 $ W( 4*NMAX ), WI( NMAX ), WR( NMAX ) 98* .. 99* .. External Subroutines .. 100 EXTERNAL CHKXER, DGEES, DGEESX, DGEEV, DGEEVX, DGEJSV, 101 $ DGESDD, DGESVD 102* .. 103* .. External Functions .. 104 LOGICAL DSLECT, LSAMEN 105 EXTERNAL DSLECT, LSAMEN 106* .. 107* .. Intrinsic Functions .. 108 INTRINSIC LEN_TRIM 109* .. 110* .. Arrays in Common .. 111 LOGICAL SELVAL( 20 ) 112 DOUBLE PRECISION SELWI( 20 ), SELWR( 20 ) 113* .. 114* .. Scalars in Common .. 115 LOGICAL LERR, OK 116 CHARACTER*32 SRNAMT 117 INTEGER INFOT, NOUT, SELDIM, SELOPT 118* .. 119* .. Common blocks .. 120 COMMON / INFOC / INFOT, NOUT, OK, LERR 121 COMMON / SRNAMC / SRNAMT 122 COMMON / SSLCT / SELOPT, SELDIM, SELVAL, SELWR, SELWI 123* .. 124* .. Executable Statements .. 125* 126 NOUT = NUNIT 127 WRITE( NOUT, FMT = * ) 128 C2 = PATH( 2: 3 ) 129* 130* Initialize A 131* 132 DO 20 J = 1, NMAX 133 DO 10 I = 1, NMAX 134 A( I, J ) = ZERO 135 10 CONTINUE 136 20 CONTINUE 137 DO 30 I = 1, NMAX 138 A( I, I ) = ONE 139 30 CONTINUE 140 OK = .TRUE. 141 NT = 0 142* 143 IF( LSAMEN( 2, C2, 'EV' ) ) THEN 144* 145* Test DGEEV 146* 147 SRNAMT = 'DGEEV ' 148 INFOT = 1 149 CALL DGEEV( 'X', 'N', 0, A, 1, WR, WI, VL, 1, VR, 1, W, 1, 150 $ INFO ) 151 CALL CHKXER( 'DGEEV ', INFOT, NOUT, LERR, OK ) 152 INFOT = 2 153 CALL DGEEV( 'N', 'X', 0, A, 1, WR, WI, VL, 1, VR, 1, W, 1, 154 $ INFO ) 155 CALL CHKXER( 'DGEEV ', INFOT, NOUT, LERR, OK ) 156 INFOT = 3 157 CALL DGEEV( 'N', 'N', -1, A, 1, WR, WI, VL, 1, VR, 1, W, 1, 158 $ INFO ) 159 CALL CHKXER( 'DGEEV ', INFOT, NOUT, LERR, OK ) 160 INFOT = 5 161 CALL DGEEV( 'N', 'N', 2, A, 1, WR, WI, VL, 1, VR, 1, W, 6, 162 $ INFO ) 163 CALL CHKXER( 'DGEEV ', INFOT, NOUT, LERR, OK ) 164 INFOT = 9 165 CALL DGEEV( 'V', 'N', 2, A, 2, WR, WI, VL, 1, VR, 1, W, 8, 166 $ INFO ) 167 CALL CHKXER( 'DGEEV ', INFOT, NOUT, LERR, OK ) 168 INFOT = 11 169 CALL DGEEV( 'N', 'V', 2, A, 2, WR, WI, VL, 1, VR, 1, W, 8, 170 $ INFO ) 171 CALL CHKXER( 'DGEEV ', INFOT, NOUT, LERR, OK ) 172 INFOT = 13 173 CALL DGEEV( 'V', 'V', 1, A, 1, WR, WI, VL, 1, VR, 1, W, 3, 174 $ INFO ) 175 CALL CHKXER( 'DGEEV ', INFOT, NOUT, LERR, OK ) 176 NT = NT + 7 177* 178 ELSE IF( LSAMEN( 2, C2, 'ES' ) ) THEN 179* 180* Test DGEES 181* 182 SRNAMT = 'DGEES ' 183 INFOT = 1 184 CALL DGEES( 'X', 'N', DSLECT, 0, A, 1, SDIM, WR, WI, VL, 1, W, 185 $ 1, B, INFO ) 186 CALL CHKXER( 'DGEES ', INFOT, NOUT, LERR, OK ) 187 INFOT = 2 188 CALL DGEES( 'N', 'X', DSLECT, 0, A, 1, SDIM, WR, WI, VL, 1, W, 189 $ 1, B, INFO ) 190 CALL CHKXER( 'DGEES ', INFOT, NOUT, LERR, OK ) 191 INFOT = 4 192 CALL DGEES( 'N', 'S', DSLECT, -1, A, 1, SDIM, WR, WI, VL, 1, W, 193 $ 1, B, INFO ) 194 CALL CHKXER( 'DGEES ', INFOT, NOUT, LERR, OK ) 195 INFOT = 6 196 CALL DGEES( 'N', 'S', DSLECT, 2, A, 1, SDIM, WR, WI, VL, 1, W, 197 $ 6, B, INFO ) 198 CALL CHKXER( 'DGEES ', INFOT, NOUT, LERR, OK ) 199 INFOT = 11 200 CALL DGEES( 'V', 'S', DSLECT, 2, A, 2, SDIM, WR, WI, VL, 1, W, 201 $ 6, B, INFO ) 202 CALL CHKXER( 'DGEES ', INFOT, NOUT, LERR, OK ) 203 INFOT = 13 204 CALL DGEES( 'N', 'S', DSLECT, 1, A, 1, SDIM, WR, WI, VL, 1, W, 205 $ 2, B, INFO ) 206 CALL CHKXER( 'DGEES ', INFOT, NOUT, LERR, OK ) 207 NT = NT + 6 208* 209 ELSE IF( LSAMEN( 2, C2, 'VX' ) ) THEN 210* 211* Test DGEEVX 212* 213 SRNAMT = 'DGEEVX' 214 INFOT = 1 215 CALL DGEEVX( 'X', 'N', 'N', 'N', 0, A, 1, WR, WI, VL, 1, VR, 1, 216 $ ILO, IHI, S, ABNRM, R1, R2, W, 1, IW, INFO ) 217 CALL CHKXER( 'DGEEVX', INFOT, NOUT, LERR, OK ) 218 INFOT = 2 219 CALL DGEEVX( 'N', 'X', '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 = 3 223 CALL DGEEVX( 'N', 'N', 'X', '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 = 4 227 CALL DGEEVX( 'N', 'N', 'N', 'X', 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 = 5 231 CALL DGEEVX( 'N', 'N', 'N', 'N', -1, A, 1, WR, WI, VL, 1, VR, 232 $ 1, ILO, IHI, S, ABNRM, R1, R2, W, 1, IW, INFO ) 233 CALL CHKXER( 'DGEEVX', INFOT, NOUT, LERR, OK ) 234 INFOT = 7 235 CALL DGEEVX( 'N', 'N', 'N', 'N', 2, A, 1, WR, WI, VL, 1, VR, 1, 236 $ ILO, IHI, S, ABNRM, R1, R2, W, 1, IW, INFO ) 237 CALL CHKXER( 'DGEEVX', INFOT, NOUT, LERR, OK ) 238 INFOT = 11 239 CALL DGEEVX( 'N', 'V', 'N', 'N', 2, A, 2, WR, WI, VL, 1, VR, 1, 240 $ ILO, IHI, S, ABNRM, R1, R2, W, 6, IW, INFO ) 241 CALL CHKXER( 'DGEEVX', INFOT, NOUT, LERR, OK ) 242 INFOT = 13 243 CALL DGEEVX( 'N', 'N', 'V', '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 = 21 247 CALL DGEEVX( 'N', 'N', 'N', 'N', 1, A, 1, WR, WI, VL, 1, VR, 1, 248 $ ILO, IHI, S, ABNRM, R1, R2, W, 1, IW, INFO ) 249 CALL CHKXER( 'DGEEVX', INFOT, NOUT, LERR, OK ) 250 INFOT = 21 251 CALL DGEEVX( 'N', 'V', 'N', 'N', 1, A, 1, WR, WI, VL, 1, VR, 1, 252 $ ILO, IHI, S, ABNRM, R1, R2, W, 2, IW, INFO ) 253 CALL CHKXER( 'DGEEVX', INFOT, NOUT, LERR, OK ) 254 INFOT = 21 255 CALL DGEEVX( 'N', 'N', 'V', 'V', 1, A, 1, WR, WI, VL, 1, VR, 1, 256 $ ILO, IHI, S, ABNRM, R1, R2, W, 3, IW, INFO ) 257 CALL CHKXER( 'DGEEVX', INFOT, NOUT, LERR, OK ) 258 NT = NT + 11 259* 260 ELSE IF( LSAMEN( 2, C2, 'SX' ) ) THEN 261* 262* Test DGEESX 263* 264 SRNAMT = 'DGEESX' 265 INFOT = 1 266 CALL DGEESX( 'X', 'N', DSLECT, 'N', 0, A, 1, SDIM, WR, WI, VL, 267 $ 1, R1( 1 ), R2( 1 ), W, 1, IW, 1, B, INFO ) 268 CALL CHKXER( 'DGEESX', INFOT, NOUT, LERR, OK ) 269 INFOT = 2 270 CALL DGEESX( 'N', 'X', 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 = 4 274 CALL DGEESX( 'N', 'N', DSLECT, 'X', 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 = 5 278 CALL DGEESX( 'N', 'N', DSLECT, 'N', -1, 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 = 7 282 CALL DGEESX( 'N', 'N', DSLECT, 'N', 2, A, 1, SDIM, WR, WI, VL, 283 $ 1, R1( 1 ), R2( 1 ), W, 6, IW, 1, B, INFO ) 284 CALL CHKXER( 'DGEESX', INFOT, NOUT, LERR, OK ) 285 INFOT = 12 286 CALL DGEESX( 'V', 'N', DSLECT, 'N', 2, A, 2, 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 = 16 290 CALL DGEESX( 'N', 'N', DSLECT, 'N', 1, A, 1, SDIM, WR, WI, VL, 291 $ 1, R1( 1 ), R2( 1 ), W, 2, IW, 1, B, INFO ) 292 CALL CHKXER( 'DGEESX', INFOT, NOUT, LERR, OK ) 293 NT = NT + 7 294* 295 ELSE IF( LSAMEN( 2, C2, 'BD' ) ) THEN 296* 297* Test DGESVD 298* 299 SRNAMT = 'DGESVD' 300 INFOT = 1 301 CALL DGESVD( 'X', 'N', 0, 0, A, 1, S, U, 1, VT, 1, W, 1, INFO ) 302 CALL CHKXER( 'DGESVD', INFOT, NOUT, LERR, OK ) 303 INFOT = 2 304 CALL DGESVD( 'N', 'X', 0, 0, A, 1, S, U, 1, VT, 1, W, 1, INFO ) 305 CALL CHKXER( 'DGESVD', INFOT, NOUT, LERR, OK ) 306 INFOT = 2 307 CALL DGESVD( 'O', 'O', 0, 0, A, 1, S, U, 1, VT, 1, W, 1, INFO ) 308 CALL CHKXER( 'DGESVD', INFOT, NOUT, LERR, OK ) 309 INFOT = 3 310 CALL DGESVD( 'N', 'N', -1, 0, A, 1, S, U, 1, VT, 1, W, 1, 311 $ INFO ) 312 CALL CHKXER( 'DGESVD', INFOT, NOUT, LERR, OK ) 313 INFOT = 4 314 CALL DGESVD( 'N', 'N', 0, -1, A, 1, S, U, 1, VT, 1, W, 1, 315 $ INFO ) 316 CALL CHKXER( 'DGESVD', INFOT, NOUT, LERR, OK ) 317 INFOT = 6 318 CALL DGESVD( 'N', 'N', 2, 1, A, 1, S, U, 1, VT, 1, W, 5, INFO ) 319 CALL CHKXER( 'DGESVD', INFOT, NOUT, LERR, OK ) 320 INFOT = 9 321 CALL DGESVD( 'A', 'N', 2, 1, A, 2, S, U, 1, VT, 1, W, 5, INFO ) 322 CALL CHKXER( 'DGESVD', INFOT, NOUT, LERR, OK ) 323 INFOT = 11 324 CALL DGESVD( 'N', 'A', 1, 2, A, 1, S, U, 1, VT, 1, W, 5, INFO ) 325 CALL CHKXER( 'DGESVD', INFOT, NOUT, LERR, OK ) 326 NT = 8 327 IF( OK ) THEN 328 WRITE( NOUT, FMT = 9999 )SRNAMT( 1:LEN_TRIM( SRNAMT ) ), 329 $ NT 330 ELSE 331 WRITE( NOUT, FMT = 9998 ) 332 END IF 333* 334* Test DGESDD 335* 336 SRNAMT = 'DGESDD' 337 INFOT = 1 338 CALL DGESDD( 'X', 0, 0, A, 1, S, U, 1, VT, 1, W, 1, IW, INFO ) 339 CALL CHKXER( 'DGESDD', INFOT, NOUT, LERR, OK ) 340 INFOT = 2 341 CALL DGESDD( 'N', -1, 0, A, 1, S, U, 1, VT, 1, W, 1, IW, INFO ) 342 CALL CHKXER( 'DGESDD', INFOT, NOUT, LERR, OK ) 343 INFOT = 3 344 CALL DGESDD( 'N', 0, -1, A, 1, S, U, 1, VT, 1, W, 1, IW, INFO ) 345 CALL CHKXER( 'DGESDD', INFOT, NOUT, LERR, OK ) 346 INFOT = 5 347 CALL DGESDD( 'N', 2, 1, A, 1, S, U, 1, VT, 1, W, 5, IW, INFO ) 348 CALL CHKXER( 'DGESDD', INFOT, NOUT, LERR, OK ) 349 INFOT = 8 350 CALL DGESDD( 'A', 2, 1, A, 2, S, U, 1, VT, 1, W, 5, IW, INFO ) 351 CALL CHKXER( 'DGESDD', INFOT, NOUT, LERR, OK ) 352 INFOT = 10 353 CALL DGESDD( 'A', 1, 2, A, 1, S, U, 1, VT, 1, W, 5, IW, INFO ) 354 CALL CHKXER( 'DGESDD', INFOT, NOUT, LERR, OK ) 355 NT = 6 356 IF( OK ) THEN 357 WRITE( NOUT, FMT = 9999 )SRNAMT( 1:LEN_TRIM( SRNAMT ) ), 358 $ NT 359 ELSE 360 WRITE( NOUT, FMT = 9998 ) 361 END IF 362* 363* Test DGEJSV 364* 365 SRNAMT = 'DGEJSV' 366 INFOT = 1 367 CALL DGEJSV( 'X', 'U', 'V', 'R', 'N', 'N', 368 $ 0, 0, A, 1, S, U, 1, VT, 1, 369 $ W, 1, IW, INFO) 370 CALL CHKXER( 'DGEJSV', INFOT, NOUT, LERR, OK ) 371 INFOT = 2 372 CALL DGEJSV( 'G', 'X', 'V', 'R', 'N', 'N', 373 $ 0, 0, A, 1, S, U, 1, VT, 1, 374 $ W, 1, IW, INFO) 375 CALL CHKXER( 'DGEJSV', INFOT, NOUT, LERR, OK ) 376 INFOT = 3 377 CALL DGEJSV( 'G', 'U', 'X', 'R', 'N', 'N', 378 $ 0, 0, A, 1, S, U, 1, VT, 1, 379 $ W, 1, IW, INFO) 380 CALL CHKXER( 'DGEJSV', INFOT, NOUT, LERR, OK ) 381 INFOT = 4 382 CALL DGEJSV( 'G', 'U', 'V', 'X', 'N', 'N', 383 $ 0, 0, A, 1, S, U, 1, VT, 1, 384 $ W, 1, IW, INFO) 385 CALL CHKXER( 'DGEJSV', INFOT, NOUT, LERR, OK ) 386 INFOT = 5 387 CALL DGEJSV( 'G', 'U', 'V', 'R', 'X', 'N', 388 $ 0, 0, A, 1, S, U, 1, VT, 1, 389 $ W, 1, IW, INFO) 390 CALL CHKXER( 'DGEJSV', INFOT, NOUT, LERR, OK ) 391 INFOT = 6 392 CALL DGEJSV( 'G', 'U', 'V', 'R', 'N', 'X', 393 $ 0, 0, A, 1, S, U, 1, VT, 1, 394 $ W, 1, IW, INFO) 395 CALL CHKXER( 'DGEJSV', INFOT, NOUT, LERR, OK ) 396 INFOT = 7 397 CALL DGEJSV( 'G', 'U', 'V', 'R', 'N', 'N', 398 $ -1, 0, A, 1, S, U, 1, VT, 1, 399 $ W, 1, IW, INFO) 400 CALL CHKXER( 'DGEJSV', INFOT, NOUT, LERR, OK ) 401 INFOT = 8 402 CALL DGEJSV( 'G', 'U', 'V', 'R', 'N', 'N', 403 $ 0, -1, A, 1, S, U, 1, VT, 1, 404 $ W, 1, IW, INFO) 405 CALL CHKXER( 'DGEJSV', INFOT, NOUT, LERR, OK ) 406 INFOT = 10 407 CALL DGEJSV( 'G', 'U', 'V', 'R', 'N', 'N', 408 $ 2, 1, A, 1, S, U, 1, VT, 1, 409 $ W, 1, IW, INFO) 410 CALL CHKXER( 'DGEJSV', INFOT, NOUT, LERR, OK ) 411 INFOT = 13 412 CALL DGEJSV( 'G', 'U', 'V', 'R', 'N', 'N', 413 $ 2, 2, A, 2, S, U, 1, VT, 2, 414 $ W, 1, IW, INFO) 415 CALL CHKXER( 'DGEJSV', INFOT, NOUT, LERR, OK ) 416 INFOT = 14 417 CALL DGEJSV( 'G', 'U', 'V', 'R', 'N', 'N', 418 $ 2, 2, A, 2, S, U, 2, VT, 1, 419 $ W, 1, IW, INFO) 420 CALL CHKXER( 'DGEJSV', INFOT, NOUT, LERR, OK ) 421 NT = 11 422 IF( OK ) THEN 423 WRITE( NOUT, FMT = 9999 )SRNAMT( 1:LEN_TRIM( SRNAMT ) ), 424 $ NT 425 ELSE 426 WRITE( NOUT, FMT = 9998 ) 427 END IF 428 END IF 429* 430* Print a summary line. 431* 432 IF( .NOT.LSAMEN( 2, C2, 'BD' ) ) THEN 433 IF( OK ) THEN 434 WRITE( NOUT, FMT = 9999 )SRNAMT( 1:LEN_TRIM( SRNAMT ) ), 435 $ NT 436 ELSE 437 WRITE( NOUT, FMT = 9998 ) 438 END IF 439 END IF 440* 441 9999 FORMAT( 1X, A, ' passed the tests of the error exits (', I3, 442 $ ' tests done)' ) 443 9998 FORMAT( ' *** ', A, ' failed the tests of the error exits ***' ) 444 RETURN 445* 446* End of DERRED 447 END 448