|
GRASS Programmer's Manual
6.5.svn(2012)-r51648
|
00001 /* cminv.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 cminv(Cpx * a, int n) 00011 { 00012 int i, j, k, m, lc, *le; 00013 00014 Cpx *ps, *p, *q, *pa, *pd; 00015 00016 Cpx z, h, *q0; 00017 00018 double s, t, tq = 0., zr = 1.e-15; 00019 00020 le = (int *)calloc(n, sizeof(int)); 00021 q0 = (Cpx *) calloc(n, sizeof(Cpx)); 00022 pa = pd = a; 00023 for (j = 0; j < n; ++j, ++pa, pd += n + 1) { 00024 if (j > 0) { 00025 for (i = 0, p = pa, q = q0; i < n; ++i, p += n) 00026 *q++ = *p; 00027 for (i = 1; i < n; ++i) { 00028 lc = i < j ? i : j; 00029 z.re = z.im = 0.; 00030 for (k = 0, p = pa + i * n - j, q = q0; k < lc; ++k, ++q, ++p) { 00031 z.re += p->re * q->re - p->im * q->im; 00032 z.im += p->im * q->re + p->re * q->im; 00033 } 00034 q0[i].re -= z.re; 00035 q0[i].im -= z.im; 00036 } 00037 for (i = 0, p = pa, q = q0; i < n; ++i, p += n) 00038 *p = *q++; 00039 } 00040 s = fabs(pd->re) + fabs(pd->im); 00041 lc = j; 00042 for (k = j + 1, ps = pd; k < n; ++k) { 00043 ps += n; 00044 if ((t = fabs(ps->re) + fabs(ps->im)) > s) { 00045 s = t; 00046 lc = k; 00047 } 00048 } 00049 tq = tq > s ? tq : s; 00050 if (s < zr * tq) { 00051 free(le - j); 00052 free(q0); 00053 return -1; 00054 } 00055 *le++ = lc; 00056 if (lc != j) { 00057 p = a + n * j; 00058 q = a + n * lc; 00059 for (k = 0; k < n; ++k, ++p, ++q) { 00060 h = *p; 00061 *p = *q; 00062 *q = h; 00063 } 00064 } 00065 t = pd->re * pd->re + pd->im * pd->im; 00066 h.re = pd->re / t; 00067 h.im = -(pd->im) / t; 00068 for (k = j + 1, ps = pd + n; k < n; ++k, ps += n) { 00069 z.re = ps->re * h.re - ps->im * h.im; 00070 z.im = ps->im * h.re + ps->re * h.im; 00071 *ps = z; 00072 } 00073 *pd = h; 00074 } 00075 for (j = 1, pd = ps = a; j < n; ++j) { 00076 for (k = 0, pd += n + 1, q = ++ps; k < j; ++k, q += n) { 00077 z.re = q->re * pd->re - q->im * pd->im; 00078 z.im = q->im * pd->re + q->re * pd->im; 00079 *q = z; 00080 } 00081 } 00082 for (j = 1, pa = a; j < n; ++j) { 00083 ++pa; 00084 for (i = 0, q = q0, p = pa; i < j; ++i, p += n) 00085 *q++ = *p; 00086 for (k = 0; k < j; ++k) { 00087 h.re = h.im = 0.; 00088 for (i = k, p = pa + k * n + k - j, q = q0 + k; i < j; ++i) { 00089 h.re -= p->re * q->re - p->im * q->im; 00090 h.im -= p->im * q->re + p->re * q->im; 00091 ++p; 00092 ++q; 00093 } 00094 q0[k] = h; 00095 } 00096 for (i = 0, q = q0, p = pa; i < j; ++i, p += n) 00097 *p = *q++; 00098 } 00099 for (j = n - 2, pd = pa = a + n * n - 1; j >= 0; --j) { 00100 --pa; 00101 pd -= n + 1; 00102 for (i = 0, m = n - j - 1, q = q0, p = pd + n; i < m; ++i, p += n) 00103 *q++ = *p; 00104 for (k = n - 1, ps = pa; k > j; --k, ps -= n) { 00105 z.re = -ps->re; 00106 z.im = -ps->im; 00107 for (i = j + 1, p = ps + 1, q = q0; i < k; ++i, ++p, ++q) { 00108 z.re -= p->re * q->re - p->im * q->im; 00109 z.im -= p->im * q->re + p->re * q->im; 00110 } 00111 q0[--m] = z; 00112 } 00113 for (i = 0, m = n - j - 1, q = q0, p = pd + n; i < m; ++i, p += n) 00114 *p = *q++; 00115 } 00116 for (k = 0, pa = a; k < n - 1; ++k, ++pa) { 00117 for (i = 0, q = q0, p = pa; i < n; ++i, p += n) 00118 *q++ = *p; 00119 for (j = 0, ps = a; j < n; ++j, ps += n) { 00120 if (j > k) { 00121 h.re = h.im = 0.; 00122 p = ps + j; 00123 i = j; 00124 } 00125 else { 00126 h = q0[j]; 00127 p = ps + k + 1; 00128 i = k + 1; 00129 } 00130 for (; i < n; ++i, ++p) { 00131 h.re += p->re * q0[i].re - p->im * q0[i].im; 00132 h.im += p->im * q0[i].re + p->re * q0[i].im; 00133 } 00134 q0[j] = h; 00135 } 00136 for (i = 0, q = q0, p = pa; i < n; ++i, p += n) 00137 *p = *q++; 00138 } 00139 for (j = n - 2, le--; j >= 0; --j) { 00140 for (k = 0, p = a + j, q = a + *(--le); k < n; ++k, p += n, q += n) { 00141 h = *p; 00142 *p = *q; 00143 *q = h; 00144 } 00145 } 00146 free(le); 00147 free(q0); 00148 return 0; 00149 }