summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorjames <james@8a072113-8704-0410-8d35-dd094bca7971>2012-08-18 22:01:21 +0000
committerjames <james@8a072113-8704-0410-8d35-dd094bca7971>2012-08-18 22:01:21 +0000
commitc8ee6a3d9840624af4c85d89a5f57dacf77292c5 (patch)
treec579c835d3bd1b46ea884c4e8e7d0c5641114744
parented86510324207b3d6b9065d8e38d5596ce34d7f3 (diff)
downloadlapack-c8ee6a3d9840624af4c85d89a5f57dacf77292c5.tar.gz
lapack-c8ee6a3d9840624af4c85d89a5f57dacf77292c5.tar.bz2
lapack-c8ee6a3d9840624af4c85d89a5f57dacf77292c5.zip
Corrected bug that occurs when V is stored in backwards order: previously, the scan for zero rows or columns at the _end_ of V can result in the trunctation of the unit triangular part of V. The correction replaces the LASTV in the DIRECT='B' cases with the full length, which is either M or N, which then keeps the full K-by-K unit triangular portion of V. Another approach, which could be applied in a future revision, is to add new routines to compute the first non-zero row and non-zero column of a matrix, and store this index in FIRSTV, and run the loops and matrix multiplications from FIRSTV:M and FIRSTV:N where appropriate.
-rw-r--r--SRC/clarfb.f77
-rw-r--r--SRC/dlarfb.f76
-rw-r--r--SRC/slarfb.f75
-rw-r--r--SRC/zlarfb.f77
4 files changed, 143 insertions, 162 deletions
diff --git a/SRC/clarfb.f b/SRC/clarfb.f
index 83515567..37168595 100644
--- a/SRC/clarfb.f
+++ b/SRC/clarfb.f
@@ -381,15 +381,14 @@
* Form H * C or H**H * C where C = ( C1 )
* ( C2 )
*
- LASTV = MAX( K, ILACLR( M, K, V, LDV ) )
- LASTC = ILACLC( LASTV, N, C, LDC )
+ LASTC = ILACLC( M, N, C, LDC )
*
* W := C**H * V = (C1**H * V1 + C2**H * V2) (stored in WORK)
*
* W := C2**H
*
DO 70 J = 1, K
- CALL CCOPY( LASTC, C( LASTV-K+J, 1 ), LDC,
+ CALL CCOPY( LASTC, C( M-K+J, 1 ), LDC,
$ WORK( 1, J ), 1 )
CALL CLACGV( LASTC, WORK( 1, J ), 1 )
70 CONTINUE
@@ -397,14 +396,14 @@
* W := W * V2
*
CALL CTRMM( 'Right', 'Upper', 'No transpose', 'Unit',
- $ LASTC, K, ONE, V( LASTV-K+1, 1 ), LDV,
+ $ LASTC, K, ONE, V( M-K+1, 1 ), LDV,
$ WORK, LDWORK )
- IF( LASTV.GT.K ) THEN
+ IF( M.GT.K ) THEN
*
* W := W + C1**H*V1
*
CALL CGEMM( 'Conjugate transpose', 'No transpose',
- $ LASTC, K, LASTV-K, ONE, C, LDC, V, LDV,
+ $ LASTC, K, M-K, ONE, C, LDC, V, LDV,
$ ONE, WORK, LDWORK )
END IF
*
@@ -415,26 +414,26 @@
*
* C := C - V * W**H
*
- IF( LASTV.GT.K ) THEN
+ IF( M.GT.K ) THEN
*
* C1 := C1 - V1 * W**H
*
CALL CGEMM( 'No transpose', 'Conjugate transpose',
- $ LASTV-K, LASTC, K, -ONE, V, LDV, WORK, LDWORK,
+ $ M-K, LASTC, K, -ONE, V, LDV, WORK, LDWORK,
$ ONE, C, LDC )
END IF
*
* W := W * V2**H
*
CALL CTRMM( 'Right', 'Upper', 'Conjugate transpose',
- $ 'Unit', LASTC, K, ONE, V( LASTV-K+1, 1 ), LDV,
+ $ 'Unit', LASTC, K, ONE, V( M-K+1, 1 ), LDV,
$ WORK, LDWORK )
*
* C2 := C2 - W**H
*
DO 90 J = 1, K
DO 80 I = 1, LASTC
- C( LASTV-K+J, I ) = C( LASTV-K+J, I ) -
+ C( M-K+J, I ) = C( M-K+J, I ) -
$ CONJG( WORK( I, J ) )
80 CONTINUE
90 CONTINUE
@@ -443,29 +442,28 @@
*
* Form C * H or C * H**H where C = ( C1 C2 )
*
- LASTV = MAX( K, ILACLR( N, K, V, LDV ) )
- LASTC = ILACLR( M, LASTV, C, LDC )
+ LASTC = ILACLR( M, N, C, LDC )
*
* W := C * V = (C1*V1 + C2*V2) (stored in WORK)
*
* W := C2
*
DO 100 J = 1, K
- CALL CCOPY( LASTC, C( 1, LASTV-K+J ), 1,
+ CALL CCOPY( LASTC, C( 1, N-K+J ), 1,
$ WORK( 1, J ), 1 )
100 CONTINUE
*
* W := W * V2
*
CALL CTRMM( 'Right', 'Upper', 'No transpose', 'Unit',
- $ LASTC, K, ONE, V( LASTV-K+1, 1 ), LDV,
+ $ LASTC, K, ONE, V( N-K+1, 1 ), LDV,
$ WORK, LDWORK )
- IF( LASTV.GT.K ) THEN
+ IF( N.GT.K ) THEN
*
* W := W + C1 * V1
*
CALL CGEMM( 'No transpose', 'No transpose',
- $ LASTC, K, LASTV-K,
+ $ LASTC, K, N-K,
$ ONE, C, LDC, V, LDV, ONE, WORK, LDWORK )
END IF
*
@@ -476,26 +474,26 @@
*
* C := C - W * V**H
*
- IF( LASTV.GT.K ) THEN
+ IF( N.GT.K ) THEN
*
* C1 := C1 - W * V1**H
*
CALL CGEMM( 'No transpose', 'Conjugate transpose',
- $ LASTC, LASTV-K, K, -ONE, WORK, LDWORK, V, LDV,
+ $ LASTC, N-K, K, -ONE, WORK, LDWORK, V, LDV,
$ ONE, C, LDC )
END IF
*
* W := W * V2**H
*
CALL CTRMM( 'Right', 'Upper', 'Conjugate transpose',
- $ 'Unit', LASTC, K, ONE, V( LASTV-K+1, 1 ), LDV,
+ $ 'Unit', LASTC, 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, LASTV-K+J ) = C( I, LASTV-K+J )
+ C( I, N-K+J ) = C( I, N-K+J )
$ - WORK( I, J )
110 CONTINUE
120 CONTINUE
@@ -640,15 +638,14 @@
* Form H * C or H**H * C where C = ( C1 )
* ( C2 )
*
- LASTV = MAX( K, ILACLC( K, M, V, LDV ) )
- LASTC = ILACLC( LASTV, N, C, LDC )
+ LASTC = ILACLC( M, N, C, LDC )
*
* W := C**H * V**H = (C1**H * V1**H + C2**H * V2**H) (stored in WORK)
*
* W := C2**H
*
DO 190 J = 1, K
- CALL CCOPY( LASTC, C( LASTV-K+J, 1 ), LDC,
+ CALL CCOPY( LASTC, C( M-K+J, 1 ), LDC,
$ WORK( 1, J ), 1 )
CALL CLACGV( LASTC, WORK( 1, J ), 1 )
190 CONTINUE
@@ -656,14 +653,14 @@
* W := W * V2**H
*
CALL CTRMM( 'Right', 'Lower', 'Conjugate transpose',
- $ 'Unit', LASTC, K, ONE, V( 1, LASTV-K+1 ), LDV,
+ $ 'Unit', LASTC, K, ONE, V( 1, M-K+1 ), LDV,
$ WORK, LDWORK )
- IF( LASTV.GT.K ) THEN
+ IF( M.GT.K ) THEN
*
* W := W + C1**H * V1**H
*
CALL CGEMM( 'Conjugate transpose',
- $ 'Conjugate transpose', LASTC, K, LASTV-K,
+ $ 'Conjugate transpose', LASTC, K, M-K,
$ ONE, C, LDC, V, LDV, ONE, WORK, LDWORK )
END IF
*
@@ -674,26 +671,26 @@
*
* C := C - V**H * W**H
*
- IF( LASTV.GT.K ) THEN
+ IF( M.GT.K ) THEN
*
* C1 := C1 - V1**H * W**H
*
CALL CGEMM( 'Conjugate transpose',
- $ 'Conjugate transpose', LASTV-K, LASTC, K,
+ $ 'Conjugate transpose', M-K, LASTC, K,
$ -ONE, V, LDV, WORK, LDWORK, ONE, C, LDC )
END IF
*
* W := W * V2
*
CALL CTRMM( 'Right', 'Lower', 'No transpose', 'Unit',
- $ LASTC, K, ONE, V( 1, LASTV-K+1 ), LDV,
+ $ LASTC, K, ONE, V( 1, M-K+1 ), LDV,
$ WORK, LDWORK )
*
* C2 := C2 - W**H
*
DO 210 J = 1, K
DO 200 I = 1, LASTC
- C( LASTV-K+J, I ) = C( LASTV-K+J, I ) -
+ C( M-K+J, I ) = C( M-K+J, I ) -
$ CONJG( WORK( I, J ) )
200 CONTINUE
210 CONTINUE
@@ -702,29 +699,28 @@
*
* Form C * H or C * H**H where C = ( C1 C2 )
*
- LASTV = MAX( K, ILACLC( K, N, V, LDV ) )
- LASTC = ILACLR( M, LASTV, C, LDC )
+ LASTC = ILACLR( M, N, C, LDC )
*
* W := C * V**H = (C1*V1**H + C2*V2**H) (stored in WORK)
*
* W := C2
*
DO 220 J = 1, K
- CALL CCOPY( LASTC, C( 1, LASTV-K+J ), 1,
+ CALL CCOPY( LASTC, C( 1, N-K+J ), 1,
$ WORK( 1, J ), 1 )
220 CONTINUE
*
* W := W * V2**H
*
CALL CTRMM( 'Right', 'Lower', 'Conjugate transpose',
- $ 'Unit', LASTC, K, ONE, V( 1, LASTV-K+1 ), LDV,
+ $ 'Unit', LASTC, K, ONE, V( 1, N-K+1 ), LDV,
$ WORK, LDWORK )
- IF( LASTV.GT.K ) THEN
+ IF( N.GT.K ) THEN
*
* W := W + C1 * V1**H
*
CALL CGEMM( 'No transpose', 'Conjugate transpose',
- $ LASTC, K, LASTV-K, ONE, C, LDC, V, LDV, ONE,
+ $ LASTC, K, N-K, ONE, C, LDC, V, LDV, ONE,
$ WORK, LDWORK )
END IF
*
@@ -735,27 +731,26 @@
*
* C := C - W * V
*
- IF( LASTV.GT.K ) THEN
+ IF( N.GT.K ) THEN
*
* C1 := C1 - W * V1
*
CALL CGEMM( 'No transpose', 'No transpose',
- $ LASTC, LASTV-K, K, -ONE, WORK, LDWORK, V, LDV,
+ $ LASTC, N-K, K, -ONE, WORK, LDWORK, V, LDV,
$ ONE, C, LDC )
END IF
*
* W := W * V2
*
CALL CTRMM( 'Right', 'Lower', 'No transpose', 'Unit',
- $ LASTC, K, ONE, V( 1, LASTV-K+1 ), LDV,
+ $ LASTC, 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, LASTV-K+J ) = C( I, LASTV-K+J )
- $ - WORK( I, J )
+ C( I, N-K+J ) = C( I, N-K+J ) - WORK( I, J )
230 CONTINUE
240 CONTINUE
*
diff --git a/SRC/dlarfb.f b/SRC/dlarfb.f
index 1e6894c3..8ed8fe2b 100644
--- a/SRC/dlarfb.f
+++ b/SRC/dlarfb.f
@@ -217,7 +217,7 @@
* ..
* .. Local Scalars ..
CHARACTER TRANST
- INTEGER I, J, LASTV, LASTC
+ INTEGER I, J, LASTV, LASTC, lastv2
* ..
* .. External Functions ..
LOGICAL LSAME
@@ -379,29 +379,28 @@
* 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 )
+ 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( LASTV-K+J, 1 ), LDC,
+ CALL DCOPY( LASTC, 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( LASTV-K+1, 1 ), LDV,
+ $ LASTC, K, ONE, V( M-K+1, 1 ), LDV,
$ WORK, LDWORK )
- IF( LASTV.GT.K ) THEN
+ IF( M.GT.K ) THEN
*
* W := W + C1**T*V1
*
CALL DGEMM( 'Transpose', 'No transpose',
- $ LASTC, K, LASTV-K, ONE, C, LDC, V, LDV,
+ $ LASTC, K, M-K, ONE, C, LDC, V, LDV,
$ ONE, WORK, LDWORK )
END IF
*
@@ -412,26 +411,26 @@
*
* C := C - V * W**T
*
- IF( LASTV.GT.K ) THEN
+ IF( M.GT.K ) THEN
*
* C1 := C1 - V1 * W**T
*
CALL DGEMM( 'No transpose', 'Transpose',
- $ LASTV-K, LASTC, K, -ONE, V, LDV, WORK, LDWORK,
+ $ M-K, LASTC, 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( LASTV-K+1, 1 ), LDV,
+ $ LASTC, 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( LASTV-K+J, I ) = C( LASTV-K+J, I ) - WORK(I, J)
+ C( M-K+J, I ) = C( M-K+J, I ) - WORK(I, J)
80 CONTINUE
90 CONTINUE
*
@@ -439,8 +438,7 @@
*
* 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 )
+ LASTC = ILADLR( M, N, C, LDC )
*
* W := C * V = (C1*V1 + C2*V2) (stored in WORK)
*
@@ -453,14 +451,14 @@
* W := W * V2
*
CALL DTRMM( 'Right', 'Upper', 'No transpose', 'Unit',
- $ LASTC, K, ONE, V( LASTV-K+1, 1 ), LDV,
+ $ LASTC, K, ONE, V( N-K+1, 1 ), LDV,
$ WORK, LDWORK )
- IF( LASTV.GT.K ) THEN
+ IF( N.GT.K ) THEN
*
* W := W + C1 * V1
*
CALL DGEMM( 'No transpose', 'No transpose',
- $ LASTC, K, LASTV-K, ONE, C, LDC, V, LDV,
+ $ LASTC, K, N-K, ONE, C, LDC, V, LDV,
$ ONE, WORK, LDWORK )
END IF
*
@@ -471,26 +469,26 @@
*
* C := C - W * V**T
*
- IF( LASTV.GT.K ) THEN
+ IF( N.GT.K ) THEN
*
* C1 := C1 - W * V1**T
*
CALL DGEMM( 'No transpose', 'Transpose',
- $ LASTC, LASTV-K, K, -ONE, WORK, LDWORK, V, LDV,
+ $ LASTC, 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( LASTV-K+1, 1 ), LDV,
+ $ LASTC, 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, LASTV-K+J ) = C( I, LASTV-K+J ) - WORK(I, J)
+ C( I, N-K+J ) = C( I, N-K+J ) - WORK(I, J)
110 CONTINUE
120 CONTINUE
END IF
@@ -634,29 +632,28 @@
* 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 )
+ 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( LASTV-K+J, 1 ), LDC,
+ CALL DCOPY( LASTC, 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, LASTV-K+1 ), LDV,
+ $ LASTC, K, ONE, V( 1, M-K+1 ), LDV,
$ WORK, LDWORK )
- IF( LASTV.GT.K ) THEN
+ IF( M.GT.K ) THEN
*
* W := W + C1**T * V1**T
*
CALL DGEMM( 'Transpose', 'Transpose',
- $ LASTC, K, LASTV-K, ONE, C, LDC, V, LDV,
+ $ LASTC, K, M-K, ONE, C, LDC, V, LDV,
$ ONE, WORK, LDWORK )
END IF
*
@@ -667,26 +664,26 @@
*
* C := C - V**T * W**T
*
- IF( LASTV.GT.K ) THEN
+ IF( M.GT.K ) THEN
*
* C1 := C1 - V1**T * W**T
*
CALL DGEMM( 'Transpose', 'Transpose',
- $ LASTV-K, LASTC, K, -ONE, V, LDV, WORK, LDWORK,
+ $ M-K, LASTC, 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, LASTV-K+1 ), LDV,
+ $ LASTC, 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( LASTV-K+J, I ) = C( LASTV-K+J, I ) - WORK(I, J)
+ C( M-K+J, I ) = C( M-K+J, I ) - WORK(I, J)
200 CONTINUE
210 CONTINUE
*
@@ -694,29 +691,28 @@
*
* 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 )
+ LASTC = ILADLR( M, N, C, LDC )
*
* 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, LASTV-K+J ), 1,
+ CALL DCOPY( LASTC, 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, LASTV-K+1 ), LDV,
+ $ LASTC, K, ONE, V( 1, N-K+1 ), LDV,
$ WORK, LDWORK )
- IF( LASTV.GT.K ) THEN
+ IF( N.GT.K ) THEN
*
* W := W + C1 * V1**T
*
CALL DGEMM( 'No transpose', 'Transpose',
- $ LASTC, K, LASTV-K, ONE, C, LDC, V, LDV,
+ $ LASTC, K, N-K, ONE, C, LDC, V, LDV,
$ ONE, WORK, LDWORK )
END IF
*
@@ -727,26 +723,26 @@
*
* C := C - W * V
*
- IF( LASTV.GT.K ) THEN
+ IF( N.GT.K ) THEN
*
* C1 := C1 - W * V1
*
CALL DGEMM( 'No transpose', 'No transpose',
- $ LASTC, LASTV-K, K, -ONE, WORK, LDWORK, V, LDV,
+ $ LASTC, 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, LASTV-K+1 ), LDV,
+ $ LASTC, 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, LASTV-K+J ) = C( I, LASTV-K+J ) - WORK(I, J)
+ C( I, N-K+J ) = C( I, N-K+J ) - WORK(I, J)
230 CONTINUE
240 CONTINUE
*
diff --git a/SRC/slarfb.f b/SRC/slarfb.f
index f086f090..20a22577 100644
--- a/SRC/slarfb.f
+++ b/SRC/slarfb.f
@@ -379,29 +379,28 @@
* Form H * C or H**T * C where C = ( C1 )
* ( C2 )
*
- LASTV = MAX( K, ILASLR( M, K, V, LDV ) )
- LASTC = ILASLC( LASTV, N, C, LDC )
+ LASTC = ILASLC( 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 SCOPY( LASTC, C( LASTV-K+J, 1 ), LDC,
+ CALL SCOPY( LASTC, C( M-K+J, 1 ), LDC,
$ WORK( 1, J ), 1 )
70 CONTINUE
*
* W := W * V2
*
CALL STRMM( 'Right', 'Upper', 'No transpose', 'Unit',
- $ LASTC, K, ONE, V( LASTV-K+1, 1 ), LDV,
+ $ LASTC, K, ONE, V( M-K+1, 1 ), LDV,
$ WORK, LDWORK )
- IF( LASTV.GT.K ) THEN
+ IF( M.GT.K ) THEN
*
* W := W + C1**T*V1
*
CALL SGEMM( 'Transpose', 'No transpose',
- $ LASTC, K, LASTV-K, ONE, C, LDC, V, LDV,
+ $ LASTC, K, M-K, ONE, C, LDC, V, LDV,
$ ONE, WORK, LDWORK )
END IF
*
@@ -412,26 +411,26 @@
*
* C := C - V * W**T
*
- IF( LASTV.GT.K ) THEN
+ IF( M.GT.K ) THEN
*
* C1 := C1 - V1 * W**T
*
CALL SGEMM( 'No transpose', 'Transpose',
- $ LASTV-K, LASTC, K, -ONE, V, LDV, WORK, LDWORK,
+ $ M-K, LASTC, K, -ONE, V, LDV, WORK, LDWORK,
$ ONE, C, LDC )
END IF
*
* W := W * V2**T
*
CALL STRMM( 'Right', 'Upper', 'Transpose', 'Unit',
- $ LASTC, K, ONE, V( LASTV-K+1, 1 ), LDV,
+ $ LASTC, 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( LASTV-K+J, I ) = C( LASTV-K+J, I ) - WORK(I, J)
+ C( M-K+J, I ) = C( M-K+J, I ) - WORK(I, J)
80 CONTINUE
90 CONTINUE
*
@@ -439,8 +438,7 @@
*
* Form C * H or C * H**T where C = ( C1 C2 )
*
- LASTV = MAX( K, ILASLR( N, K, V, LDV ) )
- LASTC = ILASLR( M, LASTV, C, LDC )
+ LASTC = ILASLR( M, N, C, LDC )
*
* W := C * V = (C1*V1 + C2*V2) (stored in WORK)
*
@@ -453,14 +451,14 @@
* W := W * V2
*
CALL STRMM( 'Right', 'Upper', 'No transpose', 'Unit',
- $ LASTC, K, ONE, V( LASTV-K+1, 1 ), LDV,
+ $ LASTC, K, ONE, V( N-K+1, 1 ), LDV,
$ WORK, LDWORK )
- IF( LASTV.GT.K ) THEN
+ IF( N.GT.K ) THEN
*
* W := W + C1 * V1
*
CALL SGEMM( 'No transpose', 'No transpose',
- $ LASTC, K, LASTV-K, ONE, C, LDC, V, LDV,
+ $ LASTC, K, N-K, ONE, C, LDC, V, LDV,
$ ONE, WORK, LDWORK )
END IF
*
@@ -471,26 +469,26 @@
*
* C := C - W * V**T
*
- IF( LASTV.GT.K ) THEN
+ IF( N.GT.K ) THEN
*
* C1 := C1 - W * V1**T
*
CALL SGEMM( 'No transpose', 'Transpose',
- $ LASTC, LASTV-K, K, -ONE, WORK, LDWORK, V, LDV,
+ $ LASTC, N-K, K, -ONE, WORK, LDWORK, V, LDV,
$ ONE, C, LDC )
END IF
*
* W := W * V2**T
*
CALL STRMM( 'Right', 'Upper', 'Transpose', 'Unit',
- $ LASTC, K, ONE, V( LASTV-K+1, 1 ), LDV,
+ $ LASTC, 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, LASTV-K+J ) = C( I, LASTV-K+J ) - WORK(I, J)
+ C( I, N-K+J ) = C( I, N-K+J ) - WORK(I, J)
110 CONTINUE
120 CONTINUE
END IF
@@ -634,29 +632,28 @@
* Form H * C or H**T * C where C = ( C1 )
* ( C2 )
*
- LASTV = MAX( K, ILASLC( K, M, V, LDV ) )
- LASTC = ILASLC( LASTV, N, C, LDC )
+ LASTC = ILASLC( 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 SCOPY( LASTC, C( LASTV-K+J, 1 ), LDC,
+ CALL SCOPY( LASTC, C( M-K+J, 1 ), LDC,
$ WORK( 1, J ), 1 )
190 CONTINUE
*
* W := W * V2**T
*
CALL STRMM( 'Right', 'Lower', 'Transpose', 'Unit',
- $ LASTC, K, ONE, V( 1, LASTV-K+1 ), LDV,
+ $ LASTC, K, ONE, V( 1, M-K+1 ), LDV,
$ WORK, LDWORK )
- IF( LASTV.GT.K ) THEN
+ IF( M.GT.K ) THEN
*
* W := W + C1**T * V1**T
*
CALL SGEMM( 'Transpose', 'Transpose',
- $ LASTC, K, LASTV-K, ONE, C, LDC, V, LDV,
+ $ LASTC, K, M-K, ONE, C, LDC, V, LDV,
$ ONE, WORK, LDWORK )
END IF
*
@@ -667,26 +664,26 @@
*
* C := C - V**T * W**T
*
- IF( LASTV.GT.K ) THEN
+ IF( M.GT.K ) THEN
*
* C1 := C1 - V1**T * W**T
*
CALL SGEMM( 'Transpose', 'Transpose',
- $ LASTV-K, LASTC, K, -ONE, V, LDV, WORK, LDWORK,
+ $ M-K, LASTC, K, -ONE, V, LDV, WORK, LDWORK,
$ ONE, C, LDC )
END IF
*
* W := W * V2
*
CALL STRMM( 'Right', 'Lower', 'No transpose', 'Unit',
- $ LASTC, K, ONE, V( 1, LASTV-K+1 ), LDV,
+ $ LASTC, 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( LASTV-K+J, I ) = C( LASTV-K+J, I ) - WORK(I, J)
+ C( M-K+J, I ) = C( M-K+J, I ) - WORK(I, J)
200 CONTINUE
210 CONTINUE
*
@@ -694,29 +691,28 @@
*
* Form C * H or C * H**T where C = ( C1 C2 )
*
- LASTV = MAX( K, ILASLC( K, N, V, LDV ) )
- LASTC = ILASLR( M, LASTV, C, LDC )
+ LASTC = ILASLR( M, N, C, LDC )
*
* W := C * V**T = (C1*V1**T + C2*V2**T) (stored in WORK)
*
* W := C2
*
DO 220 J = 1, K
- CALL SCOPY( LASTC, C( 1, LASTV-K+J ), 1,
+ CALL SCOPY( LASTC, C( 1, N-K+J ), 1,
$ WORK( 1, J ), 1 )
220 CONTINUE
*
* W := W * V2**T
*
CALL STRMM( 'Right', 'Lower', 'Transpose', 'Unit',
- $ LASTC, K, ONE, V( 1, LASTV-K+1 ), LDV,
+ $ LASTC, K, ONE, V( 1, N-K+1 ), LDV,
$ WORK, LDWORK )
- IF( LASTV.GT.K ) THEN
+ IF( N.GT.K ) THEN
*
* W := W + C1 * V1**T
*
CALL SGEMM( 'No transpose', 'Transpose',
- $ LASTC, K, LASTV-K, ONE, C, LDC, V, LDV,
+ $ LASTC, K, N-K, ONE, C, LDC, V, LDV,
$ ONE, WORK, LDWORK )
END IF
*
@@ -727,27 +723,26 @@
*
* C := C - W * V
*
- IF( LASTV.GT.K ) THEN
+ IF( N.GT.K ) THEN
*
* C1 := C1 - W * V1
*
CALL SGEMM( 'No transpose', 'No transpose',
- $ LASTC, LASTV-K, K, -ONE, WORK, LDWORK, V, LDV,
+ $ LASTC, N-K, K, -ONE, WORK, LDWORK, V, LDV,
$ ONE, C, LDC )
END IF
*
* W := W * V2
*
CALL STRMM( 'Right', 'Lower', 'No transpose', 'Unit',
- $ LASTC, K, ONE, V( 1, LASTV-K+1 ), LDV,
+ $ LASTC, 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, LASTV-K+J ) = C( I, LASTV-K+J )
- $ - WORK( I, J )
+ C( I, N-K+J ) = C( I, N-K+J ) - WORK( I, J )
230 CONTINUE
240 CONTINUE
*
diff --git a/SRC/zlarfb.f b/SRC/zlarfb.f
index 56c4c62d..c4e2d59c 100644
--- a/SRC/zlarfb.f
+++ b/SRC/zlarfb.f
@@ -382,15 +382,14 @@
* Form H * C or H**H * C where C = ( C1 )
* ( C2 )
*
- LASTV = MAX( K, ILAZLR( M, K, V, LDV ) )
- LASTC = ILAZLC( LASTV, N, C, LDC )
+ LASTC = ILAZLC( M, N, C, LDC )
*
* W := C**H * V = (C1**H * V1 + C2**H * V2) (stored in WORK)
*
* W := C2**H
*
DO 70 J = 1, K
- CALL ZCOPY( LASTC, C( LASTV-K+J, 1 ), LDC,
+ CALL ZCOPY( LASTC, C( M-K+J, 1 ), LDC,
$ WORK( 1, J ), 1 )
CALL ZLACGV( LASTC, WORK( 1, J ), 1 )
70 CONTINUE
@@ -398,14 +397,14 @@
* W := W * V2
*
CALL ZTRMM( 'Right', 'Upper', 'No transpose', 'Unit',
- $ LASTC, K, ONE, V( LASTV-K+1, 1 ), LDV,
+ $ LASTC, K, ONE, V( M-K+1, 1 ), LDV,
$ WORK, LDWORK )
- IF( LASTV.GT.K ) THEN
+ IF( M.GT.K ) THEN
*
* W := W + C1**H*V1
*
CALL ZGEMM( 'Conjugate transpose', 'No transpose',
- $ LASTC, K, LASTV-K,
+ $ LASTC, K, M-K,
$ ONE, C, LDC, V, LDV,
$ ONE, WORK, LDWORK )
END IF
@@ -417,12 +416,12 @@
*
* C := C - V * W**H
*
- IF( LASTV.GT.K ) THEN
+ IF( M.GT.K ) THEN
*
* C1 := C1 - V1 * W**H
*
CALL ZGEMM( 'No transpose', 'Conjugate transpose',
- $ LASTV-K, LASTC, K,
+ $ M-K, LASTC, K,
$ -ONE, V, LDV, WORK, LDWORK,
$ ONE, C, LDC )
END IF
@@ -430,14 +429,14 @@
* W := W * V2**H
*
CALL ZTRMM( 'Right', 'Upper', 'Conjugate transpose',
- $ 'Unit', LASTC, K, ONE, V( LASTV-K+1, 1 ), LDV,
+ $ 'Unit', LASTC, K, ONE, V( M-K+1, 1 ), LDV,
$ WORK, LDWORK )
*
* C2 := C2 - W**H
*
DO 90 J = 1, K
DO 80 I = 1, LASTC
- C( LASTV-K+J, I ) = C( LASTV-K+J, I ) -
+ C( M-K+J, I ) = C( M-K+J, I ) -
$ DCONJG( WORK( I, J ) )
80 CONTINUE
90 CONTINUE
@@ -446,29 +445,28 @@
*
* Form C * H or C * H**H where C = ( C1 C2 )
*
- LASTV = MAX( K, ILAZLR( N, K, V, LDV ) )
- LASTC = ILAZLR( M, LASTV, C, LDC )
+ LASTC = ILAZLR( M, N, C, LDC )
*
* W := C * V = (C1*V1 + C2*V2) (stored in WORK)
*
* W := C2
*
DO 100 J = 1, K
- CALL ZCOPY( LASTC, C( 1, LASTV-K+J ), 1,
+ CALL ZCOPY( LASTC, C( 1, N-K+J ), 1,
$ WORK( 1, J ), 1 )
100 CONTINUE
*
* W := W * V2
*
CALL ZTRMM( 'Right', 'Upper', 'No transpose', 'Unit',
- $ LASTC, K, ONE, V( LASTV-K+1, 1 ), LDV,
+ $ LASTC, K, ONE, V( N-K+1, 1 ), LDV,
$ WORK, LDWORK )
- IF( LASTV.GT.K ) THEN
+ IF( N.GT.K ) THEN
*
* W := W + C1 * V1
*
CALL ZGEMM( 'No transpose', 'No transpose',
- $ LASTC, K, LASTV-K,
+ $ LASTC, K, N-K,
$ ONE, C, LDC, V, LDV, ONE, WORK, LDWORK )
END IF
*
@@ -479,26 +477,26 @@
*
* C := C - W * V**H
*
- IF( LASTV.GT.K ) THEN
+ IF( N.GT.K ) THEN
*
* C1 := C1 - W * V1**H
*
CALL ZGEMM( 'No transpose', 'Conjugate transpose',
- $ LASTC, LASTV-K, K, -ONE, WORK, LDWORK, V, LDV,
+ $ LASTC, N-K, K, -ONE, WORK, LDWORK, V, LDV,
$ ONE, C, LDC )
END IF
*
* W := W * V2**H
*
CALL ZTRMM( 'Right', 'Upper', 'Conjugate transpose',
- $ 'Unit', LASTC, K, ONE, V( LASTV-K+1, 1 ), LDV,
+ $ 'Unit', LASTC, 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, LASTV-K+J ) = C( I, LASTV-K+J )
+ C( I, N-K+J ) = C( I, N-K+J )
$ - WORK( I, J )
110 CONTINUE
120 CONTINUE
@@ -643,15 +641,14 @@
* Form H * C or H**H * C where C = ( C1 )
* ( C2 )
*
- LASTV = MAX( K, ILAZLC( K, M, V, LDV ) )
- LASTC = ILAZLC( LASTV, N, C, LDC )
+ LASTC = ILAZLC( M, N, C, LDC )
*
* W := C**H * V**H = (C1**H * V1**H + C2**H * V2**H) (stored in WORK)
*
* W := C2**H
*
DO 190 J = 1, K
- CALL ZCOPY( LASTC, C( LASTV-K+J, 1 ), LDC,
+ CALL ZCOPY( LASTC, C( M-K+J, 1 ), LDC,
$ WORK( 1, J ), 1 )
CALL ZLACGV( LASTC, WORK( 1, J ), 1 )
190 CONTINUE
@@ -659,14 +656,14 @@
* W := W * V2**H
*
CALL ZTRMM( 'Right', 'Lower', 'Conjugate transpose',
- $ 'Unit', LASTC, K, ONE, V( 1, LASTV-K+1 ), LDV,
+ $ 'Unit', LASTC, K, ONE, V( 1, M-K+1 ), LDV,
$ WORK, LDWORK )
- IF( LASTV.GT.K ) THEN
+ IF( M.GT.K ) THEN
*
* W := W + C1**H * V1**H
*
CALL ZGEMM( 'Conjugate transpose',
- $ 'Conjugate transpose', LASTC, K, LASTV-K,
+ $ 'Conjugate transpose', LASTC, K, M-K,
$ ONE, C, LDC, V, LDV, ONE, WORK, LDWORK )
END IF
*
@@ -677,26 +674,26 @@
*
* C := C - V**H * W**H
*
- IF( LASTV.GT.K ) THEN
+ IF( M.GT.K ) THEN
*
* C1 := C1 - V1**H * W**H
*
CALL ZGEMM( 'Conjugate transpose',
- $ 'Conjugate transpose', LASTV-K, LASTC, K,
+ $ 'Conjugate transpose', M-K, LASTC, K,
$ -ONE, V, LDV, WORK, LDWORK, ONE, C, LDC )
END IF
*
* W := W * V2
*
CALL ZTRMM( 'Right', 'Lower', 'No transpose', 'Unit',
- $ LASTC, K, ONE, V( 1, LASTV-K+1 ), LDV,
+ $ LASTC, K, ONE, V( 1, M-K+1 ), LDV,
$ WORK, LDWORK )
*
* C2 := C2 - W**H
*
DO 210 J = 1, K
DO 200 I = 1, LASTC
- C( LASTV-K+J, I ) = C( LASTV-K+J, I ) -
+ C( M-K+J, I ) = C( M-K+J, I ) -
$ DCONJG( WORK( I, J ) )
200 CONTINUE
210 CONTINUE
@@ -705,29 +702,28 @@
*
* Form C * H or C * H**H where C = ( C1 C2 )
*
- LASTV = MAX( K, ILAZLC( K, N, V, LDV ) )
- LASTC = ILAZLR( M, LASTV, C, LDC )
+ LASTC = ILAZLR( M, N, C, LDC )
*
* W := C * V**H = (C1*V1**H + C2*V2**H) (stored in WORK)
*
* W := C2
*
DO 220 J = 1, K
- CALL ZCOPY( LASTC, C( 1, LASTV-K+J ), 1,
+ CALL ZCOPY( LASTC, C( 1, N-K+J ), 1,
$ WORK( 1, J ), 1 )
220 CONTINUE
*
* W := W * V2**H
*
CALL ZTRMM( 'Right', 'Lower', 'Conjugate transpose',
- $ 'Unit', LASTC, K, ONE, V( 1, LASTV-K+1 ), LDV,
+ $ 'Unit', LASTC, K, ONE, V( 1, N-K+1 ), LDV,
$ WORK, LDWORK )
- IF( LASTV.GT.K ) THEN
+ IF( N.GT.K ) THEN
*
* W := W + C1 * V1**H
*
CALL ZGEMM( 'No transpose', 'Conjugate transpose',
- $ LASTC, K, LASTV-K, ONE, C, LDC, V, LDV, ONE,
+ $ LASTC, K, N-K, ONE, C, LDC, V, LDV, ONE,
$ WORK, LDWORK )
END IF
*
@@ -738,27 +734,26 @@
*
* C := C - W * V
*
- IF( LASTV.GT.K ) THEN
+ IF( N.GT.K ) THEN
*
* C1 := C1 - W * V1
*
CALL ZGEMM( 'No transpose', 'No transpose',
- $ LASTC, LASTV-K, K, -ONE, WORK, LDWORK, V, LDV,
+ $ LASTC, N-K, K, -ONE, WORK, LDWORK, V, LDV,
$ ONE, C, LDC )
END IF
*
* W := W * V2
*
CALL ZTRMM( 'Right', 'Lower', 'No transpose', 'Unit',
- $ LASTC, K, ONE, V( 1, LASTV-K+1 ), LDV,
+ $ LASTC, 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, LASTV-K+J ) = C( I, LASTV-K+J )
- $ - WORK( I, J )
+ C( I, N-K+J ) = C( I, N-K+J ) - WORK( I, J )
230 CONTINUE
240 CONTINUE
*