SRC/sggbak.f

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