GRASS Programmer's Manual  6.5.svn(2012)-r51648
 All Data Structures Namespaces Files Functions Variables Typedefs Enumerations Enumerator Defines
sv2uv.c
Go to the documentation of this file.
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 }