LAPACK 3.3.0

clatzm.f

Go to the documentation of this file.
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
 All Files Functions