--- rpl/lapack/lapack/dlarfb.f 2012/12/14 14:22:34 1.13 +++ rpl/lapack/lapack/dlarfb.f 2014/01/27 09:24:34 1.14 @@ -159,7 +159,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date September 2012 +*> \date June 2013 * *> \ingroup doubleOTHERauxiliary * @@ -195,10 +195,10 @@ SUBROUTINE DLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV, $ T, LDT, C, LDC, WORK, LDWORK ) * -* -- LAPACK auxiliary routine (version 3.4.2) -- +* -- LAPACK auxiliary routine (version 3.5.0) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* September 2012 +* June 2013 * * .. Scalar Arguments .. CHARACTER DIRECT, SIDE, STOREV, TRANS @@ -217,12 +217,11 @@ * .. * .. Local Scalars .. CHARACTER TRANST - INTEGER I, J, LASTV, LASTC, lastv2 + INTEGER I, J * .. * .. External Functions .. LOGICAL LSAME - INTEGER ILADLR, ILADLC - EXTERNAL LSAME, ILADLR, ILADLC + EXTERNAL LSAME * .. * .. External Subroutines .. EXTERNAL DCOPY, DGEMM, DTRMM @@ -253,57 +252,52 @@ * Form H * C or H**T * C where C = ( C1 ) * ( C2 ) * - LASTV = MAX( K, ILADLR( M, K, V, LDV ) ) - LASTC = ILADLC( LASTV, N, C, LDC ) -* * W := C**T * V = (C1**T * V1 + C2**T * V2) (stored in WORK) * * W := C1**T * DO 10 J = 1, K - CALL DCOPY( LASTC, C( J, 1 ), LDC, WORK( 1, J ), 1 ) + CALL DCOPY( N, C( J, 1 ), LDC, WORK( 1, J ), 1 ) 10 CONTINUE * * W := W * V1 * - CALL DTRMM( 'Right', 'Lower', 'No transpose', 'Unit', - $ LASTC, K, ONE, V, LDV, WORK, LDWORK ) - IF( LASTV.GT.K ) THEN -* -* W := W + C2**T *V2 -* - CALL DGEMM( 'Transpose', 'No transpose', - $ LASTC, K, LASTV-K, - $ ONE, C( K+1, 1 ), LDC, V( K+1, 1 ), LDV, - $ ONE, WORK, LDWORK ) + CALL DTRMM( 'Right', 'Lower', 'No transpose', 'Unit', N, + $ K, ONE, V, LDV, WORK, LDWORK ) + IF( M.GT.K ) THEN +* +* W := W + C2**T * V2 +* + CALL DGEMM( 'Transpose', 'No transpose', N, K, M-K, + $ ONE, C( K+1, 1 ), LDC, V( K+1, 1 ), LDV, + $ ONE, WORK, LDWORK ) END IF * * W := W * T**T or W * T * - CALL DTRMM( 'Right', 'Upper', TRANST, 'Non-unit', - $ LASTC, K, ONE, T, LDT, WORK, LDWORK ) + CALL DTRMM( 'Right', 'Upper', TRANST, 'Non-unit', N, K, + $ ONE, T, LDT, WORK, LDWORK ) * * C := C - V * W**T * - IF( LASTV.GT.K ) THEN + IF( M.GT.K ) THEN * * C2 := C2 - V2 * W**T * - CALL DGEMM( 'No transpose', 'Transpose', - $ LASTV-K, LASTC, K, - $ -ONE, V( K+1, 1 ), LDV, WORK, LDWORK, ONE, - $ C( K+1, 1 ), LDC ) + CALL DGEMM( 'No transpose', 'Transpose', M-K, N, K, + $ -ONE, V( K+1, 1 ), LDV, WORK, LDWORK, ONE, + $ C( K+1, 1 ), LDC ) END IF * * W := W * V1**T * - CALL DTRMM( 'Right', 'Lower', 'Transpose', 'Unit', - $ LASTC, K, ONE, V, LDV, WORK, LDWORK ) + CALL DTRMM( 'Right', 'Lower', 'Transpose', 'Unit', N, K, + $ ONE, V, LDV, WORK, LDWORK ) * * C1 := C1 - W**T * DO 30 J = 1, K - DO 20 I = 1, LASTC + DO 20 I = 1, N C( J, I ) = C( J, I ) - WORK( I, J ) 20 CONTINUE 30 CONTINUE @@ -312,57 +306,52 @@ * * Form C * H or C * H**T where C = ( C1 C2 ) * - LASTV = MAX( K, ILADLR( N, K, V, LDV ) ) - LASTC = ILADLR( M, LASTV, C, LDC ) -* * W := C * V = (C1*V1 + C2*V2) (stored in WORK) * * W := C1 * DO 40 J = 1, K - CALL DCOPY( LASTC, C( 1, J ), 1, WORK( 1, J ), 1 ) + CALL DCOPY( M, C( 1, J ), 1, WORK( 1, J ), 1 ) 40 CONTINUE * * W := W * V1 * - CALL DTRMM( 'Right', 'Lower', 'No transpose', 'Unit', - $ LASTC, K, ONE, V, LDV, WORK, LDWORK ) - IF( LASTV.GT.K ) THEN + CALL DTRMM( 'Right', 'Lower', 'No transpose', 'Unit', M, + $ K, ONE, V, LDV, WORK, LDWORK ) + IF( N.GT.K ) THEN * * W := W + C2 * V2 * - CALL DGEMM( 'No transpose', 'No transpose', - $ LASTC, K, LASTV-K, - $ ONE, C( 1, K+1 ), LDC, V( K+1, 1 ), LDV, - $ ONE, WORK, LDWORK ) + CALL DGEMM( 'No transpose', 'No transpose', M, K, N-K, + $ ONE, C( 1, K+1 ), LDC, V( K+1, 1 ), LDV, + $ ONE, WORK, LDWORK ) END IF * * W := W * T or W * T**T * - CALL DTRMM( 'Right', 'Upper', TRANS, 'Non-unit', - $ LASTC, K, ONE, T, LDT, WORK, LDWORK ) + CALL DTRMM( 'Right', 'Upper', TRANS, 'Non-unit', M, K, + $ ONE, T, LDT, WORK, LDWORK ) * * C := C - W * V**T * - IF( LASTV.GT.K ) THEN + IF( N.GT.K ) THEN * * C2 := C2 - W * V2**T * - CALL DGEMM( 'No transpose', 'Transpose', - $ LASTC, LASTV-K, K, - $ -ONE, WORK, LDWORK, V( K+1, 1 ), LDV, ONE, - $ C( 1, K+1 ), LDC ) + CALL DGEMM( 'No transpose', 'Transpose', M, N-K, K, + $ -ONE, WORK, LDWORK, V( K+1, 1 ), LDV, ONE, + $ C( 1, K+1 ), LDC ) END IF * * W := W * V1**T * - CALL DTRMM( 'Right', 'Lower', 'Transpose', 'Unit', - $ LASTC, K, ONE, V, LDV, WORK, LDWORK ) + CALL DTRMM( 'Right', 'Lower', 'Transpose', 'Unit', M, K, + $ ONE, V, LDV, WORK, LDWORK ) * * C1 := C1 - W * DO 60 J = 1, K - DO 50 I = 1, LASTC + DO 50 I = 1, M C( I, J ) = C( I, J ) - WORK( I, J ) 50 CONTINUE 60 CONTINUE @@ -379,35 +368,30 @@ * Form H * C or H**T * C where C = ( C1 ) * ( C2 ) * - LASTC = ILADLC( M, N, C, LDC ) -* * W := C**T * V = (C1**T * V1 + C2**T * V2) (stored in WORK) * * W := C2**T * DO 70 J = 1, K - CALL DCOPY( LASTC, C( M-K+J, 1 ), LDC, - $ WORK( 1, J ), 1 ) + CALL DCOPY( N, C( M-K+J, 1 ), LDC, WORK( 1, J ), 1 ) 70 CONTINUE * * W := W * V2 * - CALL DTRMM( 'Right', 'Upper', 'No transpose', 'Unit', - $ LASTC, K, ONE, V( M-K+1, 1 ), LDV, - $ WORK, LDWORK ) + CALL DTRMM( 'Right', 'Upper', 'No transpose', 'Unit', N, + $ K, ONE, V( M-K+1, 1 ), LDV, WORK, LDWORK ) IF( M.GT.K ) THEN * -* W := W + C1**T*V1 +* W := W + C1**T * V1 * - CALL DGEMM( 'Transpose', 'No transpose', - $ LASTC, K, M-K, ONE, C, LDC, V, LDV, - $ ONE, WORK, LDWORK ) + CALL DGEMM( 'Transpose', 'No transpose', N, K, M-K, + $ ONE, C, LDC, V, LDV, ONE, WORK, LDWORK ) END IF * * W := W * T**T or W * T * - CALL DTRMM( 'Right', 'Lower', TRANST, 'Non-unit', - $ LASTC, K, ONE, T, LDT, WORK, LDWORK ) + CALL DTRMM( 'Right', 'Lower', TRANST, 'Non-unit', N, K, + $ ONE, T, LDT, WORK, LDWORK ) * * C := C - V * W**T * @@ -415,22 +399,20 @@ * * C1 := C1 - V1 * W**T * - CALL DGEMM( 'No transpose', 'Transpose', - $ M-K, LASTC, K, -ONE, V, LDV, WORK, LDWORK, - $ ONE, C, LDC ) + CALL DGEMM( 'No transpose', 'Transpose', M-K, N, K, + $ -ONE, V, LDV, WORK, LDWORK, ONE, C, LDC ) END IF * * W := W * V2**T * - CALL DTRMM( 'Right', 'Upper', 'Transpose', 'Unit', - $ LASTC, K, ONE, V( M-K+1, 1 ), LDV, - $ WORK, LDWORK ) + CALL DTRMM( 'Right', 'Upper', 'Transpose', 'Unit', N, K, + $ ONE, V( M-K+1, 1 ), LDV, WORK, LDWORK ) * * C2 := C2 - W**T * DO 90 J = 1, K - DO 80 I = 1, LASTC - C( M-K+J, I ) = C( M-K+J, I ) - WORK(I, J) + DO 80 I = 1, N + C( M-K+J, I ) = C( M-K+J, I ) - WORK( I, J ) 80 CONTINUE 90 CONTINUE * @@ -438,34 +420,30 @@ * * Form C * H or C * H**T where C = ( C1 C2 ) * - LASTC = ILADLR( M, N, C, LDC ) -* * W := C * V = (C1*V1 + C2*V2) (stored in WORK) * * W := C2 * DO 100 J = 1, K - CALL DCOPY( LASTC, C( 1, N-K+J ), 1, WORK( 1, J ), 1 ) + CALL DCOPY( M, C( 1, N-K+J ), 1, WORK( 1, J ), 1 ) 100 CONTINUE * * W := W * V2 * - CALL DTRMM( 'Right', 'Upper', 'No transpose', 'Unit', - $ LASTC, K, ONE, V( N-K+1, 1 ), LDV, - $ WORK, LDWORK ) + CALL DTRMM( 'Right', 'Upper', 'No transpose', 'Unit', M, + $ K, ONE, V( N-K+1, 1 ), LDV, WORK, LDWORK ) IF( N.GT.K ) THEN * * W := W + C1 * V1 * - CALL DGEMM( 'No transpose', 'No transpose', - $ LASTC, K, N-K, ONE, C, LDC, V, LDV, - $ ONE, WORK, LDWORK ) + CALL DGEMM( 'No transpose', 'No transpose', M, K, N-K, + $ ONE, C, LDC, V, LDV, ONE, WORK, LDWORK ) END IF * * W := W * T or W * T**T * - CALL DTRMM( 'Right', 'Lower', TRANS, 'Non-unit', - $ LASTC, K, ONE, T, LDT, WORK, LDWORK ) + CALL DTRMM( 'Right', 'Lower', TRANS, 'Non-unit', M, K, + $ ONE, T, LDT, WORK, LDWORK ) * * C := C - W * V**T * @@ -473,22 +451,20 @@ * * C1 := C1 - W * V1**T * - CALL DGEMM( 'No transpose', 'Transpose', - $ LASTC, N-K, K, -ONE, WORK, LDWORK, V, LDV, - $ ONE, C, LDC ) + CALL DGEMM( 'No transpose', 'Transpose', M, N-K, K, + $ -ONE, WORK, LDWORK, V, LDV, ONE, C, LDC ) END IF * * W := W * V2**T * - CALL DTRMM( 'Right', 'Upper', 'Transpose', 'Unit', - $ LASTC, K, ONE, V( N-K+1, 1 ), LDV, - $ WORK, LDWORK ) + CALL DTRMM( 'Right', 'Upper', 'Transpose', 'Unit', M, K, + $ ONE, V( N-K+1, 1 ), LDV, WORK, LDWORK ) * * C2 := C2 - W * DO 120 J = 1, K - DO 110 I = 1, LASTC - C( I, N-K+J ) = C( I, N-K+J ) - WORK(I, J) + DO 110 I = 1, M + C( I, N-K+J ) = C( I, N-K+J ) - WORK( I, J ) 110 CONTINUE 120 CONTINUE END IF @@ -506,57 +482,52 @@ * Form H * C or H**T * C where C = ( C1 ) * ( C2 ) * - LASTV = MAX( K, ILADLC( K, M, V, LDV ) ) - LASTC = ILADLC( LASTV, N, C, LDC ) -* * W := C**T * V**T = (C1**T * V1**T + C2**T * V2**T) (stored in WORK) * * W := C1**T * DO 130 J = 1, K - CALL DCOPY( LASTC, C( J, 1 ), LDC, WORK( 1, J ), 1 ) + CALL DCOPY( N, C( J, 1 ), LDC, WORK( 1, J ), 1 ) 130 CONTINUE * * W := W * V1**T * - CALL DTRMM( 'Right', 'Upper', 'Transpose', 'Unit', - $ LASTC, K, ONE, V, LDV, WORK, LDWORK ) - IF( LASTV.GT.K ) THEN -* -* W := W + C2**T*V2**T -* - CALL DGEMM( 'Transpose', 'Transpose', - $ LASTC, K, LASTV-K, - $ ONE, C( K+1, 1 ), LDC, V( 1, K+1 ), LDV, - $ ONE, WORK, LDWORK ) + CALL DTRMM( 'Right', 'Upper', 'Transpose', 'Unit', N, K, + $ ONE, V, LDV, WORK, LDWORK ) + IF( M.GT.K ) THEN +* +* W := W + C2**T * V2**T +* + CALL DGEMM( 'Transpose', 'Transpose', N, K, M-K, ONE, + $ C( K+1, 1 ), LDC, V( 1, K+1 ), LDV, ONE, + $ WORK, LDWORK ) END IF * * W := W * T**T or W * T * - CALL DTRMM( 'Right', 'Upper', TRANST, 'Non-unit', - $ LASTC, K, ONE, T, LDT, WORK, LDWORK ) + CALL DTRMM( 'Right', 'Upper', TRANST, 'Non-unit', N, K, + $ ONE, T, LDT, WORK, LDWORK ) * * C := C - V**T * W**T * - IF( LASTV.GT.K ) THEN + IF( M.GT.K ) THEN * * C2 := C2 - V2**T * W**T * - CALL DGEMM( 'Transpose', 'Transpose', - $ LASTV-K, LASTC, K, - $ -ONE, V( 1, K+1 ), LDV, WORK, LDWORK, - $ ONE, C( K+1, 1 ), LDC ) + CALL DGEMM( 'Transpose', 'Transpose', M-K, N, K, -ONE, + $ V( 1, K+1 ), LDV, WORK, LDWORK, ONE, + $ C( K+1, 1 ), LDC ) END IF * * W := W * V1 * - CALL DTRMM( 'Right', 'Upper', 'No transpose', 'Unit', - $ LASTC, K, ONE, V, LDV, WORK, LDWORK ) + CALL DTRMM( 'Right', 'Upper', 'No transpose', 'Unit', N, + $ K, ONE, V, LDV, WORK, LDWORK ) * * C1 := C1 - W**T * DO 150 J = 1, K - DO 140 I = 1, LASTC + DO 140 I = 1, N C( J, I ) = C( J, I ) - WORK( I, J ) 140 CONTINUE 150 CONTINUE @@ -565,57 +536,52 @@ * * Form C * H or C * H**T where C = ( C1 C2 ) * - LASTV = MAX( K, ILADLC( K, N, V, LDV ) ) - LASTC = ILADLR( M, LASTV, C, LDC ) -* * W := C * V**T = (C1*V1**T + C2*V2**T) (stored in WORK) * * W := C1 * DO 160 J = 1, K - CALL DCOPY( LASTC, C( 1, J ), 1, WORK( 1, J ), 1 ) + CALL DCOPY( M, C( 1, J ), 1, WORK( 1, J ), 1 ) 160 CONTINUE * * W := W * V1**T * - CALL DTRMM( 'Right', 'Upper', 'Transpose', 'Unit', - $ LASTC, K, ONE, V, LDV, WORK, LDWORK ) - IF( LASTV.GT.K ) THEN + CALL DTRMM( 'Right', 'Upper', 'Transpose', 'Unit', M, K, + $ ONE, V, LDV, WORK, LDWORK ) + IF( N.GT.K ) THEN * * W := W + C2 * V2**T * - CALL DGEMM( 'No transpose', 'Transpose', - $ LASTC, K, LASTV-K, - $ ONE, C( 1, K+1 ), LDC, V( 1, K+1 ), LDV, - $ ONE, WORK, LDWORK ) + CALL DGEMM( 'No transpose', 'Transpose', M, K, N-K, + $ ONE, C( 1, K+1 ), LDC, V( 1, K+1 ), LDV, + $ ONE, WORK, LDWORK ) END IF * * W := W * T or W * T**T * - CALL DTRMM( 'Right', 'Upper', TRANS, 'Non-unit', - $ LASTC, K, ONE, T, LDT, WORK, LDWORK ) + CALL DTRMM( 'Right', 'Upper', TRANS, 'Non-unit', M, K, + $ ONE, T, LDT, WORK, LDWORK ) * * C := C - W * V * - IF( LASTV.GT.K ) THEN + IF( N.GT.K ) THEN * * C2 := C2 - W * V2 * - CALL DGEMM( 'No transpose', 'No transpose', - $ LASTC, LASTV-K, K, - $ -ONE, WORK, LDWORK, V( 1, K+1 ), LDV, - $ ONE, C( 1, K+1 ), LDC ) + CALL DGEMM( 'No transpose', 'No transpose', M, N-K, K, + $ -ONE, WORK, LDWORK, V( 1, K+1 ), LDV, ONE, + $ C( 1, K+1 ), LDC ) END IF * * W := W * V1 * - CALL DTRMM( 'Right', 'Upper', 'No transpose', 'Unit', - $ LASTC, K, ONE, V, LDV, WORK, LDWORK ) + CALL DTRMM( 'Right', 'Upper', 'No transpose', 'Unit', M, + $ K, ONE, V, LDV, WORK, LDWORK ) * * C1 := C1 - W * DO 180 J = 1, K - DO 170 I = 1, LASTC + DO 170 I = 1, M C( I, J ) = C( I, J ) - WORK( I, J ) 170 CONTINUE 180 CONTINUE @@ -632,35 +598,30 @@ * Form H * C or H**T * C where C = ( C1 ) * ( C2 ) * - LASTC = ILADLC( M, N, C, LDC ) -* * W := C**T * V**T = (C1**T * V1**T + C2**T * V2**T) (stored in WORK) * * W := C2**T * DO 190 J = 1, K - CALL DCOPY( LASTC, C( M-K+J, 1 ), LDC, - $ WORK( 1, J ), 1 ) + CALL DCOPY( N, C( M-K+J, 1 ), LDC, WORK( 1, J ), 1 ) 190 CONTINUE * * W := W * V2**T * - CALL DTRMM( 'Right', 'Lower', 'Transpose', 'Unit', - $ LASTC, K, ONE, V( 1, M-K+1 ), LDV, - $ WORK, LDWORK ) + CALL DTRMM( 'Right', 'Lower', 'Transpose', 'Unit', N, K, + $ ONE, V( 1, M-K+1 ), LDV, WORK, LDWORK ) IF( M.GT.K ) THEN * * W := W + C1**T * V1**T * - CALL DGEMM( 'Transpose', 'Transpose', - $ LASTC, K, M-K, ONE, C, LDC, V, LDV, - $ ONE, WORK, LDWORK ) + CALL DGEMM( 'Transpose', 'Transpose', N, K, M-K, ONE, + $ C, LDC, V, LDV, ONE, WORK, LDWORK ) END IF * * W := W * T**T or W * T * - CALL DTRMM( 'Right', 'Lower', TRANST, 'Non-unit', - $ LASTC, K, ONE, T, LDT, WORK, LDWORK ) + CALL DTRMM( 'Right', 'Lower', TRANST, 'Non-unit', N, K, + $ ONE, T, LDT, WORK, LDWORK ) * * C := C - V**T * W**T * @@ -668,58 +629,51 @@ * * C1 := C1 - V1**T * W**T * - CALL DGEMM( 'Transpose', 'Transpose', - $ M-K, LASTC, K, -ONE, V, LDV, WORK, LDWORK, - $ ONE, C, LDC ) + CALL DGEMM( 'Transpose', 'Transpose', M-K, N, K, -ONE, + $ V, LDV, WORK, LDWORK, ONE, C, LDC ) END IF * * W := W * V2 * - CALL DTRMM( 'Right', 'Lower', 'No transpose', 'Unit', - $ LASTC, K, ONE, V( 1, M-K+1 ), LDV, - $ WORK, LDWORK ) + CALL DTRMM( 'Right', 'Lower', 'No transpose', 'Unit', N, + $ K, ONE, V( 1, M-K+1 ), LDV, WORK, LDWORK ) * * C2 := C2 - W**T * DO 210 J = 1, K - DO 200 I = 1, LASTC - C( M-K+J, I ) = C( M-K+J, I ) - WORK(I, J) + DO 200 I = 1, N + C( M-K+J, I ) = C( M-K+J, I ) - WORK( I, J ) 200 CONTINUE 210 CONTINUE * ELSE IF( LSAME( SIDE, 'R' ) ) THEN * -* Form C * H or C * H**T where C = ( C1 C2 ) -* - LASTC = ILADLR( M, N, C, LDC ) +* Form C * H or C * H' where C = ( C1 C2 ) * * W := C * V**T = (C1*V1**T + C2*V2**T) (stored in WORK) * * W := C2 * DO 220 J = 1, K - CALL DCOPY( LASTC, C( 1, N-K+J ), 1, - $ WORK( 1, J ), 1 ) + CALL DCOPY( M, C( 1, N-K+J ), 1, WORK( 1, J ), 1 ) 220 CONTINUE * * W := W * V2**T * - CALL DTRMM( 'Right', 'Lower', 'Transpose', 'Unit', - $ LASTC, K, ONE, V( 1, N-K+1 ), LDV, - $ WORK, LDWORK ) + CALL DTRMM( 'Right', 'Lower', 'Transpose', 'Unit', M, K, + $ ONE, V( 1, N-K+1 ), LDV, WORK, LDWORK ) IF( N.GT.K ) THEN * * W := W + C1 * V1**T * - CALL DGEMM( 'No transpose', 'Transpose', - $ LASTC, K, N-K, ONE, C, LDC, V, LDV, - $ ONE, WORK, LDWORK ) + CALL DGEMM( 'No transpose', 'Transpose', M, K, N-K, + $ ONE, C, LDC, V, LDV, ONE, WORK, LDWORK ) END IF * * W := W * T or W * T**T * - CALL DTRMM( 'Right', 'Lower', TRANS, 'Non-unit', - $ LASTC, K, ONE, T, LDT, WORK, LDWORK ) + CALL DTRMM( 'Right', 'Lower', TRANS, 'Non-unit', M, K, + $ ONE, T, LDT, WORK, LDWORK ) * * C := C - W * V * @@ -727,22 +681,20 @@ * * C1 := C1 - W * V1 * - CALL DGEMM( 'No transpose', 'No transpose', - $ LASTC, N-K, K, -ONE, WORK, LDWORK, V, LDV, - $ ONE, C, LDC ) + CALL DGEMM( 'No transpose', 'No transpose', M, N-K, K, + $ -ONE, WORK, LDWORK, V, LDV, ONE, C, LDC ) END IF * * W := W * V2 * - CALL DTRMM( 'Right', 'Lower', 'No transpose', 'Unit', - $ LASTC, K, ONE, V( 1, N-K+1 ), LDV, - $ WORK, LDWORK ) + CALL DTRMM( 'Right', 'Lower', 'No transpose', 'Unit', M, + $ K, ONE, V( 1, N-K+1 ), LDV, WORK, LDWORK ) * * C1 := C1 - W * DO 240 J = 1, K - DO 230 I = 1, LASTC - C( I, N-K+J ) = C( I, N-K+J ) - WORK(I, J) + DO 230 I = 1, M + C( I, N-K+J ) = C( I, N-K+J ) - WORK( I, J ) 230 CONTINUE 240 CONTINUE *