[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

@@ -137,6 +137,7 @@
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* December 2016
*
IMPLICIT NONE
* .. Scalar Arguments ..
CHARACTER NORM, UPLO
INTEGER K, LDAB, N
@@ -154,14 +155,17 @@
* ..
* .. Local Scalars ..
INTEGER I, J, L
DOUBLE PRECISION ABSA, SCALE, SUM, VALUE
DOUBLE PRECISION ABSA, SUM, VALUE
* ..
* .. Local Arrays ..
DOUBLE PRECISION SSQ( 2 ), COLSSQ( 2 )
* ..
* .. External Functions ..
LOGICAL LSAME, DISNAN
EXTERNAL LSAME, DISNAN
* ..
* .. External Subroutines ..
EXTERNAL ZLASSQ
EXTERNAL ZLASSQ, DCOMBSSQ
* ..
* .. Intrinsic Functions ..
INTRINSIC ABS, DBLE, MAX, MIN, SQRT
@@ -233,39 +237,57 @@
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 ZLASSQ( MIN( J-1, K ), AB( MAX( K+2-J, 1 ), J ),
$ 1, SCALE, SUM )
$ 1, COLSSQ( 1 ), COLSSQ( 2 ) )
CALL DCOMBSSQ( SSQ, COLSSQ )
110 CONTINUE
L = K + 1
ELSE
DO 120 J = 1, N - 1
CALL ZLASSQ( MIN( N-J, K ), AB( 2, J ), 1, SCALE,
$ SUM )
COLSSQ( 1 ) = ZERO
COLSSQ( 2 ) = ONE
CALL ZLASSQ( MIN( N-J, K ), AB( 2, J ), 1,
$ COLSSQ( 1 ), COLSSQ( 2 ) )
CALL DCOMBSSQ( SSQ, COLSSQ )
120 CONTINUE
L = 1
END IF
SUM = 2*SUM
SSQ( 2 ) = 2*SSQ( 2 )
ELSE
L = 1
END IF
*
* Sum diagonal
*
COLSSQ( 1 ) = ZERO
COLSSQ( 2 ) = ONE
DO 130 J = 1, N
IF( DBLE( AB( L, J ) ).NE.ZERO ) THEN
ABSA = ABS( DBLE( AB( L, J ) ) )
IF( SCALE.LT.ABSA ) THEN
SUM = ONE + SUM*( SCALE / ABSA )**2
SCALE = ABSA
IF( COLSSQ( 1 ).LT.ABSA ) THEN
COLSSQ( 2 ) = ONE + COLSSQ(2)*( COLSSQ(1) / ABSA )**2
COLSSQ( 1 ) = ABSA
ELSE
SUM = SUM + ( ABSA / SCALE )**2
COLSSQ( 2 ) = COLSSQ( 2 ) + ( ABSA / COLSSQ( 1 ) )**2
END IF
END IF
130 CONTINUE
VALUE = SCALE*SQRT( SUM )
CALL DCOMBSSQ( SSQ, COLSSQ )
VALUE = SSQ( 1 )*SQRT( SSQ( 2 ) )
END IF
*
ZLANHB = VALUE