00001 SUBROUTINE DLATMR( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX,
00002 $ RSIGN, GRADE, DL, MODEL, CONDL, DR, MODER,
00003 $ CONDR, PIVTNG, IPIVOT, KL, KU, SPARSE, ANORM,
00004 $ PACK, A, LDA, IWORK, INFO )
00005
00006
00007
00008
00009
00010
00011 CHARACTER DIST, GRADE, PACK, PIVTNG, RSIGN, SYM
00012 INTEGER INFO, KL, KU, LDA, M, MODE, MODEL, MODER, N
00013 DOUBLE PRECISION ANORM, COND, CONDL, CONDR, DMAX, SPARSE
00014
00015
00016 INTEGER IPIVOT( * ), ISEED( 4 ), IWORK( * )
00017 DOUBLE PRECISION A( LDA, * ), D( * ), DL( * ), DR( * )
00018
00019
00020
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
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
00250
00251
00252
00253
00254
00255
00256
00257
00258
00259
00260
00261
00262
00263
00264
00265
00266
00267
00268
00269
00270
00271
00272
00273
00274
00275
00276
00277
00278
00279
00280
00281
00282
00283
00284
00285
00286
00287
00288
00289
00290
00291
00292
00293
00294
00295
00296
00297
00298
00299
00300
00301
00302
00303
00304
00305
00306
00307
00308
00309
00310
00311
00312
00313
00314
00315
00316
00317
00318
00319
00320
00321
00322
00323
00324
00325
00326
00327
00328
00329
00330
00331
00332
00333
00334
00335
00336
00337
00338
00339
00340
00341
00342
00343
00344
00345
00346
00347
00348
00349
00350
00351
00352
00353
00354
00355
00356
00357
00358
00359
00360
00361
00362
00363
00364
00365 DOUBLE PRECISION ZERO
00366 PARAMETER ( ZERO = 0.0D0 )
00367 DOUBLE PRECISION ONE
00368 PARAMETER ( ONE = 1.0D0 )
00369
00370
00371 LOGICAL BADPVT, DZERO, FULBND
00372 INTEGER I, IDIST, IGRADE, IISUB, IPACK, IPVTNG, IRSIGN,
00373 $ ISUB, ISYM, J, JJSUB, JSUB, K, KLL, KUU, MNMIN,
00374 $ MNSUB, MXSUB, NPVTS
00375 DOUBLE PRECISION ALPHA, ONORM, TEMP
00376
00377
00378 DOUBLE PRECISION TEMPA( 1 )
00379
00380
00381 LOGICAL LSAME
00382 DOUBLE PRECISION DLANGB, DLANGE, DLANSB, DLANSP, DLANSY, DLATM2,
00383 $ DLATM3
00384 EXTERNAL LSAME, DLANGB, DLANGE, DLANSB, DLANSP, DLANSY,
00385 $ DLATM2, DLATM3
00386
00387
00388 EXTERNAL DLATM1, DSCAL, XERBLA
00389
00390
00391 INTRINSIC ABS, MAX, MIN, MOD
00392
00393
00394
00395
00396
00397
00398 INFO = 0
00399
00400
00401
00402 IF( M.EQ.0 .OR. N.EQ.0 )
00403 $ RETURN
00404
00405
00406
00407 IF( LSAME( DIST, 'U' ) ) THEN
00408 IDIST = 1
00409 ELSE IF( LSAME( DIST, 'S' ) ) THEN
00410 IDIST = 2
00411 ELSE IF( LSAME( DIST, 'N' ) ) THEN
00412 IDIST = 3
00413 ELSE
00414 IDIST = -1
00415 END IF
00416
00417
00418
00419 IF( LSAME( SYM, 'S' ) ) THEN
00420 ISYM = 0
00421 ELSE IF( LSAME( SYM, 'N' ) ) THEN
00422 ISYM = 1
00423 ELSE IF( LSAME( SYM, 'H' ) ) THEN
00424 ISYM = 0
00425 ELSE
00426 ISYM = -1
00427 END IF
00428
00429
00430
00431 IF( LSAME( RSIGN, 'F' ) ) THEN
00432 IRSIGN = 0
00433 ELSE IF( LSAME( RSIGN, 'T' ) ) THEN
00434 IRSIGN = 1
00435 ELSE
00436 IRSIGN = -1
00437 END IF
00438
00439
00440
00441 IF( LSAME( PIVTNG, 'N' ) ) THEN
00442 IPVTNG = 0
00443 ELSE IF( LSAME( PIVTNG, ' ' ) ) THEN
00444 IPVTNG = 0
00445 ELSE IF( LSAME( PIVTNG, 'L' ) ) THEN
00446 IPVTNG = 1
00447 NPVTS = M
00448 ELSE IF( LSAME( PIVTNG, 'R' ) ) THEN
00449 IPVTNG = 2
00450 NPVTS = N
00451 ELSE IF( LSAME( PIVTNG, 'B' ) ) THEN
00452 IPVTNG = 3
00453 NPVTS = MIN( N, M )
00454 ELSE IF( LSAME( PIVTNG, 'F' ) ) THEN
00455 IPVTNG = 3
00456 NPVTS = MIN( N, M )
00457 ELSE
00458 IPVTNG = -1
00459 END IF
00460
00461
00462
00463 IF( LSAME( GRADE, 'N' ) ) THEN
00464 IGRADE = 0
00465 ELSE IF( LSAME( GRADE, 'L' ) ) THEN
00466 IGRADE = 1
00467 ELSE IF( LSAME( GRADE, 'R' ) ) THEN
00468 IGRADE = 2
00469 ELSE IF( LSAME( GRADE, 'B' ) ) THEN
00470 IGRADE = 3
00471 ELSE IF( LSAME( GRADE, 'E' ) ) THEN
00472 IGRADE = 4
00473 ELSE IF( LSAME( GRADE, 'H' ) .OR. LSAME( GRADE, 'S' ) ) THEN
00474 IGRADE = 5
00475 ELSE
00476 IGRADE = -1
00477 END IF
00478
00479
00480
00481 IF( LSAME( PACK, 'N' ) ) THEN
00482 IPACK = 0
00483 ELSE IF( LSAME( PACK, 'U' ) ) THEN
00484 IPACK = 1
00485 ELSE IF( LSAME( PACK, 'L' ) ) THEN
00486 IPACK = 2
00487 ELSE IF( LSAME( PACK, 'C' ) ) THEN
00488 IPACK = 3
00489 ELSE IF( LSAME( PACK, 'R' ) ) THEN
00490 IPACK = 4
00491 ELSE IF( LSAME( PACK, 'B' ) ) THEN
00492 IPACK = 5
00493 ELSE IF( LSAME( PACK, 'Q' ) ) THEN
00494 IPACK = 6
00495 ELSE IF( LSAME( PACK, 'Z' ) ) THEN
00496 IPACK = 7
00497 ELSE
00498 IPACK = -1
00499 END IF
00500
00501
00502
00503 MNMIN = MIN( M, N )
00504 KLL = MIN( KL, M-1 )
00505 KUU = MIN( KU, N-1 )
00506
00507
00508
00509 DZERO = .FALSE.
00510 IF( IGRADE.EQ.4 .AND. MODEL.EQ.0 ) THEN
00511 DO 10 I = 1, M
00512 IF( DL( I ).EQ.ZERO )
00513 $ DZERO = .TRUE.
00514 10 CONTINUE
00515 END IF
00516
00517
00518
00519 BADPVT = .FALSE.
00520 IF( IPVTNG.GT.0 ) THEN
00521 DO 20 J = 1, NPVTS
00522 IF( IPIVOT( J ).LE.0 .OR. IPIVOT( J ).GT.NPVTS )
00523 $ BADPVT = .TRUE.
00524 20 CONTINUE
00525 END IF
00526
00527
00528
00529 IF( M.LT.0 ) THEN
00530 INFO = -1
00531 ELSE IF( M.NE.N .AND. ISYM.EQ.0 ) THEN
00532 INFO = -1
00533 ELSE IF( N.LT.0 ) THEN
00534 INFO = -2
00535 ELSE IF( IDIST.EQ.-1 ) THEN
00536 INFO = -3
00537 ELSE IF( ISYM.EQ.-1 ) THEN
00538 INFO = -5
00539 ELSE IF( MODE.LT.-6 .OR. MODE.GT.6 ) THEN
00540 INFO = -7
00541 ELSE IF( ( MODE.NE.-6 .AND. MODE.NE.0 .AND. MODE.NE.6 ) .AND.
00542 $ COND.LT.ONE ) THEN
00543 INFO = -8
00544 ELSE IF( ( MODE.NE.-6 .AND. MODE.NE.0 .AND. MODE.NE.6 ) .AND.
00545 $ IRSIGN.EQ.-1 ) THEN
00546 INFO = -10
00547 ELSE IF( IGRADE.EQ.-1 .OR. ( IGRADE.EQ.4 .AND. M.NE.N ) .OR.
00548 $ ( ( IGRADE.GE.1 .AND. IGRADE.LE.4 ) .AND. ISYM.EQ.0 ) )
00549 $ THEN
00550 INFO = -11
00551 ELSE IF( IGRADE.EQ.4 .AND. DZERO ) THEN
00552 INFO = -12
00553 ELSE IF( ( IGRADE.EQ.1 .OR. IGRADE.EQ.3 .OR. IGRADE.EQ.4 .OR.
00554 $ IGRADE.EQ.5 ) .AND. ( MODEL.LT.-6 .OR. MODEL.GT.6 ) )
00555 $ THEN
00556 INFO = -13
00557 ELSE IF( ( IGRADE.EQ.1 .OR. IGRADE.EQ.3 .OR. IGRADE.EQ.4 .OR.
00558 $ IGRADE.EQ.5 ) .AND. ( MODEL.NE.-6 .AND. MODEL.NE.0 .AND.
00559 $ MODEL.NE.6 ) .AND. CONDL.LT.ONE ) THEN
00560 INFO = -14
00561 ELSE IF( ( IGRADE.EQ.2 .OR. IGRADE.EQ.3 ) .AND.
00562 $ ( MODER.LT.-6 .OR. MODER.GT.6 ) ) THEN
00563 INFO = -16
00564 ELSE IF( ( IGRADE.EQ.2 .OR. IGRADE.EQ.3 ) .AND.
00565 $ ( MODER.NE.-6 .AND. MODER.NE.0 .AND. MODER.NE.6 ) .AND.
00566 $ CONDR.LT.ONE ) THEN
00567 INFO = -17
00568 ELSE IF( IPVTNG.EQ.-1 .OR. ( IPVTNG.EQ.3 .AND. M.NE.N ) .OR.
00569 $ ( ( IPVTNG.EQ.1 .OR. IPVTNG.EQ.2 ) .AND. ISYM.EQ.0 ) )
00570 $ THEN
00571 INFO = -18
00572 ELSE IF( IPVTNG.NE.0 .AND. BADPVT ) THEN
00573 INFO = -19
00574 ELSE IF( KL.LT.0 ) THEN
00575 INFO = -20
00576 ELSE IF( KU.LT.0 .OR. ( ISYM.EQ.0 .AND. KL.NE.KU ) ) THEN
00577 INFO = -21
00578 ELSE IF( SPARSE.LT.ZERO .OR. SPARSE.GT.ONE ) THEN
00579 INFO = -22
00580 ELSE IF( IPACK.EQ.-1 .OR. ( ( IPACK.EQ.1 .OR. IPACK.EQ.2 .OR.
00581 $ IPACK.EQ.5 .OR. IPACK.EQ.6 ) .AND. ISYM.EQ.1 ) .OR.
00582 $ ( IPACK.EQ.3 .AND. ISYM.EQ.1 .AND. ( KL.NE.0 .OR. M.NE.
00583 $ N ) ) .OR. ( IPACK.EQ.4 .AND. ISYM.EQ.1 .AND. ( KU.NE.
00584 $ 0 .OR. M.NE.N ) ) ) THEN
00585 INFO = -24
00586 ELSE IF( ( ( IPACK.EQ.0 .OR. IPACK.EQ.1 .OR. IPACK.EQ.2 ) .AND.
00587 $ LDA.LT.MAX( 1, M ) ) .OR. ( ( IPACK.EQ.3 .OR. IPACK.EQ.
00588 $ 4 ) .AND. LDA.LT.1 ) .OR. ( ( IPACK.EQ.5 .OR. IPACK.EQ.
00589 $ 6 ) .AND. LDA.LT.KUU+1 ) .OR.
00590 $ ( IPACK.EQ.7 .AND. LDA.LT.KLL+KUU+1 ) ) THEN
00591 INFO = -26
00592 END IF
00593
00594 IF( INFO.NE.0 ) THEN
00595 CALL XERBLA( 'DLATMR', -INFO )
00596 RETURN
00597 END IF
00598
00599
00600
00601 FULBND = .FALSE.
00602 IF( KUU.EQ.N-1 .AND. KLL.EQ.M-1 )
00603 $ FULBND = .TRUE.
00604
00605
00606
00607 DO 30 I = 1, 4
00608 ISEED( I ) = MOD( ABS( ISEED( I ) ), 4096 )
00609 30 CONTINUE
00610
00611 ISEED( 4 ) = 2*( ISEED( 4 ) / 2 ) + 1
00612
00613
00614
00615
00616
00617 CALL DLATM1( MODE, COND, IRSIGN, IDIST, ISEED, D, MNMIN, INFO )
00618 IF( INFO.NE.0 ) THEN
00619 INFO = 1
00620 RETURN
00621 END IF
00622 IF( MODE.NE.0 .AND. MODE.NE.-6 .AND. MODE.NE.6 ) THEN
00623
00624
00625
00626 TEMP = ABS( D( 1 ) )
00627 DO 40 I = 2, MNMIN
00628 TEMP = MAX( TEMP, ABS( D( I ) ) )
00629 40 CONTINUE
00630 IF( TEMP.EQ.ZERO .AND. DMAX.NE.ZERO ) THEN
00631 INFO = 2
00632 RETURN
00633 END IF
00634 IF( TEMP.NE.ZERO ) THEN
00635 ALPHA = DMAX / TEMP
00636 ELSE
00637 ALPHA = ONE
00638 END IF
00639 DO 50 I = 1, MNMIN
00640 D( I ) = ALPHA*D( I )
00641 50 CONTINUE
00642
00643 END IF
00644
00645
00646
00647 IF( IGRADE.EQ.1 .OR. IGRADE.EQ.3 .OR. IGRADE.EQ.4 .OR. IGRADE.EQ.
00648 $ 5 ) THEN
00649 CALL DLATM1( MODEL, CONDL, 0, IDIST, ISEED, DL, M, INFO )
00650 IF( INFO.NE.0 ) THEN
00651 INFO = 3
00652 RETURN
00653 END IF
00654 END IF
00655
00656
00657
00658 IF( IGRADE.EQ.2 .OR. IGRADE.EQ.3 ) THEN
00659 CALL DLATM1( MODER, CONDR, 0, IDIST, ISEED, DR, N, INFO )
00660 IF( INFO.NE.0 ) THEN
00661 INFO = 4
00662 RETURN
00663 END IF
00664 END IF
00665
00666
00667
00668 IF( IPVTNG.GT.0 ) THEN
00669 DO 60 I = 1, NPVTS
00670 IWORK( I ) = I
00671 60 CONTINUE
00672 IF( FULBND ) THEN
00673 DO 70 I = 1, NPVTS
00674 K = IPIVOT( I )
00675 J = IWORK( I )
00676 IWORK( I ) = IWORK( K )
00677 IWORK( K ) = J
00678 70 CONTINUE
00679 ELSE
00680 DO 80 I = NPVTS, 1, -1
00681 K = IPIVOT( I )
00682 J = IWORK( I )
00683 IWORK( I ) = IWORK( K )
00684 IWORK( K ) = J
00685 80 CONTINUE
00686 END IF
00687 END IF
00688
00689
00690
00691
00692
00693
00694 IF( FULBND ) THEN
00695
00696
00697
00698
00699 IF( IPACK.EQ.0 ) THEN
00700 IF( ISYM.EQ.0 ) THEN
00701 DO 100 J = 1, N
00702 DO 90 I = 1, J
00703 TEMP = DLATM3( M, N, I, J, ISUB, JSUB, KL, KU,
00704 $ IDIST, ISEED, D, IGRADE, DL, DR, IPVTNG,
00705 $ IWORK, SPARSE )
00706 A( ISUB, JSUB ) = TEMP
00707 A( JSUB, ISUB ) = TEMP
00708 90 CONTINUE
00709 100 CONTINUE
00710 ELSE IF( ISYM.EQ.1 ) THEN
00711 DO 120 J = 1, N
00712 DO 110 I = 1, M
00713 TEMP = DLATM3( M, N, I, J, ISUB, JSUB, KL, KU,
00714 $ IDIST, ISEED, D, IGRADE, DL, DR, IPVTNG,
00715 $ IWORK, SPARSE )
00716 A( ISUB, JSUB ) = TEMP
00717 110 CONTINUE
00718 120 CONTINUE
00719 END IF
00720
00721 ELSE IF( IPACK.EQ.1 ) THEN
00722
00723 DO 140 J = 1, N
00724 DO 130 I = 1, J
00725 TEMP = DLATM3( M, N, I, J, ISUB, JSUB, KL, KU, IDIST,
00726 $ ISEED, D, IGRADE, DL, DR, IPVTNG, IWORK,
00727 $ SPARSE )
00728 MNSUB = MIN( ISUB, JSUB )
00729 MXSUB = MAX( ISUB, JSUB )
00730 A( MNSUB, MXSUB ) = TEMP
00731 IF( MNSUB.NE.MXSUB )
00732 $ A( MXSUB, MNSUB ) = ZERO
00733 130 CONTINUE
00734 140 CONTINUE
00735
00736 ELSE IF( IPACK.EQ.2 ) THEN
00737
00738 DO 160 J = 1, N
00739 DO 150 I = 1, J
00740 TEMP = DLATM3( M, N, I, J, ISUB, JSUB, KL, KU, IDIST,
00741 $ ISEED, D, IGRADE, DL, DR, IPVTNG, IWORK,
00742 $ SPARSE )
00743 MNSUB = MIN( ISUB, JSUB )
00744 MXSUB = MAX( ISUB, JSUB )
00745 A( MXSUB, MNSUB ) = TEMP
00746 IF( MNSUB.NE.MXSUB )
00747 $ A( MNSUB, MXSUB ) = ZERO
00748 150 CONTINUE
00749 160 CONTINUE
00750
00751 ELSE IF( IPACK.EQ.3 ) THEN
00752
00753 DO 180 J = 1, N
00754 DO 170 I = 1, J
00755 TEMP = DLATM3( M, N, I, J, ISUB, JSUB, KL, KU, IDIST,
00756 $ ISEED, D, IGRADE, DL, DR, IPVTNG, IWORK,
00757 $ SPARSE )
00758
00759
00760
00761
00762 MNSUB = MIN( ISUB, JSUB )
00763 MXSUB = MAX( ISUB, JSUB )
00764 K = MXSUB*( MXSUB-1 ) / 2 + MNSUB
00765
00766
00767
00768 JJSUB = ( K-1 ) / LDA + 1
00769 IISUB = K - LDA*( JJSUB-1 )
00770
00771 A( IISUB, JJSUB ) = TEMP
00772 170 CONTINUE
00773 180 CONTINUE
00774
00775 ELSE IF( IPACK.EQ.4 ) THEN
00776
00777 DO 200 J = 1, N
00778 DO 190 I = 1, J
00779 TEMP = DLATM3( M, N, I, J, ISUB, JSUB, KL, KU, IDIST,
00780 $ ISEED, D, IGRADE, DL, DR, IPVTNG, IWORK,
00781 $ SPARSE )
00782
00783
00784
00785 MNSUB = MIN( ISUB, JSUB )
00786 MXSUB = MAX( ISUB, JSUB )
00787 IF( MNSUB.EQ.1 ) THEN
00788 K = MXSUB
00789 ELSE
00790 K = N*( N+1 ) / 2 - ( N-MNSUB+1 )*( N-MNSUB+2 ) /
00791 $ 2 + MXSUB - MNSUB + 1
00792 END IF
00793
00794
00795
00796 JJSUB = ( K-1 ) / LDA + 1
00797 IISUB = K - LDA*( JJSUB-1 )
00798
00799 A( IISUB, JJSUB ) = TEMP
00800 190 CONTINUE
00801 200 CONTINUE
00802
00803 ELSE IF( IPACK.EQ.5 ) THEN
00804
00805 DO 220 J = 1, N
00806 DO 210 I = J - KUU, J
00807 IF( I.LT.1 ) THEN
00808 A( J-I+1, I+N ) = ZERO
00809 ELSE
00810 TEMP = DLATM3( M, N, I, J, ISUB, JSUB, KL, KU,
00811 $ IDIST, ISEED, D, IGRADE, DL, DR, IPVTNG,
00812 $ IWORK, SPARSE )
00813 MNSUB = MIN( ISUB, JSUB )
00814 MXSUB = MAX( ISUB, JSUB )
00815 A( MXSUB-MNSUB+1, MNSUB ) = TEMP
00816 END IF
00817 210 CONTINUE
00818 220 CONTINUE
00819
00820 ELSE IF( IPACK.EQ.6 ) THEN
00821
00822 DO 240 J = 1, N
00823 DO 230 I = J - KUU, J
00824 TEMP = DLATM3( M, N, I, J, ISUB, JSUB, KL, KU, IDIST,
00825 $ ISEED, D, IGRADE, DL, DR, IPVTNG, IWORK,
00826 $ SPARSE )
00827 MNSUB = MIN( ISUB, JSUB )
00828 MXSUB = MAX( ISUB, JSUB )
00829 A( MNSUB-MXSUB+KUU+1, MXSUB ) = TEMP
00830 230 CONTINUE
00831 240 CONTINUE
00832
00833 ELSE IF( IPACK.EQ.7 ) THEN
00834
00835 IF( ISYM.EQ.0 ) THEN
00836 DO 260 J = 1, N
00837 DO 250 I = J - KUU, J
00838 TEMP = DLATM3( M, N, I, J, ISUB, JSUB, KL, KU,
00839 $ IDIST, ISEED, D, IGRADE, DL, DR, IPVTNG,
00840 $ IWORK, SPARSE )
00841 MNSUB = MIN( ISUB, JSUB )
00842 MXSUB = MAX( ISUB, JSUB )
00843 A( MNSUB-MXSUB+KUU+1, MXSUB ) = TEMP
00844 IF( I.LT.1 )
00845 $ A( J-I+1+KUU, I+N ) = ZERO
00846 IF( I.GE.1 .AND. MNSUB.NE.MXSUB )
00847 $ A( MXSUB-MNSUB+1+KUU, MNSUB ) = TEMP
00848 250 CONTINUE
00849 260 CONTINUE
00850 ELSE IF( ISYM.EQ.1 ) THEN
00851 DO 280 J = 1, N
00852 DO 270 I = J - KUU, J + KLL
00853 TEMP = DLATM3( M, N, I, J, ISUB, JSUB, KL, KU,
00854 $ IDIST, ISEED, D, IGRADE, DL, DR, IPVTNG,
00855 $ IWORK, SPARSE )
00856 A( ISUB-JSUB+KUU+1, JSUB ) = TEMP
00857 270 CONTINUE
00858 280 CONTINUE
00859 END IF
00860
00861 END IF
00862
00863 ELSE
00864
00865
00866
00867 IF( IPACK.EQ.0 ) THEN
00868 IF( ISYM.EQ.0 ) THEN
00869 DO 300 J = 1, N
00870 DO 290 I = 1, J
00871 A( I, J ) = DLATM2( M, N, I, J, KL, KU, IDIST,
00872 $ ISEED, D, IGRADE, DL, DR, IPVTNG,
00873 $ IWORK, SPARSE )
00874 A( J, I ) = A( I, J )
00875 290 CONTINUE
00876 300 CONTINUE
00877 ELSE IF( ISYM.EQ.1 ) THEN
00878 DO 320 J = 1, N
00879 DO 310 I = 1, M
00880 A( I, J ) = DLATM2( M, N, I, J, KL, KU, IDIST,
00881 $ ISEED, D, IGRADE, DL, DR, IPVTNG,
00882 $ IWORK, SPARSE )
00883 310 CONTINUE
00884 320 CONTINUE
00885 END IF
00886
00887 ELSE IF( IPACK.EQ.1 ) THEN
00888
00889 DO 340 J = 1, N
00890 DO 330 I = 1, J
00891 A( I, J ) = DLATM2( M, N, I, J, KL, KU, IDIST, ISEED,
00892 $ D, IGRADE, DL, DR, IPVTNG, IWORK, SPARSE )
00893 IF( I.NE.J )
00894 $ A( J, I ) = ZERO
00895 330 CONTINUE
00896 340 CONTINUE
00897
00898 ELSE IF( IPACK.EQ.2 ) THEN
00899
00900 DO 360 J = 1, N
00901 DO 350 I = 1, J
00902 A( J, I ) = DLATM2( M, N, I, J, KL, KU, IDIST, ISEED,
00903 $ D, IGRADE, DL, DR, IPVTNG, IWORK, SPARSE )
00904 IF( I.NE.J )
00905 $ A( I, J ) = ZERO
00906 350 CONTINUE
00907 360 CONTINUE
00908
00909 ELSE IF( IPACK.EQ.3 ) THEN
00910
00911 ISUB = 0
00912 JSUB = 1
00913 DO 380 J = 1, N
00914 DO 370 I = 1, J
00915 ISUB = ISUB + 1
00916 IF( ISUB.GT.LDA ) THEN
00917 ISUB = 1
00918 JSUB = JSUB + 1
00919 END IF
00920 A( ISUB, JSUB ) = DLATM2( M, N, I, J, KL, KU, IDIST,
00921 $ ISEED, D, IGRADE, DL, DR, IPVTNG,
00922 $ IWORK, SPARSE )
00923 370 CONTINUE
00924 380 CONTINUE
00925
00926 ELSE IF( IPACK.EQ.4 ) THEN
00927
00928 IF( ISYM.EQ.0 ) THEN
00929 DO 400 J = 1, N
00930 DO 390 I = 1, J
00931
00932
00933
00934 IF( I.EQ.1 ) THEN
00935 K = J
00936 ELSE
00937 K = N*( N+1 ) / 2 - ( N-I+1 )*( N-I+2 ) / 2 +
00938 $ J - I + 1
00939 END IF
00940
00941
00942
00943 JSUB = ( K-1 ) / LDA + 1
00944 ISUB = K - LDA*( JSUB-1 )
00945
00946 A( ISUB, JSUB ) = DLATM2( M, N, I, J, KL, KU,
00947 $ IDIST, ISEED, D, IGRADE, DL, DR,
00948 $ IPVTNG, IWORK, SPARSE )
00949 390 CONTINUE
00950 400 CONTINUE
00951 ELSE
00952 ISUB = 0
00953 JSUB = 1
00954 DO 420 J = 1, N
00955 DO 410 I = J, M
00956 ISUB = ISUB + 1
00957 IF( ISUB.GT.LDA ) THEN
00958 ISUB = 1
00959 JSUB = JSUB + 1
00960 END IF
00961 A( ISUB, JSUB ) = DLATM2( M, N, I, J, KL, KU,
00962 $ IDIST, ISEED, D, IGRADE, DL, DR,
00963 $ IPVTNG, IWORK, SPARSE )
00964 410 CONTINUE
00965 420 CONTINUE
00966 END IF
00967
00968 ELSE IF( IPACK.EQ.5 ) THEN
00969
00970 DO 440 J = 1, N
00971 DO 430 I = J - KUU, J
00972 IF( I.LT.1 ) THEN
00973 A( J-I+1, I+N ) = ZERO
00974 ELSE
00975 A( J-I+1, I ) = DLATM2( M, N, I, J, KL, KU, IDIST,
00976 $ ISEED, D, IGRADE, DL, DR, IPVTNG,
00977 $ IWORK, SPARSE )
00978 END IF
00979 430 CONTINUE
00980 440 CONTINUE
00981
00982 ELSE IF( IPACK.EQ.6 ) THEN
00983
00984 DO 460 J = 1, N
00985 DO 450 I = J - KUU, J
00986 A( I-J+KUU+1, J ) = DLATM2( M, N, I, J, KL, KU, IDIST,
00987 $ ISEED, D, IGRADE, DL, DR, IPVTNG,
00988 $ IWORK, SPARSE )
00989 450 CONTINUE
00990 460 CONTINUE
00991
00992 ELSE IF( IPACK.EQ.7 ) THEN
00993
00994 IF( ISYM.EQ.0 ) THEN
00995 DO 480 J = 1, N
00996 DO 470 I = J - KUU, J
00997 A( I-J+KUU+1, J ) = DLATM2( M, N, I, J, KL, KU,
00998 $ IDIST, ISEED, D, IGRADE, DL,
00999 $ DR, IPVTNG, IWORK, SPARSE )
01000 IF( I.LT.1 )
01001 $ A( J-I+1+KUU, I+N ) = ZERO
01002 IF( I.GE.1 .AND. I.NE.J )
01003 $ A( J-I+1+KUU, I ) = A( I-J+KUU+1, J )
01004 470 CONTINUE
01005 480 CONTINUE
01006 ELSE IF( ISYM.EQ.1 ) THEN
01007 DO 500 J = 1, N
01008 DO 490 I = J - KUU, J + KLL
01009 A( I-J+KUU+1, J ) = DLATM2( M, N, I, J, KL, KU,
01010 $ IDIST, ISEED, D, IGRADE, DL,
01011 $ DR, IPVTNG, IWORK, SPARSE )
01012 490 CONTINUE
01013 500 CONTINUE
01014 END IF
01015
01016 END IF
01017
01018 END IF
01019
01020
01021
01022 IF( IPACK.EQ.0 ) THEN
01023 ONORM = DLANGE( 'M', M, N, A, LDA, TEMPA )
01024 ELSE IF( IPACK.EQ.1 ) THEN
01025 ONORM = DLANSY( 'M', 'U', N, A, LDA, TEMPA )
01026 ELSE IF( IPACK.EQ.2 ) THEN
01027 ONORM = DLANSY( 'M', 'L', N, A, LDA, TEMPA )
01028 ELSE IF( IPACK.EQ.3 ) THEN
01029 ONORM = DLANSP( 'M', 'U', N, A, TEMPA )
01030 ELSE IF( IPACK.EQ.4 ) THEN
01031 ONORM = DLANSP( 'M', 'L', N, A, TEMPA )
01032 ELSE IF( IPACK.EQ.5 ) THEN
01033 ONORM = DLANSB( 'M', 'L', N, KLL, A, LDA, TEMPA )
01034 ELSE IF( IPACK.EQ.6 ) THEN
01035 ONORM = DLANSB( 'M', 'U', N, KUU, A, LDA, TEMPA )
01036 ELSE IF( IPACK.EQ.7 ) THEN
01037 ONORM = DLANGB( 'M', N, KLL, KUU, A, LDA, TEMPA )
01038 END IF
01039
01040 IF( ANORM.GE.ZERO ) THEN
01041
01042 IF( ANORM.GT.ZERO .AND. ONORM.EQ.ZERO ) THEN
01043
01044
01045
01046 INFO = 5
01047 RETURN
01048
01049 ELSE IF( ( ANORM.GT.ONE .AND. ONORM.LT.ONE ) .OR.
01050 $ ( ANORM.LT.ONE .AND. ONORM.GT.ONE ) ) THEN
01051
01052
01053
01054 IF( IPACK.LE.2 ) THEN
01055 DO 510 J = 1, N
01056 CALL DSCAL( M, ONE / ONORM, A( 1, J ), 1 )
01057 CALL DSCAL( M, ANORM, A( 1, J ), 1 )
01058 510 CONTINUE
01059
01060 ELSE IF( IPACK.EQ.3 .OR. IPACK.EQ.4 ) THEN
01061
01062 CALL DSCAL( N*( N+1 ) / 2, ONE / ONORM, A, 1 )
01063 CALL DSCAL( N*( N+1 ) / 2, ANORM, A, 1 )
01064
01065 ELSE IF( IPACK.GE.5 ) THEN
01066
01067 DO 520 J = 1, N
01068 CALL DSCAL( KLL+KUU+1, ONE / ONORM, A( 1, J ), 1 )
01069 CALL DSCAL( KLL+KUU+1, ANORM, A( 1, J ), 1 )
01070 520 CONTINUE
01071
01072 END IF
01073
01074 ELSE
01075
01076
01077
01078 IF( IPACK.LE.2 ) THEN
01079 DO 530 J = 1, N
01080 CALL DSCAL( M, ANORM / ONORM, A( 1, J ), 1 )
01081 530 CONTINUE
01082
01083 ELSE IF( IPACK.EQ.3 .OR. IPACK.EQ.4 ) THEN
01084
01085 CALL DSCAL( N*( N+1 ) / 2, ANORM / ONORM, A, 1 )
01086
01087 ELSE IF( IPACK.GE.5 ) THEN
01088
01089 DO 540 J = 1, N
01090 CALL DSCAL( KLL+KUU+1, ANORM / ONORM, A( 1, J ), 1 )
01091 540 CONTINUE
01092 END IF
01093
01094 END IF
01095
01096 END IF
01097
01098
01099
01100 END