void main() {
printf("\n Input data file name: "); scanf("%s", filename);
fp = fopen(filename, "r");
//read size of linear system
fscanf(fp,"%d", &m);
fscanf(fp,"%d", &n);
//allocate memory
vmblock = vminit();
A = (REAL **) vmalloc(vmblock, MATRIX, m+1, n+1);
U = (REAL **) vmalloc(vmblock, MATRIX, m+1, n+1);
V = (REAL **) vmalloc(vmblock, MATRIX, n+1, n+1);
B = (REAL *) vmalloc(vmblock, VEKTOR, m+1, 0);
W = (REAL *) vmalloc(vmblock, VEKTOR, n+1, 0);
X = (REAL *) vmalloc(vmblock, VEKTOR, n+1, 0);
// read matrix A
for (i=1; i<=m; i++)
for (j=1; j<=n; j++)
fscanf(fp,"%lf", &A[i][j]);
// read vector B
for (i=1; i<=m; i++)
fscanf(fp,"%lf", &B[i]);
fclose(fp);
fp = fopen("tsvbksb.lst", "w");
fprintf(fp,"\n M = %d\n", m);
fprintf(fp," N = %d\n", n);
WriteMat(" Matrix A:",A,m,n);
WriteVec(" Vector B:",B,m);
// Save A in U
for (i=1; i<=m; i++)
for (j=1; j<=n; j++)
U[i][j]=A[i][j];
//call singular value decomposition subroutine
SVDCMP(U,m,n,W,V);
WriteMat(" Matrix U:",U,m,n);
WriteVec(" Vector W:",W,n);
WriteMat(" Matrix V:",V,m,n);
//seek highest value of W's and set near-zero
//values to exactly zero (for near-singular cases)
WMAX=0.0;
for (j=1; j<=n; j++)
if (W[j] > WMAX) WMAX=W[j];
WMIN=WMAX*1e-6;
for (j=1; j<=n; j++)
if (W[j] < WMIN) W[j]=0.0;
//call solver for SVD matrix
SVBKSB(U,W,V,m,n,B,X);
//print solution
WriteVec(" Solution:",X,n);
// free memory
vmfree(vmblock);
fclose(fp);
printf("\n Results in file tsvbksb.lst.\n\n");
}
/*.BE*/
int spline /* nichtparametrischer kubischer Polynomspline .......*/
/*.BA*/
/*.IX{spline}*/
/*.BE*/
(
int m, /* Anzahl der Stuetzstellen ............*/
REAL x[], /* Stuetzstellen .......................*/
REAL y[], /* Stuetzwerte .........................*/
int marg_cond, /* Art der Randbedingung ...............*/
REAL marg_0, /* linke Randbedingung .................*/
REAL marg_n, /* rechte Randbedingung ................*/
int save, /* dynamische Hilfsfelder sichern? .....*/
REAL b[], /* Splinekoeffizienten von (x-x[i]) ....*/
REAL c[], /* Splinekoeffizienten von (x-x[i])^2 ..*/
REAL d[] /* Splinekoeffizienten von (x-x[i])^3 ..*/
) /* Fehlercode ..........................*/
/*.BA*/
/***********************************************************************
* zu den vorgegebenen Wertepaaren *
* (x[i], y[i]), i = 0(1)m-1 *
* die Koeffizienten eines nichtparametrischen interpolierenden *
* kubischen Polynomplines berechnen. *
.BE*)
* Die Art der Randbedingung wird durch den Parameter marg_cond *
* festgelegt. Die x[i] muessen streng monoton wachsen. *
* Bei wiederholten Aufrufen mit gleichen Stuetzstellen, aber verschie- *
* denen Stuetzwerten besteht die Moeglichkeit, die erneute Aufstellung *
* und Zerlegung der Matrix des Gleichungssystems zu vermeiden, indem *
* man den Parameter save von Null verschieden waehlt und so die Be- *
* schreibung der Zerlegungsmatrizen fuer den naechsten Aufruf rettet. *
* Wichtig: Damit der Speicher fuer die Hilfsfelder wieder frei wird *
* -------- und bei weiteren Aufrufen nicht mit falschen Zerlegungs- *
* matrizen gearbeitet wird, muss der letzte Aufruf einer *
* zusammengehoerigen Aufruffolge mit save = 0 statt mit *
* save = 1 ausgefuehrt werden! *
* *
* Eingabeparameter: *
* ================= *
* m: Anzahl der Stuetzstellen (mindestens 3) *
* x: [0..m-1]-Vektor mit den x-Koordinaten der Wertepaare *
* (wird nicht benoetigt, falls der vorige Aufruf mit *
* save != 0 stattfand) *
* y: [0..m-1]-Vektor mit den y-Koordinaten der Wertepaare *
* marg_cond: = 0: not-a-knot-Bedingung (=> marg_0, marg_n ohne *
* Bedeutung) *
* = 1: marg_0, marg_n sind 1. Ableitungen. *
* = 2: marg_0, marg_n sind 2. Ableitungen. *
* (Fuer marg_0 = marg_n = 0 erhaelt man einen *
* natuerlichen Spline.) *
* = 3: marg_0, marg_n sind 3. Ableitungen. *
* = 4: periodischer Spline (=> marg_0, marg_n ohne *
* Bedeutung) *
* marg_0: Randbedingung in x[0] *
* marg_n: Randbedingung in x[m-1] *
* save: Flagge, die anzeigt, ob der Speicher fuer die Hilfsfel- *
* der mit den Zerlegungsmatrizen fuer den naechsten Aufruf *
* aufbewahrt werden soll. Im Normalfall ist save = 0 zu *
* setzen. Wenn man mehrere Splinefunktionen mit denselben *
* Stuetzstellen x[i], aber anderen y[i] berechnen will *
* (z. B. bei parametrischen Splines), kann man ab dem *
* zweiten Aufruf Rechenzeit sparen, indem man beim ersten *
* Aufruf save = 1 setzt. Dann wird naemlich die neuerliche *
* Aufstellung und Zerlegung der Tridiagonalmatrix umgangen *
* (=> ca. 4*m Punktoperationen weniger). *
* Im letzten Aufruf muss man save = 0 waehlen, damit der *
* von den Hilfsfeldern beanspruchte dynamische Speicher *
* fuer andere Programmteile wieder verfuegbar wird. *
* *
* Ausgabeparameter: *
* ================= *
* b: \ [0..m-2]-Vektoren mit den Splinekoeffizienten nach dem Ansatz *
* c: > s(x) = a[i] + b[i] * (x - x[i]) + c[i] * (x - x[i]) ^ 2 *
* d: / + d[i] * (x - x[i]) ^ 3. *
* a entspricht y, *
* c hat (wie a) noch ein zusaetzliches Element c[m-1]. *
* *
* Funktionswert: *
* ============== *
* = 0: kein Fehler *
* = -i: Monotoniefehler: x[i-1] >= x[i] *
* = 1: falscher Wert fuer marg_cond *
* = 2: m < 3 *
* = 3: nicht genuegend Heapspeicher fuer die Hilfsfelder *
* = 4: marg_cond = 4: Eingabedaten nichtperiodisch *
* > 4: Fehler in trdiag() oder tzdiag() *
* Im Fehlerfall sind die Werte der Ausgabeparameter unbestimmt, und *
* der Speicher fuer die Hilfsfelder wird freigegeben. *
* *
* benutzte globale Namen: *
* ======================= *
* REAL, vminit, vmalloc, vmcomplete, vmfree, VEKTOR, trdiag, tzdiag, *
* NULL, ZERO, THREE, HALF, TWO *
.BA*)
***********************************************************************/
/*.BE*/
{
#define ciao(fehler) /* dafuer sorgen, dass vor dem Beenden */\
{ \
/* von spline() aufgeraeumt wird */\
vmfree(vmblock); /* Speicherplatz fuer die Hilfsfelder freigeben */\
vmblock = NULL; /* und dies auch anzeigen */\
return fehler; /* den Fehlercode an den Aufrufer weiterreichen */\
}
static
void *vmblock = NULL; /* Liste der dynamisch vereinbarten Vek- */
/* toren. Der Wert NULL zeigt an, dass */
/* noch keine Hilfsvektoren aus eventu- */
/* ellen frueheren Aufrufen existieren, */
/* dass dies also der erste Aufruf einer */
/* zusammengehoerenden Folge mit glei- */
/* chen Stuetzstellen ist. */
static
REAL *h, /* [0..m-2]-Vektor mit den Laengen der Stuetz- */
/* stellenintervalle */
*lower, /* [0..m-2]-Vektor mit der unteren Nebendiago- */
/* nale der Matrix, spaeter Zerlegungsmatrix */
/* von trdiag() bzw. tzdiag() */
*diag, /* [0..m-2]-Vektor mit der Hauptdiagonale der */
/* Matrix, spaeter Zerlegungsmatrix von */
/* trdiag() bzw. tzdiag() */
*upper, /* [0..m-2]-Vektor mit der oberen Nebendiago- */
/* nale der Matrix, spaeter Zerlegungsmatrix */
/* von trdiag() bzw. tzdiag() */
*lowrow, /* [0..m-4]-Vektor mit der unteren Zeile der */
/* Matrix, spaeter Zerlegungsmatrix von tzdiag() */
*ricol; /* [0..m-4]-Vektor mit der rechten Spalte der */
/* Matrix, spaeter Zerlegungsmatrix von tzdiag() */
int n, /* m - 1, Index der letzten Stuetzstelle */
fehler, /* Fehlercode von trdiag() bzw. tzdiag() */
i, /* Laufvariable */
erster_aufruf; /* Flagge, die anzeigt, dass gerade der */
/* erste Aufruf einer Folge stattfindet */
n = m - 1;
if (n < 2) /* zu kleinen Wert fuer n abfangen */
ciao(2);
if (marg_cond < 0 || marg_cond > 4) /* falsches marg_cond abfangen */
ciao(1);
if (marg_cond == 4) /* periodischer Spline? */
if (y[n] != y[0]) /* Periodizitaet ueberpruefen */
ciao(4);
/* 1. Aufruf: Speicher fuer die Hilfsfelder anfordern: 4 [0..n-1]- */
/* Vektoren (im periodischen Fall noch 2 [0..n-3]-Vektoren) */
if (vmblock == NULL) /* erster Aufruf einer Folge? */
{
erster_aufruf = 1;
#define MYALLOC(l) (REAL *)vmalloc(vmblock, VEKTOR, (l), 0)
vmblock = vminit(); /* Speicherblock initialisieren */
h = MYALLOC(n); /* Speicher fuer die */
lower = MYALLOC(n); /* Hilfsvektoren anfordern */
diag = MYALLOC(n);
upper = MYALLOC(n);
if (marg_cond == 4) /* periodischer Spline mit */
if (n > 2) /* genuegend Stuetzstellen? */
lowrow = MYALLOC(n - 2), /* auch die zusaetzlichen */
ricol = MYALLOC(n - 2); /* Vektoren versorgen */
#undef MYALLOC
}
else
erster_aufruf = 0;
if (! vmcomplete(vmblock)) /* Ging eine der Speicheranforderungen */
ciao(3); /* fuer den Block schief? */
if (erster_aufruf)
for (i = 0; i < n; i++) /* Schrittweiten berechnen und dabei die */
{ /* Stuetzstellen auf Monotonie pruefen */
h[i] = x[i + 1] - x[i]; /* Schrittweiten berechnen */
if (h[i] <= ZERO) /* Stuetzstellen nicht monoton wachsend? */
ciao(-(i + 1));
}
for (i = 0; i < n - 1; i++) /* das Gleichungssystem aufstellen */
{
/* rechte Seite */
c[i] = THREE * ((y[i + 2] - y[i + 1]) / h[i + 1]
- (y[i + 1] - y[i]) / h[i]);
if (erster_aufruf)
diag[i] = TWO * (h[i] + h[i + 1]), /* Hauptdiagonale */
lower[i + 1] = upper[i] = h[i + 1]; /* untere und obere */
} /* Nebendiagonale */
switch (marg_cond) /* je nach Randbedingung einige Koeffizienten */
{ /* des Gleichungssystems korrigieren */
case 0: /* not-a-knot-Bedingung? */
if (n == 2) /* nur drei Stuetzstellen? */
{ /* Da in diesem Fall das Gleichungssystem */
/* unterbestimmt ist, wird nur ein Polynom */
/* 2. Grades berechnet. */
c[0] /= THREE; /* rechte Seite */
if (erster_aufruf)
diag[0] *= HALF; /* auch die Matrix */
}
else /* mehr als drei Stuetzstellen? */
{
/* rechte */
c[0] *= h[1] / (h[0] + h[1]);
/* Seite */
c[n - 2] *= h[n - 2] / (h[n - 1] + h[n - 2]);
if (erster_aufruf)
diag[0] -= h[0], /* auch die */
diag[n - 2] -= h[n - 1], /* Matrix */
upper[0] -= h[0],
lower[n - 2] -= h[n - 1];
}
break;
case 1: /* erste Randableitungen vorgegeben? */
c[0] -= (REAL)1.5 * ((y[1] - y[0]) / h[0] - marg_0);
c[n - 2] -= (REAL)1.5 * (marg_n - (y[n] - y[n - 1]) / h[n - 1]);
if (erster_aufruf)
diag[0] -= HALF * h[0], /* auch die Matrix */
diag[n - 2] -= HALF * h[n - 1]; /* vorbesetzen */
break;
case 2: /* zweite Randableitungen vorgegeben? */
c[0] -= h[0] * HALF * marg_0;
c[n - 2] -= h[n - 1] * HALF * marg_n;
break;
case 3: /* dritte Randableitungen vorgegeben? */
c[0] += HALF * marg_0 * h[0] * h[0];
c[n - 2] -= HALF * marg_n * h[n - 1] * h[n - 1];
if (erster_aufruf)
diag[0] += h[0], /* auch die Matrix */
diag[n - 2] += h[n - 1]; /* vorbesetzen */
break;
case 4: /* periodischer Spline? */
c[n - 1] = THREE * ((y[1] - y[0]) / h[0] -
(y[n] - y[n - 1]) / h[n - 1]);
if (erster_aufruf)
if (n > 2)
diag[n - 1] = TWO * (h[0] + h[n - 1]),
ricol[0] = lowrow[0] = h[0];
}
switch (n) /* das Gleichungssystem loesen und damit */
{ /* die Splinekoeffizienten c[i] berechnen */
case 2: /* nur drei Stuetzstellen => */
/* => Loesung direkt berechnen */
if (marg_cond == 4) /* periodischer Spline? */
c[1] = THREE * (y[0] - y[1]) / (x[2] - x[1]) / (x[1] - x[0]),
c[2] = - c[1];
else
c[1] = c[0] / diag[0];
break;
default: /* mehr als drei Stuetzstellen? */
if (marg_cond == 4) /* periodischer Spline? */
fehler = tzdiag(n, lower, diag, upper, lowrow,
ricol, c, !erster_aufruf);
else /* nichtperiodischer Spline? */
fehler = trdiag(n - 1, lower, diag, upper, c, !erster_aufruf);
if (fehler != 0) /* Fehler in tzdiag() oder in trdiag()? */
ciao(fehler + 4);
for (i = n; i != 0; i--) /* die Elemente des Loesungsvektors */
c[i] = c[i - 1]; /* eine Position nach rechts schieben */
}
switch (marg_cond) /* in Abhaengigkeit von der Randbedingung den */
{ /* ersten und letzten Wert von c korrigieren */
case 0: /* not-a-knot-Bedingung? */
if (n == 2) /* nur drei Stuetzstellen? */
c[0] = c[2] = c[1];
else /* mehr als drei Stuetzstellen? */
c[0] = c[1] + h[0] * (c[1] - c[2]) / h[1],
c[n] = c[n - 1] + h[n - 1] *
(c[n - 1] - c[n - 2]) / h[n - 2];
break;
case 1: /* erste Randableitungen vorgegeben? */
c[0] = (REAL)1.5 * ((y[1] - y[0]) / h[0] - marg_0);
c[0] = (c[0] - c[1] * h[0] * HALF) / h[0];
c[n] = (REAL)-1.5 * ((y[n] - y[n - 1]) / h[n - 1] - marg_n);
c[n] = (c[n] - c[n - 1] * h[n - 1] * HALF) / h[n - 1];
break;
case 2: /* zweite Randableitungen vorgegeben? */
c[0] = marg_0 * HALF;
c[n] = marg_n * HALF;
break;
case 3: /* dritte Randableitungen vorgegeben? */
c[0] = c[1] - marg_0 * HALF * h[0];
c[n] = c[n - 1] + marg_n * HALF * h[n - 1];
break;
case 4: /* periodischer Spline? */
c[0] = c[n];
}
for (i = 0; i < n; i++) /* die restlichen */
b[i] = (y[i + 1] - y[i]) / h[i] - h[i] * /* Splinekoeffizienten */
(c[i + 1] + TWO * c[i]) / THREE, /* b[i] und d[i] */
d[i] = (c[i + 1] - c[i]) / (THREE * h[i]);/* berechnen */
if (!save) /* Hilfsfelder nicht aufbewahren */
ciao(0); /* (letzter Aufruf einer Folge)? */
return 0;
#undef ciao
}