Annotation of rpl/lapack/lapack/dsyevd.f, revision 1.18

1.8       bertrand    1: *> \brief <b> DSYEVD computes the eigenvalues and, optionally, the left and/or right eigenvectors for SY matrices</b>
                      2: *
                      3: *  =========== DOCUMENTATION ===========
                      4: *
1.15      bertrand    5: * Online html documentation available at
                      6: *            http://www.netlib.org/lapack/explore-html/
1.8       bertrand    7: *
                      8: *> \htmlonly
1.15      bertrand    9: *> Download DSYEVD + dependencies
                     10: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dsyevd.f">
                     11: *> [TGZ]</a>
                     12: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dsyevd.f">
                     13: *> [ZIP]</a>
                     14: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dsyevd.f">
1.8       bertrand   15: *> [TXT]</a>
1.15      bertrand   16: *> \endhtmlonly
1.8       bertrand   17: *
                     18: *  Definition:
                     19: *  ===========
                     20: *
                     21: *       SUBROUTINE DSYEVD( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, IWORK,
                     22: *                          LIWORK, INFO )
1.15      bertrand   23: *
1.8       bertrand   24: *       .. Scalar Arguments ..
                     25: *       CHARACTER          JOBZ, UPLO
                     26: *       INTEGER            INFO, LDA, LIWORK, LWORK, N
                     27: *       ..
                     28: *       .. Array Arguments ..
                     29: *       INTEGER            IWORK( * )
                     30: *       DOUBLE PRECISION   A( LDA, * ), W( * ), WORK( * )
                     31: *       ..
