Annotation of rpl/lapack/lapack/dgemlq.f, revision 1.1
1.1 ! bertrand 1: *
! 2: * Definition:
! 3: * ===========
! 4: *
! 5: * SUBROUTINE DGEMLQ( 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: *> DGEMLQ 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: *> where Q is a real orthogonal matrix defined as the product
! 28: *> of blocked elementary reflectors computed by short wide LQ
! 29: *> factorization (DGELQ)
! 30: *>
! 31: *> \endverbatim
! 32: *
! 33: * Arguments:
! 34: * ==========
! 35: *
! 36: *> \param[in] SIDE
! 37: *> \verbatim
! 38: *> SIDE is CHARACTER*1
! 39: *> = 'L': apply Q or Q**T from the Left;
! 40: *> = 'R': apply Q or Q**T from the Right.
! 41: *> \endverbatim
! 42: *>
! 43: *> \param[in] TRANS
! 44: *> \verbatim
! 45: *> TRANS is CHARACTER*1
! 46: *> = 'N': No transpose, apply Q;
! 47: *> = 'T': Transpose, apply Q**T.
! 48: *> \endverbatim
! 49: *>
! 50: *> \param[in] M
! 51: *> \verbatim
! 52: *> M is INTEGER
! 53: *> The number of rows of the matrix A. M >=0.
! 54: *> \endverbatim
! 55: *>
! 56: *> \param[in] N
! 57: *> \verbatim
! 58: *> N is INTEGER
! 59: *> The number of columns of the matrix C. N >= 0.
! 60: *> \endverbatim
! 61: *>
! 62: *> \param[in] K
! 63: *> \verbatim
! 64: *> K is INTEGER
! 65: *> The number of elementary reflectors whose product defines
! 66: *> the matrix Q.
! 67: *> If SIDE = 'L', M >= K >= 0;
! 68: *> if SIDE = 'R', N >= K >= 0.
! 69: *>
! 70: *> \endverbatim
! 71: *>
! 72: *> \param[in] A
! 73: *> \verbatim
! 74: *> A is DOUBLE PRECISION array, dimension
! 75: *> (LDA,M) if SIDE = 'L',
! 76: *> (LDA,N) if SIDE = 'R'
! 77: *> Part of the data structure to represent Q as returned by DGELQ.
! 78: *> \endverbatim
! 79: *>
! 80: *> \param[in] LDA
! 81: *> \verbatim
! 82: *> LDA is INTEGER
! 83: *> The leading dimension of the array A. LDA >= max(1,K).
! 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 DGELQ.
! 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: *> DLASWLQ or DGELQT
! 157: *>
! 158: *> Depending on the matrix dimensions M and N, and row and column
! 159: *> block sizes MB and NB returned by ILAENV, DGELQ will use either
! 160: *> DLASWLQ (if the matrix is wide-and-short) or DGELQT to compute
! 161: *> the LQ factorization.
! 162: *> This version of DGEMLQ will use either DLAMSWLQ or DGEMLQT to
! 163: *> multiply matrix Q by another matrix.
! 164: *> Further Details in DLAMSWLQ or DGEMLQT.
! 165: *> \endverbatim
! 166: *>
! 167: * =====================================================================
! 168: SUBROUTINE DGEMLQ( SIDE, TRANS, M, N, K, A, LDA, T, TSIZE,
! 169: $ C, LDC, WORK, LWORK, INFO )
! 170: *
! 171: * -- LAPACK computational routine (version 3.7.0) --
! 172: * -- LAPACK is a software package provided by Univ. of Tennessee, --
! 173: * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
! 174: * December 2016
! 175: *
! 176: * .. Scalar Arguments ..
! 177: CHARACTER SIDE, TRANS
! 178: INTEGER INFO, LDA, M, N, K, TSIZE, LWORK, LDC
! 179: * ..
! 180: * .. Array Arguments ..
! 181: DOUBLE PRECISION A( LDA, * ), T( * ), C( LDC, * ), WORK( * )
! 182: * ..
! 183: *
! 184: * =====================================================================
! 185: *
! 186: * ..
! 187: * .. Local Scalars ..
! 188: LOGICAL LEFT, RIGHT, TRAN, NOTRAN, LQUERY
! 189: INTEGER MB, NB, LW, NBLCKS, MN
! 190: * ..
! 191: * .. External Functions ..
! 192: LOGICAL LSAME
! 193: EXTERNAL LSAME
! 194: * ..
! 195: * .. External Subroutines ..
! 196: EXTERNAL DLAMSWLQ, DGEMLQT, XERBLA
! 197: * ..
! 198: * .. Intrinsic Functions ..
! 199: INTRINSIC INT, MAX, MIN, MOD
! 200: * ..
! 201: * .. Executable Statements ..
! 202: *
! 203: * Test the input arguments
! 204: *
! 205: LQUERY = LWORK.EQ.-1
! 206: NOTRAN = LSAME( TRANS, 'N' )
! 207: TRAN = LSAME( TRANS, 'T' )
! 208: LEFT = LSAME( SIDE, 'L' )
! 209: RIGHT = LSAME( SIDE, 'R' )
! 210: *
! 211: MB = INT( T( 2 ) )
! 212: NB = INT( T( 3 ) )
! 213: IF( LEFT ) THEN
! 214: LW = N * MB
! 215: MN = M
! 216: ELSE
! 217: LW = M * MB
! 218: MN = N
! 219: END IF
! 220: *
! 221: IF( ( NB.GT.K ) .AND. ( MN.GT.K ) ) THEN
! 222: IF( MOD( MN - K, NB - K ) .EQ. 0 ) THEN
! 223: NBLCKS = ( MN - K ) / ( NB - K )
! 224: ELSE
! 225: NBLCKS = ( MN - K ) / ( NB - K ) + 1
! 226: END IF
! 227: ELSE
! 228: NBLCKS = 1
! 229: END IF
! 230: *
! 231: INFO = 0
! 232: IF( .NOT.LEFT .AND. .NOT.RIGHT ) THEN
! 233: INFO = -1
! 234: ELSE IF( .NOT.TRAN .AND. .NOT.NOTRAN ) THEN
! 235: INFO = -2
! 236: ELSE IF( M.LT.0 ) THEN
! 237: INFO = -3
! 238: ELSE IF( N.LT.0 ) THEN
! 239: INFO = -4
! 240: ELSE IF( K.LT.0 .OR. K.GT.MN ) THEN
! 241: INFO = -5
! 242: ELSE IF( LDA.LT.MAX( 1, K ) ) THEN
! 243: INFO = -7
! 244: ELSE IF( TSIZE.LT.5 ) THEN
! 245: INFO = -9
! 246: ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
! 247: INFO = -11
! 248: ELSE IF( ( LWORK.LT.MAX( 1, LW ) ) .AND. ( .NOT.LQUERY ) ) THEN
! 249: INFO = -13
! 250: END IF
! 251: *
! 252: IF( INFO.EQ.0 ) THEN
! 253: WORK( 1 ) = LW
! 254: END IF
! 255: *
! 256: IF( INFO.NE.0 ) THEN
! 257: CALL XERBLA( 'DGEMLQ', -INFO )
! 258: RETURN
! 259: ELSE IF( LQUERY ) THEN
! 260: RETURN
! 261: END IF
! 262: *
! 263: * Quick return if possible
! 264: *
! 265: IF( MIN( M, N, K ).EQ.0 ) THEN
! 266: RETURN
! 267: END IF
! 268: *
! 269: IF( ( LEFT .AND. M.LE.K ) .OR. ( RIGHT .AND. N.LE.K )
! 270: $ .OR. ( NB.LE.K ) .OR. ( NB.GE.MAX( M, N, K ) ) ) THEN
! 271: CALL DGEMLQT( SIDE, TRANS, M, N, K, MB, A, LDA,
! 272: $ T( 6 ), MB, C, LDC, WORK, INFO )
! 273: ELSE
! 274: CALL DLAMSWLQ( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T( 6 ),
! 275: $ MB, C, LDC, WORK, LWORK, INFO )
! 276: END IF
! 277: *
! 278: WORK( 1 ) = LW
! 279: *
! 280: RETURN
! 281: *
! 282: * End of DGEMLQ
! 283: *
! 284: END
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to dgemlq.f CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / lapack / lapack