GRASS Programmer's Manual  6.5.svn(2012)-r51648
 All Data Structures Namespaces Files Functions Variables Typedefs Enumerations Enumerator Defines
qreval.c
Go to the documentation of this file.
00001 /*  qreval.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 "ccmath.h"
00009 int qreval(double *ev, double *dp, int n)
00010 {
00011     double cc, sc = 0.0, d, x, y, h, tzr = 1.e-15;
00012 
00013     int j, k, m, mqr = 8 * n;
00014 
00015     for (j = 0, m = n - 1;; ++j) {
00016         while (1) {
00017             if (m < 1)
00018                 return 0;
00019             k = m - 1;
00020             if (fabs(dp[k]) <= fabs(ev[m]) * tzr)
00021                 --m;
00022             else {
00023                 x = (ev[k] - ev[m]) / 2.;
00024                 h = sqrt(x * x + dp[k] * dp[k]);
00025                 if (m > 1 && fabs(dp[m - 2]) > fabs(ev[k]) * tzr)
00026                     break;
00027                 x += ev[m];
00028                 ev[m--] = x - h;
00029                 ev[m--] = x + h;
00030             }
00031         }
00032         if (j > mqr)
00033             return -1;
00034         if (x > 0.)
00035             d = ev[m] + x - h;
00036         else
00037             d = ev[m] + x + h;
00038         cc = 1.;
00039         y = 0.;
00040         ev[0] -= d;
00041         for (k = 0; k < m; ++k) {
00042             x = ev[k] * cc - y;
00043             y = dp[k] * cc;
00044             h = sqrt(x * x + dp[k] * dp[k]);
00045             if (k > 0)
00046                 dp[k - 1] = sc * h;
00047             ev[k] = cc * h;
00048             cc = x / h;
00049             sc = dp[k] / h;
00050             ev[k + 1] -= d;
00051             y *= sc;
00052             ev[k] = cc * (ev[k] + y) + ev[k + 1] * sc * sc + d;
00053         }
00054         ev[k] = ev[k] * cc - y;
00055         dp[k - 1] = ev[k] * sc;
00056         ev[k] = ev[k] * cc + d;
00057     }
00058     return 0;
00059 }