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
133
134
135
136
137
138
139
140
|
include <tbset.h>
# tudcol -- get column pointers
# Get pointers to input and output dependent variable columns, define
# columns in output table.
# The arrays icp & ocp of column pointers are of the same length,
# which will be less than the total number of columns because they
# do not include the independent variable column.
#
# Columns of type text or boolean will not be copied to the output table.
# If the independent variable column contains arrays, scalar columns will
# be copied to output without interpolation; array columns must be the same
# length as the independent variable column.
# If the independent variable column contains scalars, array columns will
# not be copied to output.
# If verbose is true, a message will be printed regarding skipped columns.
#
# Phil Hodge, 26-Apr-2000 Subroutine created, based on previous tugcol.
procedure tudcol (itp, otp, iv_colname, outrows,
iv_icp, iv_ocp, icp, ocp, ncols, array, verbose)
pointer itp # i: pointer to input table descriptor
pointer otp # i: pointer to output table descriptor
char iv_colname[ARB] # i: name of indep var column
int outrows # i: array length for output array columns
pointer iv_icp # o: ptr to descr for input indep var column
pointer iv_ocp # o: ptr to descr for output indep var column
pointer icp[ARB] # o: ptr to column descr for input table
pointer ocp[ARB] # o: ptr to column descr for output table
int ncols # o: number of dependent variable columns
bool array # o: true if indep var column contains arrays
bool verbose # i: print info?
#--
pointer sp
pointer why # note regarding why a column is skipped
bool skip_this # true if column will not be copied to output
pointer cp # a column pointer
char cname[SZ_COLNAME] # a column name
char cunits[SZ_COLUNITS] # units for a column
char cfmt[SZ_COLFMT] # print format for a column
int dtype # data type of a column
int xnelem # number of input elements for indep var column
int iv_nelem # number of output elements for indep var column
int nelem # number of elements
int lenfmt # length of print format
int incols # number of columns in input table
int k # loop index
int cnum # column number (ignored)
pointer tbcnum()
int tbpsta()
begin
call smark (sp)
call salloc (why, SZ_FNAME, TY_CHAR)
incols = tbpsta (itp, TBL_NCOLS)
call tbcfnd1 (itp, iv_colname, iv_icp)
if (iv_icp == NULL)
call error (1, "independent variable column not found")
# Get info about indep var column in input table.
call tbcinf (iv_icp, cnum, cname, cunits, cfmt, dtype, xnelem, lenfmt)
# Note that this test is based on the independent variable column.
array = (xnelem > 1)
# The indep var column in the output table may contain arrays;
# iv_nelem will be used in the loop below when defining the output
# column of independent variable values.
if (array)
iv_nelem = outrows
else
iv_nelem = 1
if (verbose && array) {
call printf ("note: array columns in each row will be rebinned\n")
call flush (STDOUT)
}
# Define the columns in the output table.
ncols = 0
do k = 1, incols {
skip_this = false # initial value
cp = tbcnum (itp, k)
call tbcinf (cp, cnum, cname, cunits, cfmt, dtype, nelem, lenfmt)
# Indep var column.
if (cp == iv_icp) {
call tbcdef1 (otp, iv_ocp, cname, cunits, cfmt, dtype, iv_nelem)
next
}
if (array) {
if (nelem > 1 && nelem != xnelem) { # not the same size
skip_this = true
call strcpy ("array size is not the same",
Memc[why], SZ_FNAME)
}
} else {
if (nelem > 1) { # skip array columns
skip_this = true
call strcpy ("column contains arrays", Memc[why], SZ_FNAME)
}
if (dtype <= 0 || dtype == TY_CHAR || dtype == TY_BOOL) {
skip_this = true
if (dtype == TY_BOOL) {
call strcpy ("data type is boolean",
Memc[why], SZ_FNAME)
} else {
call strcpy ("data type is text string",
Memc[why], SZ_FNAME)
}
}
}
if (skip_this) {
if (verbose) {
call printf (" skipping column `%s' (%s)\n")
call pargstr (cname)
call pargstr (Memc[why])
call flush (STDOUT)
}
next
}
# Define output column; save pointers for input & output.
ncols = ncols + 1
if (array && nelem > 1)
nelem = outrows
icp[ncols] = cp
call tbcdef1 (otp, ocp[ncols],
cname, cunits, cfmt, dtype, nelem)
}
call sfree (sp)
end
|
