00001 /* clatzm.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 complex c_b1 = {1.f,0.f}; 00019 static integer c__1 = 1; 00020 00021 /* Subroutine */ int clatzm_(char *side, integer *m, integer *n, complex *v, 00022 integer *incv, complex *tau, complex *c1, complex *c2, integer *ldc, 00023 complex *work) 00024 { 00025 /* System generated locals */ 00026 integer c1_dim1, c1_offset, c2_dim1, c2_offset, i__1; 00027 complex q__1; 00028 00029 /* Local variables */ 00030 extern /* Subroutine */ int cgerc_(integer *, integer *, complex *, 00031 complex *, integer *, complex *, integer *, complex *, integer *), 00032 cgemv_(char *, integer *, integer *, complex *, complex *, 00033 integer *, complex *, integer *, complex *, complex *, integer *); 00034 extern logical lsame_(char *, char *); 00035 extern /* Subroutine */ int cgeru_(integer *, integer *, complex *, 00036 complex *, integer *, complex *, integer *, complex *, integer *), 00037 ccopy_(integer *, complex *, integer *, complex *, integer *), 00038 caxpy_(integer *, complex *, complex *, integer *, complex *, 00039 integer *), clacgv_(integer *, complex *, integer *); 00040 00041 00042 /* -- LAPACK routine (version 3.2) -- */ 00043 /* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */ 00044 /* November 2006 */ 00045 00046 /* .. Scalar Arguments .. */ 00047 /* .. */ 00048 /* .. Array Arguments .. */ 00049 /* .. */ 00050 00051 /* Purpose */ 00052 /* ======= */ 00053 00054 /* This routine is deprecated and has been replaced by routine CUNMRZ. */ 00055 00056 /* CLATZM applies a Householder matrix generated by CTZRQF to a matrix. */ 00057 00058 /* Let P = I - tau*u*u', u = ( 1 ), */ 00059 /* ( v ) */ 00060 /* where v is an (m-1) vector if SIDE = 'L', or a (n-1) vector if */ 00061 /* SIDE = 'R'. */ 00062 00063 /* If SIDE equals 'L', let */ 00064 /* C = [ C1 ] 1 */ 00065 /* [ C2 ] m-1 */ 00066 /* n */ 00067 /* Then C is overwritten by P*C. */ 00068 00069 /* If SIDE equals 'R', let */ 00070 /* C = [ C1, C2 ] m */ 00071 /* 1 n-1 */ 00072 /* Then C is overwritten by C*P. */ 00073 00074 /* Arguments */ 00075 /* ========= */ 00076 00077 /* SIDE (input) CHARACTER*1 */ 00078 /* = 'L': form P * C */ 00079 /* = 'R': form C * P */ 00080 00081 /* M (input) INTEGER */ 00082 /* The number of rows of the matrix C. */ 00083 00084 /* N (input) INTEGER */ 00085 /* The number of columns of the matrix C. */ 00086 00087 /* V (input) COMPLEX array, dimension */ 00088 /* (1 + (M-1)*abs(INCV)) if SIDE = 'L' */ 00089 /* (1 + (N-1)*abs(INCV)) if SIDE = 'R' */ 00090 /* The vector v in the representation of P. V is not used */ 00091 /* if TAU = 0. */ 00092 00093 /* INCV (input) INTEGER */ 00094 /* The increment between elements of v. INCV <> 0 */ 00095 00096 /* TAU (input) COMPLEX */ 00097 /* The value tau in the representation of P. */ 00098 00099 /* C1 (input/output) COMPLEX array, dimension */ 00100 /* (LDC,N) if SIDE = 'L' */ 00101 /* (M,1) if SIDE = 'R' */ 00102 /* On entry, the n-vector C1 if SIDE = 'L', or the m-vector C1 */ 00103 /* if SIDE = 'R'. */ 00104 00105 /* On exit, the first row of P*C if SIDE = 'L', or the first */ 00106 /* column of C*P if SIDE = 'R'. */ 00107 00108 /* C2 (input/output) COMPLEX array, dimension */ 00109 /* (LDC, N) if SIDE = 'L' */ 00110 /* (LDC, N-1) if SIDE = 'R' */ 00111 /* On entry, the (m - 1) x n matrix C2 if SIDE = 'L', or the */ 00112 /* m x (n - 1) matrix C2 if SIDE = 'R'. */ 00113 00114 /* On exit, rows 2:m of P*C if SIDE = 'L', or columns 2:m of C*P */ 00115 /* if SIDE = 'R'. */ 00116 00117 /* LDC (input) INTEGER */ 00118 /* The leading dimension of the arrays C1 and C2. */ 00119 /* LDC >= max(1,M). */ 00120 00121 /* WORK (workspace) COMPLEX array, dimension */ 00122 /* (N) if SIDE = 'L' */ 00123 /* (M) if SIDE = 'R' */ 00124 00125 /* ===================================================================== */ 00126 00127 /* .. Parameters .. */ 00128 /* .. */ 00129 /* .. External Subroutines .. */ 00130 /* .. */ 00131 /* .. External Functions .. */ 00132 /* .. */ 00133 /* .. Intrinsic Functions .. */ 00134 /* .. */ 00135 /* .. Executable Statements .. */ 00136 00137 /* Parameter adjustments */ 00138 --v; 00139 c2_dim1 = *ldc; 00140 c2_offset = 1 + c2_dim1; 00141 c2 -= c2_offset; 00142 c1_dim1 = *ldc; 00143 c1_offset = 1 + c1_dim1; 00144 c1 -= c1_offset; 00145 --work; 00146 00147 /* Function Body */ 00148 if (min(*m,*n) == 0 || tau->r == 0.f && tau->i == 0.f) { 00149 return 0; 00150 } 00151 00152 if (lsame_(side, "L")) { 00153 00154 /* w := conjg( C1 + v' * C2 ) */ 00155 00156 ccopy_(n, &c1[c1_offset], ldc, &work[1], &c__1); 00157 clacgv_(n, &work[1], &c__1); 00158 i__1 = *m - 1; 00159 cgemv_("Conjugate transpose", &i__1, n, &c_b1, &c2[c2_offset], ldc, & 00160 v[1], incv, &c_b1, &work[1], &c__1); 00161 00162 /* [ C1 ] := [ C1 ] - tau* [ 1 ] * w' */ 00163 /* [ C2 ] [ C2 ] [ v ] */ 00164 00165 clacgv_(n, &work[1], &c__1); 00166 q__1.r = -tau->r, q__1.i = -tau->i; 00167 caxpy_(n, &q__1, &work[1], &c__1, &c1[c1_offset], ldc); 00168 i__1 = *m - 1; 00169 q__1.r = -tau->r, q__1.i = -tau->i; 00170 cgeru_(&i__1, n, &q__1, &v[1], incv, &work[1], &c__1, &c2[c2_offset], 00171 ldc); 00172 00173 } else if (lsame_(side, "R")) { 00174 00175 /* w := C1 + C2 * v */ 00176 00177 ccopy_(m, &c1[c1_offset], &c__1, &work[1], &c__1); 00178 i__1 = *n - 1; 00179 cgemv_("No transpose", m, &i__1, &c_b1, &c2[c2_offset], ldc, &v[1], 00180 incv, &c_b1, &work[1], &c__1); 00181 00182 /* [ C1, C2 ] := [ C1, C2 ] - tau* w * [ 1 , v'] */ 00183 00184 q__1.r = -tau->r, q__1.i = -tau->i; 00185 caxpy_(m, &q__1, &work[1], &c__1, &c1[c1_offset], &c__1); 00186 i__1 = *n - 1; 00187 q__1.r = -tau->r, q__1.i = -tau->i; 00188 cgerc_(m, &i__1, &q__1, &work[1], &c__1, &v[1], incv, &c2[c2_offset], 00189 ldc); 00190 } 00191 00192 return 0; 00193 00194 /* End of CLATZM */ 00195 00196 } /* clatzm_ */