![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b DERRBD 00002 * 00003 * =========== DOCUMENTATION =========== 00004 * 00005 * Online html documentation available at 00006 * http://www.netlib.org/lapack/explore-html/ 00007 * 00008 * Definition: 00009 * =========== 00010 * 00011 * SUBROUTINE DERRBD( PATH, NUNIT ) 00012 * 00013 * .. Scalar Arguments .. 00014 * CHARACTER*3 PATH 00015 * INTEGER NUNIT 00016 * .. 00017 * 00018 * 00019 *> \par Purpose: 00020 * ============= 00021 *> 00022 *> \verbatim 00023 *> 00024 *> DERRBD tests the error exits for DGEBRD, DORGBR, DORMBR, DBDSQR and 00025 *> DBDSDC. 00026 *> \endverbatim 00027 * 00028 * Arguments: 00029 * ========== 00030 * 00031 *> \param[in] PATH 00032 *> \verbatim 00033 *> PATH is CHARACTER*3 00034 *> The LAPACK path name for the routines to be tested. 00035 *> \endverbatim 00036 *> 00037 *> \param[in] NUNIT 00038 *> \verbatim 00039 *> NUNIT is INTEGER 00040 *> The unit number for output. 00041 *> \endverbatim 00042 * 00043 * Authors: 00044 * ======== 00045 * 00046 *> \author Univ. of Tennessee 00047 *> \author Univ. of California Berkeley 00048 *> \author Univ. of Colorado Denver 00049 *> \author NAG Ltd. 00050 * 00051 *> \date November 2011 00052 * 00053 *> \ingroup double_eig 00054 * 00055 * ===================================================================== 00056 SUBROUTINE DERRBD( PATH, NUNIT ) 00057 * 00058 * -- LAPACK test routine (version 3.4.0) -- 00059 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00060 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00061 * November 2011 00062 * 00063 * .. Scalar Arguments .. 00064 CHARACTER*3 PATH 00065 INTEGER NUNIT 00066 * .. 00067 * 00068 * ===================================================================== 00069 * 00070 * .. Parameters .. 00071 INTEGER NMAX, LW 00072 PARAMETER ( NMAX = 4, LW = NMAX ) 00073 * .. 00074 * .. Local Scalars .. 00075 CHARACTER*2 C2 00076 INTEGER I, INFO, J, NT 00077 * .. 00078 * .. Local Arrays .. 00079 INTEGER IQ( NMAX, NMAX ), IW( NMAX ) 00080 DOUBLE PRECISION A( NMAX, NMAX ), D( NMAX ), E( NMAX ), 00081 $ Q( NMAX, NMAX ), TP( NMAX ), TQ( NMAX ), 00082 $ U( NMAX, NMAX ), V( NMAX, NMAX ), W( LW ) 00083 * .. 00084 * .. External Functions .. 00085 LOGICAL LSAMEN 00086 EXTERNAL LSAMEN 00087 * .. 00088 * .. External Subroutines .. 00089 EXTERNAL CHKXER, DBDSDC, DBDSQR, DGEBD2, DGEBRD, DORGBR, 00090 $ DORMBR 00091 * .. 00092 * .. Scalars in Common .. 00093 LOGICAL LERR, OK 00094 CHARACTER*32 SRNAMT 00095 INTEGER INFOT, NOUT 00096 * .. 00097 * .. Common blocks .. 00098 COMMON / INFOC / INFOT, NOUT, OK, LERR 00099 COMMON / SRNAMC / SRNAMT 00100 * .. 00101 * .. Intrinsic Functions .. 00102 INTRINSIC DBLE 00103 * .. 00104 * .. Executable Statements .. 00105 * 00106 NOUT = NUNIT 00107 WRITE( NOUT, FMT = * ) 00108 C2 = PATH( 2: 3 ) 00109 * 00110 * Set the variables to innocuous values. 00111 * 00112 DO 20 J = 1, NMAX 00113 DO 10 I = 1, NMAX 00114 A( I, J ) = 1.D0 / DBLE( I+J ) 00115 10 CONTINUE 00116 20 CONTINUE 00117 OK = .TRUE. 00118 NT = 0 00119 * 00120 * Test error exits of the SVD routines. 00121 * 00122 IF( LSAMEN( 2, C2, 'BD' ) ) THEN 00123 * 00124 * DGEBRD 00125 * 00126 SRNAMT = 'DGEBRD' 00127 INFOT = 1 00128 CALL DGEBRD( -1, 0, A, 1, D, E, TQ, TP, W, 1, INFO ) 00129 CALL CHKXER( 'DGEBRD', INFOT, NOUT, LERR, OK ) 00130 INFOT = 2 00131 CALL DGEBRD( 0, -1, A, 1, D, E, TQ, TP, W, 1, INFO ) 00132 CALL CHKXER( 'DGEBRD', INFOT, NOUT, LERR, OK ) 00133 INFOT = 4 00134 CALL DGEBRD( 2, 1, A, 1, D, E, TQ, TP, W, 2, INFO ) 00135 CALL CHKXER( 'DGEBRD', INFOT, NOUT, LERR, OK ) 00136 INFOT = 10 00137 CALL DGEBRD( 2, 1, A, 2, D, E, TQ, TP, W, 1, INFO ) 00138 CALL CHKXER( 'DGEBRD', INFOT, NOUT, LERR, OK ) 00139 NT = NT + 4 00140 * 00141 * DGEBD2 00142 * 00143 SRNAMT = 'DGEBD2' 00144 INFOT = 1 00145 CALL DGEBD2( -1, 0, A, 1, D, E, TQ, TP, W, INFO ) 00146 CALL CHKXER( 'DGEBD2', INFOT, NOUT, LERR, OK ) 00147 INFOT = 2 00148 CALL DGEBD2( 0, -1, A, 1, D, E, TQ, TP, W, INFO ) 00149 CALL CHKXER( 'DGEBD2', INFOT, NOUT, LERR, OK ) 00150 INFOT = 4 00151 CALL DGEBD2( 2, 1, A, 1, D, E, TQ, TP, W, INFO ) 00152 CALL CHKXER( 'DGEBD2', INFOT, NOUT, LERR, OK ) 00153 NT = NT + 3 00154 * 00155 * DORGBR 00156 * 00157 SRNAMT = 'DORGBR' 00158 INFOT = 1 00159 CALL DORGBR( '/', 0, 0, 0, A, 1, TQ, W, 1, INFO ) 00160 CALL CHKXER( 'DORGBR', INFOT, NOUT, LERR, OK ) 00161 INFOT = 2 00162 CALL DORGBR( 'Q', -1, 0, 0, A, 1, TQ, W, 1, INFO ) 00163 CALL CHKXER( 'DORGBR', INFOT, NOUT, LERR, OK ) 00164 INFOT = 3 00165 CALL DORGBR( 'Q', 0, -1, 0, A, 1, TQ, W, 1, INFO ) 00166 CALL CHKXER( 'DORGBR', INFOT, NOUT, LERR, OK ) 00167 INFOT = 3 00168 CALL DORGBR( 'Q', 0, 1, 0, A, 1, TQ, W, 1, INFO ) 00169 CALL CHKXER( 'DORGBR', INFOT, NOUT, LERR, OK ) 00170 INFOT = 3 00171 CALL DORGBR( 'Q', 1, 0, 1, A, 1, TQ, W, 1, INFO ) 00172 CALL CHKXER( 'DORGBR', INFOT, NOUT, LERR, OK ) 00173 INFOT = 3 00174 CALL DORGBR( 'P', 1, 0, 0, A, 1, TQ, W, 1, INFO ) 00175 CALL CHKXER( 'DORGBR', INFOT, NOUT, LERR, OK ) 00176 INFOT = 3 00177 CALL DORGBR( 'P', 0, 1, 1, A, 1, TQ, W, 1, INFO ) 00178 CALL CHKXER( 'DORGBR', INFOT, NOUT, LERR, OK ) 00179 INFOT = 4 00180 CALL DORGBR( 'Q', 0, 0, -1, A, 1, TQ, W, 1, INFO ) 00181 CALL CHKXER( 'DORGBR', INFOT, NOUT, LERR, OK ) 00182 INFOT = 6 00183 CALL DORGBR( 'Q', 2, 1, 1, A, 1, TQ, W, 1, INFO ) 00184 CALL CHKXER( 'DORGBR', INFOT, NOUT, LERR, OK ) 00185 INFOT = 9 00186 CALL DORGBR( 'Q', 2, 2, 1, A, 2, TQ, W, 1, INFO ) 00187 CALL CHKXER( 'DORGBR', INFOT, NOUT, LERR, OK ) 00188 NT = NT + 10 00189 * 00190 * DORMBR 00191 * 00192 SRNAMT = 'DORMBR' 00193 INFOT = 1 00194 CALL DORMBR( '/', 'L', 'T', 0, 0, 0, A, 1, TQ, U, 1, W, 1, 00195 $ INFO ) 00196 CALL CHKXER( 'DORMBR', INFOT, NOUT, LERR, OK ) 00197 INFOT = 2 00198 CALL DORMBR( 'Q', '/', 'T', 0, 0, 0, A, 1, TQ, U, 1, W, 1, 00199 $ INFO ) 00200 CALL CHKXER( 'DORMBR', INFOT, NOUT, LERR, OK ) 00201 INFOT = 3 00202 CALL DORMBR( 'Q', 'L', '/', 0, 0, 0, A, 1, TQ, U, 1, W, 1, 00203 $ INFO ) 00204 CALL CHKXER( 'DORMBR', INFOT, NOUT, LERR, OK ) 00205 INFOT = 4 00206 CALL DORMBR( 'Q', 'L', 'T', -1, 0, 0, A, 1, TQ, U, 1, W, 1, 00207 $ INFO ) 00208 CALL CHKXER( 'DORMBR', INFOT, NOUT, LERR, OK ) 00209 INFOT = 5 00210 CALL DORMBR( 'Q', 'L', 'T', 0, -1, 0, A, 1, TQ, U, 1, W, 1, 00211 $ INFO ) 00212 CALL CHKXER( 'DORMBR', INFOT, NOUT, LERR, OK ) 00213 INFOT = 6 00214 CALL DORMBR( 'Q', 'L', 'T', 0, 0, -1, A, 1, TQ, U, 1, W, 1, 00215 $ INFO ) 00216 CALL CHKXER( 'DORMBR', INFOT, NOUT, LERR, OK ) 00217 INFOT = 8 00218 CALL DORMBR( 'Q', 'L', 'T', 2, 0, 0, A, 1, TQ, U, 2, W, 1, 00219 $ INFO ) 00220 CALL CHKXER( 'DORMBR', INFOT, NOUT, LERR, OK ) 00221 INFOT = 8 00222 CALL DORMBR( 'Q', 'R', 'T', 0, 2, 0, A, 1, TQ, U, 1, W, 1, 00223 $ INFO ) 00224 CALL CHKXER( 'DORMBR', INFOT, NOUT, LERR, OK ) 00225 INFOT = 8 00226 CALL DORMBR( 'P', 'L', 'T', 2, 0, 2, A, 1, TQ, U, 2, W, 1, 00227 $ INFO ) 00228 CALL CHKXER( 'DORMBR', INFOT, NOUT, LERR, OK ) 00229 INFOT = 8 00230 CALL DORMBR( 'P', 'R', 'T', 0, 2, 2, A, 1, TQ, U, 1, W, 1, 00231 $ INFO ) 00232 CALL CHKXER( 'DORMBR', INFOT, NOUT, LERR, OK ) 00233 INFOT = 11 00234 CALL DORMBR( 'Q', 'R', 'T', 2, 0, 0, A, 1, TQ, U, 1, W, 1, 00235 $ INFO ) 00236 CALL CHKXER( 'DORMBR', INFOT, NOUT, LERR, OK ) 00237 INFOT = 13 00238 CALL DORMBR( 'Q', 'L', 'T', 0, 2, 0, A, 1, TQ, U, 1, W, 1, 00239 $ INFO ) 00240 CALL CHKXER( 'DORMBR', INFOT, NOUT, LERR, OK ) 00241 INFOT = 13 00242 CALL DORMBR( 'Q', 'R', 'T', 2, 0, 0, A, 1, TQ, U, 2, W, 1, 00243 $ INFO ) 00244 CALL CHKXER( 'DORMBR', INFOT, NOUT, LERR, OK ) 00245 NT = NT + 13 00246 * 00247 * DBDSQR 00248 * 00249 SRNAMT = 'DBDSQR' 00250 INFOT = 1 00251 CALL DBDSQR( '/', 0, 0, 0, 0, D, E, V, 1, U, 1, A, 1, W, INFO ) 00252 CALL CHKXER( 'DBDSQR', INFOT, NOUT, LERR, OK ) 00253 INFOT = 2 00254 CALL DBDSQR( 'U', -1, 0, 0, 0, D, E, V, 1, U, 1, A, 1, W, 00255 $ INFO ) 00256 CALL CHKXER( 'DBDSQR', INFOT, NOUT, LERR, OK ) 00257 INFOT = 3 00258 CALL DBDSQR( 'U', 0, -1, 0, 0, D, E, V, 1, U, 1, A, 1, W, 00259 $ INFO ) 00260 CALL CHKXER( 'DBDSQR', INFOT, NOUT, LERR, OK ) 00261 INFOT = 4 00262 CALL DBDSQR( 'U', 0, 0, -1, 0, D, E, V, 1, U, 1, A, 1, W, 00263 $ INFO ) 00264 CALL CHKXER( 'DBDSQR', INFOT, NOUT, LERR, OK ) 00265 INFOT = 5 00266 CALL DBDSQR( 'U', 0, 0, 0, -1, D, E, V, 1, U, 1, A, 1, W, 00267 $ INFO ) 00268 CALL CHKXER( 'DBDSQR', INFOT, NOUT, LERR, OK ) 00269 INFOT = 9 00270 CALL DBDSQR( 'U', 2, 1, 0, 0, D, E, V, 1, U, 1, A, 1, W, INFO ) 00271 CALL CHKXER( 'DBDSQR', INFOT, NOUT, LERR, OK ) 00272 INFOT = 11 00273 CALL DBDSQR( 'U', 0, 0, 2, 0, D, E, V, 1, U, 1, A, 1, W, INFO ) 00274 CALL CHKXER( 'DBDSQR', INFOT, NOUT, LERR, OK ) 00275 INFOT = 13 00276 CALL DBDSQR( 'U', 2, 0, 0, 1, D, E, V, 1, U, 1, A, 1, W, INFO ) 00277 CALL CHKXER( 'DBDSQR', INFOT, NOUT, LERR, OK ) 00278 NT = NT + 8 00279 * 00280 * DBDSDC 00281 * 00282 SRNAMT = 'DBDSDC' 00283 INFOT = 1 00284 CALL DBDSDC( '/', 'N', 0, D, E, U, 1, V, 1, Q, IQ, W, IW, 00285 $ INFO ) 00286 CALL CHKXER( 'DBDSDC', INFOT, NOUT, LERR, OK ) 00287 INFOT = 2 00288 CALL DBDSDC( 'U', '/', 0, D, E, U, 1, V, 1, Q, IQ, W, IW, 00289 $ INFO ) 00290 CALL CHKXER( 'DBDSDC', INFOT, NOUT, LERR, OK ) 00291 INFOT = 3 00292 CALL DBDSDC( 'U', 'N', -1, D, E, U, 1, V, 1, Q, IQ, W, IW, 00293 $ INFO ) 00294 CALL CHKXER( 'DBDSDC', INFOT, NOUT, LERR, OK ) 00295 INFOT = 7 00296 CALL DBDSDC( 'U', 'I', 2, D, E, U, 1, V, 1, Q, IQ, W, IW, 00297 $ INFO ) 00298 CALL CHKXER( 'DBDSDC', INFOT, NOUT, LERR, OK ) 00299 INFOT = 9 00300 CALL DBDSDC( 'U', 'I', 2, D, E, U, 2, V, 1, Q, IQ, W, IW, 00301 $ INFO ) 00302 CALL CHKXER( 'DBDSDC', INFOT, NOUT, LERR, OK ) 00303 NT = NT + 5 00304 END IF 00305 * 00306 * Print a summary line. 00307 * 00308 IF( OK ) THEN 00309 WRITE( NOUT, FMT = 9999 )PATH, NT 00310 ELSE 00311 WRITE( NOUT, FMT = 9998 )PATH 00312 END IF 00313 * 00314 9999 FORMAT( 1X, A3, ' routines passed the tests of the error exits', 00315 $ ' (', I3, ' tests done)' ) 00316 9998 FORMAT( ' *** ', A3, ' routines failed the tests of the error ', 00317 $ 'exits ***' ) 00318 * 00319 RETURN 00320 * 00321 * End of DERRBD 00322 * 00323 END