|
version 1.1, 2015/11/26 11:44:15
|
version 1.2, 2016/08/27 15:27:08
|
|
Line 80
|
Line 80
|
| *> = 'L': B is lower bidiagonal. |
*> = 'L': B is lower bidiagonal. |
| *> \endverbatim |
*> \endverbatim |
| *> |
*> |
| *> \param[in] JOBXZ |
*> \param[in] JOBZ |
| *> \verbatim |
*> \verbatim |
| *> JOBZ is CHARACTER*1 |
*> JOBZ is CHARACTER*1 |
| *> = 'N': Compute singular values only; |
*> = 'N': Compute singular values only; |
|
Line 117
|
Line 117
|
| *> |
*> |
| *> \param[in] VL |
*> \param[in] VL |
| *> \verbatim |
*> \verbatim |
| *> VL is DOUBLE PRECISION |
*> VL is DOUBLE PRECISION |
| *> VL >=0. |
*> If RANGE='V', the lower bound of the interval to |
| |
*> be searched for singular values. VU > VL. |
| |
*> Not referenced if RANGE = 'A' or 'I'. |
| *> \endverbatim |
*> \endverbatim |
| *> |
*> |
| *> \param[in] VU |
*> \param[in] VU |
| *> \verbatim |
*> \verbatim |
| *> VU is DOUBLE PRECISION |
*> VU is DOUBLE PRECISION |
| *> If RANGE='V', the lower and upper bounds of the interval to |
*> If RANGE='V', the upper bound of the interval to |
| *> be searched for singular values. VU > VL. |
*> be searched for singular values. VU > VL. |
| *> Not referenced if RANGE = 'A' or 'I'. |
*> Not referenced if RANGE = 'A' or 'I'. |
| *> \endverbatim |
*> \endverbatim |
|
Line 132
|
Line 134
|
| *> \param[in] IL |
*> \param[in] IL |
| *> \verbatim |
*> \verbatim |
| *> IL is INTEGER |
*> IL is INTEGER |
| |
*> If RANGE='I', the index of the |
| |
*> smallest singular value to be returned. |
| |
*> 1 <= IL <= IU <= min(M,N), if min(M,N) > 0. |
| |
*> Not referenced if RANGE = 'A' or 'V'. |
| *> \endverbatim |
*> \endverbatim |
| *> |
*> |
| *> \param[in] IU |
*> \param[in] IU |
| *> \verbatim |
*> \verbatim |
| *> IU is INTEGER |
*> IU is INTEGER |
| *> If RANGE='I', the indices (in ascending order) of the |
*> If RANGE='I', the index of the |
| *> smallest and largest singular values to be returned. |
*> largest singular value to be returned. |
| *> 1 <= IL <= IU <= min(M,N), if min(M,N) > 0. |
*> 1 <= IL <= IU <= min(M,N), if min(M,N) > 0. |
| *> Not referenced if RANGE = 'A' or 'V'. |
*> Not referenced if RANGE = 'A' or 'V'. |
| *> \endverbatim |
*> \endverbatim |
|
Line 190
|
Line 196
|
| *> If JOBZ = 'V', then if INFO = 0, the first NS elements of |
*> If JOBZ = 'V', then if INFO = 0, the first NS elements of |
| *> IWORK are zero. If INFO > 0, then IWORK contains the indices |
*> IWORK are zero. If INFO > 0, then IWORK contains the indices |
| *> of the eigenvectors that failed to converge in DSTEVX. |
*> of the eigenvectors that failed to converge in DSTEVX. |
| |
*> \endverbatim |
| *> |
*> |
| |
*> \param[out] INFO |
| |
*> \verbatim |
| *> INFO is INTEGER |
*> INFO is INTEGER |
| *> = 0: successful exit |
*> = 0: successful exit |
| *> < 0: if INFO = -i, the i-th argument had an illegal value |
*> < 0: if INFO = -i, the i-th argument had an illegal value |
|
Line 209
|
Line 218
|
| *> \author Univ. of Colorado Denver |
*> \author Univ. of Colorado Denver |
| *> \author NAG Ltd. |
*> \author NAG Ltd. |
| * |
* |
| *> \date November 2011 |
*> \date June 2016 |
| * |
* |
| *> \ingroup doubleOTHEReigen |
*> \ingroup doubleOTHEReigen |
| * |
* |
|
Line 217
|
Line 226
|
| SUBROUTINE DBDSVDX( UPLO, JOBZ, RANGE, N, D, E, VL, VU, IL, IU, |
SUBROUTINE DBDSVDX( UPLO, JOBZ, RANGE, N, D, E, VL, VU, IL, IU, |
| $ NS, S, Z, LDZ, WORK, IWORK, INFO) |
$ NS, S, Z, LDZ, WORK, IWORK, INFO) |
| * |
* |
| * -- LAPACK driver routine (version 3.6.0) -- |
* -- LAPACK driver routine (version 3.6.1) -- |
| * -- LAPACK is a software package provided by Univ. of Tennessee, -- |
* -- LAPACK is a software package provided by Univ. of Tennessee, -- |
| * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- |
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- |
| * November 2016 |
* November 2016 |
|
Line 371
|
Line 380
|
| IF( ABS( E( I ) ).LE.THRESH ) E( I ) = ZERO |
IF( ABS( E( I ) ).LE.THRESH ) E( I ) = ZERO |
| END DO |
END DO |
| IF( ABS( D( N ) ).LE.THRESH ) D( N ) = ZERO |
IF( ABS( D( N ) ).LE.THRESH ) D( N ) = ZERO |
| E( N ) = ZERO |
|
| * |
* |
| * Pointers for arrays used by DSTEVX. |
* Pointers for arrays used by DSTEVX. |
| * |
* |
|
Line 398
|
Line 406
|
| * of the active submatrix. |
* of the active submatrix. |
| * |
* |
| RNGVX = 'I' |
RNGVX = 'I' |
| CALL DLASET( 'F', N*2, N+1, ZERO, ZERO, Z, LDZ ) |
IF( WANTZ ) CALL DLASET( 'F', N*2, N+1, ZERO, ZERO, Z, LDZ ) |
| ELSE IF( VALSV ) THEN |
ELSE IF( VALSV ) THEN |
| * |
* |
| * Find singular values in a half-open interval. We aim |
* Find singular values in a half-open interval. We aim |
|
Line 418
|
Line 426
|
| IF( NS.EQ.0 ) THEN |
IF( NS.EQ.0 ) THEN |
| RETURN |
RETURN |
| ELSE |
ELSE |
| CALL DLASET( 'F', N*2, NS, ZERO, ZERO, Z, LDZ ) |
IF( WANTZ ) CALL DLASET( 'F', N*2, NS, ZERO, ZERO, Z, LDZ ) |
| END IF |
END IF |
| ELSE IF( INDSV ) THEN |
ELSE IF( INDSV ) THEN |
| * |
* |
|
Line 455
|
Line 463
|
| * |
* |
| IF( VLTGK.EQ.VUTGK ) VLTGK = VLTGK - TOL |
IF( VLTGK.EQ.VUTGK ) VLTGK = VLTGK - TOL |
| * |
* |
| CALL DLASET( 'F', N*2, IU-IL+1, ZERO, ZERO, Z, LDZ ) |
IF( WANTZ ) CALL DLASET( 'F', N*2, IU-IL+1, ZERO, ZERO, Z, LDZ) |
| END IF |
END IF |
| * |
* |
| * Initialize variables and pointers for S, Z, and WORK. |
* Initialize variables and pointers for S, Z, and WORK. |
|
Line 709
|
Line 717
|
| NRU = 0 |
NRU = 0 |
| NRV = 0 |
NRV = 0 |
| END IF !** NTGK.GT.0 **! |
END IF !** NTGK.GT.0 **! |
| IF( IROWZ.LT.N*2 ) Z( 1:IROWZ-1, ICOLZ ) = ZERO |
IF( IROWZ.LT.N*2 .AND. WANTZ ) THEN |
| |
Z( 1:IROWZ-1, ICOLZ ) = ZERO |
| |
END IF |
| END DO !** IDPTR loop **! |
END DO !** IDPTR loop **! |
| IF( SPLIT ) THEN |
IF( SPLIT .AND. WANTZ ) THEN |
| * |
* |
| * Bring back eigenvector corresponding |
* Bring back eigenvector corresponding |
| * to eigenvalue equal to zero. |
* to eigenvalue equal to zero. |
|
Line 744
|
Line 754
|
| IF( K.NE.NS+1-I ) THEN |
IF( K.NE.NS+1-I ) THEN |
| S( K ) = S( NS+1-I ) |
S( K ) = S( NS+1-I ) |
| S( NS+1-I ) = SMIN |
S( NS+1-I ) = SMIN |
| CALL DSWAP( N*2, Z( 1,K ), 1, Z( 1,NS+1-I ), 1 ) |
IF( WANTZ ) CALL DSWAP( N*2, Z( 1,K ), 1, Z( 1,NS+1-I ), 1 ) |
| END IF |
END IF |
| END DO |
END DO |
| * |
* |
|
Line 754
|
Line 764
|
| K = IU - IL + 1 |
K = IU - IL + 1 |
| IF( K.LT.NS ) THEN |
IF( K.LT.NS ) THEN |
| S( K+1:NS ) = ZERO |
S( K+1:NS ) = ZERO |
| Z( 1:N*2,K+1:NS ) = ZERO |
IF( WANTZ ) Z( 1:N*2,K+1:NS ) = ZERO |
| NS = K |
NS = K |
| END IF |
END IF |
| END IF |
END IF |
|
Line 762
|
Line 772
|
| * Reorder Z: U = Z( 1:N,1:NS ), V = Z( N+1:N*2,1:NS ). |
* Reorder Z: U = Z( 1:N,1:NS ), V = Z( N+1:N*2,1:NS ). |
| * If B is a lower diagonal, swap U and V. |
* If B is a lower diagonal, swap U and V. |
| * |
* |
| |
IF( WANTZ ) THEN |
| DO I = 1, NS |
DO I = 1, NS |
| CALL DCOPY( N*2, Z( 1,I ), 1, WORK, 1 ) |
CALL DCOPY( N*2, Z( 1,I ), 1, WORK, 1 ) |
| IF( LOWER ) THEN |
IF( LOWER ) THEN |
|
Line 772
|
Line 783
|
| CALL DCOPY( N, WORK( 1 ), 2, Z( N+1,I ), 1 ) |
CALL DCOPY( N, WORK( 1 ), 2, Z( N+1,I ), 1 ) |
| END IF |
END IF |
| END DO |
END DO |
| |
END IF |
| * |
* |
| RETURN |
RETURN |
| * |
* |
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to dbdsvdx.f CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / lapack / lapack