1*> \brief \b ZERRBD 2* 3* =========== DOCUMENTATION =========== 4* 5* Online html documentation available at 6* http://www.netlib.org/lapack/explore-html/ 7* 8* Definition: 9* =========== 10* 11* SUBROUTINE ZERRBD( PATH, NUNIT ) 12* 13* .. Scalar Arguments .. 14* CHARACTER*3 PATH 15* INTEGER NUNIT 16* .. 17* 18* 19*> \par Purpose: 20* ============= 21*> 22*> \verbatim 23*> 24*> ZERRBD tests the error exits for ZGEBRD, ZUNGBR, ZUNMBR, and ZBDSQR. 25*> \endverbatim 26* 27* Arguments: 28* ========== 29* 30*> \param[in] PATH 31*> \verbatim 32*> PATH is CHARACTER*3 33*> The LAPACK path name for the routines to be tested. 34*> \endverbatim 35*> 36*> \param[in] NUNIT 37*> \verbatim 38*> NUNIT is INTEGER 39*> The unit number for output. 40*> \endverbatim 41* 42* Authors: 43* ======== 44* 45*> \author Univ. of Tennessee 46*> \author Univ. of California Berkeley 47*> \author Univ. of Colorado Denver 48*> \author NAG Ltd. 49* 50*> \date November 2011 51* 52*> \ingroup complex16_eig 53* 54* ===================================================================== 55 SUBROUTINE ZERRBD( PATH, NUNIT ) 56* 57* -- LAPACK test routine (version 3.4.0) -- 58* -- LAPACK is a software package provided by Univ. of Tennessee, -- 59* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 60* November 2011 61* 62* .. Scalar Arguments .. 63 CHARACTER*3 PATH 64 INTEGER NUNIT 65* .. 66* 67* ===================================================================== 68* 69* .. Parameters .. 70 INTEGER NMAX, LW 71 PARAMETER ( NMAX = 4, LW = NMAX ) 72* .. 73* .. Local Scalars .. 74 CHARACTER*2 C2 75 INTEGER I, INFO, J, NT 76* .. 77* .. Local Arrays .. 78 DOUBLE PRECISION D( NMAX ), E( NMAX ), RW( 4*NMAX ) 79 COMPLEX*16 A( NMAX, NMAX ), TP( NMAX ), TQ( NMAX ), 80 $ U( NMAX, NMAX ), V( NMAX, NMAX ), W( LW ) 81* .. 82* .. External Functions .. 83 LOGICAL LSAMEN 84 EXTERNAL LSAMEN 85* .. 86* .. External Subroutines .. 87 EXTERNAL CHKXER, ZBDSQR, ZGEBRD, ZUNGBR, ZUNMBR 88* .. 89* .. Scalars in Common .. 90 LOGICAL LERR, OK 91 CHARACTER*32 SRNAMT 92 INTEGER INFOT, NOUT 93* .. 94* .. Common blocks .. 95 COMMON / INFOC / INFOT, NOUT, OK, LERR 96 COMMON / SRNAMC / SRNAMT 97* .. 98* .. Intrinsic Functions .. 99 INTRINSIC DBLE 100* .. 101* .. Executable Statements .. 102* 103 NOUT = NUNIT 104 WRITE( NOUT, FMT = * ) 105 C2 = PATH( 2: 3 ) 106* 107* Set the variables to innocuous values. 108* 109 DO 20 J = 1, NMAX 110 DO 10 I = 1, NMAX 111 A( I, J ) = 1.D0 / DBLE( I+J ) 112 10 CONTINUE 113 20 CONTINUE 114 OK = .TRUE. 115 NT = 0 116* 117* Test error exits of the SVD routines. 118* 119 IF( LSAMEN( 2, C2, 'BD' ) ) THEN 120* 121* ZGEBRD 122* 123 SRNAMT = 'ZGEBRD' 124 INFOT = 1 125 CALL ZGEBRD( -1, 0, A, 1, D, E, TQ, TP, W, 1, INFO ) 126 CALL CHKXER( 'ZGEBRD', INFOT, NOUT, LERR, OK ) 127 INFOT = 2 128 CALL ZGEBRD( 0, -1, A, 1, D, E, TQ, TP, W, 1, INFO ) 129 CALL CHKXER( 'ZGEBRD', INFOT, NOUT, LERR, OK ) 130 INFOT = 4 131 CALL ZGEBRD( 2, 1, A, 1, D, E, TQ, TP, W, 2, INFO ) 132 CALL CHKXER( 'ZGEBRD', INFOT, NOUT, LERR, OK ) 133 INFOT = 10 134 CALL ZGEBRD( 2, 1, A, 2, D, E, TQ, TP, W, 1, INFO ) 135 CALL CHKXER( 'ZGEBRD', INFOT, NOUT, LERR, OK ) 136 NT = NT + 4 137* 138* ZUNGBR 139* 140 SRNAMT = 'ZUNGBR' 141 INFOT = 1 142 CALL ZUNGBR( '/', 0, 0, 0, A, 1, TQ, W, 1, INFO ) 143 CALL CHKXER( 'ZUNGBR', INFOT, NOUT, LERR, OK ) 144 INFOT = 2 145 CALL ZUNGBR( 'Q', -1, 0, 0, A, 1, TQ, W, 1, INFO ) 146 CALL CHKXER( 'ZUNGBR', INFOT, NOUT, LERR, OK ) 147 INFOT = 3 148 CALL ZUNGBR( 'Q', 0, -1, 0, A, 1, TQ, W, 1, INFO ) 149 CALL CHKXER( 'ZUNGBR', INFOT, NOUT, LERR, OK ) 150 INFOT = 3 151 CALL ZUNGBR( 'Q', 0, 1, 0, A, 1, TQ, W, 1, INFO ) 152 CALL CHKXER( 'ZUNGBR', INFOT, NOUT, LERR, OK ) 153 INFOT = 3 154 CALL ZUNGBR( 'Q', 1, 0, 1, A, 1, TQ, W, 1, INFO ) 155 CALL CHKXER( 'ZUNGBR', INFOT, NOUT, LERR, OK ) 156 INFOT = 3 157 CALL ZUNGBR( 'P', 1, 0, 0, A, 1, TQ, W, 1, INFO ) 158 CALL CHKXER( 'ZUNGBR', INFOT, NOUT, LERR, OK ) 159 INFOT = 3 160 CALL ZUNGBR( 'P', 0, 1, 1, A, 1, TQ, W, 1, INFO ) 161 CALL CHKXER( 'ZUNGBR', INFOT, NOUT, LERR, OK ) 162 INFOT = 4 163 CALL ZUNGBR( 'Q', 0, 0, -1, A, 1, TQ, W, 1, INFO ) 164 CALL CHKXER( 'ZUNGBR', INFOT, NOUT, LERR, OK ) 165 INFOT = 6 166 CALL ZUNGBR( 'Q', 2, 1, 1, A, 1, TQ, W, 1, INFO ) 167 CALL CHKXER( 'ZUNGBR', INFOT, NOUT, LERR, OK ) 168 INFOT = 9 169 CALL ZUNGBR( 'Q', 2, 2, 1, A, 2, TQ, W, 1, INFO ) 170 CALL CHKXER( 'ZUNGBR', INFOT, NOUT, LERR, OK ) 171 NT = NT + 10 172* 173* ZUNMBR 174* 175 SRNAMT = 'ZUNMBR' 176 INFOT = 1 177 CALL ZUNMBR( '/', 'L', 'T', 0, 0, 0, A, 1, TQ, U, 1, W, 1, 178 $ INFO ) 179 CALL CHKXER( 'ZUNMBR', INFOT, NOUT, LERR, OK ) 180 INFOT = 2 181 CALL ZUNMBR( 'Q', '/', 'T', 0, 0, 0, A, 1, TQ, U, 1, W, 1, 182 $ INFO ) 183 CALL CHKXER( 'ZUNMBR', INFOT, NOUT, LERR, OK ) 184 INFOT = 3 185 CALL ZUNMBR( 'Q', 'L', '/', 0, 0, 0, A, 1, TQ, U, 1, W, 1, 186 $ INFO ) 187 CALL CHKXER( 'ZUNMBR', INFOT, NOUT, LERR, OK ) 188 INFOT = 4 189 CALL ZUNMBR( 'Q', 'L', 'C', -1, 0, 0, A, 1, TQ, U, 1, W, 1, 190 $ INFO ) 191 CALL CHKXER( 'ZUNMBR', INFOT, NOUT, LERR, OK ) 192 INFOT = 5 193 CALL ZUNMBR( 'Q', 'L', 'C', 0, -1, 0, A, 1, TQ, U, 1, W, 1, 194 $ INFO ) 195 CALL CHKXER( 'ZUNMBR', INFOT, NOUT, LERR, OK ) 196 INFOT = 6 197 CALL ZUNMBR( 'Q', 'L', 'C', 0, 0, -1, A, 1, TQ, U, 1, W, 1, 198 $ INFO ) 199 CALL CHKXER( 'ZUNMBR', INFOT, NOUT, LERR, OK ) 200 INFOT = 8 201 CALL ZUNMBR( 'Q', 'L', 'C', 2, 0, 0, A, 1, TQ, U, 2, W, 1, 202 $ INFO ) 203 CALL CHKXER( 'ZUNMBR', INFOT, NOUT, LERR, OK ) 204 INFOT = 8 205 CALL ZUNMBR( 'Q', 'R', 'C', 0, 2, 0, A, 1, TQ, U, 1, W, 1, 206 $ INFO ) 207 CALL CHKXER( 'ZUNMBR', INFOT, NOUT, LERR, OK ) 208 INFOT = 8 209 CALL ZUNMBR( 'P', 'L', 'C', 2, 0, 2, A, 1, TQ, U, 2, W, 1, 210 $ INFO ) 211 CALL CHKXER( 'ZUNMBR', INFOT, NOUT, LERR, OK ) 212 INFOT = 8 213 CALL ZUNMBR( 'P', 'R', 'C', 0, 2, 2, A, 1, TQ, U, 1, W, 1, 214 $ INFO ) 215 CALL CHKXER( 'ZUNMBR', INFOT, NOUT, LERR, OK ) 216 INFOT = 11 217 CALL ZUNMBR( 'Q', 'R', 'C', 2, 0, 0, A, 1, TQ, U, 1, W, 1, 218 $ INFO ) 219 CALL CHKXER( 'ZUNMBR', INFOT, NOUT, LERR, OK ) 220 INFOT = 13 221 CALL ZUNMBR( 'Q', 'L', 'C', 0, 2, 0, A, 1, TQ, U, 1, W, 0, 222 $ INFO ) 223 CALL CHKXER( 'ZUNMBR', INFOT, NOUT, LERR, OK ) 224 INFOT = 13 225 CALL ZUNMBR( 'Q', 'R', 'C', 2, 0, 0, A, 1, TQ, U, 2, W, 0, 226 $ INFO ) 227 CALL CHKXER( 'ZUNMBR', INFOT, NOUT, LERR, OK ) 228 NT = NT + 13 229* 230* ZBDSQR 231* 232 SRNAMT = 'ZBDSQR' 233 INFOT = 1 234 CALL ZBDSQR( '/', 0, 0, 0, 0, D, E, V, 1, U, 1, A, 1, RW, 235 $ INFO ) 236 CALL CHKXER( 'ZBDSQR', INFOT, NOUT, LERR, OK ) 237 INFOT = 2 238 CALL ZBDSQR( 'U', -1, 0, 0, 0, D, E, V, 1, U, 1, A, 1, RW, 239 $ INFO ) 240 CALL CHKXER( 'ZBDSQR', INFOT, NOUT, LERR, OK ) 241 INFOT = 3 242 CALL ZBDSQR( 'U', 0, -1, 0, 0, D, E, V, 1, U, 1, A, 1, RW, 243 $ INFO ) 244 CALL CHKXER( 'ZBDSQR', INFOT, NOUT, LERR, OK ) 245 INFOT = 4 246 CALL ZBDSQR( 'U', 0, 0, -1, 0, D, E, V, 1, U, 1, A, 1, RW, 247 $ INFO ) 248 CALL CHKXER( 'ZBDSQR', INFOT, NOUT, LERR, OK ) 249 INFOT = 5 250 CALL ZBDSQR( 'U', 0, 0, 0, -1, D, E, V, 1, U, 1, A, 1, RW, 251 $ INFO ) 252 CALL CHKXER( 'ZBDSQR', INFOT, NOUT, LERR, OK ) 253 INFOT = 9 254 CALL ZBDSQR( 'U', 2, 1, 0, 0, D, E, V, 1, U, 1, A, 1, RW, 255 $ INFO ) 256 CALL CHKXER( 'ZBDSQR', INFOT, NOUT, LERR, OK ) 257 INFOT = 11 258 CALL ZBDSQR( 'U', 0, 0, 2, 0, D, E, V, 1, U, 1, A, 1, RW, 259 $ INFO ) 260 CALL CHKXER( 'ZBDSQR', INFOT, NOUT, LERR, OK ) 261 INFOT = 13 262 CALL ZBDSQR( 'U', 2, 0, 0, 1, D, E, V, 1, U, 1, A, 1, RW, 263 $ INFO ) 264 CALL CHKXER( 'ZBDSQR', INFOT, NOUT, LERR, OK ) 265 NT = NT + 8 266 END IF 267* 268* Print a summary line. 269* 270 IF( OK ) THEN 271 WRITE( NOUT, FMT = 9999 )PATH, NT 272 ELSE 273 WRITE( NOUT, FMT = 9998 )PATH 274 END IF 275* 276 9999 FORMAT( 1X, A3, ' routines passed the tests of the error exits (', 277 $ I3, ' tests done)' ) 278 9998 FORMAT( ' *** ', A3, ' routines failed the tests of the error ', 279 $ 'exits ***' ) 280* 281 RETURN 282* 283* End of ZERRBD 284* 285 END 286