LAPACK: SRC/sggbak.f Source File

Go to the documentation of this file.
00001       SUBROUTINE SGGBAK( JOB, SIDE, N, ILO, IHI, LSCALE, RSCALE, M, V,
00002      $                   LDV, INFO )
00003 *
00004 *  -- LAPACK routine (version 3.2) --
00005 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00006 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00007 *     November 2006
00008 *
00009 *     .. Scalar Arguments ..
00010       CHARACTER          JOB, SIDE
00011       INTEGER            IHI, ILO, INFO, LDV, M, N
00012 *     ..
00013 *     .. Array Arguments ..
00014       REAL               LSCALE( * ), RSCALE( * ), V( LDV, * )
00015 *     ..
00016 *
00017 *  Purpose
00018 *  =======
00019 *
00020 *  SGGBAK forms the right or left eigenvectors of a real generalized
00021 *  eigenvalue problem A*x = lambda*B*x, by backward transformation on
00022 *  the computed eigenvectors of the balanced pair of matrices output by
00023 *  SGGBAL.
00024 *
00025 *  Arguments
00026 *  =========
00027 *
00028 *  JOB     (input) CHARACTER*1
00029 *          Specifies the type of backward transformation required:
00030 *          = 'N':  do nothing, return immediately;
00031 *          = 'P':  do backward transformation for permutation only;
00032 *          = 'S':  do backward transformation for scaling only;
00033 *          = 'B':  do backward transformations for both permutation and
00034 *                  scaling.
00035 *          JOB must be the same as the argument JOB supplied to SGGBAL.
00036 *
00037 *  SIDE    (input) CHARACTER*1
00038 *          = 'R':  V contains right eigenvectors;
00039 *          = 'L':  V contains left eigenvectors.
00040 *
00041 *  N       (input) INTEGER
00042 *          The number of rows of the matrix V.  N >= 0.
00043 *
00044 *  ILO     (input) INTEGER
00045 *  IHI     (input) INTEGER
00046 *          The integers ILO and IHI determined by SGGBAL.
00047 *          1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.
00048 *
00049 *  LSCALE  (input) REAL array, dimension (N)
00050 *          Details of the permutations and/or scaling factors applied
00051 *          to the left side of A and B, as returned by SGGBAL.
00052 *
00053 *  RSCALE  (input) REAL array, dimension (N)
00054 *          Details of the permutations and/or scaling factors applied
00055 *          to the right side of A and B, as returned by SGGBAL.
00056 *
00057 *  M       (input) INTEGER
00058 *          The number of columns of the matrix V.  M >= 0.
00059 *
00060 *  V       (input/output) REAL array, dimension (LDV,M)
00061 *          On entry, the matrix of right or left eigenvectors to be
00062 *          transformed, as returned by STGEVC.
00063 *          On exit, V is overwritten by the transformed eigenvectors.
00064 *
00065 *  LDV     (input) INTEGER
00066 *          The leading dimension of the matrix V. LDV >= max(1,N).
00067 *
00068 *  INFO    (output) INTEGER
00069 *          = 0:  successful exit.
00070 *          < 0:  if INFO = -i, the i-th argument had an illegal value.
00071 *
00072 *  Further Details
00073 *  ===============
00074 *
00075 *  See R.C. Ward, Balancing the generalized eigenvalue problem,
00076 *                 SIAM J. Sci. Stat. Comp. 2 (1981), 141-152.
00077 *
00078 *  =====================================================================
00079 *
00080 *     .. Local Scalars ..
00081       LOGICAL            LEFTV, RIGHTV
00082       INTEGER            I, K
00083 *     ..
00084 *     .. External Functions ..
00085       LOGICAL            LSAME
00086       EXTERNAL           LSAME
00087 *     ..
00088 *     .. External Subroutines ..
00089       EXTERNAL           SSCAL, SSWAP, XERBLA
00090 *     ..
00091 *     .. Intrinsic Functions ..
00092       INTRINSIC          MAX
00093 *     ..
00094 *     .. Executable Statements ..
00095 *
00096 *     Test the input parameters
00097 *
00098       RIGHTV = LSAME( SIDE, 'R' )
00099       LEFTV = LSAME( SIDE, 'L' )
00100 *
00101       INFO = 0
00102       IF( .NOT.LSAME( JOB, 'N' ) .AND. .NOT.LSAME( JOB, 'P' ) .AND.
00103      $    .NOT.LSAME( JOB, 'S' ) .AND. .NOT.LSAME( JOB, 'B' ) ) THEN
00104          INFO = -1
00105       ELSE IF( .NOT.RIGHTV .AND. .NOT.LEFTV ) THEN
00106          INFO = -2
00107       ELSE IF( N.LT.0 ) THEN
00108          INFO = -3
00109       ELSE IF( ILO.LT.1 ) THEN
00110          INFO = -4
00111       ELSE IF( N.EQ.0 .AND. IHI.EQ.0 .AND. ILO.NE.1 ) THEN
00112          INFO = -4
00113       ELSE IF( N.GT.0 .AND. ( IHI.LT.ILO .OR. IHI.GT.MAX( 1, N ) ) )
00114      $   THEN
00115          INFO = -5
00116       ELSE IF( N.EQ.0 .AND. ILO.EQ.1 .AND. IHI.NE.0 ) THEN
00117          INFO = -5
00118       ELSE IF( M.LT.0 ) THEN
00119          INFO = -8
00120       ELSE IF( LDV.LT.MAX( 1, N ) ) THEN
00121          INFO = -10
00122       END IF
00123       IF( INFO.NE.0 ) THEN
00124          CALL XERBLA( 'SGGBAK', -INFO )
00125          RETURN
00126       END IF
00127 *
00128 *     Quick return if possible
00129 *
00130       IF( N.EQ.0 )
00131      $   RETURN
00132       IF( M.EQ.0 )
00133      $   RETURN
00134       IF( LSAME( JOB, 'N' ) )
00135      $   RETURN
00136 *
00137       IF( ILO.EQ.IHI )
00138      $   GO TO 30
00139 *
00140 *     Backward balance
00141 *
00142       IF( LSAME( JOB, 'S' ) .OR. LSAME( JOB, 'B' ) ) THEN
00143 *
00144 *        Backward transformation on right eigenvectors
00145 *
00146          IF( RIGHTV ) THEN
00147             DO 10 I = ILO, IHI
00148                CALL SSCAL( M, RSCALE( I ), V( I, 1 ), LDV )
00149    10       CONTINUE
00150          END IF
00151 *
00152 *        Backward transformation on left eigenvectors
00153 *
00154          IF( LEFTV ) THEN
00155             DO 20 I = ILO, IHI
00156                CALL SSCAL( M, LSCALE( I ), V( I, 1 ), LDV )
00157    20       CONTINUE
00158          END IF
00159       END IF
00160 *
00161 *     Backward permutation
00162 *
00163    30 CONTINUE
00164       IF( LSAME( JOB, 'P' ) .OR. LSAME( JOB, 'B' ) ) THEN
00165 *
00166 *        Backward permutation on right eigenvectors
00167 *
00168          IF( RIGHTV ) THEN
00169             IF( ILO.EQ.1 )
00170      $         GO TO 50
00171 *
00172             DO 40 I = ILO - 1, 1, -1
00173                K = RSCALE( I )
00174                IF( K.EQ.I )
00175      $            GO TO 40
00176                CALL SSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV )
00177    40       CONTINUE
00178 *
00179    50       CONTINUE
00180             IF( IHI.EQ.N )
00181      $         GO TO 70
00182             DO 60 I = IHI + 1, N
00183                K = RSCALE( I )
00184                IF( K.EQ.I )
00185      $            GO TO 60
00186                CALL SSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV )
00187    60       CONTINUE
00188          END IF
00189 *
00190 *        Backward permutation on left eigenvectors
00191 *
00192    70    CONTINUE
00193          IF( LEFTV ) THEN
00194             IF( ILO.EQ.1 )
00195      $         GO TO 90
00196             DO 80 I = ILO - 1, 1, -1
00197                K = LSCALE( I )
00198                IF( K.EQ.I )
00199      $            GO TO 80
00200                CALL SSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV )
00201    80       CONTINUE
00202 *
00203    90       CONTINUE
00204             IF( IHI.EQ.N )
00205      $         GO TO 110
00206             DO 100 I = IHI + 1, N
00207                K = LSCALE( I )
00208                IF( K.EQ.I )
00209      $            GO TO 100
00210                CALL SSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV )
00211   100       CONTINUE
00212          END IF
00213       END IF
00214 *
00215   110 CONTINUE
00216 *
00217       RETURN
00218 *
00219 *     End of SGGBAK
00220 *
00221       END