aboutsummaryrefslogtreecommitdiff
path: root/pkg/utilities/nttools/tunits/units.x
blob: 6f4374df1be1829fbe03f60b2119d72b147fe6b3 (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
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
include	<tbset.h>
include "tunits.h"

#* HISTORY *
#* B.Simon	07-Jan-99	Original

# FIND_UNITS -- Find the conversion factor for a set of units

int procedure find_units (ut, units, punit)

pointer	ut		# i: units hash table descriptor
char	units[ARB]	# i: units string
pointer	punit		# o: conversion factor as units structure
#--
int	get_unhash()

begin 
	return (get_unhash (ut, units, punit))
end

# FREE_UNITS -- Free the abbreviation hash table

procedure free_units (ut)

pointer	ut		# i: units hash table descriptor
#--
int	index
pointer	sp, units, punit

int	each_unhash()

begin
	call smark (sp)
	call salloc (units, LEN_UNIT, TY_CHAR)

	index = 0
	while (each_unhash (ut, index, Memc[units], 
			    punit, LEN_UNIT) != EOF) {
	    if (punit != NULL)
		call free_unstr (punit)
	}

	call free_unhash (ut)
	call sfree (sp)
end

# READ_UNITS -- Read units conversions from a table and load into a hash

pointer procedure read_units (ab, unittab)

pointer	ab		# i: abbreviation table descriptor
char	unittab[ARB]	# i: units conversion table name
#--
bool	swap, verbose
double	factor
int	irow, nrow
pointer	sp, temp, oldunits, newunits
pointer	tp, c1, c2, c3, c4
pointer	ut, punit1, punit2, punit3

data	verbose   / false /

string	nocolumn  "The units conversion table must have four columns"
string	badfactor "Error in units table: factor must be greater than zero"
string	nofinal   "Error in units table: conversion from final units not allowed"

int	tbpsta(), word_match()
pointer	tbtopn(), tbcnum(), new_unhash()
pointer	parse_units(), div_unstr()

begin
	# Dynamic memory for strings

	call smark (sp)
	call salloc (temp, SZ_FNAME, TY_CHAR)
	call salloc (oldunits, SZ_FNAME, TY_CHAR)
	call salloc (newunits, SZ_FNAME, TY_CHAR)

	# Refer to columns numerically because 
	# this is supposed to be a text file

	tp = tbtopn (unittab, READ_ONLY, NULL)
	c1 = tbcnum (tp, 1)
	c2 = tbcnum (tp, 2)
	c3 = tbcnum (tp, 3)
	c4 = tbcnum (tp, 4)

	if (c1 == NULL || c2 == NULL || c3 == NULL || c4 == NULL)
	    call tuniterr (nocolumn, unittab)

	# Create hash

	nrow = tbpsta (tp, TBL_NROWS)
	ut = new_unhash (nrow, LEN_UNIT)

	# Read each row into hash

	do irow = 1, nrow {
	    # Read table columns

	    call tbegtd (tp, c1, irow, factor)
	    call tbegtt (tp, c2, irow, Memc[oldunits], SZ_FNAME)
	    call tbegtt (tp, c3, irow, Memc[newunits], SZ_FNAME)
	    call tbegtb (tp, c4, irow, swap)

	    # Check conversion factor

	    if (factor <= 0.0)
		call tuniterr (badfactor, Memc[oldunits])

	    # Swap the units string and the conversion factor

	    if (swap) {
		call strcpy (Memc[oldunits], Memc[temp], SZ_FNAME)
		call strcpy (Memc[newunits], Memc[oldunits], SZ_FNAME)
		call strcpy (Memc[temp], Memc[newunits], SZ_FNAME)
	    }

	    # Check to see that old units aren't one of the final forms

	    if (word_match (Memc[oldunits], FINALS) != 0)
		call tuniterr (nofinal, Memc[oldunits])

	    # Parse the old and new units strings

	    call strlwr (Memc[newunits])
	    punit1 = parse_units (ab, Memc[newunits])

	    call strlwr (Memc[oldunits])
	    punit2 = parse_units (ab, Memc[oldunits])

	    # The conversion factor is ratio of the two sets of units

	    punit3 = div_unstr (punit1, punit2)
	    if (swap) {
		TUN_FACTOR(punit3) = factor
	    } else {
		TUN_FACTOR(punit3) = 1.0 / factor
	    }

	    if (verbose) {
		call str_unstr (punit3, Memc[temp], SZ_FNAME)

		call eprintf ("The conversion factor is %s\n\n")
		call pargstr (Memc[temp])
	    }

	    # Add it to the hash

	    call abrev_unstr (ab, Memc[oldunits], Memc[temp], SZ_FNAME)
	    call add_unhash (ut, Memc[temp], punit3)

	    call free_unstr (punit1)
	    call free_unstr (punit2)
	} 

	# Close table and free memory

	call tbtclo (tp)
	call sfree (sp)
	return (ut)
end