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
|
include <error.h>
include <tbset.h>
# tugcol -- get input X values
# Get input independent variable column and check it to make
# sure it is either monotonically increasing or decreasing.
#
# Phil Hodge, 18-Apr-1988 Subroutine created
# Phil Hodge, 30-Jan-1992 Check independent variables more carefully.
# Phil Hodge, 27-Apr-2000 Move most of this routine to tudcol;
# rewrite to allow either array or scalar column.
procedure tugcol (itp, iv_icp, row, xin, xnelem, padvalue, array)
pointer itp # i: pointer to input table descriptor
pointer iv_icp # i: ptr to descr for input indep var column
int row # i: row number, if input column contains arrays
double xin[ARB] # o: input independent variable values
int xnelem # o: actual number of elements in xin array
double padvalue # i: ignore this value at end of xin array
bool array # i: true if input column contains arrays
#--
pointer sp
pointer temp # scratch for checking indep var for duplicates
int nelem # array size
int nvals # number of elements actually gotten
int nrows # number of rows in input table
int i # loop index
int op # index in temp
int tbcigi(), tbpsta(), tbagtd()
string NOT_MONOTONIC "input independent variable is not monotonic"
begin
if (array) {
nelem = tbcigi (iv_icp, TBL_COL_LENDATA)
nvals = tbagtd (itp, iv_icp, row, xin, 1, nelem)
if (nvals != nelem) {
call eprintf (
"Not all input independent variable data were gotten from row %d\n")
call pargi (row)
call error (1, "")
}
xnelem = nvals
} else {
nrows = tbpsta (itp, TBL_NROWS)
do i = 1, nrows
call tbegtd (itp, iv_icp, i, xin[i])
xnelem = nrows
}
# Trim trailing INDEF and pad values by reducing xnelem.
call tu_trim (xin, xnelem, padvalue)
call smark (sp)
call salloc (temp, xnelem, TY_DOUBLE)
# Copy the independent variable data to scratch, skipping embedded
# INDEF values.
op = 0
do i = 1, xnelem {
if (!IS_INDEFD(xin[i])) {
Memd[temp+op] = xin[i] # op is zero indexed at this point
op = op + 1
}
}
if (op > 1) {
# Check the independent variable values to make sure they're
# monotonically increasing or decreasing.
if (Memd[temp+1] > Memd[temp]) { # increasing
do i = 2, op { # one indexed
if (Memd[temp+i-1] <= Memd[temp+i-2])
call error (1, NOT_MONOTONIC)
}
} else { # decreasing
do i = 2, op {
if (Memd[temp+i-1] >= Memd[temp+i-2])
call error (1, NOT_MONOTONIC)
}
}
}
call sfree (sp)
end
|
