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