[WIP] Update LAPACK to 3.9.0 (#2353)

* 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

View File

@@ -127,6 +127,7 @@
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* December 2016
*
IMPLICIT NONE
* .. Scalar Arguments ..
CHARACTER NORM, UPLO
INTEGER LDA, N
@@ -143,15 +144,18 @@
* ..
* .. Local Scalars ..
INTEGER I, J
REAL ABSA, SCALE, SUM, VALUE
REAL ABSA, 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, SQRT
* ..
@@ -216,21 +220,39 @@
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
CALL SLASSQ( J-1, A( 1, J ), 1, SCALE, SUM )
COLSSQ( 1 ) = ZERO
COLSSQ( 2 ) = ONE
CALL SLASSQ( J-1, A( 1, J ), 1, COLSSQ(1), COLSSQ(2) )
CALL SCOMBSSQ( SSQ, COLSSQ )
110 CONTINUE
ELSE
DO 120 J = 1, N - 1
CALL SLASSQ( N-J, A( J+1, J ), 1, SCALE, SUM )
COLSSQ( 1 ) = ZERO
COLSSQ( 2 ) = ONE
CALL SLASSQ( N-J, A( J+1, J ), 1, COLSSQ(1), COLSSQ(2) )
CALL SCOMBSSQ( SSQ, COLSSQ )
120 CONTINUE
END IF
SUM = 2*SUM
CALL SLASSQ( N, A, LDA+1, SCALE, SUM )
VALUE = SCALE*SQRT( SUM )
SSQ( 2 ) = 2*SSQ( 2 )
*
* Sum diagonal
*
COLSSQ( 1 ) = ZERO
COLSSQ( 2 ) = ONE
CALL SLASSQ( N, A, LDA+1, COLSSQ( 1 ), COLSSQ( 2 ) )
CALL SCOMBSSQ( SSQ, COLSSQ )
VALUE = SSQ( 1 )*SQRT( SSQ( 2 ) )
END IF
*
SLANSY = VALUE