LAPACK  3.9.0
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 *> \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.7.0) --
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
zgesv
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
zerrvx
subroutine zerrvx(PATH, NUNIT)
ZERRVX
Definition: zerrvx.f:57
zget02
subroutine zget02(TRANS, M, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
ZGET02
Definition: zget02.f:135
zlaqge
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:145
zdrvge
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:166
zget01
subroutine zget01(M, N, A, LDA, AFAC, LDAFAC, IPIV, RWORK, RESID)
ZGET01
Definition: zget01.f:110
alasvm
subroutine alasvm(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASVM
Definition: alasvm.f:75
zlarhs
subroutine zlarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
ZLARHS
Definition: zlarhs.f:211
zgetri
subroutine zgetri(N, A, LDA, IPIV, WORK, LWORK, INFO)
ZGETRI
Definition: zgetri.f:116
zget07
subroutine zget07(TRANS, N, NRHS, A, LDA, B, LDB, X, LDX, XACT, LDXACT, FERR, CHKFERR, BERR, RESLTS)
ZGET07
Definition: zget07.f:168
zgesvx
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
zlaset
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:108
zget04
subroutine zget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
ZGET04
Definition: zget04.f:104
zgetrf
subroutine zgetrf(M, N, A, LDA, IPIV, INFO)
ZGETRF VARIANT: Crout Level 3 BLAS version of the algorithm.
Definition: zgetrf.f:102
zlacpy
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
Definition: zlacpy.f:105
zgeequ
subroutine zgeequ(M, N, A, LDA, R, C, ROWCND, COLCND, AMAX, INFO)
ZGEEQU
Definition: zgeequ.f:142
aladhd
subroutine aladhd(IOUNIT, PATH)
ALADHD
Definition: aladhd.f:92
alaerh
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
Definition: alaerh.f:149
zebchvxx
subroutine zebchvxx(THRESH, PATH)
ZEBCHVXX
Definition: zebchvxx.f:98
zgesvxx
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:542
zlatb4
subroutine zlatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
ZLATB4
Definition: zlatb4.f:123
xlaenv
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
Definition: xlaenv.f:83
zlatms
subroutine zlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
ZLATMS
Definition: zlatms.f:334