LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
slatzm.f
Go to the documentation of this file.
00001 *> \brief \b SLATZM
00002 *
00003 *  =========== DOCUMENTATION ===========
00004 *
00005 * Online html documentation available at 
00006 *            http://www.netlib.org/lapack/explore-html/ 
00007 *
00008 *> \htmlonly
00009 *> Download SLATZM + dependencies 
00010 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slatzm.f"> 
00011 *> [TGZ]</a> 
00012 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slatzm.f"> 
00013 *> [ZIP]</a> 
00014 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slatzm.f"> 
00015 *> [TXT]</a>
00016 *> \endhtmlonly 
00017 *
00018 *  Definition:
00019 *  ===========
00020 *
00021 *       SUBROUTINE SLATZM( SIDE, M, N, V, INCV, TAU, C1, C2, LDC, WORK )
00022 * 
00023 *       .. Scalar Arguments ..
00024 *       CHARACTER          SIDE
00025 *       INTEGER            INCV, LDC, M, N
00026 *       REAL               TAU
00027 *       ..
00028 *       .. Array Arguments ..
00029 *       REAL               C1( LDC, * ), C2( LDC, * ), V( * ), WORK( * )
00030 *       ..
00031 *  
00032 *
00033 *> \par Purpose:
00034 *  =============
00035 *>
00036 *> \verbatim
00037 *>
00038 *> This routine is deprecated and has been replaced by routine SORMRZ.
00039 *>
00040 *> SLATZM applies a Householder matrix generated by STZRQF to a matrix.
00041 *>
00042 *> Let P = I - tau*u*u**T,   u = ( 1 ),
00043 *>                               ( v )
00044 *> where v is an (m-1) vector if SIDE = 'L', or a (n-1) vector if
00045 *> SIDE = 'R'.
00046 *>
00047 *> If SIDE equals 'L', let
00048 *>        C = [ C1 ] 1
00049 *>            [ C2 ] m-1
00050 *>              n
00051 *> Then C is overwritten by P*C.
00052 *>
00053 *> If SIDE equals 'R', let
00054 *>        C = [ C1, C2 ] m
00055 *>               1  n-1
00056 *> Then C is overwritten by C*P.
00057 *> \endverbatim
00058 *
00059 *  Arguments:
00060 *  ==========
00061 *
00062 *> \param[in] SIDE
00063 *> \verbatim
00064 *>          SIDE is CHARACTER*1
00065 *>          = 'L': form P * C
00066 *>          = 'R': form C * P
00067 *> \endverbatim
00068 *>
00069 *> \param[in] M
00070 *> \verbatim
00071 *>          M is INTEGER
00072 *>          The number of rows of the matrix C.
00073 *> \endverbatim
00074 *>
00075 *> \param[in] N
00076 *> \verbatim
00077 *>          N is INTEGER
00078 *>          The number of columns of the matrix C.
00079 *> \endverbatim
00080 *>
00081 *> \param[in] V
00082 *> \verbatim
00083 *>          V is REAL array, dimension
00084 *>                  (1 + (M-1)*abs(INCV)) if SIDE = 'L'
00085 *>                  (1 + (N-1)*abs(INCV)) if SIDE = 'R'
00086 *>          The vector v in the representation of P. V is not used
00087 *>          if TAU = 0.
00088 *> \endverbatim
00089 *>
00090 *> \param[in] INCV
00091 *> \verbatim
00092 *>          INCV is INTEGER
00093 *>          The increment between elements of v. INCV <> 0
00094 *> \endverbatim
00095 *>
00096 *> \param[in] TAU
00097 *> \verbatim
00098 *>          TAU is REAL
00099 *>          The value tau in the representation of P.
00100 *> \endverbatim
00101 *>
00102 *> \param[in,out] C1
00103 *> \verbatim
00104 *>          C1 is REAL array, dimension
00105 *>                         (LDC,N) if SIDE = 'L'
00106 *>                         (M,1)   if SIDE = 'R'
00107 *>          On entry, the n-vector C1 if SIDE = 'L', or the m-vector C1
00108 *>          if SIDE = 'R'.
00109 *>
00110 *>          On exit, the first row of P*C if SIDE = 'L', or the first
00111 *>          column of C*P if SIDE = 'R'.
00112 *> \endverbatim
00113 *>
00114 *> \param[in,out] C2
00115 *> \verbatim
00116 *>          C2 is REAL array, dimension
00117 *>                         (LDC, N)   if SIDE = 'L'
00118 *>                         (LDC, N-1) if SIDE = 'R'
00119 *>          On entry, the (m - 1) x n matrix C2 if SIDE = 'L', or the
00120 *>          m x (n - 1) matrix C2 if SIDE = 'R'.
00121 *>
00122 *>          On exit, rows 2:m of P*C if SIDE = 'L', or columns 2:m of C*P
00123 *>          if SIDE = 'R'.
00124 *> \endverbatim
00125 *>
00126 *> \param[in] LDC
00127 *> \verbatim
00128 *>          LDC is INTEGER
00129 *>          The leading dimension of the arrays C1 and C2. LDC >= (1,M).
00130 *> \endverbatim
00131 *>
00132 *> \param[out] WORK
00133 *> \verbatim
00134 *>          WORK is REAL array, dimension
00135 *>                      (N) if SIDE = 'L'
00136 *>                      (M) if SIDE = 'R'
00137 *> \endverbatim
00138 *
00139 *  Authors:
00140 *  ========
00141 *
00142 *> \author Univ. of Tennessee 
00143 *> \author Univ. of California Berkeley 
00144 *> \author Univ. of Colorado Denver 
00145 *> \author NAG Ltd. 
00146 *
00147 *> \date November 2011
00148 *
00149 *> \ingroup realOTHERcomputational
00150 *
00151 *  =====================================================================
00152       SUBROUTINE SLATZM( SIDE, M, N, V, INCV, TAU, C1, C2, LDC, WORK )
00153 *
00154 *  -- LAPACK computational routine (version 3.4.0) --
00155 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00156 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00157 *     November 2011
00158 *
00159 *     .. Scalar Arguments ..
00160       CHARACTER          SIDE
00161       INTEGER            INCV, LDC, M, N
00162       REAL               TAU
00163 *     ..
00164 *     .. Array Arguments ..
00165       REAL               C1( LDC, * ), C2( LDC, * ), V( * ), WORK( * )
00166 *     ..
00167 *
00168 *  =====================================================================
00169 *
00170 *     .. Parameters ..
00171       REAL               ONE, ZERO
00172       PARAMETER          ( ONE = 1.0E+0, ZERO = 0.0E+0 )
00173 *     ..
00174 *     .. External Subroutines ..
00175       EXTERNAL           SAXPY, SCOPY, SGEMV, SGER
00176 *     ..
00177 *     .. External Functions ..
00178       LOGICAL            LSAME
00179       EXTERNAL           LSAME
00180 *     ..
00181 *     .. Intrinsic Functions ..
00182       INTRINSIC          MIN
00183 *     ..
00184 *     .. Executable Statements ..
00185 *
00186       IF( ( MIN( M, N ).EQ.0 ) .OR. ( TAU.EQ.ZERO ) )
00187      $   RETURN
00188 *
00189       IF( LSAME( SIDE, 'L' ) ) THEN
00190 *
00191 *        w :=  (C1 + v**T * C2)**T
00192 *
00193          CALL SCOPY( N, C1, LDC, WORK, 1 )
00194          CALL SGEMV( 'Transpose', M-1, N, ONE, C2, LDC, V, INCV, ONE,
00195      $               WORK, 1 )
00196 *
00197 *        [ C1 ] := [ C1 ] - tau* [ 1 ] * w**T
00198 *        [ C2 ]    [ C2 ]        [ v ]
00199 *
00200          CALL SAXPY( N, -TAU, WORK, 1, C1, LDC )
00201          CALL SGER( M-1, N, -TAU, V, INCV, WORK, 1, C2, LDC )
00202 *
00203       ELSE IF( LSAME( SIDE, 'R' ) ) THEN
00204 *
00205 *        w := C1 + C2 * v
00206 *
00207          CALL SCOPY( M, C1, 1, WORK, 1 )
00208          CALL SGEMV( 'No transpose', M, N-1, ONE, C2, LDC, V, INCV, ONE,
00209      $               WORK, 1 )
00210 *
00211 *        [ C1, C2 ] := [ C1, C2 ] - tau* w * [ 1 , v**T]
00212 *
00213          CALL SAXPY( M, -TAU, WORK, 1, C1, 1 )
00214          CALL SGER( M, N-1, -TAU, WORK, 1, V, INCV, C2, LDC )
00215       END IF
00216 *
00217       RETURN
00218 *
00219 *     End of SLATZM
00220 *
00221       END
 All Files Functions