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

55
lapack-netlib/SRC/dlantp.f
View File

@@ -129,6 +129,7 @@
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* December 2016
*
IMPLICIT NONE
* .. Scalar Arguments ..
CHARACTER DIAG, NORM, UPLO
INTEGER N
@@ -146,15 +147,18 @@
* .. Local Scalars ..
LOGICAL UDIAG
INTEGER I, J, K
DOUBLE PRECISION SCALE, SUM, VALUE
DOUBLE PRECISION SUM, VALUE
* ..
* .. External Subroutines ..
EXTERNAL DLASSQ
* .. Local Arrays ..
DOUBLE PRECISION SSQ( 2 ), COLSSQ( 2 )
* ..
* .. External Functions ..
LOGICAL LSAME, DISNAN
EXTERNAL LSAME, DISNAN
* ..
* .. External Subroutines ..
EXTERNAL DLASSQ, DCOMBSSQ
* ..
* .. Intrinsic Functions ..
INTRINSIC ABS, SQRT
* ..
@@ -306,45 +310,64 @@
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 = N
SSQ( 1 ) = ONE
SSQ( 2 ) = N
K = 2
DO 280 J = 2, N
CALL DLASSQ( J-1, AP( K ), 1, SCALE, SUM )
COLSSQ( 1 ) = ZERO
COLSSQ( 2 ) = ONE
CALL DLASSQ( J-1, AP( K ), 1,
$ COLSSQ( 1 ), COLSSQ( 2 ) )
CALL DCOMBSSQ( SSQ, COLSSQ )
K = K + J
280 CONTINUE
ELSE
SCALE = ZERO
SUM = ONE
SSQ( 1 ) = ZERO
SSQ( 2 ) = ONE
K = 1
DO 290 J = 1, N
CALL DLASSQ( J, AP( K ), 1, SCALE, SUM )
COLSSQ( 1 ) = ZERO
COLSSQ( 2 ) = ONE
CALL DLASSQ( J, AP( K ), 1,
$ COLSSQ( 1 ), COLSSQ( 2 ) )
CALL DCOMBSSQ( SSQ, COLSSQ )
K = K + J
290 CONTINUE
END IF
ELSE
IF( LSAME( DIAG, 'U' ) ) THEN
SCALE = ONE
SUM = N
SSQ( 1 ) = ONE
SSQ( 2 ) = N
K = 2
DO 300 J = 1, N - 1
CALL DLASSQ( N-J, AP( K ), 1, SCALE, SUM )
COLSSQ( 1 ) = ZERO
COLSSQ( 2 ) = ONE
CALL DLASSQ( N-J, AP( K ), 1,
$ COLSSQ( 1 ), COLSSQ( 2 ) )
CALL DCOMBSSQ( SSQ, COLSSQ )
K = K + N - J + 1
300 CONTINUE
ELSE
SCALE = ZERO
SUM = ONE
SSQ( 1 ) = ZERO
SSQ( 2 ) = ONE
K = 1
DO 310 J = 1, N
CALL DLASSQ( N-J+1, AP( K ), 1, SCALE, SUM )
COLSSQ( 1 ) = ZERO
COLSSQ( 2 ) = ONE
CALL DLASSQ( N-J+1, AP( K ), 1,
$ COLSSQ( 1 ), COLSSQ( 2 ) )
CALL DCOMBSSQ( SSQ, COLSSQ )
K = K + N - J + 1
310 CONTINUE
END IF
END IF
VALUE = SCALE*SQRT( SUM )
VALUE = SSQ( 1 )*SQRT( SSQ( 2 ) )
END IF
*
DLANTP = VALUE