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)