ICODE-ADC/lammps
4
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

linalg: update to netlib lapack-3.7.1

Browse Source
This commit is contained in:
Christoph Junghans
2018-05-18 15:17:13 -06:00
parent 858c211fdc
commit 2e7b919774
171 changed files with 5320 additions and 4660 deletions
Download Patch File Download Diff File Expand all files Collapse all files

89
lib/linalg/dstedc.f
View File

@ -1,26 +1,26 @@
*> \brief \b DSTEBZ
*> \brief \b DSTEDC
*
* =========== DOCUMENTATION ===========
*
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
*> \htmlonly
*> Download DSTEDC + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dstedc.f">
*> [TGZ]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dstedc.f">
*> [ZIP]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dstedc.f">
*> Download DSTEDC + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dstedc.f">
*> [TGZ]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dstedc.f">
*> [ZIP]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dstedc.f">
*> [TXT]</a>
*> \endhtmlonly
*> \endhtmlonly
*
* Definition:
* ===========
*
* SUBROUTINE DSTEDC( COMPZ, N, D, E, Z, LDZ, WORK, LWORK, IWORK,
* LIWORK, INFO )
*
*
* .. Scalar Arguments ..
* CHARACTER COMPZ
* INTEGER INFO, LDZ, LIWORK, LWORK, N
@ -29,7 +29,7 @@
* INTEGER IWORK( * )
* DOUBLE PRECISION D( * ), E( * ), WORK( * ), Z( LDZ, * )
* ..
*
*
*
*> \par Purpose:
* =============
@ -105,8 +105,7 @@
*>
*> \param[out] WORK
*> \verbatim
*> WORK is DOUBLE PRECISION array,
*> dimension (LWORK)
*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
*> \endverbatim
*>
@ -169,12 +168,12 @@
* Authors:
* ========
*
*> \author Univ. of Tennessee
*> \author Univ. of California Berkeley
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*> \author Univ. of Tennessee
*> \author Univ. of California Berkeley
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date November 2011
*> \date June 2017
*
*> \ingroup auxOTHERcomputational
*
@ -189,10 +188,10 @@
SUBROUTINE DSTEDC( COMPZ, N, D, E, Z, LDZ, WORK, LWORK, IWORK,
$ LIWORK, INFO )
*
* -- LAPACK computational routine (version 3.4.0) --
* -- LAPACK computational routine (version 3.7.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* November 2011
* June 2017
*
* .. Scalar Arguments ..
CHARACTER COMPZ
@ -443,38 +442,32 @@
*
* endwhile
*
* If the problem split any number of times, then the eigenvalues
* will not be properly ordered. Here we permute the eigenvalues
* (and the associated eigenvectors) into ascending order.
IF( ICOMPZ.EQ.0 ) THEN
*
IF( M.NE.N ) THEN
IF( ICOMPZ.EQ.0 ) THEN
* Use Quick Sort
*
* Use Quick Sort
CALL DLASRT( 'I', N, D, INFO )
*
CALL DLASRT( 'I', N, D, INFO )
ELSE
*
ELSE
* Use Selection Sort to minimize swaps of eigenvectors
*
* Use Selection Sort to minimize swaps of eigenvectors
*
DO 40 II = 2, N
I = II - 1
K = I
P = D( I )
DO 30 J = II, N
IF( D( J ).LT.P ) THEN
K = J
P = D( J )
END IF
30 CONTINUE
IF( K.NE.I ) THEN
D( K ) = D( I )
D( I ) = P
CALL DSWAP( N, Z( 1, I ), 1, Z( 1, K ), 1 )
END IF
40 CONTINUE
END IF
DO 40 II = 2, N
I = II - 1
K = I
P = D( I )
DO 30 J = II, N
IF( D( J ).LT.P ) THEN
K = J
P = D( J )
END IF
30 CONTINUE
IF( K.NE.I ) THEN
D( K ) = D( I )
D( I ) = P
CALL DSWAP( N, Z( 1, I ), 1, Z( 1, K ), 1 )
END IF
40 CONTINUE
END IF
END IF
*