1 SUBROUTINE DORML2( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, 2 $ WORK, 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* February 29, 1992 8* 9* .. Scalar Arguments .. 10 CHARACTER SIDE, TRANS 11 INTEGER INFO, K, LDA, LDC, M, N 12* .. 13* .. Array Arguments .. 14 DOUBLE PRECISION A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * ) 15* .. 16* 17* Purpose 18* ======= 19* 20* DORML2 overwrites the general real m by n matrix C with 21* 22* Q * C if SIDE = 'L' and TRANS = 'N', or 23* 24* Q'* C if SIDE = 'L' and TRANS = 'T', or 25* 26* C * Q if SIDE = 'R' and TRANS = 'N', or 27* 28* C * Q' if SIDE = 'R' and TRANS = 'T', 29* 30* where Q is a real orthogonal matrix defined as the product of k 31* elementary reflectors 32* 33* Q = H(k) . . . H(2) H(1) 34* 35* as returned by DGELQF. Q is of order m if SIDE = 'L' and of order n 36* if SIDE = 'R'. 37* 38* Arguments 39* ========= 40* 41* SIDE (input) CHARACTER*1 42* = 'L': apply Q or Q' from the Left 43* = 'R': apply Q or Q' from the Right 44* 45* TRANS (input) CHARACTER*1 46* = 'N': apply Q (No transpose) 47* = 'T': apply Q' (Transpose) 48* 49* M (input) INTEGER 50* The number of rows of the matrix C. M >= 0. 51* 52* N (input) INTEGER 53* The number of columns of the matrix C. N >= 0. 54* 55* K (input) INTEGER 56* The number of elementary reflectors whose product defines 57* the matrix Q. 58* If SIDE = 'L', M >= K >= 0; 59* if SIDE = 'R', N >= K >= 0. 60* 61* A (input) DOUBLE PRECISION array, dimension 62* (LDA,M) if SIDE = 'L', 63* (LDA,N) if SIDE = 'R' 64* The i-th row must contain the vector which defines the 65* elementary reflector H(i), for i = 1,2,...,k, as returned by 66* DGELQF in the first k rows of its array argument A. 67* A is modified by the routine but restored on exit. 68* 69* LDA (input) INTEGER 70* The leading dimension of the array A. LDA >= max(1,K). 71* 72* TAU (input) DOUBLE PRECISION array, dimension (K) 73* TAU(i) must contain the scalar factor of the elementary 74* reflector H(i), as returned by DGELQF. 75* 76* C (input/output) DOUBLE PRECISION array, dimension (LDC,N) 77* On entry, the m by n matrix C. 78* On exit, C is overwritten by Q*C or Q'*C or C*Q' or C*Q. 79* 80* LDC (input) INTEGER 81* The leading dimension of the array C. LDC >= max(1,M). 82* 83* WORK (workspace) DOUBLE PRECISION array, dimension 84* (N) if SIDE = 'L', 85* (M) if SIDE = 'R' 86* 87* INFO (output) INTEGER 88* = 0: successful exit 89* < 0: if INFO = -i, the i-th argument had an illegal value 90* 91* ===================================================================== 92* 93* .. Parameters .. 94 DOUBLE PRECISION ONE 95 PARAMETER ( ONE = 1.0D+0 ) 96* .. 97* .. Local Scalars .. 98 LOGICAL LEFT, NOTRAN 99 INTEGER I, I1, I2, I3, IC, JC, MI, NI, NQ 100 DOUBLE PRECISION AII 101* .. 102* .. External Functions .. 103 LOGICAL LSAME 104 EXTERNAL LSAME 105* .. 106* .. External Subroutines .. 107 EXTERNAL DLARF, XERBLA 108* .. 109* .. Intrinsic Functions .. 110 INTRINSIC MAX 111* .. 112* .. Executable Statements .. 113* 114* Test the input arguments 115* 116 INFO = 0 117 LEFT = LSAME( SIDE, 'L' ) 118 NOTRAN = LSAME( TRANS, 'N' ) 119* 120* NQ is the order of Q 121* 122 IF( LEFT ) THEN 123 NQ = M 124 ELSE 125 NQ = N 126 END IF 127 IF( .NOT.LEFT .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN 128 INFO = -1 129 ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) ) THEN 130 INFO = -2 131 ELSE IF( M.LT.0 ) THEN 132 INFO = -3 133 ELSE IF( N.LT.0 ) THEN 134 INFO = -4 135 ELSE IF( K.LT.0 .OR. K.GT.NQ ) THEN 136 INFO = -5 137 ELSE IF( LDA.LT.MAX( 1, K ) ) THEN 138 INFO = -7 139 ELSE IF( LDC.LT.MAX( 1, M ) ) THEN 140 INFO = -10 141 END IF 142 IF( INFO.NE.0 ) THEN 143 CALL XERBLA( 'DORML2', -INFO ) 144 RETURN 145 END IF 146* 147* Quick return if possible 148* 149 IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 ) 150 $ RETURN 151* 152 IF( ( LEFT .AND. NOTRAN ) .OR. ( .NOT.LEFT .AND. .NOT.NOTRAN ) ) 153 $ THEN 154 I1 = 1 155 I2 = K 156 I3 = 1 157 ELSE 158 I1 = K 159 I2 = 1 160 I3 = -1 161 END IF 162* 163 IF( LEFT ) THEN 164 NI = N 165 JC = 1 166 ELSE 167 MI = M 168 IC = 1 169 END IF 170* 171 DO 10 I = I1, I2, I3 172 IF( LEFT ) THEN 173* 174* H(i) is applied to C(i:m,1:n) 175* 176 MI = M - I + 1 177 IC = I 178 ELSE 179* 180* H(i) is applied to C(1:m,i:n) 181* 182 NI = N - I + 1 183 JC = I 184 END IF 185* 186* Apply H(i) 187* 188 AII = A( I, I ) 189 A( I, I ) = ONE 190 CALL DLARF( SIDE, MI, NI, A( I, I ), LDA, TAU( I ), 191 $ C( IC, JC ), LDC, WORK ) 192 A( I, I ) = AII 193 10 CONTINUE 194 RETURN 195* 196* End of DORML2 197* 198 END 199