|
version 1.14, 2012/12/14 14:22:35
|
version 1.20, 2018/05/29 07:18:00
|
|
Line 140
|
Line 140
|
| *> \author Univ. of Colorado Denver |
*> \author Univ. of Colorado Denver |
| *> \author NAG Ltd. |
*> \author NAG Ltd. |
| * |
* |
| *> \date September 2012 |
*> \date December 2016 |
| * |
* |
| *> \ingroup auxOTHERauxiliary |
*> \ingroup OTHERauxiliary |
| * |
* |
| *> \par Contributors: |
*> \par Contributors: |
| * ================== |
* ================== |
|
Line 153
|
Line 153
|
| * ===================================================================== |
* ===================================================================== |
| SUBROUTINE DLASD4( N, I, D, Z, DELTA, RHO, SIGMA, WORK, INFO ) |
SUBROUTINE DLASD4( N, I, D, Z, DELTA, RHO, SIGMA, WORK, INFO ) |
| * |
* |
| * -- LAPACK auxiliary routine (version 3.4.2) -- |
* -- LAPACK auxiliary routine (version 3.7.0) -- |
| * -- 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..-- |
| * September 2012 |
* December 2016 |
| * |
* |
| * .. Scalar Arguments .. |
* .. Scalar Arguments .. |
| INTEGER I, INFO, N |
INTEGER I, INFO, N |
|
Line 223
|
Line 223
|
| * |
* |
| EPS = DLAMCH( 'Epsilon' ) |
EPS = DLAMCH( 'Epsilon' ) |
| RHOINV = ONE / RHO |
RHOINV = ONE / RHO |
| |
TAU2= ZERO |
| * |
* |
| * The case I = N |
* The case I = N |
| * |
* |
|
Line 275
|
Line 276
|
| ELSE |
ELSE |
| TAU2 = ( A+SQRT( A*A+FOUR*B*C ) ) / ( TWO*C ) |
TAU2 = ( A+SQRT( A*A+FOUR*B*C ) ) / ( TWO*C ) |
| END IF |
END IF |
| |
TAU = TAU2 / ( D( N )+SQRT( D( N )*D( N )+TAU2 ) ) |
| END IF |
END IF |
| * |
* |
| * It can be proved that |
* It can be proved that |
|
Line 293
|
Line 295
|
| ELSE |
ELSE |
| TAU2 = ( A+SQRT( A*A+FOUR*B*C ) ) / ( TWO*C ) |
TAU2 = ( A+SQRT( A*A+FOUR*B*C ) ) / ( TWO*C ) |
| END IF |
END IF |
| |
TAU = TAU2 / ( D( N )+SQRT( D( N )*D( N )+TAU2 ) ) |
| |
|
| * |
* |
| * It can be proved that |
* It can be proved that |
| * D(N)^2 < D(N)^2+TAU2 < SIGMA(N)^2 < D(N)^2+RHO/2 |
* D(N)^2 < D(N)^2+TAU2 < SIGMA(N)^2 < D(N)^2+RHO/2 |
|
Line 301
|
Line 305
|
| * |
* |
| * The following TAU is to approximate SIGMA_n - D( N ) |
* The following TAU is to approximate SIGMA_n - D( N ) |
| * |
* |
| TAU = TAU2 / ( D( N )+SQRT( D( N )*D( N )+TAU2 ) ) |
* TAU = TAU2 / ( D( N )+SQRT( D( N )*D( N )+TAU2 ) ) |
| * |
* |
| SIGMA = D( N ) + TAU |
SIGMA = D( N ) + TAU |
| DO 30 J = 1, N |
DO 30 J = 1, N |
|
Line 327
|
Line 331
|
| TEMP = Z( N ) / ( DELTA( N )*WORK( N ) ) |
TEMP = Z( N ) / ( DELTA( N )*WORK( N ) ) |
| PHI = Z( N )*TEMP |
PHI = Z( N )*TEMP |
| DPHI = TEMP*TEMP |
DPHI = TEMP*TEMP |
| ERRETM = EIGHT*( -PHI-PSI ) + ERRETM - PHI + RHOINV |
ERRETM = EIGHT*( -PHI-PSI ) + ERRETM - PHI + RHOINV |
| * $ + ABS( TAU2 )*( DPSI+DPHI ) |
* $ + ABS( TAU2 )*( DPSI+DPHI ) |
| * |
* |
| W = RHOINV + PHI + PSI |
W = RHOINV + PHI + PSI |
|
Line 396
|
Line 400
|
| TEMP = Z( N ) / TAU2 |
TEMP = Z( N ) / TAU2 |
| PHI = Z( N )*TEMP |
PHI = Z( N )*TEMP |
| DPHI = TEMP*TEMP |
DPHI = TEMP*TEMP |
| ERRETM = EIGHT*( -PHI-PSI ) + ERRETM - PHI + RHOINV |
ERRETM = EIGHT*( -PHI-PSI ) + ERRETM - PHI + RHOINV |
| * $ + ABS( TAU2 )*( DPSI+DPHI ) |
* $ + ABS( TAU2 )*( DPSI+DPHI ) |
| * |
* |
| W = RHOINV + PHI + PSI |
W = RHOINV + PHI + PSI |
|
Line 466
|
Line 470
|
| TEMP = Z( N ) / TAU2 |
TEMP = Z( N ) / TAU2 |
| PHI = Z( N )*TEMP |
PHI = Z( N )*TEMP |
| DPHI = TEMP*TEMP |
DPHI = TEMP*TEMP |
| ERRETM = EIGHT*( -PHI-PSI ) + ERRETM - PHI + RHOINV |
ERRETM = EIGHT*( -PHI-PSI ) + ERRETM - PHI + RHOINV |
| * $ + ABS( TAU2 )*( DPSI+DPHI ) |
* $ + ABS( TAU2 )*( DPSI+DPHI ) |
| * |
* |
| W = RHOINV + PHI + PSI |
W = RHOINV + PHI + PSI |
|
Line 618
|
Line 622
|
| DW = DPSI + DPHI + TEMP*TEMP |
DW = DPSI + DPHI + TEMP*TEMP |
| TEMP = Z( II )*TEMP |
TEMP = Z( II )*TEMP |
| W = W + TEMP |
W = W + TEMP |
| ERRETM = EIGHT*( PHI-PSI ) + ERRETM + TWO*RHOINV |
ERRETM = EIGHT*( PHI-PSI ) + ERRETM + TWO*RHOINV |
| $ + THREE*ABS( TEMP ) |
$ + THREE*ABS( TEMP ) |
| * $ + ABS( TAU2 )*DW |
* $ + ABS( TAU2 )*DW |
| * |
* |
| * Test for convergence |
* Test for convergence |
|
Line 699
|
Line 703
|
| * |
* |
| IF( INFO.NE.0 ) THEN |
IF( INFO.NE.0 ) THEN |
| * |
* |
| * If INFO is not 0, i.e., DLAED6 failed, switch back |
* If INFO is not 0, i.e., DLAED6 failed, switch back |
| * to 2 pole interpolation. |
* to 2 pole interpolation. |
| * |
* |
| SWTCH3 = .FALSE. |
SWTCH3 = .FALSE. |
|
Line 799
|
Line 803
|
| DW = DPSI + DPHI + TEMP*TEMP |
DW = DPSI + DPHI + TEMP*TEMP |
| TEMP = Z( II )*TEMP |
TEMP = Z( II )*TEMP |
| W = RHOINV + PHI + PSI + TEMP |
W = RHOINV + PHI + PSI + TEMP |
| ERRETM = EIGHT*( PHI-PSI ) + ERRETM + TWO*RHOINV |
ERRETM = EIGHT*( PHI-PSI ) + ERRETM + TWO*RHOINV |
| $ + THREE*ABS( TEMP ) |
$ + THREE*ABS( TEMP ) |
| * $ + ABS( TAU2 )*DW |
* $ + ABS( TAU2 )*DW |
| * |
* |
| SWTCH = .FALSE. |
SWTCH = .FALSE. |
|
Line 918
|
Line 922
|
| * |
* |
| IF( INFO.NE.0 ) THEN |
IF( INFO.NE.0 ) THEN |
| * |
* |
| * If INFO is not 0, i.e., DLAED6 failed, switch |
* If INFO is not 0, i.e., DLAED6 failed, switch |
| * back to two pole interpolation |
* back to two pole interpolation |
| * |
* |
| SWTCH3 = .FALSE. |
SWTCH3 = .FALSE. |
|
Line 1034
|
Line 1038
|
| DW = DPSI + DPHI + TEMP*TEMP |
DW = DPSI + DPHI + TEMP*TEMP |
| TEMP = Z( II )*TEMP |
TEMP = Z( II )*TEMP |
| W = RHOINV + PHI + PSI + TEMP |
W = RHOINV + PHI + PSI + TEMP |
| ERRETM = EIGHT*( PHI-PSI ) + ERRETM + TWO*RHOINV |
ERRETM = EIGHT*( PHI-PSI ) + ERRETM + TWO*RHOINV |
| $ + THREE*ABS( TEMP ) |
$ + THREE*ABS( TEMP ) |
| * $ + ABS( TAU2 )*DW |
* $ + ABS( TAU2 )*DW |
| * |
* |
| IF( W*PREW.GT.ZERO .AND. ABS( W ).GT.ABS( PREW ) / TEN ) |
IF( W*PREW.GT.ZERO .AND. ABS( W ).GT.ABS( PREW ) / TEN ) |
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to dlasd4.f CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / lapack / lapack