slaed5 (3p)

Name

slaed5 - 2 secular equation

Synopsis

SUBROUTINE SLAED5( I, D, Z, DELTA, RHO, DLAM )


INTEGER I

REAL DLAM, RHO

REAL D(2),DELTA(2), Z(2)


SUBROUTINE SLAED5_64( I, D, Z, DELTA, RHO, DLAM )


INTEGER*8 I

REAL DLAM, RHO

REAL D(2),DELTA(2), Z(2)


F95 INTERFACE
SUBROUTINE LAED5( I, D, Z, DELTA, RHO, DLAM )


INTEGER :: I

REAL, DIMENSION(:) :: D, Z, DELTA

REAL :: RHO, DLAM


SUBROUTINE LAED5_64( I, D, Z, DELTA, RHO, DLAM )


INTEGER(8) :: I

REAL, DIMENSION(:) :: D, Z, DELTA

REAL :: RHO, DLAM


C INTERFACE
#include <sunperf.h>

void  slaed5 (int i, float *d, float *z, float *delta, float rho, float
*dlam);


void slaed5_64 (long i, float *d, float *z, float  *delta,  float  rho,
float *dlam);

Description

Oracle Solaris Studio Performance Library                           slaed5(3P)



NAME
       slaed5 - is used by sstedc. Solves the 2-by-2 secular equation


SYNOPSIS
       SUBROUTINE SLAED5( I, D, Z, DELTA, RHO, DLAM )


       INTEGER I

       REAL DLAM, RHO

       REAL D(2),DELTA(2), Z(2)


       SUBROUTINE SLAED5_64( I, D, Z, DELTA, RHO, DLAM )


       INTEGER*8 I

       REAL DLAM, RHO

       REAL D(2),DELTA(2), Z(2)


   F95 INTERFACE
       SUBROUTINE LAED5( I, D, Z, DELTA, RHO, DLAM )


       INTEGER :: I

       REAL, DIMENSION(:) :: D, Z, DELTA

       REAL :: RHO, DLAM


       SUBROUTINE LAED5_64( I, D, Z, DELTA, RHO, DLAM )


       INTEGER(8) :: I

       REAL, DIMENSION(:) :: D, Z, DELTA

       REAL :: RHO, DLAM


   C INTERFACE
       #include <sunperf.h>

       void  slaed5 (int i, float *d, float *z, float *delta, float rho, float
                 *dlam);


       void slaed5_64 (long i, float *d, float *z, float  *delta,  float  rho,
                 float *dlam);


PURPOSE
             SUBROUTINE  slaed5(  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
             REAL                DLAM,  RHO *     ..  *     .. Array Arguments
       ..
             REAL               D( 2 ), DELTA( 2 ), Z(  2  )  *      ..   *  *
       ===================================================================== *
       *     .. Parameters ..
             REAL               ZERO, ONE, TWO, FOUR
             PARAMETER          ( ZERO = 0.0E0, ONE = 1.0E0, TWO = 2.0E0,
            $                   FOUR =  4.0E0  )  *      ..   *      ..  Local
       Scalars ..
             REAL                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 SLAED5 *
             END


ARGUMENTS
                                  7 Nov 2015                        slaed5(3P)