|
GRASS Programmer's Manual
6.5.svn(2012)-r51648
|
00001 /* sv2uv.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 sv2uv(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, t, h, r, 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, p = a; i < n; ++i, --mm, 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 = 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) = w[j++] * t; 00046 } 00047 *p = sv; 00048 d[i] = -h; 00049 } 00050 if (mm == 1) 00051 d[i] = *p; 00052 } 00053 ldumat(a, u, m, n); 00054 for (i = 0, q = a; i < n; ++i) { 00055 for (j = 0; j < n; ++j, ++q) { 00056 if (j < i) 00057 *q = 0.; 00058 else if (j == i) 00059 *q = d[i]; 00060 } 00061 } 00062 for (i = 0, mm = n, nm = n - 1, p = a; i < n; ++i, --mm, --nm, p += n + 1) { 00063 if (i && mm > 1) { 00064 sv = h = 0.; 00065 for (j = 0, q = p, s = 0.; j < mm; ++j, q += n) { 00066 w[j] = *q; 00067 s += *q * *q; 00068 } 00069 if (s > 0.) { 00070 h = sqrt(s); 00071 if (*p < 0.) 00072 h = -h; 00073 s += *p * h; 00074 s = 1. / s; 00075 t = 1. / (w[0] += h); 00076 sv = 1. + fabs(*p / h); 00077 for (k = 1, ms = n - i; k < ms; ++k) { 00078 for (j = 0, q = p + k, r = 0.; j < mm; q += n) 00079 r += w[j++] * *q; 00080 for (j = 0, q = p + k, r *= s; j < mm; q += n) 00081 *q -= r * w[j++]; 00082 } 00083 for (k = 0, p1 = u + i; k < m; ++k, p1 += m) { 00084 for (j = 0, q = p1, r = 0.; j < mm;) 00085 r += w[j++] * *q++; 00086 for (j = 0, q = p1, r *= s; j < mm;) 00087 *q++ -= r * w[j++]; 00088 } 00089 } 00090 *p = sv; 00091 d[i] = -h; 00092 } 00093 if (mm == 1) 00094 d[i] = *p; 00095 p1 = p + 1; 00096 if (nm > 1) { 00097 sv = h = 0.; 00098 for (j = 0, q = p1, s = 0.; j < nm; ++j, ++q) 00099 s += *q * *q; 00100 if (s > 0.) { 00101 h = sqrt(s); 00102 if (*p1 < 0.) 00103 h = -h; 00104 sv = 1. + fabs(*p1 / h); 00105 s += *p1 * h; 00106 s = 1. / s; 00107 t = 1. / (*p1 += h); 00108 for (k = n, ms = n * (n - i); k < ms; k += n) { 00109 for (j = 0, q = p1, pp = p1 + k, r = 0.; j < nm; ++j) 00110 r += *q++ * *pp++; 00111 for (j = 0, q = p1, pp = p1 + k, r *= s; j < nm; ++j) 00112 *pp++ -= r * *q++; 00113 } 00114 for (j = 1, q = p1 + 1; j < nm; ++j) 00115 *q++ *= t; 00116 } 00117 *p1 = sv; 00118 e[i] = -h; 00119 } 00120 if (nm == 1) 00121 e[i] = *p1; 00122 } 00123 ldvmat(a, v, n); 00124 qrbdv(d, e, u, m, v, n); 00125 for (i = 0; i < n; ++i) { 00126 if (d[i] < 0.) { 00127 d[i] = -d[i]; 00128 for (j = 0, p = v + i; j < n; ++j, p += n) 00129 *p = -*p; 00130 } 00131 } 00132 free(w); 00133 return 0; 00134 }