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