sggbak.f

          SUBROUTINE SGGBAK( JOB, SIDE, N, ILO, IHI, LSCALE, RSCALE, M, V,
         $                   LDV, INFO )
    *
    *  -- LAPACK routine (version 3.1) --
    *     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
    *     November 2006
    *
    *     .. Scalar Arguments ..
          CHARACTER          JOB, SIDE
          INTEGER            IHI, ILO, INFO, LDV, M, N
    *     ..
    *     .. Array Arguments ..
          REAL               LSCALE( * ), RSCALE( * ), V( LDV, * )
    *     ..
    *
    *  Purpose
    *  =======
    *
    *  SGGBAK forms the right or left eigenvectors of a real generalized
    *  eigenvalue problem A*x = lambda*B*x, by backward transformation on
    *  the computed eigenvectors of the balanced pair of matrices output by
    *  SGGBAL.
    *
    *  Arguments
    *  =========
    *
    *  JOB     (input) CHARACTER*1
    *          Specifies the type of backward transformation required:
    *          = 'N':  do nothing, return immediately;
    *          = 'P':  do backward transformation for permutation only;
    *          = 'S':  do backward transformation for scaling only;
    *          = 'B':  do backward transformations for both permutation and
    *                  scaling.
    *          JOB must be the same as the argument JOB supplied to SGGBAL.
    *
    *  SIDE    (input) CHARACTER*1
    *          = 'R':  V contains right eigenvectors;
    *          = 'L':  V contains left eigenvectors.
    *
    *  N       (input) INTEGER
    *          The number of rows of the matrix V.  N >= 0.
    *
    *  ILO     (input) INTEGER
    *  IHI     (input) INTEGER
    *          The integers ILO and IHI determined by SGGBAL.
    *          1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.
    *
    *  LSCALE  (input) REAL array, dimension (N)
    *          Details of the permutations and/or scaling factors applied
    *          to the left side of A and B, as returned by SGGBAL.
    *
    *  RSCALE  (input) REAL array, dimension (N)
    *          Details of the permutations and/or scaling factors applied
    *          to the right side of A and B, as returned by SGGBAL.
    *
    *  M       (input) INTEGER
    *          The number of columns of the matrix V.  M >= 0.
    *
    *  V       (input/output) REAL array, dimension (LDV,M)
    *          On entry, the matrix of right or left eigenvectors to be
    *          transformed, as returned by STGEVC.
    *          On exit, V is overwritten by the transformed eigenvectors.
    *
    *  LDV     (input) INTEGER
    *          The leading dimension of the matrix V. LDV >= max(1,N).
    *
    *  INFO    (output) INTEGER
    *          = 0:  successful exit.
    *          < 0:  if INFO = -i, the i-th argument had an illegal value.
    *
    *  Further Details
    *  ===============
    *
    *  See R.C. Ward, Balancing the generalized eigenvalue problem,
    *                 SIAM J. Sci. Stat. Comp. 2 (1981), 141-152.
    *
    *  =====================================================================
    *
    *     .. Local Scalars ..
          LOGICAL            LEFTV, RIGHTV
          INTEGER            I, K
    *     ..
    *     .. External Functions ..
          LOGICAL            LSAME
          EXTERNAL           LSAME
    *     ..
    *     .. External Subroutines ..
          EXTERNAL           SSCAL, SSWAP, XERBLA
    *     ..
    *     .. Intrinsic Functions ..
          INTRINSIC          MAX
    *     ..
    *     .. Executable Statements ..
    *
    *     Test the input parameters
    *
          RIGHTV = LSAME( SIDE, 'R' )
          LEFTV = LSAME( SIDE, 'L' )
    *
          INFO = 0
          IF( .NOT.LSAME( JOB, 'N' ) .AND. .NOT.LSAME( JOB, 'P' ) .AND.
         $    .NOT.LSAME( JOB, 'S' ) .AND. .NOT.LSAME( JOB, 'B' ) ) THEN
             INFO = -1
          ELSE IF( .NOT.RIGHTV .AND. .NOT.LEFTV ) THEN
             INFO = -2
          ELSE IF( N.LT.0 ) THEN
             INFO = -3
          ELSE IF( ILO.LT.1 ) THEN
             INFO = -4
          ELSE IF( N.EQ.0 .AND. IHI.EQ.0 .AND. ILO.NE.1 ) THEN
             INFO = -4
          ELSE IF( N.GT.0 .AND. ( IHI.LT.ILO .OR. IHI.GT.MAX( 1, N ) ) )
         $   THEN
             INFO = -5
          ELSE IF( N.EQ.0 .AND. ILO.EQ.1 .AND. IHI.NE.0 ) THEN
             INFO = -5
          ELSE IF( M.LT.0 ) THEN
             INFO = -8
          ELSE IF( LDV.LT.MAX( 1, N ) ) THEN
             INFO = -10
          END IF
          IF( INFO.NE.0 ) THEN
             CALL XERBLA( 'SGGBAK', -INFO )
             RETURN
          END IF
    *
    *     Quick return if possible
    *
          IF( N.EQ.0 )
         $   RETURN
          IF( M.EQ.0 )
         $   RETURN
          IF( LSAME( JOB, 'N' ) )
         $   RETURN
    *
          IF( ILO.EQ.IHI )
         $   GO TO 30
    *
    *     Backward balance
    *
          IF( LSAME( JOB, 'S' ) .OR. LSAME( JOB, 'B' ) ) THEN
    *
    *        Backward transformation on right eigenvectors
    *
             IF( RIGHTV ) THEN
                DO 10 I = ILO, IHI
                   CALL SSCAL( M, RSCALE( I ), V( I, 1 ), LDV )
       10       CONTINUE
             END IF
    *
    *        Backward transformation on left eigenvectors
    *
             IF( LEFTV ) THEN
                DO 20 I = ILO, IHI
                   CALL SSCAL( M, LSCALE( I ), V( I, 1 ), LDV )
       20       CONTINUE
             END IF
          END IF
    *
    *     Backward permutation
    *
       30 CONTINUE
          IF( LSAME( JOB, 'P' ) .OR. LSAME( JOB, 'B' ) ) THEN
    *
    *        Backward permutation on right eigenvectors
    *
             IF( RIGHTV ) THEN
                IF( ILO.EQ.1 )
         $         GO TO 50
    *
                DO 40 I = ILO - 1, 1, -1
                   K = RSCALE( I )
                   IF( K.EQ.I )
         $            GO TO 40
                   CALL SSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV )
       40       CONTINUE
    *
       50       CONTINUE
                IF( IHI.EQ.N )
         $         GO TO 70
                DO 60 I = IHI + 1, N
                   K = RSCALE( I )
                   IF( K.EQ.I )
         $            GO TO 60
                   CALL SSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV )
       60       CONTINUE
             END IF
    *
    *        Backward permutation on left eigenvectors
    *
       70    CONTINUE
             IF( LEFTV ) THEN
                IF( ILO.EQ.1 )
         $         GO TO 90
                DO 80 I = ILO - 1, 1, -1
                   K = LSCALE( I )
                   IF( K.EQ.I )
         $            GO TO 80
                   CALL SSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV )
       80       CONTINUE
    *
       90       CONTINUE
                IF( IHI.EQ.N )
         $         GO TO 110
                DO 100 I = IHI + 1, N
                   K = LSCALE( I )
                   IF( K.EQ.I )
         $            GO TO 100
                   CALL SSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV )
      100       CONTINUE
             END IF
          END IF
    *
      110 CONTINUE
    *
          RETURN
    *
    *     End of SGGBAK
    *
          END