OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
cchkgb.f
Go to the documentation of this file.
1*> \brief \b CCHKGB
2*
3* =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6* http://www.netlib.org/lapack/explore-html/
7*
8* Definition:
9* ===========
10*
11* SUBROUTINE CCHKGB( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NNS,
12* NSVAL, THRESH, TSTERR, A, LA, AFAC, LAFAC, B,
13* X, XACT, WORK, RWORK, IWORK, NOUT )
14*
15* .. Scalar Arguments ..
16* LOGICAL TSTERR
17* INTEGER LA, LAFAC, NM, NN, NNB, NNS, NOUT
18* REAL THRESH
19* ..
20* .. Array Arguments ..
21* LOGICAL DOTYPE( * )
22* INTEGER IWORK( * ), MVAL( * ), NBVAL( * ), NSVAL( * ),
23* $ NVAL( * )
24* REAL RWORK( * )
25* COMPLEX A( * ), AFAC( * ), B( * ), WORK( * ), X( * ),
26* $ XACT( * )
27* ..
28*
29*
30*> \par Purpose:
31* =============
32*>
33*> \verbatim
34*>
35*> CCHKGB tests CGBTRF, -TRS, -RFS, and -CON
36*> \endverbatim
37*
38* Arguments:
39* ==========
40*
41*> \param[in] DOTYPE
42*> \verbatim
43*> DOTYPE is LOGICAL array, dimension (NTYPES)
44*> The matrix types to be used for testing. Matrices of type j
45*> (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) =
46*> .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used.
47*> \endverbatim
48*>
49*> \param[in] NM
50*> \verbatim
51*> NM is INTEGER
52*> The number of values of M contained in the vector MVAL.
53*> \endverbatim
54*>
55*> \param[in] MVAL
56*> \verbatim
57*> MVAL is INTEGER array, dimension (NM)
58*> The values of the matrix row dimension M.
59*> \endverbatim
60*>
61*> \param[in] NN
62*> \verbatim
63*> NN is INTEGER
64*> The number of values of N contained in the vector NVAL.
65*> \endverbatim
66*>
67*> \param[in] NVAL
68*> \verbatim
69*> NVAL is INTEGER array, dimension (NN)
70*> The values of the matrix column dimension N.
71*> \endverbatim
72*>
73*> \param[in] NNB
74*> \verbatim
75*> NNB is INTEGER
76*> The number of values of NB contained in the vector NBVAL.
77*> \endverbatim
78*>
79*> \param[in] NBVAL
80*> \verbatim
81*> NBVAL is INTEGER array, dimension (NNB)
82*> The values of the blocksize NB.
83*> \endverbatim
84*>
85*> \param[in] NNS
86*> \verbatim
87*> NNS is INTEGER
88*> The number of values of NRHS contained in the vector NSVAL.
89*> \endverbatim
90*>
91*> \param[in] NSVAL
92*> \verbatim
93*> NSVAL is INTEGER array, dimension (NNS)
94*> The values of the number of right hand sides NRHS.
95*> \endverbatim
96*>
97*> \param[in] THRESH
98*> \verbatim
99*> THRESH is REAL
100*> The threshold value for the test ratios. A result is
101*> included in the output file if RESULT >= THRESH. To have
102*> every test ratio printed, use THRESH = 0.
103*> \endverbatim
104*>
105*> \param[in] TSTERR
106*> \verbatim
107*> TSTERR is LOGICAL
108*> Flag that indicates whether error exits are to be tested.
109*> \endverbatim
110*>
111*> \param[out] A
112*> \verbatim
113*> A is COMPLEX array, dimension (LA)
114*> \endverbatim
115*>
116*> \param[in] LA
117*> \verbatim
118*> LA is INTEGER
119*> The length of the array A. LA >= (KLMAX+KUMAX+1)*NMAX
120*> where KLMAX is the largest entry in the local array KLVAL,
121*> KUMAX is the largest entry in the local array KUVAL and
122*> NMAX is the largest entry in the input array NVAL.
123*> \endverbatim
124*>
125*> \param[out] AFAC
126*> \verbatim
127*> AFAC is COMPLEX array, dimension (LAFAC)
128*> \endverbatim
129*>
130*> \param[in] LAFAC
131*> \verbatim
132*> LAFAC is INTEGER
133*> The length of the array AFAC. LAFAC >= (2*KLMAX+KUMAX+1)*NMAX
134*> where KLMAX is the largest entry in the local array KLVAL,
135*> KUMAX is the largest entry in the local array KUVAL and
136*> NMAX is the largest entry in the input array NVAL.
137*> \endverbatim
138*>
139*> \param[out] B
140*> \verbatim
141*> B is COMPLEX array, dimension (NMAX*NSMAX)
142*> \endverbatim
143*>
144*> \param[out] X
145*> \verbatim
146*> X is COMPLEX array, dimension (NMAX*NSMAX)
147*> \endverbatim
148*>
149*> \param[out] XACT
150*> \verbatim
151*> XACT is COMPLEX array, dimension (NMAX*NSMAX)
152*> \endverbatim
153*>
154*> \param[out] WORK
155*> \verbatim
156*> WORK is COMPLEX array, dimension
157*> (NMAX*max(3,NSMAX,NMAX))
158*> \endverbatim
159*>
160*> \param[out] RWORK
161*> \verbatim
162*> RWORK is REAL array, dimension
163*> (NMAX+2*NSMAX)
164*> \endverbatim
165*>
166*> \param[out] IWORK
167*> \verbatim
168*> IWORK is INTEGER array, dimension (NMAX)
169*> \endverbatim
170*>
171*> \param[in] NOUT
172*> \verbatim
173*> NOUT is INTEGER
174*> The unit number for output.
175*> \endverbatim
176*
177* Authors:
178* ========
179*
180*> \author Univ. of Tennessee
181*> \author Univ. of California Berkeley
182*> \author Univ. of Colorado Denver
183*> \author NAG Ltd.
184*
185*> \ingroup complex_lin
186*
187* =====================================================================
188 SUBROUTINE cchkgb( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NNS,
189 $ NSVAL, THRESH, TSTERR, A, LA, AFAC, LAFAC, B,
190 $ X, XACT, WORK, RWORK, IWORK, NOUT )
191*
192* -- LAPACK test routine --
193* -- LAPACK is a software package provided by Univ. of Tennessee, --
194* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
195*
196* .. Scalar Arguments ..
197 LOGICAL TSTERR
198 INTEGER LA, LAFAC, NM, NN, NNB, NNS, NOUT
199 REAL THRESH
200* ..
201* .. Array Arguments ..
202 LOGICAL DOTYPE( * )
203 INTEGER IWORK( * ), MVAL( * ), NBVAL( * ), NSVAL( * ),
204 $ nval( * )
205 REAL RWORK( * )
206 COMPLEX A( * ), AFAC( * ), B( * ), WORK( * ), X( * ),
207 $ xact( * )
208* ..
209*
210* =====================================================================
211*
212* .. Parameters ..
213 REAL ONE, ZERO
214 PARAMETER ( ONE = 1.0e+0, zero = 0.0e+0 )
215 INTEGER NTYPES, NTESTS
216 parameter( ntypes = 8, ntests = 7 )
217 INTEGER NBW, NTRAN
218 parameter( nbw = 4, ntran = 3 )
219* ..
220* .. Local Scalars ..
221 LOGICAL TRFCON, ZEROT
222 CHARACTER DIST, NORM, TRANS, TYPE, XTYPE
223 CHARACTER*3 PATH
224 INTEGER I, I1, I2, IKL, IKU, IM, IMAT, IN, INB, INFO,
225 $ ioff, irhs, itran, izero, j, k, kl, koff, ku,
226 $ lda, ldafac, ldb, m, mode, n, nb, nerrs, nfail,
227 $ nimat, nkl, nku, nrhs, nrun
228 REAL AINVNM, ANORM, ANORMI, ANORMO, CNDNUM, RCOND,
229 $ RCONDC, RCONDI, RCONDO
230* ..
231* .. Local Arrays ..
232 CHARACTER TRANSS( NTRAN )
233 INTEGER ISEED( 4 ), ISEEDY( 4 ), KLVAL( NBW ),
234 $ kuval( nbw )
235 REAL RESULT( NTESTS )
236* ..
237* .. External Functions ..
238 REAL CLANGB, CLANGE, SGET06
239 EXTERNAL CLANGB, CLANGE, SGET06
240* ..
241* .. External Subroutines ..
242 EXTERNAL alaerh, alahd, alasum, ccopy, cerrge, cgbcon,
243 $ cgbrfs, cgbt01, cgbt02, cgbt05, cgbtrf, cgbtrs,
244 $ cget04, clacpy, clarhs, claset, clatb4, clatms,
245 $ xlaenv
246* ..
247* .. Intrinsic Functions ..
248 INTRINSIC cmplx, max, min
249* ..
250* .. Scalars in Common ..
251 LOGICAL LERR, OK
252 CHARACTER*32 SRNAMT
253 INTEGER INFOT, NUNIT
254* ..
255* .. Common blocks ..
256 COMMON / infoc / infot, nunit, ok, lerr
257 COMMON / srnamc / srnamt
258* ..
259* .. Data statements ..
260 DATA iseedy / 1988, 1989, 1990, 1991 / ,
261 $ transs / 'n', 't', 'c' /
262* ..
263* .. Executable Statements ..
264*
265* Initialize constants and the random number seed.
266*
267 PATH( 1: 1 ) = 'Complex precision'
268 PATH( 2: 3 ) = 'GB'
269 NRUN = 0
270 NFAIL = 0
271 NERRS = 0
272 DO 10 I = 1, 4
273 ISEED( I ) = ISEEDY( I )
274 10 CONTINUE
275*
276* Test the error exits
277*
278 IF( TSTERR )
279 $ CALL CERRGE( PATH, NOUT )
280 INFOT = 0
281*
282* Initialize the first value for the lower and upper bandwidths.
283*
284 KLVAL( 1 ) = 0
285 KUVAL( 1 ) = 0
286*
287* Do for each value of M in MVAL
288*
289 DO 160 IM = 1, NM
290 M = MVAL( IM )
291*
292* Set values to use for the lower bandwidth.
293*
294 KLVAL( 2 ) = M + ( M+1 ) / 4
295*
296* KLVAL( 2 ) = MAX( M-1, 0 )
297*
298 KLVAL( 3 ) = ( 3*M-1 ) / 4
299 KLVAL( 4 ) = ( M+1 ) / 4
300*
301* Do for each value of N in NVAL
302*
303 DO 150 IN = 1, NN
304 N = NVAL( IN )
305 XTYPE = 'N'
306*
307* Set values to use for the upper bandwidth.
308*
309 KUVAL( 2 ) = N + ( N+1 ) / 4
310*
311* KUVAL( 2 ) = MAX( N-1, 0 )
312*
313 KUVAL( 3 ) = ( 3*N-1 ) / 4
314 KUVAL( 4 ) = ( N+1 ) / 4
315*
316* Set limits on the number of loop iterations.
317*
318 NKL = MIN( M+1, 4 )
319.EQ. IF( N0 )
320 $ NKL = 2
321 NKU = MIN( N+1, 4 )
322.EQ. IF( M0 )
323 $ NKU = 2
324 NIMAT = NTYPES
325.LE..OR..LE. IF( M0 N0 )
326 $ NIMAT = 1
327*
328 DO 140 IKL = 1, NKL
329*
330* Do for KL = 0, (5*M+1)/4, (3M-1)/4, and (M+1)/4. This
331* order makes it easier to skip redundant values for small
332* values of M.
333*
334 KL = KLVAL( IKL )
335 DO 130 IKU = 1, NKU
336*
337* Do for KU = 0, (5*N+1)/4, (3N-1)/4, and (N+1)/4. This
338* order makes it easier to skip redundant values for
339* small values of N.
340*
341 KU = KUVAL( IKU )
342*
343* Check that A and AFAC are big enough to generate this
344* matrix.
345*
346 LDA = KL + KU + 1
347 LDAFAC = 2*KL + KU + 1
348.GT..OR..GT. IF( ( LDA*N )LA ( LDAFAC*N )LAFAC ) THEN
349.EQ..AND..EQ. IF( NFAIL0 NERRS0 )
350 $ CALL ALAHD( NOUT, PATH )
351.GT. IF( N*( KL+KU+1 )LA ) THEN
352 WRITE( NOUT, FMT = 9999 )LA, M, N, KL, KU,
353 $ N*( KL+KU+1 )
354 NERRS = NERRS + 1
355 END IF
356.GT. IF( N*( 2*KL+KU+1 )LAFAC ) THEN
357 WRITE( NOUT, FMT = 9998 )LAFAC, M, N, KL, KU,
358 $ N*( 2*KL+KU+1 )
359 NERRS = NERRS + 1
360 END IF
361 GO TO 130
362 END IF
363*
364 DO 120 IMAT = 1, NIMAT
365*
366* Do the tests only if DOTYPE( IMAT ) is true.
367*
368.NOT. IF( DOTYPE( IMAT ) )
369 $ GO TO 120
370*
371* Skip types 2, 3, or 4 if the matrix size is too
372* small.
373*
374.GE..AND..LE. ZEROT = IMAT2 IMAT4
375.AND..LT. IF( ZEROT NIMAT-1 )
376 $ GO TO 120
377*
378.NOT..OR..NOT. IF( ZEROT DOTYPE( 1 ) ) THEN
379*
380* Set up parameters with CLATB4 and generate a
381* test matrix with CLATMS.
382*
383 CALL CLATB4( PATH, IMAT, M, N, TYPE, KL, KU,
384 $ ANORM, MODE, CNDNUM, DIST )
385*
386 KOFF = MAX( 1, KU+2-N )
387 DO 20 I = 1, KOFF - 1
388 A( I ) = ZERO
389 20 CONTINUE
390 SRNAMT = 'CLATMS'
391 CALL CLATMS( M, N, DIST, ISEED, TYPE, RWORK,
392 $ MODE, CNDNUM, ANORM, KL, KU, 'Z',
393 $ A( KOFF ), LDA, WORK, INFO )
394*
395* Check the error code from CLATMS.
396*
397.NE. IF( INFO0 ) THEN
398 CALL ALAERH( PATH, 'CLATMS', INFO, 0, ' ', M,
399 $ N, KL, KU, -1, IMAT, NFAIL,
400 $ NERRS, NOUT )
401 GO TO 120
402 END IF
403.GT. ELSE IF( IZERO0 ) THEN
404*
405* Use the same matrix for types 3 and 4 as for
406* type 2 by copying back the zeroed out column.
407*
408 CALL CCOPY( I2-I1+1, B, 1, A( IOFF+I1 ), 1 )
409 END IF
410*
411* For types 2, 3, and 4, zero one or more columns of
412* the matrix to test that INFO is returned correctly.
413*
414 IZERO = 0
415 IF( ZEROT ) THEN
416.EQ. IF( IMAT2 ) THEN
417 IZERO = 1
418.EQ. ELSE IF( IMAT3 ) THEN
419 IZERO = MIN( M, N )
420 ELSE
421 IZERO = MIN( M, N ) / 2 + 1
422 END IF
423 IOFF = ( IZERO-1 )*LDA
424.LT. IF( IMAT4 ) THEN
425*
426* Store the column to be zeroed out in B.
427*
428 I1 = MAX( 1, KU+2-IZERO )
429 I2 = MIN( KL+KU+1, KU+1+( M-IZERO ) )
430 CALL CCOPY( I2-I1+1, A( IOFF+I1 ), 1, B, 1 )
431*
432 DO 30 I = I1, I2
433 A( IOFF+I ) = ZERO
434 30 CONTINUE
435 ELSE
436 DO 50 J = IZERO, N
437 DO 40 I = MAX( 1, KU+2-J ),
438 $ MIN( KL+KU+1, KU+1+( M-J ) )
439 A( IOFF+I ) = ZERO
440 40 CONTINUE
441 IOFF = IOFF + LDA
442 50 CONTINUE
443 END IF
444 END IF
445*
446* These lines, if used in place of the calls in the
447* loop over INB, cause the code to bomb on a Sun
448* SPARCstation.
449*
450* ANORMO = CLANGB( 'O', N, KL, KU, A, LDA, RWORK )
451* ANORMI = CLANGB( 'I', N, KL, KU, A, LDA, RWORK )
452*
453* Do for each blocksize in NBVAL
454*
455 DO 110 INB = 1, NNB
456 NB = NBVAL( INB )
457 CALL XLAENV( 1, NB )
458*
459* Compute the LU factorization of the band matrix.
460*
461.GT..AND..GT. IF( M0 N0 )
462 $ CALL CLACPY( 'Full', KL+KU+1, N, A, LDA,
463 $ AFAC( KL+1 ), LDAFAC )
464 SRNAMT = 'CGBTRF'
465 CALL CGBTRF( M, N, KL, KU, AFAC, LDAFAC, IWORK,
466 $ INFO )
467*
468* Check error code from CGBTRF.
469*
470.NE. IF( INFOIZERO )
471 $ CALL ALAERH( PATH, 'CGBTRF', INFO, IZERO,
472 $ ' ', M, N, KL, KU, NB, IMAT,
473 $ NFAIL, NERRS, NOUT )
474 TRFCON = .FALSE.
475*
476*+ TEST 1
477* Reconstruct matrix from factors and compute
478* residual.
479*
480 CALL CGBT01( M, N, KL, KU, A, LDA, AFAC, LDAFAC,
481 $ IWORK, WORK, RESULT( 1 ) )
482*
483* Print information about the tests so far that
484* did not pass the threshold.
485*
486.GE. IF( RESULT( 1 )THRESH ) THEN
487.EQ..AND..EQ. IF( NFAIL0 NERRS0 )
488 $ CALL ALAHD( NOUT, PATH )
489 WRITE( NOUT, FMT = 9997 )M, N, KL, KU, NB,
490 $ IMAT, 1, RESULT( 1 )
491 NFAIL = NFAIL + 1
492 END IF
493 NRUN = NRUN + 1
494*
495* Skip the remaining tests if this is not the
496* first block size or if M .ne. N.
497*
498.GT..OR..NE. IF( INB1 MN )
499 $ GO TO 110
500*
501 ANORMO = CLANGB( 'O', N, KL, KU, A, LDA, RWORK )
502 ANORMI = CLANGB( 'I', N, KL, KU, A, LDA, RWORK )
503*
504.EQ. IF( INFO0 ) THEN
505*
506* Form the inverse of A so we can get a good
507* estimate of CNDNUM = norm(A) * norm(inv(A)).
508*
509 LDB = MAX( 1, N )
510 CALL CLASET( 'Full', N, N, CMPLX( ZERO ),
511 $ CMPLX( ONE ), WORK, LDB )
512 SRNAMT = 'CGBTRS'
513 CALL CGBTRS( 'No transpose', N, KL, KU, N,
514 $ AFAC, LDAFAC, IWORK, WORK, LDB,
515 $ INFO )
516*
517* Compute the 1-norm condition number of A.
518*
519 AINVNM = CLANGE( 'O', N, N, WORK, LDB,
520 $ RWORK )
521.LE..OR..LE. IF( ANORMOZERO AINVNMZERO ) THEN
522 RCONDO = ONE
523 ELSE
524 RCONDO = ( ONE / ANORMO ) / AINVNM
525 END IF
526*
527* Compute the infinity-norm condition number of
528* A.
529*
530 AINVNM = CLANGE( 'I', N, N, WORK, LDB,
531 $ RWORK )
532.LE..OR..LE. IF( ANORMIZERO AINVNMZERO ) THEN
533 RCONDI = ONE
534 ELSE
535 RCONDI = ( ONE / ANORMI ) / AINVNM
536 END IF
537 ELSE
538*
539* Do only the condition estimate if INFO.NE.0.
540*
541 TRFCON = .TRUE.
542 RCONDO = ZERO
543 RCONDI = ZERO
544 END IF
545*
546* Skip the solve tests if the matrix is singular.
547*
548 IF( TRFCON )
549 $ GO TO 90
550*
551 DO 80 IRHS = 1, NNS
552 NRHS = NSVAL( IRHS )
553 XTYPE = 'N'
554*
555 DO 70 ITRAN = 1, NTRAN
556 TRANS = TRANSS( ITRAN )
557.EQ. IF( ITRAN1 ) THEN
558 RCONDC = RCONDO
559 NORM = 'O'
560 ELSE
561 RCONDC = RCONDI
562 NORM = 'I'
563 END IF
564*
565*+ TEST 2:
566* Solve and compute residual for op(A) * X = B.
567*
568 SRNAMT = 'CLARHS'
569 CALL CLARHS( PATH, XTYPE, ' ', TRANS, N,
570 $ N, KL, KU, NRHS, A, LDA,
571 $ XACT, LDB, B, LDB, ISEED,
572 $ INFO )
573 XTYPE = 'C'
574 CALL CLACPY( 'Full', N, NRHS, B, LDB, X,
575 $ LDB )
576*
577 SRNAMT = 'CGBTRS'
578 CALL CGBTRS( TRANS, N, KL, KU, NRHS, AFAC,
579 $ LDAFAC, IWORK, X, LDB, INFO )
580*
581* Check error code from CGBTRS.
582*
583.NE. IF( INFO0 )
584 $ CALL ALAERH( PATH, 'CGBTRS', INFO, 0,
585 $ TRANS, N, N, KL, KU, -1,
586 $ IMAT, NFAIL, NERRS, NOUT )
587*
588 CALL CLACPY( 'Full', N, NRHS, B, LDB,
589 $ WORK, LDB )
590 CALL CGBT02( TRANS, M, N, KL, KU, NRHS, A,
591 $ LDA, X, LDB, WORK, LDB,
592 $ RWORK, RESULT( 2 ) )
593*
594*+ TEST 3:
595* Check solution from generated exact
596* solution.
597*
598 CALL CGET04( N, NRHS, X, LDB, XACT, LDB,
599 $ RCONDC, RESULT( 3 ) )
600*
601*+ TESTS 4, 5, 6:
602* Use iterative refinement to improve the
603* solution.
604*
605 SRNAMT = 'CGBRFS'
606 CALL CGBRFS( TRANS, N, KL, KU, NRHS, A,
607 $ LDA, AFAC, LDAFAC, IWORK, B,
608 $ LDB, X, LDB, RWORK,
609 $ RWORK( NRHS+1 ), WORK,
610 $ RWORK( 2*NRHS+1 ), INFO )
611*
612* Check error code from CGBRFS.
613*
614.NE. IF( INFO0 )
615 $ CALL ALAERH( PATH, 'CGBRFS', INFO, 0,
616 $ TRANS, N, N, KL, KU, NRHS,
617 $ IMAT, NFAIL, NERRS, NOUT )
618*
619 CALL CGET04( N, NRHS, X, LDB, XACT, LDB,
620 $ RCONDC, RESULT( 4 ) )
621 CALL CGBT05( TRANS, N, KL, KU, NRHS, A,
622 $ LDA, B, LDB, X, LDB, XACT,
623 $ LDB, RWORK, RWORK( NRHS+1 ),
624 $ RESULT( 5 ) )
625*
626* Print information about the tests that did
627* not pass the threshold.
628*
629 DO 60 K = 2, 6
630.GE. IF( RESULT( K )THRESH ) THEN
631.EQ..AND..EQ. IF( NFAIL0 NERRS0 )
632 $ CALL ALAHD( NOUT, PATH )
633 WRITE( NOUT, FMT = 9996 )TRANS, N,
634 $ KL, KU, NRHS, IMAT, K,
635 $ RESULT( K )
636 NFAIL = NFAIL + 1
637 END IF
638 60 CONTINUE
639 NRUN = NRUN + 5
640 70 CONTINUE
641 80 CONTINUE
642*
643*+ TEST 7:
644* Get an estimate of RCOND = 1/CNDNUM.
645*
646 90 CONTINUE
647 DO 100 ITRAN = 1, 2
648.EQ. IF( ITRAN1 ) THEN
649 ANORM = ANORMO
650 RCONDC = RCONDO
651 NORM = 'O'
652 ELSE
653 ANORM = ANORMI
654 RCONDC = RCONDI
655 NORM = 'I'
656 END IF
657 SRNAMT = 'CGBCON'
658 CALL CGBCON( NORM, N, KL, KU, AFAC, LDAFAC,
659 $ IWORK, ANORM, RCOND, WORK,
660 $ RWORK, INFO )
661*
662* Check error code from CGBCON.
663*
664.NE. IF( INFO0 )
665 $ CALL ALAERH( PATH, 'CGBCON', INFO, 0,
666 $ NORM, N, N, KL, KU, -1, IMAT,
667 $ NFAIL, NERRS, NOUT )
668*
669 RESULT( 7 ) = SGET06( RCOND, RCONDC )
670*
671* Print information about the tests that did
672* not pass the threshold.
673*
674.GE. IF( RESULT( 7 )THRESH ) THEN
675.EQ..AND..EQ. IF( NFAIL0 NERRS0 )
676 $ CALL ALAHD( NOUT, PATH )
677 WRITE( NOUT, FMT = 9995 )NORM, N, KL, KU,
678 $ IMAT, 7, RESULT( 7 )
679 NFAIL = NFAIL + 1
680 END IF
681 NRUN = NRUN + 1
682 100 CONTINUE
683 110 CONTINUE
684 120 CONTINUE
685 130 CONTINUE
686 140 CONTINUE
687 150 CONTINUE
688 160 CONTINUE
689*
690* Print a summary of the results.
691*
692 CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS )
693*
694 9999 FORMAT( ' *** In CCHKGB, LA=', I5, ' is too small for m=', I5,
695 $ ', n=', I5, ', kl=', I4, ', ku=', I4,
696 $ / ' ==> increase la to at least ', I5 )
697 9998 FORMAT( ' *** in cchkgb, lafac=', I5, ' is too small for m=', I5,
698 $ ', n=', I5, ', kl=', I4, ', ku=', I4,
699 $ / ' ==> increase lafac to at least ', I5 )
700 9997 FORMAT( ' m =', I5, ', n =', I5, ', kl=', I5, ', ku=', I5,
701 $ ', nb =', I4, ', type ', I1, ', test(', I1, ')=', G12.5 )
702 9996 FORMAT( ' trans=''', A1, ''', n=', I5, ', kl=', I5, ', ku=', I5,
703 $ ', nrhs=', I3, ', type ', I1, ', test(', I1, ')=', G12.5 )
704 9995 FORMAT( ' norm =''', A1, ''', n=', I5, ', kl=', I5, ', ku=', I5,
705 $ ',', 10X, ' type ', I1, ', test(', I1, ')=', G12.5 )
706*
707 RETURN
708*
709* End of CCHKGB
710*
711 END
cmplx
float cmplx[2]
Definition pblas.h:136
xlaenv
subroutine xlaenv(ispec, nvalue)
XLAENV
Definition xlaenv.f:81
alasum
subroutine alasum(type, nout, nfail, nrun, nerrs)
ALASUM
Definition alasum.f:73
alahd
subroutine alahd(iounit, path)
ALAHD
Definition alahd.f:107
alaerh
subroutine alaerh(path, subnam, info, infoe, opts, m, n, kl, ku, n5, imat, nfail, nerrs, nout)
ALAERH
Definition alaerh.f:147
cgbrfs
subroutine cgbrfs(trans, n, kl, ku, nrhs, ab, ldab, afb, ldafb, ipiv, b, ldb, x, ldx, ferr, berr, work, rwork, info)
CGBRFS
Definition cgbrfs.f:206
cgbtrf
subroutine cgbtrf(m, n, kl, ku, ab, ldab, ipiv, info)
CGBTRF
Definition cgbtrf.f:144
cgbcon
subroutine cgbcon(norm, n, kl, ku, ab, ldab, ipiv, anorm, rcond, work, rwork, info)
CGBCON
Definition cgbcon.f:147
cgbtrs
subroutine cgbtrs(trans, n, kl, ku, nrhs, ab, ldab, ipiv, b, ldb, info)
CGBTRS
Definition cgbtrs.f:138
clacpy
subroutine clacpy(uplo, m, n, a, lda, b, ldb)
CLACPY copies all or part of one two-dimensional array to another.
Definition clacpy.f:103
claset
subroutine claset(uplo, m, n, alpha, beta, a, lda)
CLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values.
Definition claset.f:106
ccopy
subroutine ccopy(n, cx, incx, cy, incy)
CCOPY
Definition ccopy.f:81
clarhs
subroutine clarhs(path, xtype, uplo, trans, m, n, kl, ku, nrhs, a, lda, x, ldx, b, ldb, iseed, info)
CLARHS
Definition clarhs.f:208
cchkgb
subroutine cchkgb(dotype, nm, mval, nn, nval, nnb, nbval, nns, nsval, thresh, tsterr, a, la, afac, lafac, b, x, xact, work, rwork, iwork, nout)
CCHKGB
Definition cchkgb.f:191
cgbt01
subroutine cgbt01(m, n, kl, ku, a, lda, afac, ldafac, ipiv, work, resid)
CGBT01
Definition cgbt01.f:126
cgbt02
subroutine cgbt02(trans, m, n, kl, ku, nrhs, a, lda, x, ldx, b, ldb, rwork, resid)
CGBT02
Definition cgbt02.f:148
cgbt05
subroutine cgbt05(trans, n, kl, ku, nrhs, ab, ldab, b, ldb, x, ldx, xact, ldxact, ferr, berr, reslts)
CGBT05
Definition cgbt05.f:176
clatb4
subroutine clatb4(path, imat, m, n, type, kl, ku, anorm, mode, cndnum, dist)
CLATB4
Definition clatb4.f:121
cerrge
subroutine cerrge(path, nunit)
CERRGE
Definition cerrge.f:55
cget04
subroutine cget04(n, nrhs, x, ldx, xact, ldxact, rcond, resid)
CGET04
Definition cget04.f:102
clatms
subroutine clatms(m, n, dist, iseed, sym, d, mode, cond, dmax, kl, ku, pack, a, lda, work, info)
CLATMS
Definition clatms.f:332
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
for
for(i8=*sizetab-1;i8 >=0;i8--)
Definition mumps_common.c:91