Repatch (from linux) of OSX IRAF

1 files changed, 112 insertions, 0 deletions

diff --git a/pkg/utilities/nttools/tunits/tunits.x b/pkg/utilities/nttools/tunits/tunits.x
new file mode 100644
index 00000000..526bca11
--- /dev/null
+++ b/pkg/utilities/nttools/tunits/tunits.x
@@ -0,0 +1,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