SRC/zgebak.f

   1       SUBROUTINE ZGEBAK( JOB, SIDE, N, ILO, IHI, SCALE, M, V, LDV,
   2      $                   INFO )
   3 *
   4 *  -- LAPACK routine (version 3.2) --
   5 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
   6 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
   7 *     November 2006
   8 *
   9 *     .. Scalar Arguments ..
  10       CHARACTER          JOB, SIDE
  11       INTEGER            IHI, ILO, INFO, LDV, M, N
  12 *     ..
  13 *     .. Array Arguments ..
  14       DOUBLE PRECISION   SCALE( * )
  15       COMPLEX*16         V( LDV, * )
  16 *     ..
  17 *
  18 *  Purpose
  19 *  =======
  20 *
  21 *  ZGEBAK forms the right or left eigenvectors of a complex general
  22 *  matrix by backward transformation on the computed eigenvectors of the
  23 *  balanced matrix output by ZGEBAL.
  24 *
  25 *  Arguments
  26 *  =========
  27 *
  28 *  JOB     (input) CHARACTER*1
  29 *          Specifies the type of backward transformation required:
  30 *          = 'N', do nothing, return immediately;
  31 *          = 'P', do backward transformation for permutation only;
  32 *          = 'S', do backward transformation for scaling only;
  33 *          = 'B', do backward transformations for both permutation and
  34 *                 scaling.
  35 *          JOB must be the same as the argument JOB supplied to ZGEBAL.
  36 *
  37 *  SIDE    (input) CHARACTER*1
  38 *          = 'R':  V contains right eigenvectors;
  39 *          = 'L':  V contains left eigenvectors.
  40 *
  41 *  N       (input) INTEGER
  42 *          The number of rows of the matrix V.  N >= 0.
  43 *
  44 *  ILO     (input) INTEGER
  45 *  IHI     (input) INTEGER
  46 *          The integers ILO and IHI determined by ZGEBAL.
  47 *          1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.
  48 *
  49 *  SCALE   (input) DOUBLE PRECISION array, dimension (N)
  50 *          Details of the permutation and scaling factors, as returned
  51 *          by ZGEBAL.
  52 *
  53 *  M       (input) INTEGER
  54 *          The number of columns of the matrix V.  M >= 0.
  55 *
  56 *  V       (input/output) COMPLEX*16 array, dimension (LDV,M)
  57 *          On entry, the matrix of right or left eigenvectors to be
  58 *          transformed, as returned by ZHSEIN or ZTREVC.
  59 *          On exit, V is overwritten by the transformed eigenvectors.
  60 *
  61 *  LDV     (input) INTEGER
  62 *          The leading dimension of the array V. LDV >= max(1,N).
  63 *
  64 *  INFO    (output) INTEGER
  65 *          = 0:  successful exit
  66 *          < 0:  if INFO = -i, the i-th argument had an illegal value.
  67 *
  68 *  =====================================================================
  69 *
  70 *     .. Parameters ..
  71       DOUBLE PRECISION   ONE
  72       PARAMETER          ( ONE = 1.0D+0 )
  73 *     ..
  74 *     .. Local Scalars ..
  75       LOGICAL            LEFTV, RIGHTV
  76       INTEGER            I, II, K
  77       DOUBLE PRECISION   S
  78 *     ..
  79 *     .. External Functions ..
  80       LOGICAL            LSAME
  81       EXTERNAL           LSAME
  82 *     ..
  83 *     .. External Subroutines ..
  84       EXTERNAL           XERBLA, ZDSCAL, ZSWAP
  85 *     ..
  86 *     .. Intrinsic Functions ..
  87       INTRINSIC          MAX, MIN
  88 *     ..
  89 *     .. Executable Statements ..
  90 *
  91 *     Decode and Test the input parameters
  92 *
  93       RIGHTV = LSAME( SIDE, 'R' )
  94       LEFTV = LSAME( SIDE, 'L' )
  95 *
  96       INFO = 0
  97       IF( .NOT.LSAME( JOB, 'N' ) .AND. .NOT.LSAME( JOB, 'P' ) .AND.
  98      $    .NOT.LSAME( JOB, 'S' ) .AND. .NOT.LSAME( JOB, 'B' ) ) THEN
  99          INFO = -1
 100       ELSE IF( .NOT.RIGHTV .AND. .NOT.LEFTV ) THEN
 101          INFO = -2
 102       ELSE IF( N.LT.0 ) THEN
 103          INFO = -3
 104       ELSE IF( ILO.LT.1 .OR. ILO.GT.MAX( 1, N ) ) THEN
 105          INFO = -4
 106       ELSE IF( IHI.LT.MIN( ILO, N ) .OR. IHI.GT.N ) THEN
 107          INFO = -5
 108       ELSE IF( M.LT.0 ) THEN
 109          INFO = -7
 110       ELSE IF( LDV.LT.MAX( 1, N ) ) THEN
 111          INFO = -9
 112       END IF
 113       IF( INFO.NE.0 ) THEN
 114          CALL XERBLA( 'ZGEBAK', -INFO )
 115          RETURN
 116       END IF
 117 *
 118 *     Quick return if possible
 119 *
 120       IF( N.EQ.0 )
 121      $   RETURN
 122       IF( M.EQ.0 )
 123      $   RETURN
 124       IF( LSAME( JOB, 'N' ) )
 125      $   RETURN
 126 *
 127       IF( ILO.EQ.IHI )
 128      $   GO TO 30
 129 *
 130 *     Backward balance
 131 *
 132       IF( LSAME( JOB, 'S' ) .OR. LSAME( JOB, 'B' ) ) THEN
 133 *
 134          IF( RIGHTV ) THEN
 135             DO 10 I = ILO, IHI
 136                S = SCALE( I )
 137                CALL ZDSCAL( M, S, V( I, 1 ), LDV )
 138    10       CONTINUE
 139          END IF
 140 *
 141          IF( LEFTV ) THEN
 142             DO 20 I = ILO, IHI
 143                S = ONE / SCALE( I )
 144                CALL ZDSCAL( M, S, V( I, 1 ), LDV )
 145    20       CONTINUE
 146          END IF
 147 *
 148       END IF
 149 *
 150 *     Backward permutation
 151 *
 152 *     For  I = ILO-1 step -1 until 1,
 153 *              IHI+1 step 1 until N do --
 154 *
 155    30 CONTINUE
 156       IF( LSAME( JOB, 'P' ) .OR. LSAME( JOB, 'B' ) ) THEN
 157          IF( RIGHTV ) THEN
 158             DO 40 II = 1, N
 159                I = II
 160                IF( I.GE.ILO .AND. I.LE.IHI )
 161      $            GO TO 40
 162                IF( I.LT.ILO )
 163      $            I = ILO - II
 164                K = SCALE( I )
 165                IF( K.EQ.I )
 166      $            GO TO 40
 167                CALL ZSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV )
 168    40       CONTINUE
 169          END IF
 170 *
 171          IF( LEFTV ) THEN
 172             DO 50 II = 1, N
 173                I = II
 174                IF( I.GE.ILO .AND. I.LE.IHI )
 175      $            GO TO 50
 176                IF( I.LT.ILO )
 177      $            I = ILO - II
 178                K = SCALE( I )
 179                IF( K.EQ.I )
 180      $            GO TO 50
 181                CALL ZSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV )
 182    50       CONTINUE
 183          END IF
 184       END IF
 185 *
 186       RETURN
 187 *
 188 *     End of ZGEBAK
 189 *
 190       END