summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--SRC/cla_gbamv.f19
-rw-r--r--SRC/cla_gbrcond_c.f41
-rw-r--r--SRC/cla_gbrcond_x.f25
-rw-r--r--SRC/dla_gbamv.f19
-rw-r--r--SRC/dla_gbrcond.f53
-rw-r--r--SRC/sla_gbamv.f20
-rw-r--r--SRC/sla_gbrcond.f53
-rw-r--r--SRC/zla_gbamv.f20
-rw-r--r--SRC/zla_gbrcond_c.f45
-rw-r--r--SRC/zla_gbrcond_x.f29
10 files changed, 150 insertions, 174 deletions
diff --git a/SRC/cla_gbamv.f b/SRC/cla_gbamv.f
index 9bfbab08..a4022318 100644
--- a/SRC/cla_gbamv.f
+++ b/SRC/cla_gbamv.f
@@ -1,7 +1,7 @@
SUBROUTINE CLA_GBAMV( TRANS, M, N, KL, KU, ALPHA, AB, LDAB, X,
$ INCX, BETA, Y, INCY )
*
-* -- LAPACK routine (version 3.2) --
+* -- LAPACK routine (version 3.2.1) --
* -- Contributed by James Demmel, Deaglan Halligan, Yozo Hida and --
* -- Jason Riedy of Univ. of California Berkeley. --
* -- November 2008 --
@@ -23,7 +23,7 @@
* Purpose
* =======
*
-* SLA_GEAMV performs one of the matrix-vector operations
+* SLA_GBAMV performs one of the matrix-vector operations
*
* y := alpha*abs(A)*abs(x) + beta*abs(y),
* or y := alpha*abs(A)'*abs(x) + beta*abs(y),
@@ -127,7 +127,7 @@
* .. Local Scalars ..
LOGICAL SYMB_ZERO
REAL TEMP, SAFE1
- INTEGER I, INFO, IY, J, JX, KX, KY, LENX, LENY, KD
+ INTEGER I, INFO, IY, J, JX, KX, KY, LENX, LENY, KD, KE
COMPLEX CDUM
* ..
* .. External Subroutines ..
@@ -160,9 +160,9 @@
INFO = 2
ELSE IF( N.LT.0 )THEN
INFO = 3
- ELSE IF( KL.LT.0 ) THEN
+ ELSE IF( KL.LT.0 .OR. KL.GT.M-1 ) THEN
INFO = 4
- ELSE IF( KU.LT.0 ) THEN
+ ELSE IF( KU.LT.0 .OR. KU.GT.N-1 ) THEN
INFO = 5
ELSE IF( LDAB.LT.KL+KU+1 )THEN
INFO = 6
@@ -216,6 +216,7 @@
* to per-column.
*
KD = KU + 1
+ KE = KL + 1
IY = KY
IF ( INCX.EQ.1 ) THEN
DO I = 1, LENY
@@ -229,11 +230,11 @@
Y( IY ) = BETA * ABS( Y( IY ) )
END IF
IF ( ALPHA .NE. 0.0 ) THEN
- DO J = MAX( I-KU, 1 ), MIN( I+KL, LENX )
+ DO J = MAX( I-KL, 1 ), MIN( I+KU, LENX )
IF( TRANS.EQ.ILATRANS( 'N' ) )THEN
TEMP = CABS1( AB( KD+I-J, J ) )
ELSE
- TEMP = CABS1( AB( J, KD+I-J ) )
+ TEMP = CABS1( AB( KE-I+J, I ) )
END IF
SYMB_ZERO = SYMB_ZERO .AND.
@@ -261,12 +262,12 @@
END IF
IF ( ALPHA .NE. 0.0 ) THEN
JX = KX
- DO J = MAX( I-KU, 1 ), MIN( I+KL, LENX )
+ DO J = MAX( I-KL, 1 ), MIN( I+KU, LENX )
IF( TRANS.EQ.ILATRANS( 'N' ) )THEN
TEMP = CABS1( AB( KD+I-J, J ) )
ELSE
- TEMP = CABS1( AB( J, KD+I-J ) )
+ TEMP = CABS1( AB( KE-I+J, I ) )
END IF
SYMB_ZERO = SYMB_ZERO .AND.
diff --git a/SRC/cla_gbrcond_c.f b/SRC/cla_gbrcond_c.f
index 434ebbc5..ec536701 100644
--- a/SRC/cla_gbrcond_c.f
+++ b/SRC/cla_gbrcond_c.f
@@ -2,7 +2,7 @@
$ LDAFB, IPIV, C, CAPPLY, INFO, WORK,
$ RWORK )
*
-* -- LAPACK routine (version 3.2) --
+* -- LAPACK routine (version 3.2.1) --
* -- Contributed by James Demmel, Deaglan Halligan, Yozo Hida and --
* -- Jason Riedy of Univ. of California Berkeley. --
* -- November 2008 --
@@ -15,7 +15,7 @@
* .. Scalar Arguments ..
CHARACTER TRANS
LOGICAL CAPPLY
- INTEGER N, KL, KU, KD, LDAB, LDAFB, INFO
+ INTEGER N, KL, KU, KD, KE, LDAB, LDAFB, INFO
* ..
* .. Array Arguments ..
INTEGER IPIV( * )
@@ -74,6 +74,14 @@
$ LSAME( TRANS, 'C' ) ) THEN
ELSE IF( N.LT.0 ) THEN
INFO = -2
+ ELSE IF( KL.LT.0 .OR. KL.GT.N-1 ) THEN
+ INFO = -4
+ ELSE IF( KU.LT.0 .OR. KU.GT.N-1 ) THEN
+ INFO = -5
+ ELSE IF( LDAB.LT.KL+KU+1 ) THEN
+ INFO = -8
+ ELSE IF( LDAFB.LT.2*KL+KU+1 ) THEN
+ INFO = -10
END IF
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'CLA_GBRCOND_C', -INFO )
@@ -84,22 +92,17 @@
*
ANORM = 0.0E+0
KD = KU + 1
+ KE = KL + 1
IF ( NOTRANS ) THEN
DO I = 1, N
TMP = 0.0E+0
IF ( CAPPLY ) THEN
- DO J = 1, N
- IF ( I.GE.MAX( 1, J-KU )
- $ .AND. I.LE.MIN( N, J+KL ) ) THEN
- TMP = TMP + CABS1(AB( KD+I-J, J ) ) / C( J )
- END IF
+ DO J = MAX( I-KL, 1 ), MIN( I+KU, N )
+ TMP = TMP + CABS1( AB( KD+I-J, J ) ) / C( J )
END DO
ELSE
- DO J = 1, N
- IF ( I.GE.MAX( 1, J-KU )
- $ .AND. I.LE.MIN( N, J+KL ) ) THEN
- TMP = TMP + CABS1( AB( KD+I-J, J ) )
- END IF
+ DO J = MAX( I-KL, 1 ), MIN( I+KU, N )
+ TMP = TMP + CABS1( AB( KD+I-J, J ) )
END DO
END IF
RWORK( 2*N+I ) = TMP
@@ -109,18 +112,12 @@
DO I = 1, N
TMP = 0.0E+0
IF ( CAPPLY ) THEN
- DO J = 1, N
- IF ( I.GE.MAX( 1, J-KU )
- $ .AND. I.LE.MIN( N, J+KL ) ) THEN
- TMP = TMP + CABS1( AB( J, KD+I-J ) ) / C( J )
- END IF
+ DO J = MAX( I-KL, 1 ), MIN( I+KU, N )
+ TMP = TMP + CABS1( AB( KE-I+J, I ) ) / C( J )
END DO
ELSE
- DO J = 1, N
- IF ( I.GE.MAX( 1, J-KU )
- $ .AND. I.LE.MIN( N, J+KL ) ) THEN
- TMP = TMP + CABS1( AB( J, KD+I-J ) )
- END IF
+ DO J = MAX( I-KL, 1 ), MIN( I+KU, N )
+ TMP = TMP + CABS1( AB( KE-I+J, I ) )
END DO
END IF
RWORK( 2*N+I ) = TMP
diff --git a/SRC/cla_gbrcond_x.f b/SRC/cla_gbrcond_x.f
index 073cecc4..75d04617 100644
--- a/SRC/cla_gbrcond_x.f
+++ b/SRC/cla_gbrcond_x.f
@@ -1,7 +1,7 @@
REAL FUNCTION CLA_GBRCOND_X( TRANS, N, KL, KU, AB, LDAB, AFB,
$ LDAFB, IPIV, X, INFO, WORK, RWORK )
*
-* -- LAPACK routine (version 3.2) --
+* -- LAPACK routine (version 3.2.1) --
* -- Contributed by James Demmel, Deaglan Halligan, Yozo Hida and --
* -- Jason Riedy of Univ. of California Berkeley. --
* -- November 2008 --
@@ -13,7 +13,7 @@
* ..
* .. Scalar Arguments ..
CHARACTER TRANS
- INTEGER N, KL, KU, KD, LDAB, LDAFB, INFO
+ INTEGER N, KL, KU, KD, KE, LDAB, LDAFB, INFO
* ..
* .. Array Arguments ..
INTEGER IPIV( * )
@@ -75,6 +75,14 @@
INFO = -1
ELSE IF( N.LT.0 ) THEN
INFO = -2
+ ELSE IF( KL.LT.0 .OR. KL.GT.N-1 ) THEN
+ INFO = -4
+ ELSE IF( KU.LT.0 .OR. KU.GT.N-1 ) THEN
+ INFO = -5
+ ELSE IF( LDAB.LT.KL+KU+1 ) THEN
+ INFO = -8
+ ELSE IF( LDAFB.LT.2*KL+KU+1 ) THEN
+ INFO = -10
END IF
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'CLA_GBRCOND_X', -INFO )
@@ -84,14 +92,13 @@
* Compute norm of op(A)*op2(C).
*
KD = KU + 1
+ KE = KL + 1
ANORM = 0.0
IF ( NOTRANS ) THEN
DO I = 1, N
TMP = 0.0E+0
- DO J = 1, N
- IF ( I.GE.MAX( 1, J-KU ) .AND. I.LE.MIN( N, J+KL ) ) THEN
- TMP = TMP + CABS1( AB( KD+I-J, J) * X( J ) )
- END IF
+ DO J = MAX( I-KL, 1 ), MIN( I+KU, N )
+ TMP = TMP + CABS1( AB( KD+I-J, J) * X( J ) )
END DO
RWORK( 2*N+I ) = TMP
ANORM = MAX( ANORM, TMP )
@@ -99,10 +106,8 @@
ELSE
DO I = 1, N
TMP = 0.0E+0
- DO J = 1, N
- IF ( I.GE.MAX( 1, J-KU ) .AND. I.LE.MIN( N, J+KL ) ) THEN
- TMP = TMP + CABS1( AB( J, KD+I-J ) * X( J ) )
- END IF
+ DO J = MAX( I-KL, 1 ), MIN( I+KU, N )
+ TMP = TMP + CABS1( AB( KE-I+J, I ) * X( J ) )
END DO
RWORK( 2*N+I ) = TMP
ANORM = MAX( ANORM, TMP )
diff --git a/SRC/dla_gbamv.f b/SRC/dla_gbamv.f
index cab0a645..64f29be5 100644
--- a/SRC/dla_gbamv.f
+++ b/SRC/dla_gbamv.f
@@ -1,7 +1,7 @@
SUBROUTINE DLA_GBAMV( TRANS, M, N, KL, KU, ALPHA, AB, LDAB, X,
$ INCX, BETA, Y, INCY )
*
-* -- LAPACK routine (version 3.2) --
+* -- LAPACK routine (version 3.2.1) --
* -- Contributed by James Demmel, Deaglan Halligan, Yozo Hida and --
* -- Jason Riedy of Univ. of California Berkeley. --
* -- November 2008 --
@@ -22,7 +22,7 @@
* Purpose
* =======
*
-* DLA_GEAMV performs one of the matrix-vector operations
+* DLA_GBAMV performs one of the matrix-vector operations
*
* y := alpha*abs(A)*abs(x) + beta*abs(y),
* or y := alpha*abs(A)'*abs(x) + beta*abs(y),
@@ -126,7 +126,7 @@
* .. Local Scalars ..
LOGICAL SYMB_ZERO
DOUBLE PRECISION TEMP, SAFE1
- INTEGER I, INFO, IY, J, JX, KX, KY, LENX, LENY, KD
+ INTEGER I, INFO, IY, J, JX, KX, KY, LENX, LENY, KD, KE
* ..
* .. External Subroutines ..
EXTERNAL XERBLA, DLAMCH
@@ -152,9 +152,9 @@
INFO = 2
ELSE IF( N.LT.0 )THEN
INFO = 3
- ELSE IF( KL.LT.0 ) THEN
+ ELSE IF( KL.LT.0 .OR. KL.GT.M-1 ) THEN
INFO = 4
- ELSE IF( KU.LT.0 ) THEN
+ ELSE IF( KU.LT.0 .OR. KU.GT.N-1 ) THEN
INFO = 5
ELSE IF( LDAB.LT.KL+KU+1 )THEN
INFO = 6
@@ -208,6 +208,7 @@
* to per-column.
*
KD = KU + 1
+ KE = KL + 1
IY = KY
IF ( INCX.EQ.1 ) THEN
DO I = 1, LENY
@@ -221,11 +222,11 @@
Y( IY ) = BETA * ABS( Y( IY ) )
END IF
IF ( ALPHA .NE. ZERO ) THEN
- DO J = MAX( I-KU, 1 ), MIN( I+KL, LENX )
+ DO J = MAX( I-KL, 1 ), MIN( I+KU, LENX )
IF( TRANS.EQ.ILATRANS( 'N' ) )THEN
TEMP = ABS( AB( KD+I-J, J ) )
ELSE
- TEMP = ABS( AB( J, KD+I-J ) )
+ TEMP = ABS( AB( KE-I+J, I ) )
END IF
SYMB_ZERO = SYMB_ZERO .AND.
@@ -252,12 +253,12 @@
END IF
IF ( ALPHA .NE. ZERO ) THEN
JX = KX
- DO J = MAX( I-KU, 1 ), MIN( I+KL, LENX )
+ DO J = MAX( I-KL, 1 ), MIN( I+KU, LENX )
IF( TRANS.EQ.ILATRANS( 'N' ) )THEN
TEMP = ABS( AB( KD+I-J, J ) )
ELSE
- TEMP = ABS( AB( J, KD+I-J ) )
+ TEMP = ABS( AB( KE-I+J, I ) )
END IF
SYMB_ZERO = SYMB_ZERO .AND.
diff --git a/SRC/dla_gbrcond.f b/SRC/dla_gbrcond.f
index 904e50af..cf2c5ca3 100644
--- a/SRC/dla_gbrcond.f
+++ b/SRC/dla_gbrcond.f
@@ -1,8 +1,8 @@
DOUBLE PRECISION FUNCTION DLA_GBRCOND( TRANS, N, KL, KU, AB, LDAB,
- $ AFB, LDAFB, IPIV, CMODE, C, INFO,
+ $ AFB, LDAFB, IPIV, CMODE, C, INFO,
$ WORK, IWORK )
*
-* -- LAPACK routine (version 3.2) --
+* -- LAPACK routine (version 3.2.1) --
* -- Contributed by James Demmel, Deaglan Halligan, Yozo Hida and --
* -- Jason Riedy of Univ. of California Berkeley. --
* -- November 2008 --
@@ -46,7 +46,7 @@
*
* .. Local Scalars ..
LOGICAL NOTRANS
- INTEGER KASE, I, J, KD
+ INTEGER KASE, I, J, KD, KE
DOUBLE PRECISION AINVNM, TMP
* ..
* .. Local Arrays ..
@@ -73,9 +73,9 @@
INFO = -1
ELSE IF( N.LT.0 ) THEN
INFO = -2
- ELSE IF( KL.LT.0 ) THEN
+ ELSE IF( KL.LT.0 .OR. KL.GT.N-1 ) THEN
INFO = -4
- ELSE IF( KU.LT.0 ) THEN
+ ELSE IF( KU.LT.0 .OR. KU.GT.N-1 ) THEN
INFO = -5
ELSE IF( LDAB.LT.KL+KU+1 ) THEN
INFO = -8
@@ -95,29 +95,21 @@
* inv(R)*A*C has unit 1-norm.
*
KD = KU + 1
+ KE = KL + 1
IF ( NOTRANS ) THEN
DO I = 1, N
TMP = 0.0D+0
IF ( CMODE .EQ. 1 ) THEN
- DO J = 1, N
- IF ( I.GE.MAX( 1, J-KU )
- $ .AND. I.LE.MIN( N, J+KL ) ) THEN
- TMP = TMP + ABS( AB( KD+I-J, J ) * C( J ) )
- END IF
+ DO J = MAX( I-KL, 1 ), MIN( I+KU, N )
+ TMP = TMP + ABS( AB( KD+I-J, J ) * C( J ) )
END DO
ELSE IF ( CMODE .EQ. 0 ) THEN
- DO J = 1, N
- IF ( I.GE.MAX( 1, J-KU )
- $ .AND. I.LE.MIN( N, J+KL ) ) THEN
- TMP = TMP + ABS( AB( KD+I-J, J ) )
- END IF
+ DO J = MAX( I-KL, 1 ), MIN( I+KU, N )
+ TMP = TMP + ABS( AB( KD+I-J, J ) )
END DO
ELSE
- DO J = 1, N
- IF ( I.GE.MAX( 1, J-KU )
- $ .AND. I.LE.MIN( N, J+KL ) ) THEN
- TMP = TMP + ABS( AB( KD+I-J, J ) / C( J ) )
- END IF
+ DO J = MAX( I-KL, 1 ), MIN( I+KU, N )
+ TMP = TMP + ABS( AB( KD+I-J, J ) / C( J ) )
END DO
END IF
WORK( 2*N+I ) = TMP
@@ -126,25 +118,16 @@
DO I = 1, N
TMP = 0.0D+0
IF ( CMODE .EQ. 1 ) THEN
- DO J = 1, N
- IF ( I.GE.MAX( 1, J-KU )
- $ .AND. I.LE.MIN( N, J+KL ) ) THEN
- TMP = TMP + ABS( AB( J, KD+I-J ) * C( J ) )
- END IF
+ DO J = MAX( I-KL, 1 ), MIN( I+KU, N )
+ TMP = TMP + ABS( AB( KE-I+J, I ) * C( J ) )
END DO
ELSE IF ( CMODE .EQ. 0 ) THEN
- DO J = 1, N
- IF ( I.GE.MAX( 1, J-KU )
- $ .AND. I.LE.MIN( N, J+KL ) ) THEN
- TMP = TMP + ABS(AB(J,KD+I-J))
- END IF
+ DO J = MAX( I-KL, 1 ), MIN( I+KU, N )
+ TMP = TMP + ABS( AB( KE-I+J, I ) )
END DO
ELSE
- DO J = 1, N
- IF ( I.GE.MAX( 1, J-KU )
- $ .AND. I.LE.MIN( N, J+KL ) ) THEN
- TMP = TMP + ABS( AB( J, KD+I-J ) / C( J ) )
- END IF
+ DO J = MAX( I-KL, 1 ), MIN( I+KU, N )
+ TMP = TMP + ABS( AB( KE-I+J, I ) / C( J ) )
END DO
END IF
WORK( 2*N+I ) = TMP
diff --git a/SRC/sla_gbamv.f b/SRC/sla_gbamv.f
index fb8ff49d..22e85bf5 100644
--- a/SRC/sla_gbamv.f
+++ b/SRC/sla_gbamv.f
@@ -1,7 +1,7 @@
SUBROUTINE SLA_GBAMV( TRANS, M, N, KL, KU, ALPHA, AB, LDAB, X,
$ INCX, BETA, Y, INCY )
*
-* -- LAPACK routine (version 3.2) --
+* -- LAPACK routine (version 3.2.1) --
* -- Contributed by James Demmel, Deaglan Halligan, Yozo Hida and --
* -- Jason Riedy of Univ. of California Berkeley. --
* -- November 2008 --
@@ -22,7 +22,7 @@
* Purpose
* =======
*
-* SLA_GEAMV performs one of the matrix-vector operations
+* SLA_GBAMV performs one of the matrix-vector operations
*
* y := alpha*abs(A)*abs(x) + beta*abs(y),
* or y := alpha*abs(A)'*abs(x) + beta*abs(y),
@@ -126,7 +126,7 @@
* .. Local Scalars ..
LOGICAL SYMB_ZERO
REAL TEMP, SAFE1
- INTEGER I, INFO, IY, J, JX, KX, KY, LENX, LENY, KD
+ INTEGER I, INFO, IY, J, JX, KX, KY, LENX, LENY, KD, KE
* ..
* .. External Subroutines ..
EXTERNAL XERBLA, SLAMCH
@@ -152,9 +152,9 @@
INFO = 2
ELSE IF( N.LT.0 )THEN
INFO = 3
- ELSE IF( KL.LT.0 ) THEN
+ ELSE IF( KL.LT.0 .OR. KL.GT.M-1 ) THEN
INFO = 4
- ELSE IF( KU.LT.0 ) THEN
+ ELSE IF( KU.LT.0 .OR. KU.GT.N-1 ) THEN
INFO = 5
ELSE IF( LDAB.LT.KL+KU+1 )THEN
INFO = 6
@@ -208,6 +208,7 @@
* to per-column.
*
KD = KU + 1
+ KE = KL + 1
IY = KY
IF ( INCX.EQ.1 ) THEN
DO I = 1, LENY
@@ -221,11 +222,12 @@
Y( IY ) = BETA * ABS( Y( IY ) )
END IF
IF ( ALPHA .NE. ZERO ) THEN
- DO J = MAX( I-KU, 1 ), MIN( I+KL, LENX )
+ DO J = MAX( I-KL, 1 ), MIN( I+KU, LENX )
IF( TRANS.EQ.ILATRANS( 'N' ) )THEN
+
TEMP = ABS( AB( KD+I-J, J ) )
ELSE
- TEMP = ABS( AB( J, KD+I-J ) )
+ TEMP = ABS( AB( KE-I+J, I ) )
END IF
SYMB_ZERO = SYMB_ZERO .AND.
@@ -252,12 +254,12 @@
END IF
IF ( ALPHA .NE. ZERO ) THEN
JX = KX
- DO J = MAX( I-KU, 1 ), MIN( I+KL, LENX )
+ DO J = MAX( I-KL, 1 ), MIN( I+KU, LENX )
IF( TRANS.EQ.ILATRANS( 'N' ) )THEN
TEMP = ABS( AB( KD+I-J, J ) )
ELSE
- TEMP = ABS( AB( J, KD+I-J ) )
+ TEMP = ABS( AB( KE-I+J, I ) )
END IF
SYMB_ZERO = SYMB_ZERO .AND.
diff --git a/SRC/sla_gbrcond.f b/SRC/sla_gbrcond.f
index eba7841d..ee18d28c 100644
--- a/SRC/sla_gbrcond.f
+++ b/SRC/sla_gbrcond.f
@@ -1,7 +1,7 @@
REAL FUNCTION SLA_GBRCOND( TRANS, N, KL, KU, AB, LDAB, AFB, LDAFB,
$ IPIV, CMODE, C, INFO, WORK, IWORK )
*
-* -- LAPACK routine (version 3.2) --
+* -- LAPACK routine (version 3.2.1) --
* -- Contributed by James Demmel, Deaglan Halligan, Yozo Hida and --
* -- Jason Riedy of Univ. of California Berkeley. --
* -- November 2008 --
@@ -45,7 +45,7 @@
*
* .. Local Scalars ..
LOGICAL NOTRANS
- INTEGER KASE, I, J, KD
+ INTEGER KASE, I, J, KD, KE
REAL AINVNM, TMP
* ..
* .. Local Arrays ..
@@ -72,9 +72,9 @@
INFO = -1
ELSE IF( N.LT.0 ) THEN
INFO = -2
- ELSE IF( KL.LT.0 ) THEN
+ ELSE IF( KL.LT.0 .OR. KL.GT.N-1 ) THEN
INFO = -4
- ELSE IF( KU.LT.0 ) THEN
+ ELSE IF( KU.LT.0 .OR. KU.GT.N-1 ) THEN
INFO = -5
ELSE IF( LDAB.LT.KL+KU+1 ) THEN
INFO = -8
@@ -94,29 +94,21 @@
* inv(R)*A*C has unit 1-norm.
*
KD = KU + 1
+ KE = KL + 1
IF ( NOTRANS ) THEN
DO I = 1, N
TMP = 0.0
IF ( CMODE .EQ. 1 ) THEN
- DO J = 1, N
- IF ( I.GE.MAX( 1, J-KU )
- $ .AND. I.LE.MIN( N, J+KL ) ) THEN
- TMP = TMP + ABS( AB( KD+I-J, J ) * C( J ) )
- END IF
- END DO
+ DO J = MAX( I-KL, 1 ), MIN( I+KU, N )
+ TMP = TMP + ABS( AB( KD+I-J, J ) * C( J ) )
+ END DO
ELSE IF ( CMODE .EQ. 0 ) THEN
- DO J = 1, N
- IF ( I.GE.MAX( 1, J-KU )
- $ .AND. I.LE.MIN( N, J+KL ) ) THEN
- TMP = TMP + ABS( AB( KD+I-J, J ) )
- END IF
+ DO J = MAX( I-KL, 1 ), MIN( I+KU, N )
+ TMP = TMP + ABS( AB( KD+I-J, J ) )
END DO
ELSE
- DO J = 1, N
- IF ( I.GE.MAX( 1, J-KU )
- $ .AND. I.LE.MIN( N, J+KL ) ) THEN
- TMP = TMP + ABS( AB( KD+I-J, J ) / C( J ) )
- END IF
+ DO J = MAX( I-KL, 1 ), MIN( I+KU, N )
+ TMP = TMP + ABS( AB( KD+I-J, J ) / C( J ) )
END DO
END IF
WORK( 2*N+I ) = TMP
@@ -125,25 +117,16 @@
DO I = 1, N
TMP = 0.0
IF ( CMODE .EQ. 1 ) THEN
- DO J = 1, N
- IF ( I.GE.MAX( 1, J-KU )
- $ .AND. I.LE.MIN( N, J+KL ) ) THEN
- TMP = TMP + ABS( AB( J, KD+I-J ) * C( J ) )
- END IF
+ DO J = MAX( I-KL, 1 ), MIN( I+KU, N )
+ TMP = TMP + ABS( AB( KE-I+J, I ) * C( J ) )
END DO
ELSE IF ( CMODE .EQ. 0 ) THEN
- DO J = 1, N
- IF ( I.GE.MAX( 1, J-KU )
- $ .AND. I.LE.MIN( N, J+KL ) ) THEN
- TMP = TMP + ABS(AB(J,KD+I-J))
- END IF
+ DO J = MAX( I-KL, 1 ), MIN( I+KU, N )
+ TMP = TMP + ABS( AB( KE-I+J, I ) )
END DO
ELSE
- DO J = 1, N
- IF ( I.GE.MAX( 1, J-KU )
- $ .AND. I.LE.MIN( N, J+KL ) ) THEN
- TMP = TMP + ABS( AB( J, KD+I-J ) / C( J ) )
- END IF
+ DO J = MAX( I-KL, 1 ), MIN( I+KU, N )
+ TMP = TMP + ABS( AB( KE-I+J, I ) / C( J ) )
END DO
END IF
WORK( 2*N+I ) = TMP
diff --git a/SRC/zla_gbamv.f b/SRC/zla_gbamv.f
index fb252014..3e89952c 100644
--- a/SRC/zla_gbamv.f
+++ b/SRC/zla_gbamv.f
@@ -1,7 +1,7 @@
SUBROUTINE ZLA_GBAMV( TRANS, M, N, KL, KU, ALPHA, AB, LDAB, X,
$ INCX, BETA, Y, INCY )
*
-* -- LAPACK routine (version 3.2) --
+* -- LAPACK routine (version 3.2.1) --
* -- Contributed by James Demmel, Deaglan Halligan, Yozo Hida and --
* -- Jason Riedy of Univ. of California Berkeley. --
* -- November 2008 --
@@ -23,7 +23,7 @@
* Purpose
* =======
*
-* DLA_GEAMV performs one of the matrix-vector operations
+* DLA_GBAMV performs one of the matrix-vector operations
*
* y := alpha*abs(A)*abs(x) + beta*abs(y),
* or y := alpha*abs(A)'*abs(x) + beta*abs(y),
@@ -128,7 +128,7 @@
* .. Local Scalars ..
LOGICAL SYMB_ZERO
DOUBLE PRECISION TEMP, SAFE1
- INTEGER I, INFO, IY, J, JX, KX, KY, LENX, LENY, KD
+ INTEGER I, INFO, IY, J, JX, KX, KY, LENX, LENY, KD, KE
COMPLEX*16 CDUM
* ..
* .. External Subroutines ..
@@ -161,9 +161,9 @@
INFO = 2
ELSE IF( N.LT.0 )THEN
INFO = 3
- ELSE IF( KL.LT.0 ) THEN
+ ELSE IF( KL.LT.0 .OR. KL.GT.M-1 ) THEN
INFO = 4
- ELSE IF( KU.LT.0 ) THEN
+ ELSE IF( KU.LT.0 .OR. KU.GT.N-1 ) THEN
INFO = 5
ELSE IF( LDAB.LT.KL+KU+1 )THEN
INFO = 6
@@ -217,6 +217,7 @@
* to per-column.
*
KD = KU + 1
+ KE = KL + 1
IY = KY
IF ( INCX.EQ.1 ) THEN
DO I = 1, LENY
@@ -230,11 +231,12 @@
Y( IY ) = BETA * ABS( Y( IY ) )
END IF
IF ( ALPHA .NE. 0.0D+0 ) THEN
- DO J = MAX( I-KU, 1 ), MIN( I+KL, LENX )
+ DO J = MAX( I-KL, 1 ), MIN( I+KU, LENX )
+
IF( TRANS.EQ.ILATRANS( 'N' ) )THEN
TEMP = CABS1( AB( KD+I-J, J ) )
ELSE
- TEMP = CABS1( AB( J, KD+I-J ) )
+ TEMP = CABS1( AB( KE-I+J, I ) )
END IF
SYMB_ZERO = SYMB_ZERO .AND.
@@ -262,12 +264,12 @@
END IF
IF ( ALPHA .NE. 0.0D+0 ) THEN
JX = KX
- DO J = MAX( I-KU, 1 ), MIN( I+KL, LENX )
+ DO J = MAX( I-KL, 1 ), MIN( I+KU, LENX )
IF( TRANS.EQ.ILATRANS( 'N' ) )THEN
TEMP = CABS1( AB( KD+I-J, J ) )
ELSE
- TEMP = CABS1( AB( J, KD+I-J ) )
+ TEMP = CABS1( AB( KE-I+J, I ) )
END IF
SYMB_ZERO = SYMB_ZERO .AND.
diff --git a/SRC/zla_gbrcond_c.f b/SRC/zla_gbrcond_c.f
index 6765e591..3c2241c0 100644
--- a/SRC/zla_gbrcond_c.f
+++ b/SRC/zla_gbrcond_c.f
@@ -1,8 +1,8 @@
- DOUBLE PRECISION FUNCTION ZLA_GBRCOND_C( TRANS, N, KL, KU, AB,
- $ LDAB, AFB, LDAFB, IPIV, C, CAPPLY,
+ DOUBLE PRECISION FUNCTION ZLA_GBRCOND_C( TRANS, N, KL, KU, AB,
+ $ LDAB, AFB, LDAFB, IPIV, C, CAPPLY,
$ INFO, WORK, RWORK )
*
-* -- LAPACK routine (version 3.2) --
+* -- LAPACK routine (version 3.2.1) --
* -- Contributed by James Demmel, Deaglan Halligan, Yozo Hida and --
* -- Jason Riedy of Univ. of California Berkeley. --
* -- November 2008 --
@@ -15,7 +15,7 @@
* .. Scalar Arguments ..
CHARACTER TRANS
LOGICAL CAPPLY
- INTEGER N, KL, KU, KD, LDAB, LDAFB, INFO
+ INTEGER N, KL, KU, KD, KE, LDAB, LDAFB, INFO
* ..
* .. Array Arguments ..
INTEGER IPIV( * )
@@ -74,6 +74,14 @@
$ LSAME( TRANS, 'C' ) ) THEN
ELSE IF( N.LT.0 ) THEN
INFO = -2
+ ELSE IF( KL.LT.0 .OR. KL.GT.N-1 ) THEN
+ INFO = -4
+ ELSE IF( KU.LT.0 .OR. KU.GT.N-1 ) THEN
+ INFO = -5
+ ELSE IF( LDAB.LT.KL+KU+1 ) THEN
+ INFO = -8
+ ELSE IF( LDAFB.LT.2*KL+KU+1 ) THEN
+ INFO = -10
END IF
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'ZLA_GBRCOND_C', -INFO )
@@ -84,22 +92,17 @@
*
ANORM = 0.0D+0
KD = KU + 1
+ KE = KL + 1
IF ( NOTRANS ) THEN
DO I = 1, N
TMP = 0.0D+0
IF ( CAPPLY ) THEN
- DO J = 1, N
- IF ( I.GE.MAX( 1, J-KU )
- $ .AND. I.LE.MIN( N, J+KL ) ) THEN
- TMP = TMP + CABS1(AB( KD+I-J, J ) ) / C( J )
- END IF
+ DO J = MAX( I-KL, 1 ), MIN( I+KU, N )
+ TMP = TMP + CABS1( AB( KD+I-J, J ) ) / C( J )
END DO
ELSE
- DO J = 1, N
- IF ( I.GE.MAX( 1, J-KU )
- $ .AND. I.LE.MIN( N, J+KL ) ) THEN
- TMP = TMP + CABS1( AB( KD+I-J, J ) )
- END IF
+ DO J = MAX( I-KL, 1 ), MIN( I+KU, N )
+ TMP = TMP + CABS1( AB( KD+I-J, J ) )
END DO
END IF
RWORK( 2*N+I ) = TMP
@@ -109,18 +112,12 @@
DO I = 1, N
TMP = 0.0D+0
IF ( CAPPLY ) THEN
- DO J = 1, N
- IF ( I.GE.MAX( 1, J-KU )
- $ .AND. I.LE.MIN( N, J+KL ) ) THEN
- TMP = TMP + CABS1( AB( J, KD+I-J ) ) / C( J )
- END IF
+ DO J = MAX( I-KL, 1 ), MIN( I+KU, N )
+ TMP = TMP + CABS1( AB( KE-I+J, I ) ) / C( J )
END DO
ELSE
- DO J = 1, N
- IF ( I.GE.MAX( 1, J-KU )
- $ .AND. I.LE.MIN( N, J+KL ) ) THEN
- TMP = TMP + CABS1( AB( J, KD+I-J ) )
- END IF
+ DO J = MAX( I-KL, 1 ), MIN( I+KU, N )
+ TMP = TMP + CABS1( AB( KE-I+J, I ) )
END DO
END IF
RWORK( 2*N+I ) = TMP
diff --git a/SRC/zla_gbrcond_x.f b/SRC/zla_gbrcond_x.f
index 7bc1aa3c..236508b3 100644
--- a/SRC/zla_gbrcond_x.f
+++ b/SRC/zla_gbrcond_x.f
@@ -1,8 +1,8 @@
- DOUBLE PRECISION FUNCTION ZLA_GBRCOND_X( TRANS, N, KL, KU, AB,
- $ LDAB, AFB, LDAFB, IPIV, X, INFO,
+ DOUBLE PRECISION FUNCTION ZLA_GBRCOND_X( TRANS, N, KL, KU, AB,
+ $ LDAB, AFB, LDAFB, IPIV, X, INFO,
$ WORK, RWORK )
*
-* -- LAPACK routine (version 3.2) --
+* -- LAPACK routine (version 3.2.1) --
* -- Contributed by James Demmel, Deaglan Halligan, Yozo Hida and --
* -- Jason Riedy of Univ. of California Berkeley. --
* -- November 2008 --
@@ -14,7 +14,7 @@
* ..
* .. Scalar Arguments ..
CHARACTER TRANS
- INTEGER N, KL, KU, KD, LDAB, LDAFB, INFO
+ INTEGER N, KL, KU, KD, KE, LDAB, LDAFB, INFO
* ..
* .. Array Arguments ..
INTEGER IPIV( * )
@@ -76,6 +76,14 @@
INFO = -1
ELSE IF( N.LT.0 ) THEN
INFO = -2
+ ELSE IF( KL.LT.0 .OR. KL.GT.N-1 ) THEN
+ INFO = -4
+ ELSE IF( KU.LT.0 .OR. KU.GT.N-1 ) THEN
+ INFO = -5
+ ELSE IF( LDAB.LT.KL+KU+1 ) THEN
+ INFO = -8
+ ELSE IF( LDAFB.LT.2*KL+KU+1 ) THEN
+ INFO = -10
END IF
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'ZLA_GBRCOND_X', -INFO )
@@ -85,14 +93,13 @@
* Compute norm of op(A)*op2(C).
*
KD = KU + 1
+ KE = KL + 1
ANORM = 0.0D+0
IF ( NOTRANS ) THEN
DO I = 1, N
TMP = 0.0D+0
- DO J = 1, N
- IF ( I.GE.MAX( 1, J-KU ) .AND. I.LE.MIN( N, J+KL ) ) THEN
- TMP = TMP + CABS1( AB( KD+I-J, J) * X( J ) )
- END IF
+ DO J = MAX( I-KL, 1 ), MIN( I+KU, N )
+ TMP = TMP + CABS1( AB( KD+I-J, J) * X( J ) )
END DO
RWORK( 2*N+I ) = TMP
ANORM = MAX( ANORM, TMP )
@@ -100,10 +107,8 @@
ELSE
DO I = 1, N
TMP = 0.0D+0
- DO J = 1, N
- IF ( I.GE.MAX( 1, J-KU ) .AND. I.LE.MIN( N, J+KL ) ) THEN
- TMP = TMP + CABS1( AB( J, KD+I-J ) * X( J ) )
- END IF
+ DO J = MAX( I-KL, 1 ), MIN( I+KU, N )
+ TMP = TMP + CABS1( AB( KE-I+J, I ) * X( J ) )
END DO
RWORK( 2*N+I ) = TMP
ANORM = MAX( ANORM, TMP )
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-29 16:45:45 +0000