diff options
| author | james <james@8a072113-8704-0410-8d35-dd094bca7971> | 2012-09-18 01:14:38 +0000 |
|---|---|---|
| committer | james <james@8a072113-8704-0410-8d35-dd094bca7971> | 2012-09-18 01:14:38 +0000 |
| commit | 894f016c2a00b263daad1bbfb9f4ae71bb348629 (patch) | |
| tree | bb9b7b73c0f8048b431664406ea12b6016c6dc9c /SRC/slasd4.f | |
| parent | de0934ada891b2f6eedeb65a9e965cade23b9867 (diff) | |
| download | lapack-894f016c2a00b263daad1bbfb9f4ae71bb348629.tar.gz lapack-894f016c2a00b263daad1bbfb9f4ae71bb348629.tar.bz2 lapack-894f016c2a00b263daad1bbfb9f4ae71bb348629.zip | |
Diffstat (limited to 'SRC/slasd4.f')
| -rw-r--r-- | SRC/slasd4.f | 41 |
1 files changed, 23 insertions, 18 deletions
diff --git a/SRC/slasd4.f b/SRC/slasd4.f index 7264fc9f..f29559bd 100644 --- a/SRC/slasd4.f +++ b/SRC/slasd4.f @@ -160,10 +160,10 @@ * * .. Scalar Arguments .. INTEGER I, INFO, N - REAL RHO, SIGMA + REAL RHO, SIGMA * .. * .. Array Arguments .. - REAL D( * ), DELTA( * ), WORK( * ), Z( * ) + REAL D( * ), DELTA( * ), WORK( * ), Z( * ) * .. * * ===================================================================== @@ -305,8 +305,8 @@ * SIGMA = D( N ) + TAU DO 30 J = 1, N - DELTA( J ) = ( D( J )-D( I ) ) - TAU - WORK( J ) = D( J ) + D( I ) + TAU + DELTA( J ) = ( D( J )-D( N ) ) - TAU + WORK( J ) = D( J ) + D( N ) + TAU 30 CONTINUE * * Evaluate PSI and the derivative DPSI @@ -327,8 +327,8 @@ TEMP = Z( N ) / ( DELTA( N )*WORK( N ) ) PHI = Z( N )*TEMP DPHI = TEMP*TEMP - ERRETM = EIGHT*( -PHI-PSI ) + ERRETM - PHI + RHOINV + - $ ABS( TAU2 )*( DPSI+DPHI ) + ERRETM = EIGHT*( -PHI-PSI ) + ERRETM - PHI + RHOINV +* $ + ABS( TAU2 )*( DPSI+DPHI ) * W = RHOINV + PHI + PSI * @@ -396,8 +396,8 @@ TEMP = Z( N ) / TAU2 PHI = Z( N )*TEMP DPHI = TEMP*TEMP - ERRETM = EIGHT*( -PHI-PSI ) + ERRETM - PHI + RHOINV + - $ ABS( TAU2 )*( DPSI+DPHI ) + ERRETM = EIGHT*( -PHI-PSI ) + ERRETM - PHI + RHOINV +* $ + ABS( TAU2 )*( DPSI+DPHI ) * W = RHOINV + PHI + PSI * @@ -466,8 +466,8 @@ TEMP = Z( N ) / TAU2 PHI = Z( N )*TEMP DPHI = TEMP*TEMP - ERRETM = EIGHT*( -PHI-PSI ) + ERRETM - PHI + RHOINV + - $ ABS( TAU2 )*( DPSI+DPHI ) + ERRETM = EIGHT*( -PHI-PSI ) + ERRETM - PHI + RHOINV +* $ + ABS( TAU2 )*( DPSI+DPHI ) * W = RHOINV + PHI + PSI 90 CONTINUE @@ -618,8 +618,9 @@ DW = DPSI + DPHI + TEMP*TEMP TEMP = Z( II )*TEMP W = W + TEMP - ERRETM = EIGHT*( PHI-PSI ) + ERRETM + TWO*RHOINV + - $ THREE*ABS( TEMP ) + ABS( TAU2 )*DW + ERRETM = EIGHT*( PHI-PSI ) + ERRETM + TWO*RHOINV + $ + THREE*ABS( TEMP ) +* $ + ABS( TAU2 )*DW * * Test for convergence * @@ -698,7 +699,8 @@ * IF( INFO.NE.0 ) THEN * -* If INFO is not 0, i.e., SLAED6 failed, switch back to 2 pole interpolation. +* If INFO is not 0, i.e., SLAED6 failed, switch back +* to 2 pole interpolation. * SWTCH3 = .FALSE. INFO = 0 @@ -797,8 +799,9 @@ DW = DPSI + DPHI + TEMP*TEMP TEMP = Z( II )*TEMP W = RHOINV + PHI + PSI + TEMP - ERRETM = EIGHT*( PHI-PSI ) + ERRETM + TWO*RHOINV + - $ THREE*ABS( TEMP ) + ABS( TAU2 )*DW + ERRETM = EIGHT*( PHI-PSI ) + ERRETM + TWO*RHOINV + $ + THREE*ABS( TEMP ) +* $ + ABS( TAU2 )*DW * SWTCH = .FALSE. IF( ORGATI ) THEN @@ -915,7 +918,8 @@ * IF( INFO.NE.0 ) THEN * -* If INFO is not 0, i.e., SLAED6 failed, switch back to two pole interpolation +* If INFO is not 0, i.e., SLAED6 failed, switch +* back to two pole interpolation * SWTCH3 = .FALSE. INFO = 0 @@ -1030,8 +1034,9 @@ DW = DPSI + DPHI + TEMP*TEMP TEMP = Z( II )*TEMP W = RHOINV + PHI + PSI + TEMP - ERRETM = EIGHT*( PHI-PSI ) + ERRETM + TWO*RHOINV + - $ THREE*ABS( TEMP ) + ABS( TAU2 )*DW + ERRETM = EIGHT*( PHI-PSI ) + ERRETM + TWO*RHOINV + $ + THREE*ABS( TEMP ) +* $ + ABS( TAU2 )*DW * IF( W*PREW.GT.ZERO .AND. ABS( W ).GT.ABS( PREW ) / TEN ) $ SWTCH = .NOT.SWTCH |