LAPACK  3.6.1 LAPACK: Linear Algebra PACKage
slas2.f
Go to the documentation of this file.
1 *> \brief \b SLAS2 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
10 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slas2.f">
11 *> [TGZ]</a>
12 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slas2.f">
13 *> [ZIP]</a>
14 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slas2.f">
15 *> [TXT]</a>
16 *> \endhtmlonly
17 *
18 * Definition:
19 * ===========
20 *
21 * SUBROUTINE SLAS2( F, G, H, SSMIN, SSMAX )
22 *
23 * .. Scalar Arguments ..
24 * REAL F, G, H, SSMAX, SSMIN
25 * ..
26 *
27 *
28 *> \par Purpose:
29 * =============
30 *>
31 *> \verbatim
32 *>
33 *> SLAS2 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 REAL
46 *> The (1,1) element of the 2-by-2 matrix.
47 *> \endverbatim
48 *>
49 *> \param[in] G
50 *> \verbatim
51 *> G is REAL
52 *> The (1,2) element of the 2-by-2 matrix.
53 *> \endverbatim
54 *>
55 *> \param[in] H
56 *> \verbatim
57 *> H is REAL
58 *> The (2,2) element of the 2-by-2 matrix.
59 *> \endverbatim
60 *>
61 *> \param[out] SSMIN
62 *> \verbatim
63 *> SSMIN is REAL
64 *> The smaller singular value.
65 *> \endverbatim
66 *>
67 *> \param[out] SSMAX
68 *> \verbatim
69 *> SSMAX is REAL
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 *> \date September 2012
82 *
83 *> \ingroup auxOTHERauxiliary
84 *
85 *> \par Further Details:
86 * =====================
87 *>
88 *> \verbatim
89 *>
90 *> Barring over/underflow, all output quantities are correct to within
91 *> a few units in the last place (ulps), even in the absence of a guard
93 *>
94 *> In IEEE arithmetic, the code works correctly if one matrix element is
95 *> infinite.
96 *>
97 *> Overflow will not occur unless the largest singular value itself
98 *> overflows, or is within a few ulps of overflow. (On machines with
99 *> partial overflow, like the Cray, overflow may occur if the largest
100 *> singular value is within a factor of 2 of overflow.)
101 *>
102 *> Underflow is harmless if underflow is gradual. Otherwise, results
103 *> may correspond to a matrix modified by perturbations of size near
104 *> the underflow threshold.
105 *> \endverbatim
106 *>
107 * =====================================================================
108  SUBROUTINE slas2( F, G, H, SSMIN, SSMAX )
109 *
110 * -- LAPACK auxiliary routine (version 3.4.2) --
111 * -- LAPACK is a software package provided by Univ. of Tennessee, --
112 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
113 * September 2012
114 *
115 * .. Scalar Arguments ..
116  REAL F, G, H, SSMAX, SSMIN
117 * ..
118 *
119 * ====================================================================
120 *
121 * .. Parameters ..
122  REAL ZERO
123  parameter ( zero = 0.0e0 )
124  REAL ONE
125  parameter ( one = 1.0e0 )
126  REAL TWO
127  parameter ( two = 2.0e0 )
128 * ..
129 * .. Local Scalars ..
130  REAL AS, AT, AU, C, FA, FHMN, FHMX, GA, HA
131 * ..
132 * .. Intrinsic Functions ..
133  INTRINSIC abs, max, min, sqrt
134 * ..
135 * .. Executable Statements ..
136 *
137  fa = abs( f )
138  ga = abs( g )
139  ha = abs( h )
140  fhmn = min( fa, ha )
141  fhmx = max( fa, ha )
142  IF( fhmn.EQ.zero ) THEN
143  ssmin = zero
144  IF( fhmx.EQ.zero ) THEN
145  ssmax = ga
146  ELSE
147  ssmax = max( fhmx, ga )*sqrt( one+
148  \$ ( min( fhmx, ga ) / max( fhmx, ga ) )**2 )
149  END IF
150  ELSE
151  IF( ga.LT.fhmx ) THEN
152  as = one + fhmn / fhmx
153  at = ( fhmx-fhmn ) / fhmx
154  au = ( ga / fhmx )**2
155  c = two / ( sqrt( as*as+au )+sqrt( at*at+au ) )
156  ssmin = fhmn*c
157  ssmax = fhmx / c
158  ELSE
159  au = fhmx / ga
160  IF( au.EQ.zero ) THEN
161 *
162 * Avoid possible harmful underflow if exponent range
163 * asymmetric (true SSMIN may not underflow even if
164 * AU underflows)
165 *
166  ssmin = ( fhmn*fhmx ) / ga
167  ssmax = ga
168  ELSE
169  as = one + fhmn / fhmx
170  at = ( fhmx-fhmn ) / fhmx
171  c = one / ( sqrt( one+( as*au )**2 )+
172  \$ sqrt( one+( at*au )**2 ) )
173  ssmin = ( fhmn*c )*au
174  ssmin = ssmin + ssmin
175  ssmax = ga / ( c+c )
176  END IF
177  END IF
178  END IF
179  RETURN
180 *
181 * End of SLAS2
182 *
183  END
subroutine slas2(F, G, H, SSMIN, SSMAX)
SLAS2 computes singular values of a 2-by-2 triangular matrix.
Definition: slas2.f:109