Skip to content

Commit

Permalink
Revert "Merge pull request Reference-LAPACK#290 from mgates3/norms"
Browse files Browse the repository at this point in the history 
This reverts commit 8d23489, reversing
changes made to c3b03d8.
  • Loading branch information
@weslleyspereira
weslleyspereira committed May 26, 2021
1 parent bd6add2 commit 4ea5c1e
Show file tree
Hide file tree
Showing 46 changed files with 496 additions and 1,462 deletions.
4 changes: 2 additions & 2 deletions SRC/CMakeLists.txt
View file
Original file line number Diff line number Diff line change
Expand Up @@ -155,7 +155,7 @@ set(SLASRC
ssytrd_2stage.f ssytrd_sy2sb.f ssytrd_sb2st.F ssb2st_kernels.f
ssyevd_2stage.f ssyev_2stage.f ssyevx_2stage.f ssyevr_2stage.f
ssbev_2stage.f ssbevx_2stage.f ssbevd_2stage.f ssygv_2stage.f
sgesvdq.f scombssq.f)
sgesvdq.f)

set(DSLASRC spotrs.f sgetrs.f spotrf.f sgetrf.f)

Expand Down Expand Up @@ -352,7 +352,7 @@ set(DLASRC
dsytrd_2stage.f dsytrd_sy2sb.f dsytrd_sb2st.F dsb2st_kernels.f
dsyevd_2stage.f dsyev_2stage.f dsyevx_2stage.f dsyevr_2stage.f
dsbev_2stage.f dsbevx_2stage.f dsbevd_2stage.f dsygv_2stage.f
dgesvdq.f dcombssq.f)
dgesvdq.f)

