Merge remote-tracking branch 'refs/remotes/Reference-LAPACK/master'

1 files changed, 163 insertions, 0 deletions

diff --git a/SRC/clarfy.f b/SRC/clarfy.f
new file mode 100644
index 00000000..572a4723
--- /dev/null
+++ b/SRC/clarfy.f
@@ -0,0 +1,163 @@
+*> \brief \b CLARFY
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+*            http://www.netlib.org/lapack/explore-html/
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE CLARFY( UPLO, N, V, INCV, TAU, C, LDC, WORK )
+*
+*       .. Scalar Arguments ..
+*       CHARACTER          UPLO
+*       INTEGER            INCV, LDC, N
+*       COMPLEX            TAU
+*       ..
+*       .. Array Arguments ..
+*       COMPLEX            C( LDC, * ), V( * ), WORK( * )
+*       ..
+*
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> CLARFY applies an elementary reflector, or Householder matrix, H,
+*> to an n x n Hermitian matrix C, from both the left and the right.
+*>
+*> H is represented in the form
+*>
+*>    H = I - tau * v * v'
+*>
+*> where  tau  is a scalar and  v  is a vector.
+*>
+*> If  tau  is  zero, then  H  is taken to be the unit matrix.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          Specifies whether the upper or lower triangular part of the
+*>          Hermitian matrix C is stored.
+*>          = 'U':  Upper triangle
+*>          = 'L':  Lower triangle
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The number of rows and columns of the matrix C.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in] V
+*> \verbatim
+*>          V is COMPLEX array, dimension
+*>                  (1 + (N-1)*abs(INCV))
+*>          The vector v as described above.
+*> \endverbatim
+*>
+*> \param[in] INCV
+*> \verbatim
+*>          INCV is INTEGER
+*>          The increment between successive elements of v.  INCV must
+*>          not be zero.
+*> \endverbatim
+*>
+*> \param[in] TAU
+*> \verbatim
+*>          TAU is COMPLEX
+*>          The value tau as described above.
+*> \endverbatim
+*>
+*> \param[in,out] C
+*> \verbatim
+*>          C is COMPLEX array, dimension (LDC, N)
+*>          On entry, the matrix C.
+*>          On exit, C is overwritten by H * C * H'.
+*> \endverbatim
+*>
+*> \param[in] LDC
+*> \verbatim
+*>          LDC is INTEGER
+*>          The leading dimension of the array C.  LDC >= max( 1, N ).
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is COMPLEX array, dimension (N)
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \date November 2011
+*
+*> \ingroup complex_eig
+*
+*  =====================================================================
+      SUBROUTINE CLARFY( UPLO, N, V, INCV, TAU, C, LDC, WORK )
+*
+*  -- LAPACK test routine (version 3.4.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2011
+*
+*     .. Scalar Arguments ..
+      CHARACTER          UPLO
+      INTEGER            INCV, LDC, N
+      COMPLEX            TAU
+*     ..
+*     .. Array Arguments ..
+      COMPLEX            C( LDC, * ), V( * ), WORK( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      COMPLEX            ONE, ZERO, HALF
+      PARAMETER          ( ONE = ( 1.0E+0, 0.0E+0 ),
+     $                   ZERO = ( 0.0E+0, 0.0E+0 ),
+     $                   HALF = ( 0.5E+0, 0.0E+0 ) )
+*     ..
+*     .. Local Scalars ..
+      COMPLEX            ALPHA
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           CAXPY, CHEMV, CHER2
+*     ..
+*     .. External Functions ..
+      COMPLEX            CDOTC
+      EXTERNAL           CDOTC
+*     ..
+*     .. Executable Statements ..
+*
+      IF( TAU.EQ.ZERO )
+     $   RETURN
+*
+*     Form  w:= C * v
+*
+      CALL CHEMV( UPLO, N, ONE, C, LDC, V, INCV, ZERO, WORK, 1 )
+*
+      ALPHA = -HALF*TAU*CDOTC( N, WORK, 1, V, INCV )
+      CALL CAXPY( N, ALPHA, V, INCV, WORK, 1 )
+*
+*     C := C - v * w' - w * v'
+*
+      CALL CHER2( UPLO, N, -TAU, V, INCV, WORK, 1, C, LDC )
+*
+      RETURN
+*
+*     End of CLARFY
+*
+      END