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 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...
logical function lsame(CA, CB)
LSAME