SRC/cggbak.f

   1 *> \brief \b CGGBAK
   2 *
   3 *  =========== DOCUMENTATION ===========
   4 *
   5 * Online html documentation available at
   6 *            http://www.netlib.org/lapack/explore-html/
   7 *
   8 *> \htmlonly
   9 *> Download CGGBAK + dependencies
  10 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/cggbak.f">
  11 *> [TGZ]</a>
  12 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/cggbak.f">
  13 *> [ZIP]</a>
  14 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/cggbak.f">
  15 *> [TXT]</a>
  16 *> \endhtmlonly
  17 *
  18 *  Definition:
  19 *  ===========
  20 *
  21 *       SUBROUTINE CGGBAK( JOB, SIDE, N, ILO, IHI, LSCALE, RSCALE, M, V,
  22 *                          LDV, INFO )
  23 *
  24 *       .. Scalar Arguments ..
  25 *       CHARACTER          JOB, SIDE
  26 *       INTEGER            IHI, ILO, INFO, LDV, M, N
  27 *       ..
  28 *       .. Array Arguments ..
  29 *       REAL               LSCALE( * ), RSCALE( * )
  30 *       COMPLEX            V( LDV, * )
  31 *       ..
  32 *
  33 *
  34 *> \par Purpose:
  35 *  =============
  36 *>
  37 *> \verbatim
  38 *>
  39 *> CGGBAK forms the right or left eigenvectors of a complex generalized
  40 *> eigenvalue problem A*x = lambda*B*x, by backward transformation on
  41 *> the computed eigenvectors of the balanced pair of matrices output by
  42 *> CGGBAL.
  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 CGGBAL.
  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 CGGBAL.
  82 *>          1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.
  83 *> \endverbatim
  84 *>
  85 *> \param[in] LSCALE
  86 *> \verbatim
  87 *>          LSCALE is REAL array, dimension (N)
  88 *>          Details of the permutations and/or scaling factors applied
  89 *>          to the left side of A and B, as returned by CGGBAL.
  90 *> \endverbatim
  91 *>
  92 *> \param[in] RSCALE
  93 *> \verbatim
  94 *>          RSCALE is REAL array, dimension (N)
  95 *>          Details of the permutations and/or scaling factors applied
  96 *>          to the right side of A and B, as returned by CGGBAL.
  97 *> \endverbatim
  98 *>
  99 *> \param[in] M
 100 *> \verbatim
 101 *>          M is INTEGER
 102 *>          The number of columns of the matrix V.  M >= 0.
 103 *> \endverbatim
 104 *>
 105 *> \param[in,out] V
 106 *> \verbatim
 107 *>          V is COMPLEX array, dimension (LDV,M)
 108 *>          On entry, the matrix of right or left eigenvectors to be
 109 *>          transformed, as returned by CTGEVC.
 110 *>          On exit, V is overwritten by the transformed eigenvectors.
 111 *> \endverbatim
 112 *>
 113 *> \param[in] LDV
 114 *> \verbatim
 115 *>          LDV is INTEGER
 116 *>          The leading dimension of the matrix V. LDV >= max(1,N).
 117 *> \endverbatim
 118 *>
 119 *> \param[out] INFO
 120 *> \verbatim
 121 *>          INFO is INTEGER
 122 *>          = 0:  successful exit.
 123 *>          < 0:  if INFO = -i, the i-th argument had an illegal value.
 124 *> \endverbatim
 125 *
 126 *  Authors:
 127 *  ========
 128 *
 129 *> \author Univ. of Tennessee
 130 *> \author Univ. of California Berkeley
 131 *> \author Univ. of Colorado Denver
 132 *> \author NAG Ltd.
 133 *
 134 *> \date November 2011
 135 *
 136 *> \ingroup complexGBcomputational
 137 *
 138 *> \par Further Details:
 139 *  =====================
 140 *>
 141 *> \verbatim
 142 *>
 143 *>  See R.C. Ward, Balancing the generalized eigenvalue problem,
 144 *>                 SIAM J. Sci. Stat. Comp. 2 (1981), 141-152.
 145 *> \endverbatim
 146 *>
 147 *  =====================================================================
 148       SUBROUTINE CGGBAK( JOB, SIDE, N, ILO, IHI, LSCALE, RSCALE, M, V,
 149      $                   LDV, INFO )
 150 *
 151 *  -- LAPACK computational routine (version 3.4.0) --
 152 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 153 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
 154 *     November 2011
 155 *
 156 *     .. Scalar Arguments ..
 157       CHARACTER          JOB, SIDE
 158       INTEGER            IHI, ILO, INFO, LDV, M, N
 159 *     ..
 160 *     .. Array Arguments ..
 161       REAL               LSCALE( * ), RSCALE( * )
 162       COMPLEX            V( LDV, * )
 163 *     ..
 164 *
 165 *  =====================================================================
 166 *
 167 *     .. Local Scalars ..
 168       LOGICAL            LEFTV, RIGHTV
 169       INTEGER            I, K
 170 *     ..
 171 *     .. External Functions ..
 172       LOGICAL            LSAME
 173       EXTERNAL           LSAME
 174 *     ..
 175 *     .. External Subroutines ..
 176       EXTERNAL           CSSCAL, CSWAP, XERBLA
 177 *     ..
 178 *     .. Intrinsic Functions ..
 179       INTRINSIC          MAX
 180 *     ..
 181 *     .. Executable Statements ..
 182 *
 183 *     Test the input parameters
 184 *
 185       RIGHTV = LSAME( SIDE, 'R' )
 186       LEFTV = LSAME( SIDE, 'L' )
 187 *
 188       INFO = 0
 189       IF( .NOT.LSAME( JOB, 'N' ) .AND. .NOT.LSAME( JOB, 'P' ) .AND.
 190      $    .NOT.LSAME( JOB, 'S' ) .AND. .NOT.LSAME( JOB, 'B' ) ) THEN
 191          INFO = -1
 192       ELSE IF( .NOT.RIGHTV .AND. .NOT.LEFTV ) THEN
 193          INFO = -2
 194       ELSE IF( N.LT.0 ) THEN
 195          INFO = -3
 196       ELSE IF( ILO.LT.1 ) THEN
 197          INFO = -4
 198       ELSE IF( N.EQ.0 .AND. IHI.EQ.0 .AND. ILO.NE.1 ) THEN
 199          INFO = -4
 200       ELSE IF( N.GT.0 .AND. ( IHI.LT.ILO .OR. IHI.GT.MAX( 1, N ) ) )
 201      $   THEN
 202          INFO = -5
 203       ELSE IF( N.EQ.0 .AND. ILO.EQ.1 .AND. IHI.NE.0 ) THEN
 204          INFO = -5
 205       ELSE IF( M.LT.0 ) THEN
 206          INFO = -8
 207       ELSE IF( LDV.LT.MAX( 1, N ) ) THEN
 208          INFO = -10
 209       END IF
 210       IF( INFO.NE.0 ) THEN
 211          CALL XERBLA( 'CGGBAK', -INFO )
 212          RETURN
 213       END IF
 214 *
 215 *     Quick return if possible
 216 *
 217       IF( N.EQ.0 )
 218      $   RETURN
 219       IF( M.EQ.0 )
 220      $   RETURN
 221       IF( LSAME( JOB, 'N' ) )
 222      $   RETURN
 223 *
 224       IF( ILO.EQ.IHI )
 225      $   GO TO 30
 226 *
 227 *     Backward balance
 228 *
 229       IF( LSAME( JOB, 'S' ) .OR. LSAME( JOB, 'B' ) ) THEN
 230 *
 231 *        Backward transformation on right eigenvectors
 232 *
 233          IF( RIGHTV ) THEN
 234             DO 10 I = ILO, IHI
 235                CALL CSSCAL( M, RSCALE( I ), V( I, 1 ), LDV )
 236    10       CONTINUE
 237          END IF
 238 *
 239 *        Backward transformation on left eigenvectors
 240 *
 241          IF( LEFTV ) THEN
 242             DO 20 I = ILO, IHI
 243                CALL CSSCAL( M, LSCALE( I ), V( I, 1 ), LDV )
 244    20       CONTINUE
 245          END IF
 246       END IF
 247 *
 248 *     Backward permutation
 249 *
 250    30 CONTINUE
 251       IF( LSAME( JOB, 'P' ) .OR. LSAME( JOB, 'B' ) ) THEN
 252 *
 253 *        Backward permutation on right eigenvectors
 254 *
 255          IF( RIGHTV ) THEN
 256             IF( ILO.EQ.1 )
 257      $         GO TO 50
 258             DO 40 I = ILO - 1, 1, -1
 259                K = RSCALE( I )
 260                IF( K.EQ.I )
 261      $            GO TO 40
 262                CALL CSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV )
 263    40       CONTINUE
 264 *
 265    50       CONTINUE
 266             IF( IHI.EQ.N )
 267      $         GO TO 70
 268             DO 60 I = IHI + 1, N
 269                K = RSCALE( I )
 270                IF( K.EQ.I )
 271      $            GO TO 60
 272                CALL CSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV )
 273    60       CONTINUE
 274          END IF
 275 *
 276 *        Backward permutation on left eigenvectors
 277 *
 278    70    CONTINUE
 279          IF( LEFTV ) THEN
 280             IF( ILO.EQ.1 )
 281      $         GO TO 90
 282             DO 80 I = ILO - 1, 1, -1
 283                K = LSCALE( I )
 284                IF( K.EQ.I )
 285      $            GO TO 80
 286                CALL CSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV )
 287    80       CONTINUE
 288 *
 289    90       CONTINUE
 290             IF( IHI.EQ.N )
 291      $         GO TO 110
 292             DO 100 I = IHI + 1, N
 293                K = LSCALE( I )
 294                IF( K.EQ.I )
 295      $            GO TO 100
 296                CALL CSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV )
 297   100       CONTINUE
 298          END IF
 299       END IF
 300 *
 301   110 CONTINUE
 302 *
 303       RETURN
 304 *
 305 *     End of CGGBAK
 306 *
 307       END