|
GRASS Programmer's Manual
6.5.svn(2012)-r51648
|
00001 /* housev.c CCMATH mathematics library source code. 00002 * 00003 * Copyright (C) 2000 Daniel A. Atkinson All rights reserved. 00004 * This code may be redistributed under the terms of the GNU library 00005 * public license (LGPL). ( See the lgpl.license file for details.) 00006 * ------------------------------------------------------------------------ 00007 */ 00008 #include <stdlib.h> 00009 #include "ccmath.h" 00010 void housev(double *a, double *d, double *dp, int n) 00011 { 00012 double sc, x, y, h; 00013 00014 int i, j, k, m, e; 00015 00016 double *qw, *qs, *pc, *p; 00017 00018 qs = (double *)calloc(n, sizeof(double)); 00019 for (j = 0, pc = a; j < n - 2; ++j, pc += n + 1) { 00020 m = n - j - 1; 00021 for (i = 1, sc = 0.; i <= m; ++i) 00022 sc += pc[i] * pc[i]; 00023 if (sc > 0.) { 00024 sc = sqrt(sc); 00025 if ((x = *(pc + 1)) < 0.) { 00026 y = x - sc; 00027 h = 1. / sqrt(-2. * sc * y); 00028 } 00029 else { 00030 y = x + sc; 00031 h = 1. / sqrt(2. * sc * y); 00032 sc = -sc; 00033 } 00034 for (i = 0, qw = pc + 1; i < m; ++i) { 00035 qs[i] = 0.; 00036 if (i) 00037 qw[i] *= h; 00038 else 00039 qw[i] = y * h; 00040 } 00041 for (i = 0, e = j + 2, p = pc + n + 1, h = 0.; i < m; 00042 ++i, p += e++) { 00043 qs[i] += (y = qw[i]) * *p++; 00044 for (k = i + 1; k < m; ++k) { 00045 qs[i] += qw[k] * *p; 00046 qs[k] += y * *p++; 00047 } 00048 h += y * qs[i]; 00049 } 00050 for (i = 0; i < m; ++i) { 00051 qs[i] -= h * qw[i]; 00052 qs[i] += qs[i]; 00053 } 00054 for (i = 0, e = j + 2, p = pc + n + 1; i < m; ++i, p += e++) { 00055 for (k = i; k < m; ++k) 00056 *p++ -= qw[i] * qs[k] + qs[i] * qw[k]; 00057 } 00058 } 00059 d[j] = *pc; 00060 dp[j] = sc; 00061 } 00062 d[j] = *pc; 00063 dp[j] = *(pc + 1); 00064 d[j + 1] = *(pc += n + 1); 00065 free(qs); 00066 for (i = 0, m = n + n, p = pc; i < m; ++i) 00067 *p-- = 0.; 00068 *pc = 1.; 00069 *(pc -= n + 1) = 1.; 00070 qw = pc - n; 00071 for (m = 2; m < n; ++m, qw -= n + 1) { 00072 for (j = 0, p = pc, *pc = 1.; j < m; ++j, p += n) { 00073 for (i = 0, qs = p, h = 0.; i < m;) 00074 h += qw[i++] * *qs++; 00075 for (i = 0, qs = p, h += h; i < m;) 00076 *qs++ -= h * qw[i++]; 00077 } 00078 for (i = 0, p = qw + m; i < n; ++i) 00079 *(--p) = 0.; 00080 *(pc -= n + 1) = 1.; 00081 } 00082 }