1 SUBROUTINE CDRVGE( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX,
2 $ A, AFAC, ASAV, B, BSAV, X, XACT, S, WORK,
3 $ RWORK, IWORK, NOUT )
4 *
5 * -- LAPACK test routine (version 3.2.1) --
6 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
7 * April 2009
8 *
9 * .. Scalar Arguments ..
10 LOGICAL TSTERR
11 INTEGER NMAX, NN, NOUT, NRHS
12 REAL THRESH
13 * ..
14 * .. Array Arguments ..
15 LOGICAL DOTYPE( * )
16 INTEGER IWORK( * ), NVAL( * )
17 REAL RWORK( * ), S( * )
18 COMPLEX A( * ), AFAC( * ), ASAV( * ), B( * ),
19 $ BSAV( * ), WORK( * ), X( * ), XACT( * )
20 * ..
21 *
22 * Purpose
23 * =======
24 *
25 * CDRVGE tests the driver routines CGESV, -SVX, and -SVXX.
26 *
27 * Note that this file is used only when the XBLAS are available,
28 * otherwise cdrvge.f defines this subroutine.
29 *
30 * Arguments
31 * =========
32 *
33 * DOTYPE (input) LOGICAL array, dimension (NTYPES)
34 * The matrix types to be used for testing. Matrices of type j
35 * (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) =
36 * .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.
37 *
38 * NN (input) INTEGER
39 * The number of values of N contained in the vector NVAL.
40 *
41 * NVAL (input) INTEGER array, dimension (NN)
42 * The values of the matrix column dimension N.
43 *
44 * NRHS (input) INTEGER
45 * The number of right hand side vectors to be generated for
46 * each linear system.
47 *
48 * THRESH (input) REAL
49 * The threshold value for the test ratios. A result is
50 * included in the output file if RESULT >= THRESH. To have
51 * every test ratio printed, use THRESH = 0.
52 *
53 * TSTERR (input) LOGICAL
54 * Flag that indicates whether error exits are to be tested.
55 *
56 * NMAX (input) INTEGER
57 * The maximum value permitted for N, used in dimensioning the
58 * work arrays.
59 *
60 * A (workspace) COMPLEX array, dimension (NMAX*NMAX)
61 *
62 * AFAC (workspace) COMPLEX array, dimension (NMAX*NMAX)
63 *
64 * ASAV (workspace) COMPLEX array, dimension (NMAX*NMAX)
65 *
66 * B (workspace) COMPLEX array, dimension (NMAX*NRHS)
67 *
68 * BSAV (workspace) COMPLEX array, dimension (NMAX*NRHS)
69 *
70 * X (workspace) COMPLEX array, dimension (NMAX*NRHS)
71 *
72 * XACT (workspace) COMPLEX array, dimension (NMAX*NRHS)
73 *
74 * S (workspace) REAL array, dimension (2*NMAX)
75 *
76 * WORK (workspace) COMPLEX array, dimension
77 * (NMAX*max(3,NRHS))
78 *
79 * RWORK (workspace) REAL array, dimension (2*NRHS+NMAX)
80 *
81 * IWORK (workspace) INTEGER array, dimension (NMAX)
82 *
83 * NOUT (input) INTEGER
84 * The unit number for output.
85 *
86 * =====================================================================
87 *
88 * .. Parameters ..
89 REAL ONE, ZERO
90 PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
91 INTEGER NTYPES
92 PARAMETER ( NTYPES = 11 )
93 INTEGER NTESTS
94 PARAMETER ( NTESTS = 7 )
95 INTEGER NTRAN
96 PARAMETER ( NTRAN = 3 )
97 * ..
98 * .. Local Scalars ..
99 LOGICAL EQUIL, NOFACT, PREFAC, TRFCON, ZEROT
100 CHARACTER DIST, EQUED, FACT, TRANS, TYPE, XTYPE
101 CHARACTER*3 PATH
102 INTEGER I, IEQUED, IFACT, IMAT, IN, INFO, IOFF, ITRAN,
103 $ IZERO, K, K1, KL, KU, LDA, LWORK, MODE, N, NB,
104 $ NBMIN, NERRS, NFACT, NFAIL, NIMAT, NRUN, NT,
105 $ N_ERR_BNDS
106 REAL AINVNM, AMAX, ANORM, ANORMI, ANORMO, CNDNUM,
107 $ COLCND, RCOND, RCONDC, RCONDI, RCONDO, ROLDC,
108 $ ROLDI, ROLDO, ROWCND, RPVGRW, RPVGRW_SVXX
109 * ..
110 * .. Local Arrays ..
111 CHARACTER EQUEDS( 4 ), FACTS( 3 ), TRANSS( NTRAN )
112 INTEGER ISEED( 4 ), ISEEDY( 4 )
113 REAL RDUM( 1 ), RESULT( NTESTS ), BERR( NRHS ),
114 $ ERRBNDS_N( NRHS, 3 ), ERRBNDS_C( NRHS, 3 )
115 * ..
116 * .. External Functions ..
117 LOGICAL LSAME
118 REAL CLANGE, CLANTR, SGET06, SLAMCH, CLA_RPVGRW
119 EXTERNAL LSAME, CLANGE, CLANTR, SGET06, SLAMCH,
120 $ CLA_RPVGRW
121 * ..
122 * .. External Subroutines ..
123 EXTERNAL ALADHD, ALAERH, ALASVM, CERRVX, CGEEQU, CGESV,
124 $ CGESVX, CGET01, CGET02, CGET04, CGET07, CGETRF,
125 $ CGETRI, CLACPY, CLAQGE, CLARHS, CLASET, CLATB4,
126 $ CLATMS, XLAENV, CGESVXX
127 * ..
128 * .. Intrinsic Functions ..
129 INTRINSIC ABS, CMPLX, MAX
130 * ..
131 * .. Scalars in Common ..
132 LOGICAL LERR, OK
133 CHARACTER*32 SRNAMT
134 INTEGER INFOT, NUNIT
135 * ..
136 * .. Common blocks ..
137 COMMON / INFOC / INFOT, NUNIT, OK, LERR
138 COMMON / SRNAMC / SRNAMT
139 * ..
140 * .. Data statements ..
141 DATA ISEEDY / 1988, 1989, 1990, 1991 /
142 DATA TRANSS / 'N', 'T', 'C' /
143 DATA FACTS / 'F', 'N', 'E' /
144 DATA EQUEDS / 'N', 'R', 'C', 'B' /
145 * ..
146 * .. Executable Statements ..
147 *
148 * Initialize constants and the random number seed.
149 *
150 PATH( 1: 1 ) = 'Complex precision'
151 PATH( 2: 3 ) = 'GE'
152 NRUN = 0
153 NFAIL = 0
154 NERRS = 0
155 DO 10 I = 1, 4
156 ISEED( I ) = ISEEDY( I )
157 10 CONTINUE
158 *
159 * Test the error exits
160 *
161 IF( TSTERR )
162 $ CALL CERRVX( PATH, NOUT )
163 INFOT = 0
164 *
165 * Set the block size and minimum block size for testing.
166 *
167 NB = 1
168 NBMIN = 2
169 CALL XLAENV( 1, NB )
170 CALL XLAENV( 2, NBMIN )
171 *
172 * Do for each value of N in NVAL
173 *
174 DO 90 IN = 1, NN
175 N = NVAL( IN )
176 LDA = MAX( N, 1 )
177 XTYPE = 'N'
178 NIMAT = NTYPES
179 IF( N.LE.0 )
180 $ NIMAT = 1
181 *
182 DO 80 IMAT = 1, NIMAT
183 *
184 * Do the tests only if DOTYPE( IMAT ) is true.
185 *
186 IF( .NOT.DOTYPE( IMAT ) )
187 $ GO TO 80
188 *
189 * Skip types 5, 6, or 7 if the matrix size is too small.
190 *
191 ZEROT = IMAT.GE.5 .AND. IMAT.LE.7
192 IF( ZEROT .AND. N.LT.IMAT-4 )
193 $ GO TO 80
194 *
195 * Set up parameters with CLATB4 and generate a test matrix
196 * with CLATMS.
197 *
198 CALL CLATB4( PATH, IMAT, N, N, TYPE, KL, KU, ANORM, MODE,
199 $ CNDNUM, DIST )
200 RCONDC = ONE / CNDNUM
201 *
202 SRNAMT = 'CLATMS'
203 CALL CLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE, CNDNUM,
204 $ ANORM, KL, KU, 'No packing', A, LDA, WORK,
205 $ INFO )
206 *
207 * Check error code from CLATMS.
208 *
209 IF( INFO.NE.0 ) THEN
210 CALL ALAERH( PATH, 'CLATMS', INFO, 0, ' ', N, N, -1, -1,
211 $ -1, IMAT, NFAIL, NERRS, NOUT )
212 GO TO 80
213 END IF
214 *
215 * For types 5-7, zero one or more columns of the matrix to
216 * test that INFO is returned correctly.
217 *
218 IF( ZEROT ) THEN
219 IF( IMAT.EQ.5 ) THEN
220 IZERO = 1
221 ELSE IF( IMAT.EQ.6 ) THEN
222 IZERO = N
223 ELSE
224 IZERO = N / 2 + 1
225 END IF
226 IOFF = ( IZERO-1 )*LDA
227 IF( IMAT.LT.7 ) THEN
228 DO 20 I = 1, N
229 A( IOFF+I ) = ZERO
230 20 CONTINUE
231 ELSE
232 CALL CLASET( 'Full', N, N-IZERO+1, CMPLX( ZERO ),
233 $ CMPLX( ZERO ), A( IOFF+1 ), LDA )
234 END IF
235 ELSE
236 IZERO = 0
237 END IF
238 *
239 * Save a copy of the matrix A in ASAV.
240 *
241 CALL CLACPY( 'Full', N, N, A, LDA, ASAV, LDA )
242 *
243 DO 70 IEQUED = 1, 4
244 EQUED = EQUEDS( IEQUED )
245 IF( IEQUED.EQ.1 ) THEN
246 NFACT = 3
247 ELSE
248 NFACT = 1
249 END IF
250 *
251 DO 60 IFACT = 1, NFACT
252 FACT = FACTS( IFACT )
253 PREFAC = LSAME( FACT, 'F' )
254 NOFACT = LSAME( FACT, 'N' )
255 EQUIL = LSAME( FACT, 'E' )
256 *
257 IF( ZEROT ) THEN
258 IF( PREFAC )
259 $ GO TO 60
260 RCONDO = ZERO
261 RCONDI = ZERO
262 *
263 ELSE IF( .NOT.NOFACT ) THEN
264 *
265 * Compute the condition number for comparison with
266 * the value returned by CGESVX (FACT = 'N' reuses
267 * the condition number from the previous iteration
268 * with FACT = 'F').
269 *
270 CALL CLACPY( 'Full', N, N, ASAV, LDA, AFAC, LDA )
271 IF( EQUIL .OR. IEQUED.GT.1 ) THEN
272 *
273 * Compute row and column scale factors to
274 * equilibrate the matrix A.
275 *
276 CALL CGEEQU( N, N, AFAC, LDA, S, S( N+1 ),
277 $ ROWCND, COLCND, AMAX, INFO )
278 IF( INFO.EQ.0 .AND. N.GT.0 ) THEN
279 IF( LSAME( EQUED, 'R' ) ) THEN
280 ROWCND = ZERO
281 COLCND = ONE
282 ELSE IF( LSAME( EQUED, 'C' ) ) THEN
283 ROWCND = ONE
284 COLCND = ZERO
285 ELSE IF( LSAME( EQUED, 'B' ) ) THEN
286 ROWCND = ZERO
287 COLCND = ZERO
288 END IF
289 *
290 * Equilibrate the matrix.
291 *
292 CALL CLAQGE( N, N, AFAC, LDA, S, S( N+1 ),
293 $ ROWCND, COLCND, AMAX, EQUED )
294 END IF
295 END IF
296 *
297 * Save the condition number of the non-equilibrated
298 * system for use in CGET04.
299 *
300 IF( EQUIL ) THEN
301 ROLDO = RCONDO
302 ROLDI = RCONDI
303 END IF
304 *
305 * Compute the 1-norm and infinity-norm of A.
306 *
307 ANORMO = CLANGE( '1', N, N, AFAC, LDA, RWORK )
308 ANORMI = CLANGE( 'I', N, N, AFAC, LDA, RWORK )
309 *
310 * Factor the matrix A.
311 *
312 CALL CGETRF( N, N, AFAC, LDA, IWORK, INFO )
313 *
314 * Form the inverse of A.
315 *
316 CALL CLACPY( 'Full', N, N, AFAC, LDA, A, LDA )
317 LWORK = NMAX*MAX( 3, NRHS )
318 CALL CGETRI( N, A, LDA, IWORK, WORK, LWORK, INFO )
319 *
320 * Compute the 1-norm condition number of A.
321 *
322 AINVNM = CLANGE( '1', N, N, A, LDA, RWORK )
323 IF( ANORMO.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN
324 RCONDO = ONE
325 ELSE
326 RCONDO = ( ONE / ANORMO ) / AINVNM
327 END IF
328 *
329 * Compute the infinity-norm condition number of A.
330 *
331 AINVNM = CLANGE( 'I', N, N, A, LDA, RWORK )
332 IF( ANORMI.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN
333 RCONDI = ONE
334 ELSE
335 RCONDI = ( ONE / ANORMI ) / AINVNM
336 END IF
337 END IF
338 *
339 DO 50 ITRAN = 1, NTRAN
340 *
341 * Do for each value of TRANS.
342 *
343 TRANS = TRANSS( ITRAN )
344 IF( ITRAN.EQ.1 ) THEN
345 RCONDC = RCONDO
346 ELSE
347 RCONDC = RCONDI
348 END IF
349 *
350 * Restore the matrix A.
351 *
352 CALL CLACPY( 'Full', N, N, ASAV, LDA, A, LDA )
353 *
354 * Form an exact solution and set the right hand side.
355 *
356 SRNAMT = 'CLARHS'
357 CALL CLARHS( PATH, XTYPE, 'Full', TRANS, N, N, KL,
358 $ KU, NRHS, A, LDA, XACT, LDA, B, LDA,
359 $ ISEED, INFO )
360 XTYPE = 'C'
361 CALL CLACPY( 'Full', N, NRHS, B, LDA, BSAV, LDA )
362 *
363 IF( NOFACT .AND. ITRAN.EQ.1 ) THEN
364 *
365 * --- Test CGESV ---
366 *
367 * Compute the LU factorization of the matrix and
368 * solve the system.
369 *
370 CALL CLACPY( 'Full', N, N, A, LDA, AFAC, LDA )
371 CALL CLACPY( 'Full', N, NRHS, B, LDA, X, LDA )
372 *
373 SRNAMT = 'CGESV '
374 CALL CGESV( N, NRHS, AFAC, LDA, IWORK, X, LDA,
375 $ INFO )
376 *
377 * Check error code from CGESV .
378 *
379 IF( INFO.NE.IZERO )
380 $ CALL ALAERH( PATH, 'CGESV ', INFO, IZERO,
381 $ ' ', N, N, -1, -1, NRHS, IMAT,
382 $ NFAIL, NERRS, NOUT )
383 *
384 * Reconstruct matrix from factors and compute
385 * residual.
386 *
387 CALL CGET01( N, N, A, LDA, AFAC, LDA, IWORK,
388 $ RWORK, RESULT( 1 ) )
389 NT = 1
390 IF( IZERO.EQ.0 ) THEN
391 *
392 * Compute residual of the computed solution.
393 *
394 CALL CLACPY( 'Full', N, NRHS, B, LDA, WORK,
395 $ LDA )
396 CALL CGET02( 'No transpose', N, N, NRHS, A,
397 $ LDA, X, LDA, WORK, LDA, RWORK,
398 $ RESULT( 2 ) )
399 *
400 * Check solution from generated exact solution.
401 *
402 CALL CGET04( N, NRHS, X, LDA, XACT, LDA,
403 $ RCONDC, RESULT( 3 ) )
404 NT = 3
405 END IF
406 *
407 * Print information about the tests that did not
408 * pass the threshold.
409 *
410 DO 30 K = 1, NT
411 IF( RESULT( K ).GE.THRESH ) THEN
412 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
413 $ CALL ALADHD( NOUT, PATH )
414 WRITE( NOUT, FMT = 9999 )'CGESV ', N,
415 $ IMAT, K, RESULT( K )
416 NFAIL = NFAIL + 1
417 END IF
418 30 CONTINUE
419 NRUN = NRUN + NT
420 END IF
421 *
422 * --- Test CGESVX ---
423 *
424 IF( .NOT.PREFAC )
425 $ CALL CLASET( 'Full', N, N, CMPLX( ZERO ),
426 $ CMPLX( ZERO ), AFAC, LDA )
427 CALL CLASET( 'Full', N, NRHS, CMPLX( ZERO ),
428 $ CMPLX( ZERO ), X, LDA )
429 IF( IEQUED.GT.1 .AND. N.GT.0 ) THEN
430 *
431 * Equilibrate the matrix if FACT = 'F' and
432 * EQUED = 'R', 'C', or 'B'.
433 *
434 CALL CLAQGE( N, N, A, LDA, S, S( N+1 ), ROWCND,
435 $ COLCND, AMAX, EQUED )
436 END IF
437 *
438 * Solve the system and compute the condition number
439 * and error bounds using CGESVX.
440 *
441 SRNAMT = 'CGESVX'
442 CALL CGESVX( FACT, TRANS, N, NRHS, A, LDA, AFAC,
443 $ LDA, IWORK, EQUED, S, S( N+1 ), B,
444 $ LDA, X, LDA, RCOND, RWORK,
445 $ RWORK( NRHS+1 ), WORK,
446 $ RWORK( 2*NRHS+1 ), INFO )
447 *
448 * Check the error code from CGESVX.
449 *
450 IF( INFO.NE.IZERO )
451 $ CALL ALAERH( PATH, 'CGESVX', INFO, IZERO,
452 $ FACT // TRANS, N, N, -1, -1, NRHS,
453 $ IMAT, NFAIL, NERRS, NOUT )
454 *
455 * Compare RWORK(2*NRHS+1) from CGESVX with the
456 * computed reciprocal pivot growth factor RPVGRW
457 *
458 IF( INFO.NE.0 ) THEN
459 RPVGRW = CLANTR( 'M', 'U', 'N', INFO, INFO,
460 $ AFAC, LDA, RDUM )
461 IF( RPVGRW.EQ.ZERO ) THEN
462 RPVGRW = ONE
463 ELSE
464 RPVGRW = CLANGE( 'M', N, INFO, A, LDA,
465 $ RDUM ) / RPVGRW
466 END IF
467 ELSE
468 RPVGRW = CLANTR( 'M', 'U', 'N', N, N, AFAC, LDA,
469 $ RDUM )
470 IF( RPVGRW.EQ.ZERO ) THEN
471 RPVGRW = ONE
472 ELSE
473 RPVGRW = CLANGE( 'M', N, N, A, LDA, RDUM ) /
474 $ RPVGRW
475 END IF
476 END IF
477 RESULT( 7 ) = ABS( RPVGRW-RWORK( 2*NRHS+1 ) ) /
478 $ MAX( RWORK( 2*NRHS+1 ), RPVGRW ) /
479 $ SLAMCH( 'E' )
480 *
481 IF( .NOT.PREFAC ) THEN
482 *
483 * Reconstruct matrix from factors and compute
484 * residual.
485 *
486 CALL CGET01( N, N, A, LDA, AFAC, LDA, IWORK,
487 $ RWORK( 2*NRHS+1 ), RESULT( 1 ) )
488 K1 = 1
489 ELSE
490 K1 = 2
491 END IF
492 *
493 IF( INFO.EQ.0 ) THEN
494 TRFCON = .FALSE.
495 *
496 * Compute residual of the computed solution.
497 *
498 CALL CLACPY( 'Full', N, NRHS, BSAV, LDA, WORK,
499 $ LDA )
500 CALL CGET02( TRANS, N, N, NRHS, ASAV, LDA, X,
501 $ LDA, WORK, LDA, RWORK( 2*NRHS+1 ),
502 $ RESULT( 2 ) )
503 *
504 * Check solution from generated exact solution.
505 *
506 IF( NOFACT .OR. ( PREFAC .AND. LSAME( EQUED,
507 $ 'N' ) ) ) THEN
508 CALL CGET04( N, NRHS, X, LDA, XACT, LDA,
509 $ RCONDC, RESULT( 3 ) )
510 ELSE
511 IF( ITRAN.EQ.1 ) THEN
512 ROLDC = ROLDO
513 ELSE
514 ROLDC = ROLDI
515 END IF
516 CALL CGET04( N, NRHS, X, LDA, XACT, LDA,
517 $ ROLDC, RESULT( 3 ) )
518 END IF
519 *
520 * Check the error bounds from iterative
521 * refinement.
522 *
523 CALL CGET07( TRANS, N, NRHS, ASAV, LDA, B, LDA,
524 $ X, LDA, XACT, LDA, RWORK, .TRUE.,
525 $ RWORK( NRHS+1 ), RESULT( 4 ) )
526 ELSE
527 TRFCON = .TRUE.
528 END IF
529 *
530 * Compare RCOND from CGESVX with the computed value
531 * in RCONDC.
532 *
533 RESULT( 6 ) = SGET06( RCOND, RCONDC )
534 *
535 * Print information about the tests that did not pass
536 * the threshold.
537 *
538 IF( .NOT.TRFCON ) THEN
539 DO 40 K = K1, NTESTS
540 IF( RESULT( K ).GE.THRESH ) THEN
541 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
542 $ CALL ALADHD( NOUT, PATH )
543 IF( PREFAC ) THEN
544 WRITE( NOUT, FMT = 9997 )'CGESVX',
545 $ FACT, TRANS, N, EQUED, IMAT, K,
546 $ RESULT( K )
547 ELSE
548 WRITE( NOUT, FMT = 9998 )'CGESVX',
549 $ FACT, TRANS, N, IMAT, K, RESULT( K )
550 END IF
551 NFAIL = NFAIL + 1
552 END IF
553 40 CONTINUE
554 NRUN = NRUN + 7 - K1
555 ELSE
556 IF( RESULT( 1 ).GE.THRESH .AND. .NOT.PREFAC )
557 $ THEN
558 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
559 $ CALL ALADHD( NOUT, PATH )
560 IF( PREFAC ) THEN
561 WRITE( NOUT, FMT = 9997 )'CGESVX', FACT,
562 $ TRANS, N, EQUED, IMAT, 1, RESULT( 1 )
563 ELSE
564 WRITE( NOUT, FMT = 9998 )'CGESVX', FACT,
565 $ TRANS, N, IMAT, 1, RESULT( 1 )
566 END IF
567 NFAIL = NFAIL + 1
568 NRUN = NRUN + 1
569 END IF
570 IF( RESULT( 6 ).GE.THRESH ) THEN
571 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
572 $ CALL ALADHD( NOUT, PATH )
573 IF( PREFAC ) THEN
574 WRITE( NOUT, FMT = 9997 )'CGESVX', FACT,
575 $ TRANS, N, EQUED, IMAT, 6, RESULT( 6 )
576 ELSE
577 WRITE( NOUT, FMT = 9998 )'CGESVX', FACT,
578 $ TRANS, N, IMAT, 6, RESULT( 6 )
579 END IF
580 NFAIL = NFAIL + 1
581 NRUN = NRUN + 1
582 END IF
583 IF( RESULT( 7 ).GE.THRESH ) THEN
584 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
585 $ CALL ALADHD( NOUT, PATH )
586 IF( PREFAC ) THEN
587 WRITE( NOUT, FMT = 9997 )'CGESVX', FACT,
588 $ TRANS, N, EQUED, IMAT, 7, RESULT( 7 )
589 ELSE
590 WRITE( NOUT, FMT = 9998 )'CGESVX', FACT,
591 $ TRANS, N, IMAT, 7, RESULT( 7 )
592 END IF
593 NFAIL = NFAIL + 1
594 NRUN = NRUN + 1
595 END IF
596 *
597 END IF
598 *
599 * --- Test CGESVXX ---
600 *
601 * Restore the matrices A and B.
602 *
603
604 CALL CLACPY( 'Full', N, N, ASAV, LDA, A, LDA )
605 CALL CLACPY( 'Full', N, NRHS, BSAV, LDA, B, LDA )
606
607 IF( .NOT.PREFAC )
608 $ CALL CLASET( 'Full', N, N, ZERO, ZERO, AFAC,
609 $ LDA )
610 CALL CLASET( 'Full', N, NRHS, ZERO, ZERO, X, LDA )
611 IF( IEQUED.GT.1 .AND. N.GT.0 ) THEN
612 *
613 * Equilibrate the matrix if FACT = 'F' and
614 * EQUED = 'R', 'C', or 'B'.
615 *
616 CALL CLAQGE( N, N, A, LDA, S, S( N+1 ), ROWCND,
617 $ COLCND, AMAX, EQUED )
618 END IF
619 *
620 * Solve the system and compute the condition number
621 * and error bounds using CGESVXX.
622 *
623 SRNAMT = 'CGESVXX'
624 N_ERR_BNDS = 3
625 CALL CGESVXX( FACT, TRANS, N, NRHS, A, LDA, AFAC,
626 $ LDA, IWORK, EQUED, S, S( N+1 ), B, LDA, X,
627 $ LDA, RCOND, RPVGRW_SVXX, BERR, N_ERR_BNDS,
628 $ ERRBNDS_N, ERRBNDS_C, 0, ZERO, WORK,
629 $ RWORK, INFO )
630 *
631 * Check the error code from CGESVXX.
632 *
633 IF( INFO.EQ.N+1 ) GOTO 50
634 IF( INFO.NE.IZERO ) THEN
635 CALL ALAERH( PATH, 'CGESVXX', INFO, IZERO,
636 $ FACT // TRANS, N, N, -1, -1, NRHS,
637 $ IMAT, NFAIL, NERRS, NOUT )
638 GOTO 50
639 END IF
640 *
641 * Compare rpvgrw_svxx from CGESVXX with the computed
642 * reciprocal pivot growth factor RPVGRW
643 *
644
645 IF ( INFO .GT. 0 .AND. INFO .LT. N+1 ) THEN
646 RPVGRW = CLA_RPVGRW(N, INFO, A, LDA, AFAC, LDA)
647 ELSE
648 RPVGRW = CLA_RPVGRW(N, N, A, LDA, AFAC, LDA)
649 ENDIF
650
651 RESULT( 7 ) = ABS( RPVGRW-rpvgrw_svxx ) /
652 $ MAX( rpvgrw_svxx, RPVGRW ) /
653 $ SLAMCH( 'E' )
654 *
655 IF( .NOT.PREFAC ) THEN
656 *
657 * Reconstruct matrix from factors and compute
658 * residual.
659 *
660 CALL CGET01( N, N, A, LDA, AFAC, LDA, IWORK,
661 $ RWORK( 2*NRHS+1 ), RESULT( 1 ) )
662 K1 = 1
663 ELSE
664 K1 = 2
665 END IF
666 *
667 IF( INFO.EQ.0 ) THEN
668 TRFCON = .FALSE.
669 *
670 * Compute residual of the computed solution.
671 *
672 CALL CLACPY( 'Full', N, NRHS, BSAV, LDA, WORK,
673 $ LDA )
674 CALL CGET02( TRANS, N, N, NRHS, ASAV, LDA, X,
675 $ LDA, WORK, LDA, RWORK( 2*NRHS+1 ),
676 $ RESULT( 2 ) )
677 *
678 * Check solution from generated exact solution.
679 *
680 IF( NOFACT .OR. ( PREFAC .AND. LSAME( EQUED,
681 $ 'N' ) ) ) THEN
682 CALL CGET04( N, NRHS, X, LDA, XACT, LDA,
683 $ RCONDC, RESULT( 3 ) )
684 ELSE
685 IF( ITRAN.EQ.1 ) THEN
686 ROLDC = ROLDO
687 ELSE
688 ROLDC = ROLDI
689 END IF
690 CALL CGET04( N, NRHS, X, LDA, XACT, LDA,
691 $ ROLDC, RESULT( 3 ) )
692 END IF
693 ELSE
694 TRFCON = .TRUE.
695 END IF
696 *
697 * Compare RCOND from CGESVXX with the computed value
698 * in RCONDC.
699 *
700 RESULT( 6 ) = SGET06( RCOND, RCONDC )
701 *
702 * Print information about the tests that did not pass
703 * the threshold.
704 *
705 IF( .NOT.TRFCON ) THEN
706 DO 45 K = K1, NTESTS
707 IF( RESULT( K ).GE.THRESH ) THEN
708 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
709 $ CALL ALADHD( NOUT, PATH )
710 IF( PREFAC ) THEN
711 WRITE( NOUT, FMT = 9997 )'CGESVXX',
712 $ FACT, TRANS, N, EQUED, IMAT, K,
713 $ RESULT( K )
714 ELSE
715 WRITE( NOUT, FMT = 9998 )'CGESVXX',
716 $ FACT, TRANS, N, IMAT, K, RESULT( K )
717 END IF
718 NFAIL = NFAIL + 1
719 END IF
720 45 CONTINUE
721 NRUN = NRUN + 7 - K1
722 ELSE
723 IF( RESULT( 1 ).GE.THRESH .AND. .NOT.PREFAC )
724 $ THEN
725 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
726 $ CALL ALADHD( NOUT, PATH )
727 IF( PREFAC ) THEN
728 WRITE( NOUT, FMT = 9997 )'CGESVXX', FACT,
729 $ TRANS, N, EQUED, IMAT, 1, RESULT( 1 )
730 ELSE
731 WRITE( NOUT, FMT = 9998 )'CGESVXX', FACT,
732 $ TRANS, N, IMAT, 1, RESULT( 1 )
733 END IF
734 NFAIL = NFAIL + 1
735 NRUN = NRUN + 1
736 END IF
737 IF( RESULT( 6 ).GE.THRESH ) THEN
738 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
739 $ CALL ALADHD( NOUT, PATH )
740 IF( PREFAC ) THEN
741 WRITE( NOUT, FMT = 9997 )'CGESVXX', FACT,
742 $ TRANS, N, EQUED, IMAT, 6, RESULT( 6 )
743 ELSE
744 WRITE( NOUT, FMT = 9998 )'CGESVXX', FACT,
745 $ TRANS, N, IMAT, 6, RESULT( 6 )
746 END IF
747 NFAIL = NFAIL + 1
748 NRUN = NRUN + 1
749 END IF
750 IF( RESULT( 7 ).GE.THRESH ) THEN
751 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
752 $ CALL ALADHD( NOUT, PATH )
753 IF( PREFAC ) THEN
754 WRITE( NOUT, FMT = 9997 )'CGESVXX', FACT,
755 $ TRANS, N, EQUED, IMAT, 7, RESULT( 7 )
756 ELSE
757 WRITE( NOUT, FMT = 9998 )'CGESVXX', FACT,
758 $ TRANS, N, IMAT, 7, RESULT( 7 )
759 END IF
760 NFAIL = NFAIL + 1
761 NRUN = NRUN + 1
762 END IF
763 *
764 END IF
765 *
766 50 CONTINUE
767 60 CONTINUE
768 70 CONTINUE
769 80 CONTINUE
770 90 CONTINUE
771 *
772 * Print a summary of the results.
773 *
774 CALL ALASVM( PATH, NOUT, NFAIL, NRUN, NERRS )
775 *
776
777 * Test Error Bounds for CGESVXX
778
779 CALL CEBCHVXX(THRESH, PATH)
780
781 9999 FORMAT( 1X, A, ', N =', I5, ', type ', I2, ', test(', I2, ') =',
782 $ G12.5 )
783 9998 FORMAT( 1X, A, ', FACT=''', A1, ''', TRANS=''', A1, ''', N=', I5,
784 $ ', type ', I2, ', test(', I1, ')=', G12.5 )
785 9997 FORMAT( 1X, A, ', FACT=''', A1, ''', TRANS=''', A1, ''', N=', I5,
786 $ ', EQUED=''', A1, ''', type ', I2, ', test(', I1, ')=',
787 $ G12.5 )
788 RETURN
789 *
790 * End of CDRVGE
791 *
792 END
2 $ A, AFAC, ASAV, B, BSAV, X, XACT, S, WORK,
3 $ RWORK, IWORK, NOUT )
4 *
5 * -- LAPACK test routine (version 3.2.1) --
6 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
7 * April 2009
8 *
9 * .. Scalar Arguments ..
10 LOGICAL TSTERR
11 INTEGER NMAX, NN, NOUT, NRHS
12 REAL THRESH
13 * ..
14 * .. Array Arguments ..
15 LOGICAL DOTYPE( * )
16 INTEGER IWORK( * ), NVAL( * )
17 REAL RWORK( * ), S( * )
18 COMPLEX A( * ), AFAC( * ), ASAV( * ), B( * ),
19 $ BSAV( * ), WORK( * ), X( * ), XACT( * )
20 * ..
21 *
22 * Purpose
23 * =======
24 *
25 * CDRVGE tests the driver routines CGESV, -SVX, and -SVXX.
26 *
27 * Note that this file is used only when the XBLAS are available,
28 * otherwise cdrvge.f defines this subroutine.
29 *
30 * Arguments
31 * =========
32 *
33 * DOTYPE (input) LOGICAL array, dimension (NTYPES)
34 * The matrix types to be used for testing. Matrices of type j
35 * (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) =
36 * .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.
37 *
38 * NN (input) INTEGER
39 * The number of values of N contained in the vector NVAL.
40 *
41 * NVAL (input) INTEGER array, dimension (NN)
42 * The values of the matrix column dimension N.
43 *
44 * NRHS (input) INTEGER
45 * The number of right hand side vectors to be generated for
46 * each linear system.
47 *
48 * THRESH (input) REAL
49 * The threshold value for the test ratios. A result is
50 * included in the output file if RESULT >= THRESH. To have
51 * every test ratio printed, use THRESH = 0.
52 *
53 * TSTERR (input) LOGICAL
54 * Flag that indicates whether error exits are to be tested.
55 *
56 * NMAX (input) INTEGER
57 * The maximum value permitted for N, used in dimensioning the
58 * work arrays.
59 *
60 * A (workspace) COMPLEX array, dimension (NMAX*NMAX)
61 *
62 * AFAC (workspace) COMPLEX array, dimension (NMAX*NMAX)
63 *
64 * ASAV (workspace) COMPLEX array, dimension (NMAX*NMAX)
65 *
66 * B (workspace) COMPLEX array, dimension (NMAX*NRHS)
67 *
68 * BSAV (workspace) COMPLEX array, dimension (NMAX*NRHS)
69 *
70 * X (workspace) COMPLEX array, dimension (NMAX*NRHS)
71 *
72 * XACT (workspace) COMPLEX array, dimension (NMAX*NRHS)
73 *
74 * S (workspace) REAL array, dimension (2*NMAX)
75 *
76 * WORK (workspace) COMPLEX array, dimension
77 * (NMAX*max(3,NRHS))
78 *
79 * RWORK (workspace) REAL array, dimension (2*NRHS+NMAX)
80 *
81 * IWORK (workspace) INTEGER array, dimension (NMAX)
82 *
83 * NOUT (input) INTEGER
84 * The unit number for output.
85 *
86 * =====================================================================
87 *
88 * .. Parameters ..
89 REAL ONE, ZERO
90 PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
91 INTEGER NTYPES
92 PARAMETER ( NTYPES = 11 )
93 INTEGER NTESTS
94 PARAMETER ( NTESTS = 7 )
95 INTEGER NTRAN
96 PARAMETER ( NTRAN = 3 )
97 * ..
98 * .. Local Scalars ..
99 LOGICAL EQUIL, NOFACT, PREFAC, TRFCON, ZEROT
100 CHARACTER DIST, EQUED, FACT, TRANS, TYPE, XTYPE
101 CHARACTER*3 PATH
102 INTEGER I, IEQUED, IFACT, IMAT, IN, INFO, IOFF, ITRAN,
103 $ IZERO, K, K1, KL, KU, LDA, LWORK, MODE, N, NB,
104 $ NBMIN, NERRS, NFACT, NFAIL, NIMAT, NRUN, NT,
105 $ N_ERR_BNDS
106 REAL AINVNM, AMAX, ANORM, ANORMI, ANORMO, CNDNUM,
107 $ COLCND, RCOND, RCONDC, RCONDI, RCONDO, ROLDC,
108 $ ROLDI, ROLDO, ROWCND, RPVGRW, RPVGRW_SVXX
109 * ..
110 * .. Local Arrays ..
111 CHARACTER EQUEDS( 4 ), FACTS( 3 ), TRANSS( NTRAN )
112 INTEGER ISEED( 4 ), ISEEDY( 4 )
113 REAL RDUM( 1 ), RESULT( NTESTS ), BERR( NRHS ),
114 $ ERRBNDS_N( NRHS, 3 ), ERRBNDS_C( NRHS, 3 )
115 * ..
116 * .. External Functions ..
117 LOGICAL LSAME
118 REAL CLANGE, CLANTR, SGET06, SLAMCH, CLA_RPVGRW
119 EXTERNAL LSAME, CLANGE, CLANTR, SGET06, SLAMCH,
120 $ CLA_RPVGRW
121 * ..
122 * .. External Subroutines ..
123 EXTERNAL ALADHD, ALAERH, ALASVM, CERRVX, CGEEQU, CGESV,
124 $ CGESVX, CGET01, CGET02, CGET04, CGET07, CGETRF,
125 $ CGETRI, CLACPY, CLAQGE, CLARHS, CLASET, CLATB4,
126 $ CLATMS, XLAENV, CGESVXX
127 * ..
128 * .. Intrinsic Functions ..
129 INTRINSIC ABS, CMPLX, MAX
130 * ..
131 * .. Scalars in Common ..
132 LOGICAL LERR, OK
133 CHARACTER*32 SRNAMT
134 INTEGER INFOT, NUNIT
135 * ..
136 * .. Common blocks ..
137 COMMON / INFOC / INFOT, NUNIT, OK, LERR
138 COMMON / SRNAMC / SRNAMT
139 * ..
140 * .. Data statements ..
141 DATA ISEEDY / 1988, 1989, 1990, 1991 /
142 DATA TRANSS / 'N', 'T', 'C' /
143 DATA FACTS / 'F', 'N', 'E' /
144 DATA EQUEDS / 'N', 'R', 'C', 'B' /
145 * ..
146 * .. Executable Statements ..
147 *
148 * Initialize constants and the random number seed.
149 *
150 PATH( 1: 1 ) = 'Complex precision'
151 PATH( 2: 3 ) = 'GE'
152 NRUN = 0
153 NFAIL = 0
154 NERRS = 0
155 DO 10 I = 1, 4
156 ISEED( I ) = ISEEDY( I )
157 10 CONTINUE
158 *
159 * Test the error exits
160 *
161 IF( TSTERR )
162 $ CALL CERRVX( PATH, NOUT )
163 INFOT = 0
164 *
165 * Set the block size and minimum block size for testing.
166 *
167 NB = 1
168 NBMIN = 2
169 CALL XLAENV( 1, NB )
170 CALL XLAENV( 2, NBMIN )
171 *
172 * Do for each value of N in NVAL
173 *
174 DO 90 IN = 1, NN
175 N = NVAL( IN )
176 LDA = MAX( N, 1 )
177 XTYPE = 'N'
178 NIMAT = NTYPES
179 IF( N.LE.0 )
180 $ NIMAT = 1
181 *
182 DO 80 IMAT = 1, NIMAT
183 *
184 * Do the tests only if DOTYPE( IMAT ) is true.
185 *
186 IF( .NOT.DOTYPE( IMAT ) )
187 $ GO TO 80
188 *
189 * Skip types 5, 6, or 7 if the matrix size is too small.
190 *
191 ZEROT = IMAT.GE.5 .AND. IMAT.LE.7
192 IF( ZEROT .AND. N.LT.IMAT-4 )
193 $ GO TO 80
194 *
195 * Set up parameters with CLATB4 and generate a test matrix
196 * with CLATMS.
197 *
198 CALL CLATB4( PATH, IMAT, N, N, TYPE, KL, KU, ANORM, MODE,
199 $ CNDNUM, DIST )
200 RCONDC = ONE / CNDNUM
201 *
202 SRNAMT = 'CLATMS'
203 CALL CLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE, CNDNUM,
204 $ ANORM, KL, KU, 'No packing', A, LDA, WORK,
205 $ INFO )
206 *
207 * Check error code from CLATMS.
208 *
209 IF( INFO.NE.0 ) THEN
210 CALL ALAERH( PATH, 'CLATMS', INFO, 0, ' ', N, N, -1, -1,
211 $ -1, IMAT, NFAIL, NERRS, NOUT )
212 GO TO 80
213 END IF
214 *
215 * For types 5-7, zero one or more columns of the matrix to
216 * test that INFO is returned correctly.
217 *
218 IF( ZEROT ) THEN
219 IF( IMAT.EQ.5 ) THEN
220 IZERO = 1
221 ELSE IF( IMAT.EQ.6 ) THEN
222 IZERO = N
223 ELSE
224 IZERO = N / 2 + 1
225 END IF
226 IOFF = ( IZERO-1 )*LDA
227 IF( IMAT.LT.7 ) THEN
228 DO 20 I = 1, N
229 A( IOFF+I ) = ZERO
230 20 CONTINUE
231 ELSE
232 CALL CLASET( 'Full', N, N-IZERO+1, CMPLX( ZERO ),
233 $ CMPLX( ZERO ), A( IOFF+1 ), LDA )
234 END IF
235 ELSE
236 IZERO = 0
237 END IF
238 *
239 * Save a copy of the matrix A in ASAV.
240 *
241 CALL CLACPY( 'Full', N, N, A, LDA, ASAV, LDA )
242 *
243 DO 70 IEQUED = 1, 4
244 EQUED = EQUEDS( IEQUED )
245 IF( IEQUED.EQ.1 ) THEN
246 NFACT = 3
247 ELSE
248 NFACT = 1
249 END IF
250 *
251 DO 60 IFACT = 1, NFACT
252 FACT = FACTS( IFACT )
253 PREFAC = LSAME( FACT, 'F' )
254 NOFACT = LSAME( FACT, 'N' )
255 EQUIL = LSAME( FACT, 'E' )
256 *
257 IF( ZEROT ) THEN
258 IF( PREFAC )
259 $ GO TO 60
260 RCONDO = ZERO
261 RCONDI = ZERO
262 *
263 ELSE IF( .NOT.NOFACT ) THEN
264 *
265 * Compute the condition number for comparison with
266 * the value returned by CGESVX (FACT = 'N' reuses
267 * the condition number from the previous iteration
268 * with FACT = 'F').
269 *
270 CALL CLACPY( 'Full', N, N, ASAV, LDA, AFAC, LDA )
271 IF( EQUIL .OR. IEQUED.GT.1 ) THEN
272 *
273 * Compute row and column scale factors to
274 * equilibrate the matrix A.
275 *
276 CALL CGEEQU( N, N, AFAC, LDA, S, S( N+1 ),
277 $ ROWCND, COLCND, AMAX, INFO )
278 IF( INFO.EQ.0 .AND. N.GT.0 ) THEN
279 IF( LSAME( EQUED, 'R' ) ) THEN
280 ROWCND = ZERO
281 COLCND = ONE
282 ELSE IF( LSAME( EQUED, 'C' ) ) THEN
283 ROWCND = ONE
284 COLCND = ZERO
285 ELSE IF( LSAME( EQUED, 'B' ) ) THEN
286 ROWCND = ZERO
287 COLCND = ZERO
288 END IF
289 *
290 * Equilibrate the matrix.
291 *
292 CALL CLAQGE( N, N, AFAC, LDA, S, S( N+1 ),
293 $ ROWCND, COLCND, AMAX, EQUED )
294 END IF
295 END IF
296 *
297 * Save the condition number of the non-equilibrated
298 * system for use in CGET04.
299 *
300 IF( EQUIL ) THEN
301 ROLDO = RCONDO
302 ROLDI = RCONDI
303 END IF
304 *
305 * Compute the 1-norm and infinity-norm of A.
306 *
307 ANORMO = CLANGE( '1', N, N, AFAC, LDA, RWORK )
308 ANORMI = CLANGE( 'I', N, N, AFAC, LDA, RWORK )
309 *
310 * Factor the matrix A.
311 *
312 CALL CGETRF( N, N, AFAC, LDA, IWORK, INFO )
313 *
314 * Form the inverse of A.
315 *
316 CALL CLACPY( 'Full', N, N, AFAC, LDA, A, LDA )
317 LWORK = NMAX*MAX( 3, NRHS )
318 CALL CGETRI( N, A, LDA, IWORK, WORK, LWORK, INFO )
319 *
320 * Compute the 1-norm condition number of A.
321 *
322 AINVNM = CLANGE( '1', N, N, A, LDA, RWORK )
323 IF( ANORMO.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN
324 RCONDO = ONE
325 ELSE
326 RCONDO = ( ONE / ANORMO ) / AINVNM
327 END IF
328 *
329 * Compute the infinity-norm condition number of A.
330 *
331 AINVNM = CLANGE( 'I', N, N, A, LDA, RWORK )
332 IF( ANORMI.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN
333 RCONDI = ONE
334 ELSE
335 RCONDI = ( ONE / ANORMI ) / AINVNM
336 END IF
337 END IF
338 *
339 DO 50 ITRAN = 1, NTRAN
340 *
341 * Do for each value of TRANS.
342 *
343 TRANS = TRANSS( ITRAN )
344 IF( ITRAN.EQ.1 ) THEN
345 RCONDC = RCONDO
346 ELSE
347 RCONDC = RCONDI
348 END IF
349 *
350 * Restore the matrix A.
351 *
352 CALL CLACPY( 'Full', N, N, ASAV, LDA, A, LDA )
353 *
354 * Form an exact solution and set the right hand side.
355 *
356 SRNAMT = 'CLARHS'
357 CALL CLARHS( PATH, XTYPE, 'Full', TRANS, N, N, KL,
358 $ KU, NRHS, A, LDA, XACT, LDA, B, LDA,
359 $ ISEED, INFO )
360 XTYPE = 'C'
361 CALL CLACPY( 'Full', N, NRHS, B, LDA, BSAV, LDA )
362 *
363 IF( NOFACT .AND. ITRAN.EQ.1 ) THEN
364 *
365 * --- Test CGESV ---
366 *
367 * Compute the LU factorization of the matrix and
368 * solve the system.
369 *
370 CALL CLACPY( 'Full', N, N, A, LDA, AFAC, LDA )
371 CALL CLACPY( 'Full', N, NRHS, B, LDA, X, LDA )
372 *
373 SRNAMT = 'CGESV '
374 CALL CGESV( N, NRHS, AFAC, LDA, IWORK, X, LDA,
375 $ INFO )
376 *
377 * Check error code from CGESV .
378 *
379 IF( INFO.NE.IZERO )
380 $ CALL ALAERH( PATH, 'CGESV ', INFO, IZERO,
381 $ ' ', N, N, -1, -1, NRHS, IMAT,
382 $ NFAIL, NERRS, NOUT )
383 *
384 * Reconstruct matrix from factors and compute
385 * residual.
386 *
387 CALL CGET01( N, N, A, LDA, AFAC, LDA, IWORK,
388 $ RWORK, RESULT( 1 ) )
389 NT = 1
390 IF( IZERO.EQ.0 ) THEN
391 *
392 * Compute residual of the computed solution.
393 *
394 CALL CLACPY( 'Full', N, NRHS, B, LDA, WORK,
395 $ LDA )
396 CALL CGET02( 'No transpose', N, N, NRHS, A,
397 $ LDA, X, LDA, WORK, LDA, RWORK,
398 $ RESULT( 2 ) )
399 *
400 * Check solution from generated exact solution.
401 *
402 CALL CGET04( N, NRHS, X, LDA, XACT, LDA,
403 $ RCONDC, RESULT( 3 ) )
404 NT = 3
405 END IF
406 *
407 * Print information about the tests that did not
408 * pass the threshold.
409 *
410 DO 30 K = 1, NT
411 IF( RESULT( K ).GE.THRESH ) THEN
412 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
413 $ CALL ALADHD( NOUT, PATH )
414 WRITE( NOUT, FMT = 9999 )'CGESV ', N,
415 $ IMAT, K, RESULT( K )
416 NFAIL = NFAIL + 1
417 END IF
418 30 CONTINUE
419 NRUN = NRUN + NT
420 END IF
421 *
422 * --- Test CGESVX ---
423 *
424 IF( .NOT.PREFAC )
425 $ CALL CLASET( 'Full', N, N, CMPLX( ZERO ),
426 $ CMPLX( ZERO ), AFAC, LDA )
427 CALL CLASET( 'Full', N, NRHS, CMPLX( ZERO ),
428 $ CMPLX( ZERO ), X, LDA )
429 IF( IEQUED.GT.1 .AND. N.GT.0 ) THEN
430 *
431 * Equilibrate the matrix if FACT = 'F' and
432 * EQUED = 'R', 'C', or 'B'.
433 *
434 CALL CLAQGE( N, N, A, LDA, S, S( N+1 ), ROWCND,
435 $ COLCND, AMAX, EQUED )
436 END IF
437 *
438 * Solve the system and compute the condition number
439 * and error bounds using CGESVX.
440 *
441 SRNAMT = 'CGESVX'
442 CALL CGESVX( FACT, TRANS, N, NRHS, A, LDA, AFAC,
443 $ LDA, IWORK, EQUED, S, S( N+1 ), B,
444 $ LDA, X, LDA, RCOND, RWORK,
445 $ RWORK( NRHS+1 ), WORK,
446 $ RWORK( 2*NRHS+1 ), INFO )
447 *
448 * Check the error code from CGESVX.
449 *
450 IF( INFO.NE.IZERO )
451 $ CALL ALAERH( PATH, 'CGESVX', INFO, IZERO,
452 $ FACT // TRANS, N, N, -1, -1, NRHS,
453 $ IMAT, NFAIL, NERRS, NOUT )
454 *
455 * Compare RWORK(2*NRHS+1) from CGESVX with the
456 * computed reciprocal pivot growth factor RPVGRW
457 *
458 IF( INFO.NE.0 ) THEN
459 RPVGRW = CLANTR( 'M', 'U', 'N', INFO, INFO,
460 $ AFAC, LDA, RDUM )
461 IF( RPVGRW.EQ.ZERO ) THEN
462 RPVGRW = ONE
463 ELSE
464 RPVGRW = CLANGE( 'M', N, INFO, A, LDA,
465 $ RDUM ) / RPVGRW
466 END IF
467 ELSE
468 RPVGRW = CLANTR( 'M', 'U', 'N', N, N, AFAC, LDA,
469 $ RDUM )
470 IF( RPVGRW.EQ.ZERO ) THEN
471 RPVGRW = ONE
472 ELSE
473 RPVGRW = CLANGE( 'M', N, N, A, LDA, RDUM ) /
474 $ RPVGRW
475 END IF
476 END IF
477 RESULT( 7 ) = ABS( RPVGRW-RWORK( 2*NRHS+1 ) ) /
478 $ MAX( RWORK( 2*NRHS+1 ), RPVGRW ) /
479 $ SLAMCH( 'E' )
480 *
481 IF( .NOT.PREFAC ) THEN
482 *
483 * Reconstruct matrix from factors and compute
484 * residual.
485 *
486 CALL CGET01( N, N, A, LDA, AFAC, LDA, IWORK,
487 $ RWORK( 2*NRHS+1 ), RESULT( 1 ) )
488 K1 = 1
489 ELSE
490 K1 = 2
491 END IF
492 *
493 IF( INFO.EQ.0 ) THEN
494 TRFCON = .FALSE.
495 *
496 * Compute residual of the computed solution.
497 *
498 CALL CLACPY( 'Full', N, NRHS, BSAV, LDA, WORK,
499 $ LDA )
500 CALL CGET02( TRANS, N, N, NRHS, ASAV, LDA, X,
501 $ LDA, WORK, LDA, RWORK( 2*NRHS+1 ),
502 $ RESULT( 2 ) )
503 *
504 * Check solution from generated exact solution.
505 *
506 IF( NOFACT .OR. ( PREFAC .AND. LSAME( EQUED,
507 $ 'N' ) ) ) THEN
508 CALL CGET04( N, NRHS, X, LDA, XACT, LDA,
509 $ RCONDC, RESULT( 3 ) )
510 ELSE
511 IF( ITRAN.EQ.1 ) THEN
512 ROLDC = ROLDO
513 ELSE
514 ROLDC = ROLDI
515 END IF
516 CALL CGET04( N, NRHS, X, LDA, XACT, LDA,
517 $ ROLDC, RESULT( 3 ) )
518 END IF
519 *
520 * Check the error bounds from iterative
521 * refinement.
522 *
523 CALL CGET07( TRANS, N, NRHS, ASAV, LDA, B, LDA,
524 $ X, LDA, XACT, LDA, RWORK, .TRUE.,
525 $ RWORK( NRHS+1 ), RESULT( 4 ) )
526 ELSE
527 TRFCON = .TRUE.
528 END IF
529 *
530 * Compare RCOND from CGESVX with the computed value
531 * in RCONDC.
532 *
533 RESULT( 6 ) = SGET06( RCOND, RCONDC )
534 *
535 * Print information about the tests that did not pass
536 * the threshold.
537 *
538 IF( .NOT.TRFCON ) THEN
539 DO 40 K = K1, NTESTS
540 IF( RESULT( K ).GE.THRESH ) THEN
541 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
542 $ CALL ALADHD( NOUT, PATH )
543 IF( PREFAC ) THEN
544 WRITE( NOUT, FMT = 9997 )'CGESVX',
545 $ FACT, TRANS, N, EQUED, IMAT, K,
546 $ RESULT( K )
547 ELSE
548 WRITE( NOUT, FMT = 9998 )'CGESVX',
549 $ FACT, TRANS, N, IMAT, K, RESULT( K )
550 END IF
551 NFAIL = NFAIL + 1
552 END IF
553 40 CONTINUE
554 NRUN = NRUN + 7 - K1
555 ELSE
556 IF( RESULT( 1 ).GE.THRESH .AND. .NOT.PREFAC )
557 $ THEN
558 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
559 $ CALL ALADHD( NOUT, PATH )
560 IF( PREFAC ) THEN
561 WRITE( NOUT, FMT = 9997 )'CGESVX', FACT,
562 $ TRANS, N, EQUED, IMAT, 1, RESULT( 1 )
563 ELSE
564 WRITE( NOUT, FMT = 9998 )'CGESVX', FACT,
565 $ TRANS, N, IMAT, 1, RESULT( 1 )
566 END IF
567 NFAIL = NFAIL + 1
568 NRUN = NRUN + 1
569 END IF
570 IF( RESULT( 6 ).GE.THRESH ) THEN
571 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
572 $ CALL ALADHD( NOUT, PATH )
573 IF( PREFAC ) THEN
574 WRITE( NOUT, FMT = 9997 )'CGESVX', FACT,
575 $ TRANS, N, EQUED, IMAT, 6, RESULT( 6 )
576 ELSE
577 WRITE( NOUT, FMT = 9998 )'CGESVX', FACT,
578 $ TRANS, N, IMAT, 6, RESULT( 6 )
579 END IF
580 NFAIL = NFAIL + 1
581 NRUN = NRUN + 1
582 END IF
583 IF( RESULT( 7 ).GE.THRESH ) THEN
584 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
585 $ CALL ALADHD( NOUT, PATH )
586 IF( PREFAC ) THEN
587 WRITE( NOUT, FMT = 9997 )'CGESVX', FACT,
588 $ TRANS, N, EQUED, IMAT, 7, RESULT( 7 )
589 ELSE
590 WRITE( NOUT, FMT = 9998 )'CGESVX', FACT,
591 $ TRANS, N, IMAT, 7, RESULT( 7 )
592 END IF
593 NFAIL = NFAIL + 1
594 NRUN = NRUN + 1
595 END IF
596 *
597 END IF
598 *
599 * --- Test CGESVXX ---
600 *
601 * Restore the matrices A and B.
602 *
603
604 CALL CLACPY( 'Full', N, N, ASAV, LDA, A, LDA )
605 CALL CLACPY( 'Full', N, NRHS, BSAV, LDA, B, LDA )
606
607 IF( .NOT.PREFAC )
608 $ CALL CLASET( 'Full', N, N, ZERO, ZERO, AFAC,
609 $ LDA )
610 CALL CLASET( 'Full', N, NRHS, ZERO, ZERO, X, LDA )
611 IF( IEQUED.GT.1 .AND. N.GT.0 ) THEN
612 *
613 * Equilibrate the matrix if FACT = 'F' and
614 * EQUED = 'R', 'C', or 'B'.
615 *
616 CALL CLAQGE( N, N, A, LDA, S, S( N+1 ), ROWCND,
617 $ COLCND, AMAX, EQUED )
618 END IF
619 *
620 * Solve the system and compute the condition number
621 * and error bounds using CGESVXX.
622 *
623 SRNAMT = 'CGESVXX'
624 N_ERR_BNDS = 3
625 CALL CGESVXX( FACT, TRANS, N, NRHS, A, LDA, AFAC,
626 $ LDA, IWORK, EQUED, S, S( N+1 ), B, LDA, X,
627 $ LDA, RCOND, RPVGRW_SVXX, BERR, N_ERR_BNDS,
628 $ ERRBNDS_N, ERRBNDS_C, 0, ZERO, WORK,
629 $ RWORK, INFO )
630 *
631 * Check the error code from CGESVXX.
632 *
633 IF( INFO.EQ.N+1 ) GOTO 50
634 IF( INFO.NE.IZERO ) THEN
635 CALL ALAERH( PATH, 'CGESVXX', INFO, IZERO,
636 $ FACT // TRANS, N, N, -1, -1, NRHS,
637 $ IMAT, NFAIL, NERRS, NOUT )
638 GOTO 50
639 END IF
640 *
641 * Compare rpvgrw_svxx from CGESVXX with the computed
642 * reciprocal pivot growth factor RPVGRW
643 *
644
645 IF ( INFO .GT. 0 .AND. INFO .LT. N+1 ) THEN
646 RPVGRW = CLA_RPVGRW(N, INFO, A, LDA, AFAC, LDA)
647 ELSE
648 RPVGRW = CLA_RPVGRW(N, N, A, LDA, AFAC, LDA)
649 ENDIF
650
651 RESULT( 7 ) = ABS( RPVGRW-rpvgrw_svxx ) /
652 $ MAX( rpvgrw_svxx, RPVGRW ) /
653 $ SLAMCH( 'E' )
654 *
655 IF( .NOT.PREFAC ) THEN
656 *
657 * Reconstruct matrix from factors and compute
658 * residual.
659 *
660 CALL CGET01( N, N, A, LDA, AFAC, LDA, IWORK,
661 $ RWORK( 2*NRHS+1 ), RESULT( 1 ) )
662 K1 = 1
663 ELSE
664 K1 = 2
665 END IF
666 *
667 IF( INFO.EQ.0 ) THEN
668 TRFCON = .FALSE.
669 *
670 * Compute residual of the computed solution.
671 *
672 CALL CLACPY( 'Full', N, NRHS, BSAV, LDA, WORK,
673 $ LDA )
674 CALL CGET02( TRANS, N, N, NRHS, ASAV, LDA, X,
675 $ LDA, WORK, LDA, RWORK( 2*NRHS+1 ),
676 $ RESULT( 2 ) )
677 *
678 * Check solution from generated exact solution.
679 *
680 IF( NOFACT .OR. ( PREFAC .AND. LSAME( EQUED,
681 $ 'N' ) ) ) THEN
682 CALL CGET04( N, NRHS, X, LDA, XACT, LDA,
683 $ RCONDC, RESULT( 3 ) )
684 ELSE
685 IF( ITRAN.EQ.1 ) THEN
686 ROLDC = ROLDO
687 ELSE
688 ROLDC = ROLDI
689 END IF
690 CALL CGET04( N, NRHS, X, LDA, XACT, LDA,
691 $ ROLDC, RESULT( 3 ) )
692 END IF
693 ELSE
694 TRFCON = .TRUE.
695 END IF
696 *
697 * Compare RCOND from CGESVXX with the computed value
698 * in RCONDC.
699 *
700 RESULT( 6 ) = SGET06( RCOND, RCONDC )
701 *
702 * Print information about the tests that did not pass
703 * the threshold.
704 *
705 IF( .NOT.TRFCON ) THEN
706 DO 45 K = K1, NTESTS
707 IF( RESULT( K ).GE.THRESH ) THEN
708 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
709 $ CALL ALADHD( NOUT, PATH )
710 IF( PREFAC ) THEN
711 WRITE( NOUT, FMT = 9997 )'CGESVXX',
712 $ FACT, TRANS, N, EQUED, IMAT, K,
713 $ RESULT( K )
714 ELSE
715 WRITE( NOUT, FMT = 9998 )'CGESVXX',
716 $ FACT, TRANS, N, IMAT, K, RESULT( K )
717 END IF
718 NFAIL = NFAIL + 1
719 END IF
720 45 CONTINUE
721 NRUN = NRUN + 7 - K1
722 ELSE
723 IF( RESULT( 1 ).GE.THRESH .AND. .NOT.PREFAC )
724 $ THEN
725 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
726 $ CALL ALADHD( NOUT, PATH )
727 IF( PREFAC ) THEN
728 WRITE( NOUT, FMT = 9997 )'CGESVXX', FACT,
729 $ TRANS, N, EQUED, IMAT, 1, RESULT( 1 )
730 ELSE
731 WRITE( NOUT, FMT = 9998 )'CGESVXX', FACT,
732 $ TRANS, N, IMAT, 1, RESULT( 1 )
733 END IF
734 NFAIL = NFAIL + 1
735 NRUN = NRUN + 1
736 END IF
737 IF( RESULT( 6 ).GE.THRESH ) THEN
738 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
739 $ CALL ALADHD( NOUT, PATH )
740 IF( PREFAC ) THEN
741 WRITE( NOUT, FMT = 9997 )'CGESVXX', FACT,
742 $ TRANS, N, EQUED, IMAT, 6, RESULT( 6 )
743 ELSE
744 WRITE( NOUT, FMT = 9998 )'CGESVXX', FACT,
745 $ TRANS, N, IMAT, 6, RESULT( 6 )
746 END IF
747 NFAIL = NFAIL + 1
748 NRUN = NRUN + 1
749 END IF
750 IF( RESULT( 7 ).GE.THRESH ) THEN
751 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
752 $ CALL ALADHD( NOUT, PATH )
753 IF( PREFAC ) THEN
754 WRITE( NOUT, FMT = 9997 )'CGESVXX', FACT,
755 $ TRANS, N, EQUED, IMAT, 7, RESULT( 7 )
756 ELSE
757 WRITE( NOUT, FMT = 9998 )'CGESVXX', FACT,
758 $ TRANS, N, IMAT, 7, RESULT( 7 )
759 END IF
760 NFAIL = NFAIL + 1
761 NRUN = NRUN + 1
762 END IF
763 *
764 END IF
765 *
766 50 CONTINUE
767 60 CONTINUE
768 70 CONTINUE
769 80 CONTINUE
770 90 CONTINUE
771 *
772 * Print a summary of the results.
773 *
774 CALL ALASVM( PATH, NOUT, NFAIL, NRUN, NERRS )
775 *
776
777 * Test Error Bounds for CGESVXX
778
779 CALL CEBCHVXX(THRESH, PATH)
780
781 9999 FORMAT( 1X, A, ', N =', I5, ', type ', I2, ', test(', I2, ') =',
782 $ G12.5 )
783 9998 FORMAT( 1X, A, ', FACT=''', A1, ''', TRANS=''', A1, ''', N=', I5,
784 $ ', type ', I2, ', test(', I1, ')=', G12.5 )
785 9997 FORMAT( 1X, A, ', FACT=''', A1, ''', TRANS=''', A1, ''', N=', I5,
786 $ ', EQUED=''', A1, ''', type ', I2, ', test(', I1, ')=',
787 $ G12.5 )
788 RETURN
789 *
790 * End of CDRVGE
791 *
792 END