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 *
  46 *  IHI     (input) INTEGER
  47 *          The integers ILO and IHI determined by ZGEBAL.
  48 *          1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.
  49 *
  50 *  SCALE   (input) DOUBLE PRECISION array, dimension (N)
  51 *          Details of the permutation and scaling factors, as returned
  52 *          by ZGEBAL.
  53 *
  54 *  M       (input) INTEGER
  55 *          The number of columns of the matrix V.  M >= 0.
  56 *
  57 *  V       (input/output) COMPLEX*16 array, dimension (LDV,M)
  58 *          On entry, the matrix of right or left eigenvectors to be
  59 *          transformed, as returned by ZHSEIN or ZTREVC.
  60 *          On exit, V is overwritten by the transformed eigenvectors.
  61 *
  62 *  LDV     (input) INTEGER
  63 *          The leading dimension of the array V. LDV >= max(1,N).
  64 *
  65 *  INFO    (output) INTEGER
  66 *          = 0:  successful exit
  67 *          < 0:  if INFO = -i, the i-th argument had an illegal value.
  68 *
  69 *  =====================================================================
  70 *
  71 *     .. Parameters ..
  72       DOUBLE PRECISION   ONE
  73       PARAMETER          ( ONE = 1.0D+0 )
  74 *     ..
  75 *     .. Local Scalars ..
  76       LOGICAL            LEFTV, RIGHTV
  77       INTEGER            I, II, K
  78       DOUBLE PRECISION   S
  79 *     ..
  80 *     .. External Functions ..
  81       LOGICAL            LSAME
  82       EXTERNAL           LSAME
  83 *     ..
  84 *     .. External Subroutines ..
  85       EXTERNAL           XERBLA, ZDSCAL, ZSWAP
  86 *     ..
  87 *     .. Intrinsic Functions ..
  88       INTRINSIC          MAX, MIN
  89 *     ..
  90 *     .. Executable Statements ..
  91 *
  92 *     Decode and Test the input parameters
  93 *
  94       RIGHTV = LSAME( SIDE, 'R' )
  95       LEFTV = LSAME( SIDE, 'L' )
  96 *
  97       INFO = 0
  98       IF( .NOT.LSAME( JOB, 'N' ) .AND. .NOT.LSAME( JOB, 'P' ) .AND.
  99      $    .NOT.LSAME( JOB, 'S' ) .AND. .NOT.LSAME( JOB, 'B' ) ) THEN
 100          INFO = -1
 101       ELSE IF( .NOT.RIGHTV .AND. .NOT.LEFTV ) THEN
 102          INFO = -2
 103       ELSE IF( N.LT.0 ) THEN
 104          INFO = -3
 105       ELSE IF( ILO.LT.1 .OR. ILO.GT.MAX( 1, N ) ) THEN
 106          INFO = -4
 107       ELSE IF( IHI.LT.MIN( ILO, N ) .OR. IHI.GT.N ) THEN
 108          INFO = -5
 109       ELSE IF( M.LT.0 ) THEN
 110          INFO = -7
 111       ELSE IF( LDV.LT.MAX( 1, N ) ) THEN
 112          INFO = -9
 113       END IF
 114       IF( INFO.NE.0 ) THEN
 115          CALL XERBLA( 'ZGEBAK', -INFO )
 116          RETURN
 117       END IF
 118 *
 119 *     Quick return if possible
 120 *
 121       IF( N.EQ.0 )
 122      $   RETURN
 123       IF( M.EQ.0 )
 124      $   RETURN
 125       IF( LSAME( JOB, 'N' ) )
 126      $   RETURN
 127 *
 128       IF( ILO.EQ.IHI )
 129      $   GO TO 30
 130 *
 131 *     Backward balance
 132 *
 133       IF( LSAME( JOB, 'S' ) .OR. LSAME( JOB, 'B' ) ) THEN
 134 *
 135          IF( RIGHTV ) THEN
 136             DO 10 I = ILO, IHI
 137                S = SCALE( I )
 138                CALL ZDSCAL( M, S, V( I, 1 ), LDV )
 139    10       CONTINUE
 140          END IF
 141 *
 142          IF( LEFTV ) THEN
 143             DO 20 I = ILO, IHI
 144                S = ONE / SCALE( I )
 145                CALL ZDSCAL( M, S, V( I, 1 ), LDV )
 146    20       CONTINUE
 147          END IF
 148 *
 149       END IF
 150 *
 151 *     Backward permutation
 152 *
 153 *     For  I = ILO-1 step -1 until 1,
 154 *              IHI+1 step 1 until N do --
 155 *
 156    30 CONTINUE
 157       IF( LSAME( JOB, 'P' ) .OR. LSAME( JOB, 'B' ) ) THEN
 158          IF( RIGHTV ) THEN
 159             DO 40 II = 1, N
 160                I = II
 161                IF( I.GE.ILO .AND. I.LE.IHI )
 162      $            GO TO 40
 163                IF( I.LT.ILO )
 164      $            I = ILO - II
 165                K = SCALE( I )
 166                IF( K.EQ.I )
 167      $            GO TO 40
 168                CALL ZSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV )
 169    40       CONTINUE
 170          END IF
 171 *
 172          IF( LEFTV ) THEN
 173             DO 50 II = 1, N
 174                I = II
 175                IF( I.GE.ILO .AND. I.LE.IHI )
 176      $            GO TO 50
 177                IF( I.LT.ILO )
 178      $            I = ILO - II
 179                K = SCALE( I )
 180                IF( K.EQ.I )
 181      $            GO TO 50
 182                CALL ZSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV )
 183    50       CONTINUE
 184          END IF
 185       END IF
 186 *
 187       RETURN
 188 *
 189 *     End of ZGEBAK
 190 *
 191       END