1       SUBROUTINE ZERREC( 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 *  ZERREC tests the error exits for the routines for eigen- condition
 16 *  estimation for DOUBLE PRECISION matrices:
 17 *     ZTRSYL, CTREXC, CTRSNA and CTRSEN.
 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, LW
 32       PARAMETER          ( NMAX = 4, LW = NMAX*( NMAX+2 ) )
 33       DOUBLE PRECISION   ONE, ZERO
 34       PARAMETER          ( ONE = 1.0D0, ZERO = 0.0D0 )
 35 *     ..
 36 *     .. Local Scalars ..
 37       INTEGER            I, IFST, ILST, INFO, J, M, NT
 38       DOUBLE PRECISION   SCALE
 39 *     ..
 40 *     .. Local Arrays ..
 41       LOGICAL            SEL( NMAX )
 42       DOUBLE PRECISION   RW( LW ), S( NMAX ), SEP( NMAX )
 43       COMPLEX*16         A( NMAX, NMAX ), B( NMAX, NMAX ),
 44      $                   C( NMAX, NMAX ), WORK( LW ), X( NMAX )
 45 *     ..
 46 *     .. External Subroutines ..
 47       EXTERNAL           CHKXER, ZTREXC, ZTRSEN, ZTRSNA, ZTRSYL
 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 ZTRSYL
 78 *
 79       SRNAMT = 'ZTRSYL'
 80       INFOT = 1
 81       CALL ZTRSYL( 'X''N'100, A, 1, B, 1, C, 1SCALE, INFO )
 82       CALL CHKXER( 'ZTRSYL', INFOT, NOUT, LERR, OK )
 83       INFOT = 2
 84       CALL ZTRSYL( 'N''X'100, A, 1, B, 1, C, 1SCALE, INFO )
 85       CALL CHKXER( 'ZTRSYL', INFOT, NOUT, LERR, OK )
 86       INFOT = 3
 87       CALL ZTRSYL( 'N''N'000, A, 1, B, 1, C, 1SCALE, INFO )
 88       CALL CHKXER( 'ZTRSYL', INFOT, NOUT, LERR, OK )
 89       INFOT = 4
 90       CALL ZTRSYL( 'N''N'1-10, A, 1, B, 1, C, 1SCALE, INFO )
 91       CALL CHKXER( 'ZTRSYL', INFOT, NOUT, LERR, OK )
 92       INFOT = 5
 93       CALL ZTRSYL( 'N''N'10-1, A, 1, B, 1, C, 1SCALE, INFO )
 94       CALL CHKXER( 'ZTRSYL', INFOT, NOUT, LERR, OK )
 95       INFOT = 7
 96       CALL ZTRSYL( 'N''N'120, A, 1, B, 1, C, 2SCALE, INFO )
 97       CALL CHKXER( 'ZTRSYL', INFOT, NOUT, LERR, OK )
 98       INFOT = 9
 99       CALL ZTRSYL( 'N''N'102, A, 1, B, 1, C, 1SCALE, INFO )
100       CALL CHKXER( 'ZTRSYL', INFOT, NOUT, LERR, OK )
101       INFOT = 11
102       CALL ZTRSYL( 'N''N'120, A, 2, B, 1, C, 1SCALE, INFO )
103       CALL CHKXER( 'ZTRSYL', INFOT, NOUT, LERR, OK )
104       NT = NT + 8
105 *
106 *     Test ZTREXC
107 *
108       SRNAMT = 'ZTREXC'
109       IFST = 1
110       ILST = 1
111       INFOT = 1
112       CALL ZTREXC( 'X'1, A, 1, B, 1, IFST, ILST, INFO )
113       CALL CHKXER( 'ZTREXC', INFOT, NOUT, LERR, OK )
114       INFOT = 7
115       CALL ZTREXC( 'N'0, A, 1, B, 1, IFST, ILST, INFO )
116       CALL CHKXER( 'ZTREXC', INFOT, NOUT, LERR, OK )
117       INFOT = 4
118       ILST = 2
119       CALL ZTREXC( 'N'2, A, 1, B, 1, IFST, ILST, INFO )
120       CALL CHKXER( 'ZTREXC', INFOT, NOUT, LERR, OK )
121       INFOT = 6
122       CALL ZTREXC( 'V'2, A, 2, B, 1, IFST, ILST, INFO )
123       CALL CHKXER( 'ZTREXC', INFOT, NOUT, LERR, OK )
124       INFOT = 7
125       IFST = 0
126       ILST = 1
127       CALL ZTREXC( 'V'1, A, 1, B, 1, IFST, ILST, INFO )
128       CALL CHKXER( 'ZTREXC', INFOT, NOUT, LERR, OK )
129       INFOT = 7
130       IFST = 2
131       CALL ZTREXC( 'V'1, A, 1, B, 1, IFST, ILST, INFO )
132       CALL CHKXER( 'ZTREXC', INFOT, NOUT, LERR, OK )
133       INFOT = 8
134       IFST = 1
135       ILST = 0
136       CALL ZTREXC( 'V'1, A, 1, B, 1, IFST, ILST, INFO )
137       CALL CHKXER( 'ZTREXC', INFOT, NOUT, LERR, OK )
138       INFOT = 8
139       ILST = 2
140       CALL ZTREXC( 'V'1, A, 1, B, 1, IFST, ILST, INFO )
141       CALL CHKXER( 'ZTREXC', INFOT, NOUT, LERR, OK )
142       NT = NT + 8
143 *
144 *     Test ZTRSNA
145 *
146       SRNAMT = 'ZTRSNA'
147       INFOT = 1
148       CALL ZTRSNA( 'X''A', SEL, 0, A, 1, B, 1, C, 1, S, SEP, 1, M,
149      $             WORK, 1, RW, INFO )
150       CALL CHKXER( 'ZTRSNA', INFOT, NOUT, LERR, OK )
151       INFOT = 2
152       CALL ZTRSNA( 'B''X', SEL, 0, A, 1, B, 1, C, 1, S, SEP, 1, M,
153      $             WORK, 1, RW, INFO )
154       CALL CHKXER( 'ZTRSNA', INFOT, NOUT, LERR, OK )
155       INFOT = 4
156       CALL ZTRSNA( 'B''A', SEL, -1, A, 1, B, 1, C, 1, S, SEP, 1, M,
157      $             WORK, 1, RW, INFO )
158       CALL CHKXER( 'ZTRSNA', INFOT, NOUT, LERR, OK )
159       INFOT = 6
160       CALL ZTRSNA( 'V''A', SEL, 2, A, 1, B, 1, C, 1, S, SEP, 2, M,
161      $             WORK, 2, RW, INFO )
162       CALL CHKXER( 'ZTRSNA', INFOT, NOUT, LERR, OK )
163       INFOT = 8
164       CALL ZTRSNA( 'B''A', SEL, 2, A, 2, B, 1, C, 2, S, SEP, 2, M,
165      $             WORK, 2, RW, INFO )
166       CALL CHKXER( 'ZTRSNA', INFOT, NOUT, LERR, OK )
167       INFOT = 10
168       CALL ZTRSNA( 'B''A', SEL, 2, A, 2, B, 2, C, 1, S, SEP, 2, M,
169      $             WORK, 2, RW, INFO )
170       CALL CHKXER( 'ZTRSNA', INFOT, NOUT, LERR, OK )
171       INFOT = 13
172       CALL ZTRSNA( 'B''A', SEL, 1, A, 1, B, 1, C, 1, S, SEP, 0, M,
173      $             WORK, 1, RW, INFO )
174       CALL CHKXER( 'ZTRSNA', INFOT, NOUT, LERR, OK )
175       INFOT = 13
176       CALL ZTRSNA( 'B''S', SEL, 2, A, 2, B, 2, C, 2, S, SEP, 1, M,
177      $             WORK, 1, RW, INFO )
178       CALL CHKXER( 'ZTRSNA', INFOT, NOUT, LERR, OK )
179       INFOT = 16
180       CALL ZTRSNA( 'B''A', SEL, 2, A, 2, B, 2, C, 2, S, SEP, 2, M,
181      $             WORK, 1, RW, INFO )
182       CALL CHKXER( 'ZTRSNA', INFOT, NOUT, LERR, OK )
183       NT = NT + 9
184 *
185 *     Test ZTRSEN
186 *
187       SEL( 1 ) = .FALSE.
188       SRNAMT = 'ZTRSEN'
189       INFOT = 1
190       CALL ZTRSEN( 'X''N', SEL, 0, A, 1, B, 1, X, M, S( 1 ), SEP( 1 ),
191      $             WORK, 1, INFO )
192       CALL CHKXER( 'ZTRSEN', INFOT, NOUT, LERR, OK )
193       INFOT = 2
194       CALL ZTRSEN( 'N''X', SEL, 0, A, 1, B, 1, X, M, S( 1 ), SEP( 1 ),
195      $             WORK, 1, INFO )
196       CALL CHKXER( 'ZTRSEN', INFOT, NOUT, LERR, OK )
197       INFOT = 4
198       CALL ZTRSEN( 'N''N', SEL, -1, A, 1, B, 1, X, M, S( 1 ),
199      $             SEP( 1 ), WORK, 1, INFO )
200       CALL CHKXER( 'ZTRSEN', INFOT, NOUT, LERR, OK )
201       INFOT = 6
202       CALL ZTRSEN( 'N''N', SEL, 2, A, 1, B, 1, X, M, S( 1 ), SEP( 1 ),
203      $             WORK, 2, INFO )
204       CALL CHKXER( 'ZTRSEN', INFOT, NOUT, LERR, OK )
205       INFOT = 8
206       CALL ZTRSEN( 'N''V', SEL, 2, A, 2, B, 1, X, M, S( 1 ), SEP( 1 ),
207      $             WORK, 1, INFO )
208       CALL CHKXER( 'ZTRSEN', INFOT, NOUT, LERR, OK )
209       INFOT = 14
210       CALL ZTRSEN( 'N''V', SEL, 2, A, 2, B, 2, X, M, S( 1 ), SEP( 1 ),
211      $             WORK, 0, INFO )
212       CALL CHKXER( 'ZTRSEN', INFOT, NOUT, LERR, OK )
213       INFOT = 14
214       CALL ZTRSEN( 'E''V', SEL, 3, A, 3, B, 3, X, M, S( 1 ), SEP( 1 ),
215      $             WORK, 1, INFO )
216       CALL CHKXER( 'ZTRSEN', INFOT, NOUT, LERR, OK )
217       INFOT = 14
218       CALL ZTRSEN( 'V''V', SEL, 3, A, 3, B, 3, X, M, S( 1 ), SEP( 1 ),
219      $             WORK, 3, INFO )
220       CALL CHKXER( 'ZTRSEN', INFOT, NOUT, LERR, OK )
221       NT = NT + 8
222 *
223 *     Print a summary line.
224 *
225       IF( OK ) THEN
226          WRITE( NOUT, FMT = 9999 )PATH, NT
227       ELSE
228          WRITE( NOUT, FMT = 9998 )PATH
229       END IF
230 *
231  9999 FORMAT1X, A3, ' routines passed the tests of the error exits (',
232      $      I3, ' tests done)' )
233  9998 FORMAT' *** ', A3, ' routines failed the tests of the error ',
234      $      'exits ***' )
235       RETURN
236 *
237 *     End of ZERREC
238 *
239       END