aboutsummaryrefslogtreecommitdiff
path: root/pkg/proto/interp.x
blob: 026c1c66711d4c6bbc98e80ed1c97459c15b2e1e (plain) (blame)
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
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
include	<fset.h>

define	SZ_TABLE	4096
define	LINEAR		1
define	SPLINE		2


# T_INTERP -- Interpolate for values in a table
#
# A table of x,y pairs contained in a file is used to
# find interpolated values, y, for any other given independent
# variable, x. Extrapolation is performed if necessary.
#
# A series of values may be generated to generate a fine grid
# through a coarse sampling for purposes of plotting. This is
# done by setting the hidden parameter curve_gen to yes.
# The starting point, ending point, and sampling interval
# are also needed in this case (x1, x2, dx).
#
# If only a small number of values are needed to be interpolated
# from the table, the user may enter a number of x's from either
# a file or STDIN.


procedure t_interp()

double	x, y, x1, x2, dx
pointer	xtab, ytab
int	npts, ierr, tbsize
int	filelist, tbl, in, imode
char	fname[SZ_FNAME], tbl_file[SZ_FNAME], mode[SZ_FNAME]
bool	gen

int	clpopni(), clgfil(), open(), fscan(), strncmp(), nscan()
real	clgetr()
bool	clgetb()

begin
	# Initialize interpolator
	call intrp0 (1)

	# File containing x,y pairs in a table
	call clgstr ("tbl_file", tbl_file, SZ_FNAME)

	# Open table file and read as many points as possible
	tbl = open (tbl_file, READ_ONLY, TEXT_FILE)

	npts = 0

	# Allocate the initial arrays.
	call calloc (xtab, SZ_TABLE, TY_DOUBLE)
	call calloc (ytab, SZ_TABLE, TY_DOUBLE)
	tbsize = SZ_TABLE

	while (fscan(tbl) != EOF) {
	    npts = npts + 1
	    if (npts > tbsize) {
		call realloc (xtab, (tbsize+SZ_TABLE), TY_DOUBLE)
		call realloc (ytab, (tbsize+SZ_TABLE), TY_DOUBLE)
		tbsize = tbsize + SZ_TABLE
	    }
	    call gargd (Memd[xtab+npts-1])
	    call gargd (Memd[ytab+npts-1])
	    if (nscan() < 2) {
		call eprintf ("Error reading x,y pairs\n")
		npts = npts - 1
	    }
	}

	call close (tbl)

	if (npts < 1)
	    call error (1, "Table has no entries.")

	# Linear or spline interpolator?
	call clgstr ("int_mode", mode, SZ_FNAME)
	if (strncmp (mode, "linear", 6) == 0)
	    imode = LINEAR
	else
	    imode = SPLINE

	# Generate a curve?
	gen = clgetb ("curve_gen")
	if (gen) {
	    x1 = double(clgetr ("x1"))
	    x2 = double(clgetr ("x2"))
	    dx = double(clgetr ("dx"))

	    # Verify that dx will not cause an infinite loop
	    if (dx == 0.0 || dx * (x2-x1) < 0.0)
		call error (1, "Interval paramater dx implies infinite loop.")

	    for (x=x1; x <= x2; x = x+dx) {
		call intrp (1, Memd[xtab], Memd[ytab], npts, x, y, ierr)
		call printf ("%12.5g  %12.5g\n")
		    call pargd (x)
		    call pargd (y)
	    }

	# No, just one point at a time
	} else {

	    # Open input list
	    filelist = clpopni ("input")

	    while (clgfil (filelist, fname, SZ_FNAME) != EOF) {
		call fseti (STDOUT, F_FLUSHNL, YES)
		in = open (fname, READ_ONLY, TEXT_FILE)

		# Process input requests
		while (fscan(in) != EOF) {
		    call gargd (x)
		    if (imode == LINEAR)
			call lintrp (1, Memd[xtab], Memd[ytab], npts, x,y, ierr)
		    else
			call intrp  (1, Memd[xtab], Memd[ytab], npts, x,y, ierr)

		    call printf ("%12.5g  %12.5g\n")
			call pargd (x)
			call pargd (y)
		}

		call close (in)
	    }

	    call clpcls (filelist)
	}

	# Free the pointers.
	call mfree (xtab, TY_DOUBLE)
	call mfree (ytab, TY_DOUBLE)
end