cgebak.f

          SUBROUTINE CGEBAK( JOB, SIDE, N, ILO, IHI, SCALE, M, V, LDV,
         $                   INFO )
    *
    *  -- LAPACK routine (version 3.1) --
    *     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
    *     November 2006
    *
    *     .. Scalar Arguments ..
          CHARACTER          JOB, SIDE
          INTEGER            IHI, ILO, INFO, LDV, M, N
    *     ..
    *     .. Array Arguments ..
          REAL               SCALE( * )
          COMPLEX            V( LDV, * )
    *     ..
    *
    *  Purpose
    *  =======
    *
    *  CGEBAK forms the right or left eigenvectors of a complex general
    *  matrix by backward transformation on the computed eigenvectors of the
    *  balanced matrix output by CGEBAL.
    *
    *  Arguments
    *  =========
    *
    *  JOB     (input) CHARACTER*1
    *          Specifies the type of backward transformation required:
    *          = 'N', do nothing, return immediately;
    *          = 'P', do backward transformation for permutation only;
    *          = 'S', do backward transformation for scaling only;
    *          = 'B', do backward transformations for both permutation and
    *                 scaling.
    *          JOB must be the same as the argument JOB supplied to CGEBAL.
    *
    *  SIDE    (input) CHARACTER*1
    *          = 'R':  V contains right eigenvectors;
    *          = 'L':  V contains left eigenvectors.
    *
    *  N       (input) INTEGER
    *          The number of rows of the matrix V.  N >= 0.
    *
    *  ILO     (input) INTEGER
    *  IHI     (input) INTEGER
    *          The integers ILO and IHI determined by CGEBAL.
    *          1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.
    *
    *  SCALE   (input) REAL array, dimension (N)
    *          Details of the permutation and scaling factors, as returned
    *          by CGEBAL.
    *
    *  M       (input) INTEGER
    *          The number of columns of the matrix V.  M >= 0.
    *
    *  V       (input/output) COMPLEX array, dimension (LDV,M)
    *          On entry, the matrix of right or left eigenvectors to be
    *          transformed, as returned by CHSEIN or CTREVC.
    *          On exit, V is overwritten by the transformed eigenvectors.
    *
    *  LDV     (input) INTEGER
    *          The leading dimension of the array V. LDV >= max(1,N).
    *
    *  INFO    (output) INTEGER
    *          = 0:  successful exit
    *          < 0:  if INFO = -i, the i-th argument had an illegal value.
    *
    *  =====================================================================
    *
    *     .. Parameters ..
          REAL               ONE
          PARAMETER          ( ONE = 1.0E+0 )
    *     ..
    *     .. Local Scalars ..
          LOGICAL            LEFTV, RIGHTV
          INTEGER            I, II, K
          REAL               S
    *     ..
    *     .. External Functions ..
          LOGICAL            LSAME
          EXTERNAL           LSAME
    *     ..
    *     .. External Subroutines ..
          EXTERNAL           CSSCAL, CSWAP, XERBLA
    *     ..
    *     .. Intrinsic Functions ..
          INTRINSIC          MAX, MIN
    *     ..
    *     .. Executable Statements ..
    *
    *     Decode and Test the input parameters
    *
          RIGHTV = LSAME( SIDE, 'R' )
          LEFTV = LSAME( SIDE, 'L' )
    *
          INFO = 0
          IF( .NOT.LSAME( JOB, 'N' ) .AND. .NOT.LSAME( JOB, 'P' ) .AND.
         $    .NOT.LSAME( JOB, 'S' ) .AND. .NOT.LSAME( JOB, 'B' ) ) THEN
             INFO = -1
          ELSE IF( .NOT.RIGHTV .AND. .NOT.LEFTV ) THEN
             INFO = -2
          ELSE IF( N.LT.0 ) THEN
             INFO = -3
          ELSE IF( ILO.LT.1 .OR. ILO.GT.MAX( 1, N ) ) THEN
             INFO = -4
          ELSE IF( IHI.LT.MIN( ILO, N ) .OR. IHI.GT.N ) THEN
             INFO = -5
          ELSE IF( M.LT.0 ) THEN
             INFO = -7
          ELSE IF( LDV.LT.MAX( 1, N ) ) THEN
             INFO = -9
          END IF
          IF( INFO.NE.0 ) THEN
             CALL XERBLA( 'CGEBAK', -INFO )
             RETURN
          END IF
    *
    *     Quick return if possible
    *
          IF( N.EQ.0 )
         $   RETURN
          IF( M.EQ.0 )
         $   RETURN
          IF( LSAME( JOB, 'N' ) )
         $   RETURN
    *
          IF( ILO.EQ.IHI )
         $   GO TO 30
    *
    *     Backward balance
    *
          IF( LSAME( JOB, 'S' ) .OR. LSAME( JOB, 'B' ) ) THEN
    *
             IF( RIGHTV ) THEN
                DO 10 I = ILO, IHI
                   S = SCALE( I )
                   CALL CSSCAL( M, S, V( I, 1 ), LDV )
       10       CONTINUE
             END IF
    *
             IF( LEFTV ) THEN
                DO 20 I = ILO, IHI
                   S = ONE / SCALE( I )
                   CALL CSSCAL( M, S, V( I, 1 ), LDV )
       20       CONTINUE
             END IF
    *
          END IF
    *
    *     Backward permutation
    *
    *     For  I = ILO-1 step -1 until 1,
    *              IHI+1 step 1 until N do --
    *
       30 CONTINUE
          IF( LSAME( JOB, 'P' ) .OR. LSAME( JOB, 'B' ) ) THEN
             IF( RIGHTV ) THEN
                DO 40 II = 1, N
                   I = II
                   IF( I.GE.ILO .AND. I.LE.IHI )
         $            GO TO 40
                   IF( I.LT.ILO )
         $            I = ILO - II
                   K = SCALE( I )
                   IF( K.EQ.I )
         $            GO TO 40
                   CALL CSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV )
       40       CONTINUE
             END IF
    *
             IF( LEFTV ) THEN
                DO 50 II = 1, N
                   I = II
                   IF( I.GE.ILO .AND. I.LE.IHI )
         $            GO TO 50
                   IF( I.LT.ILO )
         $            I = ILO - II
                   K = SCALE( I )
                   IF( K.EQ.I )
         $            GO TO 50
                   CALL CSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV )
       50       CONTINUE
             END IF
          END IF
    *
          RETURN
    *
    *     End of CGEBAK
    *
          END