Annotation of rpl/lapack/lapack/dormhr.f, revision 1.1
1.1 ! bertrand 1: SUBROUTINE DORMHR( SIDE, TRANS, M, N, ILO, IHI, A, LDA, TAU, C,
! 2: $ LDC, WORK, LWORK, INFO )
! 3: *
! 4: * -- LAPACK routine (version 3.2) --
! 5: * -- LAPACK is a software package provided by Univ. of Tennessee, --
! 6: * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
! 7: * November 2006
! 8: *
! 9: * .. Scalar Arguments ..
! 10: CHARACTER SIDE, TRANS
! 11: INTEGER IHI, ILO, INFO, LDA, LDC, LWORK, M, N
! 12: * ..
! 13: * .. Array Arguments ..
! 14: DOUBLE PRECISION A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
! 15: * ..
! 16: *
! 17: * Purpose
! 18: * =======
! 19: *
! 20: * DORMHR overwrites the general real M-by-N matrix C with
! 21: *
! 22: * SIDE = 'L' SIDE = 'R'
! 23: * TRANS = 'N': Q * C C * Q
! 24: * TRANS = 'T': Q**T * C C * Q**T
! 25: *
! 26: * where Q is a real orthogonal matrix of order nq, with nq = m if
! 27: * SIDE = 'L' and nq = n if SIDE = 'R'. Q is defined as the product of
! 28: * IHI-ILO elementary reflectors, as returned by DGEHRD:
! 29: *
! 30: * Q = H(ilo) H(ilo+1) . . . H(ihi-1).
! 31: *
! 32: * Arguments
! 33: * =========
! 34: *
! 35: * SIDE (input) CHARACTER*1
! 36: * = 'L': apply Q or Q**T from the Left;
! 37: * = 'R': apply Q or Q**T from the Right.
! 38: *
! 39: * TRANS (input) CHARACTER*1
! 40: * = 'N': No transpose, apply Q;
! 41: * = 'T': Transpose, apply Q**T.
! 42: *
! 43: * M (input) INTEGER
! 44: * The number of rows of the matrix C. M >= 0.
! 45: *
! 46: * N (input) INTEGER
! 47: * The number of columns of the matrix C. N >= 0.
! 48: *
! 49: * ILO (input) INTEGER
! 50: * IHI (input) INTEGER
! 51: * ILO and IHI must have the same values as in the previous call
! 52: * of DGEHRD. Q is equal to the unit matrix except in the
! 53: * submatrix Q(ilo+1:ihi,ilo+1:ihi).
! 54: * If SIDE = 'L', then 1 <= ILO <= IHI <= M, if M > 0, and
! 55: * ILO = 1 and IHI = 0, if M = 0;
! 56: * if SIDE = 'R', then 1 <= ILO <= IHI <= N, if N > 0, and
! 57: * ILO = 1 and IHI = 0, if N = 0.
! 58: *
! 59: * A (input) DOUBLE PRECISION array, dimension
! 60: * (LDA,M) if SIDE = 'L'
! 61: * (LDA,N) if SIDE = 'R'
! 62: * The vectors which define the elementary reflectors, as
! 63: * returned by DGEHRD.
! 64: *
! 65: * LDA (input) INTEGER
! 66: * The leading dimension of the array A.
! 67: * LDA >= max(1,M) if SIDE = 'L'; LDA >= max(1,N) if SIDE = 'R'.
! 68: *
! 69: * TAU (input) DOUBLE PRECISION array, dimension
! 70: * (M-1) if SIDE = 'L'
! 71: * (N-1) if SIDE = 'R'
! 72: * TAU(i) must contain the scalar factor of the elementary
! 73: * reflector H(i), as returned by DGEHRD.
! 74: *
! 75: * C (input/output) DOUBLE PRECISION array, dimension (LDC,N)
! 76: * On entry, the M-by-N matrix C.
! 77: * On exit, C is overwritten by Q*C or Q**T*C or C*Q**T or C*Q.
! 78: *
! 79: * LDC (input) INTEGER
! 80: * The leading dimension of the array C. LDC >= max(1,M).
! 81: *
! 82: * WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,LWORK))
! 83: * On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
! 84: *
! 85: * LWORK (input) INTEGER
! 86: * The dimension of the array WORK.
! 87: * If SIDE = 'L', LWORK >= max(1,N);
! 88: * if SIDE = 'R', LWORK >= max(1,M).
! 89: * For optimum performance LWORK >= N*NB if SIDE = 'L', and
! 90: * LWORK >= M*NB if SIDE = 'R', where NB is the optimal
! 91: * blocksize.
! 92: *
! 93: * If LWORK = -1, then a workspace query is assumed; the routine
! 94: * only calculates the optimal size of the WORK array, returns
! 95: * this value as the first entry of the WORK array, and no error
! 96: * message related to LWORK is issued by XERBLA.
! 97: *
! 98: * INFO (output) INTEGER
! 99: * = 0: successful exit
! 100: * < 0: if INFO = -i, the i-th argument had an illegal value
! 101: *
! 102: * =====================================================================
! 103: *
! 104: * .. Local Scalars ..
! 105: LOGICAL LEFT, LQUERY
! 106: INTEGER I1, I2, IINFO, LWKOPT, MI, NB, NH, NI, NQ, NW
! 107: * ..
! 108: * .. External Functions ..
! 109: LOGICAL LSAME
! 110: INTEGER ILAENV
! 111: EXTERNAL LSAME, ILAENV
! 112: * ..
! 113: * .. External Subroutines ..
! 114: EXTERNAL DORMQR, XERBLA
! 115: * ..
! 116: * .. Intrinsic Functions ..
! 117: INTRINSIC MAX, MIN
! 118: * ..
! 119: * .. Executable Statements ..
! 120: *
! 121: * Test the input arguments
! 122: *
! 123: INFO = 0
! 124: NH = IHI - ILO
! 125: LEFT = LSAME( SIDE, 'L' )
! 126: LQUERY = ( LWORK.EQ.-1 )
! 127: *
! 128: * NQ is the order of Q and NW is the minimum dimension of WORK
! 129: *
! 130: IF( LEFT ) THEN
! 131: NQ = M
! 132: NW = N
! 133: ELSE
! 134: NQ = N
! 135: NW = M
! 136: END IF
! 137: IF( .NOT.LEFT .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN
! 138: INFO = -1
! 139: ELSE IF( .NOT.LSAME( TRANS, 'N' ) .AND. .NOT.LSAME( TRANS, 'T' ) )
! 140: $ THEN
! 141: INFO = -2
! 142: ELSE IF( M.LT.0 ) THEN
! 143: INFO = -3
! 144: ELSE IF( N.LT.0 ) THEN
! 145: INFO = -4
! 146: ELSE IF( ILO.LT.1 .OR. ILO.GT.MAX( 1, NQ ) ) THEN
! 147: INFO = -5
! 148: ELSE IF( IHI.LT.MIN( ILO, NQ ) .OR. IHI.GT.NQ ) THEN
! 149: INFO = -6
! 150: ELSE IF( LDA.LT.MAX( 1, NQ ) ) THEN
! 151: INFO = -8
! 152: ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
! 153: INFO = -11
! 154: ELSE IF( LWORK.LT.MAX( 1, NW ) .AND. .NOT.LQUERY ) THEN
! 155: INFO = -13
! 156: END IF
! 157: *
! 158: IF( INFO.EQ.0 ) THEN
! 159: IF( LEFT ) THEN
! 160: NB = ILAENV( 1, 'DORMQR', SIDE // TRANS, NH, N, NH, -1 )
! 161: ELSE
! 162: NB = ILAENV( 1, 'DORMQR', SIDE // TRANS, M, NH, NH, -1 )
! 163: END IF
! 164: LWKOPT = MAX( 1, NW )*NB
! 165: WORK( 1 ) = LWKOPT
! 166: END IF
! 167: *
! 168: IF( INFO.NE.0 ) THEN
! 169: CALL XERBLA( 'DORMHR', -INFO )
! 170: RETURN
! 171: ELSE IF( LQUERY ) THEN
! 172: RETURN
! 173: END IF
! 174: *
! 175: * Quick return if possible
! 176: *
! 177: IF( M.EQ.0 .OR. N.EQ.0 .OR. NH.EQ.0 ) THEN
! 178: WORK( 1 ) = 1
! 179: RETURN
! 180: END IF
! 181: *
! 182: IF( LEFT ) THEN
! 183: MI = NH
! 184: NI = N
! 185: I1 = ILO + 1
! 186: I2 = 1
! 187: ELSE
! 188: MI = M
! 189: NI = NH
! 190: I1 = 1
! 191: I2 = ILO + 1
! 192: END IF
! 193: *
! 194: CALL DORMQR( SIDE, TRANS, MI, NI, NH, A( ILO+1, ILO ), LDA,
! 195: $ TAU( ILO ), C( I1, I2 ), LDC, WORK, LWORK, IINFO )
! 196: *
! 197: WORK( 1 ) = LWKOPT
! 198: RETURN
! 199: *
! 200: * End of DORMHR
! 201: *
! 202: END
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to dormhr.f CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / lapack / lapack