Go to the documentation of this file.
00001 *> \brief \b SLASQ5
00002 *
00003 *  =========== DOCUMENTATION ===========
00004 *
00005 * Online html documentation available at 
00006 *            http://www.netlib.org/lapack/explore-html/ 
00007 *
00008 *> \htmlonly
00009 *> Download SLASQ5 + dependencies 
00010 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slasq5.f"> 
00011 *> [TGZ]</a> 
00012 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slasq5.f"> 
00013 *> [ZIP]</a> 
00014 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slasq5.f"> 
00015 *> [TXT]</a>
00016 *> \endhtmlonly 
00017 *
00018 *  Definition:
00019 *  ===========
00020 *
00021 *       SUBROUTINE SLASQ5( I0, N0, Z, PP, TAU, DMIN, DMIN1, DMIN2, DN,
00022 *                          DNM1, DNM2, IEEE )
00023 * 
00024 *       .. Scalar Arguments ..
00025 *       LOGICAL            IEEE
00026 *       INTEGER            I0, N0, PP
00027 *       REAL               DMIN, DMIN1, DMIN2, DN, DNM1, DNM2, TAU
00028 *       ..
00029 *       .. Array Arguments ..
00030 *       REAL               Z( * )
00031 *       ..
00032 *  
00033 *
00034 *> \par Purpose:
00035 *  =============
00036 *>
00037 *> \verbatim
00038 *>
00039 *> SLASQ5 computes one dqds transform in ping-pong form, one
00040 *> version for IEEE machines another for non IEEE machines.
00041 *> \endverbatim
00042 *
00043 *  Arguments:
00044 *  ==========
00045 *
00046 *> \param[in] I0
00047 *> \verbatim
00048 *>          I0 is INTEGER
00049 *>        First index.
00050 *> \endverbatim
00051 *>
00052 *> \param[in] N0
00053 *> \verbatim
00054 *>          N0 is INTEGER
00055 *>        Last index.
00056 *> \endverbatim
00057 *>
00058 *> \param[in] Z
00059 *> \verbatim
00060 *>          Z is REAL array, dimension ( 4*N )
00061 *>        Z holds the qd array. EMIN is stored in Z(4*N0) to avoid
00062 *>        an extra argument.
00063 *> \endverbatim
00064 *>
00065 *> \param[in] PP
00066 *> \verbatim
00067 *>          PP is INTEGER
00068 *>        PP=0 for ping, PP=1 for pong.
00069 *> \endverbatim
00070 *>
00071 *> \param[in] TAU
00072 *> \verbatim
00073 *>          TAU is REAL
00074 *>        This is the shift.
00075 *> \endverbatim
00076 *>
00077 *> \param[out] DMIN
00078 *> \verbatim
00079 *>          DMIN is REAL
00080 *>        Minimum value of d.
00081 *> \endverbatim
00082 *>
00083 *> \param[out] DMIN1
00084 *> \verbatim
00085 *>          DMIN1 is REAL
00086 *>        Minimum value of d, excluding D( N0 ).
00087 *> \endverbatim
00088 *>
00089 *> \param[out] DMIN2
00090 *> \verbatim
00091 *>          DMIN2 is REAL
00092 *>        Minimum value of d, excluding D( N0 ) and D( N0-1 ).
00093 *> \endverbatim
00094 *>
00095 *> \param[out] DN
00096 *> \verbatim
00097 *>          DN is REAL
00098 *>        d(N0), the last value of d.
00099 *> \endverbatim
00100 *>
00101 *> \param[out] DNM1
00102 *> \verbatim
00103 *>          DNM1 is REAL
00104 *>        d(N0-1).
00105 *> \endverbatim
00106 *>
00107 *> \param[out] DNM2
00108 *> \verbatim
00109 *>          DNM2 is REAL
00110 *>        d(N0-2).
00111 *> \endverbatim
00112 *>
00113 *> \param[in] IEEE
00114 *> \verbatim
00115 *>          IEEE is LOGICAL
00116 *>        Flag for IEEE or non IEEE arithmetic.
00117 *> \endverbatim
00118 *
00119 *  Authors:
00120 *  ========
00121 *
00122 *> \author Univ. of Tennessee 
00123 *> \author Univ. of California Berkeley 
00124 *> \author Univ. of Colorado Denver 
00125 *> \author NAG Ltd. 
00126 *
00127 *> \date November 2011
00128 *
00129 *> \ingroup auxOTHERcomputational
00130 *
00131 *  =====================================================================
00132       SUBROUTINE SLASQ5( I0, N0, Z, PP, TAU, DMIN, DMIN1, DMIN2, DN,
00133      $                   DNM1, DNM2, IEEE )
00134 *
00135 *  -- LAPACK computational routine (version 3.4.0) --
00136 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00137 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00138 *     November 2011
00139 *
00140 *     .. Scalar Arguments ..
00141       LOGICAL            IEEE
00142       INTEGER            I0, N0, PP
00143       REAL               DMIN, DMIN1, DMIN2, DN, DNM1, DNM2, TAU
00144 *     ..
00145 *     .. Array Arguments ..
00146       REAL               Z( * )
00147 *     ..
00148 *
00149 *  =====================================================================
00150 *
00151 *     .. Parameter ..
00152       REAL               ZERO
00153       PARAMETER          ( ZERO = 0.0E0 )
00154 *     ..
00155 *     .. Local Scalars ..
00156       INTEGER            J4, J4P2
00157       REAL               D, EMIN, TEMP
00158 *     ..
00159 *     .. Intrinsic Functions ..
00160       INTRINSIC          MIN
00161 *     ..
00162 *     .. Executable Statements ..
00163 *
00164       IF( ( N0-I0-1 ).LE.0 )
00165      $   RETURN
00166 *
00167       J4 = 4*I0 + PP - 3
00168       EMIN = Z( J4+4 )
00169       D = Z( J4 ) - TAU
00170       DMIN = D
00171       DMIN1 = -Z( J4 )
00172 *
00173       IF( IEEE ) THEN
00174 *
00175 *        Code for IEEE arithmetic.
00176 *
00177          IF( PP.EQ.0 ) THEN
00178             DO 10 J4 = 4*I0, 4*( N0-3 ), 4
00179                Z( J4-2 ) = D + Z( J4-1 )
00180                TEMP = Z( J4+1 ) / Z( J4-2 )
00181                D = D*TEMP - TAU
00182                DMIN = MIN( DMIN, D )
00183                Z( J4 ) = Z( J4-1 )*TEMP
00184                EMIN = MIN( Z( J4 ), EMIN )
00185    10       CONTINUE
00186          ELSE
00187             DO 20 J4 = 4*I0, 4*( N0-3 ), 4
00188                Z( J4-3 ) = D + Z( J4 )
00189                TEMP = Z( J4+2 ) / Z( J4-3 )
00190                D = D*TEMP - TAU
00191                DMIN = MIN( DMIN, D )
00192                Z( J4-1 ) = Z( J4 )*TEMP
00193                EMIN = MIN( Z( J4-1 ), EMIN )
00194    20       CONTINUE
00195          END IF
00196 *
00197 *        Unroll last two steps.
00198 *
00199          DNM2 = D
00200          DMIN2 = DMIN
00201          J4 = 4*( N0-2 ) - PP
00202          J4P2 = J4 + 2*PP - 1
00203          Z( J4-2 ) = DNM2 + Z( J4P2 )
00204          Z( J4 ) = Z( J4P2+2 )*( Z( J4P2 ) / Z( J4-2 ) )
00205          DNM1 = Z( J4P2+2 )*( DNM2 / Z( J4-2 ) ) - TAU
00206          DMIN = MIN( DMIN, DNM1 )
00207 *
00208          DMIN1 = DMIN
00209          J4 = J4 + 4
00210          J4P2 = J4 + 2*PP - 1
00211          Z( J4-2 ) = DNM1 + Z( J4P2 )
00212          Z( J4 ) = Z( J4P2+2 )*( Z( J4P2 ) / Z( J4-2 ) )
00213          DN = Z( J4P2+2 )*( DNM1 / Z( J4-2 ) ) - TAU
00214          DMIN = MIN( DMIN, DN )
00215 *
00216       ELSE
00217 *
00218 *        Code for non IEEE arithmetic.
00219 *
00220          IF( PP.EQ.0 ) THEN
00221             DO 30 J4 = 4*I0, 4*( N0-3 ), 4
00222                Z( J4-2 ) = D + Z( J4-1 )
00223                IF( D.LT.ZERO ) THEN
00224                   RETURN
00225                ELSE
00226                   Z( J4 ) = Z( J4+1 )*( Z( J4-1 ) / Z( J4-2 ) )
00227                   D = Z( J4+1 )*( D / Z( J4-2 ) ) - TAU
00228                END IF
00229                DMIN = MIN( DMIN, D )
00230                EMIN = MIN( EMIN, Z( J4 ) )
00231    30       CONTINUE
00232          ELSE
00233             DO 40 J4 = 4*I0, 4*( N0-3 ), 4
00234                Z( J4-3 ) = D + Z( J4 )
00235                IF( D.LT.ZERO ) THEN
00236                   RETURN
00237                ELSE
00238                   Z( J4-1 ) = Z( J4+2 )*( Z( J4 ) / Z( J4-3 ) )
00239                   D = Z( J4+2 )*( D / Z( J4-3 ) ) - TAU
00240                END IF
00241                DMIN = MIN( DMIN, D )
00242                EMIN = MIN( EMIN, Z( J4-1 ) )
00243    40       CONTINUE
00244          END IF
00245 *
00246 *        Unroll last two steps.
00247 *
00248          DNM2 = D
00249          DMIN2 = DMIN
00250          J4 = 4*( N0-2 ) - PP
00251          J4P2 = J4 + 2*PP - 1
00252          Z( J4-2 ) = DNM2 + Z( J4P2 )
00253          IF( DNM2.LT.ZERO ) THEN
00254             RETURN
00255          ELSE
00256             Z( J4 ) = Z( J4P2+2 )*( Z( J4P2 ) / Z( J4-2 ) )
00257             DNM1 = Z( J4P2+2 )*( DNM2 / Z( J4-2 ) ) - TAU
00258          END IF
00259          DMIN = MIN( DMIN, DNM1 )
00260 *
00261          DMIN1 = DMIN
00262          J4 = J4 + 4
00263          J4P2 = J4 + 2*PP - 1
00264          Z( J4-2 ) = DNM1 + Z( J4P2 )
00265          IF( DNM1.LT.ZERO ) THEN
00266             RETURN
00267          ELSE
00268             Z( J4 ) = Z( J4P2+2 )*( Z( J4P2 ) / Z( J4-2 ) )
00269             DN = Z( J4P2+2 )*( DNM1 / Z( J4-2 ) ) - TAU
00270          END IF
00271          DMIN = MIN( DMIN, DN )
00272 *
00273       END IF
00274 *
00275       Z( J4+2 ) = DN
00276       Z( 4*N0-PP ) = EMIN
00277       RETURN
00278 *
00279 *     End of SLASQ5
00280 *
00281       END