LAPACK 3.3.1 Linear Algebra PACKage

# slatzm.f

Go to the documentation of this file.
```00001       SUBROUTINE SLATZM( SIDE, M, N, V, INCV, TAU, C1, C2, LDC, WORK )
00002 *
00003 *  -- LAPACK routine (version 3.3.1) --
00004 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00005 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00006 *  -- April 2011                                                      --
00007 *
00008 *     .. Scalar Arguments ..
00009       CHARACTER          SIDE
00010       INTEGER            INCV, LDC, M, N
00011       REAL               TAU
00012 *     ..
00013 *     .. Array Arguments ..
00014       REAL               C1( LDC, * ), C2( LDC, * ), V( * ), WORK( * )
00015 *     ..
00016 *
00017 *  Purpose
00018 *  =======
00019 *
00020 *  This routine is deprecated and has been replaced by routine SORMRZ.
00021 *
00022 *  SLATZM applies a Householder matrix generated by STZRQF to a matrix.
00023 *
00024 *  Let P = I - tau*u*u**T,   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) REAL 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) REAL
00063 *          The value tau in the representation of P.
00064 *
00065 *  C1      (input/output) REAL 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) REAL 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. LDC >= (1,M).
00085 *
00086 *  WORK    (workspace) REAL array, dimension
00087 *                      (N) if SIDE = 'L'
00088 *                      (M) if SIDE = 'R'
00089 *
00090 *  =====================================================================
00091 *
00092 *     .. Parameters ..
00093       REAL               ONE, ZERO
00094       PARAMETER          ( ONE = 1.0E+0, ZERO = 0.0E+0 )
00095 *     ..
00096 *     .. External Subroutines ..
00097       EXTERNAL           SAXPY, SCOPY, SGEMV, SGER
00098 *     ..
00099 *     .. External Functions ..
00100       LOGICAL            LSAME
00101       EXTERNAL           LSAME
00102 *     ..
00103 *     .. Intrinsic Functions ..
00104       INTRINSIC          MIN
00105 *     ..
00106 *     .. Executable Statements ..
00107 *
00108       IF( ( MIN( M, N ).EQ.0 ) .OR. ( TAU.EQ.ZERO ) )
00109      \$   RETURN
00110 *
00111       IF( LSAME( SIDE, 'L' ) ) THEN
00112 *
00113 *        w :=  (C1 + v**T * C2)**T
00114 *
00115          CALL SCOPY( N, C1, LDC, WORK, 1 )
00116          CALL SGEMV( 'Transpose', M-1, N, ONE, C2, LDC, V, INCV, ONE,
00117      \$               WORK, 1 )
00118 *
00119 *        [ C1 ] := [ C1 ] - tau* [ 1 ] * w**T
00120 *        [ C2 ]    [ C2 ]        [ v ]
00121 *
00122          CALL SAXPY( N, -TAU, WORK, 1, C1, LDC )
00123          CALL SGER( M-1, N, -TAU, V, INCV, WORK, 1, C2, LDC )
00124 *
00125       ELSE IF( LSAME( SIDE, 'R' ) ) THEN
00126 *
00127 *        w := C1 + C2 * v
00128 *
00129          CALL SCOPY( M, C1, 1, WORK, 1 )
00130          CALL SGEMV( 'No transpose', M, N-1, ONE, C2, LDC, V, INCV, ONE,
00131      \$               WORK, 1 )
00132 *
00133 *        [ C1, C2 ] := [ C1, C2 ] - tau* w * [ 1 , v**T]
00134 *
00135          CALL SAXPY( M, -TAU, WORK, 1, C1, 1 )
00136          CALL SGER( M, N-1, -TAU, WORK, 1, V, INCV, C2, LDC )
00137       END IF
00138 *
00139       RETURN
00140 *
00141 *     End of SLATZM
00142 *
00143       END
```