00001 SUBROUTINE CCHKGB( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NNS,
00002 $ NSVAL, THRESH, TSTERR, A, LA, AFAC, LAFAC, B,
00003 $ X, XACT, WORK, RWORK, IWORK, NOUT )
00004
00005
00006
00007
00008
00009
00010 LOGICAL TSTERR
00011 INTEGER LA, LAFAC, NM, NN, NNB, NNS, NOUT
00012 REAL THRESH
00013
00014
00015 LOGICAL DOTYPE( * )
00016 INTEGER IWORK( * ), MVAL( * ), NBVAL( * ), NSVAL( * ),
00017 $ NVAL( * )
00018 REAL RWORK( * )
00019 COMPLEX A( * ), AFAC( * ), B( * ), WORK( * ), X( * ),
00020 $ XACT( * )
00021
00022
00023
00024
00025
00026
00027
00028
00029
00030
00031
00032
00033
00034
00035
00036
00037
00038
00039
00040
00041
00042
00043
00044
00045
00046
00047
00048
00049
00050
00051
00052
00053
00054
00055
00056
00057
00058
00059
00060
00061
00062
00063
00064
00065
00066
00067
00068
00069
00070
00071
00072
00073
00074
00075
00076
00077
00078
00079
00080
00081
00082
00083
00084
00085
00086
00087
00088
00089
00090
00091
00092
00093
00094
00095
00096
00097
00098
00099
00100
00101
00102
00103
00104 REAL ONE, ZERO
00105 PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
00106 INTEGER NTYPES, NTESTS
00107 PARAMETER ( NTYPES = 8, NTESTS = 7 )
00108 INTEGER NBW, NTRAN
00109 PARAMETER ( NBW = 4, NTRAN = 3 )
00110
00111
00112 LOGICAL TRFCON, ZEROT
00113 CHARACTER DIST, NORM, TRANS, TYPE, XTYPE
00114 CHARACTER*3 PATH
00115 INTEGER I, I1, I2, IKL, IKU, IM, IMAT, IN, INB, INFO,
00116 $ IOFF, IRHS, ITRAN, IZERO, J, K, KL, KOFF, KU,
00117 $ LDA, LDAFAC, LDB, M, MODE, N, NB, NERRS, NFAIL,
00118 $ NIMAT, NKL, NKU, NRHS, NRUN
00119 REAL AINVNM, ANORM, ANORMI, ANORMO, CNDNUM, RCOND,
00120 $ RCONDC, RCONDI, RCONDO
00121
00122
00123 CHARACTER TRANSS( NTRAN )
00124 INTEGER ISEED( 4 ), ISEEDY( 4 ), KLVAL( NBW ),
00125 $ KUVAL( NBW )
00126 REAL RESULT( NTESTS )
00127
00128
00129 REAL CLANGB, CLANGE, SGET06
00130 EXTERNAL CLANGB, CLANGE, SGET06
00131
00132
00133 EXTERNAL ALAERH, ALAHD, ALASUM, CCOPY, CERRGE, CGBCON,
00134 $ CGBRFS, CGBT01, CGBT02, CGBT05, CGBTRF, CGBTRS,
00135 $ CGET04, CLACPY, CLARHS, CLASET, CLATB4, CLATMS,
00136 $ XLAENV
00137
00138
00139 INTRINSIC CMPLX, MAX, MIN
00140
00141
00142 LOGICAL LERR, OK
00143 CHARACTER*32 SRNAMT
00144 INTEGER INFOT, NUNIT
00145
00146
00147 COMMON / INFOC / INFOT, NUNIT, OK, LERR
00148 COMMON / SRNAMC / SRNAMT
00149
00150
00151 DATA ISEEDY / 1988, 1989, 1990, 1991 / ,
00152 $ TRANSS / 'N', 'T', 'C' /
00153
00154
00155
00156
00157
00158 PATH( 1: 1 ) = 'Complex precision'
00159 PATH( 2: 3 ) = 'GB'
00160 NRUN = 0
00161 NFAIL = 0
00162 NERRS = 0
00163 DO 10 I = 1, 4
00164 ISEED( I ) = ISEEDY( I )
00165 10 CONTINUE
00166
00167
00168
00169 IF( TSTERR )
00170 $ CALL CERRGE( PATH, NOUT )
00171 INFOT = 0
00172
00173
00174
00175 KLVAL( 1 ) = 0
00176 KUVAL( 1 ) = 0
00177
00178
00179
00180 DO 160 IM = 1, NM
00181 M = MVAL( IM )
00182
00183
00184
00185 KLVAL( 2 ) = M + ( M+1 ) / 4
00186
00187
00188
00189 KLVAL( 3 ) = ( 3*M-1 ) / 4
00190 KLVAL( 4 ) = ( M+1 ) / 4
00191
00192
00193
00194 DO 150 IN = 1, NN
00195 N = NVAL( IN )
00196 XTYPE = 'N'
00197
00198
00199
00200 KUVAL( 2 ) = N + ( N+1 ) / 4
00201
00202
00203
00204 KUVAL( 3 ) = ( 3*N-1 ) / 4
00205 KUVAL( 4 ) = ( N+1 ) / 4
00206
00207
00208
00209 NKL = MIN( M+1, 4 )
00210 IF( N.EQ.0 )
00211 $ NKL = 2
00212 NKU = MIN( N+1, 4 )
00213 IF( M.EQ.0 )
00214 $ NKU = 2
00215 NIMAT = NTYPES
00216 IF( M.LE.0 .OR. N.LE.0 )
00217 $ NIMAT = 1
00218
00219 DO 140 IKL = 1, NKL
00220
00221
00222
00223
00224
00225 KL = KLVAL( IKL )
00226 DO 130 IKU = 1, NKU
00227
00228
00229
00230
00231
00232 KU = KUVAL( IKU )
00233
00234
00235
00236
00237 LDA = KL + KU + 1
00238 LDAFAC = 2*KL + KU + 1
00239 IF( ( LDA*N ).GT.LA .OR. ( LDAFAC*N ).GT.LAFAC ) THEN
00240 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
00241 $ CALL ALAHD( NOUT, PATH )
00242 IF( N*( KL+KU+1 ).GT.LA ) THEN
00243 WRITE( NOUT, FMT = 9999 )LA, M, N, KL, KU,
00244 $ N*( KL+KU+1 )
00245 NERRS = NERRS + 1
00246 END IF
00247 IF( N*( 2*KL+KU+1 ).GT.LAFAC ) THEN
00248 WRITE( NOUT, FMT = 9998 )LAFAC, M, N, KL, KU,
00249 $ N*( 2*KL+KU+1 )
00250 NERRS = NERRS + 1
00251 END IF
00252 GO TO 130
00253 END IF
00254
00255 DO 120 IMAT = 1, NIMAT
00256
00257
00258
00259 IF( .NOT.DOTYPE( IMAT ) )
00260 $ GO TO 120
00261
00262
00263
00264
00265 ZEROT = IMAT.GE.2 .AND. IMAT.LE.4
00266 IF( ZEROT .AND. N.LT.IMAT-1 )
00267 $ GO TO 120
00268
00269 IF( .NOT.ZEROT .OR. .NOT.DOTYPE( 1 ) ) THEN
00270
00271
00272
00273
00274 CALL CLATB4( PATH, IMAT, M, N, TYPE, KL, KU,
00275 $ ANORM, MODE, CNDNUM, DIST )
00276
00277 KOFF = MAX( 1, KU+2-N )
00278 DO 20 I = 1, KOFF - 1
00279 A( I ) = ZERO
00280 20 CONTINUE
00281 SRNAMT = 'CLATMS'
00282 CALL CLATMS( M, N, DIST, ISEED, TYPE, RWORK,
00283 $ MODE, CNDNUM, ANORM, KL, KU, 'Z',
00284 $ A( KOFF ), LDA, WORK, INFO )
00285
00286
00287
00288 IF( INFO.NE.0 ) THEN
00289 CALL ALAERH( PATH, 'CLATMS', INFO, 0, ' ', M,
00290 $ N, KL, KU, -1, IMAT, NFAIL,
00291 $ NERRS, NOUT )
00292 GO TO 120
00293 END IF
00294 ELSE IF( IZERO.GT.0 ) THEN
00295
00296
00297
00298
00299 CALL CCOPY( I2-I1+1, B, 1, A( IOFF+I1 ), 1 )
00300 END IF
00301
00302
00303
00304
00305 IZERO = 0
00306 IF( ZEROT ) THEN
00307 IF( IMAT.EQ.2 ) THEN
00308 IZERO = 1
00309 ELSE IF( IMAT.EQ.3 ) THEN
00310 IZERO = MIN( M, N )
00311 ELSE
00312 IZERO = MIN( M, N ) / 2 + 1
00313 END IF
00314 IOFF = ( IZERO-1 )*LDA
00315 IF( IMAT.LT.4 ) THEN
00316
00317
00318
00319 I1 = MAX( 1, KU+2-IZERO )
00320 I2 = MIN( KL+KU+1, KU+1+( M-IZERO ) )
00321 CALL CCOPY( I2-I1+1, A( IOFF+I1 ), 1, B, 1 )
00322
00323 DO 30 I = I1, I2
00324 A( IOFF+I ) = ZERO
00325 30 CONTINUE
00326 ELSE
00327 DO 50 J = IZERO, N
00328 DO 40 I = MAX( 1, KU+2-J ),
00329 $ MIN( KL+KU+1, KU+1+( M-J ) )
00330 A( IOFF+I ) = ZERO
00331 40 CONTINUE
00332 IOFF = IOFF + LDA
00333 50 CONTINUE
00334 END IF
00335 END IF
00336
00337
00338
00339
00340
00341
00342
00343
00344
00345
00346 DO 110 INB = 1, NNB
00347 NB = NBVAL( INB )
00348 CALL XLAENV( 1, NB )
00349
00350
00351
00352 IF( M.GT.0 .AND. N.GT.0 )
00353 $ CALL CLACPY( 'Full', KL+KU+1, N, A, LDA,
00354 $ AFAC( KL+1 ), LDAFAC )
00355 SRNAMT = 'CGBTRF'
00356 CALL CGBTRF( M, N, KL, KU, AFAC, LDAFAC, IWORK,
00357 $ INFO )
00358
00359
00360
00361 IF( INFO.NE.IZERO )
00362 $ CALL ALAERH( PATH, 'CGBTRF', INFO, IZERO,
00363 $ ' ', M, N, KL, KU, NB, IMAT,
00364 $ NFAIL, NERRS, NOUT )
00365 TRFCON = .FALSE.
00366
00367
00368
00369
00370
00371 CALL CGBT01( M, N, KL, KU, A, LDA, AFAC, LDAFAC,
00372 $ IWORK, WORK, RESULT( 1 ) )
00373
00374
00375
00376
00377 IF( RESULT( 1 ).GE.THRESH ) THEN
00378 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
00379 $ CALL ALAHD( NOUT, PATH )
00380 WRITE( NOUT, FMT = 9997 )M, N, KL, KU, NB,
00381 $ IMAT, 1, RESULT( 1 )
00382 NFAIL = NFAIL + 1
00383 END IF
00384 NRUN = NRUN + 1
00385
00386
00387
00388
00389 IF( INB.GT.1 .OR. M.NE.N )
00390 $ GO TO 110
00391
00392 ANORMO = CLANGB( 'O', N, KL, KU, A, LDA, RWORK )
00393 ANORMI = CLANGB( 'I', N, KL, KU, A, LDA, RWORK )
00394
00395 IF( INFO.EQ.0 ) THEN
00396
00397
00398
00399
00400 LDB = MAX( 1, N )
00401 CALL CLASET( 'Full', N, N, CMPLX( ZERO ),
00402 $ CMPLX( ONE ), WORK, LDB )
00403 SRNAMT = 'CGBTRS'
00404 CALL CGBTRS( 'No transpose', N, KL, KU, N,
00405 $ AFAC, LDAFAC, IWORK, WORK, LDB,
00406 $ INFO )
00407
00408
00409
00410 AINVNM = CLANGE( 'O', N, N, WORK, LDB,
00411 $ RWORK )
00412 IF( ANORMO.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN
00413 RCONDO = ONE
00414 ELSE
00415 RCONDO = ( ONE / ANORMO ) / AINVNM
00416 END IF
00417
00418
00419
00420
00421 AINVNM = CLANGE( 'I', N, N, WORK, LDB,
00422 $ RWORK )
00423 IF( ANORMI.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN
00424 RCONDI = ONE
00425 ELSE
00426 RCONDI = ( ONE / ANORMI ) / AINVNM
00427 END IF
00428 ELSE
00429
00430
00431
00432 TRFCON = .TRUE.
00433 RCONDO = ZERO
00434 RCONDI = ZERO
00435 END IF
00436
00437
00438
00439 IF( TRFCON )
00440 $ GO TO 90
00441
00442 DO 80 IRHS = 1, NNS
00443 NRHS = NSVAL( IRHS )
00444 XTYPE = 'N'
00445
00446 DO 70 ITRAN = 1, NTRAN
00447 TRANS = TRANSS( ITRAN )
00448 IF( ITRAN.EQ.1 ) THEN
00449 RCONDC = RCONDO
00450 NORM = 'O'
00451 ELSE
00452 RCONDC = RCONDI
00453 NORM = 'I'
00454 END IF
00455
00456
00457
00458
00459 SRNAMT = 'CLARHS'
00460 CALL CLARHS( PATH, XTYPE, ' ', TRANS, N,
00461 $ N, KL, KU, NRHS, A, LDA,
00462 $ XACT, LDB, B, LDB, ISEED,
00463 $ INFO )
00464 XTYPE = 'C'
00465 CALL CLACPY( 'Full', N, NRHS, B, LDB, X,
00466 $ LDB )
00467
00468 SRNAMT = 'CGBTRS'
00469 CALL CGBTRS( TRANS, N, KL, KU, NRHS, AFAC,
00470 $ LDAFAC, IWORK, X, LDB, INFO )
00471
00472
00473
00474 IF( INFO.NE.0 )
00475 $ CALL ALAERH( PATH, 'CGBTRS', INFO, 0,
00476 $ TRANS, N, N, KL, KU, -1,
00477 $ IMAT, NFAIL, NERRS, NOUT )
00478
00479 CALL CLACPY( 'Full', N, NRHS, B, LDB,
00480 $ WORK, LDB )
00481 CALL CGBT02( TRANS, M, N, KL, KU, NRHS, A,
00482 $ LDA, X, LDB, WORK, LDB,
00483 $ RESULT( 2 ) )
00484
00485
00486
00487
00488
00489 CALL CGET04( N, NRHS, X, LDB, XACT, LDB,
00490 $ RCONDC, RESULT( 3 ) )
00491
00492
00493
00494
00495
00496 SRNAMT = 'CGBRFS'
00497 CALL CGBRFS( TRANS, N, KL, KU, NRHS, A,
00498 $ LDA, AFAC, LDAFAC, IWORK, B,
00499 $ LDB, X, LDB, RWORK,
00500 $ RWORK( NRHS+1 ), WORK,
00501 $ RWORK( 2*NRHS+1 ), INFO )
00502
00503
00504
00505 IF( INFO.NE.0 )
00506 $ CALL ALAERH( PATH, 'CGBRFS', INFO, 0,
00507 $ TRANS, N, N, KL, KU, NRHS,
00508 $ IMAT, NFAIL, NERRS, NOUT )
00509
00510 CALL CGET04( N, NRHS, X, LDB, XACT, LDB,
00511 $ RCONDC, RESULT( 4 ) )
00512 CALL CGBT05( TRANS, N, KL, KU, NRHS, A,
00513 $ LDA, B, LDB, X, LDB, XACT,
00514 $ LDB, RWORK, RWORK( NRHS+1 ),
00515 $ RESULT( 5 ) )
00516
00517
00518
00519
00520 DO 60 K = 2, 6
00521 IF( RESULT( K ).GE.THRESH ) THEN
00522 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
00523 $ CALL ALAHD( NOUT, PATH )
00524 WRITE( NOUT, FMT = 9996 )TRANS, N,
00525 $ KL, KU, NRHS, IMAT, K,
00526 $ RESULT( K )
00527 NFAIL = NFAIL + 1
00528 END IF
00529 60 CONTINUE
00530 NRUN = NRUN + 5
00531 70 CONTINUE
00532 80 CONTINUE
00533
00534
00535
00536
00537 90 CONTINUE
00538 DO 100 ITRAN = 1, 2
00539 IF( ITRAN.EQ.1 ) THEN
00540 ANORM = ANORMO
00541 RCONDC = RCONDO
00542 NORM = 'O'
00543 ELSE
00544 ANORM = ANORMI
00545 RCONDC = RCONDI
00546 NORM = 'I'
00547 END IF
00548 SRNAMT = 'CGBCON'
00549 CALL CGBCON( NORM, N, KL, KU, AFAC, LDAFAC,
00550 $ IWORK, ANORM, RCOND, WORK,
00551 $ RWORK, INFO )
00552
00553
00554
00555 IF( INFO.NE.0 )
00556 $ CALL ALAERH( PATH, 'CGBCON', INFO, 0,
00557 $ NORM, N, N, KL, KU, -1, IMAT,
00558 $ NFAIL, NERRS, NOUT )
00559
00560 RESULT( 7 ) = SGET06( RCOND, RCONDC )
00561
00562
00563
00564
00565 IF( RESULT( 7 ).GE.THRESH ) THEN
00566 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
00567 $ CALL ALAHD( NOUT, PATH )
00568 WRITE( NOUT, FMT = 9995 )NORM, N, KL, KU,
00569 $ IMAT, 7, RESULT( 7 )
00570 NFAIL = NFAIL + 1
00571 END IF
00572 NRUN = NRUN + 1
00573 100 CONTINUE
00574 110 CONTINUE
00575 120 CONTINUE
00576 130 CONTINUE
00577 140 CONTINUE
00578 150 CONTINUE
00579 160 CONTINUE
00580
00581
00582
00583 CALL ALASUM( PATH, NOUT, NFAIL, NRUN, NERRS )
00584
00585 9999 FORMAT( ' *** In CCHKGB, LA=', I5, ' is too small for M=', I5,
00586 $ ', N=', I5, ', KL=', I4, ', KU=', I4,
00587 $ / ' ==> Increase LA to at least ', I5 )
00588 9998 FORMAT( ' *** In CCHKGB, LAFAC=', I5, ' is too small for M=', I5,
00589 $ ', N=', I5, ', KL=', I4, ', KU=', I4,
00590 $ / ' ==> Increase LAFAC to at least ', I5 )
00591 9997 FORMAT( ' M =', I5, ', N =', I5, ', KL=', I5, ', KU=', I5,
00592 $ ', NB =', I4, ', type ', I1, ', test(', I1, ')=', G12.5 )
00593 9996 FORMAT( ' TRANS=''', A1, ''', N=', I5, ', KL=', I5, ', KU=', I5,
00594 $ ', NRHS=', I3, ', type ', I1, ', test(', I1, ')=', G12.5 )
00595 9995 FORMAT( ' NORM =''', A1, ''', N=', I5, ', KL=', I5, ', KU=', I5,
00596 $ ',', 10X, ' type ', I1, ', test(', I1, ')=', G12.5 )
00597
00598 RETURN
00599
00600
00601
00602 END