dlaed5 - 2 secular equation
SUBROUTINE DLAED5( I, D, Z, DELTA, RHO, DLAM ) INTEGER I DOUBLE PRECISION DLAM, RHO DOUBLE PRECISION D(2),DELTA(2), Z(2) SUBROUTINE DLAED5_64( I, D, Z, DELTA, RHO, DLAM ) INTEGER*8 I DOUBLE PRECISION DLAM, RHO DOUBLE PRECISION D(2),DELTA(2), Z(2) F95 INTERFACE SUBROUTINE LAED5( I, D, Z, DELTA, RHO, DLAM ) INTEGER :: I REAL(8), DIMENSION(:) :: D, Z, DELTA REAL(8) :: RHO, DLAM SUBROUTINE LAED5_64( I, D, Z, DELTA, RHO, DLAM ) INTEGER(8) :: I REAL(8), DIMENSION(:) :: D, Z, DELTA REAL(8) :: RHO, DLAM C INTERFACE #include <sunperf.h> void dlaed5 (int i, double *d, double *z, double *delta, double rho, double *dlam); void dlaed5_64 (long i, double *d, double *z, double *delta, double rho, double *dlam);
Oracle Solaris Studio Performance Library dlaed5(3P) NAME dlaed5 - is used by sstedc. Solve the 2-by-2 secular equation SYNOPSIS SUBROUTINE DLAED5( I, D, Z, DELTA, RHO, DLAM ) INTEGER I DOUBLE PRECISION DLAM, RHO DOUBLE PRECISION D(2),DELTA(2), Z(2) SUBROUTINE DLAED5_64( I, D, Z, DELTA, RHO, DLAM ) INTEGER*8 I DOUBLE PRECISION DLAM, RHO DOUBLE PRECISION D(2),DELTA(2), Z(2) F95 INTERFACE SUBROUTINE LAED5( I, D, Z, DELTA, RHO, DLAM ) INTEGER :: I REAL(8), DIMENSION(:) :: D, Z, DELTA REAL(8) :: RHO, DLAM SUBROUTINE LAED5_64( I, D, Z, DELTA, RHO, DLAM ) INTEGER(8) :: I REAL(8), DIMENSION(:) :: D, Z, DELTA REAL(8) :: RHO, DLAM C INTERFACE #include <sunperf.h> void dlaed5 (int i, double *d, double *z, double *delta, double rho, double *dlam); void dlaed5_64 (long i, double *d, double *z, double *delta, double rho, double *dlam); PURPOSE SUBROUTINE dlaed5( I, D, Z, DELTA, RHO, DLAM ) * * -- LAPACK computational routine (version 3.4.2) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * September 2012 * * .. Scalar Arguments .. INTEGER I DOUBLE PRECISION DLAM, RHO * .. * .. Array Arguments .. DOUBLE PRECISION D( 2 ), DELTA( 2 ), Z( 2 ) * .. * * ===================================================================== * * .. Parameters .. DOUBLE PRECISION ZERO, ONE, TWO, FOUR PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0, TWO = 2.0D0, $ FOUR = 4.0D0 ) * .. * .. Local Scalars .. DOUBLE PRECISION B, C, DEL, TAU, TEMP, W * .. * .. Intrinsic Functions .. INTRINSIC ABS, SQRT * .. * .. Executable State- ments .. * DEL = D( 2 ) - D( 1 ) IF( I.EQ.1 ) THEN W = ONE + TWO*RHO*( Z( 2 )*Z( 2 )-Z( 1 )*Z( 1 ) ) / DEL IF( W.GT.ZERO ) THEN B = DEL + RHO*( Z( 1 )*Z( 1 )+Z( 2 )*Z( 2 ) ) C = RHO*Z( 1 )*Z( 1 )*DEL * * B > ZERO, always * TAU = TWO*C / ( B+SQRT( ABS( B*B-FOUR*C ) ) ) DLAM = D( 1 ) + TAU DELTA( 1 ) = -Z( 1 ) / TAU DELTA( 2 ) = Z( 2 ) / ( DEL-TAU ) ELSE B = -DEL + RHO*( Z( 1 )*Z( 1 )+Z( 2 )*Z( 2 ) ) C = RHO*Z( 2 )*Z( 2 )*DEL IF( B.GT.ZERO ) THEN TAU = -TWO*C / ( B+SQRT( B*B+FOUR*C ) ) ELSE TAU = ( B-SQRT( B*B+FOUR*C ) ) / TWO END IF DLAM = D( 2 ) + TAU DELTA( 1 ) = -Z( 1 ) / ( DEL+TAU ) DELTA( 2 ) = -Z( 2 ) / TAU END IF TEMP = SQRT( DELTA( 1 )*DELTA( 1 )+DELTA( 2 )*DELTA( 2 ) ) DELTA( 1 ) = DELTA( 1 ) / TEMP DELTA( 2 ) = DELTA( 2 ) / TEMP ELSE * * Now I=2 * B = -DEL + RHO*( Z( 1 )*Z( 1 )+Z( 2 )*Z( 2 ) ) C = RHO*Z( 2 )*Z( 2 )*DEL IF( B.GT.ZERO ) THEN TAU = ( B+SQRT( B*B+FOUR*C ) ) / TWO ELSE TAU = TWO*C / ( -B+SQRT( B*B+FOUR*C ) ) END IF DLAM = D( 2 ) + TAU DELTA( 1 ) = -Z( 1 ) / ( DEL+TAU ) DELTA( 2 ) = -Z( 2 ) / TAU TEMP = SQRT( DELTA( 1 )*DELTA( 1 )+DELTA( 2 )*DELTA( 2 ) ) DELTA( 1 ) = DELTA( 1 ) / TEMP DELTA( 2 ) = DELTA( 2 ) / TEMP END IF RETURN * * End OF DLAED5 * END ARGUMENTS 7 Nov 2015 dlaed5(3P)