diff options
Diffstat (limited to 'eigen/lapack/zlarf.f')
-rw-r--r-- | eigen/lapack/zlarf.f | 232 |
1 files changed, 0 insertions, 232 deletions
diff --git a/eigen/lapack/zlarf.f b/eigen/lapack/zlarf.f deleted file mode 100644 index 53f314d..0000000 --- a/eigen/lapack/zlarf.f +++ /dev/null @@ -1,232 +0,0 @@ -*> \brief \b ZLARF -* -* =========== DOCUMENTATION =========== -* -* Online html documentation available at -* http://www.netlib.org/lapack/explore-html/ -* -*> \htmlonly -*> Download ZLARF + dependencies -*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zlarf.f"> -*> [TGZ]</a> -*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zlarf.f"> -*> [ZIP]</a> -*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zlarf.f"> -*> [TXT]</a> -*> \endhtmlonly -* -* Definition: -* =========== -* -* SUBROUTINE ZLARF( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) -* -* .. Scalar Arguments .. -* CHARACTER SIDE -* INTEGER INCV, LDC, M, N -* COMPLEX*16 TAU -* .. -* .. Array Arguments .. -* COMPLEX*16 C( LDC, * ), V( * ), WORK( * ) -* .. -* -* -*> \par Purpose: -* ============= -*> -*> \verbatim -*> -*> ZLARF applies a complex elementary reflector H to a complex M-by-N -*> matrix C, from either the left or the right. H is represented in the -*> form -*> -*> H = I - tau * v * v**H -*> -*> where tau is a complex scalar and v is a complex vector. -*> -*> If tau = 0, then H is taken to be the unit matrix. -*> -*> To apply H**H, supply conjg(tau) instead -*> tau. -*> \endverbatim -* -* Arguments: -* ========== -* -*> \param[in] SIDE -*> \verbatim -*> SIDE is CHARACTER*1 -*> = 'L': form H * C -*> = 'R': form C * H -*> \endverbatim -*> -*> \param[in] M -*> \verbatim -*> M is INTEGER -*> The number of rows of the matrix C. -*> \endverbatim -*> -*> \param[in] N -*> \verbatim -*> N is INTEGER -*> The number of columns of the matrix C. -*> \endverbatim -*> -*> \param[in] V -*> \verbatim -*> V is COMPLEX*16 array, dimension -*> (1 + (M-1)*abs(INCV)) if SIDE = 'L' -*> or (1 + (N-1)*abs(INCV)) if SIDE = 'R' -*> The vector v in the representation of H. V is not used if -*> TAU = 0. -*> \endverbatim -*> -*> \param[in] INCV -*> \verbatim -*> INCV is INTEGER -*> The increment between elements of v. INCV <> 0. -*> \endverbatim -*> -*> \param[in] TAU -*> \verbatim -*> TAU is COMPLEX*16 -*> The value tau in the representation of H. -*> \endverbatim -*> -*> \param[in,out] C -*> \verbatim -*> C is COMPLEX*16 array, dimension (LDC,N) -*> On entry, the M-by-N matrix C. -*> On exit, C is overwritten by the matrix H * C if SIDE = 'L', -*> or C * H if SIDE = 'R'. -*> \endverbatim -*> -*> \param[in] LDC -*> \verbatim -*> LDC is INTEGER -*> The leading dimension of the array C. LDC >= max(1,M). -*> \endverbatim -*> -*> \param[out] WORK -*> \verbatim -*> WORK is COMPLEX*16 array, dimension -*> (N) if SIDE = 'L' -*> or (M) if SIDE = 'R' -*> \endverbatim -* -* Authors: -* ======== -* -*> \author Univ. of Tennessee -*> \author Univ. of California Berkeley -*> \author Univ. of Colorado Denver -*> \author NAG Ltd. -* -*> \date November 2011 -* -*> \ingroup complex16OTHERauxiliary -* -* ===================================================================== - SUBROUTINE ZLARF( SIDE, M, N, V, INCV, TAU, C, LDC, WORK ) -* -* -- LAPACK auxiliary routine (version 3.4.0) -- -* -- LAPACK is a software package provided by Univ. of Tennessee, -- -* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 -* -* .. Scalar Arguments .. - CHARACTER SIDE - INTEGER INCV, LDC, M, N - COMPLEX*16 TAU -* .. -* .. Array Arguments .. - COMPLEX*16 C( LDC, * ), V( * ), WORK( * ) -* .. -* -* ===================================================================== -* -* .. Parameters .. - COMPLEX*16 ONE, ZERO - PARAMETER ( ONE = ( 1.0D+0, 0.0D+0 ), - $ ZERO = ( 0.0D+0, 0.0D+0 ) ) -* .. -* .. Local Scalars .. - LOGICAL APPLYLEFT - INTEGER I, LASTV, LASTC -* .. -* .. External Subroutines .. - EXTERNAL ZGEMV, ZGERC -* .. -* .. External Functions .. - LOGICAL LSAME - INTEGER ILAZLR, ILAZLC - EXTERNAL LSAME, ILAZLR, ILAZLC -* .. -* .. Executable Statements .. -* - APPLYLEFT = LSAME( SIDE, 'L' ) - LASTV = 0 - LASTC = 0 - IF( TAU.NE.ZERO ) THEN -* Set up variables for scanning V. LASTV begins pointing to the end -* of V. - IF( APPLYLEFT ) THEN - LASTV = M - ELSE - LASTV = N - END IF - IF( INCV.GT.0 ) THEN - I = 1 + (LASTV-1) * INCV - ELSE - I = 1 - END IF -* Look for the last non-zero row in V. - DO WHILE( LASTV.GT.0 .AND. V( I ).EQ.ZERO ) - LASTV = LASTV - 1 - I = I - INCV - END DO - IF( APPLYLEFT ) THEN -* Scan for the last non-zero column in C(1:lastv,:). - LASTC = ILAZLC(LASTV, N, C, LDC) - ELSE -* Scan for the last non-zero row in C(:,1:lastv). - LASTC = ILAZLR(M, LASTV, C, LDC) - END IF - END IF -* Note that lastc.eq.0 renders the BLAS operations null; no special -* case is needed at this level. - IF( APPLYLEFT ) THEN -* -* Form H * C -* - IF( LASTV.GT.0 ) THEN -* -* w(1:lastc,1) := C(1:lastv,1:lastc)**H * v(1:lastv,1) -* - CALL ZGEMV( 'Conjugate transpose', LASTV, LASTC, ONE, - $ C, LDC, V, INCV, ZERO, WORK, 1 ) -* -* C(1:lastv,1:lastc) := C(...) - v(1:lastv,1) * w(1:lastc,1)**H -* - CALL ZGERC( LASTV, LASTC, -TAU, V, INCV, WORK, 1, C, LDC ) - END IF - ELSE -* -* Form C * H -* - IF( LASTV.GT.0 ) THEN -* -* w(1:lastc,1) := C(1:lastc,1:lastv) * v(1:lastv,1) -* - CALL ZGEMV( 'No transpose', LASTC, LASTV, ONE, C, LDC, - $ V, INCV, ZERO, WORK, 1 ) -* -* C(1:lastc,1:lastv) := C(...) - w(1:lastc,1) * v(1:lastv,1)**H -* - CALL ZGERC( LASTC, LASTV, -TAU, WORK, 1, V, INCV, C, LDC ) - END IF - END IF - RETURN -* -* End of ZLARF -* - END |