LAPACK  3.10.1
LAPACK: Linear Algebra PACKage
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 *> \ingroup complex16_lin
162 *
163 * =====================================================================
164  SUBROUTINE zdrvge( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX,
165  $ A, AFAC, ASAV, B, BSAV, X, XACT, S, WORK,
166  $ RWORK, IWORK, NOUT )
167 *
168 * -- LAPACK test routine --
169 * -- LAPACK is a software package provided by Univ. of Tennessee, --
170 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
171 *
172 * .. Scalar Arguments ..
173  LOGICAL TSTERR
174  INTEGER NMAX, NN, NOUT, NRHS
175  DOUBLE PRECISION THRESH
176 * ..
177 * .. Array Arguments ..
178  LOGICAL DOTYPE( * )
179  INTEGER IWORK( * ), NVAL( * )
180  DOUBLE PRECISION RWORK( * ), S( * )
181  COMPLEX*16 A( * ), AFAC( * ), ASAV( * ), B( * ),
182  $ bsav( * ), work( * ), x( * ), xact( * )
183 * ..
184 *
185 * =====================================================================
186 *
187 * .. Parameters ..
188  DOUBLE PRECISION ONE, ZERO
189  PARAMETER ( ONE = 1.0d+0, zero = 0.0d+0 )
190  INTEGER NTYPES
191  parameter( ntypes = 11 )
192  INTEGER NTESTS
193  parameter( ntests = 7 )
194  INTEGER NTRAN
195  parameter( ntran = 3 )
196 * ..
197 * .. Local Scalars ..
198  LOGICAL EQUIL, NOFACT, PREFAC, TRFCON, ZEROT
199  CHARACTER DIST, EQUED, FACT, TRANS, TYPE, XTYPE
200  CHARACTER*3 PATH
201  INTEGER I, IEQUED, IFACT, IMAT, IN, INFO, IOFF, ITRAN,
202  $ izero, k, k1, kl, ku, lda, lwork, mode, n, nb,
203  $ nbmin, nerrs, nfact, nfail, nimat, nrun, nt,
204  $ n_err_bnds
205  DOUBLE PRECISION AINVNM, AMAX, ANORM, ANORMI, ANORMO, CNDNUM,
206  $ COLCND, RCOND, RCONDC, RCONDI, RCONDO, ROLDC,
207  $ roldi, roldo, rowcnd, rpvgrw, rpvgrw_svxx
208 * ..
209 * .. Local Arrays ..
210  CHARACTER EQUEDS( 4 ), FACTS( 3 ), TRANSS( NTRAN )
211  INTEGER ISEED( 4 ), ISEEDY( 4 )
212  DOUBLE PRECISION RDUM( 1 ), RESULT( NTESTS ), BERR( NRHS ),
213  $ errbnds_n( nrhs, 3 ), errbnds_c( nrhs, 3 )
214 * ..
215 * .. External Functions ..
216  LOGICAL LSAME
217  DOUBLE PRECISION DGET06, DLAMCH, ZLANGE, ZLANTR, ZLA_GERPVGRW
218  EXTERNAL lsame, dget06, dlamch, zlange, zlantr,
219  $ zla_gerpvgrw
220 * ..
221 * .. External Subroutines ..
222  EXTERNAL aladhd, alaerh, alasvm, xlaenv, zerrvx, zgeequ,
225  $ zlatb4, zlatms, zgesvxx
226 * ..
227 * .. Intrinsic Functions ..
228  INTRINSIC abs, dcmplx, max, dble, dimag
229 * ..
230 * .. Scalars in Common ..
231  LOGICAL LERR, OK
232  CHARACTER*32 SRNAMT
233  INTEGER INFOT, NUNIT
234 * ..
235 * .. Common blocks ..
236  COMMON / infoc / infot, nunit, ok, lerr
237  COMMON / srnamc / srnamt
238 * ..
239 * .. Data statements ..
240  DATA iseedy / 1988, 1989, 1990, 1991 /
241  DATA transs / 'N', 'T', 'C' /
242  DATA facts / 'F', 'N', 'E' /
243  DATA equeds / 'N', 'R', 'C', 'B' /
244 * ..
245 * .. Executable Statements ..
246 *
247 * Initialize constants and the random number seed.
248 *
249  path( 1: 1 ) = 'Zomplex precision'
250  path( 2: 3 ) = 'GE'
251  nrun = 0
252  nfail = 0
253  nerrs = 0
254  DO 10 i = 1, 4
255  iseed( i ) = iseedy( i )
256  10 CONTINUE
257 *
258 * Test the error exits
259 *
260  IF( tsterr )
261  $ CALL zerrvx( path, nout )
262  infot = 0
263 *
264 * Set the block size and minimum block size for testing.
265 *
266  nb = 1
267  nbmin = 2
268  CALL xlaenv( 1, nb )
269  CALL xlaenv( 2, nbmin )
270 *
271 * Do for each value of N in NVAL
272 *
273  DO 90 in = 1, nn
274  n = nval( in )
275  lda = max( n, 1 )
276  xtype = 'N'
277  nimat = ntypes
278  IF( n.LE.0 )
279  $ nimat = 1
280 *
281  DO 80 imat = 1, nimat
282 *
283 * Do the tests only if DOTYPE( IMAT ) is true.
284 *
285  IF( .NOT.dotype( imat ) )
286  $ GO TO 80
287 *
288 * Skip types 5, 6, or 7 if the matrix size is too small.
289 *
290  zerot = imat.GE.5 .AND. imat.LE.7
291  IF( zerot .AND. n.LT.imat-4 )
292  $ GO TO 80
293 *
294 * Set up parameters with ZLATB4 and generate a test matrix
295 * with ZLATMS.
296 *
297  CALL zlatb4( path, imat, n, n, TYPE, KL, KU, ANORM, MODE,
298  $ CNDNUM, DIST )
299  rcondc = one / cndnum
300 *
301  srnamt = 'ZLATMS'
302  CALL zlatms( n, n, dist, iseed, TYPE, RWORK, MODE, CNDNUM,
303  $ anorm, kl, ku, 'No packing', a, lda, work,
304  $ info )
305 *
306 * Check error code from ZLATMS.
307 *
308  IF( info.NE.0 ) THEN
309  CALL alaerh( path, 'ZLATMS', info, 0, ' ', n, n, -1, -1,
310  $ -1, imat, nfail, nerrs, nout )
311  GO TO 80
312  END IF
313 *
314 * For types 5-7, zero one or more columns of the matrix to
315 * test that INFO is returned correctly.
316 *
317  IF( zerot ) THEN
318  IF( imat.EQ.5 ) THEN
319  izero = 1
320  ELSE IF( imat.EQ.6 ) THEN
321  izero = n
322  ELSE
323  izero = n / 2 + 1
324  END IF
325  ioff = ( izero-1 )*lda
326  IF( imat.LT.7 ) THEN
327  DO 20 i = 1, n
328  a( ioff+i ) = zero
329  20 CONTINUE
330  ELSE
331  CALL zlaset( 'Full', n, n-izero+1, dcmplx( zero ),
332  $ dcmplx( zero ), a( ioff+1 ), lda )
333  END IF
334  ELSE
335  izero = 0
336  END IF
337 *
338 * Save a copy of the matrix A in ASAV.
339 *
340  CALL zlacpy( 'Full', n, n, a, lda, asav, lda )
341 *
342  DO 70 iequed = 1, 4
343  equed = equeds( iequed )
344  IF( iequed.EQ.1 ) THEN
345  nfact = 3
346  ELSE
347  nfact = 1
348  END IF
349 *
350  DO 60 ifact = 1, nfact
351  fact = facts( ifact )
352  prefac = lsame( fact, 'F' )
353  nofact = lsame( fact, 'N' )
354  equil = lsame( fact, 'E' )
355 *
356  IF( zerot ) THEN
357  IF( prefac )
358  $ GO TO 60
359  rcondo = zero
360  rcondi = zero
361 *
362  ELSE IF( .NOT.nofact ) THEN
363 *
364 * Compute the condition number for comparison with
365 * the value returned by ZGESVX (FACT = 'N' reuses
366 * the condition number from the previous iteration
367 * with FACT = 'F').
368 *
369  CALL zlacpy( 'Full', n, n, asav, lda, afac, lda )
370  IF( equil .OR. iequed.GT.1 ) THEN
371 *
372 * Compute row and column scale factors to
373 * equilibrate the matrix A.
374 *
375  CALL zgeequ( n, n, afac, lda, s, s( n+1 ),
376  $ rowcnd, colcnd, amax, info )
377  IF( info.EQ.0 .AND. n.GT.0 ) THEN
378  IF( lsame( equed, 'R' ) ) THEN
379  rowcnd = zero
380  colcnd = one
381  ELSE IF( lsame( equed, 'C' ) ) THEN
382  rowcnd = one
383  colcnd = zero
384  ELSE IF( lsame( equed, 'B' ) ) THEN
385  rowcnd = zero
386  colcnd = zero
387  END IF
388 *
389 * Equilibrate the matrix.
390 *
391  CALL zlaqge( n, n, afac, lda, s, s( n+1 ),
392  $ rowcnd, colcnd, amax, equed )
393  END IF
394  END IF
395 *
396 * Save the condition number of the non-equilibrated
397 * system for use in ZGET04.
398 *
399  IF( equil ) THEN
400  roldo = rcondo
401  roldi = rcondi
402  END IF
403 *
404 * Compute the 1-norm and infinity-norm of A.
405 *
406  anormo = zlange( '1', n, n, afac, lda, rwork )
407  anormi = zlange( 'I', n, n, afac, lda, rwork )
408 *
409 * Factor the matrix A.
410 *
411  CALL zgetrf( n, n, afac, lda, iwork, info )
412 *
413 * Form the inverse of A.
414 *
415  CALL zlacpy( 'Full', n, n, afac, lda, a, lda )
416  lwork = nmax*max( 3, nrhs )
417  CALL zgetri( n, a, lda, iwork, work, lwork, info )
418 *
419 * Compute the 1-norm condition number of A.
420 *
421  ainvnm = zlange( '1', n, n, a, lda, rwork )
422  IF( anormo.LE.zero .OR. ainvnm.LE.zero ) THEN
423  rcondo = one
424  ELSE
425  rcondo = ( one / anormo ) / ainvnm
426  END IF
427 *
428 * Compute the infinity-norm condition number of A.
429 *
430  ainvnm = zlange( 'I', n, n, a, lda, rwork )
431  IF( anormi.LE.zero .OR. ainvnm.LE.zero ) THEN
432  rcondi = one
433  ELSE
434  rcondi = ( one / anormi ) / ainvnm
435  END IF
436  END IF
437 *
438  DO 50 itran = 1, ntran
439 *
440 * Do for each value of TRANS.
441 *
442  trans = transs( itran )
443  IF( itran.EQ.1 ) THEN
444  rcondc = rcondo
445  ELSE
446  rcondc = rcondi
447  END IF
448 *
449 * Restore the matrix A.
450 *
451  CALL zlacpy( 'Full', n, n, asav, lda, a, lda )
452 *
453 * Form an exact solution and set the right hand side.
454 *
455  srnamt = 'ZLARHS'
456  CALL zlarhs( path, xtype, 'Full', trans, n, n, kl,
457  $ ku, nrhs, a, lda, xact, lda, b, lda,
458  $ iseed, info )
459  xtype = 'C'
460  CALL zlacpy( 'Full', n, nrhs, b, lda, bsav, lda )
461 *
462  IF( nofact .AND. itran.EQ.1 ) THEN
463 *
464 * --- Test ZGESV ---
465 *
466 * Compute the LU factorization of the matrix and
467 * solve the system.
468 *
469  CALL zlacpy( 'Full', n, n, a, lda, afac, lda )
470  CALL zlacpy( 'Full', n, nrhs, b, lda, x, lda )
471 *
472  srnamt = 'ZGESV '
473  CALL zgesv( n, nrhs, afac, lda, iwork, x, lda,
474  $ info )
475 *
476 * Check error code from ZGESV .
477 *
478  IF( info.NE.izero )
479  $ CALL alaerh( path, 'ZGESV ', info, izero,
480  $ ' ', n, n, -1, -1, nrhs, imat,
481  $ nfail, nerrs, nout )
482 *
483 * Reconstruct matrix from factors and compute
484 * residual.
485 *
486  CALL zget01( n, n, a, lda, afac, lda, iwork,
487  $ rwork, result( 1 ) )
488  nt = 1
489  IF( izero.EQ.0 ) THEN
490 *
491 * Compute residual of the computed solution.
492 *
493  CALL zlacpy( 'Full', n, nrhs, b, lda, work,
494  $ lda )
495  CALL zget02( 'No transpose', n, n, nrhs, a,
496  $ lda, x, lda, work, lda, rwork,
497  $ result( 2 ) )
498 *
499 * Check solution from generated exact solution.
500 *
501  CALL zget04( n, nrhs, x, lda, xact, lda,
502  $ rcondc, result( 3 ) )
503  nt = 3
504  END IF
505 *
506 * Print information about the tests that did not
507 * pass the threshold.
508 *
509  DO 30 k = 1, nt
510  IF( result( k ).GE.thresh ) THEN
511  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
512  $ CALL aladhd( nout, path )
513  WRITE( nout, fmt = 9999 )'ZGESV ', n,
514  $ imat, k, result( k )
515  nfail = nfail + 1
516  END IF
517  30 CONTINUE
518  nrun = nrun + nt
519  END IF
520 *
521 * --- Test ZGESVX ---
522 *
523  IF( .NOT.prefac )
524  $ CALL zlaset( 'Full', n, n, dcmplx( zero ),
525  $ dcmplx( zero ), afac, lda )
526  CALL zlaset( 'Full', n, nrhs, dcmplx( zero ),
527  $ dcmplx( zero ), x, lda )
528  IF( iequed.GT.1 .AND. n.GT.0 ) THEN
529 *
530 * Equilibrate the matrix if FACT = 'F' and
531 * EQUED = 'R', 'C', or 'B'.
532 *
533  CALL zlaqge( n, n, a, lda, s, s( n+1 ), rowcnd,
534  $ colcnd, amax, equed )
535  END IF
536 *
537 * Solve the system and compute the condition number
538 * and error bounds using ZGESVX.
539 *
540  srnamt = 'ZGESVX'
541  CALL zgesvx( fact, trans, n, nrhs, a, lda, afac,
542  $ lda, iwork, equed, s, s( n+1 ), b,
543  $ lda, x, lda, rcond, rwork,
544  $ rwork( nrhs+1 ), work,
545  $ rwork( 2*nrhs+1 ), info )
546 *
547 * Check the error code from ZGESVX.
548 *
549  IF( info.NE.izero )
550  $ CALL alaerh( path, 'ZGESVX', info, izero,
551  $ fact // trans, n, n, -1, -1, nrhs,
552  $ imat, nfail, nerrs, nout )
553 *
554 * Compare RWORK(2*NRHS+1) from ZGESVX with the
555 * computed reciprocal pivot growth factor RPVGRW
556 *
557  IF( info.NE.0 ) THEN
558  rpvgrw = zlantr( 'M', 'U', 'N', info, info,
559  $ afac, lda, rdum )
560  IF( rpvgrw.EQ.zero ) THEN
561  rpvgrw = one
562  ELSE
563  rpvgrw = zlange( 'M', n, info, a, lda,
564  $ rdum ) / rpvgrw
565  END IF
566  ELSE
567  rpvgrw = zlantr( 'M', 'U', 'N', n, n, afac, lda,
568  $ rdum )
569  IF( rpvgrw.EQ.zero ) THEN
570  rpvgrw = one
571  ELSE
572  rpvgrw = zlange( 'M', n, n, a, lda, rdum ) /
573  $ rpvgrw
574  END IF
575  END IF
576  result( 7 ) = abs( rpvgrw-rwork( 2*nrhs+1 ) ) /
577  $ max( rwork( 2*nrhs+1 ), rpvgrw ) /
578  $ dlamch( 'E' )
579 *
580  IF( .NOT.prefac ) THEN
581 *
582 * Reconstruct matrix from factors and compute
583 * residual.
584 *
585  CALL zget01( n, n, a, lda, afac, lda, iwork,
586  $ rwork( 2*nrhs+1 ), result( 1 ) )
587  k1 = 1
588  ELSE
589  k1 = 2
590  END IF
591 *
592  IF( info.EQ.0 ) THEN
593  trfcon = .false.
594 *
595 * Compute residual of the computed solution.
596 *
597  CALL zlacpy( 'Full', n, nrhs, bsav, lda, work,
598  $ lda )
599  CALL zget02( trans, n, n, nrhs, asav, lda, x,
600  $ lda, work, lda, rwork( 2*nrhs+1 ),
601  $ result( 2 ) )
602 *
603 * Check solution from generated exact solution.
604 *
605  IF( nofact .OR. ( prefac .AND. lsame( equed,
606  $ 'N' ) ) ) THEN
607  CALL zget04( n, nrhs, x, lda, xact, lda,
608  $ rcondc, result( 3 ) )
609  ELSE
610  IF( itran.EQ.1 ) THEN
611  roldc = roldo
612  ELSE
613  roldc = roldi
614  END IF
615  CALL zget04( n, nrhs, x, lda, xact, lda,
616  $ roldc, result( 3 ) )
617  END IF
618 *
619 * Check the error bounds from iterative
620 * refinement.
621 *
622  CALL zget07( trans, n, nrhs, asav, lda, b, lda,
623  $ x, lda, xact, lda, rwork, .true.,
624  $ rwork( nrhs+1 ), result( 4 ) )
625  ELSE
626  trfcon = .true.
627  END IF
628 *
629 * Compare RCOND from ZGESVX with the computed value
630 * in RCONDC.
631 *
632  result( 6 ) = dget06( rcond, rcondc )
633 *
634 * Print information about the tests that did not pass
635 * the threshold.
636 *
637  IF( .NOT.trfcon ) THEN
638  DO 40 k = k1, ntests
639  IF( result( k ).GE.thresh ) THEN
640  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
641  $ CALL aladhd( nout, path )
642  IF( prefac ) THEN
643  WRITE( nout, fmt = 9997 )'ZGESVX',
644  $ fact, trans, n, equed, imat, k,
645  $ result( k )
646  ELSE
647  WRITE( nout, fmt = 9998 )'ZGESVX',
648  $ fact, trans, n, imat, k, result( k )
649  END IF
650  nfail = nfail + 1
651  END IF
652  40 CONTINUE
653  nrun = nrun + 7 - k1
654  ELSE
655  IF( result( 1 ).GE.thresh .AND. .NOT.prefac )
656  $ THEN
657  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
658  $ CALL aladhd( nout, path )
659  IF( prefac ) THEN
660  WRITE( nout, fmt = 9997 )'ZGESVX', fact,
661  $ trans, n, equed, imat, 1, result( 1 )
662  ELSE
663  WRITE( nout, fmt = 9998 )'ZGESVX', fact,
664  $ trans, n, imat, 1, result( 1 )
665  END IF
666  nfail = nfail + 1
667  nrun = nrun + 1
668  END IF
669  IF( result( 6 ).GE.thresh ) THEN
670  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
671  $ CALL aladhd( nout, path )
672  IF( prefac ) THEN
673  WRITE( nout, fmt = 9997 )'ZGESVX', fact,
674  $ trans, n, equed, imat, 6, result( 6 )
675  ELSE
676  WRITE( nout, fmt = 9998 )'ZGESVX', fact,
677  $ trans, n, imat, 6, result( 6 )
678  END IF
679  nfail = nfail + 1
680  nrun = nrun + 1
681  END IF
682  IF( result( 7 ).GE.thresh ) THEN
683  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
684  $ CALL aladhd( nout, path )
685  IF( prefac ) THEN
686  WRITE( nout, fmt = 9997 )'ZGESVX', fact,
687  $ trans, n, equed, imat, 7, result( 7 )
688  ELSE
689  WRITE( nout, fmt = 9998 )'ZGESVX', fact,
690  $ trans, n, imat, 7, result( 7 )
691  END IF
692  nfail = nfail + 1
693  nrun = nrun + 1
694  END IF
695 *
696  END IF
697 *
698 * --- Test ZGESVXX ---
699 *
700 * Restore the matrices A and B.
701 *
702 
703  CALL zlacpy( 'Full', n, n, asav, lda, a, lda )
704  CALL zlacpy( 'Full', n, nrhs, bsav, lda, b, lda )
705 
706  IF( .NOT.prefac )
707  $ CALL zlaset( 'Full', n, n, dcmplx( zero ),
708  $ dcmplx( zero ), afac, lda )
709  CALL zlaset( 'Full', n, nrhs, dcmplx( zero ),
710  $ dcmplx( zero ), x, lda )
711  IF( iequed.GT.1 .AND. n.GT.0 ) THEN
712 *
713 * Equilibrate the matrix if FACT = 'F' and
714 * EQUED = 'R', 'C', or 'B'.
715 *
716  CALL zlaqge( n, n, a, lda, s, s( n+1 ), rowcnd,
717  $ colcnd, amax, equed )
718  END IF
719 *
720 * Solve the system and compute the condition number
721 * and error bounds using ZGESVXX.
722 *
723  srnamt = 'ZGESVXX'
724  n_err_bnds = 3
725  CALL zgesvxx( fact, trans, n, nrhs, a, lda, afac,
726  $ lda, iwork, equed, s, s( n+1 ), b, lda, x,
727  $ lda, rcond, rpvgrw_svxx, berr, n_err_bnds,
728  $ errbnds_n, errbnds_c, 0, zero, work,
729  $ rwork, info )
730 *
731 * Check the error code from ZGESVXX.
732 *
733  IF( info.EQ.n+1 ) GOTO 50
734  IF( info.NE.izero ) THEN
735  CALL alaerh( path, 'ZGESVXX', info, izero,
736  $ fact // trans, n, n, -1, -1, nrhs,
737  $ imat, nfail, nerrs, nout )
738  GOTO 50
739  END IF
740 *
741 * Compare rpvgrw_svxx from ZGESVXX with the computed
742 * reciprocal pivot growth factor RPVGRW
743 *
744 
745  IF ( info .GT. 0 .AND. info .LT. n+1 ) THEN
746  rpvgrw = zla_gerpvgrw
747  $ (n, info, a, lda, afac, lda)
748  ELSE
749  rpvgrw = zla_gerpvgrw
750  $ (n, n, a, lda, afac, lda)
751  ENDIF
752 
753  result( 7 ) = abs( rpvgrw-rpvgrw_svxx ) /
754  $ max( rpvgrw_svxx, rpvgrw ) /
755  $ dlamch( 'E' )
756 *
757  IF( .NOT.prefac ) THEN
758 *
759 * Reconstruct matrix from factors and compute
760 * residual.
761 *
762  CALL zget01( n, n, a, lda, afac, lda, iwork,
763  $ rwork( 2*nrhs+1 ), result( 1 ) )
764  k1 = 1
765  ELSE
766  k1 = 2
767  END IF
768 *
769  IF( info.EQ.0 ) THEN
770  trfcon = .false.
771 *
772 * Compute residual of the computed solution.
773 *
774  CALL zlacpy( 'Full', n, nrhs, bsav, lda, work,
775  $ lda )
776  CALL zget02( trans, n, n, nrhs, asav, lda, x,
777  $ lda, work, lda, rwork( 2*nrhs+1 ),
778  $ result( 2 ) )
779 *
780 * Check solution from generated exact solution.
781 *
782  IF( nofact .OR. ( prefac .AND. lsame( equed,
783  $ 'N' ) ) ) THEN
784  CALL zget04( n, nrhs, x, lda, xact, lda,
785  $ rcondc, result( 3 ) )
786  ELSE
787  IF( itran.EQ.1 ) THEN
788  roldc = roldo
789  ELSE
790  roldc = roldi
791  END IF
792  CALL zget04( n, nrhs, x, lda, xact, lda,
793  $ roldc, result( 3 ) )
794  END IF
795  ELSE
796  trfcon = .true.
797  END IF
798 *
799 * Compare RCOND from ZGESVXX with the computed value
800 * in RCONDC.
801 *
802  result( 6 ) = dget06( rcond, rcondc )
803 *
804 * Print information about the tests that did not pass
805 * the threshold.
806 *
807  IF( .NOT.trfcon ) THEN
808  DO 45 k = k1, ntests
809  IF( result( k ).GE.thresh ) THEN
810  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
811  $ CALL aladhd( nout, path )
812  IF( prefac ) THEN
813  WRITE( nout, fmt = 9997 )'ZGESVXX',
814  $ fact, trans, n, equed, imat, k,
815  $ result( k )
816  ELSE
817  WRITE( nout, fmt = 9998 )'ZGESVXX',
818  $ fact, trans, n, imat, k, result( k )
819  END IF
820  nfail = nfail + 1
821  END IF
822  45 CONTINUE
823  nrun = nrun + 7 - k1
824  ELSE
825  IF( result( 1 ).GE.thresh .AND. .NOT.prefac )
826  $ THEN
827  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
828  $ CALL aladhd( nout, path )
829  IF( prefac ) THEN
830  WRITE( nout, fmt = 9997 )'ZGESVXX', fact,
831  $ trans, n, equed, imat, 1, result( 1 )
832  ELSE
833  WRITE( nout, fmt = 9998 )'ZGESVXX', fact,
834  $ trans, n, imat, 1, result( 1 )
835  END IF
836  nfail = nfail + 1
837  nrun = nrun + 1
838  END IF
839  IF( result( 6 ).GE.thresh ) THEN
840  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
841  $ CALL aladhd( nout, path )
842  IF( prefac ) THEN
843  WRITE( nout, fmt = 9997 )'ZGESVXX', fact,
844  $ trans, n, equed, imat, 6, result( 6 )
845  ELSE
846  WRITE( nout, fmt = 9998 )'ZGESVXX', fact,
847  $ trans, n, imat, 6, result( 6 )
848  END IF
849  nfail = nfail + 1
850  nrun = nrun + 1
851  END IF
852  IF( result( 7 ).GE.thresh ) THEN
853  IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
854  $ CALL aladhd( nout, path )
855  IF( prefac ) THEN
856  WRITE( nout, fmt = 9997 )'ZGESVXX', fact,
857  $ trans, n, equed, imat, 7, result( 7 )
858  ELSE
859  WRITE( nout, fmt = 9998 )'ZGESVXX', fact,
860  $ trans, n, imat, 7, result( 7 )
861  END IF
862  nfail = nfail + 1
863  nrun = nrun + 1
864  END IF
865 *
866  END IF
867 *
868  50 CONTINUE
869  60 CONTINUE
870  70 CONTINUE
871  80 CONTINUE
872  90 CONTINUE
873 *
874 * Print a summary of the results.
875 *
876  CALL alasvm( path, nout, nfail, nrun, nerrs )
877 *
878 
879 * Test Error Bounds for ZGESVXX
880 
881  CALL zebchvxx(thresh, path)
882 
883  9999 FORMAT( 1x, a, ', N =', i5, ', type ', i2, ', test(', i2, ') =',
884  $ g12.5 )
885  9998 FORMAT( 1x, a, ', FACT=''', a1, ''', TRANS=''', a1, ''', N=', i5,
886  $ ', type ', i2, ', test(', i1, ')=', g12.5 )
887  9997 FORMAT( 1x, a, ', FACT=''', a1, ''', TRANS=''', a1, ''', N=', i5,
888  $ ', EQUED=''', a1, ''', type ', i2, ', test(', i1, ')=',
889  $ g12.5 )
890  RETURN
891 *
892 * End of ZDRVGEX
893 *
894  END
subroutine alasvm(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASVM
Definition: alasvm.f:73
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
Definition: xlaenv.f:81
subroutine aladhd(IOUNIT, PATH)
ALADHD
Definition: aladhd.f:90
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
Definition: alaerh.f:147
subroutine zget02(TRANS, M, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
ZGET02
Definition: zget02.f:134
subroutine zlarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
ZLARHS
Definition: zlarhs.f:208
subroutine zebchvxx(THRESH, PATH)
ZEBCHVXX
Definition: zebchvxx.f:96
subroutine zerrvx(PATH, NUNIT)
ZERRVX
Definition: zerrvx.f:55
subroutine zdrvge(DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX, A, AFAC, ASAV, B, BSAV, X, XACT, S, WORK, RWORK, IWORK, NOUT)
ZDRVGE
Definition: zdrvge.f:164
subroutine zget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
ZGET04
Definition: zget04.f:102
subroutine zget01(M, N, A, LDA, AFAC, LDAFAC, IPIV, RWORK, RESID)
ZGET01
Definition: zget01.f:108
subroutine zlatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
ZLATB4
Definition: zlatb4.f:121
subroutine zget07(TRANS, N, NRHS, A, LDA, B, LDB, X, LDX, XACT, LDXACT, FERR, CHKFERR, BERR, RESLTS)
ZGET07
Definition: zget07.f:166
subroutine zlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
ZLATMS
Definition: zlatms.f:332
subroutine zlaqge(M, N, A, LDA, R, C, ROWCND, COLCND, AMAX, EQUED)
ZLAQGE scales a general rectangular matrix, using row and column scaling factors computed by sgeequ.
Definition: zlaqge.f:143
subroutine zgeequ(M, N, A, LDA, R, C, ROWCND, COLCND, AMAX, INFO)
ZGEEQU
Definition: zgeequ.f:140
subroutine zgetri(N, A, LDA, IPIV, WORK, LWORK, INFO)
ZGETRI
Definition: zgetri.f:114
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:122
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:350
subroutine zgesvxx(FACT, TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, EQUED, R, C, B, LDB, X, LDX, RCOND, RPVGRW, BERR, N_ERR_BNDS, ERR_BNDS_NORM, ERR_BNDS_COMP, NPARAMS, PARAMS, WORK, RWORK, INFO)
ZGESVXX computes the solution to system of linear equations A * X = B for GE matrices
Definition: zgesvxx.f:540
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
Definition: zlacpy.f:103
subroutine zlaset(UPLO, M, N, ALPHA, BETA, A, LDA)
ZLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values.
Definition: zlaset.f:106
subroutine zgetrf(M, N, A, LDA, IPIV, INFO)
ZGETRF VARIANT: Crout Level 3 BLAS version of the algorithm.
Definition: zgetrf.f:102