![]() ![]() | ![]() |
Mise à jour de lapack vers la version 3.5.0.
1: *> \brief \b ZGEMQRT 2: * 3: * =========== DOCUMENTATION =========== 4: * 5: * Online html documentation available at 6: * http://www.netlib.org/lapack/explore-html/ 7: * 8: *> \htmlonly 9: *> Download ZGEMQRT + dependencies 10: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zgemqrt.f"> 11: *> [TGZ]</a> 12: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zgemqrt.f"> 13: *> [ZIP]</a> 14: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zgemqrt.f"> 15: *> [TXT]</a> 16: *> \endhtmlonly 17: * 18: * Definition: 19: * =========== 20: * 21: * SUBROUTINE ZGEMQRT( SIDE, TRANS, M, N, K, NB, V, LDV, T, LDT, 22: * C, LDC, WORK, INFO ) 23: * 24: * .. Scalar Arguments .. 25: * CHARACTER SIDE, TRANS 26: * INTEGER INFO, K, LDV, LDC, M, N, NB, LDT 27: * .. 28: * .. Array Arguments .. 29: * COMPLEX*16 V( LDV, * ), C( LDC, * ), T( LDT, * ), WORK( * ) 30: * .. 31: * 32: * 33: *> \par Purpose: 34: * ============= 35: *> 36: *> \verbatim 37: *> 38: *> ZGEMQRT overwrites the general complex M-by-N matrix C with 39: *> 40: *> SIDE = 'L' SIDE = 'R' 41: *> TRANS = 'N': Q C C Q 42: *> TRANS = 'C': Q**H C C Q**H 43: *> 44: *> where Q is a complex orthogonal matrix defined as the product of K 45: *> elementary reflectors: 46: *> 47: *> Q = H(1) H(2) . . . H(K) = I - V T V**H 48: *> 49: *> generated using the compact WY representation as returned by ZGEQRT. 50: *> 51: *> Q is of order M if SIDE = 'L' and of order N if SIDE = 'R'. 52: *> \endverbatim 53: * 54: * Arguments: 55: * ========== 56: * 57: *> \param[in] SIDE 58: *> \verbatim 59: *> SIDE is CHARACTER*1 60: *> = 'L': apply Q or Q**H from the Left; 61: *> = 'R': apply Q or Q**H from the Right. 62: *> \endverbatim 63: *> 64: *> \param[in] TRANS 65: *> \verbatim 66: *> TRANS is CHARACTER*1 67: *> = 'N': No transpose, apply Q; 68: *> = 'C': Transpose, apply Q**H. 69: *> \endverbatim 70: *> 71: *> \param[in] M 72: *> \verbatim 73: *> M is INTEGER 74: *> The number of rows of the matrix C. M >= 0. 75: *> \endverbatim 76: *> 77: *> \param[in] N 78: *> \verbatim 79: *> N is INTEGER 80: *> The number of columns of the matrix C. N >= 0. 81: *> \endverbatim 82: *> 83: *> \param[in] K 84: *> \verbatim 85: *> K is INTEGER 86: *> The number of elementary reflectors whose product defines 87: *> the matrix Q. 88: *> If SIDE = 'L', M >= K >= 0; 89: *> if SIDE = 'R', N >= K >= 0. 90: *> \endverbatim 91: *> 92: *> \param[in] NB 93: *> \verbatim 94: *> NB is INTEGER 95: *> The block size used for the storage of T. K >= NB >= 1. 96: *> This must be the same value of NB used to generate T 97: *> in CGEQRT. 98: *> \endverbatim 99: *> 100: *> \param[in] V 101: *> \verbatim 102: *> V is COMPLEX*16 array, dimension (LDV,K) 103: *> The i-th column must contain the vector which defines the 104: *> elementary reflector H(i), for i = 1,2,...,k, as returned by 105: *> CGEQRT in the first K columns of its array argument A. 106: *> \endverbatim 107: *> 108: *> \param[in] LDV 109: *> \verbatim 110: *> LDV is INTEGER 111: *> The leading dimension of the array V. 112: *> If SIDE = 'L', LDA >= max(1,M); 113: *> if SIDE = 'R', LDA >= max(1,N). 114: *> \endverbatim 115: *> 116: *> \param[in] T 117: *> \verbatim 118: *> T is COMPLEX*16 array, dimension (LDT,K) 119: *> The upper triangular factors of the block reflectors 120: *> as returned by CGEQRT, stored as a NB-by-N matrix. 121: *> \endverbatim 122: *> 123: *> \param[in] LDT 124: *> \verbatim 125: *> LDT is INTEGER 126: *> The leading dimension of the array T. LDT >= NB. 127: *> \endverbatim 128: *> 129: *> \param[in,out] C 130: *> \verbatim 131: *> C is COMPLEX*16 array, dimension (LDC,N) 132: *> On entry, the M-by-N matrix C. 133: *> On exit, C is overwritten by Q C, Q**H C, C Q**H or C Q. 134: *> \endverbatim 135: *> 136: *> \param[in] LDC 137: *> \verbatim 138: *> LDC is INTEGER 139: *> The leading dimension of the array C. LDC >= max(1,M). 140: *> \endverbatim 141: *> 142: *> \param[out] WORK 143: *> \verbatim 144: *> WORK is COMPLEX*16 array. The dimension of WORK is 145: *> N*NB if SIDE = 'L', or M*NB if SIDE = 'R'. 146: *> \endverbatim 147: *> 148: *> \param[out] INFO 149: *> \verbatim 150: *> INFO is INTEGER 151: *> = 0: successful exit 152: *> < 0: if INFO = -i, the i-th argument had an illegal value 153: *> \endverbatim 154: * 155: * Authors: 156: * ======== 157: * 158: *> \author Univ. of Tennessee 159: *> \author Univ. of California Berkeley 160: *> \author Univ. of Colorado Denver 161: *> \author NAG Ltd. 162: * 163: *> \date November 2013 164: * 165: *> \ingroup complex16GEcomputational 166: * 167: * ===================================================================== 168: SUBROUTINE ZGEMQRT( SIDE, TRANS, M, N, K, NB, V, LDV, T, LDT, 169: $ C, LDC, WORK, INFO ) 170: * 171: * -- LAPACK computational routine (version 3.5.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: * November 2013 175: * 176: * .. Scalar Arguments .. 177: CHARACTER SIDE, TRANS 178: INTEGER INFO, K, LDV, LDC, M, N, NB, LDT 179: * .. 180: * .. Array Arguments .. 181: COMPLEX*16 V( LDV, * ), C( LDC, * ), T( LDT, * ), WORK( * ) 182: * .. 183: * 184: * ===================================================================== 185: * 186: * .. 187: * .. Local Scalars .. 188: LOGICAL LEFT, RIGHT, TRAN, NOTRAN 189: INTEGER I, IB, LDWORK, KF, Q 190: * .. 191: * .. External Functions .. 192: LOGICAL LSAME 193: EXTERNAL LSAME 194: * .. 195: * .. External Subroutines .. 196: EXTERNAL XERBLA, ZLARFB 197: * .. 198: * .. Intrinsic Functions .. 199: INTRINSIC MAX, MIN 200: * .. 201: * .. Executable Statements .. 202: * 203: * .. Test the input arguments .. 204: * 205: INFO = 0 206: LEFT = LSAME( SIDE, 'L' ) 207: RIGHT = LSAME( SIDE, 'R' ) 208: TRAN = LSAME( TRANS, 'C' ) 209: NOTRAN = LSAME( TRANS, 'N' ) 210: * 211: IF( LEFT ) THEN 212: LDWORK = MAX( 1, N ) 213: Q = M 214: ELSE IF ( RIGHT ) THEN 215: LDWORK = MAX( 1, M ) 216: Q = N 217: END IF 218: IF( .NOT.LEFT .AND. .NOT.RIGHT ) THEN 219: INFO = -1 220: ELSE IF( .NOT.TRAN .AND. .NOT.NOTRAN ) THEN 221: INFO = -2 222: ELSE IF( M.LT.0 ) THEN 223: INFO = -3 224: ELSE IF( N.LT.0 ) THEN 225: INFO = -4 226: ELSE IF( K.LT.0 .OR. K.GT.Q ) THEN 227: INFO = -5 228: ELSE IF( NB.LT.1 .OR. (NB.GT.K .AND. K.GT.0)) THEN 229: INFO = -6 230: ELSE IF( LDV.LT.MAX( 1, Q ) ) THEN 231: INFO = -8 232: ELSE IF( LDT.LT.NB ) THEN 233: INFO = -10 234: ELSE IF( LDC.LT.MAX( 1, M ) ) THEN 235: INFO = -12 236: END IF 237: * 238: IF( INFO.NE.0 ) THEN 239: CALL XERBLA( 'ZGEMQRT', -INFO ) 240: RETURN 241: END IF 242: * 243: * .. Quick return if possible .. 244: * 245: IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 ) RETURN 246: * 247: IF( LEFT .AND. TRAN ) THEN 248: * 249: DO I = 1, K, NB 250: IB = MIN( NB, K-I+1 ) 251: CALL ZLARFB( 'L', 'C', 'F', 'C', M-I+1, N, IB, 252: $ V( I, I ), LDV, T( 1, I ), LDT, 253: $ C( I, 1 ), LDC, WORK, LDWORK ) 254: END DO 255: * 256: ELSE IF( RIGHT .AND. NOTRAN ) THEN 257: * 258: DO I = 1, K, NB 259: IB = MIN( NB, K-I+1 ) 260: CALL ZLARFB( 'R', 'N', 'F', 'C', M, N-I+1, IB, 261: $ V( I, I ), LDV, T( 1, I ), LDT, 262: $ C( 1, I ), LDC, WORK, LDWORK ) 263: END DO 264: * 265: ELSE IF( LEFT .AND. NOTRAN ) THEN 266: * 267: KF = ((K-1)/NB)*NB+1 268: DO I = KF, 1, -NB 269: IB = MIN( NB, K-I+1 ) 270: CALL ZLARFB( 'L', 'N', 'F', 'C', M-I+1, N, IB, 271: $ V( I, I ), LDV, T( 1, I ), LDT, 272: $ C( I, 1 ), LDC, WORK, LDWORK ) 273: END DO 274: * 275: ELSE IF( RIGHT .AND. TRAN ) THEN 276: * 277: KF = ((K-1)/NB)*NB+1 278: DO I = KF, 1, -NB 279: IB = MIN( NB, K-I+1 ) 280: CALL ZLARFB( 'R', 'C', 'F', 'C', M, N-I+1, IB, 281: $ V( I, I ), LDV, T( 1, I ), LDT, 282: $ C( 1, I ), LDC, WORK, LDWORK ) 283: END DO 284: * 285: END IF 286: * 287: RETURN 288: * 289: * End of ZGEMQRT 290: * 291: END