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