Routine: CLANV2()  File: SRC\clanv2.f

 
 
# lines: 145
  # code: 145
  # comment: 0
  # blank:0
# Variables:23
# Callers:2
# Callings:0
# Words:66
# Keywords:37
 

 

..
  Purpose
  =======
  CLANV2 computes the Schur factorization of a complex 2-by-2
  nonhermitian matrix in standard form:
       [ A  B ] = [ CS -SN ] [ AA  BB ] [ CS  SN ]
       [ C  D ]   [ SN  CS ] [  0  DD ] [-SN  CS ]
  Arguments
  =========
  A       (input/output) COMPLEX
  B       (input/output) COMPLEX
  C       (input/output) COMPLEX
  D       (input/output) COMPLEX
          On entry, the elements of the input matrix.
          On exit, they are overwritten by the elements of the
          standardised Schur form.
  RT1     (output) COMPLEX
  RT2     (output) COMPLEX
          The two eigenvalues.
  CS      (output) REAL
  SN      (output) COMPLEX
          Parameters of the rotation matrix.
  Further Details
  ===============
  Implemented by Mark R. Fahey, May 28, 1999
  =====================================================================
     .. Parameters ..

 
Display dynamic version Find AutoScroll Reload FontSize: - + Hide Comments Hide Blanks Frame FullScreen MailPrint

 
001        SUBROUTINE CLANV2( A , B , C , D , RT1 , RT2 , CS , SN )
002  
003  *     -- ScaLAPACK routine(version 1.7) --
004  *     Univ. of Tennessee , Univ. of California Berkeley , NAG Ltd. ,
005  *     Courant Institute , Argonne National Lab , and Rice University
006  *     May 28 , 1999
007  
008  *     .. Scalar Arguments ..
009        REAL CS
010        COMPLEX A , B , C , D , RT1 , RT2 , SN
011        REAL RZERO , HALF , RONE
012        PARAMETER( RZERO = 0.0E + 0 , HALF = 0.5E + 0 ,
013       $RONE = 1.0E + 0 )
014        COMPLEX ZERO , ONE
015        PARAMETER( ZERO =( 0.0E + 0 , 0.0E + 0 ) ,
016       $ONE =( 1.0E + 0 , 0.0E + 0 ) )
017  *     ..
018  *     .. Local Scalars ..
019        COMPLEX AA , BB , DD , T , TEMP , TEMP2 , U , X , Y
020  *     ..
021  *     .. External Functions ..
022        COMPLEX CLADIV
023        EXTERNAL CLADIV
024  *     ..
025  *     .. External Subroutines ..
026        EXTERNAL CLARTG
027  *     ..
028  *     .. Intrinsic Functions ..
029        INTRINSIC REAL , CMPLX , CONJG , AIMAG , SQRT
030  *     ..
031  *     .. Executable Statements ..
032  
033  *     Initialize CS and SN
034  
035        CS = RONE
036        SN = ZERO
037  
038        IF( C.EQ.ZERO ) THEN
039            GO TO 10
040  
041        ELSE IF( B.EQ.ZERO ) THEN
042  
043  *         Swap rows and columns
044  
045            CS = RZERO
046            SN = ONE
047            TEMP = D
048            D = A
049            A = TEMP
050            B = - C
051            C = ZERO
052            GO TO 10
053        ELSE IF(( A - D ).EQ.ZERO ) THEN
054            TEMP = SQRT( B*C )
055            A = A + TEMP
056            D = D - TEMP
057            IF(( B + C ).EQ.ZERO ) THEN
058                CS = SQRT( HALF )
059                SN = CMPLX( RZERO , RONE )*CS
060            ELSE
061                TEMP = SQRT( B + C )
062                TEMP2 = CLADIV( SQRT( B ) , TEMP )
063                CS = REAL( TEMP2 )
064                SN = CLADIV( SQRT( C ) , TEMP )
065            END IF
066            B = B - C
067            C = ZERO
068            GO TO 10
069        ELSE
070  
071  *         Compute eigenvalue closest to D
072  
073            T = D
074            U = B*C
075            X = HALF*( A - T )
076            Y = SQRT( X*X + U )
077            IF( REAL( X )*REAL( Y ) + AIMAG( X )*AIMAG( Y ).LT.RZERO )
078       $        Y = - Y
079                T = T - CLADIV( U ,( X + Y ) )
080  
081  *             Do one QR step with exact shift T - resulting 2 x 2 in
082  *             triangular form.
083  
084                CALL CLARTG( A - T , C , CS , SN , AA )
085  
086                D = D - T
087                BB = CS*B + SN*D
088                DD = - CONJG( SN )*B + CS*D
089  
090                A = AA*CS + BB*CONJG( SN ) + T
091                B = - AA*SN + BB*CS
092                C = ZERO
093                D = T
094  
095            END IF
096  
097     10 CONTINUE
098  
099  *     Store eigenvalues in RT1 and RT2.
100  
101        RT1 = A
102        RT2 = D
103        RETURN
104  
105  *     End of CLANV2
106  
107        END