00001 SUBROUTINE CGET23( COMP, ISRT, BALANC, JTYPE, THRESH, ISEED,
00002 $ NOUNIT, N, A, LDA, H, W, W1, VL, LDVL, VR,
00003 $ LDVR, LRE, LDLRE, RCONDV, RCNDV1, RCDVIN,
00004 $ RCONDE, RCNDE1, RCDEIN, SCALE, SCALE1, RESULT,
00005 $ WORK, LWORK, RWORK, INFO )
00006
00007
00008
00009
00010
00011
00012 LOGICAL COMP
00013 CHARACTER BALANC
00014 INTEGER INFO, ISRT, JTYPE, LDA, LDLRE, LDVL, LDVR,
00015 $ LWORK, N, NOUNIT
00016 REAL THRESH
00017
00018
00019 INTEGER ISEED( 4 )
00020 REAL RCDEIN( * ), RCDVIN( * ), RCNDE1( * ),
00021 $ RCNDV1( * ), RCONDE( * ), RCONDV( * ),
00022 $ RESULT( 11 ), RWORK( * ), SCALE( * ),
00023 $ SCALE1( * )
00024 COMPLEX A( LDA, * ), H( LDA, * ), LRE( LDLRE, * ),
00025 $ VL( LDVL, * ), VR( LDVR, * ), W( * ), W1( * ),
00026 $ WORK( * )
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
00105
00106
00107
00108
00109
00110
00111
00112
00113
00114
00115
00116
00117
00118
00119
00120
00121
00122
00123
00124
00125
00126
00127
00128
00129
00130
00131
00132
00133
00134
00135
00136
00137
00138
00139
00140
00141
00142
00143
00144
00145
00146
00147
00148
00149
00150
00151
00152
00153
00154
00155
00156
00157
00158
00159
00160
00161
00162
00163
00164
00165
00166
00167
00168
00169
00170
00171
00172
00173
00174
00175
00176
00177
00178
00179
00180
00181
00182
00183
00184
00185
00186
00187
00188
00189
00190
00191
00192
00193
00194
00195
00196
00197
00198
00199
00200
00201
00202
00203
00204
00205
00206
00207
00208
00209
00210
00211
00212
00213
00214
00215
00216
00217
00218
00219
00220
00221
00222
00223
00224
00225
00226
00227
00228
00229
00230
00231
00232
00233
00234
00235
00236
00237
00238
00239
00240
00241
00242
00243
00244
00245
00246
00247
00248
00249 REAL ZERO, ONE, TWO
00250 PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0, TWO = 2.0E0 )
00251 REAL EPSIN
00252 PARAMETER ( EPSIN = 5.9605E-8 )
00253
00254
00255 LOGICAL BALOK, NOBAL
00256 CHARACTER SENSE
00257 INTEGER I, IHI, IHI1, IINFO, ILO, ILO1, ISENS, ISENSM,
00258 $ J, JJ, KMIN
00259 REAL ABNRM, ABNRM1, EPS, SMLNUM, TNRM, TOL, TOLIN,
00260 $ ULP, ULPINV, V, VMAX, VMX, VRICMP, VRIMIN,
00261 $ VRMX, VTST
00262 COMPLEX CTMP
00263
00264
00265 CHARACTER SENS( 2 )
00266 REAL RES( 2 )
00267 COMPLEX CDUM( 1 )
00268
00269
00270 LOGICAL LSAME
00271 REAL SCNRM2, SLAMCH
00272 EXTERNAL LSAME, SCNRM2, SLAMCH
00273
00274
00275 EXTERNAL CGEEVX, CGET22, CLACPY, XERBLA
00276
00277
00278 INTRINSIC ABS, AIMAG, MAX, MIN, REAL
00279
00280
00281 DATA SENS / 'N', 'V' /
00282
00283
00284
00285
00286
00287 NOBAL = LSAME( BALANC, 'N' )
00288 BALOK = NOBAL .OR. LSAME( BALANC, 'P' ) .OR.
00289 $ LSAME( BALANC, 'S' ) .OR. LSAME( BALANC, 'B' )
00290 INFO = 0
00291 IF( ISRT.NE.0 .AND. ISRT.NE.1 ) THEN
00292 INFO = -2
00293 ELSE IF( .NOT.BALOK ) THEN
00294 INFO = -3
00295 ELSE IF( THRESH.LT.ZERO ) THEN
00296 INFO = -5
00297 ELSE IF( NOUNIT.LE.0 ) THEN
00298 INFO = -7
00299 ELSE IF( N.LT.0 ) THEN
00300 INFO = -8
00301 ELSE IF( LDA.LT.1 .OR. LDA.LT.N ) THEN
00302 INFO = -10
00303 ELSE IF( LDVL.LT.1 .OR. LDVL.LT.N ) THEN
00304 INFO = -15
00305 ELSE IF( LDVR.LT.1 .OR. LDVR.LT.N ) THEN
00306 INFO = -17
00307 ELSE IF( LDLRE.LT.1 .OR. LDLRE.LT.N ) THEN
00308 INFO = -19
00309 ELSE IF( LWORK.LT.2*N .OR. ( COMP .AND. LWORK.LT.2*N+N*N ) ) THEN
00310 INFO = -30
00311 END IF
00312
00313 IF( INFO.NE.0 ) THEN
00314 CALL XERBLA( 'CGET23', -INFO )
00315 RETURN
00316 END IF
00317
00318
00319
00320 DO 10 I = 1, 11
00321 RESULT( I ) = -ONE
00322 10 CONTINUE
00323
00324 IF( N.EQ.0 )
00325 $ RETURN
00326
00327
00328
00329 ULP = SLAMCH( 'Precision' )
00330 SMLNUM = SLAMCH( 'S' )
00331 ULPINV = ONE / ULP
00332
00333
00334
00335 IF( LWORK.GE.2*N+N*N ) THEN
00336 SENSE = 'B'
00337 ISENSM = 2
00338 ELSE
00339 SENSE = 'E'
00340 ISENSM = 1
00341 END IF
00342 CALL CLACPY( 'F', N, N, A, LDA, H, LDA )
00343 CALL CGEEVX( BALANC, 'V', 'V', SENSE, N, H, LDA, W, VL, LDVL, VR,
00344 $ LDVR, ILO, IHI, SCALE, ABNRM, RCONDE, RCONDV, WORK,
00345 $ LWORK, RWORK, IINFO )
00346 IF( IINFO.NE.0 ) THEN
00347 RESULT( 1 ) = ULPINV
00348 IF( JTYPE.NE.22 ) THEN
00349 WRITE( NOUNIT, FMT = 9998 )'CGEEVX1', IINFO, N, JTYPE,
00350 $ BALANC, ISEED
00351 ELSE
00352 WRITE( NOUNIT, FMT = 9999 )'CGEEVX1', IINFO, N, ISEED( 1 )
00353 END IF
00354 INFO = ABS( IINFO )
00355 RETURN
00356 END IF
00357
00358
00359
00360 CALL CGET22( 'N', 'N', 'N', N, A, LDA, VR, LDVR, W, WORK, RWORK,
00361 $ RES )
00362 RESULT( 1 ) = RES( 1 )
00363
00364
00365
00366 CALL CGET22( 'C', 'N', 'C', N, A, LDA, VL, LDVL, W, WORK, RWORK,
00367 $ RES )
00368 RESULT( 2 ) = RES( 1 )
00369
00370
00371
00372 DO 30 J = 1, N
00373 TNRM = SCNRM2( N, VR( 1, J ), 1 )
00374 RESULT( 3 ) = MAX( RESULT( 3 ),
00375 $ MIN( ULPINV, ABS( TNRM-ONE ) / ULP ) )
00376 VMX = ZERO
00377 VRMX = ZERO
00378 DO 20 JJ = 1, N
00379 VTST = ABS( VR( JJ, J ) )
00380 IF( VTST.GT.VMX )
00381 $ VMX = VTST
00382 IF( AIMAG( VR( JJ, J ) ).EQ.ZERO .AND.
00383 $ ABS( REAL( VR( JJ, J ) ) ).GT.VRMX )
00384 $ VRMX = ABS( REAL( VR( JJ, J ) ) )
00385 20 CONTINUE
00386 IF( VRMX / VMX.LT.ONE-TWO*ULP )
00387 $ RESULT( 3 ) = ULPINV
00388 30 CONTINUE
00389
00390
00391
00392 DO 50 J = 1, N
00393 TNRM = SCNRM2( N, VL( 1, J ), 1 )
00394 RESULT( 4 ) = MAX( RESULT( 4 ),
00395 $ MIN( ULPINV, ABS( TNRM-ONE ) / ULP ) )
00396 VMX = ZERO
00397 VRMX = ZERO
00398 DO 40 JJ = 1, N
00399 VTST = ABS( VL( JJ, J ) )
00400 IF( VTST.GT.VMX )
00401 $ VMX = VTST
00402 IF( AIMAG( VL( JJ, J ) ).EQ.ZERO .AND.
00403 $ ABS( REAL( VL( JJ, J ) ) ).GT.VRMX )
00404 $ VRMX = ABS( REAL( VL( JJ, J ) ) )
00405 40 CONTINUE
00406 IF( VRMX / VMX.LT.ONE-TWO*ULP )
00407 $ RESULT( 4 ) = ULPINV
00408 50 CONTINUE
00409
00410
00411
00412 DO 200 ISENS = 1, ISENSM
00413
00414 SENSE = SENS( ISENS )
00415
00416
00417
00418 CALL CLACPY( 'F', N, N, A, LDA, H, LDA )
00419 CALL CGEEVX( BALANC, 'N', 'N', SENSE, N, H, LDA, W1, CDUM, 1,
00420 $ CDUM, 1, ILO1, IHI1, SCALE1, ABNRM1, RCNDE1,
00421 $ RCNDV1, WORK, LWORK, RWORK, IINFO )
00422 IF( IINFO.NE.0 ) THEN
00423 RESULT( 1 ) = ULPINV
00424 IF( JTYPE.NE.22 ) THEN
00425 WRITE( NOUNIT, FMT = 9998 )'CGEEVX2', IINFO, N, JTYPE,
00426 $ BALANC, ISEED
00427 ELSE
00428 WRITE( NOUNIT, FMT = 9999 )'CGEEVX2', IINFO, N,
00429 $ ISEED( 1 )
00430 END IF
00431 INFO = ABS( IINFO )
00432 GO TO 190
00433 END IF
00434
00435
00436
00437 DO 60 J = 1, N
00438 IF( W( J ).NE.W1( J ) )
00439 $ RESULT( 5 ) = ULPINV
00440 60 CONTINUE
00441
00442
00443
00444 IF( .NOT.NOBAL ) THEN
00445 DO 70 J = 1, N
00446 IF( SCALE( J ).NE.SCALE1( J ) )
00447 $ RESULT( 8 ) = ULPINV
00448 70 CONTINUE
00449 IF( ILO.NE.ILO1 )
00450 $ RESULT( 8 ) = ULPINV
00451 IF( IHI.NE.IHI1 )
00452 $ RESULT( 8 ) = ULPINV
00453 IF( ABNRM.NE.ABNRM1 )
00454 $ RESULT( 8 ) = ULPINV
00455 END IF
00456
00457
00458
00459 IF( ISENS.EQ.2 .AND. N.GT.1 ) THEN
00460 DO 80 J = 1, N
00461 IF( RCONDV( J ).NE.RCNDV1( J ) )
00462 $ RESULT( 9 ) = ULPINV
00463 80 CONTINUE
00464 END IF
00465
00466
00467
00468 CALL CLACPY( 'F', N, N, A, LDA, H, LDA )
00469 CALL CGEEVX( BALANC, 'N', 'V', SENSE, N, H, LDA, W1, CDUM, 1,
00470 $ LRE, LDLRE, ILO1, IHI1, SCALE1, ABNRM1, RCNDE1,
00471 $ RCNDV1, WORK, LWORK, RWORK, IINFO )
00472 IF( IINFO.NE.0 ) THEN
00473 RESULT( 1 ) = ULPINV
00474 IF( JTYPE.NE.22 ) THEN
00475 WRITE( NOUNIT, FMT = 9998 )'CGEEVX3', IINFO, N, JTYPE,
00476 $ BALANC, ISEED
00477 ELSE
00478 WRITE( NOUNIT, FMT = 9999 )'CGEEVX3', IINFO, N,
00479 $ ISEED( 1 )
00480 END IF
00481 INFO = ABS( IINFO )
00482 GO TO 190
00483 END IF
00484
00485
00486
00487 DO 90 J = 1, N
00488 IF( W( J ).NE.W1( J ) )
00489 $ RESULT( 5 ) = ULPINV
00490 90 CONTINUE
00491
00492
00493
00494 DO 110 J = 1, N
00495 DO 100 JJ = 1, N
00496 IF( VR( J, JJ ).NE.LRE( J, JJ ) )
00497 $ RESULT( 6 ) = ULPINV
00498 100 CONTINUE
00499 110 CONTINUE
00500
00501
00502
00503 IF( .NOT.NOBAL ) THEN
00504 DO 120 J = 1, N
00505 IF( SCALE( J ).NE.SCALE1( J ) )
00506 $ RESULT( 8 ) = ULPINV
00507 120 CONTINUE
00508 IF( ILO.NE.ILO1 )
00509 $ RESULT( 8 ) = ULPINV
00510 IF( IHI.NE.IHI1 )
00511 $ RESULT( 8 ) = ULPINV
00512 IF( ABNRM.NE.ABNRM1 )
00513 $ RESULT( 8 ) = ULPINV
00514 END IF
00515
00516
00517
00518 IF( ISENS.EQ.2 .AND. N.GT.1 ) THEN
00519 DO 130 J = 1, N
00520 IF( RCONDV( J ).NE.RCNDV1( J ) )
00521 $ RESULT( 9 ) = ULPINV
00522 130 CONTINUE
00523 END IF
00524
00525
00526
00527 CALL CLACPY( 'F', N, N, A, LDA, H, LDA )
00528 CALL CGEEVX( BALANC, 'V', 'N', SENSE, N, H, LDA, W1, LRE,
00529 $ LDLRE, CDUM, 1, ILO1, IHI1, SCALE1, ABNRM1,
00530 $ RCNDE1, RCNDV1, WORK, LWORK, RWORK, IINFO )
00531 IF( IINFO.NE.0 ) THEN
00532 RESULT( 1 ) = ULPINV
00533 IF( JTYPE.NE.22 ) THEN
00534 WRITE( NOUNIT, FMT = 9998 )'CGEEVX4', IINFO, N, JTYPE,
00535 $ BALANC, ISEED
00536 ELSE
00537 WRITE( NOUNIT, FMT = 9999 )'CGEEVX4', IINFO, N,
00538 $ ISEED( 1 )
00539 END IF
00540 INFO = ABS( IINFO )
00541 GO TO 190
00542 END IF
00543
00544
00545
00546 DO 140 J = 1, N
00547 IF( W( J ).NE.W1( J ) )
00548 $ RESULT( 5 ) = ULPINV
00549 140 CONTINUE
00550
00551
00552
00553 DO 160 J = 1, N
00554 DO 150 JJ = 1, N
00555 IF( VL( J, JJ ).NE.LRE( J, JJ ) )
00556 $ RESULT( 7 ) = ULPINV
00557 150 CONTINUE
00558 160 CONTINUE
00559
00560
00561
00562 IF( .NOT.NOBAL ) THEN
00563 DO 170 J = 1, N
00564 IF( SCALE( J ).NE.SCALE1( J ) )
00565 $ RESULT( 8 ) = ULPINV
00566 170 CONTINUE
00567 IF( ILO.NE.ILO1 )
00568 $ RESULT( 8 ) = ULPINV
00569 IF( IHI.NE.IHI1 )
00570 $ RESULT( 8 ) = ULPINV
00571 IF( ABNRM.NE.ABNRM1 )
00572 $ RESULT( 8 ) = ULPINV
00573 END IF
00574
00575
00576
00577 IF( ISENS.EQ.2 .AND. N.GT.1 ) THEN
00578 DO 180 J = 1, N
00579 IF( RCONDV( J ).NE.RCNDV1( J ) )
00580 $ RESULT( 9 ) = ULPINV
00581 180 CONTINUE
00582 END IF
00583
00584 190 CONTINUE
00585
00586 200 CONTINUE
00587
00588
00589
00590 IF( COMP ) THEN
00591 CALL CLACPY( 'F', N, N, A, LDA, H, LDA )
00592 CALL CGEEVX( 'N', 'V', 'V', 'B', N, H, LDA, W, VL, LDVL, VR,
00593 $ LDVR, ILO, IHI, SCALE, ABNRM, RCONDE, RCONDV,
00594 $ WORK, LWORK, RWORK, IINFO )
00595 IF( IINFO.NE.0 ) THEN
00596 RESULT( 1 ) = ULPINV
00597 WRITE( NOUNIT, FMT = 9999 )'CGEEVX5', IINFO, N, ISEED( 1 )
00598 INFO = ABS( IINFO )
00599 GO TO 250
00600 END IF
00601
00602
00603
00604
00605 DO 220 I = 1, N - 1
00606 KMIN = I
00607 IF( ISRT.EQ.0 ) THEN
00608 VRIMIN = REAL( W( I ) )
00609 ELSE
00610 VRIMIN = AIMAG( W( I ) )
00611 END IF
00612 DO 210 J = I + 1, N
00613 IF( ISRT.EQ.0 ) THEN
00614 VRICMP = REAL( W( J ) )
00615 ELSE
00616 VRICMP = AIMAG( W( J ) )
00617 END IF
00618 IF( VRICMP.LT.VRIMIN ) THEN
00619 KMIN = J
00620 VRIMIN = VRICMP
00621 END IF
00622 210 CONTINUE
00623 CTMP = W( KMIN )
00624 W( KMIN ) = W( I )
00625 W( I ) = CTMP
00626 VRIMIN = RCONDE( KMIN )
00627 RCONDE( KMIN ) = RCONDE( I )
00628 RCONDE( I ) = VRIMIN
00629 VRIMIN = RCONDV( KMIN )
00630 RCONDV( KMIN ) = RCONDV( I )
00631 RCONDV( I ) = VRIMIN
00632 220 CONTINUE
00633
00634
00635
00636
00637 RESULT( 10 ) = ZERO
00638 EPS = MAX( EPSIN, ULP )
00639 V = MAX( REAL( N )*EPS*ABNRM, SMLNUM )
00640 IF( ABNRM.EQ.ZERO )
00641 $ V = ONE
00642 DO 230 I = 1, N
00643 IF( V.GT.RCONDV( I )*RCONDE( I ) ) THEN
00644 TOL = RCONDV( I )
00645 ELSE
00646 TOL = V / RCONDE( I )
00647 END IF
00648 IF( V.GT.RCDVIN( I )*RCDEIN( I ) ) THEN
00649 TOLIN = RCDVIN( I )
00650 ELSE
00651 TOLIN = V / RCDEIN( I )
00652 END IF
00653 TOL = MAX( TOL, SMLNUM / EPS )
00654 TOLIN = MAX( TOLIN, SMLNUM / EPS )
00655 IF( EPS*( RCDVIN( I )-TOLIN ).GT.RCONDV( I )+TOL ) THEN
00656 VMAX = ONE / EPS
00657 ELSE IF( RCDVIN( I )-TOLIN.GT.RCONDV( I )+TOL ) THEN
00658 VMAX = ( RCDVIN( I )-TOLIN ) / ( RCONDV( I )+TOL )
00659 ELSE IF( RCDVIN( I )+TOLIN.LT.EPS*( RCONDV( I )-TOL ) ) THEN
00660 VMAX = ONE / EPS
00661 ELSE IF( RCDVIN( I )+TOLIN.LT.RCONDV( I )-TOL ) THEN
00662 VMAX = ( RCONDV( I )-TOL ) / ( RCDVIN( I )+TOLIN )
00663 ELSE
00664 VMAX = ONE
00665 END IF
00666 RESULT( 10 ) = MAX( RESULT( 10 ), VMAX )
00667 230 CONTINUE
00668
00669
00670
00671
00672 RESULT( 11 ) = ZERO
00673 DO 240 I = 1, N
00674 IF( V.GT.RCONDV( I ) ) THEN
00675 TOL = ONE
00676 ELSE
00677 TOL = V / RCONDV( I )
00678 END IF
00679 IF( V.GT.RCDVIN( I ) ) THEN
00680 TOLIN = ONE
00681 ELSE
00682 TOLIN = V / RCDVIN( I )
00683 END IF
00684 TOL = MAX( TOL, SMLNUM / EPS )
00685 TOLIN = MAX( TOLIN, SMLNUM / EPS )
00686 IF( EPS*( RCDEIN( I )-TOLIN ).GT.RCONDE( I )+TOL ) THEN
00687 VMAX = ONE / EPS
00688 ELSE IF( RCDEIN( I )-TOLIN.GT.RCONDE( I )+TOL ) THEN
00689 VMAX = ( RCDEIN( I )-TOLIN ) / ( RCONDE( I )+TOL )
00690 ELSE IF( RCDEIN( I )+TOLIN.LT.EPS*( RCONDE( I )-TOL ) ) THEN
00691 VMAX = ONE / EPS
00692 ELSE IF( RCDEIN( I )+TOLIN.LT.RCONDE( I )-TOL ) THEN
00693 VMAX = ( RCONDE( I )-TOL ) / ( RCDEIN( I )+TOLIN )
00694 ELSE
00695 VMAX = ONE
00696 END IF
00697 RESULT( 11 ) = MAX( RESULT( 11 ), VMAX )
00698 240 CONTINUE
00699 250 CONTINUE
00700
00701 END IF
00702
00703 9999 FORMAT( ' CGET23: ', A, ' returned INFO=', I6, '.', / 9X, 'N=',
00704 $ I6, ', INPUT EXAMPLE NUMBER = ', I4 )
00705 9998 FORMAT( ' CGET23: ', A, ' returned INFO=', I6, '.', / 9X, 'N=',
00706 $ I6, ', JTYPE=', I6, ', BALANC = ', A, ', ISEED=(',
00707 $ 3( I5, ',' ), I5, ')' )
00708
00709 RETURN
00710
00711
00712
00713 END