ScaLAPACK  2.0.2
ScaLAPACK: Scalable Linear Algebra PACKage
slasorte.f
Go to the documentation of this file.
00001       SUBROUTINE SLASORTE( S, LDS, J, OUT, INFO )
00002 *
00003 *  -- ScaLAPACK routine (version 1.7) --
00004 *     University of Tennessee, Knoxville, Oak Ridge National Laboratory,
00005 *     and University of California, Berkeley.
00006 *     December 31, 1998
00007 *
00008 *     .. Scalar Arguments ..
00009       INTEGER            INFO, J, LDS
00010 *     ..
00011 *     .. Array Arguments ..
00012       REAL               OUT( J, * ), S( LDS, * )
00013 *     ..
00014 *
00015 *  Purpose
00016 *  =======
00017 *
00018 *  SLASORTE sorts eigenpairs so that real eigenpairs are together and
00019 *    complex are together.  This way one can employ 2x2 shifts easily
00020 *    since every 2nd subdiagonal is guaranteed to be zero.
00021 *  This routine does no parallel work.
00022 *
00023 *  Arguments
00024 *  =========
00025 *
00026 *  S       (local input/output) REAL array, dimension LDS
00027 *          On entry, a matrix already in Schur form.
00028 *          On exit, the diagonal blocks of S have been rewritten to pair
00029 *             the eigenvalues.  The resulting matrix is no longer
00030 *             similar to the input.
00031 *
00032 *  LDS     (local input) INTEGER
00033 *          On entry, the leading dimension of the local array S.
00034 *          Unchanged on exit.
00035 *
00036 *  J       (local input) INTEGER
00037 *          On entry, the order of the matrix S.
00038 *          Unchanged on exit.
00039 *
00040 *  OUT     (local input/output) REAL array, dimension Jx2
00041 *          This is the work buffer required by this routine.
00042 *
00043 *  INFO    (local input) INTEGER
00044 *          This is set if the input matrix had an odd number of real
00045 *          eigenvalues and things couldn't be paired or if the input
00046 *           matrix S was not originally in Schur form.
00047 *          0 indicates successful completion.
00048 *
00049 *  Implemented by:  G. Henry, November 17, 1996
00050 *
00051 *  =====================================================================
00052 *
00053 *     .. Parameters ..
00054       REAL               ZERO
00055       PARAMETER          ( ZERO = 0.0E+0 )
00056 *     ..
00057 *     .. Local Scalars ..
00058       INTEGER            BOT, I, LAST, TOP
00059 *     ..
00060 *     .. Intrinsic Functions ..
00061       INTRINSIC          MOD
00062 *     ..
00063 *     .. Executable Statements ..
00064 *
00065       LAST = J
00066       TOP = 1
00067       BOT = J
00068       INFO = 0
00069       DO 10 I = J - 1, 1, -1
00070          IF( S( I+1, I ).EQ.ZERO ) THEN
00071             IF( LAST-I.EQ.2 ) THEN
00072                OUT( BOT-1, 1 ) = S( I+1, I+1 )
00073                OUT( BOT, 2 ) = S( I+2, I+2 )
00074                OUT( BOT-1, 2 ) = S( I+1, I+2 )
00075                OUT( BOT, 1 ) = S( I+2, I+1 )
00076                BOT = BOT - 2
00077             END IF
00078             IF( LAST-I.EQ.1 ) THEN
00079                IF( MOD( TOP, 2 ).EQ.1 ) THEN
00080 *
00081 *                 FIRST OF A PAIR
00082 *
00083                   IF( ( I.EQ.J-1 ) .OR. ( I.EQ.1 ) ) THEN
00084                      OUT( TOP, 1 ) = S( I+1, I+1 )
00085                   ELSE
00086                      OUT( TOP, 1 ) = S( I+1, I+1 )
00087                   END IF
00088                   OUT( TOP, 2 ) = ZERO
00089                ELSE
00090 *
00091 *                 SECOND OF A PAIR
00092 *
00093                   IF( ( I.EQ.J-1 ) .OR. ( I.EQ.1 ) ) THEN
00094                      OUT( TOP, 2 ) = S( I+1, I+1 )
00095                   ELSE
00096                      OUT( TOP, 2 ) = S( I+1, I+1 )
00097                   END IF
00098                   OUT( TOP, 1 ) = ZERO
00099                END IF
00100                TOP = TOP + 1
00101             END IF
00102             IF( LAST-I.GT.2 ) THEN
00103                INFO = I
00104                RETURN
00105             END IF
00106             LAST = I
00107          END IF
00108    10 CONTINUE
00109       IF( LAST.EQ.2 ) THEN
00110 *
00111 *        GRAB LAST DOUBLE PAIR
00112 *
00113          OUT( BOT-1, 1 ) = S( 1, 1 )
00114          OUT( BOT, 2 ) = S( 2, 2 )
00115          OUT( BOT-1, 2 ) = S( 1, 2 )
00116          OUT( BOT, 1 ) = S( 2, 1 )
00117          BOT = BOT - 2
00118       END IF
00119       IF( LAST.EQ.1 .and. mod(top, 2) .eq. 0 ) THEN
00120 *
00121 *        GRAB SECOND PART OF LAST PAIR
00122 *
00123          OUT(TOP, 2) = s(1,1)
00124          OUT(TOP, 1) = zero
00125          TOP = TOP + 1
00126       END IF
00127       IF( TOP-1.NE.BOT ) THEN
00128          INFO = -BOT
00129          RETURN
00130       END IF
00131 *
00132 *     Overwrite the S diagonals
00133 *
00134       DO 20 I = 1, J, 2
00135          S( I, I ) = OUT( I, 1 )
00136          S( I+1, I ) = OUT( I+1, 1 )
00137          S( I, I+1 ) = OUT( I, 2 )
00138          S( I+1, I+1 ) = OUT( I+1, 2 )
00139    20 CONTINUE
00140 *
00141       RETURN
00142 *
00143 *     End of SLASORTE
00144 *
00145       END