LAPACK  3.8.0
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.
Date
December 2016

Definition at line 58 of file zerrec.f.

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