diff options
Diffstat (limited to '2.3-1/src/fortran/lapack/zung2l.f')
| -rw-r--r-- | 2.3-1/src/fortran/lapack/zung2l.f | 128 |
1 files changed, 128 insertions, 0 deletions
diff --git a/2.3-1/src/fortran/lapack/zung2l.f b/2.3-1/src/fortran/lapack/zung2l.f new file mode 100644 index 00000000..29178b90 --- /dev/null +++ b/2.3-1/src/fortran/lapack/zung2l.f @@ -0,0 +1,128 @@ + SUBROUTINE ZUNG2L( M, N, K, A, LDA, TAU, WORK, INFO ) +* +* -- LAPACK routine (version 3.1) -- +* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. +* November 2006 +* +* .. Scalar Arguments .. + INTEGER INFO, K, LDA, M, N +* .. +* .. Array Arguments .. + COMPLEX*16 A( LDA, * ), TAU( * ), WORK( * ) +* .. +* +* Purpose +* ======= +* +* ZUNG2L generates an m by n complex matrix Q with orthonormal columns, +* which is defined as the last n columns of a product of k elementary +* reflectors of order m +* +* Q = H(k) . . . H(2) H(1) +* +* as returned by ZGEQLF. +* +* Arguments +* ========= +* +* M (input) INTEGER +* The number of rows of the matrix Q. M >= 0. +* +* N (input) INTEGER +* The number of columns of the matrix Q. M >= N >= 0. +* +* K (input) INTEGER +* The number of elementary reflectors whose product defines the +* matrix Q. N >= K >= 0. +* +* A (input/output) COMPLEX*16 array, dimension (LDA,N) +* On entry, the (n-k+i)-th column must contain the vector which +* defines the elementary reflector H(i), for i = 1,2,...,k, as +* returned by ZGEQLF in the last k columns of its array +* argument A. +* On exit, the m-by-n matrix Q. +* +* LDA (input) INTEGER +* The first dimension of the array A. LDA >= max(1,M). +* +* TAU (input) COMPLEX*16 array, dimension (K) +* TAU(i) must contain the scalar factor of the elementary +* reflector H(i), as returned by ZGEQLF. +* +* WORK (workspace) COMPLEX*16 array, dimension (N) +* +* INFO (output) INTEGER +* = 0: successful exit +* < 0: if INFO = -i, the i-th argument has an illegal value +* +* ===================================================================== +* +* .. Parameters .. + COMPLEX*16 ONE, ZERO + PARAMETER ( ONE = ( 1.0D+0, 0.0D+0 ), + $ ZERO = ( 0.0D+0, 0.0D+0 ) ) +* .. +* .. Local Scalars .. + INTEGER I, II, J, L +* .. +* .. External Subroutines .. + EXTERNAL XERBLA, ZLARF, ZSCAL +* .. +* .. Intrinsic Functions .. + INTRINSIC MAX +* .. +* .. Executable Statements .. +* +* Test the input arguments +* + INFO = 0 + IF( M.LT.0 ) THEN + INFO = -1 + ELSE IF( N.LT.0 .OR. N.GT.M ) THEN + INFO = -2 + ELSE IF( K.LT.0 .OR. K.GT.N ) THEN + INFO = -3 + ELSE IF( LDA.LT.MAX( 1, M ) ) THEN + INFO = -5 + END IF + IF( INFO.NE.0 ) THEN + CALL XERBLA( 'ZUNG2L', -INFO ) + RETURN + END IF +* +* Quick return if possible +* + IF( N.LE.0 ) + $ RETURN +* +* Initialise columns 1:n-k to columns of the unit matrix +* + DO 20 J = 1, N - K + DO 10 L = 1, M + A( L, J ) = ZERO + 10 CONTINUE + A( M-N+J, J ) = ONE + 20 CONTINUE +* + DO 40 I = 1, K + II = N - K + I +* +* Apply H(i) to A(1:m-k+i,1:n-k+i) from the left +* + A( M-N+II, II ) = ONE + CALL ZLARF( 'Left', M-N+II, II-1, A( 1, II ), 1, TAU( I ), A, + $ LDA, WORK ) + CALL ZSCAL( M-N+II-1, -TAU( I ), A( 1, II ), 1 ) + A( M-N+II, II ) = ONE - TAU( I ) +* +* Set A(m-k+i+1:m,n-k+i) to zero +* + DO 30 L = M - N + II + 1, M + A( L, II ) = ZERO + 30 CONTINUE + 40 CONTINUE + RETURN +* +* End of ZUNG2L +* + END |