Annotation of rpl/lapack/lapack/dlasq5.f, revision 1.8
1.8 ! bertrand 1: *> \brief \b DLASQ5
! 2: *
! 3: * =========== DOCUMENTATION ===========
! 4: *
! 5: * Online html documentation available at
! 6: * http://www.netlib.org/lapack/explore-html/
! 7: *
! 8: *> \htmlonly
! 9: *> Download DLASQ5 + dependencies
! 10: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlasq5.f">
! 11: *> [TGZ]</a>
! 12: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlasq5.f">
! 13: *> [ZIP]</a>
! 14: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlasq5.f">
! 15: *> [TXT]</a>
! 16: *> \endhtmlonly
! 17: *
! 18: * Definition:
! 19: * ===========
! 20: *
! 21: * SUBROUTINE DLASQ5( I0, N0, Z, PP, TAU, DMIN, DMIN1, DMIN2, DN,
! 22: * DNM1, DNM2, IEEE )
! 23: *
! 24: * .. Scalar Arguments ..
! 25: * LOGICAL IEEE
! 26: * INTEGER I0, N0, PP
! 27: * DOUBLE PRECISION DMIN, DMIN1, DMIN2, DN, DNM1, DNM2, TAU
! 28: * ..
! 29: * .. Array Arguments ..
! 30: * DOUBLE PRECISION Z( * )
! 31: * ..
! 32: *
! 33: *
! 34: *> \par Purpose:
! 35: * =============
! 36: *>
! 37: *> \verbatim
! 38: *>
! 39: *> DLASQ5 computes one dqds transform in ping-pong form, one
! 40: *> version for IEEE machines another for non IEEE machines.
! 41: *> \endverbatim
! 42: *
! 43: * Arguments:
! 44: * ==========
! 45: *
! 46: *> \param[in] I0
! 47: *> \verbatim
! 48: *> I0 is INTEGER
! 49: *> First index.
! 50: *> \endverbatim
! 51: *>
! 52: *> \param[in] N0
! 53: *> \verbatim
! 54: *> N0 is INTEGER
! 55: *> Last index.
! 56: *> \endverbatim
! 57: *>
! 58: *> \param[in] Z
! 59: *> \verbatim
! 60: *> Z is DOUBLE PRECISION array, dimension ( 4*N )
! 61: *> Z holds the qd array. EMIN is stored in Z(4*N0) to avoid
! 62: *> an extra argument.
! 63: *> \endverbatim
! 64: *>
! 65: *> \param[in] PP
! 66: *> \verbatim
! 67: *> PP is INTEGER
! 68: *> PP=0 for ping, PP=1 for pong.
! 69: *> \endverbatim
! 70: *>
! 71: *> \param[in] TAU
! 72: *> \verbatim
! 73: *> TAU is DOUBLE PRECISION
! 74: *> This is the shift.
! 75: *> \endverbatim
! 76: *>
! 77: *> \param[out] DMIN
! 78: *> \verbatim
! 79: *> DMIN is DOUBLE PRECISION
! 80: *> Minimum value of d.
! 81: *> \endverbatim
! 82: *>
! 83: *> \param[out] DMIN1
! 84: *> \verbatim
! 85: *> DMIN1 is DOUBLE PRECISION
! 86: *> Minimum value of d, excluding D( N0 ).
! 87: *> \endverbatim
! 88: *>
! 89: *> \param[out] DMIN2
! 90: *> \verbatim
! 91: *> DMIN2 is DOUBLE PRECISION
! 92: *> Minimum value of d, excluding D( N0 ) and D( N0-1 ).
! 93: *> \endverbatim
! 94: *>
! 95: *> \param[out] DN
! 96: *> \verbatim
! 97: *> DN is DOUBLE PRECISION
! 98: *> d(N0), the last value of d.
! 99: *> \endverbatim
! 100: *>
! 101: *> \param[out] DNM1
! 102: *> \verbatim
! 103: *> DNM1 is DOUBLE PRECISION
! 104: *> d(N0-1).
! 105: *> \endverbatim
! 106: *>
! 107: *> \param[out] DNM2
! 108: *> \verbatim
! 109: *> DNM2 is DOUBLE PRECISION
! 110: *> d(N0-2).
! 111: *> \endverbatim
! 112: *>
! 113: *> \param[in] IEEE
! 114: *> \verbatim
! 115: *> IEEE is LOGICAL
! 116: *> Flag for IEEE or non IEEE arithmetic.
! 117: *> \endverbatim
! 118: *
! 119: * Authors:
! 120: * ========
! 121: *
! 122: *> \author Univ. of Tennessee
! 123: *> \author Univ. of California Berkeley
! 124: *> \author Univ. of Colorado Denver
! 125: *> \author NAG Ltd.
! 126: *
! 127: *> \date November 2011
! 128: *
! 129: *> \ingroup auxOTHERcomputational
! 130: *
! 131: * =====================================================================
1.1 bertrand 132: SUBROUTINE DLASQ5( I0, N0, Z, PP, TAU, DMIN, DMIN1, DMIN2, DN,
133: $ DNM1, DNM2, IEEE )
134: *
1.8 ! bertrand 135: * -- LAPACK computational routine (version 3.4.0) --
1.1 bertrand 136: * -- LAPACK is a software package provided by Univ. of Tennessee, --
137: * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
1.8 ! bertrand 138: * November 2011
1.1 bertrand 139: *
140: * .. Scalar Arguments ..
141: LOGICAL IEEE
142: INTEGER I0, N0, PP
143: DOUBLE PRECISION DMIN, DMIN1, DMIN2, DN, DNM1, DNM2, TAU
144: * ..
145: * .. Array Arguments ..
146: DOUBLE PRECISION Z( * )
147: * ..
148: *
149: * =====================================================================
150: *
151: * .. Parameter ..
152: DOUBLE PRECISION ZERO
153: PARAMETER ( ZERO = 0.0D0 )
154: * ..
155: * .. Local Scalars ..
156: INTEGER J4, J4P2
157: DOUBLE PRECISION D, EMIN, TEMP
158: * ..
159: * .. Intrinsic Functions ..
160: INTRINSIC MIN
161: * ..
162: * .. Executable Statements ..
163: *
164: IF( ( N0-I0-1 ).LE.0 )
165: $ RETURN
166: *
167: J4 = 4*I0 + PP - 3
168: EMIN = Z( J4+4 )
169: D = Z( J4 ) - TAU
170: DMIN = D
171: DMIN1 = -Z( J4 )
172: *
173: IF( IEEE ) THEN
174: *
175: * Code for IEEE arithmetic.
176: *
177: IF( PP.EQ.0 ) THEN
178: DO 10 J4 = 4*I0, 4*( N0-3 ), 4
179: Z( J4-2 ) = D + Z( J4-1 )
180: TEMP = Z( J4+1 ) / Z( J4-2 )
181: D = D*TEMP - TAU
182: DMIN = MIN( DMIN, D )
183: Z( J4 ) = Z( J4-1 )*TEMP
184: EMIN = MIN( Z( J4 ), EMIN )
185: 10 CONTINUE
186: ELSE
187: DO 20 J4 = 4*I0, 4*( N0-3 ), 4
188: Z( J4-3 ) = D + Z( J4 )
189: TEMP = Z( J4+2 ) / Z( J4-3 )
190: D = D*TEMP - TAU
191: DMIN = MIN( DMIN, D )
192: Z( J4-1 ) = Z( J4 )*TEMP
193: EMIN = MIN( Z( J4-1 ), EMIN )
194: 20 CONTINUE
195: END IF
196: *
197: * Unroll last two steps.
198: *
199: DNM2 = D
200: DMIN2 = DMIN
201: J4 = 4*( N0-2 ) - PP
202: J4P2 = J4 + 2*PP - 1
203: Z( J4-2 ) = DNM2 + Z( J4P2 )
204: Z( J4 ) = Z( J4P2+2 )*( Z( J4P2 ) / Z( J4-2 ) )
205: DNM1 = Z( J4P2+2 )*( DNM2 / Z( J4-2 ) ) - TAU
206: DMIN = MIN( DMIN, DNM1 )
207: *
208: DMIN1 = DMIN
209: J4 = J4 + 4
210: J4P2 = J4 + 2*PP - 1
211: Z( J4-2 ) = DNM1 + Z( J4P2 )
212: Z( J4 ) = Z( J4P2+2 )*( Z( J4P2 ) / Z( J4-2 ) )
213: DN = Z( J4P2+2 )*( DNM1 / Z( J4-2 ) ) - TAU
214: DMIN = MIN( DMIN, DN )
215: *
216: ELSE
217: *
218: * Code for non IEEE arithmetic.
219: *
220: IF( PP.EQ.0 ) THEN
221: DO 30 J4 = 4*I0, 4*( N0-3 ), 4
222: Z( J4-2 ) = D + Z( J4-1 )
223: IF( D.LT.ZERO ) THEN
224: RETURN
225: ELSE
226: Z( J4 ) = Z( J4+1 )*( Z( J4-1 ) / Z( J4-2 ) )
227: D = Z( J4+1 )*( D / Z( J4-2 ) ) - TAU
228: END IF
229: DMIN = MIN( DMIN, D )
230: EMIN = MIN( EMIN, Z( J4 ) )
231: 30 CONTINUE
232: ELSE
233: DO 40 J4 = 4*I0, 4*( N0-3 ), 4
234: Z( J4-3 ) = D + Z( J4 )
235: IF( D.LT.ZERO ) THEN
236: RETURN
237: ELSE
238: Z( J4-1 ) = Z( J4+2 )*( Z( J4 ) / Z( J4-3 ) )
239: D = Z( J4+2 )*( D / Z( J4-3 ) ) - TAU
240: END IF
241: DMIN = MIN( DMIN, D )
242: EMIN = MIN( EMIN, Z( J4-1 ) )
243: 40 CONTINUE
244: END IF
245: *
246: * Unroll last two steps.
247: *
248: DNM2 = D
249: DMIN2 = DMIN
250: J4 = 4*( N0-2 ) - PP
251: J4P2 = J4 + 2*PP - 1
252: Z( J4-2 ) = DNM2 + Z( J4P2 )
253: IF( DNM2.LT.ZERO ) THEN
254: RETURN
255: ELSE
256: Z( J4 ) = Z( J4P2+2 )*( Z( J4P2 ) / Z( J4-2 ) )
257: DNM1 = Z( J4P2+2 )*( DNM2 / Z( J4-2 ) ) - TAU
258: END IF
259: DMIN = MIN( DMIN, DNM1 )
260: *
261: DMIN1 = DMIN
262: J4 = J4 + 4
263: J4P2 = J4 + 2*PP - 1
264: Z( J4-2 ) = DNM1 + Z( J4P2 )
265: IF( DNM1.LT.ZERO ) THEN
266: RETURN
267: ELSE
268: Z( J4 ) = Z( J4P2+2 )*( Z( J4P2 ) / Z( J4-2 ) )
269: DN = Z( J4P2+2 )*( DNM1 / Z( J4-2 ) ) - TAU
270: END IF
271: DMIN = MIN( DMIN, DN )
272: *
273: END IF
274: *
275: Z( J4+2 ) = DN
276: Z( 4*N0-PP ) = EMIN
277: RETURN
278: *
279: * End of DLASQ5
280: *
281: END
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to dlasq5.f CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / lapack / lapack