![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b SLAS2 00002 * 00003 * =========== DOCUMENTATION =========== 00004 * 00005 * Online html documentation available at 00006 * http://www.netlib.org/lapack/explore-html/ 00007 * 00008 *> \htmlonly 00009 *> Download SLAS2 + dependencies 00010 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slas2.f"> 00011 *> [TGZ]</a> 00012 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slas2.f"> 00013 *> [ZIP]</a> 00014 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slas2.f"> 00015 *> [TXT]</a> 00016 *> \endhtmlonly 00017 * 00018 * Definition: 00019 * =========== 00020 * 00021 * SUBROUTINE SLAS2( F, G, H, SSMIN, SSMAX ) 00022 * 00023 * .. Scalar Arguments .. 00024 * REAL F, G, H, SSMAX, SSMIN 00025 * .. 00026 * 00027 * 00028 *> \par Purpose: 00029 * ============= 00030 *> 00031 *> \verbatim 00032 *> 00033 *> SLAS2 computes the singular values of the 2-by-2 matrix 00034 *> [ F G ] 00035 *> [ 0 H ]. 00036 *> On return, SSMIN is the smaller singular value and SSMAX is the 00037 *> larger singular value. 00038 *> \endverbatim 00039 * 00040 * Arguments: 00041 * ========== 00042 * 00043 *> \param[in] F 00044 *> \verbatim 00045 *> F is REAL 00046 *> The (1,1) element of the 2-by-2 matrix. 00047 *> \endverbatim 00048 *> 00049 *> \param[in] G 00050 *> \verbatim 00051 *> G is REAL 00052 *> The (1,2) element of the 2-by-2 matrix. 00053 *> \endverbatim 00054 *> 00055 *> \param[in] H 00056 *> \verbatim 00057 *> H is REAL 00058 *> The (2,2) element of the 2-by-2 matrix. 00059 *> \endverbatim 00060 *> 00061 *> \param[out] SSMIN 00062 *> \verbatim 00063 *> SSMIN is REAL 00064 *> The smaller singular value. 00065 *> \endverbatim 00066 *> 00067 *> \param[out] SSMAX 00068 *> \verbatim 00069 *> SSMAX is REAL 00070 *> The larger singular value. 00071 *> \endverbatim 00072 * 00073 * Authors: 00074 * ======== 00075 * 00076 *> \author Univ. of Tennessee 00077 *> \author Univ. of California Berkeley 00078 *> \author Univ. of Colorado Denver 00079 *> \author NAG Ltd. 00080 * 00081 *> \date November 2011 00082 * 00083 *> \ingroup auxOTHERauxiliary 00084 * 00085 *> \par Further Details: 00086 * ===================== 00087 *> 00088 *> \verbatim 00089 *> 00090 *> Barring over/underflow, all output quantities are correct to within 00091 *> a few units in the last place (ulps), even in the absence of a guard 00092 *> digit in addition/subtraction. 00093 *> 00094 *> In IEEE arithmetic, the code works correctly if one matrix element is 00095 *> infinite. 00096 *> 00097 *> Overflow will not occur unless the largest singular value itself 00098 *> overflows, or is within a few ulps of overflow. (On machines with 00099 *> partial overflow, like the Cray, overflow may occur if the largest 00100 *> singular value is within a factor of 2 of overflow.) 00101 *> 00102 *> Underflow is harmless if underflow is gradual. Otherwise, results 00103 *> may correspond to a matrix modified by perturbations of size near 00104 *> the underflow threshold. 00105 *> \endverbatim 00106 *> 00107 * ===================================================================== 00108 SUBROUTINE SLAS2( F, G, H, SSMIN, SSMAX ) 00109 * 00110 * -- LAPACK auxiliary routine (version 3.4.0) -- 00111 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00112 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00113 * November 2011 00114 * 00115 * .. Scalar Arguments .. 00116 REAL F, G, H, SSMAX, SSMIN 00117 * .. 00118 * 00119 * ==================================================================== 00120 * 00121 * .. Parameters .. 00122 REAL ZERO 00123 PARAMETER ( ZERO = 0.0E0 ) 00124 REAL ONE 00125 PARAMETER ( ONE = 1.0E0 ) 00126 REAL TWO 00127 PARAMETER ( TWO = 2.0E0 ) 00128 * .. 00129 * .. Local Scalars .. 00130 REAL AS, AT, AU, C, FA, FHMN, FHMX, GA, HA 00131 * .. 00132 * .. Intrinsic Functions .. 00133 INTRINSIC ABS, MAX, MIN, SQRT 00134 * .. 00135 * .. Executable Statements .. 00136 * 00137 FA = ABS( F ) 00138 GA = ABS( G ) 00139 HA = ABS( H ) 00140 FHMN = MIN( FA, HA ) 00141 FHMX = MAX( FA, HA ) 00142 IF( FHMN.EQ.ZERO ) THEN 00143 SSMIN = ZERO 00144 IF( FHMX.EQ.ZERO ) THEN 00145 SSMAX = GA 00146 ELSE 00147 SSMAX = MAX( FHMX, GA )*SQRT( ONE+ 00148 $ ( MIN( FHMX, GA ) / MAX( FHMX, GA ) )**2 ) 00149 END IF 00150 ELSE 00151 IF( GA.LT.FHMX ) THEN 00152 AS = ONE + FHMN / FHMX 00153 AT = ( FHMX-FHMN ) / FHMX 00154 AU = ( GA / FHMX )**2 00155 C = TWO / ( SQRT( AS*AS+AU )+SQRT( AT*AT+AU ) ) 00156 SSMIN = FHMN*C 00157 SSMAX = FHMX / C 00158 ELSE 00159 AU = FHMX / GA 00160 IF( AU.EQ.ZERO ) THEN 00161 * 00162 * Avoid possible harmful underflow if exponent range 00163 * asymmetric (true SSMIN may not underflow even if 00164 * AU underflows) 00165 * 00166 SSMIN = ( FHMN*FHMX ) / GA 00167 SSMAX = GA 00168 ELSE 00169 AS = ONE + FHMN / FHMX 00170 AT = ( FHMX-FHMN ) / FHMX 00171 C = ONE / ( SQRT( ONE+( AS*AU )**2 )+ 00172 $ SQRT( ONE+( AT*AU )**2 ) ) 00173 SSMIN = ( FHMN*C )*AU 00174 SSMIN = SSMIN + SSMIN 00175 SSMAX = GA / ( C+C ) 00176 END IF 00177 END IF 00178 END IF 00179 RETURN 00180 * 00181 * End of SLAS2 00182 * 00183 END