|
LAPACK 3.3.0
|
|
LAPACK 3.3.0
|
00001 SUBROUTINE SERRBD( 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 * SERRBD tests the error exits for SGEBRD, SORGBR, SORMBR, SBDSQR and 00016 * SBDSDC. 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 REAL 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, SBDSDC, SBDSQR, SGEBD2, SGEBRD, SORGBR, 00049 $ SORMBR 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 REAL 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. / REAL( 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 * SGEBRD 00084 * 00085 SRNAMT = 'SGEBRD' 00086 INFOT = 1 00087 CALL SGEBRD( -1, 0, A, 1, D, E, TQ, TP, W, 1, INFO ) 00088 CALL CHKXER( 'SGEBRD', INFOT, NOUT, LERR, OK ) 00089 INFOT = 2 00090 CALL SGEBRD( 0, -1, A, 1, D, E, TQ, TP, W, 1, INFO ) 00091 CALL CHKXER( 'SGEBRD', INFOT, NOUT, LERR, OK ) 00092 INFOT = 4 00093 CALL SGEBRD( 2, 1, A, 1, D, E, TQ, TP, W, 2, INFO ) 00094 CALL CHKXER( 'SGEBRD', INFOT, NOUT, LERR, OK ) 00095 INFOT = 10 00096 CALL SGEBRD( 2, 1, A, 2, D, E, TQ, TP, W, 1, INFO ) 00097 CALL CHKXER( 'SGEBRD', INFOT, NOUT, LERR, OK ) 00098 NT = NT + 4 00099 * 00100 * SGEBD2 00101 * 00102 SRNAMT = 'SGEBD2' 00103 INFOT = 1 00104 CALL SGEBD2( -1, 0, A, 1, D, E, TQ, TP, W, INFO ) 00105 CALL CHKXER( 'SGEBD2', INFOT, NOUT, LERR, OK ) 00106 INFOT = 2 00107 CALL SGEBD2( 0, -1, A, 1, D, E, TQ, TP, W, INFO ) 00108 CALL CHKXER( 'SGEBD2', INFOT, NOUT, LERR, OK ) 00109 INFOT = 4 00110 CALL SGEBD2( 2, 1, A, 1, D, E, TQ, TP, W, INFO ) 00111 CALL CHKXER( 'SGEBD2', INFOT, NOUT, LERR, OK ) 00112 NT = NT + 3 00113 * 00114 * SORGBR 00115 * 00116 SRNAMT = 'SORGBR' 00117 INFOT = 1 00118 CALL SORGBR( '/', 0, 0, 0, A, 1, TQ, W, 1, INFO ) 00119 CALL CHKXER( 'SORGBR', INFOT, NOUT, LERR, OK ) 00120 INFOT = 2 00121 CALL SORGBR( 'Q', -1, 0, 0, A, 1, TQ, W, 1, INFO ) 00122 CALL CHKXER( 'SORGBR', INFOT, NOUT, LERR, OK ) 00123 INFOT = 3 00124 CALL SORGBR( 'Q', 0, -1, 0, A, 1, TQ, W, 1, INFO ) 00125 CALL CHKXER( 'SORGBR', INFOT, NOUT, LERR, OK ) 00126 INFOT = 3 00127 CALL SORGBR( 'Q', 0, 1, 0, A, 1, TQ, W, 1, INFO ) 00128 CALL CHKXER( 'SORGBR', INFOT, NOUT, LERR, OK ) 00129 INFOT = 3 00130 CALL SORGBR( 'Q', 1, 0, 1, A, 1, TQ, W, 1, INFO ) 00131 CALL CHKXER( 'SORGBR', INFOT, NOUT, LERR, OK ) 00132 INFOT = 3 00133 CALL SORGBR( 'P', 1, 0, 0, A, 1, TQ, W, 1, INFO ) 00134 CALL CHKXER( 'SORGBR', INFOT, NOUT, LERR, OK ) 00135 INFOT = 3 00136 CALL SORGBR( 'P', 0, 1, 1, A, 1, TQ, W, 1, INFO ) 00137 CALL CHKXER( 'SORGBR', INFOT, NOUT, LERR, OK ) 00138 INFOT = 4 00139 CALL SORGBR( 'Q', 0, 0, -1, A, 1, TQ, W, 1, INFO ) 00140 CALL CHKXER( 'SORGBR', INFOT, NOUT, LERR, OK ) 00141 INFOT = 6 00142 CALL SORGBR( 'Q', 2, 1, 1, A, 1, TQ, W, 1, INFO ) 00143 CALL CHKXER( 'SORGBR', INFOT, NOUT, LERR, OK ) 00144 INFOT = 9 00145 CALL SORGBR( 'Q', 2, 2, 1, A, 2, TQ, W, 1, INFO ) 00146 CALL CHKXER( 'SORGBR', INFOT, NOUT, LERR, OK ) 00147 NT = NT + 10 00148 * 00149 * SORMBR 00150 * 00151 SRNAMT = 'SORMBR' 00152 INFOT = 1 00153 CALL SORMBR( '/', 'L', 'T', 0, 0, 0, A, 1, TQ, U, 1, W, 1, 00154 $ INFO ) 00155 CALL CHKXER( 'SORMBR', INFOT, NOUT, LERR, OK ) 00156 INFOT = 2 00157 CALL SORMBR( 'Q', '/', 'T', 0, 0, 0, A, 1, TQ, U, 1, W, 1, 00158 $ INFO ) 00159 CALL CHKXER( 'SORMBR', INFOT, NOUT, LERR, OK ) 00160 INFOT = 3 00161 CALL SORMBR( 'Q', 'L', '/', 0, 0, 0, A, 1, TQ, U, 1, W, 1, 00162 $ INFO ) 00163 CALL CHKXER( 'SORMBR', INFOT, NOUT, LERR, OK ) 00164 INFOT = 4 00165 CALL SORMBR( 'Q', 'L', 'T', -1, 0, 0, A, 1, TQ, U, 1, W, 1, 00166 $ INFO ) 00167 CALL CHKXER( 'SORMBR', INFOT, NOUT, LERR, OK ) 00168 INFOT = 5 00169 CALL SORMBR( 'Q', 'L', 'T', 0, -1, 0, A, 1, TQ, U, 1, W, 1, 00170 $ INFO ) 00171 CALL CHKXER( 'SORMBR', INFOT, NOUT, LERR, OK ) 00172 INFOT = 6 00173 CALL SORMBR( 'Q', 'L', 'T', 0, 0, -1, A, 1, TQ, U, 1, W, 1, 00174 $ INFO ) 00175 CALL CHKXER( 'SORMBR', INFOT, NOUT, LERR, OK ) 00176 INFOT = 8 00177 CALL SORMBR( 'Q', 'L', 'T', 2, 0, 0, A, 1, TQ, U, 2, W, 1, 00178 $ INFO ) 00179 CALL CHKXER( 'SORMBR', INFOT, NOUT, LERR, OK ) 00180 INFOT = 8 00181 CALL SORMBR( 'Q', 'R', 'T', 0, 2, 0, A, 1, TQ, U, 1, W, 1, 00182 $ INFO ) 00183 CALL CHKXER( 'SORMBR', INFOT, NOUT, LERR, OK ) 00184 INFOT = 8 00185 CALL SORMBR( 'P', 'L', 'T', 2, 0, 2, A, 1, TQ, U, 2, W, 1, 00186 $ INFO ) 00187 CALL CHKXER( 'SORMBR', INFOT, NOUT, LERR, OK ) 00188 INFOT = 8 00189 CALL SORMBR( 'P', 'R', 'T', 0, 2, 2, A, 1, TQ, U, 1, W, 1, 00190 $ INFO ) 00191 CALL CHKXER( 'SORMBR', INFOT, NOUT, LERR, OK ) 00192 INFOT = 11 00193 CALL SORMBR( 'Q', 'R', 'T', 2, 0, 0, A, 1, TQ, U, 1, W, 1, 00194 $ INFO ) 00195 CALL CHKXER( 'SORMBR', INFOT, NOUT, LERR, OK ) 00196 INFOT = 13 00197 CALL SORMBR( 'Q', 'L', 'T', 0, 2, 0, A, 1, TQ, U, 1, W, 1, 00198 $ INFO ) 00199 CALL CHKXER( 'SORMBR', INFOT, NOUT, LERR, OK ) 00200 INFOT = 13 00201 CALL SORMBR( 'Q', 'R', 'T', 2, 0, 0, A, 1, TQ, U, 2, W, 1, 00202 $ INFO ) 00203 CALL CHKXER( 'SORMBR', INFOT, NOUT, LERR, OK ) 00204 NT = NT + 13 00205 * 00206 * SBDSQR 00207 * 00208 SRNAMT = 'SBDSQR' 00209 INFOT = 1 00210 CALL SBDSQR( '/', 0, 0, 0, 0, D, E, V, 1, U, 1, A, 1, W, INFO ) 00211 CALL CHKXER( 'SBDSQR', INFOT, NOUT, LERR, OK ) 00212 INFOT = 2 00213 CALL SBDSQR( 'U', -1, 0, 0, 0, D, E, V, 1, U, 1, A, 1, W, 00214 $ INFO ) 00215 CALL CHKXER( 'SBDSQR', INFOT, NOUT, LERR, OK ) 00216 INFOT = 3 00217 CALL SBDSQR( 'U', 0, -1, 0, 0, D, E, V, 1, U, 1, A, 1, W, 00218 $ INFO ) 00219 CALL CHKXER( 'SBDSQR', INFOT, NOUT, LERR, OK ) 00220 INFOT = 4 00221 CALL SBDSQR( 'U', 0, 0, -1, 0, D, E, V, 1, U, 1, A, 1, W, 00222 $ INFO ) 00223 CALL CHKXER( 'SBDSQR', INFOT, NOUT, LERR, OK ) 00224 INFOT = 5 00225 CALL SBDSQR( 'U', 0, 0, 0, -1, D, E, V, 1, U, 1, A, 1, W, 00226 $ INFO ) 00227 CALL CHKXER( 'SBDSQR', INFOT, NOUT, LERR, OK ) 00228 INFOT = 9 00229 CALL SBDSQR( 'U', 2, 1, 0, 0, D, E, V, 1, U, 1, A, 1, W, INFO ) 00230 CALL CHKXER( 'SBDSQR', INFOT, NOUT, LERR, OK ) 00231 INFOT = 11 00232 CALL SBDSQR( 'U', 0, 0, 2, 0, D, E, V, 1, U, 1, A, 1, W, INFO ) 00233 CALL CHKXER( 'SBDSQR', INFOT, NOUT, LERR, OK ) 00234 INFOT = 13 00235 CALL SBDSQR( 'U', 2, 0, 0, 1, D, E, V, 1, U, 1, A, 1, W, INFO ) 00236 CALL CHKXER( 'SBDSQR', INFOT, NOUT, LERR, OK ) 00237 NT = NT + 8 00238 * 00239 * SBDSDC 00240 * 00241 SRNAMT = 'SBDSDC' 00242 INFOT = 1 00243 CALL SBDSDC( '/', 'N', 0, D, E, U, 1, V, 1, Q, IQ, W, IW, 00244 $ INFO ) 00245 CALL CHKXER( 'SBDSDC', INFOT, NOUT, LERR, OK ) 00246 INFOT = 2 00247 CALL SBDSDC( 'U', '/', 0, D, E, U, 1, V, 1, Q, IQ, W, IW, 00248 $ INFO ) 00249 CALL CHKXER( 'SBDSDC', INFOT, NOUT, LERR, OK ) 00250 INFOT = 3 00251 CALL SBDSDC( 'U', 'N', -1, D, E, U, 1, V, 1, Q, IQ, W, IW, 00252 $ INFO ) 00253 CALL CHKXER( 'SBDSDC', INFOT, NOUT, LERR, OK ) 00254 INFOT = 7 00255 CALL SBDSDC( 'U', 'I', 2, D, E, U, 1, V, 1, Q, IQ, W, IW, 00256 $ INFO ) 00257 CALL CHKXER( 'SBDSDC', INFOT, NOUT, LERR, OK ) 00258 INFOT = 9 00259 CALL SBDSDC( 'U', 'I', 2, D, E, U, 2, V, 1, Q, IQ, W, IW, 00260 $ INFO ) 00261 CALL CHKXER( 'SBDSDC', 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 SERRBD 00281 * 00282 END
1.7.3 
