diff options
author | jofret | 2009-04-28 07:17:00 +0000 |
---|---|---|
committer | jofret | 2009-04-28 07:17:00 +0000 |
commit | 8c8d2f518968ce7057eec6aa5cd5aec8faab861a (patch) | |
tree | 3dd1788b71d6a3ce2b73d2d475a3133580e17530 /src/lib/lapack/zlarz.f | |
parent | 9f652ffc16a310ac6641a9766c5b9e2671e0e9cb (diff) | |
download | scilab2c-8c8d2f518968ce7057eec6aa5cd5aec8faab861a.tar.gz scilab2c-8c8d2f518968ce7057eec6aa5cd5aec8faab861a.tar.bz2 scilab2c-8c8d2f518968ce7057eec6aa5cd5aec8faab861a.zip |
Moving lapack to right place
Diffstat (limited to 'src/lib/lapack/zlarz.f')
-rw-r--r-- | src/lib/lapack/zlarz.f | 157 |
1 files changed, 0 insertions, 157 deletions
diff --git a/src/lib/lapack/zlarz.f b/src/lib/lapack/zlarz.f deleted file mode 100644 index 18124672..00000000 --- a/src/lib/lapack/zlarz.f +++ /dev/null @@ -1,157 +0,0 @@ - SUBROUTINE ZLARZ( SIDE, M, N, L, V, INCV, TAU, C, LDC, WORK ) -* -* -- LAPACK routine (version 3.1) -- -* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. -* November 2006 -* -* .. Scalar Arguments .. - CHARACTER SIDE - INTEGER INCV, L, LDC, M, N - COMPLEX*16 TAU -* .. -* .. Array Arguments .. - COMPLEX*16 C( LDC, * ), V( * ), WORK( * ) -* .. -* -* Purpose -* ======= -* -* ZLARZ 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' -* -* 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' (the conjugate transpose of H), supply conjg(tau) instead -* tau. -* -* H is a product of k elementary reflectors as returned by ZTZRZF. -* -* Arguments -* ========= -* -* SIDE (input) CHARACTER*1 -* = 'L': form H * C -* = 'R': form C * H -* -* M (input) INTEGER -* The number of rows of the matrix C. -* -* N (input) INTEGER -* The number of columns of the matrix C. -* -* L (input) INTEGER -* The number of entries of the vector V containing -* the meaningful part of the Householder vectors. -* If SIDE = 'L', M >= L >= 0, if SIDE = 'R', N >= L >= 0. -* -* V (input) COMPLEX*16 array, dimension (1+(L-1)*abs(INCV)) -* The vector v in the representation of H as returned by -* ZTZRZF. V is not used if TAU = 0. -* -* INCV (input) INTEGER -* The increment between elements of v. INCV <> 0. -* -* TAU (input) COMPLEX*16 -* The value tau in the representation of H. -* -* C (input/output) 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'. -* -* LDC (input) INTEGER -* The leading dimension of the array C. LDC >= max(1,M). -* -* WORK (workspace) COMPLEX*16 array, dimension -* (N) if SIDE = 'L' -* or (M) if SIDE = 'R' -* -* Further Details -* =============== -* -* Based on contributions by -* A. Petitet, Computer Science Dept., Univ. of Tenn., Knoxville, USA -* -* ===================================================================== -* -* .. Parameters .. - COMPLEX*16 ONE, ZERO - PARAMETER ( ONE = ( 1.0D+0, 0.0D+0 ), - $ ZERO = ( 0.0D+0, 0.0D+0 ) ) -* .. -* .. External Subroutines .. - EXTERNAL ZAXPY, ZCOPY, ZGEMV, ZGERC, ZGERU, ZLACGV -* .. -* .. External Functions .. - LOGICAL LSAME - EXTERNAL LSAME -* .. -* .. Executable Statements .. -* - IF( LSAME( SIDE, 'L' ) ) THEN -* -* Form H * C -* - IF( TAU.NE.ZERO ) THEN -* -* w( 1:n ) = conjg( C( 1, 1:n ) ) -* - CALL ZCOPY( N, C, LDC, WORK, 1 ) - CALL ZLACGV( N, WORK, 1 ) -* -* w( 1:n ) = conjg( w( 1:n ) + C( m-l+1:m, 1:n )' * v( 1:l ) ) -* - CALL ZGEMV( 'Conjugate transpose', L, N, ONE, C( M-L+1, 1 ), - $ LDC, V, INCV, ONE, WORK, 1 ) - CALL ZLACGV( N, WORK, 1 ) -* -* C( 1, 1:n ) = C( 1, 1:n ) - tau * w( 1:n ) -* - CALL ZAXPY( N, -TAU, WORK, 1, C, LDC ) -* -* C( m-l+1:m, 1:n ) = C( m-l+1:m, 1:n ) - ... -* tau * v( 1:l ) * conjg( w( 1:n )' ) -* - CALL ZGERU( L, N, -TAU, V, INCV, WORK, 1, C( M-L+1, 1 ), - $ LDC ) - END IF -* - ELSE -* -* Form C * H -* - IF( TAU.NE.ZERO ) THEN -* -* w( 1:m ) = C( 1:m, 1 ) -* - CALL ZCOPY( M, C, 1, WORK, 1 ) -* -* w( 1:m ) = w( 1:m ) + C( 1:m, n-l+1:n, 1:n ) * v( 1:l ) -* - CALL ZGEMV( 'No transpose', M, L, ONE, C( 1, N-L+1 ), LDC, - $ V, INCV, ONE, WORK, 1 ) -* -* C( 1:m, 1 ) = C( 1:m, 1 ) - tau * w( 1:m ) -* - CALL ZAXPY( M, -TAU, WORK, 1, C, 1 ) -* -* C( 1:m, n-l+1:n ) = C( 1:m, n-l+1:n ) - ... -* tau * w( 1:m ) * v( 1:l )' -* - CALL ZGERC( M, L, -TAU, WORK, 1, V, INCV, C( 1, N-L+1 ), - $ LDC ) -* - END IF -* - END IF -* - RETURN -* -* End of ZLARZ -* - END |