159 SUBROUTINE dsbgst( VECT, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, X,
169 INTEGER INFO, KA, KB, LDAB, LDBB, LDX, N
172 DOUBLE PRECISION AB( ldab, * ), BB( ldbb, * ), WORK( * ),
179 DOUBLE PRECISION ZERO, ONE
180 parameter ( zero = 0.0d+0, one = 1.0d+0 )
183 LOGICAL UPDATE, UPPER, WANTX
184 INTEGER I, I0, I1, I2, INCA, J, J1, J1T, J2, J2T, K,
185 $ ka1, kb1, kbt, l, m, nr, nrt, nx
186 DOUBLE PRECISION BII, RA, RA1, T
203 wantx = lsame( vect,
'V' )
204 upper = lsame( uplo,
'U' )
208 IF( .NOT.wantx .AND. .NOT.lsame( vect,
'N' ) )
THEN
210 ELSE IF( .NOT.upper .AND. .NOT.lsame( uplo,
'L' ) )
THEN
212 ELSE IF( n.LT.0 )
THEN
214 ELSE IF( ka.LT.0 )
THEN
216 ELSE IF( kb.LT.0 .OR. kb.GT.ka )
THEN
218 ELSE IF( ldab.LT.ka+1 )
THEN
220 ELSE IF( ldbb.LT.kb+1 )
THEN
222 ELSE IF( ldx.LT.1 .OR. wantx .AND. ldx.LT.max( 1, n ) )
THEN
226 CALL xerbla(
'DSBGST', -info )
240 $
CALL dlaset(
'Full', n, n, zero, one, x, ldx )
342 ab( i-j+ka1, j ) = ab( i-j+ka1, j ) / bii
344 DO 30 j = max( 1, i-ka ), i
345 ab( j-i+ka1, i ) = ab( j-i+ka1, i ) / bii
347 DO 60 k = i - kbt, i - 1
349 ab( j-k+ka1, k ) = ab( j-k+ka1, k ) -
350 $ bb( j-i+kb1, i )*ab( k-i+ka1, i ) -
351 $ bb( k-i+kb1, i )*ab( j-i+ka1, i ) +
352 $ ab( ka1, i )*bb( j-i+kb1, i )*
355 DO 50 j = max( 1, i-ka ), i - kbt - 1
356 ab( j-k+ka1, k ) = ab( j-k+ka1, k ) -
357 $ bb( k-i+kb1, i )*ab( j-i+ka1, i )
361 DO 70 k = max( j-ka, i-kbt ), i - 1
362 ab( k-j+ka1, j ) = ab( k-j+ka1, j ) -
363 $ bb( k-i+kb1, i )*ab( i-j+ka1, j )
371 CALL dscal( n-m, one / bii, x( m+1, i ), 1 )
373 $
CALL dger( n-m, kbt, -one, x( m+1, i ), 1,
374 $ bb( kb1-kbt, i ), 1, x( m+1, i-kbt ), ldx )
379 ra1 = ab( i-i1+ka1, i1 )
392 IF( i-k+ka.LT.n .AND. i-k.GT.1 )
THEN
396 CALL dlartg( ab( k+1, i-k+ka ), ra1,
397 $ work( n+i-k+ka-m ), work( i-k+ka-m ),
403 t = -bb( kb1-k, i )*ra1
404 work( i-k ) = work( n+i-k+ka-m )*t -
405 $ work( i-k+ka-m )*ab( 1, i-k+ka )
406 ab( 1, i-k+ka ) = work( i-k+ka-m )*t +
407 $ work( n+i-k+ka-m )*ab( 1, i-k+ka )
411 j2 = i - k - 1 + max( 1, k-i0+2 )*ka1
412 nr = ( n-j2+ka ) / ka1
413 j1 = j2 + ( nr-1 )*ka1
415 j2t = max( j2, i+2*ka-k+1 )
419 nrt = ( n-j2t+ka ) / ka1
420 DO 90 j = j2t, j1, ka1
425 work( j-m ) = work( j-m )*ab( 1, j+1 )
426 ab( 1, j+1 ) = work( n+j-m )*ab( 1, j+1 )
433 $
CALL dlargv( nrt, ab( 1, j2t ), inca, work( j2t-m ), ka1,
434 $ work( n+j2t-m ), ka1 )
440 CALL dlartv( nr, ab( ka1-l, j2 ), inca,
441 $ ab( ka-l, j2+1 ), inca, work( n+j2-m ),
442 $ work( j2-m ), ka1 )
448 CALL dlar2v( nr, ab( ka1, j2 ), ab( ka1, j2+1 ),
449 $ ab( ka, j2+1 ), inca, work( n+j2-m ),
450 $ work( j2-m ), ka1 )
456 DO 110 l = ka - 1, kb - k + 1, -1
457 nrt = ( n-j2+l ) / ka1
459 $
CALL dlartv( nrt, ab( l, j2+ka1-l ), inca,
460 $ ab( l+1, j2+ka1-l ), inca,
461 $ work( n+j2-m ), work( j2-m ), ka1 )
468 DO 120 j = j2, j1, ka1
469 CALL drot( n-m, x( m+1, j ), 1, x( m+1, j+1 ), 1,
470 $ work( n+j-m ), work( j-m ) )
476 IF( i2.LE.n .AND. kbt.GT.0 )
THEN
481 work( i-kbt ) = -bb( kb1-kbt, i )*ra1
487 j2 = i - k - 1 + max( 2, k-i0+1 )*ka1
489 j2 = i - k - 1 + max( 1, k-i0+1 )*ka1
494 DO 140 l = kb - k, 1, -1
495 nrt = ( n-j2+ka+l ) / ka1
497 $
CALL dlartv( nrt, ab( l, j2-l+1 ), inca,
498 $ ab( l+1, j2-l+1 ), inca, work( n+j2-ka ),
499 $ work( j2-ka ), ka1 )
501 nr = ( n-j2+ka ) / ka1
502 j1 = j2 + ( nr-1 )*ka1
503 DO 150 j = j1, j2, -ka1
504 work( j ) = work( j-ka )
505 work( n+j ) = work( n+j-ka )
507 DO 160 j = j2, j1, ka1
512 work( j ) = work( j )*ab( 1, j+1 )
513 ab( 1, j+1 ) = work( n+j )*ab( 1, j+1 )
516 IF( i-k.LT.n-ka .AND. k.LE.kbt )
517 $ work( i-k+ka ) = work( i-k )
522 j2 = i - k - 1 + max( 1, k-i0+1 )*ka1
523 nr = ( n-j2+ka ) / ka1
524 j1 = j2 + ( nr-1 )*ka1
530 CALL dlargv( nr, ab( 1, j2 ), inca, work( j2 ), ka1,
531 $ work( n+j2 ), ka1 )
536 CALL dlartv( nr, ab( ka1-l, j2 ), inca,
537 $ ab( ka-l, j2+1 ), inca, work( n+j2 ),
544 CALL dlar2v( nr, ab( ka1, j2 ), ab( ka1, j2+1 ),
545 $ ab( ka, j2+1 ), inca, work( n+j2 ),
552 DO 190 l = ka - 1, kb - k + 1, -1
553 nrt = ( n-j2+l ) / ka1
555 $
CALL dlartv( nrt, ab( l, j2+ka1-l ), inca,
556 $ ab( l+1, j2+ka1-l ), inca, work( n+j2 ),
564 DO 200 j = j2, j1, ka1
565 CALL drot( n-m, x( m+1, j ), 1, x( m+1, j+1 ), 1,
566 $ work( n+j ), work( j ) )
572 j2 = i - k - 1 + max( 1, k-i0+2 )*ka1
576 DO 220 l = kb - k, 1, -1
577 nrt = ( n-j2+l ) / ka1
579 $
CALL dlartv( nrt, ab( l, j2+ka1-l ), inca,
580 $ ab( l+1, j2+ka1-l ), inca,
581 $ work( n+j2-m ), work( j2-m ), ka1 )
586 DO 240 j = n - 1, i - kb + 2*ka + 1, -1
587 work( n+j-m ) = work( n+j-ka-m )
588 work( j-m ) = work( j-ka-m )
602 ab( j-i+1, i ) = ab( j-i+1, i ) / bii
604 DO 260 j = max( 1, i-ka ), i
605 ab( i-j+1, j ) = ab( i-j+1, j ) / bii
607 DO 290 k = i - kbt, i - 1
608 DO 270 j = i - kbt, k
609 ab( k-j+1, j ) = ab( k-j+1, j ) -
610 $ bb( i-j+1, j )*ab( i-k+1, k ) -
611 $ bb( i-k+1, k )*ab( i-j+1, j ) +
612 $ ab( 1, i )*bb( i-j+1, j )*
615 DO 280 j = max( 1, i-ka ), i - kbt - 1
616 ab( k-j+1, j ) = ab( k-j+1, j ) -
617 $ bb( i-k+1, k )*ab( i-j+1, j )
621 DO 300 k = max( j-ka, i-kbt ), i - 1
622 ab( j-k+1, k ) = ab( j-k+1, k ) -
623 $ bb( i-k+1, k )*ab( j-i+1, i )
631 CALL dscal( n-m, one / bii, x( m+1, i ), 1 )
633 $
CALL dger( n-m, kbt, -one, x( m+1, i ), 1,
634 $ bb( kbt+1, i-kbt ), ldbb-1,
635 $ x( m+1, i-kbt ), ldx )
640 ra1 = ab( i1-i+1, i )
653 IF( i-k+ka.LT.n .AND. i-k.GT.1 )
THEN
657 CALL dlartg( ab( ka1-k, i ), ra1, work( n+i-k+ka-m ),
658 $ work( i-k+ka-m ), ra )
663 t = -bb( k+1, i-k )*ra1
664 work( i-k ) = work( n+i-k+ka-m )*t -
665 $ work( i-k+ka-m )*ab( ka1, i-k )
666 ab( ka1, i-k ) = work( i-k+ka-m )*t +
667 $ work( n+i-k+ka-m )*ab( ka1, i-k )
671 j2 = i - k - 1 + max( 1, k-i0+2 )*ka1
672 nr = ( n-j2+ka ) / ka1
673 j1 = j2 + ( nr-1 )*ka1
675 j2t = max( j2, i+2*ka-k+1 )
679 nrt = ( n-j2t+ka ) / ka1
680 DO 320 j = j2t, j1, ka1
685 work( j-m ) = work( j-m )*ab( ka1, j-ka+1 )
686 ab( ka1, j-ka+1 ) = work( n+j-m )*ab( ka1, j-ka+1 )
693 $
CALL dlargv( nrt, ab( ka1, j2t-ka ), inca, work( j2t-m ),
694 $ ka1, work( n+j2t-m ), ka1 )
700 CALL dlartv( nr, ab( l+1, j2-l ), inca,
701 $ ab( l+2, j2-l ), inca, work( n+j2-m ),
702 $ work( j2-m ), ka1 )
708 CALL dlar2v( nr, ab( 1, j2 ), ab( 1, j2+1 ), ab( 2, j2 ),
709 $ inca, work( n+j2-m ), work( j2-m ), ka1 )
715 DO 340 l = ka - 1, kb - k + 1, -1
716 nrt = ( n-j2+l ) / ka1
718 $
CALL dlartv( nrt, ab( ka1-l+1, j2 ), inca,
719 $ ab( ka1-l, j2+1 ), inca, work( n+j2-m ),
720 $ work( j2-m ), ka1 )
727 DO 350 j = j2, j1, ka1
728 CALL drot( n-m, x( m+1, j ), 1, x( m+1, j+1 ), 1,
729 $ work( n+j-m ), work( j-m ) )
735 IF( i2.LE.n .AND. kbt.GT.0 )
THEN
740 work( i-kbt ) = -bb( kbt+1, i-kbt )*ra1
746 j2 = i - k - 1 + max( 2, k-i0+1 )*ka1
748 j2 = i - k - 1 + max( 1, k-i0+1 )*ka1
753 DO 370 l = kb - k, 1, -1
754 nrt = ( n-j2+ka+l ) / ka1
756 $
CALL dlartv( nrt, ab( ka1-l+1, j2-ka ), inca,
757 $ ab( ka1-l, j2-ka+1 ), inca,
758 $ work( n+j2-ka ), work( j2-ka ), ka1 )
760 nr = ( n-j2+ka ) / ka1
761 j1 = j2 + ( nr-1 )*ka1
762 DO 380 j = j1, j2, -ka1
763 work( j ) = work( j-ka )
764 work( n+j ) = work( n+j-ka )
766 DO 390 j = j2, j1, ka1
771 work( j ) = work( j )*ab( ka1, j-ka+1 )
772 ab( ka1, j-ka+1 ) = work( n+j )*ab( ka1, j-ka+1 )
775 IF( i-k.LT.n-ka .AND. k.LE.kbt )
776 $ work( i-k+ka ) = work( i-k )
781 j2 = i - k - 1 + max( 1, k-i0+1 )*ka1
782 nr = ( n-j2+ka ) / ka1
783 j1 = j2 + ( nr-1 )*ka1
789 CALL dlargv( nr, ab( ka1, j2-ka ), inca, work( j2 ), ka1,
790 $ work( n+j2 ), ka1 )
795 CALL dlartv( nr, ab( l+1, j2-l ), inca,
796 $ ab( l+2, j2-l ), inca, work( n+j2 ),
803 CALL dlar2v( nr, ab( 1, j2 ), ab( 1, j2+1 ), ab( 2, j2 ),
804 $ inca, work( n+j2 ), work( j2 ), ka1 )
810 DO 420 l = ka - 1, kb - k + 1, -1
811 nrt = ( n-j2+l ) / ka1
813 $
CALL dlartv( nrt, ab( ka1-l+1, j2 ), inca,
814 $ ab( ka1-l, j2+1 ), inca, work( n+j2 ),
822 DO 430 j = j2, j1, ka1
823 CALL drot( n-m, x( m+1, j ), 1, x( m+1, j+1 ), 1,
824 $ work( n+j ), work( j ) )
830 j2 = i - k - 1 + max( 1, k-i0+2 )*ka1
834 DO 450 l = kb - k, 1, -1
835 nrt = ( n-j2+l ) / ka1
837 $
CALL dlartv( nrt, ab( ka1-l+1, j2 ), inca,
838 $ ab( ka1-l, j2+1 ), inca, work( n+j2-m ),
839 $ work( j2-m ), ka1 )
844 DO 470 j = n - 1, i - kb + 2*ka + 1, -1
845 work( n+j-m ) = work( n+j-ka-m )
846 work( j-m ) = work( j-ka-m )
895 IF( i.LT.m-kbt )
THEN
911 ab( j-i+ka1, i ) = ab( j-i+ka1, i ) / bii
913 DO 510 j = i, min( n, i+ka )
914 ab( i-j+ka1, j ) = ab( i-j+ka1, j ) / bii
916 DO 540 k = i + 1, i + kbt
917 DO 520 j = k, i + kbt
918 ab( k-j+ka1, j ) = ab( k-j+ka1, j ) -
919 $ bb( i-j+kb1, j )*ab( i-k+ka1, k ) -
920 $ bb( i-k+kb1, k )*ab( i-j+ka1, j ) +
921 $ ab( ka1, i )*bb( i-j+kb1, j )*
924 DO 530 j = i + kbt + 1, min( n, i+ka )
925 ab( k-j+ka1, j ) = ab( k-j+ka1, j ) -
926 $ bb( i-k+kb1, k )*ab( i-j+ka1, j )
930 DO 550 k = i + 1, min( j+ka, i+kbt )
931 ab( j-k+ka1, k ) = ab( j-k+ka1, k ) -
932 $ bb( i-k+kb1, k )*ab( j-i+ka1, i )
940 CALL dscal( nx, one / bii, x( 1, i ), 1 )
942 $
CALL dger( nx, kbt, -one, x( 1, i ), 1, bb( kb, i+1 ),
943 $ ldbb-1, x( 1, i+1 ), ldx )
948 ra1 = ab( i1-i+ka1, i )
960 IF( i+k-ka1.GT.0 .AND. i+k.LT.m )
THEN
964 CALL dlartg( ab( k+1, i ), ra1, work( n+i+k-ka ),
965 $ work( i+k-ka ), ra )
970 t = -bb( kb1-k, i+k )*ra1
971 work( m-kb+i+k ) = work( n+i+k-ka )*t -
972 $ work( i+k-ka )*ab( 1, i+k )
973 ab( 1, i+k ) = work( i+k-ka )*t +
974 $ work( n+i+k-ka )*ab( 1, i+k )
978 j2 = i + k + 1 - max( 1, k+i0-m+1 )*ka1
979 nr = ( j2+ka-1 ) / ka1
980 j1 = j2 - ( nr-1 )*ka1
982 j2t = min( j2, i-2*ka+k-1 )
986 nrt = ( j2t+ka-1 ) / ka1
987 DO 570 j = j1, j2t, ka1
992 work( j ) = work( j )*ab( 1, j+ka-1 )
993 ab( 1, j+ka-1 ) = work( n+j )*ab( 1, j+ka-1 )
1000 $
CALL dlargv( nrt, ab( 1, j1+ka ), inca, work( j1 ), ka1,
1001 $ work( n+j1 ), ka1 )
1006 DO 580 l = 1, ka - 1
1007 CALL dlartv( nr, ab( ka1-l, j1+l ), inca,
1008 $ ab( ka-l, j1+l ), inca, work( n+j1 ),
1015 CALL dlar2v( nr, ab( ka1, j1 ), ab( ka1, j1-1 ),
1016 $ ab( ka, j1 ), inca, work( n+j1 ),
1023 DO 590 l = ka - 1, kb - k + 1, -1
1024 nrt = ( j2+l-1 ) / ka1
1025 j1t = j2 - ( nrt-1 )*ka1
1027 $
CALL dlartv( nrt, ab( l, j1t ), inca,
1028 $ ab( l+1, j1t-1 ), inca, work( n+j1t ),
1029 $ work( j1t ), ka1 )
1036 DO 600 j = j1, j2, ka1
1037 CALL drot( nx, x( 1, j ), 1, x( 1, j-1 ), 1,
1038 $ work( n+j ), work( j ) )
1044 IF( i2.GT.0 .AND. kbt.GT.0 )
THEN
1049 work( m-kb+i+kbt ) = -bb( kb1-kbt, i+kbt )*ra1
1053 DO 650 k = kb, 1, -1
1055 j2 = i + k + 1 - max( 2, k+i0-m )*ka1
1057 j2 = i + k + 1 - max( 1, k+i0-m )*ka1
1062 DO 620 l = kb - k, 1, -1
1063 nrt = ( j2+ka+l-1 ) / ka1
1064 j1t = j2 - ( nrt-1 )*ka1
1066 $
CALL dlartv( nrt, ab( l, j1t+ka ), inca,
1067 $ ab( l+1, j1t+ka-1 ), inca,
1068 $ work( n+m-kb+j1t+ka ),
1069 $ work( m-kb+j1t+ka ), ka1 )
1071 nr = ( j2+ka-1 ) / ka1
1072 j1 = j2 - ( nr-1 )*ka1
1073 DO 630 j = j1, j2, ka1
1074 work( m-kb+j ) = work( m-kb+j+ka )
1075 work( n+m-kb+j ) = work( n+m-kb+j+ka )
1077 DO 640 j = j1, j2, ka1
1082 work( m-kb+j ) = work( m-kb+j )*ab( 1, j+ka-1 )
1083 ab( 1, j+ka-1 ) = work( n+m-kb+j )*ab( 1, j+ka-1 )
1086 IF( i+k.GT.ka1 .AND. k.LE.kbt )
1087 $ work( m-kb+i+k-ka ) = work( m-kb+i+k )
1091 DO 690 k = kb, 1, -1
1092 j2 = i + k + 1 - max( 1, k+i0-m )*ka1
1093 nr = ( j2+ka-1 ) / ka1
1094 j1 = j2 - ( nr-1 )*ka1
1100 CALL dlargv( nr, ab( 1, j1+ka ), inca, work( m-kb+j1 ),
1101 $ ka1, work( n+m-kb+j1 ), ka1 )
1105 DO 660 l = 1, ka - 1
1106 CALL dlartv( nr, ab( ka1-l, j1+l ), inca,
1107 $ ab( ka-l, j1+l ), inca,
1108 $ work( n+m-kb+j1 ), work( m-kb+j1 ), ka1 )
1114 CALL dlar2v( nr, ab( ka1, j1 ), ab( ka1, j1-1 ),
1115 $ ab( ka, j1 ), inca, work( n+m-kb+j1 ),
1116 $ work( m-kb+j1 ), ka1 )
1122 DO 670 l = ka - 1, kb - k + 1, -1
1123 nrt = ( j2+l-1 ) / ka1
1124 j1t = j2 - ( nrt-1 )*ka1
1126 $
CALL dlartv( nrt, ab( l, j1t ), inca,
1127 $ ab( l+1, j1t-1 ), inca,
1128 $ work( n+m-kb+j1t ), work( m-kb+j1t ),
1136 DO 680 j = j1, j2, ka1
1137 CALL drot( nx, x( 1, j ), 1, x( 1, j-1 ), 1,
1138 $ work( n+m-kb+j ), work( m-kb+j ) )
1143 DO 710 k = 1, kb - 1
1144 j2 = i + k + 1 - max( 1, k+i0-m+1 )*ka1
1148 DO 700 l = kb - k, 1, -1
1149 nrt = ( j2+l-1 ) / ka1
1150 j1t = j2 - ( nrt-1 )*ka1
1152 $
CALL dlartv( nrt, ab( l, j1t ), inca,
1153 $ ab( l+1, j1t-1 ), inca, work( n+j1t ),
1154 $ work( j1t ), ka1 )
1159 DO 720 j = 2, min( i+kb, m ) - 2*ka - 1
1160 work( n+j ) = work( n+j+ka )
1161 work( j ) = work( j+ka )
1175 ab( i-j+1, j ) = ab( i-j+1, j ) / bii
1177 DO 740 j = i, min( n, i+ka )
1178 ab( j-i+1, i ) = ab( j-i+1, i ) / bii
1180 DO 770 k = i + 1, i + kbt
1181 DO 750 j = k, i + kbt
1182 ab( j-k+1, k ) = ab( j-k+1, k ) -
1183 $ bb( j-i+1, i )*ab( k-i+1, i ) -
1184 $ bb( k-i+1, i )*ab( j-i+1, i ) +
1185 $ ab( 1, i )*bb( j-i+1, i )*
1188 DO 760 j = i + kbt + 1, min( n, i+ka )
1189 ab( j-k+1, k ) = ab( j-k+1, k ) -
1190 $ bb( k-i+1, i )*ab( j-i+1, i )
1194 DO 780 k = i + 1, min( j+ka, i+kbt )
1195 ab( k-j+1, j ) = ab( k-j+1, j ) -
1196 $ bb( k-i+1, i )*ab( i-j+1, j )
1204 CALL dscal( nx, one / bii, x( 1, i ), 1 )
1206 $
CALL dger( nx, kbt, -one, x( 1, i ), 1, bb( 2, i ), 1,
1207 $ x( 1, i+1 ), ldx )
1212 ra1 = ab( i-i1+1, i1 )
1218 DO 840 k = 1, kb - 1
1224 IF( i+k-ka1.GT.0 .AND. i+k.LT.m )
THEN
1228 CALL dlartg( ab( ka1-k, i+k-ka ), ra1,
1229 $ work( n+i+k-ka ), work( i+k-ka ), ra )
1234 t = -bb( k+1, i )*ra1
1235 work( m-kb+i+k ) = work( n+i+k-ka )*t -
1236 $ work( i+k-ka )*ab( ka1, i+k-ka )
1237 ab( ka1, i+k-ka ) = work( i+k-ka )*t +
1238 $ work( n+i+k-ka )*ab( ka1, i+k-ka )
1242 j2 = i + k + 1 - max( 1, k+i0-m+1 )*ka1
1243 nr = ( j2+ka-1 ) / ka1
1244 j1 = j2 - ( nr-1 )*ka1
1246 j2t = min( j2, i-2*ka+k-1 )
1250 nrt = ( j2t+ka-1 ) / ka1
1251 DO 800 j = j1, j2t, ka1
1256 work( j ) = work( j )*ab( ka1, j-1 )
1257 ab( ka1, j-1 ) = work( n+j )*ab( ka1, j-1 )
1264 $
CALL dlargv( nrt, ab( ka1, j1 ), inca, work( j1 ), ka1,
1265 $ work( n+j1 ), ka1 )
1270 DO 810 l = 1, ka - 1
1271 CALL dlartv( nr, ab( l+1, j1 ), inca, ab( l+2, j1-1 ),
1272 $ inca, work( n+j1 ), work( j1 ), ka1 )
1278 CALL dlar2v( nr, ab( 1, j1 ), ab( 1, j1-1 ),
1279 $ ab( 2, j1-1 ), inca, work( n+j1 ),
1286 DO 820 l = ka - 1, kb - k + 1, -1
1287 nrt = ( j2+l-1 ) / ka1
1288 j1t = j2 - ( nrt-1 )*ka1
1290 $
CALL dlartv( nrt, ab( ka1-l+1, j1t-ka1+l ), inca,
1291 $ ab( ka1-l, j1t-ka1+l ), inca,
1292 $ work( n+j1t ), work( j1t ), ka1 )
1299 DO 830 j = j1, j2, ka1
1300 CALL drot( nx, x( 1, j ), 1, x( 1, j-1 ), 1,
1301 $ work( n+j ), work( j ) )
1307 IF( i2.GT.0 .AND. kbt.GT.0 )
THEN
1312 work( m-kb+i+kbt ) = -bb( kbt+1, i )*ra1
1316 DO 880 k = kb, 1, -1
1318 j2 = i + k + 1 - max( 2, k+i0-m )*ka1
1320 j2 = i + k + 1 - max( 1, k+i0-m )*ka1
1325 DO 850 l = kb - k, 1, -1
1326 nrt = ( j2+ka+l-1 ) / ka1
1327 j1t = j2 - ( nrt-1 )*ka1
1329 $
CALL dlartv( nrt, ab( ka1-l+1, j1t+l-1 ), inca,
1330 $ ab( ka1-l, j1t+l-1 ), inca,
1331 $ work( n+m-kb+j1t+ka ),
1332 $ work( m-kb+j1t+ka ), ka1 )
1334 nr = ( j2+ka-1 ) / ka1
1335 j1 = j2 - ( nr-1 )*ka1
1336 DO 860 j = j1, j2, ka1
1337 work( m-kb+j ) = work( m-kb+j+ka )
1338 work( n+m-kb+j ) = work( n+m-kb+j+ka )
1340 DO 870 j = j1, j2, ka1
1345 work( m-kb+j ) = work( m-kb+j )*ab( ka1, j-1 )
1346 ab( ka1, j-1 ) = work( n+m-kb+j )*ab( ka1, j-1 )
1349 IF( i+k.GT.ka1 .AND. k.LE.kbt )
1350 $ work( m-kb+i+k-ka ) = work( m-kb+i+k )
1354 DO 920 k = kb, 1, -1
1355 j2 = i + k + 1 - max( 1, k+i0-m )*ka1
1356 nr = ( j2+ka-1 ) / ka1
1357 j1 = j2 - ( nr-1 )*ka1
1363 CALL dlargv( nr, ab( ka1, j1 ), inca, work( m-kb+j1 ),
1364 $ ka1, work( n+m-kb+j1 ), ka1 )
1368 DO 890 l = 1, ka - 1
1369 CALL dlartv( nr, ab( l+1, j1 ), inca, ab( l+2, j1-1 ),
1370 $ inca, work( n+m-kb+j1 ), work( m-kb+j1 ),
1377 CALL dlar2v( nr, ab( 1, j1 ), ab( 1, j1-1 ),
1378 $ ab( 2, j1-1 ), inca, work( n+m-kb+j1 ),
1379 $ work( m-kb+j1 ), ka1 )
1385 DO 900 l = ka - 1, kb - k + 1, -1
1386 nrt = ( j2+l-1 ) / ka1
1387 j1t = j2 - ( nrt-1 )*ka1
1389 $
CALL dlartv( nrt, ab( ka1-l+1, j1t-ka1+l ), inca,
1390 $ ab( ka1-l, j1t-ka1+l ), inca,
1391 $ work( n+m-kb+j1t ), work( m-kb+j1t ),
1399 DO 910 j = j1, j2, ka1
1400 CALL drot( nx, x( 1, j ), 1, x( 1, j-1 ), 1,
1401 $ work( n+m-kb+j ), work( m-kb+j ) )
1406 DO 940 k = 1, kb - 1
1407 j2 = i + k + 1 - max( 1, k+i0-m+1 )*ka1
1411 DO 930 l = kb - k, 1, -1
1412 nrt = ( j2+l-1 ) / ka1
1413 j1t = j2 - ( nrt-1 )*ka1
1415 $
CALL dlartv( nrt, ab( ka1-l+1, j1t-ka1+l ), inca,
1416 $ ab( ka1-l, j1t-ka1+l ), inca,
1417 $ work( n+j1t ), work( j1t ), ka1 )
1422 DO 950 j = 2, min( i+kb, m ) - 2*ka - 1
1423 work( n+j ) = work( n+j+ka )
1424 work( j ) = work( j+ka )
subroutine dlaset(UPLO, M, N, ALPHA, BETA, A, LDA)
DLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
subroutine drot(N, DX, INCX, DY, INCY, C, S)
DROT
subroutine dlargv(N, X, INCX, Y, INCY, C, INCC)
DLARGV generates a vector of plane rotations with real cosines and real sines.
subroutine dlartv(N, X, INCX, Y, INCY, C, S, INCC)
DLARTV applies a vector of plane rotations with real cosines and real sines to the elements of a pair...
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine dger(M, N, ALPHA, X, INCX, Y, INCY, A, LDA)
DGER
subroutine dscal(N, DA, DX, INCX)
DSCAL
subroutine dsbgst(VECT, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, X, LDX, WORK, INFO)
DSBGST
subroutine dlartg(F, G, CS, SN, R)
DLARTG generates a plane rotation with real cosine and real sine.
subroutine dlar2v(N, X, Y, Z, INCX, C, S, INCC)
DLAR2V applies a vector of plane rotations with real cosines and real sines from both sides to a sequ...