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
|
include <tbset.h>
include "tunits.h"
#* HISTORY *
#* B.Simon 07-Jan-99 Original
# TUNITS -- Convert table column from one set of units to another
procedure tunits ()
#--
pointer table # table name
pointer column # column name
pointer newunits # new column units
pointer oldunits # old column units
pointer abrevtab # table of unit abbreviations
pointer unittab # table of unit conversions
bool verbose # print diagnostic messages
double factor
int type
pointer sp, tp, cp, ab, ut, punit1, punit2
string nocolumn "Column not found"
string unitblank "Units parameter is blank"
string notfloat "Table column is not floating point"
bool clgetb(), isblank()
double find_factor()
int tbcigi()
pointer tbtopn(), read_abrev(), read_units(), parse_units()
begin
# Allocate memory for temporary strings
call smark (sp)
call salloc (table, SZ_FNAME, TY_CHAR)
call salloc (column, SZ_FNAME, TY_CHAR)
call salloc (newunits, SZ_FNAME, TY_CHAR)
call salloc (oldunits, SZ_FNAME, TY_CHAR)
call salloc (abrevtab, SZ_FNAME, TY_CHAR)
call salloc (unittab, SZ_FNAME, TY_CHAR)
# Read required task parameters
call clgstr ("table", Memc[table], SZ_FNAME)
call clgstr ("column", Memc[column], SZ_FNAME)
call clgstr ("newunits", Memc[newunits], SZ_FNAME)
call clgstr ("oldunits", Memc[oldunits], SZ_FNAME)
call clgstr ("abrevtab", Memc[abrevtab], SZ_FNAME)
call clgstr ("unittab", Memc[unittab], SZ_FNAME)
verbose = clgetb ("verbose")
# Open table, find column
tp = tbtopn (Memc[table], READ_WRITE, NULL)
call tbcfnd (tp, Memc[column], cp, 1)
if (cp == NULL)
call tuniterr (nocolumn, Memc[column])
# Read column units if old units are blank
if (isblank (Memc[oldunits]))
call tbcigt (cp, TBL_COL_UNITS, Memc[oldunits], SZ_FNAME)
call strlwr (Memc[oldunits])
call strlwr (Memc[newunits])
# Check to see if units are not blank
if (isblank (Memc[oldunits]))
call tuniterr (unitblank, "oldunits")
if (isblank (Memc[newunits]))
call tuniterr (unitblank, "newunits")
# Check to see if column is floating point
type = tbcigi (cp, TBL_COL_DATATYPE)
if (type != TY_REAL && type != TY_DOUBLE)
call tuniterr (notfloat, Memc[column])
# Read units and abbreviation tables into hashes
ab = read_abrev (Memc[abrevtab])
ut = read_units (ab, Memc[unittab])
# Convert units to internal form
punit1 = parse_units (ab, Memc[oldunits])
punit2 = parse_units (ab, Memc[newunits])
# Find conversion factor between units
factor = find_factor (ut, punit1, punit2, verbose)
# Apply conversion factor to table column
call convert_col (tp, cp, Memc[newunits], factor)
# Close table and free allocated memory
call tbtclo (tp)
call free_abrev (ab)
call free_units (ut)
call free_unstr (punit1)
call free_unstr (punit2)
call sfree (sp)
end
|
