1 SUBROUTINE ZDRVGT( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, A, AF,
2 $ B, X, XACT, WORK, RWORK, IWORK, NOUT )
3 *
4 * -- LAPACK test routine (version 3.1) --
5 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
6 * November 2006
7 *
8 * .. Scalar Arguments ..
9 LOGICAL TSTERR
10 INTEGER NN, NOUT, NRHS
11 DOUBLE PRECISION THRESH
12 * ..
13 * .. Array Arguments ..
14 LOGICAL DOTYPE( * )
15 INTEGER IWORK( * ), NVAL( * )
16 DOUBLE PRECISION RWORK( * )
17 COMPLEX*16 A( * ), AF( * ), B( * ), WORK( * ), X( * ),
18 $ XACT( * )
19 * ..
20 *
21 * Purpose
22 * =======
23 *
24 * ZDRVGT tests ZGTSV and -SVX.
25 *
26 * Arguments
27 * =========
28 *
29 * DOTYPE (input) LOGICAL array, dimension (NTYPES)
30 * The matrix types to be used for testing. Matrices of type j
31 * (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) =
32 * .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.
33 *
34 * NN (input) INTEGER
35 * The number of values of N contained in the vector NVAL.
36 *
37 * NVAL (input) INTEGER array, dimension (NN)
38 * The values of the matrix dimension N.
39 *
40 * THRESH (input) DOUBLE PRECISION
41 * The threshold value for the test ratios. A result is
42 * included in the output file if RESULT >= THRESH. To have
43 * every test ratio printed, use THRESH = 0.
44 *
45 * TSTERR (input) LOGICAL
46 * Flag that indicates whether error exits are to be tested.
47 *
48 * A (workspace) COMPLEX*16 array, dimension (NMAX*4)
49 *
50 * AF (workspace) COMPLEX*16 array, dimension (NMAX*4)
51 *
52 * B (workspace) COMPLEX*16 array, dimension (NMAX*NRHS)
53 *
54 * X (workspace) COMPLEX*16 array, dimension (NMAX*NRHS)
55 *
56 * XACT (workspace) COMPLEX*16 array, dimension (NMAX*NRHS)
57 *
58 * WORK (workspace) COMPLEX*16 array, dimension
59 * (NMAX*max(3,NRHS))
60 *
61 * RWORK (workspace) DOUBLE PRECISION array, dimension (NMAX+2*NRHS)
62 *
63 * IWORK (workspace) INTEGER array, dimension (2*NMAX)
64 *
65 * NOUT (input) INTEGER
66 * The unit number for output.
67 *
68 * =====================================================================
69 *
70 * .. Parameters ..
71 DOUBLE PRECISION ONE, ZERO
72 PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
73 INTEGER NTYPES
74 PARAMETER ( NTYPES = 12 )
75 INTEGER NTESTS
76 PARAMETER ( NTESTS = 6 )
77 * ..
78 * .. Local Scalars ..
79 LOGICAL TRFCON, ZEROT
80 CHARACTER DIST, FACT, TRANS, TYPE
81 CHARACTER*3 PATH
82 INTEGER I, IFACT, IMAT, IN, INFO, ITRAN, IX, IZERO, J,
83 $ K, K1, KL, KOFF, KU, LDA, M, MODE, N, NERRS,
84 $ NFAIL, NIMAT, NRUN, NT
85 DOUBLE PRECISION AINVNM, ANORM, ANORMI, ANORMO, COND, RCOND,
86 $ RCONDC, RCONDI, RCONDO
87 * ..
88 * .. Local Arrays ..
89 CHARACTER TRANSS( 3 )
90 INTEGER ISEED( 4 ), ISEEDY( 4 )
91 DOUBLE PRECISION RESULT( NTESTS ), Z( 3 )
92 * ..
93 * .. External Functions ..
94 DOUBLE PRECISION DGET06, DZASUM, ZLANGT
95 EXTERNAL DGET06, DZASUM, ZLANGT
96 * ..
97 * .. External Subroutines ..
98 EXTERNAL ALADHD, ALAERH, ALASVM, ZCOPY, ZDSCAL, ZERRVX,
99 $ ZGET04, ZGTSV, ZGTSVX, ZGTT01, ZGTT02, ZGTT05,
100 $ ZGTTRF, ZGTTRS, ZLACPY, ZLAGTM, ZLARNV, ZLASET,
101 $ ZLATB4, ZLATMS
102 * ..
103 * .. Intrinsic Functions ..
104 INTRINSIC DCMPLX, MAX
105 * ..
106 * .. Scalars in Common ..
107 LOGICAL LERR, OK
108 CHARACTER*32 SRNAMT
109 INTEGER INFOT, NUNIT
110 * ..
111 * .. Common blocks ..
112 COMMON / INFOC / INFOT, NUNIT, OK, LERR
113 COMMON / SRNAMC / SRNAMT
114 * ..
115 * .. Data statements ..
116 DATA ISEEDY / 0, 0, 0, 1 / , TRANSS / 'N', 'T',
117 $ 'C' /
118 * ..
119 * .. Executable Statements ..
120 *
121 PATH( 1: 1 ) = 'Zomplex precision'
122 PATH( 2: 3 ) = 'GT'
123 NRUN = 0
124 NFAIL = 0
125 NERRS = 0
126 DO 10 I = 1, 4
127 ISEED( I ) = ISEEDY( I )
128 10 CONTINUE
129 *
130 * Test the error exits
131 *
132 IF( TSTERR )
133 $ CALL ZERRVX( PATH, NOUT )
134 INFOT = 0
135 *
136 DO 140 IN = 1, NN
137 *
138 * Do for each value of N in NVAL.
139 *
140 N = NVAL( IN )
141 M = MAX( N-1, 0 )
142 LDA = MAX( 1, N )
143 NIMAT = NTYPES
144 IF( N.LE.0 )
145 $ NIMAT = 1
146 *
147 DO 130 IMAT = 1, NIMAT
148 *
149 * Do the tests only if DOTYPE( IMAT ) is true.
150 *
151 IF( .NOT.DOTYPE( IMAT ) )
152 $ GO TO 130
153 *
154 * Set up parameters with ZLATB4.
155 *
156 CALL ZLATB4( PATH, IMAT, N, N, TYPE, KL, KU, ANORM, MODE,
157 $ COND, DIST )
158 *
159 ZEROT = IMAT.GE.8 .AND. IMAT.LE.10
160 IF( IMAT.LE.6 ) THEN
161 *
162 * Types 1-6: generate matrices of known condition number.
163 *
164 KOFF = MAX( 2-KU, 3-MAX( 1, N ) )
165 SRNAMT = 'ZLATMS'
166 CALL ZLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE, COND,
167 $ ANORM, KL, KU, 'Z', AF( KOFF ), 3, WORK,
168 $ INFO )
169 *
170 * Check the error code from ZLATMS.
171 *
172 IF( INFO.NE.0 ) THEN
173 CALL ALAERH( PATH, 'ZLATMS', INFO, 0, ' ', N, N, KL,
174 $ KU, -1, IMAT, NFAIL, NERRS, NOUT )
175 GO TO 130
176 END IF
177 IZERO = 0
178 *
179 IF( N.GT.1 ) THEN
180 CALL ZCOPY( N-1, AF( 4 ), 3, A, 1 )
181 CALL ZCOPY( N-1, AF( 3 ), 3, A( N+M+1 ), 1 )
182 END IF
183 CALL ZCOPY( N, AF( 2 ), 3, A( M+1 ), 1 )
184 ELSE
185 *
186 * Types 7-12: generate tridiagonal matrices with
187 * unknown condition numbers.
188 *
189 IF( .NOT.ZEROT .OR. .NOT.DOTYPE( 7 ) ) THEN
190 *
191 * Generate a matrix with elements from [-1,1].
192 *
193 CALL ZLARNV( 2, ISEED, N+2*M, A )
194 IF( ANORM.NE.ONE )
195 $ CALL ZDSCAL( N+2*M, ANORM, A, 1 )
196 ELSE IF( IZERO.GT.0 ) THEN
197 *
198 * Reuse the last matrix by copying back the zeroed out
199 * elements.
200 *
201 IF( IZERO.EQ.1 ) THEN
202 A( N ) = Z( 2 )
203 IF( N.GT.1 )
204 $ A( 1 ) = Z( 3 )
205 ELSE IF( IZERO.EQ.N ) THEN
206 A( 3*N-2 ) = Z( 1 )
207 A( 2*N-1 ) = Z( 2 )
208 ELSE
209 A( 2*N-2+IZERO ) = Z( 1 )
210 A( N-1+IZERO ) = Z( 2 )
211 A( IZERO ) = Z( 3 )
212 END IF
213 END IF
214 *
215 * If IMAT > 7, set one column of the matrix to 0.
216 *
217 IF( .NOT.ZEROT ) THEN
218 IZERO = 0
219 ELSE IF( IMAT.EQ.8 ) THEN
220 IZERO = 1
221 Z( 2 ) = A( N )
222 A( N ) = ZERO
223 IF( N.GT.1 ) THEN
224 Z( 3 ) = A( 1 )
225 A( 1 ) = ZERO
226 END IF
227 ELSE IF( IMAT.EQ.9 ) THEN
228 IZERO = N
229 Z( 1 ) = A( 3*N-2 )
230 Z( 2 ) = A( 2*N-1 )
231 A( 3*N-2 ) = ZERO
232 A( 2*N-1 ) = ZERO
233 ELSE
234 IZERO = ( N+1 ) / 2
235 DO 20 I = IZERO, N - 1
236 A( 2*N-2+I ) = ZERO
237 A( N-1+I ) = ZERO
238 A( I ) = ZERO
239 20 CONTINUE
240 A( 3*N-2 ) = ZERO
241 A( 2*N-1 ) = ZERO
242 END IF
243 END IF
244 *
245 DO 120 IFACT = 1, 2
246 IF( IFACT.EQ.1 ) THEN
247 FACT = 'F'
248 ELSE
249 FACT = 'N'
250 END IF
251 *
252 * Compute the condition number for comparison with
253 * the value returned by ZGTSVX.
254 *
255 IF( ZEROT ) THEN
256 IF( IFACT.EQ.1 )
257 $ GO TO 120
258 RCONDO = ZERO
259 RCONDI = ZERO
260 *
261 ELSE IF( IFACT.EQ.1 ) THEN
262 CALL ZCOPY( N+2*M, A, 1, AF, 1 )
263 *
264 * Compute the 1-norm and infinity-norm of A.
265 *
266 ANORMO = ZLANGT( '1', N, A, A( M+1 ), A( N+M+1 ) )
267 ANORMI = ZLANGT( 'I', N, A, A( M+1 ), A( N+M+1 ) )
268 *
269 * Factor the matrix A.
270 *
271 CALL ZGTTRF( N, AF, AF( M+1 ), AF( N+M+1 ),
272 $ AF( N+2*M+1 ), IWORK, INFO )
273 *
274 * Use ZGTTRS to solve for one column at a time of
275 * inv(A), computing the maximum column sum as we go.
276 *
277 AINVNM = ZERO
278 DO 40 I = 1, N
279 DO 30 J = 1, N
280 X( J ) = ZERO
281 30 CONTINUE
282 X( I ) = ONE
283 CALL ZGTTRS( 'No transpose', N, 1, AF, AF( M+1 ),
284 $ AF( N+M+1 ), AF( N+2*M+1 ), IWORK, X,
285 $ LDA, INFO )
286 AINVNM = MAX( AINVNM, DZASUM( N, X, 1 ) )
287 40 CONTINUE
288 *
289 * Compute the 1-norm condition number of A.
290 *
291 IF( ANORMO.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN
292 RCONDO = ONE
293 ELSE
294 RCONDO = ( ONE / ANORMO ) / AINVNM
295 END IF
296 *
297 * Use ZGTTRS to solve for one column at a time of
298 * inv(A'), computing the maximum column sum as we go.
299 *
300 AINVNM = ZERO
301 DO 60 I = 1, N
302 DO 50 J = 1, N
303 X( J ) = ZERO
304 50 CONTINUE
305 X( I ) = ONE
306 CALL ZGTTRS( 'Conjugate transpose', N, 1, AF,
307 $ AF( M+1 ), AF( N+M+1 ), AF( N+2*M+1 ),
308 $ IWORK, X, LDA, INFO )
309 AINVNM = MAX( AINVNM, DZASUM( N, X, 1 ) )
310 60 CONTINUE
311 *
312 * Compute the infinity-norm condition number of A.
313 *
314 IF( ANORMI.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN
315 RCONDI = ONE
316 ELSE
317 RCONDI = ( ONE / ANORMI ) / AINVNM
318 END IF
319 END IF
320 *
321 DO 110 ITRAN = 1, 3
322 TRANS = TRANSS( ITRAN )
323 IF( ITRAN.EQ.1 ) THEN
324 RCONDC = RCONDO
325 ELSE
326 RCONDC = RCONDI
327 END IF
328 *
329 * Generate NRHS random solution vectors.
330 *
331 IX = 1
332 DO 70 J = 1, NRHS
333 CALL ZLARNV( 2, ISEED, N, XACT( IX ) )
334 IX = IX + LDA
335 70 CONTINUE
336 *
337 * Set the right hand side.
338 *
339 CALL ZLAGTM( TRANS, N, NRHS, ONE, A, A( M+1 ),
340 $ A( N+M+1 ), XACT, LDA, ZERO, B, LDA )
341 *
342 IF( IFACT.EQ.2 .AND. ITRAN.EQ.1 ) THEN
343 *
344 * --- Test ZGTSV ---
345 *
346 * Solve the system using Gaussian elimination with
347 * partial pivoting.
348 *
349 CALL ZCOPY( N+2*M, A, 1, AF, 1 )
350 CALL ZLACPY( 'Full', N, NRHS, B, LDA, X, LDA )
351 *
352 SRNAMT = 'ZGTSV '
353 CALL ZGTSV( N, NRHS, AF, AF( M+1 ), AF( N+M+1 ), X,
354 $ LDA, INFO )
355 *
356 * Check error code from ZGTSV .
357 *
358 IF( INFO.NE.IZERO )
359 $ CALL ALAERH( PATH, 'ZGTSV ', INFO, IZERO, ' ',
360 $ N, N, 1, 1, NRHS, IMAT, NFAIL,
361 $ NERRS, NOUT )
362 NT = 1
363 IF( IZERO.EQ.0 ) THEN
364 *
365 * Check residual of computed solution.
366 *
367 CALL ZLACPY( 'Full', N, NRHS, B, LDA, WORK,
368 $ LDA )
369 CALL ZGTT02( TRANS, N, NRHS, A, A( M+1 ),
370 $ A( N+M+1 ), X, LDA, WORK, LDA,
371 $ RWORK, RESULT( 2 ) )
372 *
373 * Check solution from generated exact solution.
374 *
375 CALL ZGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC,
376 $ RESULT( 3 ) )
377 NT = 3
378 END IF
379 *
380 * Print information about the tests that did not pass
381 * the threshold.
382 *
383 DO 80 K = 2, NT
384 IF( RESULT( K ).GE.THRESH ) THEN
385 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
386 $ CALL ALADHD( NOUT, PATH )
387 WRITE( NOUT, FMT = 9999 )'ZGTSV ', N, IMAT,
388 $ K, RESULT( K )
389 NFAIL = NFAIL + 1
390 END IF
391 80 CONTINUE
392 NRUN = NRUN + NT - 1
393 END IF
394 *
395 * --- Test ZGTSVX ---
396 *
397 IF( IFACT.GT.1 ) THEN
398 *
399 * Initialize AF to zero.
400 *
401 DO 90 I = 1, 3*N - 2
402 AF( I ) = ZERO
403 90 CONTINUE
404 END IF
405 CALL ZLASET( 'Full', N, NRHS, DCMPLX( ZERO ),
406 $ DCMPLX( ZERO ), X, LDA )
407 *
408 * Solve the system and compute the condition number and
409 * error bounds using ZGTSVX.
410 *
411 SRNAMT = 'ZGTSVX'
412 CALL ZGTSVX( FACT, TRANS, N, NRHS, A, A( M+1 ),
413 $ A( N+M+1 ), AF, AF( M+1 ), AF( N+M+1 ),
414 $ AF( N+2*M+1 ), IWORK, B, LDA, X, LDA,
415 $ RCOND, RWORK, RWORK( NRHS+1 ), WORK,
416 $ RWORK( 2*NRHS+1 ), INFO )
417 *
418 * Check the error code from ZGTSVX.
419 *
420 IF( INFO.NE.IZERO )
421 $ CALL ALAERH( PATH, 'ZGTSVX', INFO, IZERO,
422 $ FACT // TRANS, N, N, 1, 1, NRHS, IMAT,
423 $ NFAIL, NERRS, NOUT )
424 *
425 IF( IFACT.GE.2 ) THEN
426 *
427 * Reconstruct matrix from factors and compute
428 * residual.
429 *
430 CALL ZGTT01( N, A, A( M+1 ), A( N+M+1 ), AF,
431 $ AF( M+1 ), AF( N+M+1 ), AF( N+2*M+1 ),
432 $ IWORK, WORK, LDA, RWORK, RESULT( 1 ) )
433 K1 = 1
434 ELSE
435 K1 = 2
436 END IF
437 *
438 IF( INFO.EQ.0 ) THEN
439 TRFCON = .FALSE.
440 *
441 * Check residual of computed solution.
442 *
443 CALL ZLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA )
444 CALL ZGTT02( TRANS, N, NRHS, A, A( M+1 ),
445 $ A( N+M+1 ), X, LDA, WORK, LDA, RWORK,
446 $ RESULT( 2 ) )
447 *
448 * Check solution from generated exact solution.
449 *
450 CALL ZGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC,
451 $ RESULT( 3 ) )
452 *
453 * Check the error bounds from iterative refinement.
454 *
455 CALL ZGTT05( TRANS, N, NRHS, A, A( M+1 ),
456 $ A( N+M+1 ), B, LDA, X, LDA, XACT, LDA,
457 $ RWORK, RWORK( NRHS+1 ), RESULT( 4 ) )
458 NT = 5
459 END IF
460 *
461 * Print information about the tests that did not pass
462 * the threshold.
463 *
464 DO 100 K = K1, NT
465 IF( RESULT( K ).GE.THRESH ) THEN
466 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
467 $ CALL ALADHD( NOUT, PATH )
468 WRITE( NOUT, FMT = 9998 )'ZGTSVX', FACT, TRANS,
469 $ N, IMAT, K, RESULT( K )
470 NFAIL = NFAIL + 1
471 END IF
472 100 CONTINUE
473 *
474 * Check the reciprocal of the condition number.
475 *
476 RESULT( 6 ) = DGET06( RCOND, RCONDC )
477 IF( RESULT( 6 ).GE.THRESH ) THEN
478 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
479 $ CALL ALADHD( NOUT, PATH )
480 WRITE( NOUT, FMT = 9998 )'ZGTSVX', FACT, TRANS, N,
481 $ IMAT, K, RESULT( K )
482 NFAIL = NFAIL + 1
483 END IF
484 NRUN = NRUN + NT - K1 + 2
485 *
486 110 CONTINUE
487 120 CONTINUE
488 130 CONTINUE
489 140 CONTINUE
490 *
491 * Print a summary of the results.
492 *
493 CALL ALASVM( PATH, NOUT, NFAIL, NRUN, NERRS )
494 *
495 9999 FORMAT( 1X, A, ', N =', I5, ', type ', I2, ', test ', I2,
496 $ ', ratio = ', G12.5 )
497 9998 FORMAT( 1X, A, ', FACT=''', A1, ''', TRANS=''', A1, ''', N =',
498 $ I5, ', type ', I2, ', test ', I2, ', ratio = ', G12.5 )
499 RETURN
500 *
501 * End of ZDRVGT
502 *
503 END
2 $ B, X, XACT, WORK, RWORK, IWORK, NOUT )
3 *
4 * -- LAPACK test routine (version 3.1) --
5 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
6 * November 2006
7 *
8 * .. Scalar Arguments ..
9 LOGICAL TSTERR
10 INTEGER NN, NOUT, NRHS
11 DOUBLE PRECISION THRESH
12 * ..
13 * .. Array Arguments ..
14 LOGICAL DOTYPE( * )
15 INTEGER IWORK( * ), NVAL( * )
16 DOUBLE PRECISION RWORK( * )
17 COMPLEX*16 A( * ), AF( * ), B( * ), WORK( * ), X( * ),
18 $ XACT( * )
19 * ..
20 *
21 * Purpose
22 * =======
23 *
24 * ZDRVGT tests ZGTSV and -SVX.
25 *
26 * Arguments
27 * =========
28 *
29 * DOTYPE (input) LOGICAL array, dimension (NTYPES)
30 * The matrix types to be used for testing. Matrices of type j
31 * (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) =
32 * .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.
33 *
34 * NN (input) INTEGER
35 * The number of values of N contained in the vector NVAL.
36 *
37 * NVAL (input) INTEGER array, dimension (NN)
38 * The values of the matrix dimension N.
39 *
40 * THRESH (input) DOUBLE PRECISION
41 * The threshold value for the test ratios. A result is
42 * included in the output file if RESULT >= THRESH. To have
43 * every test ratio printed, use THRESH = 0.
44 *
45 * TSTERR (input) LOGICAL
46 * Flag that indicates whether error exits are to be tested.
47 *
48 * A (workspace) COMPLEX*16 array, dimension (NMAX*4)
49 *
50 * AF (workspace) COMPLEX*16 array, dimension (NMAX*4)
51 *
52 * B (workspace) COMPLEX*16 array, dimension (NMAX*NRHS)
53 *
54 * X (workspace) COMPLEX*16 array, dimension (NMAX*NRHS)
55 *
56 * XACT (workspace) COMPLEX*16 array, dimension (NMAX*NRHS)
57 *
58 * WORK (workspace) COMPLEX*16 array, dimension
59 * (NMAX*max(3,NRHS))
60 *
61 * RWORK (workspace) DOUBLE PRECISION array, dimension (NMAX+2*NRHS)
62 *
63 * IWORK (workspace) INTEGER array, dimension (2*NMAX)
64 *
65 * NOUT (input) INTEGER
66 * The unit number for output.
67 *
68 * =====================================================================
69 *
70 * .. Parameters ..
71 DOUBLE PRECISION ONE, ZERO
72 PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
73 INTEGER NTYPES
74 PARAMETER ( NTYPES = 12 )
75 INTEGER NTESTS
76 PARAMETER ( NTESTS = 6 )
77 * ..
78 * .. Local Scalars ..
79 LOGICAL TRFCON, ZEROT
80 CHARACTER DIST, FACT, TRANS, TYPE
81 CHARACTER*3 PATH
82 INTEGER I, IFACT, IMAT, IN, INFO, ITRAN, IX, IZERO, J,
83 $ K, K1, KL, KOFF, KU, LDA, M, MODE, N, NERRS,
84 $ NFAIL, NIMAT, NRUN, NT
85 DOUBLE PRECISION AINVNM, ANORM, ANORMI, ANORMO, COND, RCOND,
86 $ RCONDC, RCONDI, RCONDO
87 * ..
88 * .. Local Arrays ..
89 CHARACTER TRANSS( 3 )
90 INTEGER ISEED( 4 ), ISEEDY( 4 )
91 DOUBLE PRECISION RESULT( NTESTS ), Z( 3 )
92 * ..
93 * .. External Functions ..
94 DOUBLE PRECISION DGET06, DZASUM, ZLANGT
95 EXTERNAL DGET06, DZASUM, ZLANGT
96 * ..
97 * .. External Subroutines ..
98 EXTERNAL ALADHD, ALAERH, ALASVM, ZCOPY, ZDSCAL, ZERRVX,
99 $ ZGET04, ZGTSV, ZGTSVX, ZGTT01, ZGTT02, ZGTT05,
100 $ ZGTTRF, ZGTTRS, ZLACPY, ZLAGTM, ZLARNV, ZLASET,
101 $ ZLATB4, ZLATMS
102 * ..
103 * .. Intrinsic Functions ..
104 INTRINSIC DCMPLX, MAX
105 * ..
106 * .. Scalars in Common ..
107 LOGICAL LERR, OK
108 CHARACTER*32 SRNAMT
109 INTEGER INFOT, NUNIT
110 * ..
111 * .. Common blocks ..
112 COMMON / INFOC / INFOT, NUNIT, OK, LERR
113 COMMON / SRNAMC / SRNAMT
114 * ..
115 * .. Data statements ..
116 DATA ISEEDY / 0, 0, 0, 1 / , TRANSS / 'N', 'T',
117 $ 'C' /
118 * ..
119 * .. Executable Statements ..
120 *
121 PATH( 1: 1 ) = 'Zomplex precision'
122 PATH( 2: 3 ) = 'GT'
123 NRUN = 0
124 NFAIL = 0
125 NERRS = 0
126 DO 10 I = 1, 4
127 ISEED( I ) = ISEEDY( I )
128 10 CONTINUE
129 *
130 * Test the error exits
131 *
132 IF( TSTERR )
133 $ CALL ZERRVX( PATH, NOUT )
134 INFOT = 0
135 *
136 DO 140 IN = 1, NN
137 *
138 * Do for each value of N in NVAL.
139 *
140 N = NVAL( IN )
141 M = MAX( N-1, 0 )
142 LDA = MAX( 1, N )
143 NIMAT = NTYPES
144 IF( N.LE.0 )
145 $ NIMAT = 1
146 *
147 DO 130 IMAT = 1, NIMAT
148 *
149 * Do the tests only if DOTYPE( IMAT ) is true.
150 *
151 IF( .NOT.DOTYPE( IMAT ) )
152 $ GO TO 130
153 *
154 * Set up parameters with ZLATB4.
155 *
156 CALL ZLATB4( PATH, IMAT, N, N, TYPE, KL, KU, ANORM, MODE,
157 $ COND, DIST )
158 *
159 ZEROT = IMAT.GE.8 .AND. IMAT.LE.10
160 IF( IMAT.LE.6 ) THEN
161 *
162 * Types 1-6: generate matrices of known condition number.
163 *
164 KOFF = MAX( 2-KU, 3-MAX( 1, N ) )
165 SRNAMT = 'ZLATMS'
166 CALL ZLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE, COND,
167 $ ANORM, KL, KU, 'Z', AF( KOFF ), 3, WORK,
168 $ INFO )
169 *
170 * Check the error code from ZLATMS.
171 *
172 IF( INFO.NE.0 ) THEN
173 CALL ALAERH( PATH, 'ZLATMS', INFO, 0, ' ', N, N, KL,
174 $ KU, -1, IMAT, NFAIL, NERRS, NOUT )
175 GO TO 130
176 END IF
177 IZERO = 0
178 *
179 IF( N.GT.1 ) THEN
180 CALL ZCOPY( N-1, AF( 4 ), 3, A, 1 )
181 CALL ZCOPY( N-1, AF( 3 ), 3, A( N+M+1 ), 1 )
182 END IF
183 CALL ZCOPY( N, AF( 2 ), 3, A( M+1 ), 1 )
184 ELSE
185 *
186 * Types 7-12: generate tridiagonal matrices with
187 * unknown condition numbers.
188 *
189 IF( .NOT.ZEROT .OR. .NOT.DOTYPE( 7 ) ) THEN
190 *
191 * Generate a matrix with elements from [-1,1].
192 *
193 CALL ZLARNV( 2, ISEED, N+2*M, A )
194 IF( ANORM.NE.ONE )
195 $ CALL ZDSCAL( N+2*M, ANORM, A, 1 )
196 ELSE IF( IZERO.GT.0 ) THEN
197 *
198 * Reuse the last matrix by copying back the zeroed out
199 * elements.
200 *
201 IF( IZERO.EQ.1 ) THEN
202 A( N ) = Z( 2 )
203 IF( N.GT.1 )
204 $ A( 1 ) = Z( 3 )
205 ELSE IF( IZERO.EQ.N ) THEN
206 A( 3*N-2 ) = Z( 1 )
207 A( 2*N-1 ) = Z( 2 )
208 ELSE
209 A( 2*N-2+IZERO ) = Z( 1 )
210 A( N-1+IZERO ) = Z( 2 )
211 A( IZERO ) = Z( 3 )
212 END IF
213 END IF
214 *
215 * If IMAT > 7, set one column of the matrix to 0.
216 *
217 IF( .NOT.ZEROT ) THEN
218 IZERO = 0
219 ELSE IF( IMAT.EQ.8 ) THEN
220 IZERO = 1
221 Z( 2 ) = A( N )
222 A( N ) = ZERO
223 IF( N.GT.1 ) THEN
224 Z( 3 ) = A( 1 )
225 A( 1 ) = ZERO
226 END IF
227 ELSE IF( IMAT.EQ.9 ) THEN
228 IZERO = N
229 Z( 1 ) = A( 3*N-2 )
230 Z( 2 ) = A( 2*N-1 )
231 A( 3*N-2 ) = ZERO
232 A( 2*N-1 ) = ZERO
233 ELSE
234 IZERO = ( N+1 ) / 2
235 DO 20 I = IZERO, N - 1
236 A( 2*N-2+I ) = ZERO
237 A( N-1+I ) = ZERO
238 A( I ) = ZERO
239 20 CONTINUE
240 A( 3*N-2 ) = ZERO
241 A( 2*N-1 ) = ZERO
242 END IF
243 END IF
244 *
245 DO 120 IFACT = 1, 2
246 IF( IFACT.EQ.1 ) THEN
247 FACT = 'F'
248 ELSE
249 FACT = 'N'
250 END IF
251 *
252 * Compute the condition number for comparison with
253 * the value returned by ZGTSVX.
254 *
255 IF( ZEROT ) THEN
256 IF( IFACT.EQ.1 )
257 $ GO TO 120
258 RCONDO = ZERO
259 RCONDI = ZERO
260 *
261 ELSE IF( IFACT.EQ.1 ) THEN
262 CALL ZCOPY( N+2*M, A, 1, AF, 1 )
263 *
264 * Compute the 1-norm and infinity-norm of A.
265 *
266 ANORMO = ZLANGT( '1', N, A, A( M+1 ), A( N+M+1 ) )
267 ANORMI = ZLANGT( 'I', N, A, A( M+1 ), A( N+M+1 ) )
268 *
269 * Factor the matrix A.
270 *
271 CALL ZGTTRF( N, AF, AF( M+1 ), AF( N+M+1 ),
272 $ AF( N+2*M+1 ), IWORK, INFO )
273 *
274 * Use ZGTTRS to solve for one column at a time of
275 * inv(A), computing the maximum column sum as we go.
276 *
277 AINVNM = ZERO
278 DO 40 I = 1, N
279 DO 30 J = 1, N
280 X( J ) = ZERO
281 30 CONTINUE
282 X( I ) = ONE
283 CALL ZGTTRS( 'No transpose', N, 1, AF, AF( M+1 ),
284 $ AF( N+M+1 ), AF( N+2*M+1 ), IWORK, X,
285 $ LDA, INFO )
286 AINVNM = MAX( AINVNM, DZASUM( N, X, 1 ) )
287 40 CONTINUE
288 *
289 * Compute the 1-norm condition number of A.
290 *
291 IF( ANORMO.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN
292 RCONDO = ONE
293 ELSE
294 RCONDO = ( ONE / ANORMO ) / AINVNM
295 END IF
296 *
297 * Use ZGTTRS to solve for one column at a time of
298 * inv(A'), computing the maximum column sum as we go.
299 *
300 AINVNM = ZERO
301 DO 60 I = 1, N
302 DO 50 J = 1, N
303 X( J ) = ZERO
304 50 CONTINUE
305 X( I ) = ONE
306 CALL ZGTTRS( 'Conjugate transpose', N, 1, AF,
307 $ AF( M+1 ), AF( N+M+1 ), AF( N+2*M+1 ),
308 $ IWORK, X, LDA, INFO )
309 AINVNM = MAX( AINVNM, DZASUM( N, X, 1 ) )
310 60 CONTINUE
311 *
312 * Compute the infinity-norm condition number of A.
313 *
314 IF( ANORMI.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN
315 RCONDI = ONE
316 ELSE
317 RCONDI = ( ONE / ANORMI ) / AINVNM
318 END IF
319 END IF
320 *
321 DO 110 ITRAN = 1, 3
322 TRANS = TRANSS( ITRAN )
323 IF( ITRAN.EQ.1 ) THEN
324 RCONDC = RCONDO
325 ELSE
326 RCONDC = RCONDI
327 END IF
328 *
329 * Generate NRHS random solution vectors.
330 *
331 IX = 1
332 DO 70 J = 1, NRHS
333 CALL ZLARNV( 2, ISEED, N, XACT( IX ) )
334 IX = IX + LDA
335 70 CONTINUE
336 *
337 * Set the right hand side.
338 *
339 CALL ZLAGTM( TRANS, N, NRHS, ONE, A, A( M+1 ),
340 $ A( N+M+1 ), XACT, LDA, ZERO, B, LDA )
341 *
342 IF( IFACT.EQ.2 .AND. ITRAN.EQ.1 ) THEN
343 *
344 * --- Test ZGTSV ---
345 *
346 * Solve the system using Gaussian elimination with
347 * partial pivoting.
348 *
349 CALL ZCOPY( N+2*M, A, 1, AF, 1 )
350 CALL ZLACPY( 'Full', N, NRHS, B, LDA, X, LDA )
351 *
352 SRNAMT = 'ZGTSV '
353 CALL ZGTSV( N, NRHS, AF, AF( M+1 ), AF( N+M+1 ), X,
354 $ LDA, INFO )
355 *
356 * Check error code from ZGTSV .
357 *
358 IF( INFO.NE.IZERO )
359 $ CALL ALAERH( PATH, 'ZGTSV ', INFO, IZERO, ' ',
360 $ N, N, 1, 1, NRHS, IMAT, NFAIL,
361 $ NERRS, NOUT )
362 NT = 1
363 IF( IZERO.EQ.0 ) THEN
364 *
365 * Check residual of computed solution.
366 *
367 CALL ZLACPY( 'Full', N, NRHS, B, LDA, WORK,
368 $ LDA )
369 CALL ZGTT02( TRANS, N, NRHS, A, A( M+1 ),
370 $ A( N+M+1 ), X, LDA, WORK, LDA,
371 $ RWORK, RESULT( 2 ) )
372 *
373 * Check solution from generated exact solution.
374 *
375 CALL ZGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC,
376 $ RESULT( 3 ) )
377 NT = 3
378 END IF
379 *
380 * Print information about the tests that did not pass
381 * the threshold.
382 *
383 DO 80 K = 2, NT
384 IF( RESULT( K ).GE.THRESH ) THEN
385 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
386 $ CALL ALADHD( NOUT, PATH )
387 WRITE( NOUT, FMT = 9999 )'ZGTSV ', N, IMAT,
388 $ K, RESULT( K )
389 NFAIL = NFAIL + 1
390 END IF
391 80 CONTINUE
392 NRUN = NRUN + NT - 1
393 END IF
394 *
395 * --- Test ZGTSVX ---
396 *
397 IF( IFACT.GT.1 ) THEN
398 *
399 * Initialize AF to zero.
400 *
401 DO 90 I = 1, 3*N - 2
402 AF( I ) = ZERO
403 90 CONTINUE
404 END IF
405 CALL ZLASET( 'Full', N, NRHS, DCMPLX( ZERO ),
406 $ DCMPLX( ZERO ), X, LDA )
407 *
408 * Solve the system and compute the condition number and
409 * error bounds using ZGTSVX.
410 *
411 SRNAMT = 'ZGTSVX'
412 CALL ZGTSVX( FACT, TRANS, N, NRHS, A, A( M+1 ),
413 $ A( N+M+1 ), AF, AF( M+1 ), AF( N+M+1 ),
414 $ AF( N+2*M+1 ), IWORK, B, LDA, X, LDA,
415 $ RCOND, RWORK, RWORK( NRHS+1 ), WORK,
416 $ RWORK( 2*NRHS+1 ), INFO )
417 *
418 * Check the error code from ZGTSVX.
419 *
420 IF( INFO.NE.IZERO )
421 $ CALL ALAERH( PATH, 'ZGTSVX', INFO, IZERO,
422 $ FACT // TRANS, N, N, 1, 1, NRHS, IMAT,
423 $ NFAIL, NERRS, NOUT )
424 *
425 IF( IFACT.GE.2 ) THEN
426 *
427 * Reconstruct matrix from factors and compute
428 * residual.
429 *
430 CALL ZGTT01( N, A, A( M+1 ), A( N+M+1 ), AF,
431 $ AF( M+1 ), AF( N+M+1 ), AF( N+2*M+1 ),
432 $ IWORK, WORK, LDA, RWORK, RESULT( 1 ) )
433 K1 = 1
434 ELSE
435 K1 = 2
436 END IF
437 *
438 IF( INFO.EQ.0 ) THEN
439 TRFCON = .FALSE.
440 *
441 * Check residual of computed solution.
442 *
443 CALL ZLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA )
444 CALL ZGTT02( TRANS, N, NRHS, A, A( M+1 ),
445 $ A( N+M+1 ), X, LDA, WORK, LDA, RWORK,
446 $ RESULT( 2 ) )
447 *
448 * Check solution from generated exact solution.
449 *
450 CALL ZGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC,
451 $ RESULT( 3 ) )
452 *
453 * Check the error bounds from iterative refinement.
454 *
455 CALL ZGTT05( TRANS, N, NRHS, A, A( M+1 ),
456 $ A( N+M+1 ), B, LDA, X, LDA, XACT, LDA,
457 $ RWORK, RWORK( NRHS+1 ), RESULT( 4 ) )
458 NT = 5
459 END IF
460 *
461 * Print information about the tests that did not pass
462 * the threshold.
463 *
464 DO 100 K = K1, NT
465 IF( RESULT( K ).GE.THRESH ) THEN
466 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
467 $ CALL ALADHD( NOUT, PATH )
468 WRITE( NOUT, FMT = 9998 )'ZGTSVX', FACT, TRANS,
469 $ N, IMAT, K, RESULT( K )
470 NFAIL = NFAIL + 1
471 END IF
472 100 CONTINUE
473 *
474 * Check the reciprocal of the condition number.
475 *
476 RESULT( 6 ) = DGET06( RCOND, RCONDC )
477 IF( RESULT( 6 ).GE.THRESH ) THEN
478 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
479 $ CALL ALADHD( NOUT, PATH )
480 WRITE( NOUT, FMT = 9998 )'ZGTSVX', FACT, TRANS, N,
481 $ IMAT, K, RESULT( K )
482 NFAIL = NFAIL + 1
483 END IF
484 NRUN = NRUN + NT - K1 + 2
485 *
486 110 CONTINUE
487 120 CONTINUE
488 130 CONTINUE
489 140 CONTINUE
490 *
491 * Print a summary of the results.
492 *
493 CALL ALASVM( PATH, NOUT, NFAIL, NRUN, NERRS )
494 *
495 9999 FORMAT( 1X, A, ', N =', I5, ', type ', I2, ', test ', I2,
496 $ ', ratio = ', G12.5 )
497 9998 FORMAT( 1X, A, ', FACT=''', A1, ''', TRANS=''', A1, ''', N =',
498 $ I5, ', type ', I2, ', test ', I2, ', ratio = ', G12.5 )
499 RETURN
500 *
501 * End of ZDRVGT
502 *
503 END