Numérotation des lignes :

dorm2r
C DORM2R    SOURCE    BP208322  18/07/10    21:15:22     9872           *> \brief \b DORM2R multiplies a general matrix by the orthogonal matrix from a QR factorization determined by sgeqrf (unblocked algorithm).**  =========== DOCUMENTATION ===========** Online html documentation available at*            http://www.netlib.org/lapack/explore-html/**> \htmlonly*> Download DORM2R + dependencies*> &lt;a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dorm2r.f">*> [TGZ]&lt;/a>*> &lt;a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dorm2r.f">*> [ZIP]&lt;/a>*> &lt;a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dorm2r.f">*> [TXT]&lt;/a>*> \endhtmlonly**  Definition:*  ===========**       SUBROUTINE DORM2R( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,*                          WORK, INFO )**       .. Scalar Arguments ..*       CHARACTER          SIDE, TRANS*       INTEGER            INFO, K, LDA, LDC, M, N*       ..*       .. Array Arguments ..*       REAL*8   A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )*       ..***> \par Purpose:*  =============*>*> \verbatim*>*> DORM2R overwrites the general real m by n matrix C with*>*>       Q * C  if SIDE = 'L' and TRANS = 'N', or*>*>       Q**T* C  if SIDE = 'L' and TRANS = 'T', or*>*>       C * Q  if SIDE = 'R' and TRANS = 'N', or*>*>       C * Q**T if SIDE = 'R' and TRANS = 'T',*>*> where Q is a real orthogonal matrix defined as the product of k*> elementary reflectors*>*>       Q = H(1) H(2) . . . H(k)*>*> as returned by DGEQRF. Q is of order m if SIDE = 'L' and of order n*> if SIDE = 'R'.*> \endverbatim**  Arguments:*  ==========**> \param[in] SIDE*> \verbatim*>          SIDE is CHARACTER*1*>          = 'L': apply Q or Q**T from the Left*>          = 'R': apply Q or Q**T from the Right*> \endverbatim*>*> \param[in] TRANS*> \verbatim*>          TRANS is CHARACTER*1*>          = 'N': apply Q  (No transpose)*>          = 'T': apply Q**T (Transpose)*> \endverbatim*>*> \param[in] M*> \verbatim*>          M is INTEGER*>          The number of rows of the matrix C. M >= 0.*> \endverbatim*>*> \param[in] N*> \verbatim*>          N is INTEGER*>          The number of columns of the matrix C. N >= 0.*> \endverbatim*>*> \param[in] K*> \verbatim*>          K is INTEGER*>          The number of elementary reflectors whose product defines*>          the matrix Q.*>          If SIDE = 'L', M >= K >= 0;*>          if SIDE = 'R', N >= K >= 0.*> \endverbatim*>*> \param[in] A*> \verbatim*>          A is DOUBLE PRECISION array, dimension (LDA,K)*>          The i-th column must contain the vector which defines the*>          elementary reflector H(i), for i = 1,2,...,k, as returned by*>          DGEQRF in the first k columns of its array argument A.*>          A is modified by the routine but restored on exit.*> \endverbatim*>*> \param[in] LDA*> \verbatim*>          LDA is INTEGER*>          The leading dimension of the array A.*>          If SIDE = 'L', LDA >= max(1,M);*>          if SIDE = 'R', LDA >= max(1,N).*> \endverbatim*>*> \param[in] TAU*> \verbatim*>          TAU is DOUBLE PRECISION array, dimension (K)*>          TAU(i) must contain the scalar factor of the elementary*>          reflector H(i), as returned by DGEQRF.*> \endverbatim*>*> \param[in,out] C*> \verbatim*>          C is DOUBLE PRECISION array, dimension (LDC,N)*>          On entry, the m by n matrix C.*>          On exit, C is overwritten by Q*C or Q**T*C or C*Q**T or C*Q.*> \endverbatim*>*> \param[in] LDC*> \verbatim*>          LDC is INTEGER*>          The leading dimension of the array C. LDC >= max(1,M).*> \endverbatim*>*> \param[out] WORK*> \verbatim*>          WORK is DOUBLE PRECISION array, dimension*>                                   (N) if SIDE = 'L',*>                                   (M) if SIDE = 'R'*> \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 doubleOTHERcomputational**  =====================================================================      SUBROUTINE DORM2R( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,     $WORK, 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** .. Scalar Arguments .. CHARACTER SIDE, TRANS INTEGER INFO, K, LDA, LDC, M, N* ..* .. Array Arguments .. REAL*8 A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )* ..** =====================================================================** .. Parameters .. REAL*8 ONE PARAMETER ( ONE = 1.0D+0 )* ..* .. Local Scalars .. LOGICAL LEFT, NOTRAN INTEGER I, I1, I2, I3, IC, JC, MI, NI, NQ REAL*8 AII* ..* .. External Functions .. LOGICAL LSAME EXTERNAL LSAME* ..* .. External Subroutines .. EXTERNAL DLARF, XERBLA* ..** .. Intrinsic Functions ..* INTRINSIC MAX** ..** .. Executable Statements ..** Test the input arguments* INFO = 0 LEFT = LSAME( SIDE, 'L' ) NOTRAN = LSAME( TRANS, 'N' )** NQ is the order of Q* IF( LEFT ) THEN NQ = M ELSE NQ = N END IF IF( .NOT.LEFT .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN INFO = -1 ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) ) THEN INFO = -2 ELSE IF( M.LT.0 ) THEN INFO = -3 ELSE IF( N.LT.0 ) THEN INFO = -4 ELSE IF( K.LT.0 .OR. K.GT.NQ ) THEN INFO = -5 ELSE IF( LDA.LT.MAX( 1, NQ ) ) THEN INFO = -7 ELSE IF( LDC.LT.MAX( 1, M ) ) THEN INFO = -10 END IF IF( INFO.NE.0 ) THEN CALL XERBLA( 'DORM2R', -INFO ) RETURN END IF** Quick return if possible* IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 )$   RETURN*      IF( ( LEFT .AND. .NOT.NOTRAN ) .OR. ( .NOT.LEFT .AND. NOTRAN ) )     $THEN I1 = 1 I2 = K I3 = 1 ELSE I1 = K I2 = 1 I3 = -1 END IF* IF( LEFT ) THEN NI = N JC = 1 ELSE MI = M IC = 1 END IF* DO 10 I = I1, I2, I3 IF( LEFT ) THEN** H(i) is applied to C(i:m,1:n)* MI = M - I + 1 IC = I ELSE** H(i) is applied to C(1:m,i:n)* NI = N - I + 1 JC = I END IF** Apply H(i)* AII = A( I, I ) A( I, I ) = ONE CALL DLARF( SIDE, MI, NI, A( I, I ), 1, TAU( I ), C( IC, JC ),$               LDC, WORK )         A( I, I ) = AII   10 CONTINUE      RETURN**     End of DORM2R*      END   

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