1: *> \brief \b DLAS2 computes singular values of a 2-by-2 triangular matrix.
2: *
3: * =========== DOCUMENTATION ===========
4: *
5: * Online html documentation available at
6: * http://www.netlib.org/lapack/explore-html/
7: *
8: *> \htmlonly
9: *> Download DLAS2 + dependencies
10: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlas2.f">
11: *> [TGZ]</a>
12: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlas2.f">
13: *> [ZIP]</a>
14: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlas2.f">
15: *> [TXT]</a>
16: *> \endhtmlonly
17: *
18: * Definition:
19: * ===========
20: *
21: * SUBROUTINE DLAS2( F, G, H, SSMIN, SSMAX )
22: *
23: * .. Scalar Arguments ..
24: * DOUBLE PRECISION F, G, H, SSMAX, SSMIN
25: * ..
26: *
27: *
28: *> \par Purpose:
29: * =============
30: *>
31: *> \verbatim
32: *>
33: *> DLAS2 computes the singular values of the 2-by-2 matrix
34: *> [ F G ]
35: *> [ 0 H ].
36: *> On return, SSMIN is the smaller singular value and SSMAX is the
37: *> larger singular value.
38: *> \endverbatim
39: *
40: * Arguments:
41: * ==========
42: *
43: *> \param[in] F
44: *> \verbatim
45: *> F is DOUBLE PRECISION
46: *> The (1,1) element of the 2-by-2 matrix.
47: *> \endverbatim
48: *>
49: *> \param[in] G
50: *> \verbatim
51: *> G is DOUBLE PRECISION
52: *> The (1,2) element of the 2-by-2 matrix.
53: *> \endverbatim
54: *>
55: *> \param[in] H
56: *> \verbatim
57: *> H is DOUBLE PRECISION
58: *> The (2,2) element of the 2-by-2 matrix.
59: *> \endverbatim
60: *>
61: *> \param[out] SSMIN
62: *> \verbatim
63: *> SSMIN is DOUBLE PRECISION
64: *> The smaller singular value.
65: *> \endverbatim
66: *>
67: *> \param[out] SSMAX
68: *> \verbatim
69: *> SSMAX is DOUBLE PRECISION
70: *> The larger singular value.
71: *> \endverbatim
72: *
73: * Authors:
74: * ========
75: *
76: *> \author Univ. of Tennessee
77: *> \author Univ. of California Berkeley
78: *> \author Univ. of Colorado Denver
79: *> \author NAG Ltd.
80: *
81: *> \ingroup OTHERauxiliary
82: *
83: *> \par Further Details:
84: * =====================
85: *>
86: *> \verbatim
87: *>
88: *> Barring over/underflow, all output quantities are correct to within
89: *> a few units in the last place (ulps), even in the absence of a guard
90: *> digit in addition/subtraction.
91: *>
92: *> In IEEE arithmetic, the code works correctly if one matrix element is
93: *> infinite.
94: *>
95: *> Overflow will not occur unless the largest singular value itself
96: *> overflows, or is within a few ulps of overflow. (On machines with
97: *> partial overflow, like the Cray, overflow may occur if the largest
98: *> singular value is within a factor of 2 of overflow.)
99: *>
100: *> Underflow is harmless if underflow is gradual. Otherwise, results
101: *> may correspond to a matrix modified by perturbations of size near
102: *> the underflow threshold.
103: *> \endverbatim
104: *>
105: * =====================================================================
106: SUBROUTINE DLAS2( F, G, H, SSMIN, SSMAX )
107: *
108: * -- LAPACK auxiliary routine --
109: * -- LAPACK is a software package provided by Univ. of Tennessee, --
110: * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
111: *
112: * .. Scalar Arguments ..
113: DOUBLE PRECISION F, G, H, SSMAX, SSMIN
114: * ..
115: *
116: * ====================================================================
117: *
118: * .. Parameters ..
119: DOUBLE PRECISION ZERO
120: PARAMETER ( ZERO = 0.0D0 )
121: DOUBLE PRECISION ONE
122: PARAMETER ( ONE = 1.0D0 )
123: DOUBLE PRECISION TWO
124: PARAMETER ( TWO = 2.0D0 )
125: * ..
126: * .. Local Scalars ..
127: DOUBLE PRECISION AS, AT, AU, C, FA, FHMN, FHMX, GA, HA
128: * ..
129: * .. Intrinsic Functions ..
130: INTRINSIC ABS, MAX, MIN, SQRT
131: * ..
132: * .. Executable Statements ..
133: *
134: FA = ABS( F )
135: GA = ABS( G )
136: HA = ABS( H )
137: FHMN = MIN( FA, HA )
138: FHMX = MAX( FA, HA )
139: IF( FHMN.EQ.ZERO ) THEN
140: SSMIN = ZERO
141: IF( FHMX.EQ.ZERO ) THEN
142: SSMAX = GA
143: ELSE
144: SSMAX = MAX( FHMX, GA )*SQRT( ONE+
145: $ ( MIN( FHMX, GA ) / MAX( FHMX, GA ) )**2 )
146: END IF
147: ELSE
148: IF( GA.LT.FHMX ) THEN
149: AS = ONE + FHMN / FHMX
150: AT = ( FHMX-FHMN ) / FHMX
151: AU = ( GA / FHMX )**2
152: C = TWO / ( SQRT( AS*AS+AU )+SQRT( AT*AT+AU ) )
153: SSMIN = FHMN*C
154: SSMAX = FHMX / C
155: ELSE
156: AU = FHMX / GA
157: IF( AU.EQ.ZERO ) THEN
158: *
159: * Avoid possible harmful underflow if exponent range
160: * asymmetric (true SSMIN may not underflow even if
161: * AU underflows)
162: *
163: SSMIN = ( FHMN*FHMX ) / GA
164: SSMAX = GA
165: ELSE
166: AS = ONE + FHMN / FHMX
167: AT = ( FHMX-FHMN ) / FHMX
168: C = ONE / ( SQRT( ONE+( AS*AU )**2 )+
169: $ SQRT( ONE+( AT*AU )**2 ) )
170: SSMIN = ( FHMN*C )*AU
171: SSMIN = SSMIN + SSMIN
172: SSMAX = GA / ( C+C )
173: END IF
174: END IF
175: END IF
176: RETURN
177: *
178: * End of DLAS2
179: *
180: END
CVSweb interface <joel.bertrand@systella.fr>