+++ /dev/null
-*> \brief \b DLASQ6 computes one dqd transform in ping-pong form. Used by sbdsqr and sstegr.
-*
-* =========== DOCUMENTATION ===========
-*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
-*
-*> \htmlonly
-*> Download DLASQ6 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlasq6.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlasq6.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlasq6.f">
-*> [TXT]</a>
-*> \endhtmlonly
-*
-* Definition:
-* ===========
-*
-* SUBROUTINE DLASQ6( I0, N0, Z, PP, DMIN, DMIN1, DMIN2, DN,
-* DNM1, DNM2 )
-*
-* .. Scalar Arguments ..
-* INTEGER I0, N0, PP
-* DOUBLE PRECISION DMIN, DMIN1, DMIN2, DN, DNM1, DNM2
-* ..
-* .. Array Arguments ..
-* DOUBLE PRECISION Z( * )
-* ..
-*
-*
-*> \par Purpose:
-* =============
-*>
-*> \verbatim
-*>
-*> DLASQ6 computes one dqd (shift equal to zero) transform in
-*> ping-pong form, with protection against underflow and overflow.
-*> \endverbatim
-*
-* Arguments:
-* ==========
-*
-*> \param[in] I0
-*> \verbatim
-*> I0 is INTEGER
-*> First index.
-*> \endverbatim
-*>
-*> \param[in] N0
-*> \verbatim
-*> N0 is INTEGER
-*> Last index.
-*> \endverbatim
-*>
-*> \param[in] Z
-*> \verbatim
-*> Z is DOUBLE PRECISION array, dimension ( 4*N )
-*> Z holds the qd array. EMIN is stored in Z(4*N0) to avoid
-*> an extra argument.
-*> \endverbatim
-*>
-*> \param[in] PP
-*> \verbatim
-*> PP is INTEGER
-*> PP=0 for ping, PP=1 for pong.
-*> \endverbatim
-*>
-*> \param[out] DMIN
-*> \verbatim
-*> DMIN is DOUBLE PRECISION
-*> Minimum value of d.
-*> \endverbatim
-*>
-*> \param[out] DMIN1
-*> \verbatim
-*> DMIN1 is DOUBLE PRECISION
-*> Minimum value of d, excluding D( N0 ).
-*> \endverbatim
-*>
-*> \param[out] DMIN2
-*> \verbatim
-*> DMIN2 is DOUBLE PRECISION
-*> Minimum value of d, excluding D( N0 ) and D( N0-1 ).
-*> \endverbatim
-*>
-*> \param[out] DN
-*> \verbatim
-*> DN is DOUBLE PRECISION
-*> d(N0), the last value of d.
-*> \endverbatim
-*>
-*> \param[out] DNM1
-*> \verbatim
-*> DNM1 is DOUBLE PRECISION
-*> d(N0-1).
-*> \endverbatim
-*>
-*> \param[out] DNM2
-*> \verbatim
-*> DNM2 is DOUBLE PRECISION
-*> d(N0-2).
-*> \endverbatim
-*
-* Authors:
-* ========
-*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
-*
-*> \date September 2012
-*
-*> \ingroup auxOTHERcomputational
-*
-* =====================================================================
- SUBROUTINE DLASQ6( I0, N0, Z, PP, DMIN, DMIN1, DMIN2, DN,
- $ DNM1, DNM2 )
-*
-* -- 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
- DOUBLE PRECISION DMIN, DMIN1, DMIN2, DN, DNM1, DNM2
-* ..
-* .. Array Arguments ..
- DOUBLE PRECISION Z( * )
-* ..
-*
-* =====================================================================
-*
-* .. Parameter ..
- DOUBLE PRECISION ZERO
- PARAMETER ( ZERO = 0.0D0 )
-* ..
-* .. Local Scalars ..
- INTEGER J4, J4P2
- DOUBLE PRECISION D, EMIN, SAFMIN, TEMP
-* ..
-* .. External Function ..
- DOUBLE PRECISION DLAMCH
- EXTERNAL DLAMCH
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC MIN
-* ..
-* .. Executable Statements ..
-*
- IF( ( N0-I0-1 ).LE.0 )
- $ RETURN
-*
-
- print *, "In dlasq6"
- STOP
-
- SAFMIN = DLAMCH( '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 DLASQ6
-*
- END
OSDN Git Service
