1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
|
# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
include <math/curfit.h>
$if (datatype == r)
include "curfitdef.h"
$else
include "dcurfitdef.h"
$endif
# Interface Routine for external user functions
# CV_B1USER - Evaluate basis functions at a single point with
# external user routine.
procedure $tcv_b1user (cv, x)
pointer cv
PIXEL x
begin
if (CV_USERFNC(cv) == NULL)
call error (0, "CV_USERFNC: Pointer not set")
call zcall5 (CV_USERFNC(cv), x, CV_ORDER(cv), CV_MAXMIN(cv),
CV_RANGE(cv), XBASIS(CV_XBASIS(cv)))
end
# CV_BUSER - Evaluate basis functions at a set of points with
# external user routine.
procedure $tcv_buser (cv, x, npts)
pointer cv
PIXEL x[ARB]
int npts
int i, j
begin
do i = 1, npts {
call $tcv_b1user (cv, x[i])
do j = 1, CV_ORDER(cv)
BASIS(CV_BASIS(cv)-1+i + npts*(j-1)) =
XBASIS(CV_XBASIS(cv)-1+j)
}
end
# CV_EVUSER - Evaluate user function at a set of points using present
# coefficient values
procedure $tcv_evuser (cv, x, yfit, npts)
pointer cv
PIXEL x[ARB], yfit[ARB]
int npts
int i
PIXEL adot$t
begin
do i = 1, npts {
call $tcv_b1user (cv, x[i])
yfit[i] = adot$t ( XBASIS(CV_XBASIS(cv)), COEFF(CV_COEFF(cv)),
CV_ORDER(cv))
}
end
# CVUSERFNC - Set external user function.
$if (datatype == r)
procedure cvuserfnc (cv, fnc)
$else
procedure dcvuserfnc (cv, fnc)
$endif
pointer cv
extern fnc()
int locpr()
begin
CV_USERFNC(cv) = locpr (fnc)
end
|
