LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
sggbak.f
Go to the documentation of this file.
00001 *> \brief \b SGGBAK
00002 *
00003 *  =========== DOCUMENTATION ===========
00004 *
00005 * Online html documentation available at 
00006 *            http://www.netlib.org/lapack/explore-html/ 
00007 *
00008 *> \htmlonly
00009 *> Download SGGBAK + dependencies 
00010 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sggbak.f"> 
00011 *> [TGZ]</a> 
00012 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sggbak.f"> 
00013 *> [ZIP]</a> 
00014 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sggbak.f"> 
00015 *> [TXT]</a>
00016 *> \endhtmlonly 
00017 *
00018 *  Definition:
00019 *  ===========
00020 *
00021 *       SUBROUTINE SGGBAK( JOB, SIDE, N, ILO, IHI, LSCALE, RSCALE, M, V,
00022 *                          LDV, INFO )
00023 * 
00024 *       .. Scalar Arguments ..
00025 *       CHARACTER          JOB, SIDE
00026 *       INTEGER            IHI, ILO, INFO, LDV, M, N
00027 *       ..
00028 *       .. Array Arguments ..
00029 *       REAL               LSCALE( * ), RSCALE( * ), V( LDV, * )
00030 *       ..
00031 *  
00032 *
00033 *> \par Purpose:
00034 *  =============
00035 *>
00036 *> \verbatim
00037 *>
00038 *> SGGBAK forms the right or left eigenvectors of a real generalized
00039 *> eigenvalue problem A*x = lambda*B*x, by backward transformation on
00040 *> the computed eigenvectors of the balanced pair of matrices output by
00041 *> SGGBAL.
00042 *> \endverbatim
00043 *
00044 *  Arguments:
00045 *  ==========
00046 *
00047 *> \param[in] JOB
00048 *> \verbatim
00049 *>          JOB is CHARACTER*1
00050 *>          Specifies the type of backward transformation required:
00051 *>          = 'N':  do nothing, return immediately;
00052 *>          = 'P':  do backward transformation for permutation only;
00053 *>          = 'S':  do backward transformation for scaling only;
00054 *>          = 'B':  do backward transformations for both permutation and
00055 *>                  scaling.
00056 *>          JOB must be the same as the argument JOB supplied to SGGBAL.
00057 *> \endverbatim
00058 *>
00059 *> \param[in] SIDE
00060 *> \verbatim
00061 *>          SIDE is CHARACTER*1
00062 *>          = 'R':  V contains right eigenvectors;
00063 *>          = 'L':  V contains left eigenvectors.
00064 *> \endverbatim
00065 *>
00066 *> \param[in] N
00067 *> \verbatim
00068 *>          N is INTEGER
00069 *>          The number of rows of the matrix V.  N >= 0.
00070 *> \endverbatim
00071 *>
00072 *> \param[in] ILO
00073 *> \verbatim
00074 *>          ILO is INTEGER
00075 *> \endverbatim
00076 *>
00077 *> \param[in] IHI
00078 *> \verbatim
00079 *>          IHI is INTEGER
00080 *>          The integers ILO and IHI determined by SGGBAL.
00081 *>          1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.
00082 *> \endverbatim
00083 *>
00084 *> \param[in] LSCALE
00085 *> \verbatim
00086 *>          LSCALE is REAL array, dimension (N)
00087 *>          Details of the permutations and/or scaling factors applied
00088 *>          to the left side of A and B, as returned by SGGBAL.
00089 *> \endverbatim
00090 *>
00091 *> \param[in] RSCALE
00092 *> \verbatim
00093 *>          RSCALE is REAL array, dimension (N)
00094 *>          Details of the permutations and/or scaling factors applied
00095 *>          to the right side of A and B, as returned by SGGBAL.
00096 *> \endverbatim
00097 *>
00098 *> \param[in] M
00099 *> \verbatim
00100 *>          M is INTEGER
00101 *>          The number of columns of the matrix V.  M >= 0.
00102 *> \endverbatim
00103 *>
00104 *> \param[in,out] V
00105 *> \verbatim
00106 *>          V is REAL array, dimension (LDV,M)
00107 *>          On entry, the matrix of right or left eigenvectors to be
00108 *>          transformed, as returned by STGEVC.
00109 *>          On exit, V is overwritten by the transformed eigenvectors.
00110 *> \endverbatim
00111 *>
00112 *> \param[in] LDV
00113 *> \verbatim
00114 *>          LDV is INTEGER
00115 *>          The leading dimension of the matrix V. LDV >= max(1,N).
00116 *> \endverbatim
00117 *>
00118 *> \param[out] INFO
00119 *> \verbatim
00120 *>          INFO is INTEGER
00121 *>          = 0:  successful exit.
00122 *>          < 0:  if INFO = -i, the i-th argument had an illegal value.
00123 *> \endverbatim
00124 *
00125 *  Authors:
00126 *  ========
00127 *
00128 *> \author Univ. of Tennessee 
00129 *> \author Univ. of California Berkeley 
00130 *> \author Univ. of Colorado Denver 
00131 *> \author NAG Ltd. 
00132 *
00133 *> \date November 2011
00134 *
00135 *> \ingroup realGBcomputational
00136 *
00137 *> \par Further Details:
00138 *  =====================
00139 *>
00140 *> \verbatim
00141 *>
00142 *>  See R.C. Ward, Balancing the generalized eigenvalue problem,
00143 *>                 SIAM J. Sci. Stat. Comp. 2 (1981), 141-152.
00144 *> \endverbatim
00145 *>
00146 *  =====================================================================
00147       SUBROUTINE SGGBAK( JOB, SIDE, N, ILO, IHI, LSCALE, RSCALE, M, V,
00148      $                   LDV, INFO )
00149 *
00150 *  -- LAPACK computational routine (version 3.4.0) --
00151 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00152 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00153 *     November 2011
00154 *
00155 *     .. Scalar Arguments ..
00156       CHARACTER          JOB, SIDE
00157       INTEGER            IHI, ILO, INFO, LDV, M, N
00158 *     ..
00159 *     .. Array Arguments ..
00160       REAL               LSCALE( * ), RSCALE( * ), V( LDV, * )
00161 *     ..
00162 *
00163 *  =====================================================================
00164 *
00165 *     .. Local Scalars ..
00166       LOGICAL            LEFTV, RIGHTV
00167       INTEGER            I, K
00168 *     ..
00169 *     .. External Functions ..
00170       LOGICAL            LSAME
00171       EXTERNAL           LSAME
00172 *     ..
00173 *     .. External Subroutines ..
00174       EXTERNAL           SSCAL, SSWAP, XERBLA
00175 *     ..
00176 *     .. Intrinsic Functions ..
00177       INTRINSIC          MAX
00178 *     ..
00179 *     .. Executable Statements ..
00180 *
00181 *     Test the input parameters
00182 *
00183       RIGHTV = LSAME( SIDE, 'R' )
00184       LEFTV = LSAME( SIDE, 'L' )
00185 *
00186       INFO = 0
00187       IF( .NOT.LSAME( JOB, 'N' ) .AND. .NOT.LSAME( JOB, 'P' ) .AND.
00188      $    .NOT.LSAME( JOB, 'S' ) .AND. .NOT.LSAME( JOB, 'B' ) ) THEN
00189          INFO = -1
00190       ELSE IF( .NOT.RIGHTV .AND. .NOT.LEFTV ) THEN
00191          INFO = -2
00192       ELSE IF( N.LT.0 ) THEN
00193          INFO = -3
00194       ELSE IF( ILO.LT.1 ) THEN
00195          INFO = -4
00196       ELSE IF( N.EQ.0 .AND. IHI.EQ.0 .AND. ILO.NE.1 ) THEN
00197          INFO = -4
00198       ELSE IF( N.GT.0 .AND. ( IHI.LT.ILO .OR. IHI.GT.MAX( 1, N ) ) )
00199      $   THEN
00200          INFO = -5
00201       ELSE IF( N.EQ.0 .AND. ILO.EQ.1 .AND. IHI.NE.0 ) THEN
00202          INFO = -5
00203       ELSE IF( M.LT.0 ) THEN
00204          INFO = -8
00205       ELSE IF( LDV.LT.MAX( 1, N ) ) THEN
00206          INFO = -10
00207       END IF
00208       IF( INFO.NE.0 ) THEN
00209          CALL XERBLA( 'SGGBAK', -INFO )
00210          RETURN
00211       END IF
00212 *
00213 *     Quick return if possible
00214 *
00215       IF( N.EQ.0 )
00216      $   RETURN
00217       IF( M.EQ.0 )
00218      $   RETURN
00219       IF( LSAME( JOB, 'N' ) )
00220      $   RETURN
00221 *
00222       IF( ILO.EQ.IHI )
00223      $   GO TO 30
00224 *
00225 *     Backward balance
00226 *
00227       IF( LSAME( JOB, 'S' ) .OR. LSAME( JOB, 'B' ) ) THEN
00228 *
00229 *        Backward transformation on right eigenvectors
00230 *
00231          IF( RIGHTV ) THEN
00232             DO 10 I = ILO, IHI
00233                CALL SSCAL( M, RSCALE( I ), V( I, 1 ), LDV )
00234    10       CONTINUE
00235          END IF
00236 *
00237 *        Backward transformation on left eigenvectors
00238 *
00239          IF( LEFTV ) THEN
00240             DO 20 I = ILO, IHI
00241                CALL SSCAL( M, LSCALE( I ), V( I, 1 ), LDV )
00242    20       CONTINUE
00243          END IF
00244       END IF
00245 *
00246 *     Backward permutation
00247 *
00248    30 CONTINUE
00249       IF( LSAME( JOB, 'P' ) .OR. LSAME( JOB, 'B' ) ) THEN
00250 *
00251 *        Backward permutation on right eigenvectors
00252 *
00253          IF( RIGHTV ) THEN
00254             IF( ILO.EQ.1 )
00255      $         GO TO 50
00256 *
00257             DO 40 I = ILO - 1, 1, -1
00258                K = RSCALE( I )
00259                IF( K.EQ.I )
00260      $            GO TO 40
00261                CALL SSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV )
00262    40       CONTINUE
00263 *
00264    50       CONTINUE
00265             IF( IHI.EQ.N )
00266      $         GO TO 70
00267             DO 60 I = IHI + 1, N
00268                K = RSCALE( I )
00269                IF( K.EQ.I )
00270      $            GO TO 60
00271                CALL SSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV )
00272    60       CONTINUE
00273          END IF
00274 *
00275 *        Backward permutation on left eigenvectors
00276 *
00277    70    CONTINUE
00278          IF( LEFTV ) THEN
00279             IF( ILO.EQ.1 )
00280      $         GO TO 90
00281             DO 80 I = ILO - 1, 1, -1
00282                K = LSCALE( I )
00283                IF( K.EQ.I )
00284      $            GO TO 80
00285                CALL SSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV )
00286    80       CONTINUE
00287 *
00288    90       CONTINUE
00289             IF( IHI.EQ.N )
00290      $         GO TO 110
00291             DO 100 I = IHI + 1, N
00292                K = LSCALE( I )
00293                IF( K.EQ.I )
00294      $            GO TO 100
00295                CALL SSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV )
00296   100       CONTINUE
00297          END IF
00298       END IF
00299 *
00300   110 CONTINUE
00301 *
00302       RETURN
00303 *
00304 *     End of SGGBAK
00305 *
00306       END
 All Files Functions