Page Menu
Home
c4science
Search
Configure Global Search
Log In
Files
F79853026
dorm2l.f
No One
Temporary
Actions
Download File
Edit File
Delete File
View Transforms
Subscribe
Mute Notifications
Award Token
Subscribers
None
File Metadata
Details
File Info
Storage
Attached
Created
Wed, Aug 28, 14:56
Size
7 KB
Mime Type
text/html
Expires
Fri, Aug 30, 14:56 (1 d, 21 h)
Engine
blob
Format
Raw Data
Handle
20236310
Attached To
rLAMMPS lammps
dorm2l.f
View Options
*> \brief \b DORM2L multiplies a general matrix by the orthogonal matrix from a QL factorization determined by sgeqlf (unblocked algorithm).
*
* =========== DOCUMENTATION ===========
*
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
*> \htmlonly
*> Download DORM2L + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dorm2l.f">
*> [TGZ]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dorm2l.f">
*> [ZIP]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dorm2l.f">
*> [TXT]</a>
*> \endhtmlonly
*
* Definition:
* ===========
*
* SUBROUTINE DORM2L( 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 ..
* DOUBLE PRECISION A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
* ..
*
*
*> \par Purpose:
* =============
*>
*> \verbatim
*>
*> DORM2L 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(k) . . . H(2) H(1)
*>
*> as returned by DGEQLF. 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
*> DGEQLF in the last 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 DGEQLF.
*> \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
*> < 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 September 2012
*
*> \ingroup doubleOTHERcomputational
*
* =====================================================================
SUBROUTINE DORM2L( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
$ WORK, INFO )
*
* -- LAPACK computational routine (version 3.4.2) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* September 2012
*
* .. Scalar Arguments ..
CHARACTER SIDE, TRANS
INTEGER INFO, K, LDA, LDC, M, N
* ..
* .. Array Arguments ..
DOUBLE PRECISION A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
* ..
*
* =====================================================================
*
* .. Parameters ..
DOUBLE PRECISION ONE
PARAMETER ( ONE = 1.0D+0 )
* ..
* .. Local Scalars ..
LOGICAL LEFT, NOTRAN
INTEGER I, I1, I2, I3, MI, NI, NQ
DOUBLE PRECISION 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( 'DORM2L', -INFO )
RETURN
END IF
*
* Quick return if possible
*
IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 )
$ RETURN
*
IF( ( LEFT .AND. NOTRAN ) .OR. ( .NOT.LEFT .AND. .NOT.NOTRAN ) )
$ THEN
I1 = 1
I2 = K
I3 = 1
ELSE
I1 = K
I2 = 1
I3 = -1
END IF
*
IF( LEFT ) THEN
NI = N
ELSE
MI = M
END IF
*
DO 10 I = I1, I2, I3
IF( LEFT ) THEN
*
* H(i) is applied to C(1:m-k+i,1:n)
*
MI = M - K + I
ELSE
*
* H(i) is applied to C(1:m,1:n-k+i)
*
NI = N - K + I
END IF
*
* Apply H(i)
*
AII = A( NQ-K+I, I )
A( NQ-K+I, I ) = ONE
CALL DLARF( SIDE, MI, NI, A( 1, I ), 1, TAU( I ), C, LDC,
$ WORK )
A( NQ-K+I, I ) = AII
10 CONTINUE
RETURN
*
* End of DORM2L
*
END
Event Timeline
Log In to Comment