|
LAPACK 3.3.0
|
|
LAPACK 3.3.0
|
00001 SUBROUTINE ZERRBD( 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 * ZERRBD tests the error exits for ZGEBRD, ZUNGBR, ZUNMBR, and ZBDSQR. 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 DOUBLE PRECISION D( NMAX ), E( NMAX ), RW( 4*NMAX ) 00038 COMPLEX*16 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 CHKXER, ZBDSQR, ZGEBRD, ZUNGBR, ZUNMBR 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 DBLE 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.D0 / DBLE( 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 * ZGEBRD 00081 * 00082 SRNAMT = 'ZGEBRD' 00083 INFOT = 1 00084 CALL ZGEBRD( -1, 0, A, 1, D, E, TQ, TP, W, 1, INFO ) 00085 CALL CHKXER( 'ZGEBRD', INFOT, NOUT, LERR, OK ) 00086 INFOT = 2 00087 CALL ZGEBRD( 0, -1, A, 1, D, E, TQ, TP, W, 1, INFO ) 00088 CALL CHKXER( 'ZGEBRD', INFOT, NOUT, LERR, OK ) 00089 INFOT = 4 00090 CALL ZGEBRD( 2, 1, A, 1, D, E, TQ, TP, W, 2, INFO ) 00091 CALL CHKXER( 'ZGEBRD', INFOT, NOUT, LERR, OK ) 00092 INFOT = 10 00093 CALL ZGEBRD( 2, 1, A, 2, D, E, TQ, TP, W, 1, INFO ) 00094 CALL CHKXER( 'ZGEBRD', INFOT, NOUT, LERR, OK ) 00095 NT = NT + 4 00096 * 00097 * ZUNGBR 00098 * 00099 SRNAMT = 'ZUNGBR' 00100 INFOT = 1 00101 CALL ZUNGBR( '/', 0, 0, 0, A, 1, TQ, W, 1, INFO ) 00102 CALL CHKXER( 'ZUNGBR', INFOT, NOUT, LERR, OK ) 00103 INFOT = 2 00104 CALL ZUNGBR( 'Q', -1, 0, 0, A, 1, TQ, W, 1, INFO ) 00105 CALL CHKXER( 'ZUNGBR', INFOT, NOUT, LERR, OK ) 00106 INFOT = 3 00107 CALL ZUNGBR( 'Q', 0, -1, 0, A, 1, TQ, W, 1, INFO ) 00108 CALL CHKXER( 'ZUNGBR', INFOT, NOUT, LERR, OK ) 00109 INFOT = 3 00110 CALL ZUNGBR( 'Q', 0, 1, 0, A, 1, TQ, W, 1, INFO ) 00111 CALL CHKXER( 'ZUNGBR', INFOT, NOUT, LERR, OK ) 00112 INFOT = 3 00113 CALL ZUNGBR( 'Q', 1, 0, 1, A, 1, TQ, W, 1, INFO ) 00114 CALL CHKXER( 'ZUNGBR', INFOT, NOUT, LERR, OK ) 00115 INFOT = 3 00116 CALL ZUNGBR( 'P', 1, 0, 0, A, 1, TQ, W, 1, INFO ) 00117 CALL CHKXER( 'ZUNGBR', INFOT, NOUT, LERR, OK ) 00118 INFOT = 3 00119 CALL ZUNGBR( 'P', 0, 1, 1, A, 1, TQ, W, 1, INFO ) 00120 CALL CHKXER( 'ZUNGBR', INFOT, NOUT, LERR, OK ) 00121 INFOT = 4 00122 CALL ZUNGBR( 'Q', 0, 0, -1, A, 1, TQ, W, 1, INFO ) 00123 CALL CHKXER( 'ZUNGBR', INFOT, NOUT, LERR, OK ) 00124 INFOT = 6 00125 CALL ZUNGBR( 'Q', 2, 1, 1, A, 1, TQ, W, 1, INFO ) 00126 CALL CHKXER( 'ZUNGBR', INFOT, NOUT, LERR, OK ) 00127 INFOT = 9 00128 CALL ZUNGBR( 'Q', 2, 2, 1, A, 2, TQ, W, 1, INFO ) 00129 CALL CHKXER( 'ZUNGBR', INFOT, NOUT, LERR, OK ) 00130 NT = NT + 10 00131 * 00132 * ZUNMBR 00133 * 00134 SRNAMT = 'ZUNMBR' 00135 INFOT = 1 00136 CALL ZUNMBR( '/', 'L', 'T', 0, 0, 0, A, 1, TQ, U, 1, W, 1, 00137 $ INFO ) 00138 CALL CHKXER( 'ZUNMBR', INFOT, NOUT, LERR, OK ) 00139 INFOT = 2 00140 CALL ZUNMBR( 'Q', '/', 'T', 0, 0, 0, A, 1, TQ, U, 1, W, 1, 00141 $ INFO ) 00142 CALL CHKXER( 'ZUNMBR', INFOT, NOUT, LERR, OK ) 00143 INFOT = 3 00144 CALL ZUNMBR( 'Q', 'L', '/', 0, 0, 0, A, 1, TQ, U, 1, W, 1, 00145 $ INFO ) 00146 CALL CHKXER( 'ZUNMBR', INFOT, NOUT, LERR, OK ) 00147 INFOT = 4 00148 CALL ZUNMBR( 'Q', 'L', 'C', -1, 0, 0, A, 1, TQ, U, 1, W, 1, 00149 $ INFO ) 00150 CALL CHKXER( 'ZUNMBR', INFOT, NOUT, LERR, OK ) 00151 INFOT = 5 00152 CALL ZUNMBR( 'Q', 'L', 'C', 0, -1, 0, A, 1, TQ, U, 1, W, 1, 00153 $ INFO ) 00154 CALL CHKXER( 'ZUNMBR', INFOT, NOUT, LERR, OK ) 00155 INFOT = 6 00156 CALL ZUNMBR( 'Q', 'L', 'C', 0, 0, -1, A, 1, TQ, U, 1, W, 1, 00157 $ INFO ) 00158 CALL CHKXER( 'ZUNMBR', INFOT, NOUT, LERR, OK ) 00159 INFOT = 8 00160 CALL ZUNMBR( 'Q', 'L', 'C', 2, 0, 0, A, 1, TQ, U, 2, W, 1, 00161 $ INFO ) 00162 CALL CHKXER( 'ZUNMBR', INFOT, NOUT, LERR, OK ) 00163 INFOT = 8 00164 CALL ZUNMBR( 'Q', 'R', 'C', 0, 2, 0, A, 1, TQ, U, 1, W, 1, 00165 $ INFO ) 00166 CALL CHKXER( 'ZUNMBR', INFOT, NOUT, LERR, OK ) 00167 INFOT = 8 00168 CALL ZUNMBR( 'P', 'L', 'C', 2, 0, 2, A, 1, TQ, U, 2, W, 1, 00169 $ INFO ) 00170 CALL CHKXER( 'ZUNMBR', INFOT, NOUT, LERR, OK ) 00171 INFOT = 8 00172 CALL ZUNMBR( 'P', 'R', 'C', 0, 2, 2, A, 1, TQ, U, 1, W, 1, 00173 $ INFO ) 00174 CALL CHKXER( 'ZUNMBR', INFOT, NOUT, LERR, OK ) 00175 INFOT = 11 00176 CALL ZUNMBR( 'Q', 'R', 'C', 2, 0, 0, A, 1, TQ, U, 1, W, 1, 00177 $ INFO ) 00178 CALL CHKXER( 'ZUNMBR', INFOT, NOUT, LERR, OK ) 00179 INFOT = 13 00180 CALL ZUNMBR( 'Q', 'L', 'C', 0, 2, 0, A, 1, TQ, U, 1, W, 0, 00181 $ INFO ) 00182 CALL CHKXER( 'ZUNMBR', INFOT, NOUT, LERR, OK ) 00183 INFOT = 13 00184 CALL ZUNMBR( 'Q', 'R', 'C', 2, 0, 0, A, 1, TQ, U, 2, W, 0, 00185 $ INFO ) 00186 CALL CHKXER( 'ZUNMBR', INFOT, NOUT, LERR, OK ) 00187 NT = NT + 13 00188 * 00189 * ZBDSQR 00190 * 00191 SRNAMT = 'ZBDSQR' 00192 INFOT = 1 00193 CALL ZBDSQR( '/', 0, 0, 0, 0, D, E, V, 1, U, 1, A, 1, RW, 00194 $ INFO ) 00195 CALL CHKXER( 'ZBDSQR', INFOT, NOUT, LERR, OK ) 00196 INFOT = 2 00197 CALL ZBDSQR( 'U', -1, 0, 0, 0, D, E, V, 1, U, 1, A, 1, RW, 00198 $ INFO ) 00199 CALL CHKXER( 'ZBDSQR', INFOT, NOUT, LERR, OK ) 00200 INFOT = 3 00201 CALL ZBDSQR( 'U', 0, -1, 0, 0, D, E, V, 1, U, 1, A, 1, RW, 00202 $ INFO ) 00203 CALL CHKXER( 'ZBDSQR', INFOT, NOUT, LERR, OK ) 00204 INFOT = 4 00205 CALL ZBDSQR( 'U', 0, 0, -1, 0, D, E, V, 1, U, 1, A, 1, RW, 00206 $ INFO ) 00207 CALL CHKXER( 'ZBDSQR', INFOT, NOUT, LERR, OK ) 00208 INFOT = 5 00209 CALL ZBDSQR( 'U', 0, 0, 0, -1, D, E, V, 1, U, 1, A, 1, RW, 00210 $ INFO ) 00211 CALL CHKXER( 'ZBDSQR', INFOT, NOUT, LERR, OK ) 00212 INFOT = 9 00213 CALL ZBDSQR( 'U', 2, 1, 0, 0, D, E, V, 1, U, 1, A, 1, RW, 00214 $ INFO ) 00215 CALL CHKXER( 'ZBDSQR', INFOT, NOUT, LERR, OK ) 00216 INFOT = 11 00217 CALL ZBDSQR( 'U', 0, 0, 2, 0, D, E, V, 1, U, 1, A, 1, RW, 00218 $ INFO ) 00219 CALL CHKXER( 'ZBDSQR', INFOT, NOUT, LERR, OK ) 00220 INFOT = 13 00221 CALL ZBDSQR( 'U', 2, 0, 0, 1, D, E, V, 1, U, 1, A, 1, RW, 00222 $ INFO ) 00223 CALL CHKXER( 'ZBDSQR', 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 ZERRBD 00243 * 00244 END
1.7.3 
