1 SUBROUTINE DORMHR( SIDE, TRANS, M, N, ILO, IHI, A, LDA, TAU, C, 2 $ LDC, WORK, LWORK, INFO ) 3* 4* -- LAPACK routine (version 3.0) -- 5* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., 6* Courant Institute, Argonne National Lab, and Rice University 7* June 30, 1999 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 (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 203