LAPACK  3.9.1
LAPACK: Linear Algebra PACKage

◆ zerrec()

subroutine zerrec ( character*3  PATH,
integer  NUNIT 
)

ZERREC

Purpose:
 ZERREC tests the error exits for the routines for eigen- condition
 estimation for DOUBLE PRECISION matrices:
    ZTRSYL, ZTREXC, ZTRSNA and ZTRSEN.
Parameters
[in]PATH
          PATH is CHARACTER*3
          The LAPACK path name for the routines to be tested.
[in]NUNIT
          NUNIT is INTEGER
          The unit number for output.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.

Definition at line 55 of file zerrec.f.

56 *
57 * -- LAPACK test routine --
58 * -- LAPACK is a software package provided by Univ. of Tennessee, --
59 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
60 *
61 * .. Scalar Arguments ..
62  CHARACTER*3 PATH
63  INTEGER NUNIT
64 * ..
65 *
66 * =====================================================================
67 *
68 * .. Parameters ..
69  INTEGER NMAX, LW
70  parameter( nmax = 4, lw = nmax*( nmax+2 ) )
71  DOUBLE PRECISION ONE, ZERO
72  parameter( one = 1.0d0, zero = 0.0d0 )
73 * ..
74 * .. Local Scalars ..
75  INTEGER I, IFST, ILST, INFO, J, M, NT
76  DOUBLE PRECISION SCALE
77 * ..
78 * .. Local Arrays ..
79  LOGICAL SEL( NMAX )
80  DOUBLE PRECISION RW( LW ), S( NMAX ), SEP( NMAX )
81  COMPLEX*16 A( NMAX, NMAX ), B( NMAX, NMAX ),
82  $ C( NMAX, NMAX ), WORK( LW ), X( NMAX )
83 * ..
84 * .. External Subroutines ..
85  EXTERNAL chkxer, ztrexc, ztrsen, ztrsna, ztrsyl
86 * ..
87 * .. Scalars in Common ..
88  LOGICAL LERR, OK
89  CHARACTER*32 SRNAMT
90  INTEGER INFOT, NOUT
91 * ..
92 * .. Common blocks ..
93  COMMON / infoc / infot, nout, ok, lerr
94  COMMON / srnamc / srnamt
95 * ..
96 * .. Executable Statements ..
97 *
98  nout = nunit
99  ok = .true.
100  nt = 0
101 *
102 * Initialize A, B and SEL
103 *
104  DO 20 j = 1, nmax
105  DO 10 i = 1, nmax
106  a( i, j ) = zero
107  b( i, j ) = zero
108  10 CONTINUE
109  20 CONTINUE
110  DO 30 i = 1, nmax
111  a( i, i ) = one
112  sel( i ) = .true.
113  30 CONTINUE
114 *
115 * Test ZTRSYL
116 *
117  srnamt = 'ZTRSYL'
118  infot = 1
119  CALL ztrsyl( 'X', 'N', 1, 0, 0, a, 1, b, 1, c, 1, scale, info )
120  CALL chkxer( 'ZTRSYL', infot, nout, lerr, ok )
121  infot = 2
122  CALL ztrsyl( 'N', 'X', 1, 0, 0, a, 1, b, 1, c, 1, scale, info )
123  CALL chkxer( 'ZTRSYL', infot, nout, lerr, ok )
124  infot = 3
125  CALL ztrsyl( 'N', 'N', 0, 0, 0, a, 1, b, 1, c, 1, scale, info )
126  CALL chkxer( 'ZTRSYL', infot, nout, lerr, ok )
127  infot = 4
128  CALL ztrsyl( 'N', 'N', 1, -1, 0, a, 1, b, 1, c, 1, scale, info )
129  CALL chkxer( 'ZTRSYL', infot, nout, lerr, ok )
130  infot = 5
131  CALL ztrsyl( 'N', 'N', 1, 0, -1, a, 1, b, 1, c, 1, scale, info )
132  CALL chkxer( 'ZTRSYL', infot, nout, lerr, ok )
133  infot = 7
134  CALL ztrsyl( 'N', 'N', 1, 2, 0, a, 1, b, 1, c, 2, scale, info )
135  CALL chkxer( 'ZTRSYL', infot, nout, lerr, ok )
136  infot = 9
137  CALL ztrsyl( 'N', 'N', 1, 0, 2, a, 1, b, 1, c, 1, scale, info )
138  CALL chkxer( 'ZTRSYL', infot, nout, lerr, ok )
139  infot = 11
140  CALL ztrsyl( 'N', 'N', 1, 2, 0, a, 2, b, 1, c, 1, scale, info )
141  CALL chkxer( 'ZTRSYL', infot, nout, lerr, ok )
142  nt = nt + 8
143 *
144 * Test ZTREXC
145 *
146  srnamt = 'ZTREXC'
147  ifst = 1
148  ilst = 1
149  infot = 1
150  CALL ztrexc( 'X', 1, a, 1, b, 1, ifst, ilst, info )
151  CALL chkxer( 'ZTREXC', infot, nout, lerr, ok )
152  infot = 2
153  CALL ztrexc( 'N', -1, a, 1, b, 1, ifst, ilst, info )
154  CALL chkxer( 'ZTREXC', infot, nout, lerr, ok )
155  infot = 4
156  ilst = 2
157  CALL ztrexc( 'N', 2, a, 1, b, 1, ifst, ilst, info )
158  CALL chkxer( 'ZTREXC', infot, nout, lerr, ok )
159  infot = 6
160  CALL ztrexc( 'V', 2, a, 2, b, 1, ifst, ilst, info )
161  CALL chkxer( 'ZTREXC', infot, nout, lerr, ok )
162  infot = 7
163  ifst = 0
164  ilst = 1
165  CALL ztrexc( 'V', 1, a, 1, b, 1, ifst, ilst, info )
166  CALL chkxer( 'ZTREXC', infot, nout, lerr, ok )
167  infot = 7
168  ifst = 2
169  CALL ztrexc( 'V', 1, a, 1, b, 1, ifst, ilst, info )
170  CALL chkxer( 'ZTREXC', infot, nout, lerr, ok )
171  infot = 8
172  ifst = 1
173  ilst = 0
174  CALL ztrexc( 'V', 1, a, 1, b, 1, ifst, ilst, info )
175  CALL chkxer( 'ZTREXC', infot, nout, lerr, ok )
176  infot = 8
177  ilst = 2
178  CALL ztrexc( 'V', 1, a, 1, b, 1, ifst, ilst, info )
179  CALL chkxer( 'ZTREXC', infot, nout, lerr, ok )
180  nt = nt + 8
181 *
182 * Test ZTRSNA
183 *
184  srnamt = 'ZTRSNA'
185  infot = 1
186  CALL ztrsna( 'X', 'A', sel, 0, a, 1, b, 1, c, 1, s, sep, 1, m,
187  $ work, 1, rw, info )
188  CALL chkxer( 'ZTRSNA', infot, nout, lerr, ok )
189  infot = 2
190  CALL ztrsna( 'B', 'X', sel, 0, a, 1, b, 1, c, 1, s, sep, 1, m,
191  $ work, 1, rw, info )
192  CALL chkxer( 'ZTRSNA', infot, nout, lerr, ok )
193  infot = 4
194  CALL ztrsna( 'B', 'A', sel, -1, a, 1, b, 1, c, 1, s, sep, 1, m,
195  $ work, 1, rw, info )
196  CALL chkxer( 'ZTRSNA', infot, nout, lerr, ok )
197  infot = 6
198  CALL ztrsna( 'V', 'A', sel, 2, a, 1, b, 1, c, 1, s, sep, 2, m,
199  $ work, 2, rw, info )
200  CALL chkxer( 'ZTRSNA', infot, nout, lerr, ok )
201  infot = 8
202  CALL ztrsna( 'B', 'A', sel, 2, a, 2, b, 1, c, 2, s, sep, 2, m,
203  $ work, 2, rw, info )
204  CALL chkxer( 'ZTRSNA', infot, nout, lerr, ok )
205  infot = 10
206  CALL ztrsna( 'B', 'A', sel, 2, a, 2, b, 2, c, 1, s, sep, 2, m,
207  $ work, 2, rw, info )
208  CALL chkxer( 'ZTRSNA', infot, nout, lerr, ok )
209  infot = 13
210  CALL ztrsna( 'B', 'A', sel, 1, a, 1, b, 1, c, 1, s, sep, 0, m,
211  $ work, 1, rw, info )
212  CALL chkxer( 'ZTRSNA', infot, nout, lerr, ok )
213  infot = 13
214  CALL ztrsna( 'B', 'S', sel, 2, a, 2, b, 2, c, 2, s, sep, 1, m,
215  $ work, 1, rw, info )
216  CALL chkxer( 'ZTRSNA', infot, nout, lerr, ok )
217  infot = 16
218  CALL ztrsna( 'B', 'A', sel, 2, a, 2, b, 2, c, 2, s, sep, 2, m,
219  $ work, 1, rw, info )
220  CALL chkxer( 'ZTRSNA', infot, nout, lerr, ok )
221  nt = nt + 9
222 *
223 * Test ZTRSEN
224 *
225  sel( 1 ) = .false.
226  srnamt = 'ZTRSEN'
227  infot = 1
228  CALL ztrsen( 'X', 'N', sel, 0, a, 1, b, 1, x, m, s( 1 ), sep( 1 ),
229  $ work, 1, info )
230  CALL chkxer( 'ZTRSEN', infot, nout, lerr, ok )
231  infot = 2
232  CALL ztrsen( 'N', 'X', sel, 0, a, 1, b, 1, x, m, s( 1 ), sep( 1 ),
233  $ work, 1, info )
234  CALL chkxer( 'ZTRSEN', infot, nout, lerr, ok )
235  infot = 4
236  CALL ztrsen( 'N', 'N', sel, -1, a, 1, b, 1, x, m, s( 1 ),
237  $ sep( 1 ), work, 1, info )
238  CALL chkxer( 'ZTRSEN', infot, nout, lerr, ok )
239  infot = 6
240  CALL ztrsen( 'N', 'N', sel, 2, a, 1, b, 1, x, m, s( 1 ), sep( 1 ),
241  $ work, 2, info )
242  CALL chkxer( 'ZTRSEN', infot, nout, lerr, ok )
243  infot = 8
244  CALL ztrsen( 'N', 'V', sel, 2, a, 2, b, 1, x, m, s( 1 ), sep( 1 ),
245  $ work, 1, info )
246  CALL chkxer( 'ZTRSEN', infot, nout, lerr, ok )
247  infot = 14
248  CALL ztrsen( 'N', 'V', sel, 2, a, 2, b, 2, x, m, s( 1 ), sep( 1 ),
249  $ work, 0, info )
250  CALL chkxer( 'ZTRSEN', infot, nout, lerr, ok )
251  infot = 14
252  CALL ztrsen( 'E', 'V', sel, 3, a, 3, b, 3, x, m, s( 1 ), sep( 1 ),
253  $ work, 1, info )
254  CALL chkxer( 'ZTRSEN', infot, nout, lerr, ok )
255  infot = 14
256  CALL ztrsen( 'V', 'V', sel, 3, a, 3, b, 3, x, m, s( 1 ), sep( 1 ),
257  $ work, 3, info )
258  CALL chkxer( 'ZTRSEN', infot, nout, lerr, ok )
259  nt = nt + 8
260 *
261 * Print a summary line.
262 *
263  IF( ok ) THEN
264  WRITE( nout, fmt = 9999 )path, nt
265  ELSE
266  WRITE( nout, fmt = 9998 )path
267  END IF
268 *
269  9999 FORMAT( 1x, a3, ' routines passed the tests of the error exits (',
270  $ i3, ' tests done)' )
271  9998 FORMAT( ' *** ', a3, ' routines failed the tests of the error ',
272  $ 'exits ***' )
273  RETURN
274 *
275 * End of ZERREC
276 *
chkxer
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
Definition: cblat2.f:3196
ztrexc
subroutine ztrexc(COMPQ, N, T, LDT, Q, LDQ, IFST, ILST, INFO)
ZTREXC
Definition: ztrexc.f:126
ztrsna
subroutine ztrsna(JOB, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR, LDVR, S, SEP, MM, M, WORK, LDWORK, RWORK, INFO)
ZTRSNA
Definition: ztrsna.f:249
ztrsen
subroutine ztrsen(JOB, COMPQ, SELECT, N, T, LDT, Q, LDQ, W, M, S, SEP, WORK, LWORK, INFO)
ZTRSEN
Definition: ztrsen.f:264
ztrsyl
subroutine ztrsyl(TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C, LDC, SCALE, INFO)
ZTRSYL
Definition: ztrsyl.f:157
Here is the call graph for this function:
Here is the caller graph for this function: