floraachy/OpenBLAS
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

[WIP] Update LAPACK to 3.9.0 (#2353)

Browse Source 
* Update make.inc entries for LAPACK 3.9.0

Reference-LAPACK PR 347 changed some variable names and relative paths

* Update LAPACK to 3.9.0

* Add new functions from LAPACK 3.9.0

* Add new functions from LAPACK 3.9.0

* Restore LOADER command 

as it makes it easier to specify pthread as needed

* Restore LOADER

* Restore EIG/LIN prefixes in cmdbase

* add binary path to lapack_testing.py call

* Restore OpenMP version check

* Restore OpenMP version check

* Restore fix for out-of-bounds array accesses

from #2096
This commit is contained in:
Martin Kroeker
2020-01-01 13:18:53 +01:00
committed by GitHub
parent 6c85cb1869
commit 375b1875c8
812 changed files with 36421 additions and 12050 deletions
Download Patch File Download Diff File Expand all files Collapse all files

58
lapack-netlib/SRC/slantr.f
View File

@@ -146,6 +146,7 @@
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* December 2016
*
IMPLICIT NONE
* .. Scalar Arguments ..
CHARACTER DIAG, NORM, UPLO
INTEGER LDA, M, N
@@ -163,15 +164,18 @@
* .. Local Scalars ..
LOGICAL UDIAG
INTEGER I, J
REAL SCALE, SUM, VALUE
REAL SUM, VALUE
* ..
* .. External Subroutines ..
EXTERNAL SLASSQ
* .. Local Arrays ..
REAL SSQ( 2 ), COLSSQ( 2 )
* ..
* .. External Functions ..
LOGICAL LSAME, SISNAN
EXTERNAL LSAME, SISNAN
* ..
* .. External Subroutines ..
EXTERNAL SLASSQ, SCOMBSSQ
* ..
* .. Intrinsic Functions ..
INTRINSIC ABS, MIN, SQRT
* ..
@@ -281,7 +285,7 @@
END IF
ELSE
IF( LSAME( DIAG, 'U' ) ) THEN
DO 210 I = 1, N
DO 210 I = 1, MIN( M, N )
WORK( I ) = ONE
210 CONTINUE
DO 220 I = N + 1, M
@@ -311,38 +315,56 @@
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.
*
IF( LSAME( UPLO, 'U' ) ) THEN
IF( LSAME( DIAG, 'U' ) ) THEN
SCALE = ONE
SUM = MIN( M, N )
SSQ( 1 ) = ONE
SSQ( 2 ) = MIN( M, N )
DO 290 J = 2, N
CALL SLASSQ( MIN( M, J-1 ), A( 1, J ), 1, SCALE, SUM )
COLSSQ( 1 ) = ZERO
COLSSQ( 2 ) = ONE
CALL SLASSQ( MIN( M, J-1 ), A( 1, J ), 1,
$ COLSSQ( 1 ), COLSSQ( 2 ) )
CALL SCOMBSSQ( SSQ, COLSSQ )
290 CONTINUE
ELSE
SCALE = ZERO
SUM = ONE
SSQ( 1 ) = ZERO
SSQ( 2 ) = ONE
DO 300 J = 1, N
CALL SLASSQ( MIN( M, J ), A( 1, J ), 1, SCALE, SUM )
COLSSQ( 1 ) = ZERO
COLSSQ( 2 ) = ONE
CALL SLASSQ( MIN( M, J ), A( 1, J ), 1,
$ COLSSQ( 1 ), COLSSQ( 2 ) )
CALL SCOMBSSQ( SSQ, COLSSQ )
300 CONTINUE
END IF
ELSE
IF( LSAME( DIAG, 'U' ) ) THEN
SCALE = ONE
SUM = MIN( M, N )
SSQ( 1 ) = ONE
SSQ( 2 ) = MIN( M, N )
DO 310 J = 1, N
CALL SLASSQ( M-J, A( MIN( M, J+1 ), J ), 1, SCALE,
$ SUM )
COLSSQ( 1 ) = ZERO
COLSSQ( 2 ) = ONE
CALL SLASSQ( M-J, A( MIN( M, J+1 ), J ), 1,
$ COLSSQ( 1 ), COLSSQ( 2 ) )
CALL SCOMBSSQ( SSQ, COLSSQ )
310 CONTINUE
ELSE
SCALE = ZERO
SUM = ONE
SSQ( 1 ) = ZERO
SSQ( 2 ) = ONE
DO 320 J = 1, N
CALL SLASSQ( M-J+1, A( J, J ), 1, SCALE, SUM )
COLSSQ( 1 ) = ZERO
COLSSQ( 2 ) = ONE
CALL SLASSQ( M-J+1, A( J, J ), 1,
$ COLSSQ( 1 ), COLSSQ( 2 ) )
CALL SCOMBSSQ( SSQ, COLSSQ )
320 CONTINUE
END IF
END IF
VALUE = SCALE*SQRT( SUM )
VALUE = SSQ( 1 )*SQRT( SSQ( 2 ) )
END IF
*
SLANTR = VALUE