1 SUBROUTINE SDRVGE( 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.1) --
6 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
7 * November 2006
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 A( * ), AFAC( * ), ASAV( * ), B( * ),
18 $ BSAV( * ), RWORK( * ), S( * ), WORK( * ),
19 $ X( * ), XACT( * )
20 * ..
21 *
22 * Purpose
23 * =======
24 *
25 * SDRVGE tests the driver routines SGESV and -SVX.
26 *
27 * Arguments
28 * =========
29 *
30 * DOTYPE (input) LOGICAL array, dimension (NTYPES)
31 * The matrix types to be used for testing. Matrices of type j
32 * (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) =
33 * .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.
34 *
35 * NN (input) INTEGER
36 * The number of values of N contained in the vector NVAL.
37 *
38 * NVAL (input) INTEGER array, dimension (NN)
39 * The values of the matrix column dimension N.
40 *
41 * NRHS (input) INTEGER
42 * The number of right hand side vectors to be generated for
43 * each linear system.
44 *
45 * THRESH (input) REAL
46 * The threshold value for the test ratios. A result is
47 * included in the output file if RESULT >= THRESH. To have
48 * every test ratio printed, use THRESH = 0.
49 *
50 * TSTERR (input) LOGICAL
51 * Flag that indicates whether error exits are to be tested.
52 *
53 * NMAX (input) INTEGER
54 * The maximum value permitted for N, used in dimensioning the
55 * work arrays.
56 *
57 * A (workspace) REAL array, dimension (NMAX*NMAX)
58 *
59 * AFAC (workspace) REAL array, dimension (NMAX*NMAX)
60 *
61 * ASAV (workspace) REAL array, dimension (NMAX*NMAX)
62 *
63 * B (workspace) REAL array, dimension (NMAX*NRHS)
64 *
65 * BSAV (workspace) REAL array, dimension (NMAX*NRHS)
66 *
67 * X (workspace) REAL array, dimension (NMAX*NRHS)
68 *
69 * XACT (workspace) REAL array, dimension (NMAX*NRHS)
70 *
71 * S (workspace) REAL array, dimension (2*NMAX)
72 *
73 * WORK (workspace) REAL array, dimension
74 * (NMAX*max(3,NRHS))
75 *
76 * RWORK (workspace) REAL array, dimension (2*NRHS+NMAX)
77 *
78 * IWORK (workspace) INTEGER array, dimension (2*NMAX)
79 *
80 * NOUT (input) INTEGER
81 * The unit number for output.
82 *
83 * =====================================================================
84 *
85 * .. Parameters ..
86 REAL ONE, ZERO
87 PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
88 INTEGER NTYPES
89 PARAMETER ( NTYPES = 11 )
90 INTEGER NTESTS
91 PARAMETER ( NTESTS = 7 )
92 INTEGER NTRAN
93 PARAMETER ( NTRAN = 3 )
94 * ..
95 * .. Local Scalars ..
96 LOGICAL EQUIL, NOFACT, PREFAC, TRFCON, ZEROT
97 CHARACTER DIST, EQUED, FACT, TRANS, TYPE, XTYPE
98 CHARACTER*3 PATH
99 INTEGER I, IEQUED, IFACT, IMAT, IN, INFO, IOFF, ITRAN,
100 $ IZERO, K, K1, KL, KU, LDA, LWORK, MODE, N, NB,
101 $ NBMIN, NERRS, NFACT, NFAIL, NIMAT, NRUN, NT
102 REAL AINVNM, AMAX, ANORM, ANORMI, ANORMO, CNDNUM,
103 $ COLCND, RCOND, RCONDC, RCONDI, RCONDO, ROLDC,
104 $ ROLDI, ROLDO, ROWCND, RPVGRW
105 * ..
106 * .. Local Arrays ..
107 CHARACTER EQUEDS( 4 ), FACTS( 3 ), TRANSS( NTRAN )
108 INTEGER ISEED( 4 ), ISEEDY( 4 )
109 REAL RESULT( NTESTS )
110 * ..
111 * .. External Functions ..
112 LOGICAL LSAME
113 REAL SGET06, SLAMCH, SLANGE, SLANTR
114 EXTERNAL LSAME, SGET06, SLAMCH, SLANGE, SLANTR
115 * ..
116 * .. External Subroutines ..
117 EXTERNAL ALADHD, ALAERH, ALASVM, SERRVX, SGEEQU, SGESV,
118 $ SGESVX, SGET01, SGET02, SGET04, SGET07, SGETRF,
119 $ SGETRI, SLACPY, SLAQGE, SLARHS, SLASET, SLATB4,
120 $ SLATMS, XLAENV
121 * ..
122 * .. Intrinsic Functions ..
123 INTRINSIC ABS, MAX
124 * ..
125 * .. Scalars in Common ..
126 LOGICAL LERR, OK
127 CHARACTER*32 SRNAMT
128 INTEGER INFOT, NUNIT
129 * ..
130 * .. Common blocks ..
131 COMMON / INFOC / INFOT, NUNIT, OK, LERR
132 COMMON / SRNAMC / SRNAMT
133 * ..
134 * .. Data statements ..
135 DATA ISEEDY / 1988, 1989, 1990, 1991 /
136 DATA TRANSS / 'N', 'T', 'C' /
137 DATA FACTS / 'F', 'N', 'E' /
138 DATA EQUEDS / 'N', 'R', 'C', 'B' /
139 * ..
140 * .. Executable Statements ..
141 *
142 * Initialize constants and the random number seed.
143 *
144 PATH( 1: 1 ) = 'Single precision'
145 PATH( 2: 3 ) = 'GE'
146 NRUN = 0
147 NFAIL = 0
148 NERRS = 0
149 DO 10 I = 1, 4
150 ISEED( I ) = ISEEDY( I )
151 10 CONTINUE
152 *
153 * Test the error exits
154 *
155 IF( TSTERR )
156 $ CALL SERRVX( PATH, NOUT )
157 INFOT = 0
158 *
159 * Set the block size and minimum block size for testing.
160 *
161 NB = 1
162 NBMIN = 2
163 CALL XLAENV( 1, NB )
164 CALL XLAENV( 2, NBMIN )
165 *
166 * Do for each value of N in NVAL
167 *
168 DO 90 IN = 1, NN
169 N = NVAL( IN )
170 LDA = MAX( N, 1 )
171 XTYPE = 'N'
172 NIMAT = NTYPES
173 IF( N.LE.0 )
174 $ NIMAT = 1
175 *
176 DO 80 IMAT = 1, NIMAT
177 *
178 * Do the tests only if DOTYPE( IMAT ) is true.
179 *
180 IF( .NOT.DOTYPE( IMAT ) )
181 $ GO TO 80
182 *
183 * Skip types 5, 6, or 7 if the matrix size is too small.
184 *
185 ZEROT = IMAT.GE.5 .AND. IMAT.LE.7
186 IF( ZEROT .AND. N.LT.IMAT-4 )
187 $ GO TO 80
188 *
189 * Set up parameters with SLATB4 and generate a test matrix
190 * with SLATMS.
191 *
192 CALL SLATB4( PATH, IMAT, N, N, TYPE, KL, KU, ANORM, MODE,
193 $ CNDNUM, DIST )
194 RCONDC = ONE / CNDNUM
195 *
196 SRNAMT = 'SLATMS'
197 CALL SLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE, CNDNUM,
198 $ ANORM, KL, KU, 'No packing', A, LDA, WORK,
199 $ INFO )
200 *
201 * Check error code from SLATMS.
202 *
203 IF( INFO.NE.0 ) THEN
204 CALL ALAERH( PATH, 'SLATMS', INFO, 0, ' ', N, N, -1, -1,
205 $ -1, IMAT, NFAIL, NERRS, NOUT )
206 GO TO 80
207 END IF
208 *
209 * For types 5-7, zero one or more columns of the matrix to
210 * test that INFO is returned correctly.
211 *
212 IF( ZEROT ) THEN
213 IF( IMAT.EQ.5 ) THEN
214 IZERO = 1
215 ELSE IF( IMAT.EQ.6 ) THEN
216 IZERO = N
217 ELSE
218 IZERO = N / 2 + 1
219 END IF
220 IOFF = ( IZERO-1 )*LDA
221 IF( IMAT.LT.7 ) THEN
222 DO 20 I = 1, N
223 A( IOFF+I ) = ZERO
224 20 CONTINUE
225 ELSE
226 CALL SLASET( 'Full', N, N-IZERO+1, ZERO, ZERO,
227 $ A( IOFF+1 ), LDA )
228 END IF
229 ELSE
230 IZERO = 0
231 END IF
232 *
233 * Save a copy of the matrix A in ASAV.
234 *
235 CALL SLACPY( 'Full', N, N, A, LDA, ASAV, LDA )
236 *
237 DO 70 IEQUED = 1, 4
238 EQUED = EQUEDS( IEQUED )
239 IF( IEQUED.EQ.1 ) THEN
240 NFACT = 3
241 ELSE
242 NFACT = 1
243 END IF
244 *
245 DO 60 IFACT = 1, NFACT
246 FACT = FACTS( IFACT )
247 PREFAC = LSAME( FACT, 'F' )
248 NOFACT = LSAME( FACT, 'N' )
249 EQUIL = LSAME( FACT, 'E' )
250 *
251 IF( ZEROT ) THEN
252 IF( PREFAC )
253 $ GO TO 60
254 RCONDO = ZERO
255 RCONDI = ZERO
256 *
257 ELSE IF( .NOT.NOFACT ) THEN
258 *
259 * Compute the condition number for comparison with
260 * the value returned by SGESVX (FACT = 'N' reuses
261 * the condition number from the previous iteration
262 * with FACT = 'F').
263 *
264 CALL SLACPY( 'Full', N, N, ASAV, LDA, AFAC, LDA )
265 IF( EQUIL .OR. IEQUED.GT.1 ) THEN
266 *
267 * Compute row and column scale factors to
268 * equilibrate the matrix A.
269 *
270 CALL SGEEQU( N, N, AFAC, LDA, S, S( N+1 ),
271 $ ROWCND, COLCND, AMAX, INFO )
272 IF( INFO.EQ.0 .AND. N.GT.0 ) THEN
273 IF( LSAME( EQUED, 'R' ) ) THEN
274 ROWCND = ZERO
275 COLCND = ONE
276 ELSE IF( LSAME( EQUED, 'C' ) ) THEN
277 ROWCND = ONE
278 COLCND = ZERO
279 ELSE IF( LSAME( EQUED, 'B' ) ) THEN
280 ROWCND = ZERO
281 COLCND = ZERO
282 END IF
283 *
284 * Equilibrate the matrix.
285 *
286 CALL SLAQGE( N, N, AFAC, LDA, S, S( N+1 ),
287 $ ROWCND, COLCND, AMAX, EQUED )
288 END IF
289 END IF
290 *
291 * Save the condition number of the non-equilibrated
292 * system for use in SGET04.
293 *
294 IF( EQUIL ) THEN
295 ROLDO = RCONDO
296 ROLDI = RCONDI
297 END IF
298 *
299 * Compute the 1-norm and infinity-norm of A.
300 *
301 ANORMO = SLANGE( '1', N, N, AFAC, LDA, RWORK )
302 ANORMI = SLANGE( 'I', N, N, AFAC, LDA, RWORK )
303 *
304 * Factor the matrix A.
305 *
306 CALL SGETRF( N, N, AFAC, LDA, IWORK, INFO )
307 *
308 * Form the inverse of A.
309 *
310 CALL SLACPY( 'Full', N, N, AFAC, LDA, A, LDA )
311 LWORK = NMAX*MAX( 3, NRHS )
312 CALL SGETRI( N, A, LDA, IWORK, WORK, LWORK, INFO )
313 *
314 * Compute the 1-norm condition number of A.
315 *
316 AINVNM = SLANGE( '1', N, N, A, LDA, RWORK )
317 IF( ANORMO.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN
318 RCONDO = ONE
319 ELSE
320 RCONDO = ( ONE / ANORMO ) / AINVNM
321 END IF
322 *
323 * Compute the infinity-norm condition number of A.
324 *
325 AINVNM = SLANGE( 'I', N, N, A, LDA, RWORK )
326 IF( ANORMI.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN
327 RCONDI = ONE
328 ELSE
329 RCONDI = ( ONE / ANORMI ) / AINVNM
330 END IF
331 END IF
332 *
333 DO 50 ITRAN = 1, NTRAN
334 *
335 * Do for each value of TRANS.
336 *
337 TRANS = TRANSS( ITRAN )
338 IF( ITRAN.EQ.1 ) THEN
339 RCONDC = RCONDO
340 ELSE
341 RCONDC = RCONDI
342 END IF
343 *
344 * Restore the matrix A.
345 *
346 CALL SLACPY( 'Full', N, N, ASAV, LDA, A, LDA )
347 *
348 * Form an exact solution and set the right hand side.
349 *
350 SRNAMT = 'SLARHS'
351 CALL SLARHS( PATH, XTYPE, 'Full', TRANS, N, N, KL,
352 $ KU, NRHS, A, LDA, XACT, LDA, B, LDA,
353 $ ISEED, INFO )
354 XTYPE = 'C'
355 CALL SLACPY( 'Full', N, NRHS, B, LDA, BSAV, LDA )
356 *
357 IF( NOFACT .AND. ITRAN.EQ.1 ) THEN
358 *
359 * --- Test SGESV ---
360 *
361 * Compute the LU factorization of the matrix and
362 * solve the system.
363 *
364 CALL SLACPY( 'Full', N, N, A, LDA, AFAC, LDA )
365 CALL SLACPY( 'Full', N, NRHS, B, LDA, X, LDA )
366 *
367 SRNAMT = 'SGESV '
368 CALL SGESV( N, NRHS, AFAC, LDA, IWORK, X, LDA,
369 $ INFO )
370 *
371 * Check error code from SGESV .
372 *
373 IF( INFO.NE.IZERO )
374 $ CALL ALAERH( PATH, 'SGESV ', INFO, IZERO,
375 $ ' ', N, N, -1, -1, NRHS, IMAT,
376 $ NFAIL, NERRS, NOUT )
377 *
378 * Reconstruct matrix from factors and compute
379 * residual.
380 *
381 CALL SGET01( N, N, A, LDA, AFAC, LDA, IWORK,
382 $ RWORK, RESULT( 1 ) )
383 NT = 1
384 IF( IZERO.EQ.0 ) THEN
385 *
386 * Compute residual of the computed solution.
387 *
388 CALL SLACPY( 'Full', N, NRHS, B, LDA, WORK,
389 $ LDA )
390 CALL SGET02( 'No transpose', N, N, NRHS, A,
391 $ LDA, X, LDA, WORK, LDA, RWORK,
392 $ RESULT( 2 ) )
393 *
394 * Check solution from generated exact solution.
395 *
396 CALL SGET04( N, NRHS, X, LDA, XACT, LDA,
397 $ RCONDC, RESULT( 3 ) )
398 NT = 3
399 END IF
400 *
401 * Print information about the tests that did not
402 * pass the threshold.
403 *
404 DO 30 K = 1, NT
405 IF( RESULT( K ).GE.THRESH ) THEN
406 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
407 $ CALL ALADHD( NOUT, PATH )
408 WRITE( NOUT, FMT = 9999 )'SGESV ', N,
409 $ IMAT, K, RESULT( K )
410 NFAIL = NFAIL + 1
411 END IF
412 30 CONTINUE
413 NRUN = NRUN + NT
414 END IF
415 *
416 * --- Test SGESVX ---
417 *
418 IF( .NOT.PREFAC )
419 $ CALL SLASET( 'Full', N, N, ZERO, ZERO, AFAC,
420 $ LDA )
421 CALL SLASET( 'Full', N, NRHS, ZERO, ZERO, X, LDA )
422 IF( IEQUED.GT.1 .AND. N.GT.0 ) THEN
423 *
424 * Equilibrate the matrix if FACT = 'F' and
425 * EQUED = 'R', 'C', or 'B'.
426 *
427 CALL SLAQGE( N, N, A, LDA, S, S( N+1 ), ROWCND,
428 $ COLCND, AMAX, EQUED )
429 END IF
430 *
431 * Solve the system and compute the condition number
432 * and error bounds using SGESVX.
433 *
434 SRNAMT = 'SGESVX'
435 CALL SGESVX( FACT, TRANS, N, NRHS, A, LDA, AFAC,
436 $ LDA, IWORK, EQUED, S, S( N+1 ), B,
437 $ LDA, X, LDA, RCOND, RWORK,
438 $ RWORK( NRHS+1 ), WORK, IWORK( N+1 ),
439 $ INFO )
440 *
441 * Check the error code from SGESVX.
442 *
443 IF( INFO.NE.IZERO )
444 $ CALL ALAERH( PATH, 'SGESVX', INFO, IZERO,
445 $ FACT // TRANS, N, N, -1, -1, NRHS,
446 $ IMAT, NFAIL, NERRS, NOUT )
447 *
448 * Compare WORK(1) from SGESVX with the computed
449 * reciprocal pivot growth factor RPVGRW
450 *
451 IF( INFO.NE.0 ) THEN
452 RPVGRW = SLANTR( 'M', 'U', 'N', INFO, INFO,
453 $ AFAC, LDA, WORK )
454 IF( RPVGRW.EQ.ZERO ) THEN
455 RPVGRW = ONE
456 ELSE
457 RPVGRW = SLANGE( 'M', N, INFO, A, LDA,
458 $ WORK ) / RPVGRW
459 END IF
460 ELSE
461 RPVGRW = SLANTR( 'M', 'U', 'N', N, N, AFAC, LDA,
462 $ WORK )
463 IF( RPVGRW.EQ.ZERO ) THEN
464 RPVGRW = ONE
465 ELSE
466 RPVGRW = SLANGE( 'M', N, N, A, LDA, WORK ) /
467 $ RPVGRW
468 END IF
469 END IF
470 RESULT( 7 ) = ABS( RPVGRW-WORK( 1 ) ) /
471 $ MAX( WORK( 1 ), RPVGRW ) /
472 $ SLAMCH( 'E' )
473 *
474 IF( .NOT.PREFAC ) THEN
475 *
476 * Reconstruct matrix from factors and compute
477 * residual.
478 *
479 CALL SGET01( N, N, A, LDA, AFAC, LDA, IWORK,
480 $ RWORK( 2*NRHS+1 ), RESULT( 1 ) )
481 K1 = 1
482 ELSE
483 K1 = 2
484 END IF
485 *
486 IF( INFO.EQ.0 ) THEN
487 TRFCON = .FALSE.
488 *
489 * Compute residual of the computed solution.
490 *
491 CALL SLACPY( 'Full', N, NRHS, BSAV, LDA, WORK,
492 $ LDA )
493 CALL SGET02( TRANS, N, N, NRHS, ASAV, LDA, X,
494 $ LDA, WORK, LDA, RWORK( 2*NRHS+1 ),
495 $ RESULT( 2 ) )
496 *
497 * Check solution from generated exact solution.
498 *
499 IF( NOFACT .OR. ( PREFAC .AND. LSAME( EQUED,
500 $ 'N' ) ) ) THEN
501 CALL SGET04( N, NRHS, X, LDA, XACT, LDA,
502 $ RCONDC, RESULT( 3 ) )
503 ELSE
504 IF( ITRAN.EQ.1 ) THEN
505 ROLDC = ROLDO
506 ELSE
507 ROLDC = ROLDI
508 END IF
509 CALL SGET04( N, NRHS, X, LDA, XACT, LDA,
510 $ ROLDC, RESULT( 3 ) )
511 END IF
512 *
513 * Check the error bounds from iterative
514 * refinement.
515 *
516 CALL SGET07( TRANS, N, NRHS, ASAV, LDA, B, LDA,
517 $ X, LDA, XACT, LDA, RWORK, .TRUE.,
518 $ RWORK( NRHS+1 ), RESULT( 4 ) )
519 ELSE
520 TRFCON = .TRUE.
521 END IF
522 *
523 * Compare RCOND from SGESVX with the computed value
524 * in RCONDC.
525 *
526 RESULT( 6 ) = SGET06( RCOND, RCONDC )
527 *
528 * Print information about the tests that did not pass
529 * the threshold.
530 *
531 IF( .NOT.TRFCON ) THEN
532 DO 40 K = K1, NTESTS
533 IF( RESULT( K ).GE.THRESH ) THEN
534 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
535 $ CALL ALADHD( NOUT, PATH )
536 IF( PREFAC ) THEN
537 WRITE( NOUT, FMT = 9997 )'SGESVX',
538 $ FACT, TRANS, N, EQUED, IMAT, K,
539 $ RESULT( K )
540 ELSE
541 WRITE( NOUT, FMT = 9998 )'SGESVX',
542 $ FACT, TRANS, N, IMAT, K, RESULT( K )
543 END IF
544 NFAIL = NFAIL + 1
545 END IF
546 40 CONTINUE
547 NRUN = NRUN + 7 - K1
548 ELSE
549 IF( RESULT( 1 ).GE.THRESH .AND. .NOT.PREFAC )
550 $ THEN
551 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
552 $ CALL ALADHD( NOUT, PATH )
553 IF( PREFAC ) THEN
554 WRITE( NOUT, FMT = 9997 )'SGESVX', FACT,
555 $ TRANS, N, EQUED, IMAT, 1, RESULT( 1 )
556 ELSE
557 WRITE( NOUT, FMT = 9998 )'SGESVX', FACT,
558 $ TRANS, N, IMAT, 1, RESULT( 1 )
559 END IF
560 NFAIL = NFAIL + 1
561 NRUN = NRUN + 1
562 END IF
563 IF( RESULT( 6 ).GE.THRESH ) THEN
564 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
565 $ CALL ALADHD( NOUT, PATH )
566 IF( PREFAC ) THEN
567 WRITE( NOUT, FMT = 9997 )'SGESVX', FACT,
568 $ TRANS, N, EQUED, IMAT, 6, RESULT( 6 )
569 ELSE
570 WRITE( NOUT, FMT = 9998 )'SGESVX', FACT,
571 $ TRANS, N, IMAT, 6, RESULT( 6 )
572 END IF
573 NFAIL = NFAIL + 1
574 NRUN = NRUN + 1
575 END IF
576 IF( RESULT( 7 ).GE.THRESH ) THEN
577 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
578 $ CALL ALADHD( NOUT, PATH )
579 IF( PREFAC ) THEN
580 WRITE( NOUT, FMT = 9997 )'SGESVX', FACT,
581 $ TRANS, N, EQUED, IMAT, 7, RESULT( 7 )
582 ELSE
583 WRITE( NOUT, FMT = 9998 )'SGESVX', FACT,
584 $ TRANS, N, IMAT, 7, RESULT( 7 )
585 END IF
586 NFAIL = NFAIL + 1
587 NRUN = NRUN + 1
588 END IF
589 *
590 END IF
591 *
592 50 CONTINUE
593 60 CONTINUE
594 70 CONTINUE
595 80 CONTINUE
596 90 CONTINUE
597 *
598 * Print a summary of the results.
599 *
600 CALL ALASVM( PATH, NOUT, NFAIL, NRUN, NERRS )
601 *
602 9999 FORMAT( 1X, A, ', N =', I5, ', type ', I2, ', test(', I2, ') =',
603 $ G12.5 )
604 9998 FORMAT( 1X, A, ', FACT=''', A1, ''', TRANS=''', A1, ''', N=', I5,
605 $ ', type ', I2, ', test(', I1, ')=', G12.5 )
606 9997 FORMAT( 1X, A, ', FACT=''', A1, ''', TRANS=''', A1, ''', N=', I5,
607 $ ', EQUED=''', A1, ''', type ', I2, ', test(', I1, ')=',
608 $ G12.5 )
609 RETURN
610 *
611 * End of SDRVGE
612 *
613 END
2 $ A, AFAC, ASAV, B, BSAV, X, XACT, S, WORK,
3 $ RWORK, IWORK, NOUT )
4 *
5 * -- LAPACK test routine (version 3.1) --
6 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
7 * November 2006
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 A( * ), AFAC( * ), ASAV( * ), B( * ),
18 $ BSAV( * ), RWORK( * ), S( * ), WORK( * ),
19 $ X( * ), XACT( * )
20 * ..
21 *
22 * Purpose
23 * =======
24 *
25 * SDRVGE tests the driver routines SGESV and -SVX.
26 *
27 * Arguments
28 * =========
29 *
30 * DOTYPE (input) LOGICAL array, dimension (NTYPES)
31 * The matrix types to be used for testing. Matrices of type j
32 * (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) =
33 * .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.
34 *
35 * NN (input) INTEGER
36 * The number of values of N contained in the vector NVAL.
37 *
38 * NVAL (input) INTEGER array, dimension (NN)
39 * The values of the matrix column dimension N.
40 *
41 * NRHS (input) INTEGER
42 * The number of right hand side vectors to be generated for
43 * each linear system.
44 *
45 * THRESH (input) REAL
46 * The threshold value for the test ratios. A result is
47 * included in the output file if RESULT >= THRESH. To have
48 * every test ratio printed, use THRESH = 0.
49 *
50 * TSTERR (input) LOGICAL
51 * Flag that indicates whether error exits are to be tested.
52 *
53 * NMAX (input) INTEGER
54 * The maximum value permitted for N, used in dimensioning the
55 * work arrays.
56 *
57 * A (workspace) REAL array, dimension (NMAX*NMAX)
58 *
59 * AFAC (workspace) REAL array, dimension (NMAX*NMAX)
60 *
61 * ASAV (workspace) REAL array, dimension (NMAX*NMAX)
62 *
63 * B (workspace) REAL array, dimension (NMAX*NRHS)
64 *
65 * BSAV (workspace) REAL array, dimension (NMAX*NRHS)
66 *
67 * X (workspace) REAL array, dimension (NMAX*NRHS)
68 *
69 * XACT (workspace) REAL array, dimension (NMAX*NRHS)
70 *
71 * S (workspace) REAL array, dimension (2*NMAX)
72 *
73 * WORK (workspace) REAL array, dimension
74 * (NMAX*max(3,NRHS))
75 *
76 * RWORK (workspace) REAL array, dimension (2*NRHS+NMAX)
77 *
78 * IWORK (workspace) INTEGER array, dimension (2*NMAX)
79 *
80 * NOUT (input) INTEGER
81 * The unit number for output.
82 *
83 * =====================================================================
84 *
85 * .. Parameters ..
86 REAL ONE, ZERO
87 PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
88 INTEGER NTYPES
89 PARAMETER ( NTYPES = 11 )
90 INTEGER NTESTS
91 PARAMETER ( NTESTS = 7 )
92 INTEGER NTRAN
93 PARAMETER ( NTRAN = 3 )
94 * ..
95 * .. Local Scalars ..
96 LOGICAL EQUIL, NOFACT, PREFAC, TRFCON, ZEROT
97 CHARACTER DIST, EQUED, FACT, TRANS, TYPE, XTYPE
98 CHARACTER*3 PATH
99 INTEGER I, IEQUED, IFACT, IMAT, IN, INFO, IOFF, ITRAN,
100 $ IZERO, K, K1, KL, KU, LDA, LWORK, MODE, N, NB,
101 $ NBMIN, NERRS, NFACT, NFAIL, NIMAT, NRUN, NT
102 REAL AINVNM, AMAX, ANORM, ANORMI, ANORMO, CNDNUM,
103 $ COLCND, RCOND, RCONDC, RCONDI, RCONDO, ROLDC,
104 $ ROLDI, ROLDO, ROWCND, RPVGRW
105 * ..
106 * .. Local Arrays ..
107 CHARACTER EQUEDS( 4 ), FACTS( 3 ), TRANSS( NTRAN )
108 INTEGER ISEED( 4 ), ISEEDY( 4 )
109 REAL RESULT( NTESTS )
110 * ..
111 * .. External Functions ..
112 LOGICAL LSAME
113 REAL SGET06, SLAMCH, SLANGE, SLANTR
114 EXTERNAL LSAME, SGET06, SLAMCH, SLANGE, SLANTR
115 * ..
116 * .. External Subroutines ..
117 EXTERNAL ALADHD, ALAERH, ALASVM, SERRVX, SGEEQU, SGESV,
118 $ SGESVX, SGET01, SGET02, SGET04, SGET07, SGETRF,
119 $ SGETRI, SLACPY, SLAQGE, SLARHS, SLASET, SLATB4,
120 $ SLATMS, XLAENV
121 * ..
122 * .. Intrinsic Functions ..
123 INTRINSIC ABS, MAX
124 * ..
125 * .. Scalars in Common ..
126 LOGICAL LERR, OK
127 CHARACTER*32 SRNAMT
128 INTEGER INFOT, NUNIT
129 * ..
130 * .. Common blocks ..
131 COMMON / INFOC / INFOT, NUNIT, OK, LERR
132 COMMON / SRNAMC / SRNAMT
133 * ..
134 * .. Data statements ..
135 DATA ISEEDY / 1988, 1989, 1990, 1991 /
136 DATA TRANSS / 'N', 'T', 'C' /
137 DATA FACTS / 'F', 'N', 'E' /
138 DATA EQUEDS / 'N', 'R', 'C', 'B' /
139 * ..
140 * .. Executable Statements ..
141 *
142 * Initialize constants and the random number seed.
143 *
144 PATH( 1: 1 ) = 'Single precision'
145 PATH( 2: 3 ) = 'GE'
146 NRUN = 0
147 NFAIL = 0
148 NERRS = 0
149 DO 10 I = 1, 4
150 ISEED( I ) = ISEEDY( I )
151 10 CONTINUE
152 *
153 * Test the error exits
154 *
155 IF( TSTERR )
156 $ CALL SERRVX( PATH, NOUT )
157 INFOT = 0
158 *
159 * Set the block size and minimum block size for testing.
160 *
161 NB = 1
162 NBMIN = 2
163 CALL XLAENV( 1, NB )
164 CALL XLAENV( 2, NBMIN )
165 *
166 * Do for each value of N in NVAL
167 *
168 DO 90 IN = 1, NN
169 N = NVAL( IN )
170 LDA = MAX( N, 1 )
171 XTYPE = 'N'
172 NIMAT = NTYPES
173 IF( N.LE.0 )
174 $ NIMAT = 1
175 *
176 DO 80 IMAT = 1, NIMAT
177 *
178 * Do the tests only if DOTYPE( IMAT ) is true.
179 *
180 IF( .NOT.DOTYPE( IMAT ) )
181 $ GO TO 80
182 *
183 * Skip types 5, 6, or 7 if the matrix size is too small.
184 *
185 ZEROT = IMAT.GE.5 .AND. IMAT.LE.7
186 IF( ZEROT .AND. N.LT.IMAT-4 )
187 $ GO TO 80
188 *
189 * Set up parameters with SLATB4 and generate a test matrix
190 * with SLATMS.
191 *
192 CALL SLATB4( PATH, IMAT, N, N, TYPE, KL, KU, ANORM, MODE,
193 $ CNDNUM, DIST )
194 RCONDC = ONE / CNDNUM
195 *
196 SRNAMT = 'SLATMS'
197 CALL SLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE, CNDNUM,
198 $ ANORM, KL, KU, 'No packing', A, LDA, WORK,
199 $ INFO )
200 *
201 * Check error code from SLATMS.
202 *
203 IF( INFO.NE.0 ) THEN
204 CALL ALAERH( PATH, 'SLATMS', INFO, 0, ' ', N, N, -1, -1,
205 $ -1, IMAT, NFAIL, NERRS, NOUT )
206 GO TO 80
207 END IF
208 *
209 * For types 5-7, zero one or more columns of the matrix to
210 * test that INFO is returned correctly.
211 *
212 IF( ZEROT ) THEN
213 IF( IMAT.EQ.5 ) THEN
214 IZERO = 1
215 ELSE IF( IMAT.EQ.6 ) THEN
216 IZERO = N
217 ELSE
218 IZERO = N / 2 + 1
219 END IF
220 IOFF = ( IZERO-1 )*LDA
221 IF( IMAT.LT.7 ) THEN
222 DO 20 I = 1, N
223 A( IOFF+I ) = ZERO
224 20 CONTINUE
225 ELSE
226 CALL SLASET( 'Full', N, N-IZERO+1, ZERO, ZERO,
227 $ A( IOFF+1 ), LDA )
228 END IF
229 ELSE
230 IZERO = 0
231 END IF
232 *
233 * Save a copy of the matrix A in ASAV.
234 *
235 CALL SLACPY( 'Full', N, N, A, LDA, ASAV, LDA )
236 *
237 DO 70 IEQUED = 1, 4
238 EQUED = EQUEDS( IEQUED )
239 IF( IEQUED.EQ.1 ) THEN
240 NFACT = 3
241 ELSE
242 NFACT = 1
243 END IF
244 *
245 DO 60 IFACT = 1, NFACT
246 FACT = FACTS( IFACT )
247 PREFAC = LSAME( FACT, 'F' )
248 NOFACT = LSAME( FACT, 'N' )
249 EQUIL = LSAME( FACT, 'E' )
250 *
251 IF( ZEROT ) THEN
252 IF( PREFAC )
253 $ GO TO 60
254 RCONDO = ZERO
255 RCONDI = ZERO
256 *
257 ELSE IF( .NOT.NOFACT ) THEN
258 *
259 * Compute the condition number for comparison with
260 * the value returned by SGESVX (FACT = 'N' reuses
261 * the condition number from the previous iteration
262 * with FACT = 'F').
263 *
264 CALL SLACPY( 'Full', N, N, ASAV, LDA, AFAC, LDA )
265 IF( EQUIL .OR. IEQUED.GT.1 ) THEN
266 *
267 * Compute row and column scale factors to
268 * equilibrate the matrix A.
269 *
270 CALL SGEEQU( N, N, AFAC, LDA, S, S( N+1 ),
271 $ ROWCND, COLCND, AMAX, INFO )
272 IF( INFO.EQ.0 .AND. N.GT.0 ) THEN
273 IF( LSAME( EQUED, 'R' ) ) THEN
274 ROWCND = ZERO
275 COLCND = ONE
276 ELSE IF( LSAME( EQUED, 'C' ) ) THEN
277 ROWCND = ONE
278 COLCND = ZERO
279 ELSE IF( LSAME( EQUED, 'B' ) ) THEN
280 ROWCND = ZERO
281 COLCND = ZERO
282 END IF
283 *
284 * Equilibrate the matrix.
285 *
286 CALL SLAQGE( N, N, AFAC, LDA, S, S( N+1 ),
287 $ ROWCND, COLCND, AMAX, EQUED )
288 END IF
289 END IF
290 *
291 * Save the condition number of the non-equilibrated
292 * system for use in SGET04.
293 *
294 IF( EQUIL ) THEN
295 ROLDO = RCONDO
296 ROLDI = RCONDI
297 END IF
298 *
299 * Compute the 1-norm and infinity-norm of A.
300 *
301 ANORMO = SLANGE( '1', N, N, AFAC, LDA, RWORK )
302 ANORMI = SLANGE( 'I', N, N, AFAC, LDA, RWORK )
303 *
304 * Factor the matrix A.
305 *
306 CALL SGETRF( N, N, AFAC, LDA, IWORK, INFO )
307 *
308 * Form the inverse of A.
309 *
310 CALL SLACPY( 'Full', N, N, AFAC, LDA, A, LDA )
311 LWORK = NMAX*MAX( 3, NRHS )
312 CALL SGETRI( N, A, LDA, IWORK, WORK, LWORK, INFO )
313 *
314 * Compute the 1-norm condition number of A.
315 *
316 AINVNM = SLANGE( '1', N, N, A, LDA, RWORK )
317 IF( ANORMO.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN
318 RCONDO = ONE
319 ELSE
320 RCONDO = ( ONE / ANORMO ) / AINVNM
321 END IF
322 *
323 * Compute the infinity-norm condition number of A.
324 *
325 AINVNM = SLANGE( 'I', N, N, A, LDA, RWORK )
326 IF( ANORMI.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN
327 RCONDI = ONE
328 ELSE
329 RCONDI = ( ONE / ANORMI ) / AINVNM
330 END IF
331 END IF
332 *
333 DO 50 ITRAN = 1, NTRAN
334 *
335 * Do for each value of TRANS.
336 *
337 TRANS = TRANSS( ITRAN )
338 IF( ITRAN.EQ.1 ) THEN
339 RCONDC = RCONDO
340 ELSE
341 RCONDC = RCONDI
342 END IF
343 *
344 * Restore the matrix A.
345 *
346 CALL SLACPY( 'Full', N, N, ASAV, LDA, A, LDA )
347 *
348 * Form an exact solution and set the right hand side.
349 *
350 SRNAMT = 'SLARHS'
351 CALL SLARHS( PATH, XTYPE, 'Full', TRANS, N, N, KL,
352 $ KU, NRHS, A, LDA, XACT, LDA, B, LDA,
353 $ ISEED, INFO )
354 XTYPE = 'C'
355 CALL SLACPY( 'Full', N, NRHS, B, LDA, BSAV, LDA )
356 *
357 IF( NOFACT .AND. ITRAN.EQ.1 ) THEN
358 *
359 * --- Test SGESV ---
360 *
361 * Compute the LU factorization of the matrix and
362 * solve the system.
363 *
364 CALL SLACPY( 'Full', N, N, A, LDA, AFAC, LDA )
365 CALL SLACPY( 'Full', N, NRHS, B, LDA, X, LDA )
366 *
367 SRNAMT = 'SGESV '
368 CALL SGESV( N, NRHS, AFAC, LDA, IWORK, X, LDA,
369 $ INFO )
370 *
371 * Check error code from SGESV .
372 *
373 IF( INFO.NE.IZERO )
374 $ CALL ALAERH( PATH, 'SGESV ', INFO, IZERO,
375 $ ' ', N, N, -1, -1, NRHS, IMAT,
376 $ NFAIL, NERRS, NOUT )
377 *
378 * Reconstruct matrix from factors and compute
379 * residual.
380 *
381 CALL SGET01( N, N, A, LDA, AFAC, LDA, IWORK,
382 $ RWORK, RESULT( 1 ) )
383 NT = 1
384 IF( IZERO.EQ.0 ) THEN
385 *
386 * Compute residual of the computed solution.
387 *
388 CALL SLACPY( 'Full', N, NRHS, B, LDA, WORK,
389 $ LDA )
390 CALL SGET02( 'No transpose', N, N, NRHS, A,
391 $ LDA, X, LDA, WORK, LDA, RWORK,
392 $ RESULT( 2 ) )
393 *
394 * Check solution from generated exact solution.
395 *
396 CALL SGET04( N, NRHS, X, LDA, XACT, LDA,
397 $ RCONDC, RESULT( 3 ) )
398 NT = 3
399 END IF
400 *
401 * Print information about the tests that did not
402 * pass the threshold.
403 *
404 DO 30 K = 1, NT
405 IF( RESULT( K ).GE.THRESH ) THEN
406 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
407 $ CALL ALADHD( NOUT, PATH )
408 WRITE( NOUT, FMT = 9999 )'SGESV ', N,
409 $ IMAT, K, RESULT( K )
410 NFAIL = NFAIL + 1
411 END IF
412 30 CONTINUE
413 NRUN = NRUN + NT
414 END IF
415 *
416 * --- Test SGESVX ---
417 *
418 IF( .NOT.PREFAC )
419 $ CALL SLASET( 'Full', N, N, ZERO, ZERO, AFAC,
420 $ LDA )
421 CALL SLASET( 'Full', N, NRHS, ZERO, ZERO, X, LDA )
422 IF( IEQUED.GT.1 .AND. N.GT.0 ) THEN
423 *
424 * Equilibrate the matrix if FACT = 'F' and
425 * EQUED = 'R', 'C', or 'B'.
426 *
427 CALL SLAQGE( N, N, A, LDA, S, S( N+1 ), ROWCND,
428 $ COLCND, AMAX, EQUED )
429 END IF
430 *
431 * Solve the system and compute the condition number
432 * and error bounds using SGESVX.
433 *
434 SRNAMT = 'SGESVX'
435 CALL SGESVX( FACT, TRANS, N, NRHS, A, LDA, AFAC,
436 $ LDA, IWORK, EQUED, S, S( N+1 ), B,
437 $ LDA, X, LDA, RCOND, RWORK,
438 $ RWORK( NRHS+1 ), WORK, IWORK( N+1 ),
439 $ INFO )
440 *
441 * Check the error code from SGESVX.
442 *
443 IF( INFO.NE.IZERO )
444 $ CALL ALAERH( PATH, 'SGESVX', INFO, IZERO,
445 $ FACT // TRANS, N, N, -1, -1, NRHS,
446 $ IMAT, NFAIL, NERRS, NOUT )
447 *
448 * Compare WORK(1) from SGESVX with the computed
449 * reciprocal pivot growth factor RPVGRW
450 *
451 IF( INFO.NE.0 ) THEN
452 RPVGRW = SLANTR( 'M', 'U', 'N', INFO, INFO,
453 $ AFAC, LDA, WORK )
454 IF( RPVGRW.EQ.ZERO ) THEN
455 RPVGRW = ONE
456 ELSE
457 RPVGRW = SLANGE( 'M', N, INFO, A, LDA,
458 $ WORK ) / RPVGRW
459 END IF
460 ELSE
461 RPVGRW = SLANTR( 'M', 'U', 'N', N, N, AFAC, LDA,
462 $ WORK )
463 IF( RPVGRW.EQ.ZERO ) THEN
464 RPVGRW = ONE
465 ELSE
466 RPVGRW = SLANGE( 'M', N, N, A, LDA, WORK ) /
467 $ RPVGRW
468 END IF
469 END IF
470 RESULT( 7 ) = ABS( RPVGRW-WORK( 1 ) ) /
471 $ MAX( WORK( 1 ), RPVGRW ) /
472 $ SLAMCH( 'E' )
473 *
474 IF( .NOT.PREFAC ) THEN
475 *
476 * Reconstruct matrix from factors and compute
477 * residual.
478 *
479 CALL SGET01( N, N, A, LDA, AFAC, LDA, IWORK,
480 $ RWORK( 2*NRHS+1 ), RESULT( 1 ) )
481 K1 = 1
482 ELSE
483 K1 = 2
484 END IF
485 *
486 IF( INFO.EQ.0 ) THEN
487 TRFCON = .FALSE.
488 *
489 * Compute residual of the computed solution.
490 *
491 CALL SLACPY( 'Full', N, NRHS, BSAV, LDA, WORK,
492 $ LDA )
493 CALL SGET02( TRANS, N, N, NRHS, ASAV, LDA, X,
494 $ LDA, WORK, LDA, RWORK( 2*NRHS+1 ),
495 $ RESULT( 2 ) )
496 *
497 * Check solution from generated exact solution.
498 *
499 IF( NOFACT .OR. ( PREFAC .AND. LSAME( EQUED,
500 $ 'N' ) ) ) THEN
501 CALL SGET04( N, NRHS, X, LDA, XACT, LDA,
502 $ RCONDC, RESULT( 3 ) )
503 ELSE
504 IF( ITRAN.EQ.1 ) THEN
505 ROLDC = ROLDO
506 ELSE
507 ROLDC = ROLDI
508 END IF
509 CALL SGET04( N, NRHS, X, LDA, XACT, LDA,
510 $ ROLDC, RESULT( 3 ) )
511 END IF
512 *
513 * Check the error bounds from iterative
514 * refinement.
515 *
516 CALL SGET07( TRANS, N, NRHS, ASAV, LDA, B, LDA,
517 $ X, LDA, XACT, LDA, RWORK, .TRUE.,
518 $ RWORK( NRHS+1 ), RESULT( 4 ) )
519 ELSE
520 TRFCON = .TRUE.
521 END IF
522 *
523 * Compare RCOND from SGESVX with the computed value
524 * in RCONDC.
525 *
526 RESULT( 6 ) = SGET06( RCOND, RCONDC )
527 *
528 * Print information about the tests that did not pass
529 * the threshold.
530 *
531 IF( .NOT.TRFCON ) THEN
532 DO 40 K = K1, NTESTS
533 IF( RESULT( K ).GE.THRESH ) THEN
534 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
535 $ CALL ALADHD( NOUT, PATH )
536 IF( PREFAC ) THEN
537 WRITE( NOUT, FMT = 9997 )'SGESVX',
538 $ FACT, TRANS, N, EQUED, IMAT, K,
539 $ RESULT( K )
540 ELSE
541 WRITE( NOUT, FMT = 9998 )'SGESVX',
542 $ FACT, TRANS, N, IMAT, K, RESULT( K )
543 END IF
544 NFAIL = NFAIL + 1
545 END IF
546 40 CONTINUE
547 NRUN = NRUN + 7 - K1
548 ELSE
549 IF( RESULT( 1 ).GE.THRESH .AND. .NOT.PREFAC )
550 $ THEN
551 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
552 $ CALL ALADHD( NOUT, PATH )
553 IF( PREFAC ) THEN
554 WRITE( NOUT, FMT = 9997 )'SGESVX', FACT,
555 $ TRANS, N, EQUED, IMAT, 1, RESULT( 1 )
556 ELSE
557 WRITE( NOUT, FMT = 9998 )'SGESVX', FACT,
558 $ TRANS, N, IMAT, 1, RESULT( 1 )
559 END IF
560 NFAIL = NFAIL + 1
561 NRUN = NRUN + 1
562 END IF
563 IF( RESULT( 6 ).GE.THRESH ) THEN
564 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
565 $ CALL ALADHD( NOUT, PATH )
566 IF( PREFAC ) THEN
567 WRITE( NOUT, FMT = 9997 )'SGESVX', FACT,
568 $ TRANS, N, EQUED, IMAT, 6, RESULT( 6 )
569 ELSE
570 WRITE( NOUT, FMT = 9998 )'SGESVX', FACT,
571 $ TRANS, N, IMAT, 6, RESULT( 6 )
572 END IF
573 NFAIL = NFAIL + 1
574 NRUN = NRUN + 1
575 END IF
576 IF( RESULT( 7 ).GE.THRESH ) THEN
577 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
578 $ CALL ALADHD( NOUT, PATH )
579 IF( PREFAC ) THEN
580 WRITE( NOUT, FMT = 9997 )'SGESVX', FACT,
581 $ TRANS, N, EQUED, IMAT, 7, RESULT( 7 )
582 ELSE
583 WRITE( NOUT, FMT = 9998 )'SGESVX', FACT,
584 $ TRANS, N, IMAT, 7, RESULT( 7 )
585 END IF
586 NFAIL = NFAIL + 1
587 NRUN = NRUN + 1
588 END IF
589 *
590 END IF
591 *
592 50 CONTINUE
593 60 CONTINUE
594 70 CONTINUE
595 80 CONTINUE
596 90 CONTINUE
597 *
598 * Print a summary of the results.
599 *
600 CALL ALASVM( PATH, NOUT, NFAIL, NRUN, NERRS )
601 *
602 9999 FORMAT( 1X, A, ', N =', I5, ', type ', I2, ', test(', I2, ') =',
603 $ G12.5 )
604 9998 FORMAT( 1X, A, ', FACT=''', A1, ''', TRANS=''', A1, ''', N=', I5,
605 $ ', type ', I2, ', test(', I1, ')=', G12.5 )
606 9997 FORMAT( 1X, A, ', FACT=''', A1, ''', TRANS=''', A1, ''', N=', I5,
607 $ ', EQUED=''', A1, ''', type ', I2, ', test(', I1, ')=',
608 $ G12.5 )
609 RETURN
610 *
611 * End of SDRVGE
612 *
613 END