|
GRASS Programmer's Manual
6.5.svn(2012)-r51648
|
00001 /* svduv.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 int svduv(double *d, double *a, double *u, int m, double *v, int n) 00011 { 00012 double *p, *p1, *q, *pp, *w, *e; 00013 00014 double s, h, r, t, sv; 00015 00016 int i, j, k, mm, nm, ms; 00017 00018 if (m < n) 00019 return -1; 00020 w = (double *)calloc(m + n, sizeof(double)); 00021 e = w + m; 00022 for (i = 0, mm = m, nm = n - 1, p = a; i < n; ++i, --mm, --nm, p += n + 1) { 00023 if (mm > 1) { 00024 sv = h = 0.; 00025 for (j = 0, q = p, s = 0.; j < mm; ++j, q += n) { 00026 w[j] = *q; 00027 s += *q * *q; 00028 } 00029 if (s > 0.) { 00030 h = sqrt(s); 00031 if (*p < 0.) 00032 h = -h; 00033 s += *p * h; 00034 s = 1. / s; 00035 t = 1. / (w[0] += h); 00036 sv = 1. + fabs(*p / h); 00037 for (k = 1, ms = n - i; k < ms; ++k) { 00038 for (j = 0, q = p + k, r = 0.; j < mm; q += n) 00039 r += w[j++] * *q; 00040 r *= s; 00041 for (j = 0, q = p + k; j < mm; q += n) 00042 *q -= r * w[j++]; 00043 } 00044 for (j = 1, q = p; j < mm;) 00045 *(q += n) = t * w[j++]; 00046 } 00047 *p = sv; 00048 d[i] = -h; 00049 } 00050 if (mm == 1) 00051 d[i] = *p; 00052 p1 = p + 1; 00053 sv = h = 0.; 00054 if (nm > 1) { 00055 for (j = 0, q = p1, s = 0.; j < nm; ++j, ++q) 00056 s += *q * *q; 00057 if (s > 0.) { 00058 h = sqrt(s); 00059 if (*p1 < 0.) 00060 h = -h; 00061 sv = 1. + fabs(*p1 / h); 00062 s += *p1 * h; 00063 s = 1. / s; 00064 t = 1. / (*p1 += h); 00065 for (k = n, ms = n * (m - i); k < ms; k += n) { 00066 for (j = 0, q = p1, pp = p1 + k, r = 0.; j < nm; ++j) 00067 r += *q++ * *pp++; 00068 r *= s; 00069 for (j = 0, q = p1, pp = p1 + k; j < nm; ++j) 00070 *pp++ -= r * *q++; 00071 } 00072 for (j = 1, q = p1 + 1; j < nm; ++j) 00073 *q++ *= t; 00074 } 00075 *p1 = sv; 00076 e[i] = -h; 00077 } 00078 if (nm == 1) 00079 e[i] = *p1; 00080 } 00081 ldvmat(a, v, n); 00082 ldumat(a, u, m, n); 00083 qrbdv(d, e, u, m, v, n); 00084 for (i = 0; i < n; ++i) { 00085 if (d[i] < 0.) { 00086 d[i] = -d[i]; 00087 for (j = 0, p = v + i; j < n; ++j, p += n) 00088 *p = -*p; 00089 } 00090 } 00091 free(w); 00092 return 0; 00093 }