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