LAPACK: SRC/dgebak.f Source File

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