LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
slanv2.f
Go to the documentation of this file.
00001 *> \brief \b SLANV2
00002 *
00003 *  =========== DOCUMENTATION ===========
00004 *
00005 * Online html documentation available at 
00006 *            http://www.netlib.org/lapack/explore-html/ 
00007 *
00008 *> \htmlonly
00009 *> Download SLANV2 + dependencies 
00010 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slanv2.f"> 
00011 *> [TGZ]</a> 
00012 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slanv2.f"> 
00013 *> [ZIP]</a> 
00014 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slanv2.f"> 
00015 *> [TXT]</a>
00016 *> \endhtmlonly 
00017 *
00018 *  Definition:
00019 *  ===========
00020 *
00021 *       SUBROUTINE SLANV2( A, B, C, D, RT1R, RT1I, RT2R, RT2I, CS, SN )
00022 * 
00023 *       .. Scalar Arguments ..
00024 *       REAL               A, B, C, CS, D, RT1I, RT1R, RT2I, RT2R, SN
00025 *       ..
00026 *  
00027 *
00028 *> \par Purpose:
00029 *  =============
00030 *>
00031 *> \verbatim
00032 *>
00033 *> SLANV2 computes the Schur factorization of a real 2-by-2 nonsymmetric
00034 *> matrix in standard form:
00035 *>
00036 *>      [ A  B ] = [ CS -SN ] [ AA  BB ] [ CS  SN ]
00037 *>      [ C  D ]   [ SN  CS ] [ CC  DD ] [-SN  CS ]
00038 *>
00039 *> where either
00040 *> 1) CC = 0 so that AA and DD are real eigenvalues of the matrix, or
00041 *> 2) AA = DD and BB*CC < 0, so that AA + or - sqrt(BB*CC) are complex
00042 *> conjugate eigenvalues.
00043 *> \endverbatim
00044 *
00045 *  Arguments:
00046 *  ==========
00047 *
00048 *> \param[in,out] A
00049 *> \verbatim
00050 *>          A is REAL
00051 *> \endverbatim
00052 *>
00053 *> \param[in,out] B
00054 *> \verbatim
00055 *>          B is REAL
00056 *> \endverbatim
00057 *>
00058 *> \param[in,out] C
00059 *> \verbatim
00060 *>          C is REAL
00061 *> \endverbatim
00062 *>
00063 *> \param[in,out] D
00064 *> \verbatim
00065 *>          D is REAL
00066 *>          On entry, the elements of the input matrix.
00067 *>          On exit, they are overwritten by the elements of the
00068 *>          standardised Schur form.
00069 *> \endverbatim
00070 *>
00071 *> \param[out] RT1R
00072 *> \verbatim
00073 *>          RT1R is REAL
00074 *> \endverbatim
00075 *>
00076 *> \param[out] RT1I
00077 *> \verbatim
00078 *>          RT1I is REAL
00079 *> \endverbatim
00080 *>
00081 *> \param[out] RT2R
00082 *> \verbatim
00083 *>          RT2R is REAL
00084 *> \endverbatim
00085 *>
00086 *> \param[out] RT2I
00087 *> \verbatim
00088 *>          RT2I is REAL
00089 *>          The real and imaginary parts of the eigenvalues. If the
00090 *>          eigenvalues are a complex conjugate pair, RT1I > 0.
00091 *> \endverbatim
00092 *>
00093 *> \param[out] CS
00094 *> \verbatim
00095 *>          CS is REAL
00096 *> \endverbatim
00097 *>
00098 *> \param[out] SN
00099 *> \verbatim
00100 *>          SN is REAL
00101 *>          Parameters of the rotation matrix.
00102 *> \endverbatim
00103 *
00104 *  Authors:
00105 *  ========
00106 *
00107 *> \author Univ. of Tennessee 
00108 *> \author Univ. of California Berkeley 
00109 *> \author Univ. of Colorado Denver 
00110 *> \author NAG Ltd. 
00111 *
00112 *> \date November 2011
00113 *
00114 *> \ingroup realOTHERauxiliary
00115 *
00116 *> \par Further Details:
00117 *  =====================
00118 *>
00119 *> \verbatim
00120 *>
00121 *>  Modified by V. Sima, Research Institute for Informatics, Bucharest,
00122 *>  Romania, to reduce the risk of cancellation errors,
00123 *>  when computing real eigenvalues, and to ensure, if possible, that
00124 *>  abs(RT1R) >= abs(RT2R).
00125 *> \endverbatim
00126 *>
00127 *  =====================================================================
00128       SUBROUTINE SLANV2( A, B, C, D, RT1R, RT1I, RT2R, RT2I, CS, SN )
00129 *
00130 *  -- LAPACK auxiliary routine (version 3.4.0) --
00131 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00132 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00133 *     November 2011
00134 *
00135 *     .. Scalar Arguments ..
00136       REAL               A, B, C, CS, D, RT1I, RT1R, RT2I, RT2R, SN
00137 *     ..
00138 *
00139 *  =====================================================================
00140 *
00141 *     .. Parameters ..
00142       REAL               ZERO, HALF, ONE
00143       PARAMETER          ( ZERO = 0.0E+0, HALF = 0.5E+0, ONE = 1.0E+0 )
00144       REAL               MULTPL
00145       PARAMETER          ( MULTPL = 4.0E+0 )
00146 *     ..
00147 *     .. Local Scalars ..
00148       REAL               AA, BB, BCMAX, BCMIS, CC, CS1, DD, EPS, P, SAB,
00149      $                   SAC, SCALE, SIGMA, SN1, TAU, TEMP, Z
00150 *     ..
00151 *     .. External Functions ..
00152       REAL               SLAMCH, SLAPY2
00153       EXTERNAL           SLAMCH, SLAPY2
00154 *     ..
00155 *     .. Intrinsic Functions ..
00156       INTRINSIC          ABS, MAX, MIN, SIGN, SQRT
00157 *     ..
00158 *     .. Executable Statements ..
00159 *
00160       EPS = SLAMCH( 'P' )
00161       IF( C.EQ.ZERO ) THEN
00162          CS = ONE
00163          SN = ZERO
00164          GO TO 10
00165 *
00166       ELSE IF( B.EQ.ZERO ) THEN
00167 *
00168 *        Swap rows and columns
00169 *
00170          CS = ZERO
00171          SN = ONE
00172          TEMP = D
00173          D = A
00174          A = TEMP
00175          B = -C
00176          C = ZERO
00177          GO TO 10
00178       ELSE IF( (A-D).EQ.ZERO .AND. SIGN( ONE, B ).NE.
00179      $   SIGN( ONE, C ) ) THEN
00180          CS = ONE
00181          SN = ZERO
00182          GO TO 10
00183       ELSE
00184 *
00185          TEMP = A - D
00186          P = HALF*TEMP
00187          BCMAX = MAX( ABS( B ), ABS( C ) )
00188          BCMIS = MIN( ABS( B ), ABS( C ) )*SIGN( ONE, B )*SIGN( ONE, C )
00189          SCALE = MAX( ABS( P ), BCMAX )
00190          Z = ( P / SCALE )*P + ( BCMAX / SCALE )*BCMIS
00191 *
00192 *        If Z is of the order of the machine accuracy, postpone the
00193 *        decision on the nature of eigenvalues
00194 *
00195          IF( Z.GE.MULTPL*EPS ) THEN
00196 *
00197 *           Real eigenvalues. Compute A and D.
00198 *
00199             Z = P + SIGN( SQRT( SCALE )*SQRT( Z ), P )
00200             A = D + Z
00201             D = D - ( BCMAX / Z )*BCMIS
00202 *
00203 *           Compute B and the rotation matrix
00204 *
00205             TAU = SLAPY2( C, Z )
00206             CS = Z / TAU
00207             SN = C / TAU
00208             B = B - C
00209             C = ZERO
00210          ELSE
00211 *
00212 *           Complex eigenvalues, or real (almost) equal eigenvalues.
00213 *           Make diagonal elements equal.
00214 *
00215             SIGMA = B + C
00216             TAU = SLAPY2( SIGMA, TEMP )
00217             CS = SQRT( HALF*( ONE+ABS( SIGMA ) / TAU ) )
00218             SN = -( P / ( TAU*CS ) )*SIGN( ONE, SIGMA )
00219 *
00220 *           Compute [ AA  BB ] = [ A  B ] [ CS -SN ]
00221 *                   [ CC  DD ]   [ C  D ] [ SN  CS ]
00222 *
00223             AA = A*CS + B*SN
00224             BB = -A*SN + B*CS
00225             CC = C*CS + D*SN
00226             DD = -C*SN + D*CS
00227 *
00228 *           Compute [ A  B ] = [ CS  SN ] [ AA  BB ]
00229 *                   [ C  D ]   [-SN  CS ] [ CC  DD ]
00230 *
00231             A = AA*CS + CC*SN
00232             B = BB*CS + DD*SN
00233             C = -AA*SN + CC*CS
00234             D = -BB*SN + DD*CS
00235 *
00236             TEMP = HALF*( A+D )
00237             A = TEMP
00238             D = TEMP
00239 *
00240             IF( C.NE.ZERO ) THEN
00241                IF( B.NE.ZERO ) THEN
00242                   IF( SIGN( ONE, B ).EQ.SIGN( ONE, C ) ) THEN
00243 *
00244 *                    Real eigenvalues: reduce to upper triangular form
00245 *
00246                      SAB = SQRT( ABS( B ) )
00247                      SAC = SQRT( ABS( C ) )
00248                      P = SIGN( SAB*SAC, C )
00249                      TAU = ONE / SQRT( ABS( B+C ) )
00250                      A = TEMP + P
00251                      D = TEMP - P
00252                      B = B - C
00253                      C = ZERO
00254                      CS1 = SAB*TAU
00255                      SN1 = SAC*TAU
00256                      TEMP = CS*CS1 - SN*SN1
00257                      SN = CS*SN1 + SN*CS1
00258                      CS = TEMP
00259                   END IF
00260                ELSE
00261                   B = -C
00262                   C = ZERO
00263                   TEMP = CS
00264                   CS = -SN
00265                   SN = TEMP
00266                END IF
00267             END IF
00268          END IF
00269 *
00270       END IF
00271 *
00272    10 CONTINUE
00273 *
00274 *     Store eigenvalues in (RT1R,RT1I) and (RT2R,RT2I).
00275 *
00276       RT1R = A
00277       RT2R = D
00278       IF( C.EQ.ZERO ) THEN
00279          RT1I = ZERO
00280          RT2I = ZERO
00281       ELSE
00282          RT1I = SQRT( ABS( B ) )*SQRT( ABS( C ) )
00283          RT2I = -RT1I
00284       END IF
00285       RETURN
00286 *
00287 *     End of SLANV2
00288 *
00289       END
 All Files Functions