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
9*> Download SLAS2 + dependencies
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*> \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 SLAS2( 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      REAL               F, G, H, SSMAX, SSMIN
114*     ..
115*
116*  ====================================================================
117*
118*     .. Parameters ..
119      REAL               ZERO
120      PARAMETER          ( ZERO = 0.0E0 )
121      REAL               ONE
122      PARAMETER          ( ONE = 1.0E0 )
123      REAL               TWO
124      PARAMETER          ( TWO = 2.0E0 )
125*     ..
126*     .. Local Scalars ..
127      REAL               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 SLAS2
179*
180      END
181