|
GRASS Programmer's Manual
6.5.svn(2012)-r51648
|
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 }