|
LAPACK 3.3.0
|
|
LAPACK 3.3.0
|
00001 SUBROUTINE SORG2L( M, N, K, A, LDA, TAU, WORK, INFO ) 00002 * 00003 * -- LAPACK routine (version 3.2) -- 00004 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00005 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00006 * November 2006 00007 * 00008 * .. Scalar Arguments .. 00009 INTEGER INFO, K, LDA, M, N 00010 * .. 00011 * .. Array Arguments .. 00012 REAL A( LDA, * ), TAU( * ), WORK( * ) 00013 * .. 00014 * 00015 * Purpose 00016 * ======= 00017 * 00018 * SORG2L generates an m by n real matrix Q with orthonormal columns, 00019 * which is defined as the last n columns of a product of k elementary 00020 * reflectors of order m 00021 * 00022 * Q = H(k) . . . H(2) H(1) 00023 * 00024 * as returned by SGEQLF. 00025 * 00026 * Arguments 00027 * ========= 00028 * 00029 * M (input) INTEGER 00030 * The number of rows of the matrix Q. M >= 0. 00031 * 00032 * N (input) INTEGER 00033 * The number of columns of the matrix Q. M >= N >= 0. 00034 * 00035 * K (input) INTEGER 00036 * The number of elementary reflectors whose product defines the 00037 * matrix Q. N >= K >= 0. 00038 * 00039 * A (input/output) REAL array, dimension (LDA,N) 00040 * On entry, the (n-k+i)-th column must contain the vector which 00041 * defines the elementary reflector H(i), for i = 1,2,...,k, as 00042 * returned by SGEQLF in the last k columns of its array 00043 * argument A. 00044 * On exit, the m by n matrix Q. 00045 * 00046 * LDA (input) INTEGER 00047 * The first dimension of the array A. LDA >= max(1,M). 00048 * 00049 * TAU (input) REAL array, dimension (K) 00050 * TAU(i) must contain the scalar factor of the elementary 00051 * reflector H(i), as returned by SGEQLF. 00052 * 00053 * WORK (workspace) REAL array, dimension (N) 00054 * 00055 * INFO (output) INTEGER 00056 * = 0: successful exit 00057 * < 0: if INFO = -i, the i-th argument has an illegal value 00058 * 00059 * ===================================================================== 00060 * 00061 * .. Parameters .. 00062 REAL ONE, ZERO 00063 PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 ) 00064 * .. 00065 * .. Local Scalars .. 00066 INTEGER I, II, J, L 00067 * .. 00068 * .. External Subroutines .. 00069 EXTERNAL SLARF, SSCAL, XERBLA 00070 * .. 00071 * .. Intrinsic Functions .. 00072 INTRINSIC MAX 00073 * .. 00074 * .. Executable Statements .. 00075 * 00076 * Test the input arguments 00077 * 00078 INFO = 0 00079 IF( M.LT.0 ) THEN 00080 INFO = -1 00081 ELSE IF( N.LT.0 .OR. N.GT.M ) THEN 00082 INFO = -2 00083 ELSE IF( K.LT.0 .OR. K.GT.N ) THEN 00084 INFO = -3 00085 ELSE IF( LDA.LT.MAX( 1, M ) ) THEN 00086 INFO = -5 00087 END IF 00088 IF( INFO.NE.0 ) THEN 00089 CALL XERBLA( 'SORG2L', -INFO ) 00090 RETURN 00091 END IF 00092 * 00093 * Quick return if possible 00094 * 00095 IF( N.LE.0 ) 00096 $ RETURN 00097 * 00098 * Initialise columns 1:n-k to columns of the unit matrix 00099 * 00100 DO 20 J = 1, N - K 00101 DO 10 L = 1, M 00102 A( L, J ) = ZERO 00103 10 CONTINUE 00104 A( M-N+J, J ) = ONE 00105 20 CONTINUE 00106 * 00107 DO 40 I = 1, K 00108 II = N - K + I 00109 * 00110 * Apply H(i) to A(1:m-k+i,1:n-k+i) from the left 00111 * 00112 A( M-N+II, II ) = ONE 00113 CALL SLARF( 'Left', M-N+II, II-1, A( 1, II ), 1, TAU( I ), A, 00114 $ LDA, WORK ) 00115 CALL SSCAL( M-N+II-1, -TAU( I ), A( 1, II ), 1 ) 00116 A( M-N+II, II ) = ONE - TAU( I ) 00117 * 00118 * Set A(m-k+i+1:m,n-k+i) to zero 00119 * 00120 DO 30 L = M - N + II + 1, M 00121 A( L, II ) = ZERO 00122 30 CONTINUE 00123 40 CONTINUE 00124 RETURN 00125 * 00126 * End of SORG2L 00127 * 00128 END
1.7.3 
