00001 /* dlarfy.f -- translated by f2c (version 20061008). 00002 You must link the resulting object file with libf2c: 00003 on Microsoft Windows system, link with libf2c.lib; 00004 on Linux or Unix systems, link with .../path/to/libf2c.a -lm 00005 or, if you install libf2c.a in a standard place, with -lf2c -lm 00006 -- in that order, at the end of the command line, as in 00007 cc *.o -lf2c -lm 00008 Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., 00009 00010 http://www.netlib.org/f2c/libf2c.zip 00011 */ 00012 00013 #include "f2c.h" 00014 #include "blaswrap.h" 00015 00016 /* Table of constant values */ 00017 00018 static doublereal c_b2 = 1.; 00019 static doublereal c_b3 = 0.; 00020 static integer c__1 = 1; 00021 00022 /* Subroutine */ int dlarfy_(char *uplo, integer *n, doublereal *v, integer * 00023 incv, doublereal *tau, doublereal *c__, integer *ldc, doublereal * 00024 work) 00025 { 00026 /* System generated locals */ 00027 integer c_dim1, c_offset; 00028 doublereal d__1; 00029 00030 /* Local variables */ 00031 extern doublereal ddot_(integer *, doublereal *, integer *, doublereal *, 00032 integer *); 00033 extern /* Subroutine */ int dsyr2_(char *, integer *, doublereal *, 00034 doublereal *, integer *, doublereal *, integer *, doublereal *, 00035 integer *); 00036 doublereal alpha; 00037 extern /* Subroutine */ int daxpy_(integer *, doublereal *, doublereal *, 00038 integer *, doublereal *, integer *), dsymv_(char *, integer *, 00039 doublereal *, doublereal *, integer *, doublereal *, integer *, 00040 doublereal *, doublereal *, integer *); 00041 00042 00043 /* -- LAPACK auxiliary test routine (version 3.1) -- */ 00044 /* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */ 00045 /* November 2006 */ 00046 00047 /* .. Scalar Arguments .. */ 00048 /* .. */ 00049 /* .. Array Arguments .. */ 00050 /* .. */ 00051 00052 /* Purpose */ 00053 /* ======= */ 00054 00055 /* DLARFY applies an elementary reflector, or Householder matrix, H, */ 00056 /* to an n x n symmetric matrix C, from both the left and the right. */ 00057 00058 /* H is represented in the form */ 00059 00060 /* H = I - tau * v * v' */ 00061 00062 /* where tau is a scalar and v is a vector. */ 00063 00064 /* If tau is zero, then H is taken to be the unit matrix. */ 00065 00066 /* Arguments */ 00067 /* ========= */ 00068 00069 /* UPLO (input) CHARACTER*1 */ 00070 /* Specifies whether the upper or lower triangular part of the */ 00071 /* symmetric matrix C is stored. */ 00072 /* = 'U': Upper triangle */ 00073 /* = 'L': Lower triangle */ 00074 00075 /* N (input) INTEGER */ 00076 /* The number of rows and columns of the matrix C. N >= 0. */ 00077 00078 /* V (input) DOUBLE PRECISION array, dimension */ 00079 /* (1 + (N-1)*abs(INCV)) */ 00080 /* The vector v as described above. */ 00081 00082 /* INCV (input) INTEGER */ 00083 /* The increment between successive elements of v. INCV must */ 00084 /* not be zero. */ 00085 00086 /* TAU (input) DOUBLE PRECISION */ 00087 /* The value tau as described above. */ 00088 00089 /* C (input/output) DOUBLE PRECISION array, dimension (LDC, N) */ 00090 /* On entry, the matrix C. */ 00091 /* On exit, C is overwritten by H * C * H'. */ 00092 00093 /* LDC (input) INTEGER */ 00094 /* The leading dimension of the array C. LDC >= max( 1, N ). */ 00095 00096 /* WORK (workspace) DOUBLE PRECISION array, dimension (N) */ 00097 00098 /* ===================================================================== */ 00099 00100 /* .. Parameters .. */ 00101 /* .. */ 00102 /* .. Local Scalars .. */ 00103 /* .. */ 00104 /* .. External Subroutines .. */ 00105 /* .. */ 00106 /* .. External Functions .. */ 00107 /* .. */ 00108 /* .. Executable Statements .. */ 00109 00110 /* Parameter adjustments */ 00111 --v; 00112 c_dim1 = *ldc; 00113 c_offset = 1 + c_dim1; 00114 c__ -= c_offset; 00115 --work; 00116 00117 /* Function Body */ 00118 if (*tau == 0.) { 00119 return 0; 00120 } 00121 00122 /* Form w:= C * v */ 00123 00124 dsymv_(uplo, n, &c_b2, &c__[c_offset], ldc, &v[1], incv, &c_b3, &work[1], 00125 &c__1); 00126 00127 alpha = *tau * -.5 * ddot_(n, &work[1], &c__1, &v[1], incv); 00128 daxpy_(n, &alpha, &v[1], incv, &work[1], &c__1); 00129 00130 /* C := C - v * w' - w * v' */ 00131 00132 d__1 = -(*tau); 00133 dsyr2_(uplo, n, &d__1, &v[1], incv, &work[1], &c__1, &c__[c_offset], ldc); 00134 00135 return 0; 00136 00137 /* End of DLARFY */ 00138 00139 } /* dlarfy_ */