aboutsummaryrefslogtreecommitdiff
path: root/pkg/utilities/nttools/threed/txtable/txtone.x
diff options
context:
space:
mode:
Diffstat (limited to 'pkg/utilities/nttools/threed/txtable/txtone.x')
-rw-r--r--pkg/utilities/nttools/threed/txtable/txtone.x227
1 files changed, 227 insertions, 0 deletions
diff --git a/pkg/utilities/nttools/threed/txtable/txtone.x b/pkg/utilities/nttools/threed/txtable/txtone.x
new file mode 100644
index 00000000..d286523d
--- /dev/null
+++ b/pkg/utilities/nttools/threed/txtable/txtone.x
@@ -0,0 +1,227 @@
+include <tbset.h>
+
+# TXTONE -- Extract 2D tables from a single input 3D table.
+#
+#
+# This code is adapted from B.Simon's 04-Nov-94 version of tcopy.
+#
+#
+#
+# Revision history:
+# ----------------
+#
+# 22-Nov-1996 - Task created (I.Busko)
+# 16-Dec-1996 - Add ORIG_ROW keyword (IB).
+# 03-Jan-1997 - Revised after code review (IB)
+# 17-Mar-1997 - Added selrows call (IB)
+# 8-Apr-1999 - Call tbfpri (Phil Hodge)
+# 8-Apr-2002 - Remove the call to whatfile (P. Hodge)
+
+
+procedure txtone (input, output, verbose, compact)
+
+char input[ARB] # i: input table name
+char output[ARB] # i: output table name
+bool compact # i: put scalars in header ?
+bool verbose # i: print operations ?
+#--
+int numrow, numcol, numptr, type, irow, nrows
+int phu_copied # set by tbfpri and ignored
+pointer sp, root, extend, rowselect, colselect, colname, colunits, colfmt
+pointer errmsg, itp, otp, colptr, newcol, pcode
+pointer newname
+bool suffix
+
+string nosect "Sections not permitted on output table name (%s)"
+string nocols "Column names not found (%s)"
+
+errchk tbfpri, tbtopn, tctexp, tbracket, trsopen, trseval
+
+bool trseval(), streq()
+int tbpsta(), selrows()
+pointer tbtopn(), trsopen()
+
+begin
+ # Allocate memory for temporary strings.
+ call smark (sp)
+ call salloc (root, SZ_FNAME, TY_CHAR)
+ call salloc (newname, SZ_FNAME, TY_CHAR)
+ call salloc (extend, SZ_FNAME, TY_CHAR)
+ call salloc (rowselect, SZ_FNAME, TY_CHAR)
+ call salloc (colselect, SZ_FNAME, TY_CHAR)
+ call salloc (colname, SZ_COLNAME, TY_CHAR)
+ call salloc (colunits, SZ_COLUNITS, TY_CHAR)
+ call salloc (colfmt, SZ_COLFMT, TY_CHAR)
+ call salloc (errmsg, SZ_LINE, TY_CHAR)
+
+ # Selectors are forbbiden on output.
+ call rdselect (output, Memc[root], Memc[rowselect],
+ Memc[colselect], SZ_FNAME)
+ if (Memc[rowselect] != EOS || Memc[colselect] != EOS) {
+ call sprintf (Memc[errmsg], SZ_LINE, nosect)
+ call pargstr (output)
+ call error (1, Memc[errmsg])
+ }
+
+ # Break input file name into bracketed selectors.
+ call rdselect (input, Memc[root], Memc[rowselect],
+ Memc[colselect], SZ_FNAME)
+
+ # Open input table and get some info about it.
+ itp = tbtopn (Memc[root], READ_ONLY, NULL)
+ numrow = tbpsta (itp, TBL_NROWS)
+ numcol = tbpsta (itp, TBL_NCOLS)
+
+ # Find how many rows were requested by row selector.
+ # If only one, turn off suffixing. Also do it in case
+ # ASCII output was requested.
+ nrows = selrows (itp, Memc[rowselect])
+ if (nrows == 1)
+ suffix = false
+ else
+ suffix = true
+ if (streq (output, "STDOUT"))
+ suffix = false
+
+ # Create array of column pointers from column selector.
+ call malloc (colptr, numcol, TY_INT)
+ call malloc (newcol, numcol, TY_INT)
+ call tcs_open (itp, Memc[colselect], Memi[colptr], numptr, numcol)
+
+ # Take an error exit if no columns were matched.
+ if (numptr == 0) {
+ call sprintf (Memc[errmsg], SZ_LINE, nocols)
+ call pargstr (input)
+ call error (1, Memc[errmsg])
+ }
+
+ # Loop over selected rows on input table, creating
+ # a 2D output table for each row.
+ pcode = trsopen (itp, Memc[rowselect])
+ do irow = 1, numrow {
+ if (trseval (itp, irow, pcode)) {
+
+ # Append suffix to output name.
+ if (suffix)
+ call txtsuff (output, Memc[newname], irow)
+ else
+ call strcpy (output, Memc[newname], SZ_FNAME)
+
+ if (verbose) {
+ call printf ("%s row=%d -> %s\n")
+ call pargstr (input)
+ call pargi (irow)
+ call pargstr (Memc[newname])
+ call flush (STDOUT)
+ }
+
+ # Open output table and set its type.
+ call tbfpri (Memc[root], Memc[newname], phu_copied)
+ otp = tbtopn (Memc[newname], NEW_FILE, NULL)
+ type = tbpsta (itp, TBL_WHTYPE)
+ if (streq (output, "STDOUT")) # ASCII output.
+ type = TBL_TYPE_TEXT
+ call tbpset (otp, TBL_WHTYPE, type)
+
+ # Copy column information from input to output.
+ call txtcpyco (otp, colptr, newcol, numptr, colname,
+ colunits, colfmt, compact)
+
+ # Create table and copy header.
+ call tbtcre (otp)
+ call tbhcal (itp, otp)
+
+ # Copy row number into header.
+ call tbhadi (otp, "ORIG_ROW", irow)
+
+ # Copy scalar columns into header.
+ if (compact)
+ call txtcpysc (otp, colptr, newcol, numptr, colname,
+ colunits, colfmt)
+
+ # Copy number of columns into header. This is used
+ # by task that reads back 2D tables into 3D format.
+ if (compact)
+ call tbhadi (otp, "TCTOTAL", numptr)
+
+ # Copy data to output table.
+ call txtcpy (itp, otp, irow, Memi[colptr], Memi[newcol],
+ numptr, compact)
+
+ # Close output.
+ call tbtclo (otp)
+ }
+ }
+
+ # Free arrays associated with columns.
+ call tcs_close (Memi[colptr], numptr)
+ call mfree (newcol, TY_INT)
+ call mfree (colptr, TY_INT)
+
+ # Close row selector structure and input table.
+ call trsclose (pcode)
+ call tbtclo (itp)
+
+ call sfree (sp)
+end
+
+
+
+
+# Appends sufix to output file name.
+
+procedure txtsuff (filename, newname, row)
+
+char filename[ARB] # i: output table name
+char newname[ARB] # o: output table name with suffix
+int row # i: row number
+
+pointer sp, ext, suffix
+int dot, i, j
+
+int strcmp(), strldxs()
+
+begin
+ call smark (sp)
+ call salloc (suffix, SZ_LINE, TY_CHAR)
+ call salloc (ext, SZ_LINE, TY_CHAR)
+
+ # Get rid of any appendages except the extension.
+ call imgcluster (filename, newname, SZ_FNAME)
+
+ # Valid extensions are .tab, .fit and .fits
+ # Everything else is part of the root file name.
+
+ # Detect extension.
+ Memc[ext] = EOS
+ dot = strldxs (".", newname)
+ if (dot != 0) {
+ i = dot
+ j = 0
+ while (newname[i] != EOS) {
+ Memc[ext+j] = newname[i]
+ j = j + 1
+ i = i + 1
+ }
+ Memc[ext+j] = EOS
+ }
+
+ # If valid extension, remove it from name.
+ if ( (strcmp (Memc[ext], ".tab") == 0) ||
+ (strcmp (Memc[ext], ".fit") == 0) ||
+ (strcmp (Memc[ext], ".fits") == 0) )
+ newname[dot] = EOS
+ else
+ Memc[ext] = EOS
+
+ # Build suffix.
+ call sprintf (Memc[suffix], SZ_LINE, "_r%04d")
+ call pargi (row)
+
+ # Append suffix and extension to root name.
+ call strcat (Memc[suffix], newname, SZ_FNAME)
+ call strcat (Memc[ext], newname, SZ_FNAME)
+
+ call sfree (sp)
+end
+
generated by cgit (git 2.34.1) at 2025-09-20 05:28:50 -0400