SRC/zgebak.f

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