set(DXLASRC dgesvxx.f dgerfsx.f dla_gerfsx_extended.f dla_geamv.f
dla_gercond.f dla_gerpvgrw.f dsysvxx.f dsyrfsx.f
Expand Down
4 changes: 2 additions & 2 deletions SRC/Makefile
View file
Original file line number Diff line number Diff line change
Expand Up @@ -191,7 +191,7 @@ SLASRC = \
ssytrd_2stage.o ssytrd_sy2sb.o ssytrd_sb2st.o ssb2st_kernels.o \
ssyevd_2stage.o ssyev_2stage.o ssyevx_2stage.o ssyevr_2stage.o \
ssbev_2stage.o ssbevx_2stage.o ssbevd_2stage.o ssygv_2stage.o \
sgesvdq.o scombssq.o
sgesvdq.o

DSLASRC = spotrs.o sgetrs.o spotrf.o sgetrf.o

Expand Down Expand Up @@ -394,7 +394,7 @@ DLASRC = \
dsytrd_2stage.o dsytrd_sy2sb.o dsytrd_sb2st.o dsb2st_kernels.o \
dsyevd_2stage.o dsyev_2stage.o dsyevx_2stage.o dsyevr_2stage.o \
dsbev_2stage.o dsbevx_2stage.o dsbevd_2stage.o dsygv_2stage.o \
dgesvdq.o dcombssq.o
dgesvdq.o

ifdef USEXBLAS
DXLASRC = dgesvxx.o dgerfsx.o dla_gerfsx_extended.o dla_geamv.o \
Expand Down
23 changes: 6 additions & 17 deletions SRC/clangb.f
View file
Original file line number Diff line number Diff line change
Expand Up @@ -127,7 +127,6 @@ REAL FUNCTION CLANGB( NORM, N, KL, KU, AB, LDAB,
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
*
IMPLICIT NONE
* .. Scalar Arguments ..
CHARACTER NORM
INTEGER KL, KU, LDAB, N
Expand All @@ -145,17 +144,14 @@ REAL FUNCTION CLANGB( NORM, N, KL, KU, AB, LDAB,
* ..
* .. Local Scalars ..
INTEGER I, J, K, L
REAL SUM, VALUE, TEMP
* ..
* .. Local Arrays ..
REAL SSQ( 2 ), COLSSQ( 2 )
REAL SCALE, SUM, VALUE, TEMP
* ..
* .. External Functions ..
LOGICAL LSAME, SISNAN
EXTERNAL LSAME, SISNAN
* ..
* .. External Subroutines ..
EXTERNAL CLASSQ, SCOMBSSQ
EXTERNAL CLASSQ
* ..
* .. Intrinsic Functions ..
INTRINSIC ABS, MAX, MIN, SQRT
Expand Down Expand Up @@ -208,22 +204,15 @@ REAL FUNCTION CLANGB( NORM, N, KL, KU, AB, LDAB,
ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN
*
* Find normF(A).
* SSQ(1) is scale
* SSQ(2) is sum-of-squares
* For better accuracy, sum each column separately.
*
SSQ( 1 ) = ZERO
SSQ( 2 ) = ONE
SCALE = ZERO
SUM = ONE
DO 90 J = 1, N
L = MAX( 1, J-KU )
K = KU + 1 - J + L
COLSSQ( 1 ) = ZERO
COLSSQ( 2 ) = ONE
CALL CLASSQ( MIN( N, J+KL )-L+1, AB( K, J ), 1,
$ COLSSQ( 1 ), COLSSQ( 2 ) )
CALL SCOMBSSQ( SSQ, COLSSQ )
CALL CLASSQ( MIN( N, J+KL )-L+1, AB( K, J ), 1, SCALE, SUM )
90 CONTINUE
VALUE = SSQ( 1 )*SQRT( SSQ( 2 ) )
VALUE = SCALE*SQRT( SUM )
END IF
*
CLANGB = VALUE
Expand Down
22 changes: 6 additions & 16 deletions SRC/clange.f
View file
Original file line number Diff line number Diff line change
Expand Up @@ -117,7 +117,6 @@ REAL FUNCTION CLANGE( NORM, M, N, A, LDA, WORK )
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
*
IMPLICIT NONE
* .. Scalar Arguments ..
CHARACTER NORM
INTEGER LDA, M, N
Expand All @@ -135,17 +134,14 @@ REAL FUNCTION CLANGE( NORM, M, N, A, LDA, WORK )
* ..
* .. Local Scalars ..
INTEGER I, J
REAL SUM, VALUE, TEMP
* ..
* .. Local Arrays ..
REAL SSQ( 2 ), COLSSQ( 2 )
REAL SCALE, SUM, VALUE, TEMP
* ..
* .. External Functions ..
LOGICAL LSAME, SISNAN
EXTERNAL LSAME, SISNAN
* ..
* .. External Subroutines ..
EXTERNAL CLASSQ, SCOMBSSQ
EXTERNAL CLASSQ
* ..
* .. Intrinsic Functions ..
INTRINSIC ABS, MIN, SQRT
Expand Down Expand Up @@ -197,19 +193,13 @@ REAL FUNCTION CLANGE( NORM, M, N, A, LDA, WORK )
ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN
*
* Find normF(A).
* SSQ(1) is scale
* SSQ(2) is sum-of-squares
* For better accuracy, sum each column separately.
*
SSQ( 1 ) = ZERO
SSQ( 2 ) = ONE
SCALE = ZERO
SUM = ONE
DO 90 J = 1, N
COLSSQ( 1 ) = ZERO
COLSSQ( 2 ) = ONE
CALL CLASSQ( M, A( 1, J ), 1, COLSSQ( 1 ), COLSSQ( 2 ) )
CALL SCOMBSSQ( SSQ, COLSSQ )
CALL CLASSQ( M, A( 1, J ), 1, SCALE, SUM )
90 CONTINUE
VALUE = SSQ( 1 )*SQRT( SSQ( 2 ) )
VALUE = SCALE*SQRT( SUM )
END IF
*
CLANGE = VALUE
Expand Down
48 changes: 13 additions & 35 deletions SRC/clanhb.f
View file
Original file line number Diff line number Diff line change
Expand Up @@ -134,7 +134,6 @@ REAL FUNCTION CLANHB( NORM, UPLO, N, K, AB, LDAB,
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
*
IMPLICIT NONE
* .. Scalar Arguments ..
CHARACTER NORM, UPLO
INTEGER K, LDAB, N
Expand All @@ -152,17 +151,14 @@ REAL FUNCTION CLANHB( NORM, UPLO, N, K, AB, LDAB,
* ..
* .. Local Scalars ..
INTEGER I, J, L
REAL ABSA, SUM, VALUE
* ..
* .. Local Arrays ..
REAL SSQ( 2 ), COLSSQ( 2 )
REAL ABSA, SCALE, SUM, VALUE
* ..
* .. External Functions ..
LOGICAL LSAME, SISNAN
EXTERNAL LSAME, SISNAN
* ..
* .. External Subroutines ..
EXTERNAL CLASSQ, SCOMBSSQ
EXTERNAL CLASSQ
* ..
* .. Intrinsic Functions ..
INTRINSIC ABS, MAX, MIN, REAL, SQRT
Expand Down Expand Up @@ -234,57 +230,39 @@ REAL FUNCTION CLANHB( NORM, UPLO, N, K, AB, LDAB,
ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN
*
* Find normF(A).
* SSQ(1) is scale
* SSQ(2) is sum-of-squares
* For better accuracy, sum each column separately.
*
SSQ( 1 ) = ZERO
SSQ( 2 ) = ONE
*
* Sum off-diagonals
*
SCALE = ZERO
SUM = ONE
IF( K.GT.0 ) THEN
IF( LSAME( UPLO, 'U' ) ) THEN
DO 110 J = 2, N
COLSSQ( 1 ) = ZERO
COLSSQ( 2 ) = ONE
CALL CLASSQ( MIN( J-1, K ), AB( MAX( K+2-J, 1 ), J ),
$ 1, COLSSQ( 1 ), COLSSQ( 2 ) )
CALL SCOMBSSQ( SSQ, COLSSQ )
$ 1, SCALE, SUM )
110 CONTINUE
L = K + 1
ELSE
DO 120 J = 1, N - 1
COLSSQ( 1 ) = ZERO
COLSSQ( 2 ) = ONE
CALL CLASSQ( MIN( N-J, K ), AB( 2, J ), 1,
$ COLSSQ( 1 ), COLSSQ( 2 ) )
CALL SCOMBSSQ( SSQ, COLSSQ )
CALL CLASSQ( MIN( N-J, K ), AB( 2, J ), 1, SCALE,
$ SUM )
120 CONTINUE
L = 1
END IF
SSQ( 2 ) = 2*SSQ( 2 )
SUM = 2*SUM
ELSE
L = 1
END IF
*
* Sum diagonal
*
COLSSQ( 1 ) = ZERO
COLSSQ( 2 ) = ONE
DO 130 J = 1, N
IF( REAL( AB( L, J ) ).NE.ZERO ) THEN
ABSA = ABS( REAL( AB( L, J ) ) )
IF( COLSSQ( 1 ).LT.ABSA ) THEN
COLSSQ( 2 ) = ONE + COLSSQ(2)*( COLSSQ(1) / ABSA )**2
COLSSQ( 1 ) = ABSA
IF( SCALE.LT.ABSA ) THEN
SUM = ONE + SUM*( SCALE / ABSA )**2
SCALE = ABSA
ELSE
COLSSQ( 2 ) = COLSSQ( 2 ) + ( ABSA / COLSSQ( 1 ) )**2
SUM = SUM + ( ABSA / SCALE )**2
END IF
END IF
130 CONTINUE
CALL SCOMBSSQ( SSQ, COLSSQ )
VALUE = SSQ( 1 )*SQRT( SSQ( 2 ) )
VALUE = SCALE*SQRT( SUM )
END IF
*
CLANHB = VALUE
Expand Down
45 changes: 12 additions & 33 deletions SRC/clanhe.f
View file
Original file line number Diff line number Diff line change
Expand Up @@ -126,7 +126,6 @@ REAL FUNCTION CLANHE( NORM, UPLO, N, A, LDA, WORK )
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
*
IMPLICIT NONE
* .. Scalar Arguments ..
CHARACTER NORM, UPLO
INTEGER LDA, N
Expand All @@ -144,17 +143,14 @@ REAL FUNCTION CLANHE( NORM, UPLO, N, A, LDA, WORK )
* ..
* .. Local Scalars ..
INTEGER I, J
REAL ABSA, SUM, VALUE
* ..
* .. Local Arrays ..
REAL SSQ( 2 ), COLSSQ( 2 )
REAL ABSA, SCALE, SUM, VALUE
* ..
* .. External Functions ..
LOGICAL LSAME, SISNAN
EXTERNAL LSAME, SISNAN
* ..
* .. External Subroutines ..
EXTERNAL CLASSQ, SCOMBSSQ
EXTERNAL CLASSQ
* ..
* .. Intrinsic Functions ..
INTRINSIC ABS, REAL, SQRT
Expand Down Expand Up @@ -224,48 +220,31 @@ REAL FUNCTION CLANHE( NORM, UPLO, N, A, LDA, WORK )
ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN
*
* Find normF(A).
* SSQ(1) is scale
* SSQ(2) is sum-of-squares
* For better accuracy, sum each column separately.
*
SSQ( 1 ) = ZERO
SSQ( 2 ) = ONE
*
* Sum off-diagonals
*
SCALE = ZERO
SUM = ONE
IF( LSAME( UPLO, 'U' ) ) THEN
DO 110 J = 2, N
COLSSQ( 1 ) = ZERO
COLSSQ( 2 ) = ONE
CALL CLASSQ( J-1, A( 1, J ), 1,
$ COLSSQ( 1 ), COLSSQ( 2 ) )
CALL SCOMBSSQ( SSQ, COLSSQ )
CALL CLASSQ( J-1, A( 1, J ), 1, SCALE, SUM )
110 CONTINUE
ELSE
DO 120 J = 1, N - 1
COLSSQ( 1 ) = ZERO
COLSSQ( 2 ) = ONE
CALL CLASSQ( N-J, A( J+1, J ), 1,
$ COLSSQ( 1 ), COLSSQ( 2 ) )
CALL SCOMBSSQ( SSQ, COLSSQ )
CALL CLASSQ( N-J, A( J+1, J ), 1, SCALE, SUM )
120 CONTINUE
END IF
SSQ( 2 ) = 2*SSQ( 2 )
*
* Sum diagonal
*
SUM = 2*SUM
DO 130 I = 1, N
IF( REAL( A( I, I ) ).NE.ZERO ) THEN
ABSA = ABS( REAL( A( I, I ) ) )
IF( SSQ( 1 ).LT.ABSA ) THEN
SSQ( 2 ) = ONE + SSQ( 2 )*( SSQ( 1 ) / ABSA )**2
SSQ( 1 ) = ABSA
IF( SCALE.LT.ABSA ) THEN
SUM = ONE + SUM*( SCALE / ABSA )**2
SCALE = ABSA
ELSE
SSQ( 2 ) = SSQ( 2 ) + ( ABSA / SSQ( 1 ) )**2
SUM = SUM + ( ABSA / SCALE )**2
END IF
END IF
130 CONTINUE
VALUE = SSQ( 1 )*SQRT( SSQ( 2 ) )
VALUE = SCALE*SQRT( SUM )
END IF
*
CLANHE = VALUE
Expand Down
Loading

0 comments on commit 4ea5c1e

Please sign in to comment.