SUBROUTINE DELCOLSQ( M, N, A, LDA, Q, LDQ, K, P, TAU, WORK, INFO ) * * Craig Lucas, University of Manchester * March, 2004 * * .. Scalar Arguments .. INTEGER INFO, K, LDA, LDQ, M, N, P * .. * .. Array Arguments .. DOUBLE PRECISION A( LDA, * ), Q( LDQ, * ), TAU( * ), WORK( * ) * .. * * Purpose * ======= * * DELCOLSQ generates an m by m real matrix Q with orthogonal columns, * which is defined as the product of Q_B and elementary reflectors * * Q = Q_B * H(k) * H(k+1) *...* H(last), last = min( m-1, n ) . * * where the H(j) are as returned by DELCOLSQ, such that C = Q * R and * C is the matrix B = Q_B * R_B, with p columns deleted from the * kth column onwards. * * Arguments * ========= * * M (input) INTEGER * The number of rows of the matrix A. M >= 0. * * N (input) INTEGER * The number of columns of the matrix A. N >= 0. * * A (input) DOUBLE PRECISION array, dimension (LDA,N) * On entry, the elements below the diagonal in columns k:n * must contain the vector which defines the elementary * reflector H(J) as returned by DELCOLS. * * LDA (input) INTEGER * The leading dimension of the array A. LDA >= max(1,M). * * Q (input/output) DOUBLE PRECISION array, dimension (LDA,N) * On entry, the matrix Q_B. * On exit, the matrix Q. * * LDQ (input) INTEGER * The leading dimension of the array Q. LDQ >= M. * * K (input) INTEGER * The position of the first column deleted from B. * 0 < K <= N+P. * * P (input) INTEGER * The number of columns deleted from B. P > 0. * * TAU (input) DOUBLE PRECISION array, dimension(N-K+1) * TAU(J) must contain the scalar factor of the elementary * reflector H(J), as returned by DELCOLS. * * WORK DOUBLE PRECISION array, dimension (P+1) * Work space. * * INFO (output) INTEGER * = 0: successful exit * < 0: if INFO = -I, the I-th argument had an illegal value. * * ===================================================================== * * .. Parameters .. DOUBLE PRECISION ONE PARAMETER ( ONE = 1.0D+0 ) * .. * .. Local Scalars .. DOUBLE PRECISION AJJ INTEGER J, LAST, LENH * .. * .. External Subroutines .. EXTERNAL DLARF, XERBLA * .. * .. Intrinsic Functions .. INTRINSIC MAX, MIN * .. * * Test the input parameters. * INFO = 0 IF( M.LT.0 ) THEN INFO = -1 ELSE IF( N.LT.0 ) THEN INFO = -2 ELSE IF( LDA.LT.MAX( 1, M ) ) THEN INFO = -4 ELSE IF( K.GT.N+P .OR. K.LE.0 ) THEN INFO = -5 ELSE IF( P.LE.0 ) THEN INFO = -6 END IF IF( INFO.NE.0 ) THEN CALL XERBLA( 'DELCOLSQ', -INFO ) RETURN END IF * LAST = MIN( M-1, N ) * DO 10 J = K, LAST * LENH = MIN( P+1, M-J+1 ) * * Apply H(J) from right * AJJ = A( J, J ) A( J, J ) = ONE * CALL DLARF( 'R', M, LENH, A( J, J ), 1, TAU( J-K+1 ), \$ Q( 1, J ), LDQ, WORK ) * A( J, J ) = AJJ * 10 CONTINUE * RETURN * * End of DELCOLSQ * END