LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
cdrvgex.f
Go to the documentation of this file.
1 *> \brief \b CDRVGEX
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 CDRVGE( 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 * REAL THRESH
19 * ..
20 * .. Array Arguments ..
21 * LOGICAL DOTYPE( * )
22 * INTEGER IWORK( * ), NVAL( * )
23 * REAL RWORK( * ), S( * )
24 * COMPLEX A( * ), AFAC( * ), ASAV( * ), B( * ),
25 * $ BSAV( * ), WORK( * ), X( * ), XACT( * )
26 * ..
27 *
28 *
29 *> \par Purpose:
30 * =============
31 *>
32 *> \verbatim
33 *>
34 *> CDRVGE tests the driver routines CGESV, -SVX, and -SVXX.
35 *>
36 *> Note that this file is used only when the XBLAS are available,
37 *> otherwise cdrvge.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 REAL
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 array, dimension (NMAX*NMAX)
94 *> \endverbatim
95 *>
96 *> \param[out] AFAC
97 *> \verbatim
98 *> AFAC is COMPLEX array, dimension (NMAX*NMAX)
99 *> \endverbatim
100 *>
101 *> \param[out] ASAV
102 *> \verbatim
103 *> ASAV is COMPLEX array, dimension (NMAX*NMAX)
104 *> \endverbatim
105 *>
106 *> \param[out] B
107 *> \verbatim
108 *> B is COMPLEX array, dimension (NMAX*NRHS)
109 *> \endverbatim
110 *>
111 *> \param[out] BSAV
112 *> \verbatim
113 *> BSAV is COMPLEX array, dimension (NMAX*NRHS)
114 *> \endverbatim
115 *>
116 *> \param[out] X
117 *> \verbatim
118 *> X is COMPLEX array, dimension (NMAX*NRHS)
119 *> \endverbatim
120 *>
121 *> \param[out] XACT
122 *> \verbatim
123 *> XACT is COMPLEX array, dimension (NMAX*NRHS)
124 *> \endverbatim
125 *>
126 *> \param[out] S
127 *> \verbatim
128 *> S is REAL array, dimension (2*NMAX)
129 *> \endverbatim
130 *>
131 *> \param[out] WORK
132 *> \verbatim
133 *> WORK is COMPLEX array, dimension
134 *> (NMAX*max(3,NRHS))
135 *> \endverbatim
136 *>
137 *> \param[out] RWORK
138 *> \verbatim
139 *> RWORK is REAL 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 complex_lin
164 *
165 * =====================================================================
166  SUBROUTINE cdrvge( 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  REAL thresh
179 * ..
180 * .. Array Arguments ..
181  LOGICAL dotype( * )
182  INTEGER iwork( * ), nval( * )
183  REAL rwork( * ), s( * )
184  COMPLEX a( * ), afac( * ), asav( * ), b( * ),
185  $ bsav( * ), work( * ), x( * ), xact( * )
186 * ..
187 *
188 * =====================================================================
189 *
190 * .. Parameters ..
191  REAL one, zero
192  parameter ( one = 1.0e+0, zero = 0.0e+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  REAL 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  REAL rdum( 1 ), result( ntests ), berr( nrhs ),
216  $ errbnds_n( nrhs, 3 ), errbnds_c( nrhs, 3 )
217 * ..
218 * .. External Functions ..
219  LOGICAL lsame
220  REAL clange, clantr, sget06, slamch, cla_gerpvgrw
221  EXTERNAL lsame, clange, clantr, sget06, slamch,
222  $ cla_gerpvgrw
223 * ..
224 * .. External Subroutines ..
225  EXTERNAL aladhd, alaerh, alasvm, cerrvx, cgeequ, cgesv,
226  $ cgesvx, cget01, cget02, cget04, cget07, cgetrf,
227  $ cgetri, clacpy, claqge, clarhs, claset, clatb4,
228  $ clatms, xlaenv, cgesvxx
229 * ..
230 * .. Intrinsic Functions ..
231  INTRINSIC abs, cmplx, max
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 ) = 'Complex 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 cerrvx( 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 CLATB4 and generate a test matrix
298 * with CLATMS.
299 *
300  CALL clatb4( path, imat, n, n, TYPE, kl, ku, anorm, mode,
301  $ cndnum, dist )
302  rcondc = one / cndnum
303 *
304  srnamt = 'CLATMS'
305  CALL clatms( 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 CLATMS.
310 *
311  IF( info.NE.0 ) THEN
312  CALL alaerh( path, 'CLATMS', 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 claset( 'Full', n, n-izero+1, cmplx( zero ),
335  $ cmplx( 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 clacpy( '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 CGESVX (FACT = 'N' reuses
369 * the condition number from the previous iteration
370 * with FACT = 'F').
371 *
372  CALL clacpy( '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 cgeequ( 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 claqge( 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 CGET04.
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 = clange( '1', n, n, afac, lda, rwork )
410  anormi = clange( 'I', n, n, afac, lda, rwork )
411 *
412 * Factor the matrix A.
413 *
414  CALL cgetrf( n, n, afac, lda, iwork, info )
415 *
416 * Form the inverse of A.
417 *
418  CALL clacpy( 'Full', n, n, afac, lda, a, lda )
419  lwork = nmax*max( 3, nrhs )
420  CALL cgetri( n, a, lda, iwork, work, lwork, info )
421 *
422 * Compute the 1-norm condition number of A.
423 *
424  ainvnm = clange( '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 = clange( '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 clacpy( 'Full', n, n, asav, lda, a, lda )
455 *
456 * Form an exact solution and set the right hand side.
457 *
458  srnamt = 'CLARHS'
459  CALL clarhs( path, xtype, 'Full', trans, n, n, kl,
460  $ ku, nrhs, a, lda, xact, lda, b, lda,
461  $ iseed, info )
462  xtype = 'C'
463  CALL clacpy( 'Full', n, nrhs, b, lda, bsav, lda )
464 *
465  IF( nofact .AND. itran.EQ.1 ) THEN
466 *
467 * --- Test CGESV ---
468 *
469 * Compute the LU factorization of the matrix and
470 * solve the system.
471 *
472  CALL clacpy( 'Full', n, n, a, lda, afac, lda )
473  CALL clacpy( 'Full', n, nrhs, b, lda, x, lda )
474 *
475  srnamt = 'CGESV '
476  CALL cgesv( n, nrhs, afac, lda, iwork, x, lda,
477  $ info )
478 *
479 * Check error code from CGESV .
480 *
481  IF( info.NE.izero )
482  $ CALL alaerh( path, 'CGESV ', 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 cget01( 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 clacpy( 'Full', n, nrhs, b, lda, work,
497  $ lda )
498  CALL cget02( '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 cget04( 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 )'CGESV ', 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 CGESVX ---
525 *
526  IF( .NOT.prefac )
527  $ CALL claset( 'Full', n, n, cmplx( zero ),
528  $ cmplx( zero ), afac, lda )
529  CALL claset( 'Full', n, nrhs, cmplx( zero ),
530  $ cmplx( 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 claqge( 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 CGESVX.
542 *
543  srnamt = 'CGESVX'
544  CALL cgesvx( 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 CGESVX.
551 *
552  IF( info.NE.izero )
553  $ CALL alaerh( path, 'CGESVX', info, izero,
554  $ fact // trans, n, n, -1, -1, nrhs,
555  $ imat, nfail, nerrs, nout )
556 *
557 * Compare RWORK(2*NRHS+1) from CGESVX with the
558 * computed reciprocal pivot growth factor RPVGRW
559 *
560  IF( info.NE.0 ) THEN
561  rpvgrw = clantr( 'M', 'U', 'N', info, info,
562  $ afac, lda, rdum )
563  IF( rpvgrw.EQ.zero ) THEN
564  rpvgrw = one
565  ELSE
566  rpvgrw = clange( 'M', n, info, a, lda,
567  $ rdum ) / rpvgrw
568  END IF
569  ELSE
570  rpvgrw = clantr( 'M', 'U', 'N', n, n, afac, lda,
571  $ rdum )
572  IF( rpvgrw.EQ.zero ) THEN
573  rpvgrw = one
574  ELSE
575  rpvgrw = clange( '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  $ slamch( 'E' )
582 *
583  IF( .NOT.prefac ) THEN
584 *
585 * Reconstruct matrix from factors and compute
586 * residual.
587 *
588  CALL cget01( 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 clacpy( 'Full', n, nrhs, bsav, lda, work,
601  $ lda )
602  CALL cget02( 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 cget04( 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 cget04( 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 cget07( 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 CGESVX with the computed value
633 * in RCONDC.
634 *
635  result( 6 ) = sget06( 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 )'CGESVX',
647  $ fact, trans, n, equed, imat, k,
648  $ result( k )
649  ELSE
650  WRITE( nout, fmt = 9998 )'CGESVX',
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 )'CGESVX', fact,
664  $ trans, n, equed, imat, 1, result( 1 )
665  ELSE
666  WRITE( nout, fmt = 9998 )'CGESVX', 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 )'CGESVX', fact,
677  $ trans, n, equed, imat, 6, result( 6 )
678  ELSE
679  WRITE( nout, fmt = 9998 )'CGESVX', 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 )'CGESVX', fact,
690  $ trans, n, equed, imat, 7, result( 7 )
691  ELSE
692  WRITE( nout, fmt = 9998 )'CGESVX', 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 CGESVXX ---
702 *
703 * Restore the matrices A and B.
704 *
705 
706  CALL clacpy( 'Full', n, n, asav, lda, a, lda )
707  CALL clacpy( 'Full', n, nrhs, bsav, lda, b, lda )
708 
709  IF( .NOT.prefac )
710  $ CALL claset( 'Full', n, n, zero, zero, afac,
711  $ lda )
712  CALL claset( '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 claqge( 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 CGESVXX.
724 *
725  srnamt = 'CGESVXX'
726  n_err_bnds = 3
727  CALL cgesvxx( 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 CGESVXX.
734 *
735  IF( info.EQ.n+1 ) GOTO 50
736  IF( info.NE.izero ) THEN
737  CALL alaerh( path, 'CGESVXX', 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 CGESVXX with the computed
744 * reciprocal pivot growth factor RPVGRW
745 *
746 
747  IF ( info .GT. 0 .AND. info .LT. n+1 ) THEN
748  rpvgrw = cla_gerpvgrw
749  $ (n, info, a, lda, afac, lda)
750  ELSE
751  rpvgrw = cla_gerpvgrw
752  $ (n, n, a, lda, afac, lda)
753  ENDIF
754 
755  result( 7 ) = abs( rpvgrw-rpvgrw_svxx ) /
756  $ max( rpvgrw_svxx, rpvgrw ) /
757  $ slamch( 'E' )
758 *
759  IF( .NOT.prefac ) THEN
760 *
761 * Reconstruct matrix from factors and compute
762 * residual.
763 *
764  CALL cget01( 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 clacpy( 'Full', n, nrhs, bsav, lda, work,
777  $ lda )
778  CALL cget02( 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 cget04( 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 cget04( 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 CGESVXX with the computed value
802 * in RCONDC.
803 *
804  result( 6 ) = sget06( 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 )'CGESVXX',
816  $ fact, trans, n, equed, imat, k,
817  $ result( k )
818  ELSE
819  WRITE( nout, fmt = 9998 )'CGESVXX',
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 )'CGESVXX', fact,
833  $ trans, n, equed, imat, 1, result( 1 )
834  ELSE
835  WRITE( nout, fmt = 9998 )'CGESVXX', 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 )'CGESVXX', fact,
846  $ trans, n, equed, imat, 6, result( 6 )
847  ELSE
848  WRITE( nout, fmt = 9998 )'CGESVXX', 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 )'CGESVXX', fact,
859  $ trans, n, equed, imat, 7, result( 7 )
860  ELSE
861  WRITE( nout, fmt = 9998 )'CGESVXX', 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 CGESVXX
882 
883  CALL cebchvxx(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 CDRVGE
895 *
896  END
alasvm
subroutine alasvm(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASVM
Definition: alasvm.f:75
cget01
subroutine cget01(M, N, A, LDA, AFAC, LDAFAC, IPIV, RWORK, RESID)
CGET01
Definition: cget01.f:110
alaerh
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
Definition: alaerh.f:149
clarhs
subroutine clarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
CLARHS
Definition: clarhs.f:211
cget07
subroutine cget07(TRANS, N, NRHS, A, LDA, B, LDB, X, LDX, XACT, LDXACT, FERR, CHKFERR, BERR, RESLTS)
CGET07
Definition: cget07.f:168
cgetri
subroutine cgetri(N, A, LDA, IPIV, WORK, LWORK, INFO)
CGETRI
Definition: cgetri.f:116
cebchvxx
subroutine cebchvxx(THRESH, PATH)
CEBCHVXX
Definition: cebchvxx.f:98
cerrvx
subroutine cerrvx(PATH, NUNIT)
CERRVX
Definition: cerrvx.f:57
clantr
real function clantr(NORM, UPLO, DIAG, M, N, A, LDA, WORK)
CLANTR returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a trapezoidal or triangular matrix.
Definition: clantr.f:144
sget06
real function sget06(RCOND, RCONDC)
SGET06
Definition: sget06.f:57
cla_gerpvgrw
real function cla_gerpvgrw(N, NCOLS, A, LDA, AF, LDAF)
CLA_GERPVGRW multiplies a square real matrix by a complex matrix.
Definition: cla_gerpvgrw.f:100
clange
real function clange(NORM, M, N, A, LDA, WORK)
CLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
Definition: clange.f:117
xlaenv
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
Definition: xlaenv.f:83
claqge
subroutine claqge(M, N, A, LDA, R, C, ROWCND, COLCND, AMAX, EQUED)
CLAQGE scales a general rectangular matrix, using row and column scaling factors computed by sgeequ...
Definition: claqge.f:145
cget02
subroutine cget02(TRANS, M, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
CGET02
Definition: cget02.f:135
cdrvge
subroutine cdrvge(DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX, A, AFAC, ASAV, B, BSAV, X, XACT, S, WORK, RWORK, IWORK, NOUT)
CDRVGE
Definition: cdrvge.f:166
claset
subroutine claset(UPLO, M, N, ALPHA, BETA, A, LDA)
CLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
Definition: claset.f:108
cgesvx
subroutine cgesvx(FACT, TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, EQUED, R, C, B, LDB, X, LDX, RCOND, FERR, BERR, WORK, RWORK, INFO)
CGESVX computes the solution to system of linear equations A * X = B for GE matrices ...
Definition: cgesvx.f:352
cgeequ
subroutine cgeequ(M, N, A, LDA, R, C, ROWCND, COLCND, AMAX, INFO)
CGEEQU
Definition: cgeequ.f:142
clatms
subroutine clatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
CLATMS
Definition: clatms.f:334
aladhd
subroutine aladhd(IOUNIT, PATH)
ALADHD
Definition: aladhd.f:80
cgetrf
subroutine cgetrf(M, N, A, LDA, IPIV, INFO)
CGETRF
Definition: cgetrf.f:110
clacpy
subroutine clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
Definition: clacpy.f:105
slamch
real function slamch(CMACH)
SLAMCH
Definition: slamch.f:69
clatb4
subroutine clatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
CLATB4
Definition: clatb4.f:123
cgesv
subroutine cgesv(N, NRHS, A, LDA, IPIV, B, LDB, INFO)
CGESV computes the solution to system of linear equations A * X = B for GE matrices (simple driver) ...
Definition: cgesv.f:124
cget04
subroutine cget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
CGET04
Definition: cget04.f:104
cgesvxx
subroutine cgesvxx(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)
CGESVXX computes the solution to system of linear equations A * X = B for GE matrices ...
Definition: cgesvxx.f:545
lsame
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:55