Annotation of rpl/lapack/lapack/dgemqr.f, revision 1.1
1.1 ! bertrand 1: *
! 2: * Definition:
! 3: * ===========
! 4: *
! 5: * SUBROUTINE DGEMQR( SIDE, TRANS, M, N, K, A, LDA, T,
! 6: * $ TSIZE, C, LDC, WORK, LWORK, INFO )
! 7: *
! 8: *
! 9: * .. Scalar Arguments ..
! 10: * CHARACTER SIDE, TRANS
! 11: * INTEGER INFO, LDA, M, N, K, LDT, TSIZE, LWORK, LDC
! 12: * ..
! 13: * .. Array Arguments ..
! 14: * DOUBLE PRECISION A( LDA, * ), T( * ), C( LDC, * ), WORK( * )
! 15: * ..
! 16: *
! 17: *> \par Purpose:
! 18: * =============
! 19: *>
! 20: *> \verbatim
! 21: *>
! 22: *> DGEMQR overwrites the general real M-by-N matrix C with
! 23: *>
! 24: *> SIDE = 'L' SIDE = 'R'
! 25: *> TRANS = 'N': Q * C C * Q
! 26: *> TRANS = 'T': Q**T * C C * Q**T
! 27: *>
! 28: *> where Q is a real orthogonal matrix defined as the product
! 29: *> of blocked elementary reflectors computed by tall skinny
! 30: *> QR factorization (DGEQR)
! 31: *>
! 32: *> \endverbatim
! 33: *
! 34: * Arguments:
! 35: * ==========
! 36: *
! 37: *> \param[in] SIDE
! 38: *> \verbatim
! 39: *> SIDE is CHARACTER*1
! 40: *> = 'L': apply Q or Q**T from the Left;
! 41: *> = 'R': apply Q or Q**T from the Right.
! 42: *> \endverbatim
! 43: *>
! 44: *> \param[in] TRANS
! 45: *> \verbatim
! 46: *> TRANS is CHARACTER*1
! 47: *> = 'N': No transpose, apply Q;
! 48: *> = 'T': Transpose, apply Q**T.
! 49: *> \endverbatim
! 50: *>
! 51: *> \param[in] M
! 52: *> \verbatim
! 53: *> M is INTEGER
! 54: *> The number of rows of the matrix A. M >=0.
! 55: *> \endverbatim
! 56: *>
! 57: *> \param[in] N
! 58: *> \verbatim
! 59: *> N is INTEGER
! 60: *> The number of columns of the matrix C. N >= 0.
! 61: *> \endverbatim
! 62: *>
! 63: *> \param[in] K
! 64: *> \verbatim
! 65: *> K is INTEGER
! 66: *> The number of elementary reflectors whose product defines
! 67: *> the matrix Q.
! 68: *> If SIDE = 'L', M >= K >= 0;
! 69: *> if SIDE = 'R', N >= K >= 0.
! 70: *> \endverbatim
! 71: *>
! 72: *> \param[in] A
! 73: *> \verbatim
! 74: *> A is DOUBLE PRECISION array, dimension (LDA,K)
! 75: *> Part of the data structure to represent Q as returned by DGEQR.
! 76: *> \endverbatim
! 77: *>
! 78: *> \param[in] LDA
! 79: *> \verbatim
! 80: *> LDA is INTEGER
! 81: *> The leading dimension of the array A.
! 82: *> If SIDE = 'L', LDA >= max(1,M);
! 83: *> if SIDE = 'R', LDA >= max(1,N).
! 84: *> \endverbatim
! 85: *>
! 86: *> \param[in] T
! 87: *> \verbatim
! 88: *> T is DOUBLE PRECISION array, dimension (MAX(5,TSIZE)).
! 89: *> Part of the data structure to represent Q as returned by DGEQR.
! 90: *> \endverbatim
! 91: *>
! 92: *> \param[in] TSIZE
! 93: *> \verbatim
! 94: *> TSIZE is INTEGER
! 95: *> The dimension of the array T. TSIZE >= 5.
! 96: *> \endverbatim
! 97: *>
! 98: *> \param[in,out] C
! 99: *> \verbatim
! 100: *> C is DOUBLE PRECISION array, dimension (LDC,N)
! 101: *> On entry, the M-by-N matrix C.
! 102: *> On exit, C is overwritten by Q*C or Q**T*C or C*Q**T or C*Q.
! 103: *> \endverbatim
! 104: *>
! 105: *> \param[in] LDC
! 106: *> \verbatim
! 107: *> LDC is INTEGER
! 108: *> The leading dimension of the array C. LDC >= max(1,M).
! 109: *> \endverbatim
! 110: *>
! 111: *> \param[out] WORK
! 112: *> \verbatim
! 113: *> (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK))
! 114: *> \endverbatim
! 115: *>
! 116: *> \param[in] LWORK
! 117: *> \verbatim
! 118: *> LWORK is INTEGER
! 119: *> The dimension of the array WORK.
! 120: *> If LWORK = -1, then a workspace query is assumed. The routine
! 121: *> only calculates the size of the WORK array, returns this
! 122: *> value as WORK(1), and no error message related to WORK
! 123: *> is issued by XERBLA.
! 124: *> \endverbatim
! 125: *>
! 126: *> \param[out] INFO
! 127: *> \verbatim
! 128: *> INFO is INTEGER
! 129: *> = 0: successful exit
! 130: *> < 0: if INFO = -i, the i-th argument had an illegal value
! 131: *> \endverbatim
! 132: *
! 133: * Authors:
! 134: * ========
! 135: *
! 136: *> \author Univ. of Tennessee
! 137: *> \author Univ. of California Berkeley
! 138: *> \author Univ. of Colorado Denver
! 139: *> \author NAG Ltd.
! 140: *
! 141: *> \par Further Details
! 142: * ====================
! 143: *>
! 144: *> \verbatim
! 145: *>
! 146: *> These details are particular for this LAPACK implementation. Users should not
! 147: *> take them for granted. These details may change in the future, and are unlikely not
! 148: *> true for another LAPACK implementation. These details are relevant if one wants
! 149: *> to try to understand the code. They are not part of the interface.
! 150: *>
! 151: *> In this version,
! 152: *>
! 153: *> T(2): row block size (MB)
! 154: *> T(3): column block size (NB)
! 155: *> T(6:TSIZE): data structure needed for Q, computed by
! 156: *> DLATSQR or DGEQRT
! 157: *>
! 158: *> Depending on the matrix dimensions M and N, and row and column
! 159: *> block sizes MB and NB returned by ILAENV, DGEQR will use either
! 160: *> DLATSQR (if the matrix is tall-and-skinny) or DGEQRT to compute
! 161: *> the QR factorization.
! 162: *> This version of DGEMQR will use either DLAMTSQR or DGEMQRT to
! 163: *> multiply matrix Q by another matrix.
! 164: *> Further Details in DLATMSQR or DGEMQRT.
! 165: *>
! 166: *> \endverbatim
! 167: *>
! 168: * =====================================================================
! 169: SUBROUTINE DGEMQR( SIDE, TRANS, M, N, K, A, LDA, T, TSIZE,
! 170: $ C, LDC, WORK, LWORK, INFO )
! 171: *
! 172: * -- LAPACK computational routine (version 3.7.0) --
! 173: * -- LAPACK is a software package provided by Univ. of Tennessee, --
! 174: * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
! 175: * December 2016
! 176: *
! 177: * .. Scalar Arguments ..
! 178: CHARACTER SIDE, TRANS
! 179: INTEGER INFO, LDA, M, N, K, TSIZE, LWORK, LDC
! 180: * ..
! 181: * .. Array Arguments ..
! 182: DOUBLE PRECISION A( LDA, * ), T( * ), C( LDC, * ), WORK( * )
! 183: * ..
! 184: *
! 185: * =====================================================================
! 186: *
! 187: * ..
! 188: * .. Local Scalars ..
! 189: LOGICAL LEFT, RIGHT, TRAN, NOTRAN, LQUERY
! 190: INTEGER MB, NB, LW, NBLCKS, MN
! 191: * ..
! 192: * .. External Functions ..
! 193: LOGICAL LSAME
! 194: EXTERNAL LSAME
! 195: * ..
! 196: * .. External Subroutines ..
! 197: EXTERNAL DGEMQRT, DLAMTSQR, XERBLA
! 198: * ..
! 199: * .. Intrinsic Functions ..
! 200: INTRINSIC INT, MAX, MIN, MOD
! 201: * ..
! 202: * .. Executable Statements ..
! 203: *
! 204: * Test the input arguments
! 205: *
! 206: LQUERY = LWORK.EQ.-1
! 207: NOTRAN = LSAME( TRANS, 'N' )
! 208: TRAN = LSAME( TRANS, 'T' )
! 209: LEFT = LSAME( SIDE, 'L' )
! 210: RIGHT = LSAME( SIDE, 'R' )
! 211: *
! 212: MB = INT( T( 2 ) )
! 213: NB = INT( T( 3 ) )
! 214: IF( LEFT ) THEN
! 215: LW = N * NB
! 216: MN = M
! 217: ELSE
! 218: LW = MB * NB
! 219: MN = N
! 220: END IF
! 221: *
! 222: IF( ( MB.GT.K ) .AND. ( MN.GT.K ) ) THEN
! 223: IF( MOD( MN - K, MB - K ).EQ.0 ) THEN
! 224: NBLCKS = ( MN - K ) / ( MB - K )
! 225: ELSE
! 226: NBLCKS = ( MN - K ) / ( MB - K ) + 1
! 227: END IF
! 228: ELSE
! 229: NBLCKS = 1
! 230: END IF
! 231: *
! 232: INFO = 0
! 233: IF( .NOT.LEFT .AND. .NOT.RIGHT ) THEN
! 234: INFO = -1
! 235: ELSE IF( .NOT.TRAN .AND. .NOT.NOTRAN ) THEN
! 236: INFO = -2
! 237: ELSE IF( M.LT.0 ) THEN
! 238: INFO = -3
! 239: ELSE IF( N.LT.0 ) THEN
! 240: INFO = -4
! 241: ELSE IF( K.LT.0 .OR. K.GT.MN ) THEN
! 242: INFO = -5
! 243: ELSE IF( LDA.LT.MAX( 1, MN ) ) THEN
! 244: INFO = -7
! 245: ELSE IF( TSIZE.LT.5 ) THEN
! 246: INFO = -9
! 247: ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
! 248: INFO = -11
! 249: ELSE IF( ( LWORK.LT.MAX( 1, LW ) ) .AND. ( .NOT.LQUERY ) ) THEN
! 250: INFO = -13
! 251: END IF
! 252: *
! 253: IF( INFO.EQ.0 ) THEN
! 254: WORK( 1 ) = LW
! 255: END IF
! 256: *
! 257: IF( INFO.NE.0 ) THEN
! 258: CALL XERBLA( 'DGEMQR', -INFO )
! 259: RETURN
! 260: ELSE IF( LQUERY ) THEN
! 261: RETURN
! 262: END IF
! 263: *
! 264: * Quick return if possible
! 265: *
! 266: IF( MIN( M, N, K ).EQ.0 ) THEN
! 267: RETURN
! 268: END IF
! 269: *
! 270: IF( ( LEFT .AND. M.LE.K ) .OR. ( RIGHT .AND. N.LE.K )
! 271: $ .OR. ( MB.LE.K ) .OR. ( MB.GE.MAX( M, N, K ) ) ) THEN
! 272: CALL DGEMQRT( SIDE, TRANS, M, N, K, NB, A, LDA, T( 6 ),
! 273: $ NB, C, LDC, WORK, INFO )
! 274: ELSE
! 275: CALL DLAMTSQR( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T( 6 ),
! 276: $ NB, C, LDC, WORK, LWORK, INFO )
! 277: END IF
! 278: *
! 279: WORK( 1 ) = LW
! 280: *
! 281: RETURN
! 282: *
! 283: * End of DGEMQR
! 284: *
! 285: END
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to dgemqr.f CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / lapack / lapack