1.15      bertrand   32: *
1.8       bertrand   33: *
                     34: *> \par Purpose:
                     35: *  =============
                     36: *>
                     37: *> \verbatim
                     38: *>
                     39: *> DSYEVD computes all eigenvalues and, optionally, eigenvectors of a
                     40: *> real symmetric matrix A. If eigenvectors are desired, it uses a
                     41: *> divide and conquer algorithm.
                     42: *>
                     43: *> The divide and conquer algorithm makes very mild assumptions about
                     44: *> floating point arithmetic. It will work on machines with a guard
                     45: *> digit in add/subtract, or on those binary machines without guard
                     46: *> digits which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or
                     47: *> Cray-2. It could conceivably fail on hexadecimal or decimal machines
                     48: *> without guard digits, but we know of none.
                     49: *>
                     50: *> Because of large use of BLAS of level 3, DSYEVD needs N**2 more
                     51: *> workspace than DSYEVX.
                     52: *> \endverbatim
                     53: *
                     54: *  Arguments:
                     55: *  ==========
                     56: *
                     57: *> \param[in] JOBZ
                     58: *> \verbatim
                     59: *>          JOBZ is CHARACTER*1
                     60: *>          = 'N':  Compute eigenvalues only;
                     61: *>          = 'V':  Compute eigenvalues and eigenvectors.
                     62: *> \endverbatim
                     63: *>
                     64: *> \param[in] UPLO
                     65: *> \verbatim
                     66: *>          UPLO is CHARACTER*1
                     67: *>          = 'U':  Upper triangle of A is stored;
                     68: *>          = 'L':  Lower triangle of A is stored.
                     69: *> \endverbatim
                     70: *>
                     71: *> \param[in] N
                     72: *> \verbatim
                     73: *>          N is INTEGER
                     74: *>          The order of the matrix A.  N >= 0.
                     75: *> \endverbatim
                     76: *>
                     77: *> \param[in,out] A
                     78: *> \verbatim
                     79: *>          A is DOUBLE PRECISION array, dimension (LDA, N)
                     80: *>          On entry, the symmetric matrix A.  If UPLO = 'U', the
                     81: *>          leading N-by-N upper triangular part of A contains the
                     82: *>          upper triangular part of the matrix A.  If UPLO = 'L',
                     83: *>          the leading N-by-N lower triangular part of A contains
                     84: *>          the lower triangular part of the matrix A.
                     85: *>          On exit, if JOBZ = 'V', then if INFO = 0, A contains the
                     86: *>          orthonormal eigenvectors of the matrix A.
                     87: *>          If JOBZ = 'N', then on exit the lower triangle (if UPLO='L')
                     88: *>          or the upper triangle (if UPLO='U') of A, including the
                     89: *>          diagonal, is destroyed.
                     90: *> \endverbatim
                     91: *>
                     92: *> \param[in] LDA
                     93: *> \verbatim
                     94: *>          LDA is INTEGER
                     95: *>          The leading dimension of the array A.  LDA >= max(1,N).
                     96: *> \endverbatim
                     97: *>
                     98: *> \param[out] W
                     99: *> \verbatim
                    100: *>          W is DOUBLE PRECISION array, dimension (N)
                    101: *>          If INFO = 0, the eigenvalues in ascending order.
                    102: *> \endverbatim
                    103: *>
                    104: *> \param[out] WORK
                    105: *> \verbatim
                    106: *>          WORK is DOUBLE PRECISION array,
                    107: *>                                         dimension (LWORK)
                    108: *>          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
                    109: *> \endverbatim
                    110: *>
                    111: *> \param[in] LWORK
                    112: *> \verbatim
                    113: *>          LWORK is INTEGER
                    114: *>          The dimension of the array WORK.
                    115: *>          If N <= 1,               LWORK must be at least 1.
                    116: *>          If JOBZ = 'N' and N > 1, LWORK must be at least 2*N+1.
                    117: *>          If JOBZ = 'V' and N > 1, LWORK must be at least
                    118: *>                                                1 + 6*N + 2*N**2.
                    119: *>
                    120: *>          If LWORK = -1, then a workspace query is assumed; the routine
                    121: *>          only calculates the optimal sizes of the WORK and IWORK
                    122: *>          arrays, returns these values as the first entries of the WORK
                    123: *>          and IWORK arrays, and no error message related to LWORK or
                    124: *>          LIWORK is issued by XERBLA.
                    125: *> \endverbatim
                    126: *>
                    127: *> \param[out] IWORK
                    128: *> \verbatim
                    129: *>          IWORK is INTEGER array, dimension (MAX(1,LIWORK))
                    130: *>          On exit, if INFO = 0, IWORK(1) returns the optimal LIWORK.
                    131: *> \endverbatim
                    132: *>
                    133: *> \param[in] LIWORK
                    134: *> \verbatim
                    135: *>          LIWORK is INTEGER
                    136: *>          The dimension of the array IWORK.
                    137: *>          If N <= 1,                LIWORK must be at least 1.
                    138: *>          If JOBZ  = 'N' and N > 1, LIWORK must be at least 1.
                    139: *>          If JOBZ  = 'V' and N > 1, LIWORK must be at least 3 + 5*N.
                    140: *>
                    141: *>          If LIWORK = -1, then a workspace query is assumed; the
                    142: *>          routine only calculates the optimal sizes of the WORK and
                    143: *>          IWORK arrays, returns these values as the first entries of
                    144: *>          the WORK and IWORK arrays, and no error message related to
                    145: *>          LWORK or LIWORK is issued by XERBLA.
                    146: *> \endverbatim
                    147: *>
                    148: *> \param[out] INFO
                    149: *> \verbatim
                    150: *>          INFO is INTEGER
                    151: *>          = 0:  successful exit
                    152: *>          < 0:  if INFO = -i, the i-th argument had an illegal value
                    153: *>          > 0:  if INFO = i and JOBZ = 'N', then the algorithm failed
                    154: *>                to converge; i off-diagonal elements of an intermediate
                    155: *>                tridiagonal form did not converge to zero;
                    156: *>                if INFO = i and JOBZ = 'V', then the algorithm failed
                    157: *>                to compute an eigenvalue while working on the submatrix
                    158: *>                lying in rows and columns INFO/(N+1) through
                    159: *>                mod(INFO,N+1).
                    160: *> \endverbatim
                    161: *
                    162: *  Authors:
                    163: *  ========
                    164: *
1.15      bertrand  165: *> \author Univ. of Tennessee
                    166: *> \author Univ. of California Berkeley
                    167: *> \author Univ. of Colorado Denver
                    168: *> \author NAG Ltd.
1.8       bertrand  169: *
                    170: *> \ingroup doubleSYeigen
                    171: *
                    172: *> \par Contributors:
                    173: *  ==================
                    174: *>
                    175: *> Jeff Rutter, Computer Science Division, University of California
                    176: *> at Berkeley, USA \n
                    177: *>  Modified by Francoise Tisseur, University of Tennessee \n
                    178: *>  Modified description of INFO. Sven, 16 Feb 05. \n
                    179: 
                    180: 
                    181: *>
                    182: *  =====================================================================
