|
LAPACK 3.3.0
|
|
LAPACK 3.3.0
|
00001 SUBROUTINE CLATZM( SIDE, M, N, V, INCV, TAU, C1, C2, LDC, WORK ) 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 CHARACTER SIDE 00010 INTEGER INCV, LDC, M, N 00011 COMPLEX TAU 00012 * .. 00013 * .. Array Arguments .. 00014 COMPLEX C1( LDC, * ), C2( LDC, * ), V( * ), WORK( * ) 00015 * .. 00016 * 00017 * Purpose 00018 * ======= 00019 * 00020 * This routine is deprecated and has been replaced by routine CUNMRZ. 00021 * 00022 * CLATZM applies a Householder matrix generated by CTZRQF to a matrix. 00023 * 00024 * Let P = I - tau*u*u', u = ( 1 ), 00025 * ( v ) 00026 * where v is an (m-1) vector if SIDE = 'L', or a (n-1) vector if 00027 * SIDE = 'R'. 00028 * 00029 * If SIDE equals 'L', let 00030 * C = [ C1 ] 1 00031 * [ C2 ] m-1 00032 * n 00033 * Then C is overwritten by P*C. 00034 * 00035 * If SIDE equals 'R', let 00036 * C = [ C1, C2 ] m 00037 * 1 n-1 00038 * Then C is overwritten by C*P. 00039 * 00040 * Arguments 00041 * ========= 00042 * 00043 * SIDE (input) CHARACTER*1 00044 * = 'L': form P * C 00045 * = 'R': form C * P 00046 * 00047 * M (input) INTEGER 00048 * The number of rows of the matrix C. 00049 * 00050 * N (input) INTEGER 00051 * The number of columns of the matrix C. 00052 * 00053 * V (input) COMPLEX array, dimension 00054 * (1 + (M-1)*abs(INCV)) if SIDE = 'L' 00055 * (1 + (N-1)*abs(INCV)) if SIDE = 'R' 00056 * The vector v in the representation of P. V is not used 00057 * if TAU = 0. 00058 * 00059 * INCV (input) INTEGER 00060 * The increment between elements of v. INCV <> 0 00061 * 00062 * TAU (input) COMPLEX 00063 * The value tau in the representation of P. 00064 * 00065 * C1 (input/output) COMPLEX array, dimension 00066 * (LDC,N) if SIDE = 'L' 00067 * (M,1) if SIDE = 'R' 00068 * On entry, the n-vector C1 if SIDE = 'L', or the m-vector C1 00069 * if SIDE = 'R'. 00070 * 00071 * On exit, the first row of P*C if SIDE = 'L', or the first 00072 * column of C*P if SIDE = 'R'. 00073 * 00074 * C2 (input/output) COMPLEX array, dimension 00075 * (LDC, N) if SIDE = 'L' 00076 * (LDC, N-1) if SIDE = 'R' 00077 * On entry, the (m - 1) x n matrix C2 if SIDE = 'L', or the 00078 * m x (n - 1) matrix C2 if SIDE = 'R'. 00079 * 00080 * On exit, rows 2:m of P*C if SIDE = 'L', or columns 2:m of C*P 00081 * if SIDE = 'R'. 00082 * 00083 * LDC (input) INTEGER 00084 * The leading dimension of the arrays C1 and C2. 00085 * LDC >= max(1,M). 00086 * 00087 * WORK (workspace) COMPLEX array, dimension 00088 * (N) if SIDE = 'L' 00089 * (M) if SIDE = 'R' 00090 * 00091 * ===================================================================== 00092 * 00093 * .. Parameters .. 00094 COMPLEX ONE, ZERO 00095 PARAMETER ( ONE = ( 1.0E+0, 0.0E+0 ), 00096 $ ZERO = ( 0.0E+0, 0.0E+0 ) ) 00097 * .. 00098 * .. External Subroutines .. 00099 EXTERNAL CAXPY, CCOPY, CGEMV, CGERC, CGERU, CLACGV 00100 * .. 00101 * .. External Functions .. 00102 LOGICAL LSAME 00103 EXTERNAL LSAME 00104 * .. 00105 * .. Intrinsic Functions .. 00106 INTRINSIC MIN 00107 * .. 00108 * .. Executable Statements .. 00109 * 00110 IF( ( MIN( M, N ).EQ.0 ) .OR. ( TAU.EQ.ZERO ) ) 00111 $ RETURN 00112 * 00113 IF( LSAME( SIDE, 'L' ) ) THEN 00114 * 00115 * w := conjg( C1 + v' * C2 ) 00116 * 00117 CALL CCOPY( N, C1, LDC, WORK, 1 ) 00118 CALL CLACGV( N, WORK, 1 ) 00119 CALL CGEMV( 'Conjugate transpose', M-1, N, ONE, C2, LDC, V, 00120 $ INCV, ONE, WORK, 1 ) 00121 * 00122 * [ C1 ] := [ C1 ] - tau* [ 1 ] * w' 00123 * [ C2 ] [ C2 ] [ v ] 00124 * 00125 CALL CLACGV( N, WORK, 1 ) 00126 CALL CAXPY( N, -TAU, WORK, 1, C1, LDC ) 00127 CALL CGERU( M-1, N, -TAU, V, INCV, WORK, 1, C2, LDC ) 00128 * 00129 ELSE IF( LSAME( SIDE, 'R' ) ) THEN 00130 * 00131 * w := C1 + C2 * v 00132 * 00133 CALL CCOPY( M, C1, 1, WORK, 1 ) 00134 CALL CGEMV( 'No transpose', M, N-1, ONE, C2, LDC, V, INCV, ONE, 00135 $ WORK, 1 ) 00136 * 00137 * [ C1, C2 ] := [ C1, C2 ] - tau* w * [ 1 , v'] 00138 * 00139 CALL CAXPY( M, -TAU, WORK, 1, C1, 1 ) 00140 CALL CGERC( M, N-1, -TAU, WORK, 1, V, INCV, C2, LDC ) 00141 END IF 00142 * 00143 RETURN 00144 * 00145 * End of CLATZM 00146 * 00147 END
1.7.3 
