LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
subroutine zerrvx ( character*3  PATH,
integer  NUNIT 
)

ZERRVX

ZERRVXX

Purpose:
 ZERRVX tests the error exits for the COMPLEX*16 driver routines
 for solving linear systems of equations.
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
November 2013
Purpose:
 ZERRVX tests the error exits for the COMPLEX*16 driver routines
 for solving linear systems of equations.
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
November 2015

Definition at line 57 of file zerrvx.f.

57 *
58 * -- LAPACK test routine (version 3.5.0) --
59 * -- LAPACK is a software package provided by Univ. of Tennessee, --
60 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
61 * November 2013
62 *
63 * .. Scalar Arguments ..
64  CHARACTER*3 path
65  INTEGER nunit
66 * ..
67 *
68 * =====================================================================
69 *
70 * .. Parameters ..
71  INTEGER nmax
72  parameter ( nmax = 4 )
73 * ..
74 * .. Local Scalars ..
75  CHARACTER eq
76  CHARACTER*2 c2
77  INTEGER i, info, j
78  DOUBLE PRECISION rcond
79 * ..
80 * .. Local Arrays ..
81  INTEGER ip( nmax )
82  DOUBLE PRECISION c( nmax ), r( nmax ), r1( nmax ), r2( nmax ),
83  $ rf( nmax ), rw( nmax )
84  COMPLEX*16 a( nmax, nmax ), af( nmax, nmax ), b( nmax ),
85  $ w( 2*nmax ), x( nmax )
86 * ..
87 * .. External Functions ..
88  LOGICAL lsamen
89  EXTERNAL lsamen
90 * ..
91 * .. External Subroutines ..
92  EXTERNAL chkxer, zgbsv, zgbsvx, zgesv, zgesvx, zgtsv,
97 * ..
98 * .. Scalars in Common ..
99  LOGICAL lerr, ok
100  CHARACTER*32 srnamt
101  INTEGER infot, nout
102 * ..
103 * .. Common blocks ..
104  COMMON / infoc / infot, nout, ok, lerr
105  COMMON / srnamc / srnamt
106 * ..
107 * .. Intrinsic Functions ..
108  INTRINSIC dble, dcmplx
109 * ..
110 * .. Executable Statements ..
111 *
112  nout = nunit
113  WRITE( nout, fmt = * )
114  c2 = path( 2: 3 )
115 *
116 * Set the variables to innocuous values.
117 *
118  DO 20 j = 1, nmax
119  DO 10 i = 1, nmax
120  a( i, j ) = dcmplx( 1.d0 / dble( i+j ),
121  $ -1.d0 / dble( i+j ) )
122  af( i, j ) = dcmplx( 1.d0 / dble( i+j ),
123  $ -1.d0 / dble( i+j ) )
124  10 CONTINUE
125  b( j ) = 0.d0
126  r1( j ) = 0.d0
127  r2( j ) = 0.d0
128  w( j ) = 0.d0
129  x( j ) = 0.d0
130  c( j ) = 0.d0
131  r( j ) = 0.d0
132  ip( j ) = j
133  20 CONTINUE
134  eq = ' '
135  ok = .true.
136 *
137  IF( lsamen( 2, c2, 'GE' ) ) THEN
138 *
139 * ZGESV
140 *
141  srnamt = 'ZGESV '
142  infot = 1
143  CALL zgesv( -1, 0, a, 1, ip, b, 1, info )
144  CALL chkxer( 'ZGESV ', infot, nout, lerr, ok )
145  infot = 2
146  CALL zgesv( 0, -1, a, 1, ip, b, 1, info )
147  CALL chkxer( 'ZGESV ', infot, nout, lerr, ok )
148  infot = 4
149  CALL zgesv( 2, 1, a, 1, ip, b, 2, info )
150  CALL chkxer( 'ZGESV ', infot, nout, lerr, ok )
151  infot = 7
152  CALL zgesv( 2, 1, a, 2, ip, b, 1, info )
153  CALL chkxer( 'ZGESV ', infot, nout, lerr, ok )
154 *
155 * ZGESVX
156 *
157  srnamt = 'ZGESVX'
158  infot = 1
159  CALL zgesvx( '/', 'N', 0, 0, a, 1, af, 1, ip, eq, r, c, b, 1,
160  $ x, 1, rcond, r1, r2, w, rw, info )
161  CALL chkxer( 'ZGESVX', infot, nout, lerr, ok )
162  infot = 2
163  CALL zgesvx( 'N', '/', 0, 0, a, 1, af, 1, ip, eq, r, c, b, 1,
164  $ x, 1, rcond, r1, r2, w, rw, info )
165  CALL chkxer( 'ZGESVX', infot, nout, lerr, ok )
166  infot = 3
167  CALL zgesvx( 'N', 'N', -1, 0, a, 1, af, 1, ip, eq, r, c, b, 1,
168  $ x, 1, rcond, r1, r2, w, rw, info )
169  CALL chkxer( 'ZGESVX', infot, nout, lerr, ok )
170  infot = 4
171  CALL zgesvx( 'N', 'N', 0, -1, a, 1, af, 1, ip, eq, r, c, b, 1,
172  $ x, 1, rcond, r1, r2, w, rw, info )
173  CALL chkxer( 'ZGESVX', infot, nout, lerr, ok )
174  infot = 6
175  CALL zgesvx( 'N', 'N', 2, 1, a, 1, af, 2, ip, eq, r, c, b, 2,
176  $ x, 2, rcond, r1, r2, w, rw, info )
177  CALL chkxer( 'ZGESVX', infot, nout, lerr, ok )
178  infot = 8
179  CALL zgesvx( 'N', 'N', 2, 1, a, 2, af, 1, ip, eq, r, c, b, 2,
180  $ x, 2, rcond, r1, r2, w, rw, info )
181  CALL chkxer( 'ZGESVX', infot, nout, lerr, ok )
182  infot = 10
183  eq = '/'
184  CALL zgesvx( 'F', 'N', 0, 0, a, 1, af, 1, ip, eq, r, c, b, 1,
185  $ x, 1, rcond, r1, r2, w, rw, info )
186  CALL chkxer( 'ZGESVX', infot, nout, lerr, ok )
187  infot = 11
188  eq = 'R'
189  CALL zgesvx( 'F', 'N', 1, 0, a, 1, af, 1, ip, eq, r, c, b, 1,
190  $ x, 1, rcond, r1, r2, w, rw, info )
191  CALL chkxer( 'ZGESVX', infot, nout, lerr, ok )
192  infot = 12
193  eq = 'C'
194  CALL zgesvx( 'F', 'N', 1, 0, a, 1, af, 1, ip, eq, r, c, b, 1,
195  $ x, 1, rcond, r1, r2, w, rw, info )
196  CALL chkxer( 'ZGESVX', infot, nout, lerr, ok )
197  infot = 14
198  CALL zgesvx( 'N', 'N', 2, 1, a, 2, af, 2, ip, eq, r, c, b, 1,
199  $ x, 2, rcond, r1, r2, w, rw, info )
200  CALL chkxer( 'ZGESVX', infot, nout, lerr, ok )
201  infot = 16
202  CALL zgesvx( 'N', 'N', 2, 1, a, 2, af, 2, ip, eq, r, c, b, 2,
203  $ x, 1, rcond, r1, r2, w, rw, info )
204  CALL chkxer( 'ZGESVX', infot, nout, lerr, ok )
205 *
206  ELSE IF( lsamen( 2, c2, 'GB' ) ) THEN
207 *
208 * ZGBSV
209 *
210  srnamt = 'ZGBSV '
211  infot = 1
212  CALL zgbsv( -1, 0, 0, 0, a, 1, ip, b, 1, info )
213  CALL chkxer( 'ZGBSV ', infot, nout, lerr, ok )
214  infot = 2
215  CALL zgbsv( 1, -1, 0, 0, a, 1, ip, b, 1, info )
216  CALL chkxer( 'ZGBSV ', infot, nout, lerr, ok )
217  infot = 3
218  CALL zgbsv( 1, 0, -1, 0, a, 1, ip, b, 1, info )
219  CALL chkxer( 'ZGBSV ', infot, nout, lerr, ok )
220  infot = 4
221  CALL zgbsv( 0, 0, 0, -1, a, 1, ip, b, 1, info )
222  CALL chkxer( 'ZGBSV ', infot, nout, lerr, ok )
223  infot = 6
224  CALL zgbsv( 1, 1, 1, 0, a, 3, ip, b, 1, info )
225  CALL chkxer( 'ZGBSV ', infot, nout, lerr, ok )
226  infot = 9
227  CALL zgbsv( 2, 0, 0, 0, a, 1, ip, b, 1, info )
228  CALL chkxer( 'ZGBSV ', infot, nout, lerr, ok )
229 *
230 * ZGBSVX
231 *
232  srnamt = 'ZGBSVX'
233  infot = 1
234  CALL zgbsvx( '/', 'N', 0, 0, 0, 0, a, 1, af, 1, ip, eq, r, c,
235  $ b, 1, x, 1, rcond, r1, r2, w, rw, info )
236  CALL chkxer( 'ZGBSVX', infot, nout, lerr, ok )
237  infot = 2
238  CALL zgbsvx( 'N', '/', 0, 0, 0, 0, a, 1, af, 1, ip, eq, r, c,
239  $ b, 1, x, 1, rcond, r1, r2, w, rw, info )
240  CALL chkxer( 'ZGBSVX', infot, nout, lerr, ok )
241  infot = 3
242  CALL zgbsvx( 'N', 'N', -1, 0, 0, 0, a, 1, af, 1, ip, eq, r, c,
243  $ b, 1, x, 1, rcond, r1, r2, w, rw, info )
244  CALL chkxer( 'ZGBSVX', infot, nout, lerr, ok )
245  infot = 4
246  CALL zgbsvx( 'N', 'N', 1, -1, 0, 0, a, 1, af, 1, ip, eq, r, c,
247  $ b, 1, x, 1, rcond, r1, r2, w, rw, info )
248  CALL chkxer( 'ZGBSVX', infot, nout, lerr, ok )
249  infot = 5
250  CALL zgbsvx( 'N', 'N', 1, 0, -1, 0, a, 1, af, 1, ip, eq, r, c,
251  $ b, 1, x, 1, rcond, r1, r2, w, rw, info )
252  CALL chkxer( 'ZGBSVX', infot, nout, lerr, ok )
253  infot = 6
254  CALL zgbsvx( 'N', 'N', 0, 0, 0, -1, a, 1, af, 1, ip, eq, r, c,
255  $ b, 1, x, 1, rcond, r1, r2, w, rw, info )
256  CALL chkxer( 'ZGBSVX', infot, nout, lerr, ok )
257  infot = 8
258  CALL zgbsvx( 'N', 'N', 1, 1, 1, 0, a, 2, af, 4, ip, eq, r, c,
259  $ b, 1, x, 1, rcond, r1, r2, w, rw, info )
260  CALL chkxer( 'ZGBSVX', infot, nout, lerr, ok )
261  infot = 10
262  CALL zgbsvx( 'N', 'N', 1, 1, 1, 0, a, 3, af, 3, ip, eq, r, c,
263  $ b, 1, x, 1, rcond, r1, r2, w, rw, info )
264  CALL chkxer( 'ZGBSVX', infot, nout, lerr, ok )
265  infot = 12
266  eq = '/'
267  CALL zgbsvx( 'F', 'N', 0, 0, 0, 0, a, 1, af, 1, ip, eq, r, c,
268  $ b, 1, x, 1, rcond, r1, r2, w, rw, info )
269  CALL chkxer( 'ZGBSVX', infot, nout, lerr, ok )
270  infot = 13
271  eq = 'R'
272  CALL zgbsvx( 'F', 'N', 1, 0, 0, 0, a, 1, af, 1, ip, eq, r, c,
273  $ b, 1, x, 1, rcond, r1, r2, w, rw, info )
274  CALL chkxer( 'ZGBSVX', infot, nout, lerr, ok )
275  infot = 14
276  eq = 'C'
277  CALL zgbsvx( 'F', 'N', 1, 0, 0, 0, a, 1, af, 1, ip, eq, r, c,
278  $ b, 1, x, 1, rcond, r1, r2, w, rw, info )
279  CALL chkxer( 'ZGBSVX', infot, nout, lerr, ok )
280  infot = 16
281  CALL zgbsvx( 'N', 'N', 2, 0, 0, 0, a, 1, af, 1, ip, eq, r, c,
282  $ b, 1, x, 2, rcond, r1, r2, w, rw, info )
283  CALL chkxer( 'ZGBSVX', infot, nout, lerr, ok )
284  infot = 18
285  CALL zgbsvx( 'N', 'N', 2, 0, 0, 0, a, 1, af, 1, ip, eq, r, c,
286  $ b, 2, x, 1, rcond, r1, r2, w, rw, info )
287  CALL chkxer( 'ZGBSVX', infot, nout, lerr, ok )
288 *
289  ELSE IF( lsamen( 2, c2, 'GT' ) ) THEN
290 *
291 * ZGTSV
292 *
293  srnamt = 'ZGTSV '
294  infot = 1
295  CALL zgtsv( -1, 0, a( 1, 1 ), a( 1, 2 ), a( 1, 3 ), b, 1,
296  $ info )
297  CALL chkxer( 'ZGTSV ', infot, nout, lerr, ok )
298  infot = 2
299  CALL zgtsv( 0, -1, a( 1, 1 ), a( 1, 2 ), a( 1, 3 ), b, 1,
300  $ info )
301  CALL chkxer( 'ZGTSV ', infot, nout, lerr, ok )
302  infot = 7
303  CALL zgtsv( 2, 0, a( 1, 1 ), a( 1, 2 ), a( 1, 3 ), b, 1, info )
304  CALL chkxer( 'ZGTSV ', infot, nout, lerr, ok )
305 *
306 * ZGTSVX
307 *
308  srnamt = 'ZGTSVX'
309  infot = 1
310  CALL zgtsvx( '/', 'N', 0, 0, a( 1, 1 ), a( 1, 2 ), a( 1, 3 ),
311  $ af( 1, 1 ), af( 1, 2 ), af( 1, 3 ), af( 1, 4 ),
312  $ ip, b, 1, x, 1, rcond, r1, r2, w, rw, info )
313  CALL chkxer( 'ZGTSVX', infot, nout, lerr, ok )
314  infot = 2
315  CALL zgtsvx( 'N', '/', 0, 0, a( 1, 1 ), a( 1, 2 ), a( 1, 3 ),
316  $ af( 1, 1 ), af( 1, 2 ), af( 1, 3 ), af( 1, 4 ),
317  $ ip, b, 1, x, 1, rcond, r1, r2, w, rw, info )
318  CALL chkxer( 'ZGTSVX', infot, nout, lerr, ok )
319  infot = 3
320  CALL zgtsvx( 'N', 'N', -1, 0, a( 1, 1 ), a( 1, 2 ), a( 1, 3 ),
321  $ af( 1, 1 ), af( 1, 2 ), af( 1, 3 ), af( 1, 4 ),
322  $ ip, b, 1, x, 1, rcond, r1, r2, w, rw, info )
323  CALL chkxer( 'ZGTSVX', infot, nout, lerr, ok )
324  infot = 4
325  CALL zgtsvx( 'N', 'N', 0, -1, a( 1, 1 ), a( 1, 2 ), a( 1, 3 ),
326  $ af( 1, 1 ), af( 1, 2 ), af( 1, 3 ), af( 1, 4 ),
327  $ ip, b, 1, x, 1, rcond, r1, r2, w, rw, info )
328  CALL chkxer( 'ZGTSVX', infot, nout, lerr, ok )
329  infot = 14
330  CALL zgtsvx( 'N', 'N', 2, 0, a( 1, 1 ), a( 1, 2 ), a( 1, 3 ),
331  $ af( 1, 1 ), af( 1, 2 ), af( 1, 3 ), af( 1, 4 ),
332  $ ip, b, 1, x, 2, rcond, r1, r2, w, rw, info )
333  CALL chkxer( 'ZGTSVX', infot, nout, lerr, ok )
334  infot = 16
335  CALL zgtsvx( 'N', 'N', 2, 0, a( 1, 1 ), a( 1, 2 ), a( 1, 3 ),
336  $ af( 1, 1 ), af( 1, 2 ), af( 1, 3 ), af( 1, 4 ),
337  $ ip, b, 2, x, 1, rcond, r1, r2, w, rw, info )
338  CALL chkxer( 'ZGTSVX', infot, nout, lerr, ok )
339 *
340  ELSE IF( lsamen( 2, c2, 'PO' ) ) THEN
341 *
342 * ZPOSV
343 *
344  srnamt = 'ZPOSV '
345  infot = 1
346  CALL zposv( '/', 0, 0, a, 1, b, 1, info )
347  CALL chkxer( 'ZPOSV ', infot, nout, lerr, ok )
348  infot = 2
349  CALL zposv( 'U', -1, 0, a, 1, b, 1, info )
350  CALL chkxer( 'ZPOSV ', infot, nout, lerr, ok )
351  infot = 3
352  CALL zposv( 'U', 0, -1, a, 1, b, 1, info )
353  CALL chkxer( 'ZPOSV ', infot, nout, lerr, ok )
354  infot = 5
355  CALL zposv( 'U', 2, 0, a, 1, b, 2, info )
356  CALL chkxer( 'ZPOSV ', infot, nout, lerr, ok )
357  infot = 7
358  CALL zposv( 'U', 2, 0, a, 2, b, 1, info )
359  CALL chkxer( 'ZPOSV ', infot, nout, lerr, ok )
360 *
361 * ZPOSVX
362 *
363  srnamt = 'ZPOSVX'
364  infot = 1
365  CALL zposvx( '/', 'U', 0, 0, a, 1, af, 1, eq, c, b, 1, x, 1,
366  $ rcond, r1, r2, w, rw, info )
367  CALL chkxer( 'ZPOSVX', infot, nout, lerr, ok )
368  infot = 2
369  CALL zposvx( 'N', '/', 0, 0, a, 1, af, 1, eq, c, b, 1, x, 1,
370  $ rcond, r1, r2, w, rw, info )
371  CALL chkxer( 'ZPOSVX', infot, nout, lerr, ok )
372  infot = 3
373  CALL zposvx( 'N', 'U', -1, 0, a, 1, af, 1, eq, c, b, 1, x, 1,
374  $ rcond, r1, r2, w, rw, info )
375  CALL chkxer( 'ZPOSVX', infot, nout, lerr, ok )
376  infot = 4
377  CALL zposvx( 'N', 'U', 0, -1, a, 1, af, 1, eq, c, b, 1, x, 1,
378  $ rcond, r1, r2, w, rw, info )
379  CALL chkxer( 'ZPOSVX', infot, nout, lerr, ok )
380  infot = 6
381  CALL zposvx( 'N', 'U', 2, 0, a, 1, af, 2, eq, c, b, 2, x, 2,
382  $ rcond, r1, r2, w, rw, info )
383  CALL chkxer( 'ZPOSVX', infot, nout, lerr, ok )
384  infot = 8
385  CALL zposvx( 'N', 'U', 2, 0, a, 2, af, 1, eq, c, b, 2, x, 2,
386  $ rcond, r1, r2, w, rw, info )
387  CALL chkxer( 'ZPOSVX', infot, nout, lerr, ok )
388  infot = 9
389  eq = '/'
390  CALL zposvx( 'F', 'U', 0, 0, a, 1, af, 1, eq, c, b, 1, x, 1,
391  $ rcond, r1, r2, w, rw, info )
392  CALL chkxer( 'ZPOSVX', infot, nout, lerr, ok )
393  infot = 10
394  eq = 'Y'
395  CALL zposvx( 'F', 'U', 1, 0, a, 1, af, 1, eq, c, b, 1, x, 1,
396  $ rcond, r1, r2, w, rw, info )
397  CALL chkxer( 'ZPOSVX', infot, nout, lerr, ok )
398  infot = 12
399  CALL zposvx( 'N', 'U', 2, 0, a, 2, af, 2, eq, c, b, 1, x, 2,
400  $ rcond, r1, r2, w, rw, info )
401  CALL chkxer( 'ZPOSVX', infot, nout, lerr, ok )
402  infot = 14
403  CALL zposvx( 'N', 'U', 2, 0, a, 2, af, 2, eq, c, b, 2, x, 1,
404  $ rcond, r1, r2, w, rw, info )
405  CALL chkxer( 'ZPOSVX', infot, nout, lerr, ok )
406 *
407  ELSE IF( lsamen( 2, c2, 'PP' ) ) THEN
408 *
409 * ZPPSV
410 *
411  srnamt = 'ZPPSV '
412  infot = 1
413  CALL zppsv( '/', 0, 0, a, b, 1, info )
414  CALL chkxer( 'ZPPSV ', infot, nout, lerr, ok )
415  infot = 2
416  CALL zppsv( 'U', -1, 0, a, b, 1, info )
417  CALL chkxer( 'ZPPSV ', infot, nout, lerr, ok )
418  infot = 3
419  CALL zppsv( 'U', 0, -1, a, b, 1, info )
420  CALL chkxer( 'ZPPSV ', infot, nout, lerr, ok )
421  infot = 6
422  CALL zppsv( 'U', 2, 0, a, b, 1, info )
423  CALL chkxer( 'ZPPSV ', infot, nout, lerr, ok )
424 *
425 * ZPPSVX
426 *
427  srnamt = 'ZPPSVX'
428  infot = 1
429  CALL zppsvx( '/', 'U', 0, 0, a, af, eq, c, b, 1, x, 1, rcond,
430  $ r1, r2, w, rw, info )
431  CALL chkxer( 'ZPPSVX', infot, nout, lerr, ok )
432  infot = 2
433  CALL zppsvx( 'N', '/', 0, 0, a, af, eq, c, b, 1, x, 1, rcond,
434  $ r1, r2, w, rw, info )
435  CALL chkxer( 'ZPPSVX', infot, nout, lerr, ok )
436  infot = 3
437  CALL zppsvx( 'N', 'U', -1, 0, a, af, eq, c, b, 1, x, 1, rcond,
438  $ r1, r2, w, rw, info )
439  CALL chkxer( 'ZPPSVX', infot, nout, lerr, ok )
440  infot = 4
441  CALL zppsvx( 'N', 'U', 0, -1, a, af, eq, c, b, 1, x, 1, rcond,
442  $ r1, r2, w, rw, info )
443  CALL chkxer( 'ZPPSVX', infot, nout, lerr, ok )
444  infot = 7
445  eq = '/'
446  CALL zppsvx( 'F', 'U', 0, 0, a, af, eq, c, b, 1, x, 1, rcond,
447  $ r1, r2, w, rw, info )
448  CALL chkxer( 'ZPPSVX', infot, nout, lerr, ok )
449  infot = 8
450  eq = 'Y'
451  CALL zppsvx( 'F', 'U', 1, 0, a, af, eq, c, b, 1, x, 1, rcond,
452  $ r1, r2, w, rw, info )
453  CALL chkxer( 'ZPPSVX', infot, nout, lerr, ok )
454  infot = 10
455  CALL zppsvx( 'N', 'U', 2, 0, a, af, eq, c, b, 1, x, 2, rcond,
456  $ r1, r2, w, rw, info )
457  CALL chkxer( 'ZPPSVX', infot, nout, lerr, ok )
458  infot = 12
459  CALL zppsvx( 'N', 'U', 2, 0, a, af, eq, c, b, 2, x, 1, rcond,
460  $ r1, r2, w, rw, info )
461  CALL chkxer( 'ZPPSVX', infot, nout, lerr, ok )
462 *
463  ELSE IF( lsamen( 2, c2, 'PB' ) ) THEN
464 *
465 * ZPBSV
466 *
467  srnamt = 'ZPBSV '
468  infot = 1
469  CALL zpbsv( '/', 0, 0, 0, a, 1, b, 1, info )
470  CALL chkxer( 'ZPBSV ', infot, nout, lerr, ok )
471  infot = 2
472  CALL zpbsv( 'U', -1, 0, 0, a, 1, b, 1, info )
473  CALL chkxer( 'ZPBSV ', infot, nout, lerr, ok )
474  infot = 3
475  CALL zpbsv( 'U', 1, -1, 0, a, 1, b, 1, info )
476  CALL chkxer( 'ZPBSV ', infot, nout, lerr, ok )
477  infot = 4
478  CALL zpbsv( 'U', 0, 0, -1, a, 1, b, 1, info )
479  CALL chkxer( 'ZPBSV ', infot, nout, lerr, ok )
480  infot = 6
481  CALL zpbsv( 'U', 1, 1, 0, a, 1, b, 2, info )
482  CALL chkxer( 'ZPBSV ', infot, nout, lerr, ok )
483  infot = 8
484  CALL zpbsv( 'U', 2, 0, 0, a, 1, b, 1, info )
485  CALL chkxer( 'ZPBSV ', infot, nout, lerr, ok )
486 *
487 * ZPBSVX
488 *
489  srnamt = 'ZPBSVX'
490  infot = 1
491  CALL zpbsvx( '/', 'U', 0, 0, 0, a, 1, af, 1, eq, c, b, 1, x, 1,
492  $ rcond, r1, r2, w, rw, info )
493  CALL chkxer( 'ZPBSVX', infot, nout, lerr, ok )
494  infot = 2
495  CALL zpbsvx( 'N', '/', 0, 0, 0, a, 1, af, 1, eq, c, b, 1, x, 1,
496  $ rcond, r1, r2, w, rw, info )
497  CALL chkxer( 'ZPBSVX', infot, nout, lerr, ok )
498  infot = 3
499  CALL zpbsvx( 'N', 'U', -1, 0, 0, a, 1, af, 1, eq, c, b, 1, x,
500  $ 1, rcond, r1, r2, w, rw, info )
501  CALL chkxer( 'ZPBSVX', infot, nout, lerr, ok )
502  infot = 4
503  CALL zpbsvx( 'N', 'U', 1, -1, 0, a, 1, af, 1, eq, c, b, 1, x,
504  $ 1, rcond, r1, r2, w, rw, info )
505  CALL chkxer( 'ZPBSVX', infot, nout, lerr, ok )
506  infot = 5
507  CALL zpbsvx( 'N', 'U', 0, 0, -1, a, 1, af, 1, eq, c, b, 1, x,
508  $ 1, rcond, r1, r2, w, rw, info )
509  CALL chkxer( 'ZPBSVX', infot, nout, lerr, ok )
510  infot = 7
511  CALL zpbsvx( 'N', 'U', 1, 1, 0, a, 1, af, 2, eq, c, b, 2, x, 2,
512  $ rcond, r1, r2, w, rw, info )
513  CALL chkxer( 'ZPBSVX', infot, nout, lerr, ok )
514  infot = 9
515  CALL zpbsvx( 'N', 'U', 1, 1, 0, a, 2, af, 1, eq, c, b, 2, x, 2,
516  $ rcond, r1, r2, w, rw, info )
517  CALL chkxer( 'ZPBSVX', infot, nout, lerr, ok )
518  infot = 10
519  eq = '/'
520  CALL zpbsvx( 'F', 'U', 0, 0, 0, a, 1, af, 1, eq, c, b, 1, x, 1,
521  $ rcond, r1, r2, w, rw, info )
522  CALL chkxer( 'ZPBSVX', infot, nout, lerr, ok )
523  infot = 11
524  eq = 'Y'
525  CALL zpbsvx( 'F', 'U', 1, 0, 0, a, 1, af, 1, eq, c, b, 1, x, 1,
526  $ rcond, r1, r2, w, rw, info )
527  CALL chkxer( 'ZPBSVX', infot, nout, lerr, ok )
528  infot = 13
529  CALL zpbsvx( 'N', 'U', 2, 0, 0, a, 1, af, 1, eq, c, b, 1, x, 2,
530  $ rcond, r1, r2, w, rw, info )
531  CALL chkxer( 'ZPBSVX', infot, nout, lerr, ok )
532  infot = 15
533  CALL zpbsvx( 'N', 'U', 2, 0, 0, a, 1, af, 1, eq, c, b, 2, x, 1,
534  $ rcond, r1, r2, w, rw, info )
535  CALL chkxer( 'ZPBSVX', infot, nout, lerr, ok )
536 *
537  ELSE IF( lsamen( 2, c2, 'PT' ) ) THEN
538 *
539 * ZPTSV
540 *
541  srnamt = 'ZPTSV '
542  infot = 1
543  CALL zptsv( -1, 0, r, a( 1, 1 ), b, 1, info )
544  CALL chkxer( 'ZPTSV ', infot, nout, lerr, ok )
545  infot = 2
546  CALL zptsv( 0, -1, r, a( 1, 1 ), b, 1, info )
547  CALL chkxer( 'ZPTSV ', infot, nout, lerr, ok )
548  infot = 6
549  CALL zptsv( 2, 0, r, a( 1, 1 ), b, 1, info )
550  CALL chkxer( 'ZPTSV ', infot, nout, lerr, ok )
551 *
552 * ZPTSVX
553 *
554  srnamt = 'ZPTSVX'
555  infot = 1
556  CALL zptsvx( '/', 0, 0, r, a( 1, 1 ), rf, af( 1, 1 ), b, 1, x,
557  $ 1, rcond, r1, r2, w, rw, info )
558  CALL chkxer( 'ZPTSVX', infot, nout, lerr, ok )
559  infot = 2
560  CALL zptsvx( 'N', -1, 0, r, a( 1, 1 ), rf, af( 1, 1 ), b, 1, x,
561  $ 1, rcond, r1, r2, w, rw, info )
562  CALL chkxer( 'ZPTSVX', infot, nout, lerr, ok )
563  infot = 3
564  CALL zptsvx( 'N', 0, -1, r, a( 1, 1 ), rf, af( 1, 1 ), b, 1, x,
565  $ 1, rcond, r1, r2, w, rw, info )
566  CALL chkxer( 'ZPTSVX', infot, nout, lerr, ok )
567  infot = 9
568  CALL zptsvx( 'N', 2, 0, r, a( 1, 1 ), rf, af( 1, 1 ), b, 1, x,
569  $ 2, rcond, r1, r2, w, rw, info )
570  CALL chkxer( 'ZPTSVX', infot, nout, lerr, ok )
571  infot = 11
572  CALL zptsvx( 'N', 2, 0, r, a( 1, 1 ), rf, af( 1, 1 ), b, 2, x,
573  $ 1, rcond, r1, r2, w, rw, info )
574  CALL chkxer( 'ZPTSVX', infot, nout, lerr, ok )
575 *
576  ELSE IF( lsamen( 2, c2, 'HE' ) ) THEN
577 *
578 * ZHESV
579 *
580  srnamt = 'ZHESV '
581  infot = 1
582  CALL zhesv( '/', 0, 0, a, 1, ip, b, 1, w, 1, info )
583  CALL chkxer( 'ZHESV ', infot, nout, lerr, ok )
584  infot = 2
585  CALL zhesv( 'U', -1, 0, a, 1, ip, b, 1, w, 1, info )
586  CALL chkxer( 'ZHESV ', infot, nout, lerr, ok )
587  infot = 3
588  CALL zhesv( 'U', 0, -1, a, 1, ip, b, 1, w, 1, info )
589  CALL chkxer( 'ZHESV ', infot, nout, lerr, ok )
590  infot = 5
591  CALL zhesv( 'U', 2, 0, a, 1, ip, b, 2, w, 1, info )
592  CALL chkxer( 'ZHESV ', infot, nout, lerr, ok )
593  infot = 8
594  CALL zhesv( 'U', 2, 0, a, 2, ip, b, 1, w, 1, info )
595  CALL chkxer( 'ZHESV ', infot, nout, lerr, ok )
596 *
597 * ZHESVX
598 *
599  srnamt = 'ZHESVX'
600  infot = 1
601  CALL zhesvx( '/', 'U', 0, 0, a, 1, af, 1, ip, b, 1, x, 1,
602  $ rcond, r1, r2, w, 1, rw, info )
603  CALL chkxer( 'ZHESVX', infot, nout, lerr, ok )
604  infot = 2
605  CALL zhesvx( 'N', '/', 0, 0, a, 1, af, 1, ip, b, 1, x, 1,
606  $ rcond, r1, r2, w, 1, rw, info )
607  CALL chkxer( 'ZHESVX', infot, nout, lerr, ok )
608  infot = 3
609  CALL zhesvx( 'N', 'U', -1, 0, a, 1, af, 1, ip, b, 1, x, 1,
610  $ rcond, r1, r2, w, 1, rw, info )
611  CALL chkxer( 'ZHESVX', infot, nout, lerr, ok )
612  infot = 4
613  CALL zhesvx( 'N', 'U', 0, -1, a, 1, af, 1, ip, b, 1, x, 1,
614  $ rcond, r1, r2, w, 1, rw, info )
615  CALL chkxer( 'ZHESVX', infot, nout, lerr, ok )
616  infot = 6
617  CALL zhesvx( 'N', 'U', 2, 0, a, 1, af, 2, ip, b, 2, x, 2,
618  $ rcond, r1, r2, w, 4, rw, info )
619  CALL chkxer( 'ZHESVX', infot, nout, lerr, ok )
620  infot = 8
621  CALL zhesvx( 'N', 'U', 2, 0, a, 2, af, 1, ip, b, 2, x, 2,
622  $ rcond, r1, r2, w, 4, rw, info )
623  CALL chkxer( 'ZHESVX', infot, nout, lerr, ok )
624  infot = 11
625  CALL zhesvx( 'N', 'U', 2, 0, a, 2, af, 2, ip, b, 1, x, 2,
626  $ rcond, r1, r2, w, 4, rw, info )
627  CALL chkxer( 'ZHESVX', infot, nout, lerr, ok )
628  infot = 13
629  CALL zhesvx( 'N', 'U', 2, 0, a, 2, af, 2, ip, b, 2, x, 1,
630  $ rcond, r1, r2, w, 4, rw, info )
631  CALL chkxer( 'ZHESVX', infot, nout, lerr, ok )
632  infot = 18
633  CALL zhesvx( 'N', 'U', 2, 0, a, 2, af, 2, ip, b, 2, x, 2,
634  $ rcond, r1, r2, w, 3, rw, info )
635  CALL chkxer( 'ZHESVX', infot, nout, lerr, ok )
636 *
637  ELSE IF( lsamen( 2, c2, 'HR' ) ) THEN
638 *
639 * ZHESV_ROOK
640 *
641  srnamt = 'ZHESV_ROOK'
642  infot = 1
643  CALL zhesv_rook( '/', 0, 0, a, 1, ip, b, 1, w, 1, info )
644  CALL chkxer( 'ZHESV_ROOK', infot, nout, lerr, ok )
645  infot = 2
646  CALL zhesv_rook( 'U', -1, 0, a, 1, ip, b, 1, w, 1, info )
647  CALL chkxer( 'ZHESV_ROOK', infot, nout, lerr, ok )
648  infot = 3
649  CALL zhesv_rook( 'U', 0, -1, a, 1, ip, b, 1, w, 1, info )
650  CALL chkxer( 'ZHESV_ROOK', infot, nout, lerr, ok )
651  infot = 8
652  CALL zhesv_rook( 'U', 2, 0, a, 2, ip, b, 1, w, 1, info )
653  CALL chkxer( 'ZHESV_ROOK', infot, nout, lerr, ok )
654 *
655  ELSE IF( lsamen( 2, c2, 'HP' ) ) THEN
656 *
657 * ZHPSV
658 *
659  srnamt = 'ZHPSV '
660  infot = 1
661  CALL zhpsv( '/', 0, 0, a, ip, b, 1, info )
662  CALL chkxer( 'ZHPSV ', infot, nout, lerr, ok )
663  infot = 2
664  CALL zhpsv( 'U', -1, 0, a, ip, b, 1, info )
665  CALL chkxer( 'ZHPSV ', infot, nout, lerr, ok )
666  infot = 3
667  CALL zhpsv( 'U', 0, -1, a, ip, b, 1, info )
668  CALL chkxer( 'ZHPSV ', infot, nout, lerr, ok )
669  infot = 7
670  CALL zhpsv( 'U', 2, 0, a, ip, b, 1, info )
671  CALL chkxer( 'ZHPSV ', infot, nout, lerr, ok )
672 *
673 * ZHPSVX
674 *
675  srnamt = 'ZHPSVX'
676  infot = 1
677  CALL zhpsvx( '/', 'U', 0, 0, a, af, ip, b, 1, x, 1, rcond, r1,
678  $ r2, w, rw, info )
679  CALL chkxer( 'ZHPSVX', infot, nout, lerr, ok )
680  infot = 2
681  CALL zhpsvx( 'N', '/', 0, 0, a, af, ip, b, 1, x, 1, rcond, r1,
682  $ r2, w, rw, info )
683  CALL chkxer( 'ZHPSVX', infot, nout, lerr, ok )
684  infot = 3
685  CALL zhpsvx( 'N', 'U', -1, 0, a, af, ip, b, 1, x, 1, rcond, r1,
686  $ r2, w, rw, info )
687  CALL chkxer( 'ZHPSVX', infot, nout, lerr, ok )
688  infot = 4
689  CALL zhpsvx( 'N', 'U', 0, -1, a, af, ip, b, 1, x, 1, rcond, r1,
690  $ r2, w, rw, info )
691  CALL chkxer( 'ZHPSVX', infot, nout, lerr, ok )
692  infot = 9
693  CALL zhpsvx( 'N', 'U', 2, 0, a, af, ip, b, 1, x, 2, rcond, r1,
694  $ r2, w, rw, info )
695  CALL chkxer( 'ZHPSVX', infot, nout, lerr, ok )
696  infot = 11
697  CALL zhpsvx( 'N', 'U', 2, 0, a, af, ip, b, 2, x, 1, rcond, r1,
698  $ r2, w, rw, info )
699  CALL chkxer( 'ZHPSVX', infot, nout, lerr, ok )
700 *
701  ELSE IF( lsamen( 2, c2, 'SY' ) ) THEN
702 *
703 * ZSYSV
704 *
705  srnamt = 'ZSYSV '
706  infot = 1
707  CALL zsysv( '/', 0, 0, a, 1, ip, b, 1, w, 1, info )
708  CALL chkxer( 'ZSYSV ', infot, nout, lerr, ok )
709  infot = 2
710  CALL zsysv( 'U', -1, 0, a, 1, ip, b, 1, w, 1, info )
711  CALL chkxer( 'ZSYSV ', infot, nout, lerr, ok )
712  infot = 3
713  CALL zsysv( 'U', 0, -1, a, 1, ip, b, 1, w, 1, info )
714  CALL chkxer( 'ZSYSV ', infot, nout, lerr, ok )
715  infot = 8
716  CALL zsysv( 'U', 2, 0, a, 2, ip, b, 1, w, 1, info )
717  CALL chkxer( 'ZSYSV ', infot, nout, lerr, ok )
718 *
719 * ZSYSVX
720 *
721  srnamt = 'ZSYSVX'
722  infot = 1
723  CALL zsysvx( '/', 'U', 0, 0, a, 1, af, 1, ip, b, 1, x, 1,
724  $ rcond, r1, r2, w, 1, rw, info )
725  CALL chkxer( 'ZSYSVX', infot, nout, lerr, ok )
726  infot = 2
727  CALL zsysvx( 'N', '/', 0, 0, a, 1, af, 1, ip, b, 1, x, 1,
728  $ rcond, r1, r2, w, 1, rw, info )
729  CALL chkxer( 'ZSYSVX', infot, nout, lerr, ok )
730  infot = 3
731  CALL zsysvx( 'N', 'U', -1, 0, a, 1, af, 1, ip, b, 1, x, 1,
732  $ rcond, r1, r2, w, 1, rw, info )
733  CALL chkxer( 'ZSYSVX', infot, nout, lerr, ok )
734  infot = 4
735  CALL zsysvx( 'N', 'U', 0, -1, a, 1, af, 1, ip, b, 1, x, 1,
736  $ rcond, r1, r2, w, 1, rw, info )
737  CALL chkxer( 'ZSYSVX', infot, nout, lerr, ok )
738  infot = 6
739  CALL zsysvx( 'N', 'U', 2, 0, a, 1, af, 2, ip, b, 2, x, 2,
740  $ rcond, r1, r2, w, 4, rw, info )
741  CALL chkxer( 'ZSYSVX', infot, nout, lerr, ok )
742  infot = 8
743  CALL zsysvx( 'N', 'U', 2, 0, a, 2, af, 1, ip, b, 2, x, 2,
744  $ rcond, r1, r2, w, 4, rw, info )
745  CALL chkxer( 'ZSYSVX', infot, nout, lerr, ok )
746  infot = 11
747  CALL zsysvx( 'N', 'U', 2, 0, a, 2, af, 2, ip, b, 1, x, 2,
748  $ rcond, r1, r2, w, 4, rw, info )
749  CALL chkxer( 'ZSYSVX', infot, nout, lerr, ok )
750  infot = 13
751  CALL zsysvx( 'N', 'U', 2, 0, a, 2, af, 2, ip, b, 2, x, 1,
752  $ rcond, r1, r2, w, 4, rw, info )
753  CALL chkxer( 'ZSYSVX', infot, nout, lerr, ok )
754  infot = 18
755  CALL zsysvx( 'N', 'U', 2, 0, a, 2, af, 2, ip, b, 2, x, 2,
756  $ rcond, r1, r2, w, 3, rw, info )
757  CALL chkxer( 'ZSYSVX', infot, nout, lerr, ok )
758 *
759  ELSE IF( lsamen( 2, c2, 'SR' ) ) THEN
760 *
761 * ZSYSV_ROOK
762 *
763  srnamt = 'ZSYSV_ROOK'
764  infot = 1
765  CALL zsysv_rook( '/', 0, 0, a, 1, ip, b, 1, w, 1, info )
766  CALL chkxer( 'ZSYSV_ROOK', infot, nout, lerr, ok )
767  infot = 2
768  CALL zsysv_rook( 'U', -1, 0, a, 1, ip, b, 1, w, 1, info )
769  CALL chkxer( 'ZSYSV_ROOK', infot, nout, lerr, ok )
770  infot = 3
771  CALL zsysv_rook( 'U', 0, -1, a, 1, ip, b, 1, w, 1, info )
772  CALL chkxer( 'ZSYSV_ROOK', infot, nout, lerr, ok )
773  infot = 8
774  CALL zsysv_rook( 'U', 2, 0, a, 2, ip, b, 1, w, 1, info )
775  CALL chkxer( 'ZSYSV_ROOK', infot, nout, lerr, ok )
776 *
777  ELSE IF( lsamen( 2, c2, 'SP' ) ) THEN
778 *
779 * ZSPSV
780 *
781  srnamt = 'ZSPSV '
782  infot = 1
783  CALL zspsv( '/', 0, 0, a, ip, b, 1, info )
784  CALL chkxer( 'ZSPSV ', infot, nout, lerr, ok )
785  infot = 2
786  CALL zspsv( 'U', -1, 0, a, ip, b, 1, info )
787  CALL chkxer( 'ZSPSV ', infot, nout, lerr, ok )
788  infot = 3
789  CALL zspsv( 'U', 0, -1, a, ip, b, 1, info )
790  CALL chkxer( 'ZSPSV ', infot, nout, lerr, ok )
791  infot = 7
792  CALL zspsv( 'U', 2, 0, a, ip, b, 1, info )
793  CALL chkxer( 'ZSPSV ', infot, nout, lerr, ok )
794 *
795 * ZSPSVX
796 *
797  srnamt = 'ZSPSVX'
798  infot = 1
799  CALL zspsvx( '/', 'U', 0, 0, a, af, ip, b, 1, x, 1, rcond, r1,
800  $ r2, w, rw, info )
801  CALL chkxer( 'ZSPSVX', infot, nout, lerr, ok )
802  infot = 2
803  CALL zspsvx( 'N', '/', 0, 0, a, af, ip, b, 1, x, 1, rcond, r1,
804  $ r2, w, rw, info )
805  CALL chkxer( 'ZSPSVX', infot, nout, lerr, ok )
806  infot = 3
807  CALL zspsvx( 'N', 'U', -1, 0, a, af, ip, b, 1, x, 1, rcond, r1,
808  $ r2, w, rw, info )
809  CALL chkxer( 'ZSPSVX', infot, nout, lerr, ok )
810  infot = 4
811  CALL zspsvx( 'N', 'U', 0, -1, a, af, ip, b, 1, x, 1, rcond, r1,
812  $ r2, w, rw, info )
813  CALL chkxer( 'ZSPSVX', infot, nout, lerr, ok )
814  infot = 9
815  CALL zspsvx( 'N', 'U', 2, 0, a, af, ip, b, 1, x, 2, rcond, r1,
816  $ r2, w, rw, info )
817  CALL chkxer( 'ZSPSVX', infot, nout, lerr, ok )
818  infot = 11
819  CALL zspsvx( 'N', 'U', 2, 0, a, af, ip, b, 2, x, 1, rcond, r1,
820  $ r2, w, rw, info )
821  CALL chkxer( 'ZSPSVX', infot, nout, lerr, ok )
822  END IF
823 *
824 * Print a summary line.
825 *
826  IF( ok ) THEN
827  WRITE( nout, fmt = 9999 )path
828  ELSE
829  WRITE( nout, fmt = 9998 )path
830  END IF
831 *
832  9999 FORMAT( 1x, a3, ' drivers passed the tests of the error exits' )
833  9998 FORMAT( ' *** ', a3, ' drivers failed the tests of the error ',
834  $ 'exits ***' )
835 *
836  RETURN
837 *
838 * End of ZERRVX
839 *
subroutine zgbsv(N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB, INFO)
ZGBSV computes the solution to system of linear equations A * X = B for GB matrices (simple driver) ...
Definition: zgbsv.f:164
logical function lsamen(N, CA, CB)
LSAMEN
Definition: lsamen.f:76
subroutine zgtsvx(FACT, TRANS, N, NRHS, DL, D, DU, DLF, DF, DUF, DU2, IPIV, B, LDB, X, LDX, RCOND, FERR, BERR, WORK, RWORK, INFO)
ZGTSVX computes the solution to system of linear equations A * X = B for GT matrices ...
Definition: zgtsvx.f:296
subroutine zsysv(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, LWORK, INFO)
ZSYSV computes the solution to system of linear equations A * X = B for SY matrices ...
Definition: zsysv.f:173
subroutine zsysvx(FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, X, LDX, RCOND, FERR, BERR, WORK, LWORK, RWORK, INFO)
ZSYSVX computes the solution to system of linear equations A * X = B for SY matrices ...
Definition: zsysvx.f:287
subroutine zposv(UPLO, N, NRHS, A, LDA, B, LDB, INFO)
ZPOSV computes the solution to system of linear equations A * X = B for PO matrices ...
Definition: zposv.f:132
subroutine zgesv(N, NRHS, A, LDA, IPIV, B, LDB, INFO)
ZGESV computes the solution to system of linear equations A * X = B for GE matrices (simple driver) ...
Definition: zgesv.f:124
subroutine zhpsv(UPLO, N, NRHS, AP, IPIV, B, LDB, INFO)
ZHPSV computes the solution to system of linear equations A * X = B for OTHER matrices ...
Definition: zhpsv.f:164
subroutine zspsv(UPLO, N, NRHS, AP, IPIV, B, LDB, INFO)
ZSPSV computes the solution to system of linear equations A * X = B for OTHER matrices ...
Definition: zspsv.f:164
subroutine zgbsvx(FACT, TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, LDAFB, IPIV, EQUED, R, C, B, LDB, X, LDX, RCOND, FERR, BERR, WORK, RWORK, INFO)
ZGBSVX computes the solution to system of linear equations A * X = B for GB matrices ...
Definition: zgbsvx.f:372
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
Definition: cblat2.f:3199
subroutine zspsvx(FACT, UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, LDX, RCOND, FERR, BERR, WORK, RWORK, INFO)
ZSPSVX computes the solution to system of linear equations A * X = B for OTHER matrices ...
Definition: zspsvx.f:279
subroutine zhesv(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, LWORK, INFO)
ZHESV computes the solution to system of linear equations A * X = B for HE matrices ...
Definition: zhesv.f:173
subroutine zpbsv(UPLO, N, KD, NRHS, AB, LDAB, B, LDB, INFO)
ZPBSV computes the solution to system of linear equations A * X = B for OTHER matrices ...
Definition: zpbsv.f:166
subroutine zptsvx(FACT, N, NRHS, D, E, DF, EF, B, LDB, X, LDX, RCOND, FERR, BERR, WORK, RWORK, INFO)
ZPTSVX computes the solution to system of linear equations A * X = B for PT matrices ...
Definition: zptsvx.f:236
subroutine zppsv(UPLO, N, NRHS, AP, B, LDB, INFO)
ZPPSV computes the solution to system of linear equations A * X = B for OTHER matrices ...
Definition: zppsv.f:146
subroutine zhesv_rook(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, LWORK, INFO)
ZHESV_ROOK computes the solution to a system of linear equations A * X = B for HE matrices using the ...
Definition: zhesv_rook.f:207
subroutine zgesvx(FACT, TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, EQUED, R, C, B, LDB, X, LDX, RCOND, FERR, BERR, WORK, RWORK, INFO)
ZGESVX computes the solution to system of linear equations A * X = B for GE matrices ...
Definition: zgesvx.f:352
subroutine zpbsvx(FACT, UPLO, N, KD, NRHS, AB, LDAB, AFB, LDAFB, EQUED, S, B, LDB, X, LDX, RCOND, FERR, BERR, WORK, RWORK, INFO)
ZPBSVX computes the solution to system of linear equations A * X = B for OTHER matrices ...
Definition: zpbsvx.f:344
subroutine zhesvx(FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, X, LDX, RCOND, FERR, BERR, WORK, LWORK, RWORK, INFO)
ZHESVX computes the solution to system of linear equations A * X = B for HE matrices ...
Definition: zhesvx.f:287
subroutine zppsvx(FACT, UPLO, N, NRHS, AP, AFP, EQUED, S, B, LDB, X, LDX, RCOND, FERR, BERR, WORK, RWORK, INFO)
ZPPSVX computes the solution to system of linear equations A * X = B for OTHER matrices ...
Definition: zppsvx.f:313
subroutine zhpsvx(FACT, UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, LDX, RCOND, FERR, BERR, WORK, RWORK, INFO)
ZHPSVX computes the solution to system of linear equations A * X = B for OTHER matrices ...
Definition: zhpsvx.f:279
subroutine zposvx(FACT, UPLO, N, NRHS, A, LDA, AF, LDAF, EQUED, S, B, LDB, X, LDX, RCOND, FERR, BERR, WORK, RWORK, INFO)
ZPOSVX computes the solution to system of linear equations A * X = B for PO matrices ...
Definition: zposvx.f:308
subroutine zptsv(N, NRHS, D, E, B, LDB, INFO)
ZPTSV computes the solution to system of linear equations A * X = B for PT matrices ...
Definition: zptsv.f:117
subroutine zsysv_rook(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, LWORK, INFO)
ZSYSV_ROOK computes the solution to system of linear equations A * X = B for SY matrices ...
Definition: zsysv_rook.f:206
subroutine zgtsv(N, NRHS, DL, D, DU, B, LDB, INFO)
ZGTSV computes the solution to system of linear equations A * X = B for GT matrices ...
Definition: zgtsv.f:126

Here is the call graph for this function:

Here is the caller graph for this function: