1       SUBROUTINE SERREC( 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 *  SERREC tests the error exits for the routines for eigen- condition
 16 *  estimation for REAL matrices:
 17 *     STRSYL, STREXC, STRSNA and STRSEN.
 18 *
 19 *  Arguments
 20 *  =========
 21 *
 22 *  PATH    (input) CHARACTER*3
 23 *          The LAPACK path name for the routines to be tested.
 24 *
 25 *  NUNIT   (input) INTEGER
 26 *          The unit number for output.
 27 *
 28 *  =====================================================================
 29 *
 30 *     .. Parameters ..
 31       INTEGER            NMAX
 32       REAL               ONE, ZERO
 33       PARAMETER          ( NMAX = 4, ONE = 1.0E0, ZERO = 0.0E0 )
 34 *     ..
 35 *     .. Local Scalars ..
 36       INTEGER            I, IFST, ILST, INFO, J, M, NT
 37       REAL               SCALE
 38 *     ..
 39 *     .. Local Arrays ..
 40       LOGICAL            SEL( NMAX )
 41       INTEGER            IWORK( NMAX )
 42       REAL               A( NMAX, NMAX ), B( NMAX, NMAX ),
 43      $                   C( NMAX, NMAX ), S( NMAX ), SEP( NMAX ),
 44      $                   WI( NMAX ), WORK( NMAX ), WR( NMAX )
 45 *     ..
 46 *     .. External Subroutines ..
 47       EXTERNAL           CHKXER, STREXC, STRSEN, STRSNA, STRSYL
 48 *     ..
 49 *     .. Scalars in Common ..
 50       LOGICAL            LERR, OK
 51       CHARACTER*32       SRNAMT
 52       INTEGER            INFOT, NOUT
 53 *     ..
 54 *     .. Common blocks ..
 55       COMMON             / INFOC / INFOT, NOUT, OK, LERR
 56       COMMON             / SRNAMC / SRNAMT
 57 *     ..
 58 *     .. Executable Statements ..
 59 *
 60       NOUT = NUNIT
 61       OK = .TRUE.
 62       NT = 0
 63 *
 64 *     Initialize A, B and SEL
 65 *
 66       DO 20 J = 1, NMAX
 67          DO 10 I = 1, NMAX
 68             A( I, J ) = ZERO
 69             B( I, J ) = ZERO
 70    10    CONTINUE
 71    20 CONTINUE
 72       DO 30 I = 1, NMAX
 73          A( I, I ) = ONE
 74          SEL( I ) = .TRUE.
 75    30 CONTINUE
 76 *
 77 *     Test STRSYL
 78 *
 79       SRNAMT = 'STRSYL'
 80       INFOT = 1
 81       CALL STRSYL( 'X''N'100, A, 1, B, 1, C, 1SCALE, INFO )
 82       CALL CHKXER( 'STRSYL', INFOT, NOUT, LERR, OK )
 83       INFOT = 2
 84       CALL STRSYL( 'N''X'100, A, 1, B, 1, C, 1SCALE, INFO )
 85       CALL CHKXER( 'STRSYL', INFOT, NOUT, LERR, OK )
 86       INFOT = 3
 87       CALL STRSYL( 'N''N'000, A, 1, B, 1, C, 1SCALE, INFO )
 88       CALL CHKXER( 'STRSYL', INFOT, NOUT, LERR, OK )
 89       INFOT = 4
 90       CALL STRSYL( 'N''N'1-10, A, 1, B, 1, C, 1SCALE, INFO )
 91       CALL CHKXER( 'STRSYL', INFOT, NOUT, LERR, OK )
 92       INFOT = 5
 93       CALL STRSYL( 'N''N'10-1, A, 1, B, 1, C, 1SCALE, INFO )
 94       CALL CHKXER( 'STRSYL', INFOT, NOUT, LERR, OK )
 95       INFOT = 7
 96       CALL STRSYL( 'N''N'120, A, 1, B, 1, C, 2SCALE, INFO )
 97       CALL CHKXER( 'STRSYL', INFOT, NOUT, LERR, OK )
 98       INFOT = 9
 99       CALL STRSYL( 'N''N'102, A, 1, B, 1, C, 1SCALE, INFO )
100       CALL CHKXER( 'STRSYL', INFOT, NOUT, LERR, OK )
101       INFOT = 11
102       CALL STRSYL( 'N''N'120, A, 2, B, 1, C, 1SCALE, INFO )
103       CALL CHKXER( 'STRSYL', INFOT, NOUT, LERR, OK )
104       NT = NT + 8
105 *
106 *     Test STREXC
107 *
108       SRNAMT = 'STREXC'
109       IFST = 1
110       ILST = 1
111       INFOT = 1
112       CALL STREXC( 'X'1, A, 1, B, 1, IFST, ILST, WORK, INFO )
113       CALL CHKXER( 'STREXC', INFOT, NOUT, LERR, OK )
114       INFOT = 7
115       CALL STREXC( 'N'0, A, 1, B, 1, IFST, ILST, WORK, INFO )
116       CALL CHKXER( 'STREXC', INFOT, NOUT, LERR, OK )
117       INFOT = 4
118       ILST = 2
119       CALL STREXC( 'N'2, A, 1, B, 1, IFST, ILST, WORK, INFO )
120       CALL CHKXER( 'STREXC', INFOT, NOUT, LERR, OK )
121       INFOT = 6
122       CALL STREXC( 'V'2, A, 2, B, 1, IFST, ILST, WORK, INFO )
123       CALL CHKXER( 'STREXC', INFOT, NOUT, LERR, OK )
124       INFOT = 7
125       IFST = 0
126       ILST = 1
127       CALL STREXC( 'V'1, A, 1, B, 1, IFST, ILST, WORK, INFO )
128       CALL CHKXER( 'STREXC', INFOT, NOUT, LERR, OK )
129       INFOT = 7
130       IFST = 2
131       CALL STREXC( 'V'1, A, 1, B, 1, IFST, ILST, WORK, INFO )
132       CALL CHKXER( 'STREXC', INFOT, NOUT, LERR, OK )
133       INFOT = 8
134       IFST = 1
135       ILST = 0
136       CALL STREXC( 'V'1, A, 1, B, 1, IFST, ILST, WORK, INFO )
137       CALL CHKXER( 'STREXC', INFOT, NOUT, LERR, OK )
138       INFOT = 8
139       ILST = 2
140       CALL STREXC( 'V'1, A, 1, B, 1, IFST, ILST, WORK, INFO )
141       CALL CHKXER( 'STREXC', INFOT, NOUT, LERR, OK )
142       NT = NT + 8
143 *
144 *     Test STRSNA
145 *
146       SRNAMT = 'STRSNA'
147       INFOT = 1
148       CALL STRSNA( 'X''A', SEL, 0, A, 1, B, 1, C, 1, S, SEP, 1, M,
149      $             WORK, 1, IWORK, INFO )
150       CALL CHKXER( 'STRSNA', INFOT, NOUT, LERR, OK )
151       INFOT = 2
152       CALL STRSNA( 'B''X', SEL, 0, A, 1, B, 1, C, 1, S, SEP, 1, M,
153      $             WORK, 1, IWORK, INFO )
154       CALL CHKXER( 'STRSNA', INFOT, NOUT, LERR, OK )
155       INFOT = 4
156       CALL STRSNA( 'B''A', SEL, -1, A, 1, B, 1, C, 1, S, SEP, 1, M,
157      $             WORK, 1, IWORK, INFO )
158       CALL CHKXER( 'STRSNA', INFOT, NOUT, LERR, OK )
159       INFOT = 6
160       CALL STRSNA( 'V''A', SEL, 2, A, 1, B, 1, C, 1, S, SEP, 2, M,
161      $             WORK, 2, IWORK, INFO )
162       CALL CHKXER( 'STRSNA', INFOT, NOUT, LERR, OK )
163       INFOT = 8
164       CALL STRSNA( 'B''A', SEL, 2, A, 2, B, 1, C, 2, S, SEP, 2, M,
165      $             WORK, 2, IWORK, INFO )
166       CALL CHKXER( 'STRSNA', INFOT, NOUT, LERR, OK )
167       INFOT = 10
168       CALL STRSNA( 'B''A', SEL, 2, A, 2, B, 2, C, 1, S, SEP, 2, M,
169      $             WORK, 2, IWORK, INFO )
170       CALL CHKXER( 'STRSNA', INFOT, NOUT, LERR, OK )
171       INFOT = 13
172       CALL STRSNA( 'B''A', SEL, 1, A, 1, B, 1, C, 1, S, SEP, 0, M,
173      $             WORK, 1, IWORK, INFO )
174       CALL CHKXER( 'STRSNA', INFOT, NOUT, LERR, OK )
175       INFOT = 13
176       CALL STRSNA( 'B''S', SEL, 2, A, 2, B, 2, C, 2, S, SEP, 1, M,
177      $             WORK, 2, IWORK, INFO )
178       CALL CHKXER( 'STRSNA', INFOT, NOUT, LERR, OK )
179       INFOT = 16
180       CALL STRSNA( 'B''A', SEL, 2, A, 2, B, 2, C, 2, S, SEP, 2, M,
181      $             WORK, 1, IWORK, INFO )
182       CALL CHKXER( 'STRSNA', INFOT, NOUT, LERR, OK )
183       NT = NT + 9
184 *
185 *     Test STRSEN
186 *
187       SEL( 1 ) = .FALSE.
188       SRNAMT = 'STRSEN'
189       INFOT = 1
190       CALL STRSEN( 'X''N', SEL, 0, A, 1, B, 1, WR, WI, M, S( 1 ),
191      $             SEP( 1 ), WORK, 1, IWORK, 1, INFO )
192       CALL CHKXER( 'STRSEN', INFOT, NOUT, LERR, OK )
193       INFOT = 2
194       CALL STRSEN( 'N''X', SEL, 0, A, 1, B, 1, WR, WI, M, S( 1 ),
195      $             SEP( 1 ), WORK, 1, IWORK, 1, INFO )
196       CALL CHKXER( 'STRSEN', INFOT, NOUT, LERR, OK )
197       INFOT = 4
198       CALL STRSEN( 'N''N', SEL, -1, A, 1, B, 1, WR, WI, M, S( 1 ),
199      $             SEP( 1 ), WORK, 1, IWORK, 1, INFO )
200       CALL CHKXER( 'STRSEN', INFOT, NOUT, LERR, OK )
201       INFOT = 6
202       CALL STRSEN( 'N''N', SEL, 2, A, 1, B, 1, WR, WI, M, S( 1 ),
203      $             SEP( 1 ), WORK, 2, IWORK, 1, INFO )
204       CALL CHKXER( 'STRSEN', INFOT, NOUT, LERR, OK )
205       INFOT = 8
206       CALL STRSEN( 'N''V', SEL, 2, A, 2, B, 1, WR, WI, M, S( 1 ),
207      $             SEP( 1 ), WORK, 1, IWORK, 1, INFO )
208       CALL CHKXER( 'STRSEN', INFOT, NOUT, LERR, OK )
209       INFOT = 15
210       CALL STRSEN( 'N''V', SEL, 2, A, 2, B, 2, WR, WI, M, S( 1 ),
211      $             SEP( 1 ), WORK, 0, IWORK, 1, INFO )
212       CALL CHKXER( 'STRSEN', INFOT, NOUT, LERR, OK )
213       INFOT = 15
214       CALL STRSEN( 'E''V', SEL, 3, A, 3, B, 3, WR, WI, M, S( 1 ),
215      $             SEP( 1 ), WORK, 1, IWORK, 1, INFO )
216       CALL CHKXER( 'STRSEN', INFOT, NOUT, LERR, OK )
217       INFOT = 15
218       CALL STRSEN( 'V''V', SEL, 3, A, 3, B, 3, WR, WI, M, S( 1 ),
219      $             SEP( 1 ), WORK, 3, IWORK, 2, INFO )
220       CALL CHKXER( 'STRSEN', INFOT, NOUT, LERR, OK )
221       INFOT = 17
222       CALL STRSEN( 'E''V', SEL, 2, A, 2, B, 2, WR, WI, M, S( 1 ),
223      $             SEP( 1 ), WORK, 1, IWORK, 0, INFO )
224       CALL CHKXER( 'STRSEN', INFOT, NOUT, LERR, OK )
225       INFOT = 17
226       CALL STRSEN( 'V''V', SEL, 3, A, 3, B, 3, WR, WI, M, S( 1 ),
227      $             SEP( 1 ), WORK, 4, IWORK, 1, INFO )
228       CALL CHKXER( 'STRSEN', INFOT, NOUT, LERR, OK )
229       NT = NT + 10
230 *
231 *     Print a summary line.
232 *
233       IF( OK ) THEN
234          WRITE( NOUT, FMT = 9999 )PATH, NT
235       ELSE
236          WRITE( NOUT, FMT = 9998 )PATH
237       END IF
238 *
239       RETURN
240  9999 FORMAT1X, A3, ' routines passed the tests of the error exits (',
241      $      I3, ' tests done)' )
242  9998 FORMAT' *** ', A3, ' routines failed the tests of the error ex',
243      $      'its ***' )
244 *
245 *     End of SERREC
246 *
247       END