1*> \brief \b SLASV2 computes the singular value decomposition 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 SLASV2 + dependencies
10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slasv2.f">
11*> [TGZ]</a>
12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slasv2.f">
13*> [ZIP]</a>
14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slasv2.f">
15*> [TXT]</a>
16*> \endhtmlonly
17*
18*  Definition:
19*  ===========
20*
21*       SUBROUTINE SLASV2( F, G, H, SSMIN, SSMAX, SNR, CSR, SNL, CSL )
22*
23*       .. Scalar Arguments ..
24*       REAL               CSL, CSR, F, G, H, SNL, SNR, SSMAX, SSMIN
25*       ..
26*
27*
28*> \par Purpose:
29*  =============
30*>
31*> \verbatim
32*>
33*> SLASV2 computes the singular value decomposition of a 2-by-2
34*> triangular matrix
35*>    [  F   G  ]
36*>    [  0   H  ].
37*> On return, abs(SSMAX) is the larger singular value, abs(SSMIN) is the
38*> smaller singular value, and (CSL,SNL) and (CSR,SNR) are the left and
39*> right singular vectors for abs(SSMAX), giving the decomposition
40*>
41*>    [ CSL  SNL ] [  F   G  ] [ CSR -SNR ]  =  [ SSMAX   0   ]
42*>    [-SNL  CSL ] [  0   H  ] [ SNR  CSR ]     [  0    SSMIN ].
43*> \endverbatim
44*
45*  Arguments:
46*  ==========
47*
48*> \param[in] F
49*> \verbatim
50*>          F is REAL
51*>          The (1,1) element of the 2-by-2 matrix.
52*> \endverbatim
53*>
54*> \param[in] G
55*> \verbatim
56*>          G is REAL
57*>          The (1,2) element of the 2-by-2 matrix.
58*> \endverbatim
59*>
60*> \param[in] H
61*> \verbatim
62*>          H is REAL
63*>          The (2,2) element of the 2-by-2 matrix.
64*> \endverbatim
65*>
66*> \param[out] SSMIN
67*> \verbatim
68*>          SSMIN is REAL
69*>          abs(SSMIN) is the smaller singular value.
70*> \endverbatim
71*>
72*> \param[out] SSMAX
73*> \verbatim
74*>          SSMAX is REAL
75*>          abs(SSMAX) is the larger singular value.
76*> \endverbatim
77*>
78*> \param[out] SNL
79*> \verbatim
80*>          SNL is REAL
81*> \endverbatim
82*>
83*> \param[out] CSL
84*> \verbatim
85*>          CSL is REAL
86*>          The vector (CSL, SNL) is a unit left singular vector for the
87*>          singular value abs(SSMAX).
88*> \endverbatim
89*>
90*> \param[out] SNR
91*> \verbatim
92*>          SNR is REAL
93*> \endverbatim
94*>
95*> \param[out] CSR
96*> \verbatim
97*>          CSR is REAL
98*>          The vector (CSR, SNR) is a unit right singular vector for the
99*>          singular value abs(SSMAX).
100*> \endverbatim
101*
102*  Authors:
103*  ========
104*
105*> \author Univ. of Tennessee
106*> \author Univ. of California Berkeley
107*> \author Univ. of Colorado Denver
108*> \author NAG Ltd.
109*
110*> \ingroup OTHERauxiliary
111*
112*> \par Further Details:
113*  =====================
114*>
115*> \verbatim
116*>
117*>  Any input parameter may be aliased with any output parameter.
118*>
119*>  Barring over/underflow and assuming a guard digit in subtraction, all
120*>  output quantities are correct to within a few units in the last
121*>  place (ulps).
122*>
123*>  In IEEE arithmetic, the code works correctly if one matrix element is
124*>  infinite.
125*>
126*>  Overflow will not occur unless the largest singular value itself
127*>  overflows or is within a few ulps of overflow. (On machines with
128*>  partial overflow, like the Cray, overflow may occur if the largest
129*>  singular value is within a factor of 2 of overflow.)
130*>
131*>  Underflow is harmless if underflow is gradual. Otherwise, results
132*>  may correspond to a matrix modified by perturbations of size near
133*>  the underflow threshold.
134*> \endverbatim
135*>
136*  =====================================================================
137      SUBROUTINE SLASV2( F, G, H, SSMIN, SSMAX, SNR, CSR, SNL, CSL )
138*
139*  -- LAPACK auxiliary routine --
140*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
141*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
142*
143*     .. Scalar Arguments ..
144      REAL               CSL, CSR, F, G, H, SNL, SNR, SSMAX, SSMIN
145*     ..
146*
147* =====================================================================
148*
149*     .. Parameters ..
150      REAL               ZERO
151      PARAMETER          ( ZERO = 0.0E0 )
152      REAL               HALF
153      PARAMETER          ( HALF = 0.5E0 )
154      REAL               ONE
155      PARAMETER          ( ONE = 1.0E0 )
156      REAL               TWO
157      PARAMETER          ( TWO = 2.0E0 )
158      REAL               FOUR
159      PARAMETER          ( FOUR = 4.0E0 )
160*     ..
161*     .. Local Scalars ..
162      LOGICAL            GASMAL, SWAP
163      INTEGER            PMAX
164      REAL               A, CLT, CRT, D, FA, FT, GA, GT, HA, HT, L, M,
165     $                   MM, R, S, SLT, SRT, T, TEMP, TSIGN, TT
166*     ..
167*     .. Intrinsic Functions ..
168      INTRINSIC          ABS, SIGN, SQRT
169*     ..
170*     .. External Functions ..
171      REAL               SLAMCH
172      EXTERNAL           SLAMCH
173*     ..
174*     .. Executable Statements ..
175*
176      FT = F
177      FA = ABS( FT )
178      HT = H
179      HA = ABS( H )
180*
181*     PMAX points to the maximum absolute element of matrix
182*       PMAX = 1 if F largest in absolute values
183*       PMAX = 2 if G largest in absolute values
184*       PMAX = 3 if H largest in absolute values
185*
186      PMAX = 1
187      SWAP = ( HA.GT.FA )
188      IF( SWAP ) THEN
189         PMAX = 3
190         TEMP = FT
191         FT = HT
192         HT = TEMP
193         TEMP = FA
194         FA = HA
195         HA = TEMP
196*
197*        Now FA .ge. HA
198*
199      END IF
200      GT = G
201      GA = ABS( GT )
202      IF( GA.EQ.ZERO ) THEN
203*
204*        Diagonal matrix
205*
206         SSMIN = HA
207         SSMAX = FA
208         CLT = ONE
209         CRT = ONE
210         SLT = ZERO
211         SRT = ZERO
212      ELSE
213         GASMAL = .TRUE.
214         IF( GA.GT.FA ) THEN
215            PMAX = 2
216            IF( ( FA / GA ).LT.SLAMCH( 'EPS' ) ) THEN
217*
218*              Case of very large GA
219*
220               GASMAL = .FALSE.
221               SSMAX = GA
222               IF( HA.GT.ONE ) THEN
223                  SSMIN = FA / ( GA / HA )
224               ELSE
225                  SSMIN = ( FA / GA )*HA
226               END IF
227               CLT = ONE
228               SLT = HT / GT
229               SRT = ONE
230               CRT = FT / GT
231            END IF
232         END IF
233         IF( GASMAL ) THEN
234*
235*           Normal case
236*
237            D = FA - HA
238            IF( D.EQ.FA ) THEN
239*
240*              Copes with infinite F or H
241*
242               L = ONE
243            ELSE
244               L = D / FA
245            END IF
246*
247*           Note that 0 .le. L .le. 1
248*
249            M = GT / FT
250*
251*           Note that abs(M) .le. 1/macheps
252*
253            T = TWO - L
254*
255*           Note that T .ge. 1
256*
257            MM = M*M
258            TT = T*T
259            S = SQRT( TT+MM )
260*
261*           Note that 1 .le. S .le. 1 + 1/macheps
262*
263            IF( L.EQ.ZERO ) THEN
264               R = ABS( M )
265            ELSE
266               R = SQRT( L*L+MM )
267            END IF
268*
269*           Note that 0 .le. R .le. 1 + 1/macheps
270*
271            A = HALF*( S+R )
272*
273*           Note that 1 .le. A .le. 1 + abs(M)
274*
275            SSMIN = HA / A
276            SSMAX = FA*A
277            IF( MM.EQ.ZERO ) THEN
278*
279*              Note that M is very tiny
280*
281               IF( L.EQ.ZERO ) THEN
282                  T = SIGN( TWO, FT )*SIGN( ONE, GT )
283               ELSE
284                  T = GT / SIGN( D, FT ) + M / T
285               END IF
286            ELSE
287               T = ( M / ( S+T )+M / ( R+L ) )*( ONE+A )
288            END IF
289            L = SQRT( T*T+FOUR )
290            CRT = TWO / L
291            SRT = T / L
292            CLT = ( CRT+SRT*M ) / A
293            SLT = ( HT / FT )*SRT / A
294         END IF
295      END IF
296      IF( SWAP ) THEN
297         CSL = SRT
298         SNL = CRT
299         CSR = SLT
300         SNR = CLT
301      ELSE
302         CSL = CLT
303         SNL = SLT
304         CSR = CRT
305         SNR = SRT
306      END IF
307*
308*     Correct signs of SSMAX and SSMIN
309*
310      IF( PMAX.EQ.1 )
311     $   TSIGN = SIGN( ONE, CSR )*SIGN( ONE, CSL )*SIGN( ONE, F )
312      IF( PMAX.EQ.2 )
313     $   TSIGN = SIGN( ONE, SNR )*SIGN( ONE, CSL )*SIGN( ONE, G )
314      IF( PMAX.EQ.3 )
315     $   TSIGN = SIGN( ONE, SNR )*SIGN( ONE, SNL )*SIGN( ONE, H )
316      SSMAX = SIGN( SSMAX, TSIGN )
317      SSMIN = SIGN( SSMIN, TSIGN*SIGN( ONE, F )*SIGN( ONE, H ) )
318      RETURN
319*
320*     End of SLASV2
321*
322      END
323