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