LAPACK: SRC/cggbak.f Source File

Go to the documentation of this file.
00001       SUBROUTINE CGGBAK( 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( * )
00015       COMPLEX            V( LDV, * )
00016 *     ..
00017 *
00018 *  Purpose
00019 *  =======
00020 *
00021 *  CGGBAK forms the right or left eigenvectors of a complex generalized
00022 *  eigenvalue problem A*x = lambda*B*x, by backward transformation on
00023 *  the computed eigenvectors of the balanced pair of matrices output by
00024 *  CGGBAL.
00025 *
00026 *  Arguments
00027 *  =========
00028 *
00029 *  JOB     (input) CHARACTER*1
00030 *          Specifies the type of backward transformation required:
00031 *          = 'N':  do nothing, return immediately;
00032 *          = 'P':  do backward transformation for permutation only;
00033 *          = 'S':  do backward transformation for scaling only;
00034 *          = 'B':  do backward transformations for both permutation and
00035 *                  scaling.
00036 *          JOB must be the same as the argument JOB supplied to CGGBAL.
00037 *
00038 *  SIDE    (input) CHARACTER*1
00039 *          = 'R':  V contains right eigenvectors;
00040 *          = 'L':  V contains left eigenvectors.
00041 *
00042 *  N       (input) INTEGER
00043 *          The number of rows of the matrix V.  N >= 0.
00044 *
00045 *  ILO     (input) INTEGER
00046 *  IHI     (input) INTEGER
00047 *          The integers ILO and IHI determined by CGGBAL.
00048 *          1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.
00049 *
00050 *  LSCALE  (input) REAL array, dimension (N)
00051 *          Details of the permutations and/or scaling factors applied
00052 *          to the left side of A and B, as returned by CGGBAL.
00053 *
00054 *  RSCALE  (input) REAL array, dimension (N)
00055 *          Details of the permutations and/or scaling factors applied
00056 *          to the right side of A and B, as returned by CGGBAL.
00057 *
00058 *  M       (input) INTEGER
00059 *          The number of columns of the matrix V.  M >= 0.
00060 *
00061 *  V       (input/output) COMPLEX array, dimension (LDV,M)
00062 *          On entry, the matrix of right or left eigenvectors to be
00063 *          transformed, as returned by CTGEVC.
00064 *          On exit, V is overwritten by the transformed eigenvectors.
00065 *
00066 *  LDV     (input) INTEGER
00067 *          The leading dimension of the matrix V. LDV >= max(1,N).
00068 *
00069 *  INFO    (output) INTEGER
00070 *          = 0:  successful exit.
00071 *          < 0:  if INFO = -i, the i-th argument had an illegal value.
00072 *
00073 *  Further Details
00074 *  ===============
00075 *
00076 *  See R.C. Ward, Balancing the generalized eigenvalue problem,
00077 *                 SIAM J. Sci. Stat. Comp. 2 (1981), 141-152.
00078 *
00079 *  =====================================================================
00080 *
00081 *     .. Local Scalars ..
00082       LOGICAL            LEFTV, RIGHTV
00083       INTEGER            I, K
00084 *     ..
00085 *     .. External Functions ..
00086       LOGICAL            LSAME
00087       EXTERNAL           LSAME
00088 *     ..
00089 *     .. External Subroutines ..
00090       EXTERNAL           CSSCAL, CSWAP, XERBLA
00091 *     ..
00092 *     .. Intrinsic Functions ..
00093       INTRINSIC          MAX
00094 *     ..
00095 *     .. Executable Statements ..
00096 *
00097 *     Test the input parameters
00098 *
00099       RIGHTV = LSAME( SIDE, 'R' )
00100       LEFTV = LSAME( SIDE, 'L' )
00101 *
00102       INFO = 0
00103       IF( .NOT.LSAME( JOB, 'N' ) .AND. .NOT.LSAME( JOB, 'P' ) .AND.
00104      $    .NOT.LSAME( JOB, 'S' ) .AND. .NOT.LSAME( JOB, 'B' ) ) THEN
00105          INFO = -1
00106       ELSE IF( .NOT.RIGHTV .AND. .NOT.LEFTV ) THEN
00107          INFO = -2
00108       ELSE IF( N.LT.0 ) THEN
00109          INFO = -3
00110       ELSE IF( ILO.LT.1 ) THEN
00111          INFO = -4
00112       ELSE IF( N.EQ.0 .AND. IHI.EQ.0 .AND. ILO.NE.1 ) THEN
00113          INFO = -4
00114       ELSE IF( N.GT.0 .AND. ( IHI.LT.ILO .OR. IHI.GT.MAX( 1, N ) ) )
00115      $   THEN
00116          INFO = -5
00117       ELSE IF( N.EQ.0 .AND. ILO.EQ.1 .AND. IHI.NE.0 ) THEN
00118          INFO = -5
00119       ELSE IF( M.LT.0 ) THEN
00120          INFO = -8
00121       ELSE IF( LDV.LT.MAX( 1, N ) ) THEN
00122          INFO = -10
00123       END IF
00124       IF( INFO.NE.0 ) THEN
00125          CALL XERBLA( 'CGGBAK', -INFO )
00126          RETURN
00127       END IF
00128 *
00129 *     Quick return if possible
00130 *
00131       IF( N.EQ.0 )
00132      $   RETURN
00133       IF( M.EQ.0 )
00134      $   RETURN
00135       IF( LSAME( JOB, 'N' ) )
00136      $   RETURN
00137 *
00138       IF( ILO.EQ.IHI )
00139      $   GO TO 30
00140 *
00141 *     Backward balance
00142 *
00143       IF( LSAME( JOB, 'S' ) .OR. LSAME( JOB, 'B' ) ) THEN
00144 *
00145 *        Backward transformation on right eigenvectors
00146 *
00147          IF( RIGHTV ) THEN
00148             DO 10 I = ILO, IHI
00149                CALL CSSCAL( M, RSCALE( I ), V( I, 1 ), LDV )
00150    10       CONTINUE
00151          END IF
00152 *
00153 *        Backward transformation on left eigenvectors
00154 *
00155          IF( LEFTV ) THEN
00156             DO 20 I = ILO, IHI
00157                CALL CSSCAL( M, LSCALE( I ), V( I, 1 ), LDV )
00158    20       CONTINUE
00159          END IF
00160       END IF
00161 *
00162 *     Backward permutation
00163 *
00164    30 CONTINUE
00165       IF( LSAME( JOB, 'P' ) .OR. LSAME( JOB, 'B' ) ) THEN
00166 *
00167 *        Backward permutation on right eigenvectors
00168 *
00169          IF( RIGHTV ) THEN
00170             IF( ILO.EQ.1 )
00171      $         GO TO 50
00172             DO 40 I = ILO - 1, 1, -1
00173                K = RSCALE( I )
00174                IF( K.EQ.I )
00175      $            GO TO 40
00176                CALL CSWAP( 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 CSWAP( 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 CSWAP( 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 CSWAP( 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 CGGBAK
00220 *
00221       END