rpl/lapack/lapack/zlarft.f - diff

Return to zlarft.f CVS log

Up to [local] / rpl / lapack / lapack

Diff for /rpl/lapack/lapack/zlarft.f between versions 1.11 and 1.22

version 1.11, 2012/07/31 11:06:39	version 1.22, 2023/08/07 08:39:31
Line 1	Line 1
*> \brief \b ZLARFT	*> \brief \b ZLARFT forms the triangular factor T of a block reflector H = I - vtvH
*	*
* =========== DOCUMENTATION ===========	* =========== DOCUMENTATION ===========
*	*
* Online html documentation available at	* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/	* http://www.netlib.org/lapack/explore-html/
*	*
*> \htmlonly	*> \htmlonly
*> Download ZLARFT + dependencies	*> Download ZLARFT + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zlarft.f">	*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zlarft.f">
*> [TGZ]</a>	*> [TGZ]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zlarft.f">	*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zlarft.f">
*> [ZIP]</a>	*> [ZIP]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zlarft.f">	*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zlarft.f">
*> [TXT]</a>	*> [TXT]</a>
*> \endhtmlonly	*> \endhtmlonly
*	*
* Definition:	* Definition:
* ===========	* ===========
*	*
* SUBROUTINE ZLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, LDT )	* SUBROUTINE ZLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, LDT )
*	*
* .. Scalar Arguments ..	* .. Scalar Arguments ..
* CHARACTER DIRECT, STOREV	* CHARACTER DIRECT, STOREV
* INTEGER K, LDT, LDV, N	* INTEGER K, LDT, LDV, N
Line 27	Line 27
* .. Array Arguments ..	* .. Array Arguments ..
* COMPLEX16 T( LDT, ), TAU( * ), V( LDV, * )	* COMPLEX16 T( LDT, ), TAU( * ), V( LDV, * )
* ..	* ..
*	*
*	*
*> \par Purpose:	*> \par Purpose:
* =============	* =============
Line 125	Line 125
* Authors:	* Authors:
* ========	* ========
*	*
*> \author Univ. of Tennessee	*> \author Univ. of Tennessee
*> \author Univ. of California Berkeley	*> \author Univ. of California Berkeley
*> \author Univ. of Colorado Denver	*> \author Univ. of Colorado Denver
*> \author NAG Ltd.	*> \author NAG Ltd.
*
*> \date April 2012
*	*
*> \ingroup complex16OTHERauxiliary	*> \ingroup complex16OTHERauxiliary
*	*
Line 163	Line 161
* =====================================================================	* =====================================================================
SUBROUTINE ZLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, LDT )	SUBROUTINE ZLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, LDT )
*	*
* -- LAPACK auxiliary routine (version 3.4.1) --	* -- LAPACK auxiliary routine --
* -- LAPACK is a software package provided by Univ. of Tennessee, --	* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--	* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* April 2012
*	*
* .. Scalar Arguments ..	* .. Scalar Arguments ..
CHARACTER DIRECT, STOREV	CHARACTER DIRECT, STOREV
Line 187	Line 184
INTEGER I, J, PREVLASTV, LASTV	INTEGER I, J, PREVLASTV, LASTV
* ..	* ..
* .. External Subroutines ..	* .. External Subroutines ..
EXTERNAL ZGEMV, ZLACGV, ZTRMV	EXTERNAL ZGEMV, ZTRMV, ZGEMM
* ..	* ..
* .. External Functions ..	* .. External Functions ..
LOGICAL LSAME	LOGICAL LSAME
Line 222	Line 219
END DO	END DO
DO J = 1, I-1	DO J = 1, I-1
T( J, I ) = -TAU( I ) * CONJG( V( I , J ) )	T( J, I ) = -TAU( I ) * CONJG( V( I , J ) )
END DO	END DO
J = MIN( LASTV, PREVLASTV )	J = MIN( LASTV, PREVLASTV )
*	*
* T(1:i-1,i) := - tau(i) * V(i:j,1:i-1)*H V(i:j,i)	* T(1:i-1,i) := - tau(i) * V(i:j,1:i-1)*H V(i:j,i)
*	*
CALL ZGEMV( 'Conjugate transpose', J-I, I-1,	CALL ZGEMV( 'Conjugate transpose', J-I, I-1,
$ -TAU( I ), V( I+1, 1 ), LDV,	$ -TAU( I ), V( I+1, 1 ), LDV,
$ V( I+1, I ), 1, ONE, T( 1, I ), 1 )	$ V( I+1, I ), 1, ONE, T( 1, I ), 1 )
ELSE	ELSE
* Skip any trailing zeros.	* Skip any trailing zeros.
Line 237	Line 234
END DO	END DO
DO J = 1, I-1	DO J = 1, I-1
T( J, I ) = -TAU( I ) * V( J , I )	T( J, I ) = -TAU( I ) * V( J , I )
END DO	END DO
J = MIN( LASTV, PREVLASTV )	J = MIN( LASTV, PREVLASTV )
*	*
* T(1:i-1,i) := - tau(i) * V(1:i-1,i:j) * V(i,i:j)**H	* T(1:i-1,i) := - tau(i) * V(1:i-1,i:j) * V(i,i:j)**H
*	*
CALL ZGEMM( 'N', 'C', I-1, 1, J-I, -TAU( I ),	CALL ZGEMM( 'N', 'C', I-1, 1, J-I, -TAU( I ),
$ V( 1, I+1 ), LDV, V( I, I+1 ), LDV,	$ V( 1, I+1 ), LDV, V( I, I+1 ), LDV,
$ ONE, T( 1, I ), LDT )	$ ONE, T( 1, I ), LDT )
END IF	END IF
*	*
* T(1:i-1,i) := T(1:i-1,1:i-1) * T(1:i-1,i)	* T(1:i-1,i) := T(1:i-1,1:i-1) * T(1:i-1,i)
Line 281	Line 278
END DO	END DO
DO J = I+1, K	DO J = I+1, K
T( J, I ) = -TAU( I ) * CONJG( V( N-K+I , J ) )	T( J, I ) = -TAU( I ) * CONJG( V( N-K+I , J ) )
END DO	END DO
J = MAX( LASTV, PREVLASTV )	J = MAX( LASTV, PREVLASTV )
*	*
* T(i+1:k,i) = -tau(i) * V(j:n-k+i,i+1:k)*H V(j:n-k+i,i)	* T(i+1:k,i) = -tau(i) * V(j:n-k+i,i+1:k)*H V(j:n-k+i,i)
Line 296	Line 293
END DO	END DO
DO J = I+1, K	DO J = I+1, K
T( J, I ) = -TAU( I ) * V( J, N-K+I )	T( J, I ) = -TAU( I ) * V( J, N-K+I )
END DO	END DO
J = MAX( LASTV, PREVLASTV )	J = MAX( LASTV, PREVLASTV )
*	*
* T(i+1:k,i) = -tau(i) * V(i+1:k,j:n-k+i) * V(i,j:n-k+i)**H	* T(i+1:k,i) = -tau(i) * V(i+1:k,j:n-k+i) * V(i,j:n-k+i)**H
*	*
CALL ZGEMM( 'N', 'C', K-I, 1, N-K+I-J, -TAU( I ),	CALL ZGEMM( 'N', 'C', K-I, 1, N-K+I-J, -TAU( I ),
$ V( I+1, J ), LDV, V( I, J ), LDV,	$ V( I+1, J ), LDV, V( I, J ), LDV,
$ ONE, T( I+1, I ), LDT )	$ ONE, T( I+1, I ), LDT )
END IF	END IF
*	*
* T(i+1:k,i) := T(i+1:k,i+1:k) * T(i+1:k,i)	* T(i+1:k,i) := T(i+1:k,i+1:k) * T(i+1:k,i)

CVSweb interface <joel.bertrand@systella.fr>

Removed from v.1.11
changed lines
	Added in v.1.22