LAPACK  3.4.2
LAPACK: Linear Algebra PACKage
 All Files Functions Groups
zdrvgex.f
Go to the documentation of this file.
1 *> \brief \b ZDRVGEX
2 *
3 * =========== DOCUMENTATION ===========
4 *
5 * Online html documentation available at
6 * http://www.netlib.org/lapack/explore-html/
7 *
8 * Definition:
9 * ===========
10 *
11 * SUBROUTINE ZDRVGE( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX,
12 * A, AFAC, ASAV, B, BSAV, X, XACT, S, WORK,
13 * RWORK, IWORK, NOUT )
14 *
15 * .. Scalar Arguments ..
16 * LOGICAL TSTERR
17 * INTEGER NMAX, NN, NOUT, NRHS
18 * DOUBLE PRECISION THRESH
19 * ..
20 * .. Array Arguments ..
21 * LOGICAL DOTYPE( * )
22 * INTEGER IWORK( * ), NVAL( * )
23 * DOUBLE PRECISION RWORK( * ), S( * )
24 * COMPLEX*16 A( * ), AFAC( * ), ASAV( * ), B( * ),
25 * $ BSAV( * ), WORK( * ), X( * ), XACT( * )
26 * ..
27 *
28 *
29 *> \par Purpose:
30 * =============
31 *>
32 *> \verbatim
33 *>
34 *> ZDRVGE tests the driver routines ZGESV, -SVX, and -SVXX.
35 *>
36 *> Note that this file is used only when the XBLAS are available,
37 *> otherwise zdrvge.f defines this subroutine.
38 *> \endverbatim
39 *
40 * Arguments:
41 * ==========
42 *
43 *> \param[in] DOTYPE
44 *> \verbatim
45 *> DOTYPE is LOGICAL array, dimension (NTYPES)
46 *> The matrix types to be used for testing. Matrices of type j
47 *> (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) =
48 *> .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.
49 *> \endverbatim
50 *>
51 *> \param[in] NN
52 *> \verbatim
53 *> NN is INTEGER
54 *> The number of values of N contained in the vector NVAL.
55 *> \endverbatim
56 *>
57 *> \param[in] NVAL
58 *> \verbatim
59 *> NVAL is INTEGER array, dimension (NN)
60 *> The values of the matrix column dimension N.
61 *> \endverbatim
62 *>
63 *> \param[in] NRHS
64 *> \verbatim
65 *> NRHS is INTEGER
66 *> The number of right hand side vectors to be generated for
67 *> each linear system.
68 *> \endverbatim
69 *>
70 *> \param[in] THRESH
71 *> \verbatim
72 *> THRESH is DOUBLE PRECISION
73 *> The threshold value for the test ratios. A result is
74 *> included in the output file if RESULT >= THRESH. To have
75 *> every test ratio printed, use THRESH = 0.
76 *> \endverbatim
77 *>
78 *> \param[in] TSTERR
79 *> \verbatim
80 *> TSTERR is LOGICAL
81 *> Flag that indicates whether error exits are to be tested.
82 *> \endverbatim
83 *>
84 *> \param[in] NMAX
85 *> \verbatim
86 *> NMAX is INTEGER
87 *> The maximum value permitted for N, used in dimensioning the
88 *> work arrays.
89 *> \endverbatim
90 *>
91 *> \param[out] A
92 *> \verbatim
93 *> A is COMPLEX*16 array, dimension (NMAX*NMAX)
94 *> \endverbatim
95 *>
96 *> \param[out] AFAC
97 *> \verbatim
98 *> AFAC is COMPLEX*16 array, dimension (NMAX*NMAX)
99 *> \endverbatim
100 *>
101 *> \param[out] ASAV
102 *> \verbatim
103 *> ASAV is COMPLEX*16 array, dimension (NMAX*NMAX)
104 *> \endverbatim
105 *>
106 *> \param[out] B
107 *> \verbatim
108 *> B is COMPLEX*16 array, dimension (NMAX*NRHS)
109 *> \endverbatim
110 *>
111 *> \param[out] BSAV
112 *> \verbatim
113 *> BSAV is COMPLEX*16 array, dimension (NMAX*NRHS)
114 *> \endverbatim
115 *>
116 *> \param[out] X
117 *> \verbatim
118 *> X is COMPLEX*16 array, dimension (NMAX*NRHS)
119 *> \endverbatim
120 *>
121 *> \param[out] XACT
122 *> \verbatim
123 *> XACT is COMPLEX*16 array, dimension (NMAX*NRHS)
124 *> \endverbatim
125 *>
126 *> \param[out] S
127 *> \verbatim
128 *> S is DOUBLE PRECISION array, dimension (2*NMAX)
129 *> \endverbatim
130 *>
131 *> \param[out] WORK
132 *> \verbatim
133 *> WORK is COMPLEX*16 array, dimension
134 *> (NMAX*max(3,NRHS))
135 *> \endverbatim
136 *>
137 *> \param[out] RWORK
138 *> \verbatim
139 *> RWORK is DOUBLE PRECISION array, dimension (2*NRHS+NMAX)
140 *> \endverbatim
141 *>
142 *> \param[out] IWORK
143 *> \verbatim
144 *> IWORK is INTEGER array, dimension (NMAX)
145 *> \endverbatim
146 *>
147 *> \param[in] NOUT
148 *> \verbatim
149 *> NOUT is INTEGER
150 *> The unit number for output.
151 *> \endverbatim
152 *
153 * Authors:
154 * ========
155 *
156 *> \author Univ. of Tennessee
157 *> \author Univ. of California Berkeley
158 *> \author Univ. of Colorado Denver
159 *> \author NAG Ltd.
160 *
161 *> \date April 2012
162 *
163 *> \ingroup complex16_lin
164 *
165 * =====================================================================
166  SUBROUTINE zdrvge( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX,
167  $ a, afac, asav, b, bsav, x, xact, s, work,
168  $ rwork, iwork, nout )
169 *
170 * -- LAPACK test routine (version 3.4.1) --
171 * -- LAPACK is a software package provided by Univ. of Tennessee, --
172 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
173 * April 2012
174 *
175 * .. Scalar Arguments ..
176  LOGICAL tsterr
177  INTEGER nmax, nn, nout, nrhs
178  DOUBLE PRECISION thresh
179 * ..
180 * .. Array Arguments ..
181  LOGICAL dotype( * )
182  INTEGER iwork( * ), nval( * )
183  DOUBLE PRECISION rwork( * ), s( * )
184  COMPLEX*16 a( * ), afac( * ), asav( * ), b( * ),
185  $ bsav( * ), work( * ), x( * ), xact( * )
186 * ..
187 *
188 * =====================================================================
189 *
190 * .. Parameters ..
191  DOUBLE PRECISION one, zero
192  parameter( one = 1.0d+0, zero = 0.0d+0 )
193  INTEGER ntypes
194  parameter( ntypes = 11 )
195  INTEGER ntests
196  parameter( ntests = 7 )
197  INTEGER ntran
198  parameter( ntran = 3 )
199 * ..
200 * .. Local Scalars ..
201  LOGICAL equil, nofact, prefac, trfcon, zerot
202  CHARACTER dist, equed, fact, trans, type, xtype
203  CHARACTER*3 path
204  INTEGER i, iequed, ifact, imat, in, info, ioff, itran,
205  $ izero, k, k1, kl, ku, lda, lwork, mode, n, nb,
206  $ nbmin, nerrs, nfact, nfail, nimat, nrun, nt,
207  $ n_err_bnds
208  DOUBLE PRECISION ainvnm, amax, anorm, anormi, anormo, cndnum,
209  $ colcnd, rcond, rcondc, rcondi, rcondo, roldc,
210  $ roldi, roldo, rowcnd, rpvgrw, rpvgrw_svxx
211 * ..
212 * .. Local Arrays ..
213  CHARACTER equeds( 4 ), facts( 3 ), transs( ntran )
214  INTEGER iseed( 4 ), iseedy( 4 )
215  DOUBLE PRECISION rdum( 1 ), result( ntests ), berr( nrhs ),
216  $ errbnds_n( nrhs, 3 ), errbnds_c( nrhs, 3 )
217 * ..
218 * .. External Functions ..
219  LOGICAL lsame
220  DOUBLE PRECISION dget06, dlamch, zlange, zlantr, zla_gerpvgrw
221  EXTERNAL lsame, dget06, dlamch, zlange, zlantr,
222  $ zla_gerpvgrw
223 * ..
224 * .. External Subroutines ..
225  EXTERNAL aladhd, alaerh, alasvm, xlaenv, zerrvx, zgeequ,
226  $ zgesv, zgesvx, zget01, zget02, zget04, zget07,
227  $ zgetrf, zgetri, zlacpy, zlaqge, zlarhs, zlaset,
228  $ zlatb4, zlatms, zgesvxx
229 * ..
230 * .. Intrinsic Functions ..
231  INTRINSIC abs, dcmplx, max, dble, dimag
232 * ..
233 * .. Scalars in Common ..
234  LOGICAL lerr, ok
235  CHARACTER*32 srnamt
236  INTEGER infot, nunit
237 * ..
238 * .. Common blocks ..
239  common / infoc / infot, nunit, ok, lerr
240  common / srnamc / srnamt
241 * ..
242 * .. Data statements ..
243  DATA iseedy / 1988, 1989, 1990, 1991 /
244  DATA transs / 'N', 'T', 'C' /
245  DATA facts / 'F', 'N', 'E' /
246  DATA equeds / 'N', 'R', 'C', 'B' /
247 * ..
248 * .. Executable Statements ..
249 *
250 * Initialize constants and the random number seed.
251 *
252  path( 1: 1 ) = 'Zomplex precision'
253  path( 2: 3 ) = 'GE'
254  nrun = 0
255  nfail = 0
256  nerrs = 0
257  DO 10 i = 1, 4
258  iseed( i ) = iseedy( i )
259  10 continue
260 *
261 * Test the error exits
262 *
263  IF( tsterr )
264  $ CALL zerrvx( path, nout )
265  infot = 0
266 *
267 * Set the block size and minimum block size for testing.
268 *
269  nb = 1
270  nbmin = 2
271  CALL xlaenv( 1, nb )
272  CALL xlaenv( 2, nbmin )
273 *
274 * Do for each value of N in NVAL
275 *
276  DO 90 in = 1, nn
277  n = nval( in )
278  lda = max( n, 1 )
279  xtype = 'N'
280  nimat = ntypes
281  IF( n.LE.0 )
282  $ nimat = 1
283 *
284  DO 80 imat = 1, nimat
285 *
286 * Do the tests only if DOTYPE( IMAT ) is true.
287 *
288  IF( .NOT.dotype( imat ) )
289  $ go to 80
290 *
291 * Skip types 5, 6, or 7 if the matrix size is too small.
292 *
293  zerot = imat.GE.5 .AND. imat.LE.7
294  IF( zerot .AND. n.LT.imat-4 )
295  $ go to 80
296 *
297 * Set up parameters with ZLATB4 and generate a test matrix
298 * with ZLATMS.
299 *
300  CALL zlatb4( path, imat, n, n, type, kl, ku, anorm, mode,
301  $ cndnum, dist )
302  rcondc = one / cndnum
303 *
304  srnamt = 'ZLATMS'
305  CALL zlatms( n, n, dist, iseed, type, rwork, mode, cndnum,
306  $ anorm, kl, ku, 'No packing', a, lda, work,
307  $ info )
308 *
309 * Check error code from ZLATMS.
310 *
311  IF( info.NE.0 ) THEN
312  CALL alaerh( path, 'ZLATMS', info, 0, ' ', n, n, -1, -1,
313  $ -1, imat, nfail, nerrs, nout )
314  go to 80
315  END IF
316 *
317 * For types 5-7, zero one or more columns of the matrix to
318 * test that INFO is returned correctly.
319 *
320  IF( zerot ) THEN
321  IF( imat.EQ.5 ) THEN
322  izero = 1
323  ELSE IF( imat.EQ.6 ) THEN
324  izero = n
325  ELSE
326  izero = n / 2 + 1
327  END IF
328  ioff = ( izero-1 )*lda
329  IF( imat.LT.7 ) THEN
330  DO 20 i = 1, n
331  a( ioff+i ) = zero
332  20 continue
333  ELSE
334  CALL zlaset( 'Full', n, n-izero+1, dcmplx( zero ),
335  $ dcmplx( zero ), a( ioff+1 ), lda )
336  END IF
337  ELSE
338  izero = 0
339  END IF
340 *
341 * Save a copy of the matrix A in ASAV.
342 *
343  CALL zlacpy( 'Full', n, n, a, lda, asav, lda )
344 *
345  DO 70 iequed = 1, 4
346  equed = equeds( iequed )
347  IF( iequed.EQ.1 ) THEN
348  nfact = 3
349  ELSE
350  nfact = 1
351  END IF
352 *
353  DO 60 ifact = 1, nfact
354  fact = facts( ifact )
355  prefac = lsame( fact, 'F' )
356  nofact = lsame( fact, 'N' )
357  equil = lsame( fact, 'E' )
358 *
359  IF( zerot ) THEN
360  IF( prefac )
361  $ go to 60
362  rcondo = zero
363  rcondi = zero
364 *
365  ELSE IF( .NOT.nofact ) THEN
366 *
367 * Compute the condition number for comparison with
368 * the value returned by ZGESVX (FACT = 'N' reuses
369 * the condition number from the previous iteration
370 * with FACT = 'F').
371 *
372  CALL zlacpy( 'Full', n, n, asav, lda, afac, lda )
373  IF( equil .OR. iequed.GT.1 ) THEN
374 *
375 * Compute row and column scale factors to
376 * equilibrate the matrix A.
377 *
378  CALL zgeequ( n, n, afac, lda, s, s( n+1 ),
379  $ rowcnd, colcnd, amax, info )
380  IF( info.EQ.0 .AND. n.GT.0 ) THEN
381  IF( lsame( equed, 'R' ) ) THEN
382  rowcnd = zero
383  colcnd = one
384  ELSE IF( lsame( equed, 'C' ) ) THEN
385  rowcnd = one
386  colcnd = zero
387  ELSE IF( lsame( equed, 'B' ) ) THEN
388  rowcnd = zero
389  colcnd = zero
390  END IF
391 *
392 * Equilibrate the matrix.
393 *
394  CALL zlaqge( n, n, afac, lda, s, s( n+1 ),
395  $ rowcnd, colcnd, amax, equed )
396  END IF
397  END IF
398 *
399 * Save the condition number of the non-equilibrated
400 * system for use in ZGET04.
401 *
402  IF( equil ) THEN
403  roldo = rcondo
404  roldi = rcondi
405  END IF
406 *
407 * Compute the 1-norm and infinity-norm of A.
408 *
409  anormo = zlange( '1', n, n, afac, lda, rwork )
410  anormi = zlange( 'I', n, n, afac, lda, rwork )
411 *
412 * Factor the matrix A.
413 *
414  CALL zgetrf( n, n, afac, lda, iwork, info )
415 *
416 * Form the inverse of A.
417 *
418  CALL zlacpy( 'Full', n, n, afac, lda, a, lda )
419  lwork = nmax*max( 3, nrhs )
420  CALL zgetri( n, a, lda, iwork, work, lwork, info )
421 *
422 * Compute the 1-norm condition number of A.
423 *
424  ainvnm = zlange( '1', n, n, a, lda, rwork )
425  IF( anormo.LE.zero .OR. ainvnm.LE.zero ) THEN
426  rcondo = one
427  ELSE
428  rcondo = ( one / anormo ) / ainvnm
429  END IF
430 *
431 * Compute the infinity-norm condition number of A.
432 *
433  ainvnm = zlange( 'I', n, n, a, lda, rwork )
434  IF( anormi.LE.zero .OR. ainvnm.LE.zero ) THEN
435  rcondi = one
436  ELSE
437  rcondi = ( one / anormi ) / ainvnm
438  END IF
439  END IF
440 *
441  DO 50 itran = 1, ntran
442 *
443 * Do for each value of TRANS.
444 *
445  trans = transs( itran )
446  IF( itran.EQ.1 ) THEN
447  rcondc = rcondo
448  ELSE
449  rcondc = rcondi
450  END IF
451 *
452 * Restore the matrix A.
453 *
454  CALL zlacpy( 'Full', n, n, asav, lda, a, lda )
455 *
456 * Form an exact solution and set the right hand side.
457 *
458  srnamt = 'ZLARHS'
459  CALL zlarhs( path, xtype, 'Full', trans, n, n, kl,
460  $ ku, nrhs, a, lda, xact, lda, b, lda,
461  $ iseed, info )
462  xtype = 'C'
463  CALL zlacpy( 'Full', n, nrhs, b, lda, bsav, lda )
464 *
465  IF( nofact .AND. itran.EQ.1 ) THEN
466 *
467 * --- Test ZGESV ---
468 *
469 * Compute the LU factorization of the matrix and
470 * solve the system.
471 *
472  CALL zlacpy( 'Full', n, n, a, lda, afac, lda )
473  CALL zlacpy( 'Full', n, nrhs, b, lda, x, lda )
474 *
475  srnamt = 'ZGESV '
476  CALL zgesv( n, nrhs, afac, lda, iwork, x, lda,
477  $ info )
478 *
479 * Check error code from ZGESV .
480 *
481  IF( info.NE.izero )
482  $ CALL alaerh( path, 'ZGESV ', info, izero,
483  $ ' ', n, n, -1, -1, nrhs, imat,
484  $ nfail, nerrs, nout )
485 *
486 * Reconstruct matrix from factors and compute
487 * residual.
488 *
489  CALL zget01( n, n, a, lda, afac, lda, iwork,
490  $ rwork, result( 1 ) )
491  nt = 1
492  IF( izero.EQ.0 ) THEN
493 *
494 * Compute residual of the computed solution.
495 *
496  CALL zlacpy( 'Full', n, nrhs, b, lda, work,
497  $ lda )
498  CALL zget02( 'No transpose', n, n, nrhs, a,
499  $ lda, x, lda, work, lda, rwork,
500  $ result( 2 ) )
501 *
502 * Check solution from generated exact solution.
503 *
504  CALL zget04( n, nrhs, x, lda, xact, lda,
505  $ rcondc, result( 3 ) )
506  nt = 3
507  END IF
508 *
509 * Print information about the tests that did not
510 * pass the threshold.
511 *
512  DO 30 k = 1, nt
513  IF( result( k ).GE.thresh ) THEN
514  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
515  $ CALL aladhd( nout, path )
516  WRITE( nout, fmt = 9999 )'ZGESV ', n,
517  $ imat, k, result( k )
518  nfail = nfail + 1
519  END IF
520  30 continue
521  nrun = nrun + nt
522  END IF
523 *
524 * --- Test ZGESVX ---
525 *
526  IF( .NOT.prefac )
527  $ CALL zlaset( 'Full', n, n, dcmplx( zero ),
528  $ dcmplx( zero ), afac, lda )
529  CALL zlaset( 'Full', n, nrhs, dcmplx( zero ),
530  $ dcmplx( zero ), x, lda )
531  IF( iequed.GT.1 .AND. n.GT.0 ) THEN
532 *
533 * Equilibrate the matrix if FACT = 'F' and
534 * EQUED = 'R', 'C', or 'B'.
535 *
536  CALL zlaqge( n, n, a, lda, s, s( n+1 ), rowcnd,
537  $ colcnd, amax, equed )
538  END IF
539 *
540 * Solve the system and compute the condition number
541 * and error bounds using ZGESVX.
542 *
543  srnamt = 'ZGESVX'
544  CALL zgesvx( fact, trans, n, nrhs, a, lda, afac,
545  $ lda, iwork, equed, s, s( n+1 ), b,
546  $ lda, x, lda, rcond, rwork,
547  $ rwork( nrhs+1 ), work,
548  $ rwork( 2*nrhs+1 ), info )
549 *
550 * Check the error code from ZGESVX.
551 *
552  IF( info.NE.izero )
553  $ CALL alaerh( path, 'ZGESVX', info, izero,
554  $ fact // trans, n, n, -1, -1, nrhs,
555  $ imat, nfail, nerrs, nout )
556 *
557 * Compare RWORK(2*NRHS+1) from ZGESVX with the
558 * computed reciprocal pivot growth factor RPVGRW
559 *
560  IF( info.NE.0 ) THEN
561  rpvgrw = zlantr( 'M', 'U', 'N', info, info,
562  $ afac, lda, rdum )
563  IF( rpvgrw.EQ.zero ) THEN
564  rpvgrw = one
565  ELSE
566  rpvgrw = zlange( 'M', n, info, a, lda,
567  $ rdum ) / rpvgrw
568  END IF
569  ELSE
570  rpvgrw = zlantr( 'M', 'U', 'N', n, n, afac, lda,
571  $ rdum )
572  IF( rpvgrw.EQ.zero ) THEN
573  rpvgrw = one
574  ELSE
575  rpvgrw = zlange( 'M', n, n, a, lda, rdum ) /
576  $ rpvgrw
577  END IF
578  END IF
579  result( 7 ) = abs( rpvgrw-rwork( 2*nrhs+1 ) ) /
580  $ max( rwork( 2*nrhs+1 ), rpvgrw ) /
581  $ dlamch( 'E' )
582 *
583  IF( .NOT.prefac ) THEN
584 *
585 * Reconstruct matrix from factors and compute
586 * residual.
587 *
588  CALL zget01( n, n, a, lda, afac, lda, iwork,
589  $ rwork( 2*nrhs+1 ), result( 1 ) )
590  k1 = 1
591  ELSE
592  k1 = 2
593  END IF
594 *
595  IF( info.EQ.0 ) THEN
596  trfcon = .false.
597 *
598 * Compute residual of the computed solution.
599 *
600  CALL zlacpy( 'Full', n, nrhs, bsav, lda, work,
601  $ lda )
602  CALL zget02( trans, n, n, nrhs, asav, lda, x,
603  $ lda, work, lda, rwork( 2*nrhs+1 ),
604  $ result( 2 ) )
605 *
606 * Check solution from generated exact solution.
607 *
608  IF( nofact .OR. ( prefac .AND. lsame( equed,
609  $ 'N' ) ) ) THEN
610  CALL zget04( n, nrhs, x, lda, xact, lda,
611  $ rcondc, result( 3 ) )
612  ELSE
613  IF( itran.EQ.1 ) THEN
614  roldc = roldo
615  ELSE
616  roldc = roldi
617  END IF
618  CALL zget04( n, nrhs, x, lda, xact, lda,
619  $ roldc, result( 3 ) )
620  END IF
621 *
622 * Check the error bounds from iterative
623 * refinement.
624 *
625  CALL zget07( trans, n, nrhs, asav, lda, b, lda,
626  $ x, lda, xact, lda, rwork, .true.,
627  $ rwork( nrhs+1 ), result( 4 ) )
628  ELSE
629  trfcon = .true.
630  END IF
631 *
632 * Compare RCOND from ZGESVX with the computed value
633 * in RCONDC.
634 *
635  result( 6 ) = dget06( rcond, rcondc )
636 *
637 * Print information about the tests that did not pass
638 * the threshold.
639 *
640  IF( .NOT.trfcon ) THEN
641  DO 40 k = k1, ntests
642  IF( result( k ).GE.thresh ) THEN
643  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
644  $ CALL aladhd( nout, path )
645  IF( prefac ) THEN
646  WRITE( nout, fmt = 9997 )'ZGESVX',
647  $ fact, trans, n, equed, imat, k,
648  $ result( k )
649  ELSE
650  WRITE( nout, fmt = 9998 )'ZGESVX',
651  $ fact, trans, n, imat, k, result( k )
652  END IF
653  nfail = nfail + 1
654  END IF
655  40 continue
656  nrun = nrun + 7 - k1
657  ELSE
658  IF( result( 1 ).GE.thresh .AND. .NOT.prefac )
659  $ THEN
660  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
661  $ CALL aladhd( nout, path )
662  IF( prefac ) THEN
663  WRITE( nout, fmt = 9997 )'ZGESVX', fact,
664  $ trans, n, equed, imat, 1, result( 1 )
665  ELSE
666  WRITE( nout, fmt = 9998 )'ZGESVX', fact,
667  $ trans, n, imat, 1, result( 1 )
668  END IF
669  nfail = nfail + 1
670  nrun = nrun + 1
671  END IF
672  IF( result( 6 ).GE.thresh ) THEN
673  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
674  $ CALL aladhd( nout, path )
675  IF( prefac ) THEN
676  WRITE( nout, fmt = 9997 )'ZGESVX', fact,
677  $ trans, n, equed, imat, 6, result( 6 )
678  ELSE
679  WRITE( nout, fmt = 9998 )'ZGESVX', fact,
680  $ trans, n, imat, 6, result( 6 )
681  END IF
682  nfail = nfail + 1
683  nrun = nrun + 1
684  END IF
685  IF( result( 7 ).GE.thresh ) THEN
686  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
687  $ CALL aladhd( nout, path )
688  IF( prefac ) THEN
689  WRITE( nout, fmt = 9997 )'ZGESVX', fact,
690  $ trans, n, equed, imat, 7, result( 7 )
691  ELSE
692  WRITE( nout, fmt = 9998 )'ZGESVX', fact,
693  $ trans, n, imat, 7, result( 7 )
694  END IF
695  nfail = nfail + 1
696  nrun = nrun + 1
697  END IF
698 *
699  END IF
700 *
701 * --- Test ZGESVXX ---
702 *
703 * Restore the matrices A and B.
704 *
705 
706  CALL zlacpy( 'Full', n, n, asav, lda, a, lda )
707  CALL zlacpy( 'Full', n, nrhs, bsav, lda, b, lda )
708 
709  IF( .NOT.prefac )
710  $ CALL zlaset( 'Full', n, n, zero, zero, afac,
711  $ lda )
712  CALL zlaset( 'Full', n, nrhs, zero, zero, x, lda )
713  IF( iequed.GT.1 .AND. n.GT.0 ) THEN
714 *
715 * Equilibrate the matrix if FACT = 'F' and
716 * EQUED = 'R', 'C', or 'B'.
717 *
718  CALL zlaqge( n, n, a, lda, s, s( n+1 ), rowcnd,
719  $ colcnd, amax, equed )
720  END IF
721 *
722 * Solve the system and compute the condition number
723 * and error bounds using ZGESVXX.
724 *
725  srnamt = 'ZGESVXX'
726  n_err_bnds = 3
727  CALL zgesvxx( fact, trans, n, nrhs, a, lda, afac,
728  $ lda, iwork, equed, s, s( n+1 ), b, lda, x,
729  $ lda, rcond, rpvgrw_svxx, berr, n_err_bnds,
730  $ errbnds_n, errbnds_c, 0, zero, work,
731  $ rwork, info )
732 *
733 * Check the error code from ZGESVXX.
734 *
735  IF( info.EQ.n+1 ) goto 50
736  IF( info.NE.izero ) THEN
737  CALL alaerh( path, 'ZGESVXX', info, izero,
738  $ fact // trans, n, n, -1, -1, nrhs,
739  $ imat, nfail, nerrs, nout )
740  goto 50
741  END IF
742 *
743 * Compare rpvgrw_svxx from ZGESVXX with the computed
744 * reciprocal pivot growth factor RPVGRW
745 *
746 
747  IF ( info .GT. 0 .AND. info .LT. n+1 ) THEN
748  rpvgrw = zla_gerpvgrw
749  $ (n, info, a, lda, afac, lda)
750  ELSE
751  rpvgrw = zla_gerpvgrw
752  $ (n, n, a, lda, afac, lda)
753  ENDIF
754 
755  result( 7 ) = abs( rpvgrw-rpvgrw_svxx ) /
756  $ max( rpvgrw_svxx, rpvgrw ) /
757  $ dlamch( 'E' )
758 *
759  IF( .NOT.prefac ) THEN
760 *
761 * Reconstruct matrix from factors and compute
762 * residual.
763 *
764  CALL zget01( n, n, a, lda, afac, lda, iwork,
765  $ rwork( 2*nrhs+1 ), result( 1 ) )
766  k1 = 1
767  ELSE
768  k1 = 2
769  END IF
770 *
771  IF( info.EQ.0 ) THEN
772  trfcon = .false.
773 *
774 * Compute residual of the computed solution.
775 *
776  CALL zlacpy( 'Full', n, nrhs, bsav, lda, work,
777  $ lda )
778  CALL zget02( trans, n, n, nrhs, asav, lda, x,
779  $ lda, work, lda, rwork( 2*nrhs+1 ),
780  $ result( 2 ) )
781 *
782 * Check solution from generated exact solution.
783 *
784  IF( nofact .OR. ( prefac .AND. lsame( equed,
785  $ 'N' ) ) ) THEN
786  CALL zget04( n, nrhs, x, lda, xact, lda,
787  $ rcondc, result( 3 ) )
788  ELSE
789  IF( itran.EQ.1 ) THEN
790  roldc = roldo
791  ELSE
792  roldc = roldi
793  END IF
794  CALL zget04( n, nrhs, x, lda, xact, lda,
795  $ roldc, result( 3 ) )
796  END IF
797  ELSE
798  trfcon = .true.
799  END IF
800 *
801 * Compare RCOND from ZGESVXX with the computed value
802 * in RCONDC.
803 *
804  result( 6 ) = dget06( rcond, rcondc )
805 *
806 * Print information about the tests that did not pass
807 * the threshold.
808 *
809  IF( .NOT.trfcon ) THEN
810  DO 45 k = k1, ntests
811  IF( result( k ).GE.thresh ) THEN
812  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
813  $ CALL aladhd( nout, path )
814  IF( prefac ) THEN
815  WRITE( nout, fmt = 9997 )'ZGESVXX',
816  $ fact, trans, n, equed, imat, k,
817  $ result( k )
818  ELSE
819  WRITE( nout, fmt = 9998 )'ZGESVXX',
820  $ fact, trans, n, imat, k, result( k )
821  END IF
822  nfail = nfail + 1
823  END IF
824  45 continue
825  nrun = nrun + 7 - k1
826  ELSE
827  IF( result( 1 ).GE.thresh .AND. .NOT.prefac )
828  $ THEN
829  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
830  $ CALL aladhd( nout, path )
831  IF( prefac ) THEN
832  WRITE( nout, fmt = 9997 )'ZGESVXX', fact,
833  $ trans, n, equed, imat, 1, result( 1 )
834  ELSE
835  WRITE( nout, fmt = 9998 )'ZGESVXX', fact,
836  $ trans, n, imat, 1, result( 1 )
837  END IF
838  nfail = nfail + 1
839  nrun = nrun + 1
840  END IF
841  IF( result( 6 ).GE.thresh ) THEN
842  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
843  $ CALL aladhd( nout, path )
844  IF( prefac ) THEN
845  WRITE( nout, fmt = 9997 )'ZGESVXX', fact,
846  $ trans, n, equed, imat, 6, result( 6 )
847  ELSE
848  WRITE( nout, fmt = 9998 )'ZGESVXX', fact,
849  $ trans, n, imat, 6, result( 6 )
850  END IF
851  nfail = nfail + 1
852  nrun = nrun + 1
853  END IF
854  IF( result( 7 ).GE.thresh ) THEN
855  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
856  $ CALL aladhd( nout, path )
857  IF( prefac ) THEN
858  WRITE( nout, fmt = 9997 )'ZGESVXX', fact,
859  $ trans, n, equed, imat, 7, result( 7 )
860  ELSE
861  WRITE( nout, fmt = 9998 )'ZGESVXX', fact,
862  $ trans, n, imat, 7, result( 7 )
863  END IF
864  nfail = nfail + 1
865  nrun = nrun + 1
866  END IF
867 *
868  END IF
869 *
870  50 continue
871  60 continue
872  70 continue
873  80 continue
874  90 continue
875 *
876 * Print a summary of the results.
877 *
878  CALL alasvm( path, nout, nfail, nrun, nerrs )
879 *
880 
881 * Test Error Bounds for ZGESVXX
882 
883  CALL zebchvxx(thresh, path)
884 
885  9999 format( 1x, a, ', N =', i5, ', type ', i2, ', test(', i2, ') =',
886  $ g12.5 )
887  9998 format( 1x, a, ', FACT=''', a1, ''', TRANS=''', a1, ''', N=', i5,
888  $ ', type ', i2, ', test(', i1, ')=', g12.5 )
889  9997 format( 1x, a, ', FACT=''', a1, ''', TRANS=''', a1, ''', N=', i5,
890  $ ', EQUED=''', a1, ''', type ', i2, ', test(', i1, ')=',
891  $ g12.5 )
892  return
893 *
894 * End of ZDRVGE
895 *
896  END