1*> \brief \b DERRBD 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 DERRBD( 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*> DERRBD tests the error exits for DGEBD2, DGEBRD, DORGBR, DORMBR, 25*> DBDSQR, DBDSDC and DBDSVDX. 26*> \endverbatim 27* 28* Arguments: 29* ========== 30* 31*> \param[in] PATH 32*> \verbatim 33*> PATH is CHARACTER*3 34*> The LAPACK path name for the routines to be tested. 35*> \endverbatim 36*> 37*> \param[in] NUNIT 38*> \verbatim 39*> NUNIT is INTEGER 40*> The unit number for output. 41*> \endverbatim 42* 43* Authors: 44* ======== 45* 46*> \author Univ. of Tennessee 47*> \author Univ. of California Berkeley 48*> \author Univ. of Colorado Denver 49*> \author NAG Ltd. 50* 51*> \ingroup double_eig 52* 53* ===================================================================== 54 SUBROUTINE DERRBD( PATH, NUNIT ) 55* 56* -- LAPACK test routine -- 57* -- LAPACK is a software package provided by Univ. of Tennessee, -- 58* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 59* 60* .. Scalar Arguments .. 61 CHARACTER*3 PATH 62 INTEGER NUNIT 63* .. 64* 65* ===================================================================== 66* 67* .. Parameters .. 68 INTEGER NMAX, LW 69 PARAMETER ( NMAX = 4, LW = NMAX ) 70 DOUBLE PRECISION ZERO, ONE 71 PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 ) 72* .. 73* .. Local Scalars .. 74 CHARACTER*2 C2 75 INTEGER I, INFO, J, NS, NT 76* .. 77* .. Local Arrays .. 78 INTEGER IQ( NMAX, NMAX ), IW( NMAX ) 79 DOUBLE PRECISION A( NMAX, NMAX ), D( NMAX ), E( NMAX ), 80 $ Q( NMAX, NMAX ), S( NMAX ), TP( NMAX ), 81 $ TQ( NMAX ), U( NMAX, NMAX ), 82 $ V( NMAX, NMAX ), W( LW ) 83* .. 84* .. External Functions .. 85 LOGICAL LSAMEN 86 EXTERNAL LSAMEN 87* .. 88* .. External Subroutines .. 89 EXTERNAL CHKXER, DBDSDC, DBDSQR, DBDSVDX, DGEBD2, 90 $ DGEBRD, DORGBR, DORMBR 91* .. 92* .. Scalars in Common .. 93 LOGICAL LERR, OK 94 CHARACTER*32 SRNAMT 95 INTEGER INFOT, NOUT 96* .. 97* .. Common blocks .. 98 COMMON / INFOC / INFOT, NOUT, OK, LERR 99 COMMON / SRNAMC / SRNAMT 100* .. 101* .. Intrinsic Functions .. 102 INTRINSIC DBLE 103* .. 104* .. Executable Statements .. 105* 106 NOUT = NUNIT 107 WRITE( NOUT, FMT = * ) 108 C2 = PATH( 2: 3 ) 109* 110* Set the variables to innocuous values. 111* 112 DO 20 J = 1, NMAX 113 DO 10 I = 1, NMAX 114 A( I, J ) = 1.D0 / DBLE( I+J ) 115 10 CONTINUE 116 20 CONTINUE 117 OK = .TRUE. 118 NT = 0 119* 120* Test error exits of the SVD routines. 121* 122 IF( LSAMEN( 2, C2, 'BD' ) ) THEN 123* 124* DGEBRD 125* 126 SRNAMT = 'DGEBRD' 127 INFOT = 1 128 CALL DGEBRD( -1, 0, A, 1, D, E, TQ, TP, W, 1, INFO ) 129 CALL CHKXER( 'DGEBRD', INFOT, NOUT, LERR, OK ) 130 INFOT = 2 131 CALL DGEBRD( 0, -1, A, 1, D, E, TQ, TP, W, 1, INFO ) 132 CALL CHKXER( 'DGEBRD', INFOT, NOUT, LERR, OK ) 133 INFOT = 4 134 CALL DGEBRD( 2, 1, A, 1, D, E, TQ, TP, W, 2, INFO ) 135 CALL CHKXER( 'DGEBRD', INFOT, NOUT, LERR, OK ) 136 INFOT = 10 137 CALL DGEBRD( 2, 1, A, 2, D, E, TQ, TP, W, 1, INFO ) 138 CALL CHKXER( 'DGEBRD', INFOT, NOUT, LERR, OK ) 139 NT = NT + 4 140* 141* DGEBD2 142* 143 SRNAMT = 'DGEBD2' 144 INFOT = 1 145 CALL DGEBD2( -1, 0, A, 1, D, E, TQ, TP, W, INFO ) 146 CALL CHKXER( 'DGEBD2', INFOT, NOUT, LERR, OK ) 147 INFOT = 2 148 CALL DGEBD2( 0, -1, A, 1, D, E, TQ, TP, W, INFO ) 149 CALL CHKXER( 'DGEBD2', INFOT, NOUT, LERR, OK ) 150 INFOT = 4 151 CALL DGEBD2( 2, 1, A, 1, D, E, TQ, TP, W, INFO ) 152 CALL CHKXER( 'DGEBD2', INFOT, NOUT, LERR, OK ) 153 NT = NT + 3 154* 155* DORGBR 156* 157 SRNAMT = 'DORGBR' 158 INFOT = 1 159 CALL DORGBR( '/', 0, 0, 0, A, 1, TQ, W, 1, INFO ) 160 CALL CHKXER( 'DORGBR', INFOT, NOUT, LERR, OK ) 161 INFOT = 2 162 CALL DORGBR( 'Q', -1, 0, 0, A, 1, TQ, W, 1, INFO ) 163 CALL CHKXER( 'DORGBR', INFOT, NOUT, LERR, OK ) 164 INFOT = 3 165 CALL DORGBR( 'Q', 0, -1, 0, A, 1, TQ, W, 1, INFO ) 166 CALL CHKXER( 'DORGBR', INFOT, NOUT, LERR, OK ) 167 INFOT = 3 168 CALL DORGBR( 'Q', 0, 1, 0, A, 1, TQ, W, 1, INFO ) 169 CALL CHKXER( 'DORGBR', INFOT, NOUT, LERR, OK ) 170 INFOT = 3 171 CALL DORGBR( 'Q', 1, 0, 1, A, 1, TQ, W, 1, INFO ) 172 CALL CHKXER( 'DORGBR', INFOT, NOUT, LERR, OK ) 173 INFOT = 3 174 CALL DORGBR( 'P', 1, 0, 0, A, 1, TQ, W, 1, INFO ) 175 CALL CHKXER( 'DORGBR', INFOT, NOUT, LERR, OK ) 176 INFOT = 3 177 CALL DORGBR( 'P', 0, 1, 1, A, 1, TQ, W, 1, INFO ) 178 CALL CHKXER( 'DORGBR', INFOT, NOUT, LERR, OK ) 179 INFOT = 4 180 CALL DORGBR( 'Q', 0, 0, -1, A, 1, TQ, W, 1, INFO ) 181 CALL CHKXER( 'DORGBR', INFOT, NOUT, LERR, OK ) 182 INFOT = 6 183 CALL DORGBR( 'Q', 2, 1, 1, A, 1, TQ, W, 1, INFO ) 184 CALL CHKXER( 'DORGBR', INFOT, NOUT, LERR, OK ) 185 INFOT = 9 186 CALL DORGBR( 'Q', 2, 2, 1, A, 2, TQ, W, 1, INFO ) 187 CALL CHKXER( 'DORGBR', INFOT, NOUT, LERR, OK ) 188 NT = NT + 10 189* 190* DORMBR 191* 192 SRNAMT = 'DORMBR' 193 INFOT = 1 194 CALL DORMBR( '/', 'L', 'T', 0, 0, 0, A, 1, TQ, U, 1, W, 1, 195 $ INFO ) 196 CALL CHKXER( 'DORMBR', INFOT, NOUT, LERR, OK ) 197 INFOT = 2 198 CALL DORMBR( 'Q', '/', 'T', 0, 0, 0, A, 1, TQ, U, 1, W, 1, 199 $ INFO ) 200 CALL CHKXER( 'DORMBR', INFOT, NOUT, LERR, OK ) 201 INFOT = 3 202 CALL DORMBR( 'Q', 'L', '/', 0, 0, 0, A, 1, TQ, U, 1, W, 1, 203 $ INFO ) 204 CALL CHKXER( 'DORMBR', INFOT, NOUT, LERR, OK ) 205 INFOT = 4 206 CALL DORMBR( 'Q', 'L', 'T', -1, 0, 0, A, 1, TQ, U, 1, W, 1, 207 $ INFO ) 208 CALL CHKXER( 'DORMBR', INFOT, NOUT, LERR, OK ) 209 INFOT = 5 210 CALL DORMBR( 'Q', 'L', 'T', 0, -1, 0, A, 1, TQ, U, 1, W, 1, 211 $ INFO ) 212 CALL CHKXER( 'DORMBR', INFOT, NOUT, LERR, OK ) 213 INFOT = 6 214 CALL DORMBR( 'Q', 'L', 'T', 0, 0, -1, A, 1, TQ, U, 1, W, 1, 215 $ INFO ) 216 CALL CHKXER( 'DORMBR', INFOT, NOUT, LERR, OK ) 217 INFOT = 8 218 CALL DORMBR( 'Q', 'L', 'T', 2, 0, 0, A, 1, TQ, U, 2, W, 1, 219 $ INFO ) 220 CALL CHKXER( 'DORMBR', INFOT, NOUT, LERR, OK ) 221 INFOT = 8 222 CALL DORMBR( 'Q', 'R', 'T', 0, 2, 0, A, 1, TQ, U, 1, W, 1, 223 $ INFO ) 224 CALL CHKXER( 'DORMBR', INFOT, NOUT, LERR, OK ) 225 INFOT = 8 226 CALL DORMBR( 'P', 'L', 'T', 2, 0, 2, A, 1, TQ, U, 2, W, 1, 227 $ INFO ) 228 CALL CHKXER( 'DORMBR', INFOT, NOUT, LERR, OK ) 229 INFOT = 8 230 CALL DORMBR( 'P', 'R', 'T', 0, 2, 2, A, 1, TQ, U, 1, W, 1, 231 $ INFO ) 232 CALL CHKXER( 'DORMBR', INFOT, NOUT, LERR, OK ) 233 INFOT = 11 234 CALL DORMBR( 'Q', 'R', 'T', 2, 0, 0, A, 1, TQ, U, 1, W, 1, 235 $ INFO ) 236 CALL CHKXER( 'DORMBR', INFOT, NOUT, LERR, OK ) 237 INFOT = 13 238 CALL DORMBR( 'Q', 'L', 'T', 0, 2, 0, A, 1, TQ, U, 1, W, 1, 239 $ INFO ) 240 CALL CHKXER( 'DORMBR', INFOT, NOUT, LERR, OK ) 241 INFOT = 13 242 CALL DORMBR( 'Q', 'R', 'T', 2, 0, 0, A, 1, TQ, U, 2, W, 1, 243 $ INFO ) 244 CALL CHKXER( 'DORMBR', INFOT, NOUT, LERR, OK ) 245 NT = NT + 13 246* 247* DBDSQR 248* 249 SRNAMT = 'DBDSQR' 250 INFOT = 1 251 CALL DBDSQR( '/', 0, 0, 0, 0, D, E, V, 1, U, 1, A, 1, W, INFO ) 252 CALL CHKXER( 'DBDSQR', INFOT, NOUT, LERR, OK ) 253 INFOT = 2 254 CALL DBDSQR( 'U', -1, 0, 0, 0, D, E, V, 1, U, 1, A, 1, W, 255 $ INFO ) 256 CALL CHKXER( 'DBDSQR', INFOT, NOUT, LERR, OK ) 257 INFOT = 3 258 CALL DBDSQR( 'U', 0, -1, 0, 0, D, E, V, 1, U, 1, A, 1, W, 259 $ INFO ) 260 CALL CHKXER( 'DBDSQR', INFOT, NOUT, LERR, OK ) 261 INFOT = 4 262 CALL DBDSQR( 'U', 0, 0, -1, 0, D, E, V, 1, U, 1, A, 1, W, 263 $ INFO ) 264 CALL CHKXER( 'DBDSQR', INFOT, NOUT, LERR, OK ) 265 INFOT = 5 266 CALL DBDSQR( 'U', 0, 0, 0, -1, D, E, V, 1, U, 1, A, 1, W, 267 $ INFO ) 268 CALL CHKXER( 'DBDSQR', INFOT, NOUT, LERR, OK ) 269 INFOT = 9 270 CALL DBDSQR( 'U', 2, 1, 0, 0, D, E, V, 1, U, 1, A, 1, W, INFO ) 271 CALL CHKXER( 'DBDSQR', INFOT, NOUT, LERR, OK ) 272 INFOT = 11 273 CALL DBDSQR( 'U', 0, 0, 2, 0, D, E, V, 1, U, 1, A, 1, W, INFO ) 274 CALL CHKXER( 'DBDSQR', INFOT, NOUT, LERR, OK ) 275 INFOT = 13 276 CALL DBDSQR( 'U', 2, 0, 0, 1, D, E, V, 1, U, 1, A, 1, W, INFO ) 277 CALL CHKXER( 'DBDSQR', INFOT, NOUT, LERR, OK ) 278 NT = NT + 8 279* 280* DBDSDC 281* 282 SRNAMT = 'DBDSDC' 283 INFOT = 1 284 CALL DBDSDC( '/', 'N', 0, D, E, U, 1, V, 1, Q, IQ, W, IW, 285 $ INFO ) 286 CALL CHKXER( 'DBDSDC', INFOT, NOUT, LERR, OK ) 287 INFOT = 2 288 CALL DBDSDC( 'U', '/', 0, D, E, U, 1, V, 1, Q, IQ, W, IW, 289 $ INFO ) 290 CALL CHKXER( 'DBDSDC', INFOT, NOUT, LERR, OK ) 291 INFOT = 3 292 CALL DBDSDC( 'U', 'N', -1, D, E, U, 1, V, 1, Q, IQ, W, IW, 293 $ INFO ) 294 CALL CHKXER( 'DBDSDC', INFOT, NOUT, LERR, OK ) 295 INFOT = 7 296 CALL DBDSDC( 'U', 'I', 2, D, E, U, 1, V, 1, Q, IQ, W, IW, 297 $ INFO ) 298 CALL CHKXER( 'DBDSDC', INFOT, NOUT, LERR, OK ) 299 INFOT = 9 300 CALL DBDSDC( 'U', 'I', 2, D, E, U, 2, V, 1, Q, IQ, W, IW, 301 $ INFO ) 302 CALL CHKXER( 'DBDSDC', INFOT, NOUT, LERR, OK ) 303 NT = NT + 5 304* 305* DBDSVDX 306* 307 SRNAMT = 'DBDSVDX' 308 INFOT = 1 309 CALL DBDSVDX( 'X', 'N', 'A', 1, D, E, ZERO, ONE, 0, 0, 310 $ NS, S, Q, 1, W, IW, INFO) 311 CALL CHKXER( 'DBDSVDX', INFOT, NOUT, LERR, OK ) 312 INFOT = 2 313 CALL DBDSVDX( 'U', 'X', 'A', 1, D, E, ZERO, ONE, 0, 0, 314 $ NS, S, Q, 1, W, IW, INFO) 315 CALL CHKXER( 'DBDSVDX', INFOT, NOUT, LERR, OK ) 316 INFOT = 3 317 CALL DBDSVDX( 'U', 'V', 'X', 1, D, E, ZERO, ONE, 0, 0, 318 $ NS, S, Q, 1, W, IW, INFO) 319 CALL CHKXER( 'DBDSVDX', INFOT, NOUT, LERR, OK ) 320 INFOT = 4 321 CALL DBDSVDX( 'U', 'V', 'A', -1, D, E, ZERO, ONE, 0, 0, 322 $ NS, S, Q, 1, W, IW, INFO) 323 CALL CHKXER( 'DBDSVDX', INFOT, NOUT, LERR, OK ) 324 INFOT = 7 325 CALL DBDSVDX( 'U', 'V', 'V', 2, D, E, -ONE, ZERO, 0, 0, 326 $ NS, S, Q, 1, W, IW, INFO) 327 CALL CHKXER( 'DBDSVDX', INFOT, NOUT, LERR, OK ) 328 INFOT = 8 329 CALL DBDSVDX( 'U', 'V', 'V', 2, D, E, ONE, ZERO, 0, 0, 330 $ NS, S, Q, 1, W, IW, INFO) 331 CALL CHKXER( 'DBDSVDX', INFOT, NOUT, LERR, OK ) 332 INFOT = 9 333 CALL DBDSVDX( 'L', 'V', 'I', 2, D, E, ZERO, ZERO, 0, 2, 334 $ NS, S, Q, 1, W, IW, INFO) 335 CALL CHKXER( 'DBDSVDX', INFOT, NOUT, LERR, OK ) 336 INFOT = 9 337 CALL DBDSVDX( 'L', 'V', 'I', 4, D, E, ZERO, ZERO, 5, 2, 338 $ NS, S, Q, 1, W, IW, INFO) 339 CALL CHKXER( 'DBDSVDX', INFOT, NOUT, LERR, OK ) 340 INFOT = 10 341 CALL DBDSVDX( 'L', 'V', 'I', 4, D, E, ZERO, ZERO, 3, 2, 342 $ NS, S, Q, 1, W, IW, INFO) 343 CALL CHKXER( 'DBDSVDX', INFOT, NOUT, LERR, OK ) 344 INFOT = 10 345 CALL DBDSVDX( 'L', 'V', 'I', 4, D, E, ZERO, ZERO, 3, 5, 346 $ NS, S, Q, 1, W, IW, INFO) 347 CALL CHKXER( 'DBDSVDX', INFOT, NOUT, LERR, OK ) 348 INFOT = 14 349 CALL DBDSVDX( 'L', 'V', 'A', 4, D, E, ZERO, ZERO, 0, 0, 350 $ NS, S, Q, 0, W, IW, INFO) 351 CALL CHKXER( 'DBDSVDX', INFOT, NOUT, LERR, OK ) 352 INFOT = 14 353 CALL DBDSVDX( 'L', 'V', 'A', 4, D, E, ZERO, ZERO, 0, 0, 354 $ NS, S, Q, 2, W, IW, INFO) 355 CALL CHKXER( 'DBDSVDX', INFOT, NOUT, LERR, OK ) 356 NT = NT + 12 357 END IF 358* 359* Print a summary line. 360* 361 IF( OK ) THEN 362 WRITE( NOUT, FMT = 9999 )PATH, NT 363 ELSE 364 WRITE( NOUT, FMT = 9998 )PATH 365 END IF 366* 367 9999 FORMAT( 1X, A3, ' routines passed the tests of the error exits', 368 $ ' (', I3, ' tests done)' ) 369 9998 FORMAT( ' *** ', A3, ' routines failed the tests of the error ', 370 $ 'exits ***' ) 371* 372 RETURN 373* 374* End of DERRBD 375* 376 END 377