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