aboutsummaryrefslogtreecommitdiff
path: root/noao/onedspec/sensfunc/sffit.x
diff options
context:
space:
mode:
authorJoseph Hunkeler <jhunkeler@gmail.com>2015-07-08 20:46:52 -0400
committerJoseph Hunkeler <jhunkeler@gmail.com>2015-07-08 20:46:52 -0400
commitfa080de7afc95aa1c19a6e6fc0e0708ced2eadc4 (patch)
treebdda434976bc09c864f2e4fa6f16ba1952b1e555 /noao/onedspec/sensfunc/sffit.x
downloadiraf-linux-fa080de7afc95aa1c19a6e6fc0e0708ced2eadc4.tar.gz
Initial commit
Diffstat (limited to 'noao/onedspec/sensfunc/sffit.x')
-rw-r--r--noao/onedspec/sensfunc/sffit.x78
1 files changed, 78 insertions, 0 deletions
diff --git a/noao/onedspec/sensfunc/sffit.x b/noao/onedspec/sensfunc/sffit.x
new file mode 100644
index 00000000..3be306ad
--- /dev/null
+++ b/noao/onedspec/sensfunc/sffit.x
@@ -0,0 +1,78 @@
+include <math/curfit.h>
+include "sensfunc.h"
+
+define FUNCTIONS "|chebyshev|legendre|spline3|spline1|"
+
+procedure sf_fit (stds, nstds, cv, function, order, xmin, xmax)
+
+pointer stds[nstds]
+int nstds
+pointer cv
+char function[ARB]
+int order
+real xmin
+real xmax
+
+int i, n, func, ord, strdic()
+pointer x, y, w
+
+int functions[4]
+data functions/CHEBYSHEV,LEGENDRE,SPLINE3,SPLINE1/
+
+begin
+ func = strdic (function, function, SZ_FNAME, FUNCTIONS)
+ func = functions[max (1, func)]
+ ord = order
+
+ while (ord > 0) {
+ call cvfree (cv)
+ call cvinit (cv, func, ord, xmin, xmax)
+ do i = 1, nstds {
+ if (STD_FLAG(stds[i]) == SF_INCLUDE) {
+ n = STD_NWAVES(stds[i])
+ x = STD_WAVES(stds[i])
+ y = STD_SENS(stds[i])
+ w = STD_WTS(stds[i])
+ call cvacpts (cv, Memr[x], Memr[y], Memr[w], n, WTS_USER)
+ }
+ }
+ call cvsolve (cv, i)
+ if (i == OK)
+ break
+
+ switch (func) {
+ case CHEBYSHEV, LEGENDRE:
+ ord = ord - 1
+ case SPLINE3:
+ ord = ord - 1
+ if (ord == 0) {
+ func = CHEBYSHEV
+ ord = 2
+ }
+ case SPLINE1:
+ ord = ord - 1
+ if (ord == 0) {
+ func = CHEBYSHEV
+ ord = 1
+ }
+ }
+ }
+
+ switch (i) {
+ case SINGULAR:
+ call error (0, "Singular solution")
+ case NO_DEG_FREEDOM:
+ call error (0, "No degrees of freedom")
+ }
+
+ # Set fitted values
+ do i = 1, nstds
+ if (STD_FLAG(stds[i]) != SF_EXCLUDE) {
+ n = STD_NWAVES(stds[i])
+ if (n < 1)
+ next
+ x = STD_WAVES(stds[i])
+ y = STD_FIT(stds[i])
+ call cvvector (cv, Memr[x], Memr[y], n)
+ }
+end