SRC/zgebak.f

   1 *> \brief \b ZGEBAK
   2 *
   3 *  =========== DOCUMENTATION ===========
   4 *
   5 * Online html documentation available at
   6 *            http://www.netlib.org/lapack/explore-html/
   7 *
   8 *> \htmlonly
   9 *> Download ZGEBAK + dependencies
  10 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zgebak.f">
  11 *> [TGZ]</a>
  12 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zgebak.f">
  13 *> [ZIP]</a>
  14 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zgebak.f">
  15 *> [TXT]</a>
  16 *> \endhtmlonly
  17 *
  18 *  Definition
  19 *  ==========
  20 *
  21 *       SUBROUTINE ZGEBAK( JOB, SIDE, N, ILO, IHI, SCALE, M, V, LDV,
  22 *                          INFO )
  23 *
  24 *       .. Scalar Arguments ..
  25 *       CHARACTER          JOB, SIDE
  26 *       INTEGER            IHI, ILO, INFO, LDV, M, N
  27 *       ..
  28 *       .. Array Arguments ..
  29 *       DOUBLE PRECISION   SCALE( * )
  30 *       COMPLEX*16         V( LDV, * )
  31 *       ..
  32 *
  33 *  Purpose
  34 *  =======
  35 *
  36 *>\details \b Purpose:
  37 *>\verbatim
  38 *>
  39 *> ZGEBAK forms the right or left eigenvectors of a complex general
  40 *> matrix by backward transformation on the computed eigenvectors of the
  41 *> balanced matrix output by ZGEBAL.
  42 *>
  43 *>\endverbatim
  44 *
  45 *  Arguments
  46 *  =========
  47 *
  48 *> \param[in] JOB
  49 *> \verbatim
  50 *>          JOB is CHARACTER*1
  51 *>          Specifies the type of backward transformation required:
  52 *>          = 'N', do nothing, return immediately;
  53 *>          = 'P', do backward transformation for permutation only;
  54 *>          = 'S', do backward transformation for scaling only;
  55 *>          = 'B', do backward transformations for both permutation and
  56 *>                 scaling.
  57 *>          JOB must be the same as the argument JOB supplied to ZGEBAL.
  58 *> \endverbatim
  59 *>
  60 *> \param[in] SIDE
  61 *> \verbatim
  62 *>          SIDE is CHARACTER*1
  63 *>          = 'R':  V contains right eigenvectors;
  64 *>          = 'L':  V contains left eigenvectors.
  65 *> \endverbatim
  66 *>
  67 *> \param[in] N
  68 *> \verbatim
  69 *>          N is INTEGER
  70 *>          The number of rows of the matrix V.  N >= 0.
  71 *> \endverbatim
  72 *>
  73 *> \param[in] ILO
  74 *> \verbatim
  75 *>          ILO is INTEGER
  76 *> \endverbatim
  77 *>
  78 *> \param[in] IHI
  79 *> \verbatim
  80 *>          IHI is INTEGER
  81 *>          The integers ILO and IHI determined by ZGEBAL.
  82 *>          1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.
  83 *> \endverbatim
  84 *>
  85 *> \param[in] SCALE
  86 *> \verbatim
  87 *>          SCALE is DOUBLE PRECISION array, dimension (N)
  88 *>          Details of the permutation and scaling factors, as returned
  89 *>          by ZGEBAL.
  90 *> \endverbatim
  91 *>
  92 *> \param[in] M
  93 *> \verbatim
  94 *>          M is INTEGER
  95 *>          The number of columns of the matrix V.  M >= 0.
  96 *> \endverbatim
  97 *>
  98 *> \param[in,out] V
  99 *> \verbatim
 100 *>          V is COMPLEX*16 array, dimension (LDV,M)
 101 *>          On entry, the matrix of right or left eigenvectors to be
 102 *>          transformed, as returned by ZHSEIN or ZTREVC.
 103 *>          On exit, V is overwritten by the transformed eigenvectors.
 104 *> \endverbatim
 105 *>
 106 *> \param[in] LDV
 107 *> \verbatim
 108 *>          LDV is INTEGER
 109 *>          The leading dimension of the array V. LDV >= max(1,N).
 110 *> \endverbatim
 111 *>
 112 *> \param[out] INFO
 113 *> \verbatim
 114 *>          INFO is INTEGER
 115 *>          = 0:  successful exit
 116 *>          < 0:  if INFO = -i, the i-th argument had an illegal value.
 117 *> \endverbatim
 118 *>
 119 *
 120 *  Authors
 121 *  =======
 122 *
 123 *> \author Univ. of Tennessee
 124 *> \author Univ. of California Berkeley
 125 *> \author Univ. of Colorado Denver
 126 *> \author NAG Ltd.
 127 *
 128 *> \date November 2011
 129 *
 130 *> \ingroup complex16GEcomputational
 131 *
 132 *  =====================================================================
 133       SUBROUTINE ZGEBAK( JOB, SIDE, N, ILO, IHI, SCALE, M, V, LDV,
 134      $                   INFO )
 135 *
 136 *  -- LAPACK computational routine (version 3.2) --
 137 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 138 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
 139 *     November 2011
 140 *
 141 *     .. Scalar Arguments ..
 142       CHARACTER          JOB, SIDE
 143       INTEGER            IHI, ILO, INFO, LDV, M, N
 144 *     ..
 145 *     .. Array Arguments ..
 146       DOUBLE PRECISION   SCALE( * )
 147       COMPLEX*16         V( LDV, * )
 148 *     ..
 149 *
 150 *  =====================================================================
 151 *
 152 *     .. Parameters ..
 153       DOUBLE PRECISION   ONE
 154       PARAMETER          ( ONE = 1.0D+0 )
 155 *     ..
 156 *     .. Local Scalars ..
 157       LOGICAL            LEFTV, RIGHTV
 158       INTEGER            I, II, K
 159       DOUBLE PRECISION   S
 160 *     ..
 161 *     .. External Functions ..
 162       LOGICAL            LSAME
 163       EXTERNAL           LSAME
 164 *     ..
 165 *     .. External Subroutines ..
 166       EXTERNAL           XERBLA, ZDSCAL, ZSWAP
 167 *     ..
 168 *     .. Intrinsic Functions ..
 169       INTRINSIC          MAX, MIN
 170 *     ..
 171 *     .. Executable Statements ..
 172 *
 173 *     Decode and Test the input parameters
 174 *
 175       RIGHTV = LSAME( SIDE, 'R' )
 176       LEFTV = LSAME( SIDE, 'L' )
 177 *
 178       INFO = 0
 179       IF( .NOT.LSAME( JOB, 'N' ) .AND. .NOT.LSAME( JOB, 'P' ) .AND.
 180      $    .NOT.LSAME( JOB, 'S' ) .AND. .NOT.LSAME( JOB, 'B' ) ) THEN
 181          INFO = -1
 182       ELSE IF( .NOT.RIGHTV .AND. .NOT.LEFTV ) THEN
 183          INFO = -2
 184       ELSE IF( N.LT.0 ) THEN
 185          INFO = -3
 186       ELSE IF( ILO.LT.1 .OR. ILO.GT.MAX( 1, N ) ) THEN
 187          INFO = -4
 188       ELSE IF( IHI.LT.MIN( ILO, N ) .OR. IHI.GT.N ) THEN
 189          INFO = -5
 190       ELSE IF( M.LT.0 ) THEN
 191          INFO = -7
 192       ELSE IF( LDV.LT.MAX( 1, N ) ) THEN
 193          INFO = -9
 194       END IF
 195       IF( INFO.NE.0 ) THEN
 196          CALL XERBLA( 'ZGEBAK', -INFO )
 197          RETURN
 198       END IF
 199 *
 200 *     Quick return if possible
 201 *
 202       IF( N.EQ.0 )
 203      $   RETURN
 204       IF( M.EQ.0 )
 205      $   RETURN
 206       IF( LSAME( JOB, 'N' ) )
 207      $   RETURN
 208 *
 209       IF( ILO.EQ.IHI )
 210      $   GO TO 30
 211 *
 212 *     Backward balance
 213 *
 214       IF( LSAME( JOB, 'S' ) .OR. LSAME( JOB, 'B' ) ) THEN
 215 *
 216          IF( RIGHTV ) THEN
 217             DO 10 I = ILO, IHI
 218                S = SCALE( I )
 219                CALL ZDSCAL( M, S, V( I, 1 ), LDV )
 220    10       CONTINUE
 221          END IF
 222 *
 223          IF( LEFTV ) THEN
 224             DO 20 I = ILO, IHI
 225                S = ONE / SCALE( I )
 226                CALL ZDSCAL( M, S, V( I, 1 ), LDV )
 227    20       CONTINUE
 228          END IF
 229 *
 230       END IF
 231 *
 232 *     Backward permutation
 233 *
 234 *     For  I = ILO-1 step -1 until 1,
 235 *              IHI+1 step 1 until N do --
 236 *
 237    30 CONTINUE
 238       IF( LSAME( JOB, 'P' ) .OR. LSAME( JOB, 'B' ) ) THEN
 239          IF( RIGHTV ) THEN
 240             DO 40 II = 1, N
 241                I = II
 242                IF( I.GE.ILO .AND. I.LE.IHI )
 243      $            GO TO 40
 244                IF( I.LT.ILO )
 245      $            I = ILO - II
 246                K = SCALE( I )
 247                IF( K.EQ.I )
 248      $            GO TO 40
 249                CALL ZSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV )
 250    40       CONTINUE
 251          END IF
 252 *
 253          IF( LEFTV ) THEN
 254             DO 50 II = 1, N
 255                I = II
 256                IF( I.GE.ILO .AND. I.LE.IHI )
 257      $            GO TO 50
 258                IF( I.LT.ILO )
 259      $            I = ILO - II
 260                K = SCALE( I )
 261                IF( K.EQ.I )
 262      $            GO TO 50
 263                CALL ZSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV )
 264    50       CONTINUE
 265          END IF
 266       END IF
 267 *
 268       RETURN
 269 *
 270 *     End of ZGEBAK
 271 *
 272       END