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