Numérotation des lignes :

dormqr
C DORMQR    SOURCE    FANDEUR   22/05/02    21:15:13     11359          *> \brief \b DORMQR**  =========== DOCUMENTATION ===========** Online html documentation available at*            http://www.netlib.org/lapack/explore-html/**> \htmlonly*> Download DORMQR + dependencies*> &lt;a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dormqr.f">*> [TGZ]&lt;/a>*> &lt;a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dormqr.f">*> [ZIP]&lt;/a>*> &lt;a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dormqr.f">*> [TXT]&lt;/a>*> \endhtmlonly**  Definition:*  ===========**       SUBROUTINE DORMQR( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,*                          WORK, LWORK, INFO )**       .. Scalar Arguments ..*       CHARACTER          SIDE, TRANS*       INTEGER            INFO, K, LDA, LDC, LWORK, M, N*       ..*       .. Array Arguments ..*       REAL*8   A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )*       ..***> \par Purpose:*  =============*>*> \verbatim*>*> DORMQR overwrites the general real M-by-N matrix C with*>*>                 SIDE = 'L'     SIDE = 'R'*> TRANS = 'N':      Q * C          C * Q*> TRANS = 'T':      Q**T * C       C * Q**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':  No transpose, apply Q;*>          = 'T':  Transpose, apply Q**T.*> \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 REAL*8 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.*> \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 REAL*8 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 REAL*8 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 REAL*8 array, dimension (MAX(1,LWORK))*>          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.*> \endverbatim*>*> \param[in] LWORK*> \verbatim*>          LWORK is INTEGER*>          The dimension of the array WORK.*>          If SIDE = 'L', LWORK >= max(1,N);*>          if SIDE = 'R', LWORK >= max(1,M).*>          For good performance, LWORK should generally be larger.*>*>          If LWORK = -1, then a workspace query is assumed; the routine*>          only calculates the optimal size of the WORK array, returns*>          this value as the first entry of the WORK array, and no error*>          message related to LWORK is issued by XERBLA.*> \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 DORMQR( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,     $WORK, LWORK, 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 SIDE, TRANS INTEGER INFO, K, LDA, LDC, LWORK, M, N* ..* .. Array Arguments .. REAL*8 A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )* ..** =====================================================================** .. Parameters .. INTEGER NBMAX, LDT, TSIZE PARAMETER ( NBMAX = 64, LDT = NBMAX+1,$                     TSIZE = LDT*NBMAX )*     ..*     .. Local Scalars ..      LOGICAL            LEFT, LQUERY, NOTRAN      INTEGER            I, I1, I2, I3, IB, IC, IINFO, IWT, JC, LDWORK,     $LWKOPT, MI, NB, NBMIN, NI, NQ, NW* ..* .. External Functions .. LOGICAL LSAME INTEGER ILAENV EXTERNAL LSAME, ILAENV* ..* .. External Subroutines .. EXTERNAL DLARFB, DLARFT, DORM2R, XERBLA* ..* .. Intrinsic Functions ..* INTRINSIC MAX, MIN* ..* .. Executable Statements ..** Test the input arguments* INFO = 0 LEFT = LSAME( SIDE, 'L' ) NOTRAN = LSAME( TRANS, 'N' ) LQUERY = ( LWORK.EQ.-1 )** NQ is the order of Q and NW is the minimum dimension of WORK* IF( LEFT ) THEN NQ = M NW = N ELSE NQ = N NW = M 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 ELSE IF( LWORK.LT.MAX( 1, NW ) .AND. .NOT.LQUERY ) THEN INFO = -12 END IF* IF( INFO.EQ.0 ) THEN** Compute the workspace requirements* NB = MIN( NBMAX, ILAENV( 1, 'DORMQR', SIDE // TRANS,$                            M, N, K, -1 ) )         LWKOPT = MAX( 1, NW )*NB + TSIZE         WORK( 1 ) = LWKOPT      END IF*      IF( INFO.NE.0 ) THEN         CALL XERBLA( 'DORMQR', -INFO )         RETURN      ELSE IF( LQUERY ) THEN         RETURN      END IF**     Quick return if possible*      IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 ) THEN         WORK( 1 ) = 1         RETURN      END IF*      NBMIN = 2      LDWORK = NW      IF( NB.GT.1 .AND. NB.LT.K ) THEN         IF( LWORK.LT.NW*NB+TSIZE ) THEN            NB = (LWORK-TSIZE) / LDWORK            NBMIN = MAX( 2, ILAENV( 2, 'DORMQR', SIDE // TRANS,     $M, N, K, -1 ) ) END IF END IF* IF( NB.LT.NBMIN .OR. NB.GE.K ) THEN** Use unblocked code* CALL DORM2R( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK,$                IINFO )      ELSE**        Use blocked code*         IWT = 1 + NW*NB         IF( ( LEFT .AND. .NOT.NOTRAN ) .OR.     $( .NOT.LEFT .AND. NOTRAN ) ) THEN I1 = 1 I2 = K I3 = NB ELSE I1 = ( ( K-1 ) / NB )*NB + 1 I2 = 1 I3 = -NB END IF* IF( LEFT ) THEN NI = N JC = 1 ELSE MI = M IC = 1 END IF* DO 10 I = I1, I2, I3 IB = MIN( NB, K-I+1 )** Form the triangular factor of the block reflector* H = H(i) H(i+1) . . . H(i+ib-1)* CALL DLARFT( 'Forward', 'Columnwise', NQ-I+1, IB, A( I, I ),$                   LDA, TAU( I ), WORK( IWT ), LDT )            IF( LEFT ) THEN**              H or H**T is applied to C(i:m,1:n)*               MI = M - I + 1               IC = I            ELSE**              H or H**T is applied to C(1:m,i:n)*               NI = N - I + 1               JC = I            END IF**           Apply H or H**T*            CALL DLARFB( SIDE, TRANS, 'Forward', 'Columnwise', MI, NI,     $IB, A( I, I ), LDA, WORK( IWT ), LDT,$                   C( IC, JC ), LDC, WORK, LDWORK )   10    CONTINUE      END IF      WORK( 1 ) = LWKOPT      RETURN**     End of DORMQR*      END    

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