slasv2()

subroutine slasv2	(	real	f,
		real	g,
		real	h,
		real	ssmin,
		real	ssmax,
		real	snr,
		real	csr,
		real	snl,
		real	csl
	)

SLASV2 computes the singular value decomposition of a 2-by-2 triangular matrix.

Download SLASV2 + dependencies [TGZ] [ZIP] [TXT]

Purpose:

 SLASV2 computes the singular value decomposition of a 2-by-2
 triangular matrix
    [  F   G  ]
    [  0   H  ].
 On return, abs(SSMAX) is the larger singular value, abs(SSMIN) is the
 smaller singular value, and (CSL,SNL) and (CSR,SNR) are the left and
 right singular vectors for abs(SSMAX), giving the decomposition

    [ CSL  SNL ] [  F   G  ] [ CSR -SNR ]  =  [ SSMAX   0   ]
    [-SNL  CSL ] [  0   H  ] [ SNR  CSR ]     [  0    SSMIN ].

Parameters

[in]	F	F is REAL The (1,1) element of the 2-by-2 matrix.
[in]	G	G is REAL The (1,2) element of the 2-by-2 matrix.
[in]	H	H is REAL The (2,2) element of the 2-by-2 matrix.
[out]	SSMIN	SSMIN is REAL abs(SSMIN) is the smaller singular value.
[out]	SSMAX	SSMAX is REAL abs(SSMAX) is the larger singular value.
[out]	SNL	SNL is REAL
[out]	CSL	CSL is REAL The vector (CSL, SNL) is a unit left singular vector for the singular value abs(SSMAX).
[out]	SNR	SNR is REAL
[out]	CSR	CSR is REAL The vector (CSR, SNR) is a unit right singular vector for the singular value abs(SSMAX).

Author

Univ. of Tennessee

Univ. of California Berkeley

Univ. of Colorado Denver

NAG Ltd.

Further Details:

  Any input parameter may be aliased with any output parameter.

  Barring over/underflow and assuming a guard digit in subtraction, all
  output quantities are correct to within a few units in the last
  place (ulps).

  In IEEE arithmetic, the code works correctly if one matrix element is
  infinite.

  Overflow will not occur unless the largest singular value itself
  overflows or is within a few ulps of overflow.

  Underflow is harmless if underflow is gradual. Otherwise, results
  may correspond to a matrix modified by perturbations of size near
  the underflow threshold.

Definition at line 135 of file slasv2.f.

*
*  -- LAPACK auxiliary routine --
*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
*
*     .. Scalar Arguments ..
      REAL               CSL, CSR, F, G, H, SNL, SNR, SSMAX, SSMIN
*     ..
*
* =====================================================================
*
*     .. Parameters ..
      REAL               ZERO
      parameter( zero = 0.0e0 )
      REAL               HALF
      parameter( half = 0.5e0 )
      REAL               ONE
      parameter( one = 1.0e0 )
      REAL               TWO
      parameter( two = 2.0e0 )
      REAL               FOUR
      parameter( four = 4.0e0 )
*     ..
*     .. Local Scalars ..
      LOGICAL            GASMAL, SWAP
      INTEGER            PMAX
      REAL               A, CLT, CRT, D, FA, FT, GA, GT, HA, HT, L, M,
     $                   MM, R, S, SLT, SRT, T, TEMP, TSIGN, TT
*     ..
*     .. Intrinsic Functions ..
      INTRINSIC          abs, sign, sqrt
*     ..
*     .. External Functions ..
      REAL               SLAMCH
      EXTERNAL           slamch
*     ..
*     .. Executable Statements ..
*
      ft = f
      fa = abs( ft )
      ht = h
      ha = abs( h )
*
*     PMAX points to the maximum absolute element of matrix
*       PMAX = 1 if F largest in absolute values
*       PMAX = 2 if G largest in absolute values
*       PMAX = 3 if H largest in absolute values
*
      pmax = 1
      swap = ( ha.GT.fa )
      IF( swap ) THEN
         pmax = 3
         temp = ft
         ft = ht
         ht = temp
         temp = fa
         fa = ha
         ha = temp
*
*        Now FA .ge. HA
*
      END IF
      gt = g
      ga = abs( gt )
      IF( ga.EQ.zero ) THEN
*
*        Diagonal matrix
*
         ssmin = ha
         ssmax = fa
         clt = one
         crt = one
         slt = zero
         srt = zero
      ELSE
         gasmal = .true.
         IF( ga.GT.fa ) THEN
            pmax = 2
            IF( ( fa / ga ).LT.slamch( 'EPS' ) ) THEN
*
*              Case of very large GA
*
               gasmal = .false.
               ssmax = ga
               IF( ha.GT.one ) THEN
                  ssmin = fa / ( ga / ha )
               ELSE
                  ssmin = ( fa / ga )*ha
               END IF
               clt = one
               slt = ht / gt
               srt = one
               crt = ft / gt
            END IF
         END IF
         IF( gasmal ) THEN
*
*           Normal case
*
            d = fa - ha
            IF( d.EQ.fa ) THEN
*
*              Copes with infinite F or H
*
               l = one
            ELSE
               l = d / fa
            END IF
*
*           Note that 0 .le. L .le. 1
*
            m = gt / ft
*
*           Note that abs(M) .le. 1/macheps
*
            t = two - l
*
*           Note that T .ge. 1
*
            mm = m*m
            tt = t*t
            s = sqrt( tt+mm )
*
*           Note that 1 .le. S .le. 1 + 1/macheps
*
            IF( l.EQ.zero ) THEN
               r = abs( m )
            ELSE
               r = sqrt( l*l+mm )
            END IF
*
*           Note that 0 .le. R .le. 1 + 1/macheps
*
            a = half*( s+r )
*
*           Note that 1 .le. A .le. 1 + abs(M)
*
            ssmin = ha / a
            ssmax = fa*a
            IF( mm.EQ.zero ) THEN
*
*              Note that M is very tiny
*
               IF( l.EQ.zero ) THEN
                  t = sign( two, ft )*sign( one, gt )
               ELSE
                  t = gt / sign( d, ft ) + m / t
               END IF
            ELSE
               t = ( m / ( s+t )+m / ( r+l ) )*( one+a )
            END IF
            l = sqrt( t*t+four )
            crt = two / l
            srt = t / l
            clt = ( crt+srt*m ) / a
            slt = ( ht / ft )*srt / a
         END IF
      END IF
      IF( swap ) THEN
         csl = srt
         snl = crt
         csr = slt
         snr = clt
      ELSE
         csl = clt
         snl = slt
         csr = crt
         snr = srt
      END IF
*
*     Correct signs of SSMAX and SSMIN
*
      IF( pmax.EQ.1 )
     $   tsign = sign( one, csr )*sign( one, csl )*sign( one, f )
      IF( pmax.EQ.2 )
     $   tsign = sign( one, snr )*sign( one, csl )*sign( one, g )
      IF( pmax.EQ.3 )
     $   tsign = sign( one, snr )*sign( one, snl )*sign( one, h )
      ssmax = sign( ssmax, tsign )
      ssmin = sign( ssmin, tsign*sign( one, f )*sign( one, h ) )
      RETURN
*
*     End of SLASV2
*

Here is the caller graph for this function: