phynexis-deps/lapack
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity
Files
4e59cd70e92b16eb34466057263f5b8a0b8f5843
lapack/SRC/dstevd.f
T
Hans Johnson 9dafba6d41 STYLE: Remove trailing whitespace in Fortran files 
This is mostly a long term maintenance improvement.

Many coding styles require elimination of trailing whitespace, and
many editors and source code management configurations automatically
gobble up whitespace. When these tools gobble up whitespace, it
complicates reviewing the meaningful code changes.

By removing whitespace on one patch, it makes future
code reviews much easier.

=SCRIPT====================================================================

if which tempfile &>/dev/null; then
  TEMPMAKER=tempfile
elif which mktemp &>/dev/null; then
  TEMPMAKER=mktemp
else
  echo "Cannot find tempfile program." 2>&1
  exit 1
fi

MYTEMP=$($TEMPMAKER)
trap 'rm -f $MYTEMP' SIGINT SIGTERM

stripit() {
  echo "stripping $1"
  sed 's/[ \t]*$//' "$1" > $MYTEMP
  cp $MYTEMP "$1"
}

if [ $# -gt 0 ]; then
  while [ "$1" != "" ]; do
    stripit $1
    shift
  done
else
  while read -t 2; do
    stripit $REPLY
  done
fi

rm $MYTEMP
=================================================
2016-07-09 11:19:34 -05:00

303 lines
8.9 KiB
FortranFixed
Raw Blame History

*> \brief <b> DSTEVD computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrices</b>
*
* =========== DOCUMENTATION ===========
*
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
*> \htmlonly
*> Download DSTEVD + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dstevd.f">
*> [TGZ]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dstevd.f">
*> [ZIP]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dstevd.f">
*> [TXT]</a>
*> \endhtmlonly
*
* Definition:
* ===========
*
* SUBROUTINE DSTEVD( JOBZ, N, D, E, Z, LDZ, WORK, LWORK, IWORK,
* LIWORK, INFO )
*
* .. Scalar Arguments ..
* CHARACTER JOBZ
* INTEGER INFO, LDZ, LIWORK, LWORK, N
* ..
* .. Array Arguments ..
* INTEGER IWORK( * )
* DOUBLE PRECISION D( * ), E( * ), WORK( * ), Z( LDZ, * )
* ..
*
*
*> \par Purpose:
* =============
*>
*> \verbatim
*>
*> DSTEVD computes all eigenvalues and, optionally, eigenvectors of a
*> real symmetric tridiagonal matrix. If eigenvectors are desired, it
*> uses a divide and conquer algorithm.
*>
*> The divide and conquer algorithm makes very mild assumptions about
*> floating point arithmetic. It will work on machines with a guard
*> digit in add/subtract, or on those binary machines without guard
*> digits which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or
*> Cray-2. It could conceivably fail on hexadecimal or decimal machines
*> without guard digits, but we know of none.
*> \endverbatim
*
* Arguments:
* ==========
*
*> \param[in] JOBZ
*> \verbatim
*> JOBZ is CHARACTER*1
*> = 'N': Compute eigenvalues only;
*> = 'V': Compute eigenvalues and eigenvectors.
*> \endverbatim
*>
*> \param[in] N
*> \verbatim
*> N is INTEGER
*> The order of the matrix. N >= 0.
*> \endverbatim
*>
*> \param[in,out] D
*> \verbatim
*> D is DOUBLE PRECISION array, dimension (N)
*> On entry, the n diagonal elements of the tridiagonal matrix
*> A.
*> On exit, if INFO = 0, the eigenvalues in ascending order.
*> \endverbatim
*>
*> \param[in,out] E
*> \verbatim
*> E is DOUBLE PRECISION array, dimension (N-1)
*> On entry, the (n-1) subdiagonal elements of the tridiagonal
*> matrix A, stored in elements 1 to N-1 of E.
*> On exit, the contents of E are destroyed.
*> \endverbatim
*>
*> \param[out] Z
*> \verbatim
*> Z is DOUBLE PRECISION array, dimension (LDZ, N)
*> If JOBZ = 'V', then if INFO = 0, Z contains the orthonormal
*> eigenvectors of the matrix A, with the i-th column of Z
*> holding the eigenvector associated with D(i).
*> If JOBZ = 'N', then Z is not referenced.
*> \endverbatim
*>
*> \param[in] LDZ
*> \verbatim
*> LDZ is INTEGER
*> The leading dimension of the array Z. LDZ >= 1, and if
*> JOBZ = 'V', LDZ >= max(1,N).
*> \endverbatim
*>
*> \param[out] WORK
*> \verbatim
*> WORK is DOUBLE PRECISION array,
*> dimension (LWORK)
*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
*> \endverbatim
*>
*> \param[in] LWORK
*> \verbatim
*> LWORK is INTEGER
*> The dimension of the array WORK.
*> If JOBZ = 'N' or N <= 1 then LWORK must be at least 1.
*> If JOBZ = 'V' and N > 1 then LWORK must be at least
*> ( 1 + 4*N + N**2 ).
*>
*> If LWORK = -1, then a workspace query is assumed; the routine
*> only calculates the optimal sizes of the WORK and IWORK
*> arrays, returns these values as the first entries of the WORK
*> and IWORK arrays, and no error message related to LWORK or
*> LIWORK is issued by XERBLA.
*> \endverbatim
*>
*> \param[out] IWORK
*> \verbatim
*> IWORK is INTEGER array, dimension (MAX(1,LIWORK))
*> On exit, if INFO = 0, IWORK(1) returns the optimal LIWORK.
*> \endverbatim
*>
*> \param[in] LIWORK
*> \verbatim
*> LIWORK is INTEGER
*> The dimension of the array IWORK.
*> If JOBZ = 'N' or N <= 1 then LIWORK must be at least 1.
*> If JOBZ = 'V' and N > 1 then LIWORK must be at least 3+5*N.
*>
*> If LIWORK = -1, then a workspace query is assumed; the
*> routine only calculates the optimal sizes of the WORK and
*> IWORK arrays, returns these values as the first entries of
*> the WORK and IWORK arrays, and no error message related to
*> LWORK or LIWORK is issued by XERBLA.
*> \endverbatim
*>
*> \param[out] INFO
*> \verbatim
*> INFO is INTEGER
*> = 0: successful exit
*> < 0: if INFO = -i, the i-th argument had an illegal value
*> > 0: if INFO = i, the algorithm failed to converge; i
*> off-diagonal elements of E did not converge to zero.
*> \endverbatim
*
* Authors:
* ========
*
*> \author Univ. of Tennessee
*> \author Univ. of California Berkeley
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date November 2011
*
*> \ingroup doubleOTHEReigen
*
* =====================================================================
SUBROUTINE DSTEVD( JOBZ, N, D, E, Z, LDZ, WORK, LWORK, IWORK,
$ LIWORK, INFO )
*
* -- LAPACK driver routine (version 3.4.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* November 2011
*
* .. Scalar Arguments ..
CHARACTER JOBZ
INTEGER INFO, LDZ, LIWORK, LWORK, N
* ..
* .. Array Arguments ..
INTEGER IWORK( * )
DOUBLE PRECISION D( * ), E( * ), WORK( * ), Z( LDZ, * )
* ..
*
* =====================================================================
*
* .. Parameters ..
DOUBLE PRECISION ZERO, ONE
PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 )
* ..
* .. Local Scalars ..
LOGICAL LQUERY, WANTZ
INTEGER ISCALE, LIWMIN, LWMIN
DOUBLE PRECISION BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA, SMLNUM,
$ TNRM
* ..
* .. External Functions ..
LOGICAL LSAME
DOUBLE PRECISION DLAMCH, DLANST
EXTERNAL LSAME, DLAMCH, DLANST
* ..
* .. External Subroutines ..
EXTERNAL DSCAL, DSTEDC, DSTERF, XERBLA
* ..
* .. Intrinsic Functions ..
INTRINSIC SQRT
* ..
* .. Executable Statements ..
*
* Test the input parameters.
*
WANTZ = LSAME( JOBZ, 'V' )
LQUERY = ( LWORK.EQ.-1 .OR. LIWORK.EQ.-1 )
*
INFO = 0
LIWMIN = 1
LWMIN = 1
IF( N.GT.1 .AND. WANTZ ) THEN
LWMIN = 1 + 4*N + N**2
LIWMIN = 3 + 5*N
END IF
*
IF( .NOT.( WANTZ .OR. LSAME( JOBZ, 'N' ) ) ) THEN
INFO = -1
ELSE IF( N.LT.0 ) THEN
INFO = -2
ELSE IF( LDZ.LT.1 .OR. ( WANTZ .AND. LDZ.LT.N ) ) THEN
INFO = -6
END IF
*
IF( INFO.EQ.0 ) THEN
WORK( 1 ) = LWMIN
IWORK( 1 ) = LIWMIN
*
IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN
INFO = -8
ELSE IF( LIWORK.LT.LIWMIN .AND. .NOT.LQUERY ) THEN
INFO = -10
END IF
END IF
*
IF( INFO.NE.0 ) THEN
CALL XERBLA( 'DSTEVD', -INFO )
RETURN
ELSE IF( LQUERY ) THEN
RETURN
END IF
*
* Quick return if possible
*
IF( N.EQ.0 )
$ RETURN
*
IF( N.EQ.1 ) THEN
IF( WANTZ )
$ Z( 1, 1 ) = ONE
RETURN
END IF
*
* Get machine constants.
*
SAFMIN = DLAMCH( 'Safe minimum' )
EPS = DLAMCH( 'Precision' )
SMLNUM = SAFMIN / EPS
BIGNUM = ONE / SMLNUM
RMIN = SQRT( SMLNUM )
RMAX = SQRT( BIGNUM )
*
* Scale matrix to allowable range, if necessary.
*
ISCALE = 0
TNRM = DLANST( 'M', N, D, E )
IF( TNRM.GT.ZERO .AND. TNRM.LT.RMIN ) THEN
ISCALE = 1
SIGMA = RMIN / TNRM
ELSE IF( TNRM.GT.RMAX ) THEN
ISCALE = 1
SIGMA = RMAX / TNRM
END IF
IF( ISCALE.EQ.1 ) THEN
CALL DSCAL( N, SIGMA, D, 1 )
CALL DSCAL( N-1, SIGMA, E( 1 ), 1 )
END IF
*
* For eigenvalues only, call DSTERF. For eigenvalues and
* eigenvectors, call DSTEDC.
*
IF( .NOT.WANTZ ) THEN
CALL DSTERF( N, D, E, INFO )
ELSE
CALL DSTEDC( 'I', N, D, E, Z, LDZ, WORK, LWORK, IWORK, LIWORK,
$ INFO )
END IF
*
* If matrix was scaled, then rescale eigenvalues appropriately.
*
IF( ISCALE.EQ.1 )
$ CALL DSCAL( N, ONE / SIGMA, D, 1 )
*
WORK( 1 ) = LWMIN
IWORK( 1 ) = LIWMIN
*
RETURN
*
* End of DSTEVD
*
END
Reference in New Issue View Git Blame Copy Permalink