1.1       bertrand  183:       SUBROUTINE DSYEVD( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, IWORK,
                    184:      $                   LIWORK, INFO )
                    185: *
1.18    ! bertrand  186: *  -- LAPACK driver routine --
1.1       bertrand  187: *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
                    188: *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
                    189: *
                    190: *     .. Scalar Arguments ..
                    191:       CHARACTER          JOBZ, UPLO
                    192:       INTEGER            INFO, LDA, LIWORK, LWORK, N
                    193: *     ..
                    194: *     .. Array Arguments ..
                    195:       INTEGER            IWORK( * )
                    196:       DOUBLE PRECISION   A( LDA, * ), W( * ), WORK( * )
                    197: *     ..
                    198: *
                    199: *  =====================================================================
                    200: *
                    201: *     .. Parameters ..
                    202:       DOUBLE PRECISION   ZERO, ONE
                    203:       PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0 )
                    204: *     ..
                    205: *     .. Local Scalars ..
                    206: *
                    207:       LOGICAL            LOWER, LQUERY, WANTZ
                    208:       INTEGER            IINFO, INDE, INDTAU, INDWK2, INDWRK, ISCALE,
                    209:      $                   LIOPT, LIWMIN, LLWORK, LLWRK2, LOPT, LWMIN
                    210:       DOUBLE PRECISION   ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA,
                    211:      $                   SMLNUM
                    212: *     ..
                    213: *     .. External Functions ..
                    214:       LOGICAL            LSAME
                    215:       INTEGER            ILAENV
                    216:       DOUBLE PRECISION   DLAMCH, DLANSY
                    217:       EXTERNAL           LSAME, DLAMCH, DLANSY, ILAENV
                    218: *     ..
                    219: *     .. External Subroutines ..
                    220:       EXTERNAL           DLACPY, DLASCL, DORMTR, DSCAL, DSTEDC, DSTERF,
                    221:      $                   DSYTRD, XERBLA
                    222: *     ..
                    223: *     .. Intrinsic Functions ..
                    224:       INTRINSIC          MAX, SQRT
                    225: *     ..
                    226: *     .. Executable Statements ..
                    227: *
                    228: *     Test the input parameters.
                    229: *
                    230:       WANTZ = LSAME( JOBZ, 'V' )
                    231:       LOWER = LSAME( UPLO, 'L' )
                    232:       LQUERY = ( LWORK.EQ.-1 .OR. LIWORK.EQ.-1 )
                    233: *
                    234:       INFO = 0
                    235:       IF( .NOT.( WANTZ .OR. LSAME( JOBZ, 'N' ) ) ) THEN
                    236:          INFO = -1
                    237:       ELSE IF( .NOT.( LOWER .OR. LSAME( UPLO, 'U' ) ) ) THEN
                    238:          INFO = -2
                    239:       ELSE IF( N.LT.0 ) THEN
                    240:          INFO = -3
                    241:       ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
                    242:          INFO = -5
                    243:       END IF
                    244: *
                    245:       IF( INFO.EQ.0 ) THEN
                    246:          IF( N.LE.1 ) THEN
                    247:             LIWMIN = 1
                    248:             LWMIN = 1
                    249:             LOPT = LWMIN
                    250:             LIOPT = LIWMIN
                    251:          ELSE
                    252:             IF( WANTZ ) THEN
                    253:                LIWMIN = 3 + 5*N
                    254:                LWMIN = 1 + 6*N + 2*N**2
                    255:             ELSE
                    256:                LIWMIN = 1
                    257:                LWMIN = 2*N + 1
                    258:             END IF
                    259:             LOPT = MAX( LWMIN, 2*N +
1.18    ! bertrand  260:      $                  N*ILAENV( 1, 'DSYTRD', UPLO, N, -1, -1, -1 ) )
1.1       bertrand  261:             LIOPT = LIWMIN
                    262:          END IF
                    263:          WORK( 1 ) = LOPT
                    264:          IWORK( 1 ) = LIOPT
                    265: *
                    266:          IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN
                    267:             INFO = -8
                    268:          ELSE IF( LIWORK.LT.LIWMIN .AND. .NOT.LQUERY ) THEN
                    269:             INFO = -10
                    270:          END IF
                    271:       END IF
                    272: *
                    273:       IF( INFO.NE.0 ) THEN
                    274:          CALL XERBLA( 'DSYEVD', -INFO )
                    275:          RETURN
                    276:       ELSE IF( LQUERY ) THEN
                    277:          RETURN
                    278:       END IF
                    279: *
                    280: *     Quick return if possible
                    281: *
                    282:       IF( N.EQ.0 )
                    283:      $   RETURN
                    284: *
                    285:       IF( N.EQ.1 ) THEN
                    286:          W( 1 ) = A( 1, 1 )
                    287:          IF( WANTZ )
                    288:      $      A( 1, 1 ) = ONE
                    289:          RETURN
                    290:       END IF
                    291: *
                    292: *     Get machine constants.
                    293: *
                    294:       SAFMIN = DLAMCH( 'Safe minimum' )
                    295:       EPS = DLAMCH( 'Precision' )
                    296:       SMLNUM = SAFMIN / EPS
                    297:       BIGNUM = ONE / SMLNUM
                    298:       RMIN = SQRT( SMLNUM )
                    299:       RMAX = SQRT( BIGNUM )
                    300: *
                    301: *     Scale matrix to allowable range, if necessary.
                    302: *
                    303:       ANRM = DLANSY( 'M', UPLO, N, A, LDA, WORK )
                    304:       ISCALE = 0
                    305:       IF( ANRM.GT.ZERO .AND. ANRM.LT.RMIN ) THEN
                    306:          ISCALE = 1
                    307:          SIGMA = RMIN / ANRM
                    308:       ELSE IF( ANRM.GT.RMAX ) THEN
                    309:          ISCALE = 1
                    310:          SIGMA = RMAX / ANRM
                    311:       END IF
                    312:       IF( ISCALE.EQ.1 )
                    313:      $   CALL DLASCL( UPLO, 0, 0, ONE, SIGMA, N, N, A, LDA, INFO )
                    314: *
                    315: *     Call DSYTRD to reduce symmetric matrix to tridiagonal form.
                    316: *
                    317:       INDE = 1
                    318:       INDTAU = INDE + N
                    319:       INDWRK = INDTAU + N
                    320:       LLWORK = LWORK - INDWRK + 1
                    321:       INDWK2 = INDWRK + N*N
                    322:       LLWRK2 = LWORK - INDWK2 + 1
                    323: *
                    324:       CALL DSYTRD( UPLO, N, A, LDA, W, WORK( INDE ), WORK( INDTAU ),
                    325:      $             WORK( INDWRK ), LLWORK, IINFO )
                    326: *
                    327: *     For eigenvalues only, call DSTERF.  For eigenvectors, first call
                    328: *     DSTEDC to generate the eigenvector matrix, WORK(INDWRK), of the
                    329: *     tridiagonal matrix, then call DORMTR to multiply it by the
                    330: *     Householder transformations stored in A.
                    331: *
                    332:       IF( .NOT.WANTZ ) THEN
                    333:          CALL DSTERF( N, W, WORK( INDE ), INFO )
                    334:       ELSE
                    335:          CALL DSTEDC( 'I', N, W, WORK( INDE ), WORK( INDWRK ), N,
                    336:      $                WORK( INDWK2 ), LLWRK2, IWORK, LIWORK, INFO )
                    337:          CALL DORMTR( 'L', UPLO, 'N', N, N, A, LDA, WORK( INDTAU ),
                    338:      $                WORK( INDWRK ), N, WORK( INDWK2 ), LLWRK2, IINFO )
                    339:          CALL DLACPY( 'A', N, N, WORK( INDWRK ), N, A, LDA )
                    340:       END IF
                    341: *
                    342: *     If matrix was scaled, then rescale eigenvalues appropriately.
                    343: *
                    344:       IF( ISCALE.EQ.1 )
                    345:      $   CALL DSCAL( N, ONE / SIGMA, W, 1 )
                    346: *
                    347:       WORK( 1 ) = LOPT
                    348:       IWORK( 1 ) = LIOPT
                    349: *
                    350:       RETURN
                    351: *
                    352: *     End of DSYEVD
                    353: *
                    354:       END

CVSweb interface <joel.bertrand@systella.fr>