subroutine slasq6	(	integer	I0,
		integer	N0,
		real, dimension( * )	Z,
		integer	PP,
		real	DMIN,
		real	DMIN1,
		real	DMIN2,
		real	DN,
		real	DNM1,
		real	DNM2
	)

SLASQ6 computes one dqd transform in ping-pong form. Used by sbdsqr and sstegr.

Download SLASQ6 + dependencies [TGZ] [ZIP] [TXT]

Purpose:

 SLASQ6 computes one dqd (shift equal to zero) transform in
 ping-pong form, with protection against underflow and overflow.

Parameters

[in]	I0	I0 is INTEGER First index.
[in]	N0	N0 is INTEGER Last index.
[in]	Z	Z is REAL array, dimension ( 4*N ) Z holds the qd array. EMIN is stored in Z(4*N0) to avoid an extra argument.
[in]	PP	PP is INTEGER PP=0 for ping, PP=1 for pong.
[out]	DMIN	DMIN is REAL Minimum value of d.
[out]	DMIN1	DMIN1 is REAL Minimum value of d, excluding D( N0 ).
[out]	DMIN2	DMIN2 is REAL Minimum value of d, excluding D( N0 ) and D( N0-1 ).
[out]	DN	DN is REAL d(N0), the last value of d.
[out]	DNM1	DNM1 is REAL d(N0-1).
[out]	DNM2	DNM2 is REAL d(N0-2).

Author

Univ. of Tennessee

Univ. of California Berkeley

Univ. of Colorado Denver

NAG Ltd.

Date

September 2012

Definition at line 121 of file slasq6.f.

*
*  -- 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            i0, n0, pp
      REAL               dmin, dmin1, dmin2, dn, dnm1, dnm2
*     ..
*     .. Array Arguments ..
      REAL               z( * )
*     ..
*
*  =====================================================================
*
*     .. Parameter ..
      REAL               zero
      parameter                ( zero = 0.0e0 )
*     ..
*     .. Local Scalars ..
      INTEGER            j4, j4p2
      REAL               d, emin, safmin, temp
*     ..
*     .. External Function ..
      REAL               slamch
      EXTERNAL           slamch
*     ..
*     .. Intrinsic Functions ..
      INTRINSIC          min
*     ..
*     .. Executable Statements ..
*
      IF( ( n0-i0-1 ).LE.0 )
     $   RETURN
*
      safmin = slamch( 'Safe minimum' )
      j4 = 4*i0 + pp - 3
      emin = z( j4+4 ) 
      d = z( j4 )
      dmin = d
*
      IF( pp.EQ.0 ) THEN
         DO 10 j4 = 4*i0, 4*( n0-3 ), 4
            z( j4-2 ) = d + z( j4-1 ) 
            IF( z( j4-2 ).EQ.zero ) THEN
               z( j4 ) = zero
               d = z( j4+1 )
               dmin = d
               emin = zero
            ELSE IF( safmin*z( j4+1 ).LT.z( j4-2 ) .AND.
     $               safmin*z( j4-2 ).LT.z( j4+1 ) ) THEN
               temp = z( j4+1 ) / z( j4-2 )
               z( j4 ) = z( j4-1 )*temp
               d = d*temp
            ELSE 
               z( j4 ) = z( j4+1 )*( z( j4-1 ) / z( j4-2 ) )
               d = z( j4+1 )*( d / z( j4-2 ) )
            END IF
            dmin = min( dmin, d )
            emin = min( emin, z( j4 ) )
   10    CONTINUE
      ELSE
         DO 20 j4 = 4*i0, 4*( n0-3 ), 4
            z( j4-3 ) = d + z( j4 ) 
            IF( z( j4-3 ).EQ.zero ) THEN
               z( j4-1 ) = zero
               d = z( j4+2 )
               dmin = d
               emin = zero
            ELSE IF( safmin*z( j4+2 ).LT.z( j4-3 ) .AND.
     $               safmin*z( j4-3 ).LT.z( j4+2 ) ) THEN
               temp = z( j4+2 ) / z( j4-3 )
               z( j4-1 ) = z( j4 )*temp
               d = d*temp
            ELSE 
               z( j4-1 ) = z( j4+2 )*( z( j4 ) / z( j4-3 ) )
               d = z( j4+2 )*( d / z( j4-3 ) )
            END IF
            dmin = min( dmin, d )
            emin = min( emin, z( j4-1 ) )
   20    CONTINUE
      END IF
*
*     Unroll last two steps. 
*
      dnm2 = d
      dmin2 = dmin
      j4 = 4*( n0-2 ) - pp
      j4p2 = j4 + 2*pp - 1
      z( j4-2 ) = dnm2 + z( j4p2 )
      IF( z( j4-2 ).EQ.zero ) THEN
         z( j4 ) = zero
         dnm1 = z( j4p2+2 )
         dmin = dnm1
         emin = zero
      ELSE IF( safmin*z( j4p2+2 ).LT.z( j4-2 ) .AND.
     $         safmin*z( j4-2 ).LT.z( j4p2+2 ) ) THEN
         temp = z( j4p2+2 ) / z( j4-2 )
         z( j4 ) = z( j4p2 )*temp
         dnm1 = dnm2*temp
      ELSE
         z( j4 ) = z( j4p2+2 )*( z( j4p2 ) / z( j4-2 ) )
         dnm1 = z( j4p2+2 )*( dnm2 / z( j4-2 ) )
      END IF
      dmin = min( dmin, dnm1 )
*
      dmin1 = dmin
      j4 = j4 + 4
      j4p2 = j4 + 2*pp - 1
      z( j4-2 ) = dnm1 + z( j4p2 )
      IF( z( j4-2 ).EQ.zero ) THEN
         z( j4 ) = zero
         dn = z( j4p2+2 )
         dmin = dn
         emin = zero
      ELSE IF( safmin*z( j4p2+2 ).LT.z( j4-2 ) .AND.
     $         safmin*z( j4-2 ).LT.z( j4p2+2 ) ) THEN
         temp = z( j4p2+2 ) / z( j4-2 )
         z( j4 ) = z( j4p2 )*temp
         dn = dnm1*temp
      ELSE
         z( j4 ) = z( j4p2+2 )*( z( j4p2 ) / z( j4-2 ) )
         dn = z( j4p2+2 )*( dnm1 / z( j4-2 ) )
      END IF
      dmin = min( dmin, dn )
*
      z( j4+2 ) = dn
      z( 4*n0-pp ) = emin
      RETURN
*
*     End of SLASQ6
*

Here is the caller graph for this function: