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