Numérotation des lignes :

C DGEBAK    SOURCE    BP208322  20/09/18    21:15:46     10718          *> \brief \b DGEBAK**  =========== DOCUMENTATION ===========** Online html documentation available at*            http://www.netlib.org/lapack/explore-html/**> \htmlonly*> Download DGEBAK + dependencies*> &lt;a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgebak.f">*> [TGZ]&lt;/a>*> &lt;a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgebak.f">*> [ZIP]&lt;/a>*> &lt;a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgebak.f">*> [TXT]&lt;/a>*> \endhtmlonly**  Definition:*  ===========**       SUBROUTINE DGEBAK( JOB, SIDE, N, ILO, IHI, SCALE, M, V, LDV,*                          INFO )**       .. Scalar Arguments ..*       CHARACTER          JOB, SIDE*       INTEGER            IHI, ILO, INFO, LDV, M, N*       ..*       .. Array Arguments ..*       REAL*8   SCALE( * ), V( LDV, * )*       ..***> \par Purpose:*  =============*>*> \verbatim*>*> DGEBAK forms the right or left eigenvectors of a real general matrix*> by backward transformation on the computed eigenvectors of the*> balanced matrix output by DGEBAL.*> \endverbatim**  Arguments:*  ==========**> \param[in] JOB*> \verbatim*>          JOB is CHARACTER*1*>          Specifies the type of backward transformation required:*>          = 'N', do nothing, return immediately;*>          = 'P', do backward transformation for permutation only;*>          = 'S', do backward transformation for scaling only;*>          = 'B', do backward transformations for both permutation and*>                 scaling.*>          JOB must be the same as the argument JOB supplied to DGEBAL.*> \endverbatim*>*> \param[in] SIDE*> \verbatim*>          SIDE is CHARACTER*1*>          = 'R':  V contains right eigenvectors;*>          = 'L':  V contains left eigenvectors.*> \endverbatim*>*> \param[in] N*> \verbatim*>          N is INTEGER*>          The number of rows of the matrix V.  N >= 0.*> \endverbatim*>*> \param[in] ILO*> \verbatim*>          ILO is INTEGER*> \endverbatim*>*> \param[in] IHI*> \verbatim*>          IHI is INTEGER*>          The integers ILO and IHI determined by DGEBAL.*>          1 &lt;= ILO &lt;= IHI &lt;= N, if N > 0; ILO=1 and IHI=0, if N=0.*> \endverbatim*>*> \param[in] SCALE*> \verbatim*>          SCALE is REAL*8 array, dimension (N)*>          Details of the permutation and scaling factors, as returned*>          by DGEBAL.*> \endverbatim*>*> \param[in] M*> \verbatim*>          M is INTEGER*>          The number of columns of the matrix V.  M >= 0.*> \endverbatim*>*> \param[in,out] V*> \verbatim*>          V is REAL*8 array, dimension (LDV,M)*>          On entry, the matrix of right or left eigenvectors to be*>          transformed, as returned by DHSEIN or DTREVC.*>          On exit, V is overwritten by the transformed eigenvectors.*> \endverbatim*>*> \param[in] LDV*> \verbatim*>          LDV is INTEGER*>          The leading dimension of the array V. LDV >= max(1,N).*> \endverbatim*>*> \param[out] INFO*> \verbatim*>          INFO is INTEGER*>          = 0:  successful exit*>          &lt; 0:  if INFO = -i, the i-th argument had an illegal value.*> \endverbatim**  Authors:*  ========**> \author Univ. of Tennessee*> \author Univ. of California Berkeley*> \author Univ. of Colorado Denver*> \author NAG Ltd.**> \date December 2016**> \ingroup doubleGEcomputational**  =====================================================================      SUBROUTINE DGEBAK( JOB, SIDE, N, ILO, IHI, SCALE, M, V, LDV,     $INFO )** -- LAPACK computational routine (version 3.7.0) --* -- LAPACK is a software package provided by Univ. of Tennessee, --* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--* December 2016 IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) ** .. Scalar Arguments .. CHARACTER JOB, SIDE INTEGER IHI, ILO, INFO, LDV, M, N* ..* .. Array Arguments .. REAL*8 SCALE( * ), V( LDV, * )* ..** =====================================================================** .. Parameters .. REAL*8 ONE PARAMETER ( ONE = 1.0D+0 )* ..* .. Local Scalars .. LOGICAL LEFTV, RIGHTV INTEGER I, II, K REAL*8 S* ..* .. External Functions .. LOGICAL LSAME* EXTERNAL LSAME* ..* .. External Subroutines ..* EXTERNAL DSCAL, DSWAP, XERBLA* ..* .. Intrinsic Functions ..* INTRINSIC MAX, MIN* ..* .. Executable Statements ..** Decode and Test the input parameters* RIGHTV = LSAME( SIDE, 'R' ) LEFTV = LSAME( SIDE, 'L' )* INFO = 0 IF( .NOT.LSAME( JOB, 'N' ) .AND. .NOT.LSAME( JOB, 'P' ) .AND.$    .NOT.LSAME( JOB, 'S' ) .AND. .NOT.LSAME( JOB, 'B' ) ) THEN         INFO = -1      ELSE IF( .NOT.RIGHTV .AND. .NOT.LEFTV ) THEN         INFO = -2      ELSE IF( N.LT.0 ) THEN         INFO = -3      ELSE IF( ILO.LT.1 .OR. ILO.GT.MAX( 1, N ) ) THEN         INFO = -4      ELSE IF( IHI.LT.MIN( ILO, N ) .OR. IHI.GT.N ) THEN         INFO = -5      ELSE IF( M.LT.0 ) THEN         INFO = -7      ELSE IF( LDV.LT.MAX( 1, N ) ) THEN         INFO = -9      END IF      IF( INFO.NE.0 ) THEN         CALL XERBLA( 'DGEBAK', -INFO )         RETURN      END IF**     Quick return if possible*      IF( N.EQ.0 )     $RETURN IF( M.EQ.0 )$   RETURN      IF( LSAME( JOB, 'N' ) )     $RETURN* IF( ILO.EQ.IHI )$   GO TO 30**     Backward balance*      IF( LSAME( JOB, 'S' ) .OR. LSAME( JOB, 'B' ) ) THEN*         IF( RIGHTV ) THEN            DO 10 I = ILO, IHI               S = SCALE( I )               CALL DSCAL( M, S, V( I, 1 ), LDV )   10       CONTINUE         END IF*         IF( LEFTV ) THEN            DO 20 I = ILO, IHI               S = ONE / SCALE( I )               CALL DSCAL( M, S, V( I, 1 ), LDV )   20       CONTINUE         END IF*      END IF**     Backward permutation**     For  I = ILO-1 step -1 until 1,*              IHI+1 step 1 until N do --*   30 CONTINUE      IF( LSAME( JOB, 'P' ) .OR. LSAME( JOB, 'B' ) ) THEN         IF( RIGHTV ) THEN            DO 40 II = 1, N               I = II               IF( I.GE.ILO .AND. I.LE.IHI )     $GO TO 40 IF( I.LT.ILO )$            I = ILO - IIcpoureviterwarning K = SCALE( I )               K = INT(SCALE( I ))               IF( K.EQ.I )     $GO TO 40 CALL DSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV ) 40 CONTINUE END IF* IF( LEFTV ) THEN DO 50 II = 1, N I = II IF( I.GE.ILO .AND. I.LE.IHI )$            GO TO 50               IF( I.LT.ILO )     $I = ILO - IIcpoureviterwarning K = SCALE( I ) K = INT(SCALE( I )) IF( K.EQ.I )$            GO TO 50               CALL DSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV )   50       CONTINUE         END IF      END IF*      RETURN**     End of DGEBAK*      END

© Cast3M 2003 - Tous droits réservés.
Mentions légales