[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:
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user