aboutsummaryrefslogtreecommitdiff
path: root/noao/digiphot/ptools/txtools
diff options
context:
space:
mode:
Diffstat (limited to 'noao/digiphot/ptools/txtools')
-rw-r--r--noao/digiphot/ptools/txtools/mkpkg23
-rw-r--r--noao/digiphot/ptools/txtools/ptqsort.x215
-rw-r--r--noao/digiphot/ptools/txtools/ptrenumb.x221
-rw-r--r--noao/digiphot/ptools/txtools/ptsortnum.x446
-rw-r--r--noao/digiphot/ptools/txtools/ptxcalc.x255
-rw-r--r--noao/digiphot/ptools/txtools/ptxdump.x421
-rw-r--r--noao/digiphot/ptools/txtools/ptxselect.x160
-rw-r--r--noao/digiphot/ptools/txtools/t_txcalc.x65
-rw-r--r--noao/digiphot/ptools/txtools/t_txconcat.x128
-rw-r--r--noao/digiphot/ptools/txtools/t_txdump.x45
-rw-r--r--noao/digiphot/ptools/txtools/t_txrenumber.x65
-rw-r--r--noao/digiphot/ptools/txtools/t_txselect.x64
-rw-r--r--noao/digiphot/ptools/txtools/t_txsort.x65
13 files changed, 2173 insertions, 0 deletions
diff --git a/noao/digiphot/ptools/txtools/mkpkg b/noao/digiphot/ptools/txtools/mkpkg
new file mode 100644
index 00000000..55485e70
--- /dev/null
+++ b/noao/digiphot/ptools/txtools/mkpkg
@@ -0,0 +1,23 @@
+# TXTOOLS tasks
+
+$checkout libpkg.a ".."
+$update libpkg.a
+$checkin libpkg.a ".."
+$exit
+
+libpkg.a:
+ t_txconcat.x ../../lib/ptkeysdef.h <fset.h> <error.h>
+ t_txdump.x
+ ptxdump.x <fset.h> <error.h> <evexpr.h> ../../lib/ptkeysdef.h
+ t_txcalc.x <fset.h>
+ ptxcalc.x ../../lib/ptkeysdef.h <error.h> \
+ <ctype.h> <evexpr.h>
+ t_txrenumber.x <fset.h>
+ ptrenumb.x ../../lib/ptkeysdef.h
+ t_txsort.x <fset.h>
+ ptsortnum.x <ctype.h> ../../lib/ptkeysdef.h
+ ptqsort.x
+ t_txselect.x <fset.h>
+ ptxselect.x ../../lib/ptkeysdef.h <error.h> \
+ <ctype.h> <evexpr.h>
+ ;
diff --git a/noao/digiphot/ptools/txtools/ptqsort.x b/noao/digiphot/ptools/txtools/ptqsort.x
new file mode 100644
index 00000000..3883424f
--- /dev/null
+++ b/noao/digiphot/ptools/txtools/ptqsort.x
@@ -0,0 +1,215 @@
+define LOGPTR 20 # log2(maxpts) (1e6)
+
+# PT_QSORT -- Vector Quicksort. In this version the index array is
+# sorted.
+
+procedure pt_qsortr (data, a, b, npix)
+
+real data[ARB] # data array
+int a[ARB], b[ARB] # index array
+int npix # number of pixels
+
+int i, j, lv[LOGPTR], p, uv[LOGPTR], temp
+real pivot
+
+begin
+ # Initialize the indices for an inplace sort.
+ do i = 1, npix
+ a[i] = i
+ call amovi (a, b, npix)
+
+ p = 1
+ lv[1] = 1
+ uv[1] = npix
+ while (p > 0) {
+
+ # If only one elem in subset pop stack otherwise pivot line.
+ if (lv[p] >= uv[p])
+ p = p - 1
+ else {
+ i = lv[p] - 1
+ j = uv[p]
+ pivot = data[b[j]]
+
+ while (i < j) {
+ for (i=i+1; data[b[i]] < pivot; i=i+1)
+ ;
+ for (j=j-1; j > i; j=j-1)
+ if (data[b[j]] <= pivot)
+ break
+ if (i < j) { # out of order pair
+ temp = b[j] # interchange elements
+ b[j] = b[i]
+ b[i] = temp
+ }
+ }
+
+ j = uv[p] # move pivot to position i
+ temp = b[j] # interchange elements
+ b[j] = b[i]
+ b[i] = temp
+
+ if (i-lv[p] < uv[p] - i) { # stack so shorter done first
+ lv[p+1] = lv[p]
+ uv[p+1] = i - 1
+ lv[p] = i + 1
+ } else {
+ lv[p+1] = i + 1
+ uv[p+1] = uv[p]
+ uv[p] = i - 1
+ }
+
+ p = p + 1 # push onto stack
+ }
+ }
+end
+
+
+# PT_QSORT -- Vector Quicksort. In this version the index array is
+# sorted.
+
+procedure pt_qsorti (data, a, b, npix)
+
+int data[ARB] # data array
+int a[ARB], b[ARB] # index array
+int npix # number of pixels
+
+int i, j, lv[LOGPTR], p, uv[LOGPTR], temp
+int pivot
+
+begin
+ # Initialize the indices for an inplace sort.
+ do i = 1, npix
+ a[i] = i
+ call amovi (a, b, npix)
+
+ p = 1
+ lv[1] = 1
+ uv[1] = npix
+ while (p > 0) {
+
+ # If only one elem in subset pop stack otherwise pivot line.
+ if (lv[p] >= uv[p])
+ p = p - 1
+ else {
+ i = lv[p] - 1
+ j = uv[p]
+ pivot = data[b[j]]
+
+ while (i < j) {
+ for (i=i+1; data[b[i]] < pivot; i=i+1)
+ ;
+ for (j=j-1; j > i; j=j-1)
+ if (data[b[j]] <= pivot)
+ break
+ if (i < j) { # out of order pair
+ temp = b[j] # interchange elements
+ b[j] = b[i]
+ b[i] = temp
+ }
+ }
+
+ j = uv[p] # move pivot to position i
+ temp = b[j] # interchange elements
+ b[j] = b[i]
+ b[i] = temp
+
+ if (i-lv[p] < uv[p] - i) { # stack so shorter done first
+ lv[p+1] = lv[p]
+ uv[p+1] = i - 1
+ lv[p] = i + 1
+ } else {
+ lv[p+1] = i + 1
+ uv[p+1] = uv[p]
+ uv[p] = i - 1
+ }
+
+ p = p + 1 # push onto stack
+ }
+ }
+end
+
+
+# PT_QSORT -- Vector Quicksort. In this version the index array is
+# sorted.
+
+procedure pt_qsortb (data, a, b, npix)
+
+bool data[ARB] # data array
+int a[ARB], b[ARB] # index array
+int npix # number of pixels
+
+int i, j, lv[LOGPTR], p, uv[LOGPTR], temp
+bool pivot
+int pt_compareb()
+
+begin
+ # Initialize the indices for an inplace sort.
+ do i = 1, npix
+ a[i] = i
+ call amovi (a, b, npix)
+
+ p = 1
+ lv[1] = 1
+ uv[1] = npix
+ while (p > 0) {
+
+ # If only one elem in subset pop stack otherwise pivot line.
+ if (lv[p] >= uv[p])
+ p = p - 1
+ else {
+ i = lv[p] - 1
+ j = uv[p]
+ pivot = data[b[j]]
+
+ while (i < j) {
+ #for (i=i+1; data[b[i]] != pivot; i=i+1)
+ for (i=i+1; pt_compareb (data[b[i]], pivot) < 0; i=i+1)
+ ;
+ for (j=j-1; j > i; j=j-1)
+ #if (data[b[j]] != pivot)
+ if (pt_compareb (data[b[j]], pivot) <= 0)
+ break
+ if (i < j) { # out of order pair
+ temp = b[j] # interchange elements
+ b[j] = b[i]
+ b[i] = temp
+ }
+ }
+
+ j = uv[p] # move pivot to position i
+ temp = b[j] # interchange elements
+ b[j] = b[i]
+ b[i] = temp
+
+ if (i-lv[p] < uv[p] - i) { # stack so shorter done first
+ lv[p+1] = lv[p]
+ uv[p+1] = i - 1
+ lv[p] = i + 1
+ } else {
+ lv[p+1] = i + 1
+ uv[p+1] = uv[p]
+ uv[p] = i - 1
+ }
+
+ p = p + 1 # push onto stack
+ }
+ }
+end
+
+
+# PT_COMPAREB -- Compare to booleans for the sort routine.
+
+int procedure pt_compareb (a, b)
+
+bool a # first boolean
+bool b # second boolean
+
+begin
+ if (! a && b)
+ return (-1)
+ else if (a && ! b)
+ return (1)
+ else
+ return (0)
+end
diff --git a/noao/digiphot/ptools/txtools/ptrenumb.x b/noao/digiphot/ptools/txtools/ptrenumb.x
new file mode 100644
index 00000000..85fee34a
--- /dev/null
+++ b/noao/digiphot/ptools/txtools/ptrenumb.x
@@ -0,0 +1,221 @@
+include "../../lib/ptkeysdef.h"
+
+# PT_RENUMBER -- Renumber the input file.
+
+int procedure pt_renumber (tp_in, tp_out, idoffset, id)
+
+int tp_in # the input text file descriptor
+int tp_out # the output text file descriptor
+int idoffset # the id number offset
+char id[ARB] # the name of the id column
+
+int first_rec, nunique, uunique, funique, record
+int ncontinue, recptr, nchars, field
+pointer key, line
+int getline(), strncmp(), pt_kstati()
+
+begin
+ # Initialize keyword structure.
+ call pt_kyinit (key)
+
+ # Initialize the file read.
+ first_rec = YES
+ nunique = 0
+ uunique = 0
+ funique = 0
+ record = 0
+ call malloc (line, SZ_LINE, TY_CHAR)
+
+ # Initilize the record read.
+ ncontinue = 0
+ recptr = 1
+
+ # Loop over the text file records.
+ repeat {
+
+ # Read in a line of the text file.
+ nchars = getline (tp_in, Memc[line])
+ if (nchars == EOF)
+ break
+
+ # Determine the type of record.
+ if (Memc[line] == KY_CHAR_POUND) {
+
+ if (strncmp (Memc[line], KY_CHAR_KEYWORD, KY_LEN_STR) == 0) {
+ call pt_kyadd (key, Memc[line], nchars)
+ call putline (tp_out, Memc[line])
+ } else if (strncmp (Memc[line], KY_CHAR_NAME,
+ KY_LEN_STR) == 0) {
+ nunique = nunique + 1
+ call pt_kname (key, Memc[line], nchars, nunique)
+ call putline (tp_out, Memc[line])
+ } else if (strncmp (Memc[line], KY_CHAR_UNITS,
+ KY_LEN_STR) == 0) {
+ uunique = uunique + 1
+ call pt_knunits (key, Memc[line], nchars, uunique)
+ call putline (tp_out, Memc[line])
+ } else if (strncmp (Memc[line], KY_CHAR_FORMAT,
+ KY_LEN_STR) == 0) {
+ funique = funique + 1
+ call pt_knformats (key, Memc[line], nchars, funique)
+ call putline (tp_out, Memc[line])
+ } else {
+ # skip lines beginning with # sign
+ call putline (tp_out, Memc[line])
+ }
+
+ } else if (Memc[line] == KY_CHAR_NEWLINE) {
+
+ # skip blank lines
+ call putline (tp_out, Memc[line])
+
+ } else {
+
+ # Check that the ID column exists and its datatype is
+ # integer.
+
+ if (first_rec == YES) {
+ field = pt_kstati (key, id, KY_INDEX)
+ if (field <= 0)
+ break
+ if (pt_kstati (key, id, KY_DATATYPE) != TY_INT)
+ break
+ }
+
+ # Replace the ID string.
+ call pt_idreplace (key, field, 1, Memc[line], nchars,
+ record + idoffset + 1, first_rec, recptr, ncontinue)
+
+ # Write the output record.
+ call putline (tp_out, Memc[line])
+
+ # Do the record book-keeping.
+ if (Memc[line+nchars-2] != KY_CHAR_CONT) {
+
+ # Increment the record counter.
+ record = record + 1
+ first_rec = NO
+
+ # Reinitialize the record read.
+ ncontinue = 0
+ recptr = 1
+ }
+ }
+
+ }
+
+ # Cleanup.
+ call mfree (line, TY_CHAR)
+ call pt_kyfree (key)
+
+ return (record)
+end
+
+
+# PT_IDREPLACE -- Replace the id with the current record number.
+
+procedure pt_idreplace (key, field, element, line, nchars, record, first_rec,
+ recptr, ncontinue)
+
+pointer key # pointer to record structure
+int field # field to be fetched
+int element # field array element
+char line[ARB] # input line
+int nchars # length of line array
+int record # current record number
+int first_rec # first record
+int recptr # line per record index
+int ncontinue # number of unique lines per record
+
+int len, i, cip, nper_line, nokeys, nckeys, nkeys
+pointer sp, str
+
+begin
+ call smark (sp)
+ call salloc (str, SZ_FNAME, TY_CHAR)
+
+ # The number of header columns defined by #K at the beginning of
+ # the file is nokeys.
+ if (recptr == 1)
+ nokeys = KY_NPKEYS(key)
+
+ # Increment the continuation statement counter or reset to 0.
+ if (line[nchars-2] == '*')
+ ncontinue = ncontinue + 1
+ else
+ ncontinue = 0
+
+ # Replace the current id with the record number.
+ cip = 1
+ if (ncontinue < 1) {
+
+ nper_line = Memi[KY_NPLINE(key)+recptr-1]
+ nkeys = nokeys + nper_line
+ call amovki (int(1), Memi[KY_NELEMS(key)+nokeys], nper_line)
+
+ do i = nokeys + 1, nkeys {
+ len = Memi[KY_KINDICES(key)+i-1]
+ if (i == field) {
+ call sprintf (Memc[str], SZ_FNAME, "%*s")
+ call pargi (-len)
+ call pargi (record)
+ call amovc (Memc[str], line[cip], len)
+ }
+ cip = cip + len
+ }
+
+ recptr = recptr + 1
+ nokeys = nkeys
+
+ } else if (ncontinue == 1) {
+
+ nckeys = nokeys + 1
+ nkeys = nokeys + Memi[KY_NPLINE(key)+recptr-1]
+
+ if (first_rec == YES) {
+ Memi[KY_NCONTINUE(key)+recptr-1] = KY_NLINES
+ do i = nckeys, nkeys
+ call malloc (Memi[KY_PTRS(key)+i-1], KY_NLINES *
+ Memi[KY_KINDICES(key)+i-1], TY_CHAR)
+ }
+
+ do i = nckeys, nkeys {
+ len = Memi[KY_KINDICES(key)+i-1]
+ if ((i == field) && (element == 1)) {
+ call sprintf (Memc[str], SZ_FNAME, "%*s")
+ call pargi (-len)
+ call pargi (record)
+ call amovc (Memc[str], line[cip], len)
+ }
+ cip = cip + len
+ }
+
+ nokeys = nkeys
+ recptr = recptr + 1
+
+ } else {
+
+ if (ncontinue > Memi[KY_NCONTINUE(key)+recptr-2]) {
+ Memi[KY_NCONTINUE(key)+recptr-2] =
+ Memi[KY_NCONTINUE(key)+recptr-2] + KY_NLINES
+ do i = nckeys, nkeys
+ call realloc (Memi[KY_PTRS(key)+i-1],
+ Memi[KY_NCONTINUE(key)+recptr-2] *
+ Memi[KY_KINDICES(key)+i-1], TY_CHAR)
+ }
+
+ do i = nckeys, nkeys {
+ len = Memi[KY_KINDICES(key)+i-1]
+ if ((i == field) && (element == ncontinue)) {
+ call sprintf (Memc[str], SZ_FNAME, "%*s")
+ call pargi (-len)
+ call pargi (record)
+ call amovc (Memc[str], line[cip], len)
+ }
+ Memi[KY_NELEMS(key)+i-1] = ncontinue
+ cip = cip + len
+ }
+ }
+
+ call sfree (sp)
+end
diff --git a/noao/digiphot/ptools/txtools/ptsortnum.x b/noao/digiphot/ptools/txtools/ptsortnum.x
new file mode 100644
index 00000000..463b2f38
--- /dev/null
+++ b/noao/digiphot/ptools/txtools/ptsortnum.x
@@ -0,0 +1,446 @@
+include <ctype.h>
+include "../../lib/ptkeysdef.h"
+
+# PT_SORTNUM -- Decode the column used for the sort, compute the file
+# record structure map, sort on the extracted column, reorder the
+# input file and write the output file.
+
+int procedure pt_sortnum (tp_in, tp_out, column, ascend)
+
+pointer tp_in # input Table descriptor
+pointer tp_out # output Table descriptor
+char column[ARB] # column name for sort
+int ascend # forward sort
+
+int coltype, colwidth, nrecs
+pointer key, colptr, colindex, recmap
+int pt_colmap()
+
+begin
+ # Initialize.
+ call pt_kyinit (key)
+ colptr = NULL
+ colindex = NULL
+ recmap = NULL
+
+ # Decode the sort column and map the record structure.
+ nrecs = pt_colmap (key, tp_in, tp_out, column, colptr, colindex,
+ coltype, colwidth, recmap)
+
+ # Sort the column and write the output file.
+ if (nrecs > 0) {
+ call pt_colsort (colptr, Memi[colindex], nrecs, coltype)
+ if (ascend == NO)
+ call pt_flipi (Memi[colindex], nrecs)
+ call pt_reorder (tp_in, tp_out, Memi[recmap], Memi[colindex], nrecs)
+ }
+
+ # Free space.
+ if (colptr != NULL)
+ call mfree (colptr, coltype)
+ if (colindex != NULL)
+ call mfree (colindex, TY_INT)
+ if (recmap != NULL)
+ call mfree (recmap, TY_INT)
+ call pt_kyfree (key)
+
+ return (nrecs)
+end
+
+
+define BUFSIZE 1000
+
+# PT_COLMAP -- Decode the column to be sorted and compute the record
+# structure of the file.
+
+int procedure pt_colmap (key, tp_in, tp_out, column, colptr, colindex, coltype,
+ bufwidth, recmap)
+
+pointer key # pointer to the database structure
+int tp_in # the input text file descriptor
+int tp_out # the output text file descriptor
+char column[ARB] # column to be sorted
+pointer colptr # pointer to extracted column array
+pointer colindex # pointer to index array for extracted column
+int coltype # data type of the column to be sorted
+int bufwidth # column width if chars
+pointer recmap # pointer to the record structure map
+
+int first_rec, nunique, uunique, funique, record
+int ncontinue, recptr, nchars, szbuf, colwidth, field, element
+long loffset, roffset
+pointer sp, line, name, value
+int getline(), strncmp(), pt_kstati()
+long note()
+
+begin
+ call smark (sp)
+ call salloc (line, SZ_LINE, TY_CHAR)
+ call salloc (name, SZ_FNAME, TY_CHAR)
+ call salloc (value, SZ_FNAME, TY_CHAR)
+
+ # Initialize the file read.
+ first_rec = YES
+ nunique = 0
+ uunique = 0
+ funique = 0
+ record = 0
+ szbuf = 0
+
+ # Initilize the record read.
+ ncontinue = 0
+ recptr = 1
+
+ # Loop over the text file records.
+ repeat {
+
+ # Read in a line of the text file.
+ loffset = note (tp_in)
+ nchars = getline (tp_in, Memc[line])
+ if (nchars == EOF)
+ break
+
+ # Determine the type of record.
+ if (Memc[line] == KY_CHAR_POUND) {
+
+ if (strncmp (Memc[line], KY_CHAR_KEYWORD, KY_LEN_STR) == 0) {
+ call pt_kyadd (key, Memc[line], nchars)
+ if (first_rec == YES)
+ call putline (tp_out, Memc[line])
+ } else if (strncmp (Memc[line], KY_CHAR_NAME,
+ KY_LEN_STR) == 0) {
+ nunique = nunique + 1
+ call pt_kname (key, Memc[line], nchars, nunique)
+ call putline (tp_out, Memc[line])
+ } else if (strncmp (Memc[line], KY_CHAR_UNITS,
+ KY_LEN_STR) == 0) {
+ uunique = uunique + 1
+ call pt_knunits (key, Memc[line], nchars, uunique)
+ call putline (tp_out, Memc[line])
+ } else if (strncmp (Memc[line], KY_CHAR_FORMAT,
+ KY_LEN_STR) == 0) {
+ funique = funique + 1
+ call pt_knformats (key, Memc[line], nchars, funique)
+ call putline (tp_out, Memc[line])
+ } else {
+ # skip lines beginning with # sign
+ call putline (tp_out, Memc[line])
+ }
+
+ } else if (Memc[line] == KY_CHAR_NEWLINE) {
+ # skip blank lines
+ call putline (tp_out, Memc[line])
+
+ } else {
+
+ # Get the variable index.
+ if (first_rec == YES) {
+ call pt_kid (column, Memc[name], element)
+ field = pt_kstati (key, Memc[name], KY_INDEX)
+ if (field <= 0)
+ break
+ }
+
+ # Save the offset of the beginning of the current record.
+ if (recptr == 1)
+ roffset = loffset
+
+ # Construct the data record.
+ call pt_kgfield (key, field, element, Memc[line], nchars,
+ Memc[value], first_rec, recptr, ncontinue)
+
+ # Decode the selected fields.
+ if (Memc[line+nchars-2] != KY_CHAR_CONT) {
+
+ # Select the appropriate column, get its datatype and
+ # allocate the appropriate space.
+
+ if (first_rec == YES) {
+ element = pt_kstati (key, column, KY_ELEMENT)
+ if (IS_INDEFI(element))
+ break
+ coltype = pt_kstati (key, column, KY_DATATYPE)
+ if (IS_INDEFI(coltype))
+ break
+ colwidth = pt_kstati (key, column, KY_LENGTH)
+ if (coltype == TY_CHAR)
+ bufwidth = colwidth + 1
+ else
+ bufwidth = 1
+ }
+
+ # Reallocate buffer space if necessary.
+ if (record >= szbuf) {
+ szbuf = szbuf + BUFSIZE
+ if (coltype == TY_CHAR)
+ call realloc (colptr, szbuf * bufwidth, TY_CHAR)
+ else
+ call realloc (colptr, szbuf, coltype)
+ call realloc (colindex, szbuf, TY_INT)
+ call realloc (recmap, szbuf, TY_INT)
+ }
+
+ # Decode the selected column.
+ record = record + 1
+ Memi[colindex+record-1] = 1 + (record - 1) * bufwidth
+ Memi[recmap+record-1] = roffset
+ call pt_gsrt (Memc[value], colptr, coltype, bufwidth,
+ record)
+ first_rec = NO
+
+ # Reinitialize the record read.
+ ncontinue = 0
+ recptr = 1
+ }
+ }
+
+ }
+
+ # Cleanup.
+ call sfree (sp)
+ return (record)
+end
+
+
+# PT_KGFIELD -- Fetch a single fields from the input file.
+
+procedure pt_kgfield (key, field, element, line, nchars, value, first_rec,
+ recptr, ncontinue)
+
+pointer key # pointer to record structure
+int field # field to be fetched
+int element # field array element
+char line[ARB] # input line
+int nchars # length of line array
+char value[ARB] # the field value
+int first_rec # first record
+int recptr # line per record index
+int ncontinue # number of unique lines per record
+
+int len, i, cip, nper_line, nokeys, nckeys, nkeys
+
+begin
+ # Fetch the value if it is a #K parameter as this will already
+ # be sorted in the key structure.
+
+ if ((recptr == 1) && (field <= KY_NPKEYS(key))) {
+ len = Memi[KY_KINDICES(key)+field-1]
+ call amovc (Memc[Memi[KY_PTRS(key)+field-1]], value, len)
+ value[len+1] = EOS
+ }
+
+ # The number of header columns defined by #K at the beginning of
+ # the file is nokeys.
+ if (recptr == 1)
+ nokeys = KY_NPKEYS(key)
+
+ # Increment the continuation statement counter or reset to 0.
+ if (line[nchars-2] == '*')
+ ncontinue = ncontinue + 1
+ else
+ ncontinue = 0
+
+ # Fill in the record.
+ cip = 1
+ if (ncontinue < 1) {
+
+ nper_line = Memi[KY_NPLINE(key)+recptr-1]
+ nkeys = nokeys + nper_line
+ call amovki (int(1), Memi[KY_NELEMS(key)+nokeys], nper_line)
+
+ do i = nokeys + 1, nkeys {
+ len = Memi[KY_KINDICES(key)+i-1]
+ if (i == field) {
+ call amovc (line[cip], value, len)
+ value[len+1] = EOS
+ }
+ cip = cip + len
+ }
+
+ recptr = recptr + 1
+ nokeys = nkeys
+
+ } else if (ncontinue == 1) {
+
+ nckeys = nokeys + 1
+ nkeys = nokeys + Memi[KY_NPLINE(key)+recptr-1]
+
+ if (first_rec == YES) {
+ Memi[KY_NCONTINUE(key)+recptr-1] = KY_NLINES
+ do i = nckeys, nkeys
+ call malloc (Memi[KY_PTRS(key)+i-1], KY_NLINES *
+ Memi[KY_KINDICES(key)+i-1], TY_CHAR)
+ }
+
+ do i = nckeys, nkeys {
+ len = Memi[KY_KINDICES(key)+i-1]
+ if ((i == field) && (element == 1)) {
+ call amovc (line[cip], value, len)
+ value[len+1] = EOS
+ }
+ cip = cip + len
+ }
+
+ nokeys = nkeys
+ recptr = recptr + 1
+
+ } else {
+
+ if (ncontinue > Memi[KY_NCONTINUE(key)+recptr-2]) {
+ Memi[KY_NCONTINUE(key)+recptr-2] =
+ Memi[KY_NCONTINUE(key)+recptr-2] + KY_NLINES
+ do i = nckeys, nokeys
+ call realloc (Memi[KY_PTRS(key)+i-1],
+ Memi[KY_NCONTINUE(key)+recptr-2] *
+ Memi[KY_KINDICES(key)+i-1], TY_CHAR)
+ }
+
+ do i = nckeys, nkeys {
+ len = Memi[KY_KINDICES(key)+i-1]
+ if ((i == field) && (element == ncontinue)) {
+ call amovc (line[cip], value, len)
+ value[len+1] = EOS
+ }
+ Memi[KY_NELEMS(key)+i-1] = ncontinue
+ cip = cip + len
+ }
+ }
+end
+
+
+# PT_COLSORT -- Sort the column.
+
+procedure pt_colsort (colptr, colindex, nrecs, coltype)
+
+pointer colptr # array of column pointers
+int colindex[ARB] # column indices
+int nrecs # number of records
+int coltype # column type
+
+begin
+ # Sort the column.
+ switch (coltype) {
+ case TY_INT:
+ call pt_qsorti (Memi[colptr], colindex, colindex, nrecs)
+ case TY_REAL:
+ call pt_qsortr (Memr[colptr], colindex, colindex, nrecs)
+ case TY_CHAR:
+ call strsrt (colindex, Memc[colptr], nrecs)
+ case TY_BOOL:
+ call pt_qsortb (Memb[colptr], colindex, colindex, nrecs)
+ }
+end
+
+
+# PT_REORDER -- Reorder the input file and write it to the output file.
+
+procedure pt_reorder (tp_in, tp_out, recmap, colindex, nrecs)
+
+int tp_in # input table file descriptor
+int tp_out # output file descriptor
+int recmap[ARB] # record strucuture map
+int colindex[ARB] # column index
+int nrecs # number of records
+
+int i
+long lptr
+pointer sp, line
+
+begin
+ call smark (sp)
+ call salloc (line, SZ_LINE, TY_CHAR)
+
+ do i = 1, nrecs {
+ lptr = recmap[colindex[i]]
+ call seek (tp_in, lptr)
+ call pt_rwrecord (tp_in, tp_out, Memc[line])
+ }
+
+ call sfree (sp)
+end
+
+
+# PT_GSRT -- Decode the column to be sorted.
+
+procedure pt_gsrt (value, colptr, coltype, colwidth, record)
+
+char value[ARB] # value to be decoded
+pointer colptr # pointer to the decode column
+int coltype # the data type of the sort column
+int colwidth # width of the column
+int record # the current record number
+
+int ip
+int ctoi(), ctor(), ctowrd()
+
+begin
+ # Decode the output value.
+ ip = 1
+ switch (coltype) {
+ case TY_INT:
+ if (ctoi (value, ip, Memi[colptr+record-1]) <= 0)
+ Memi[colptr+record-1] = INDEFI
+ case TY_REAL:
+ if (ctor (value, ip, Memr[colptr+record-1]) <= 0)
+ Memr[colptr+record-1] = INDEFR
+ case TY_BOOL:
+ while (IS_WHITE(value[ip]))
+ ip = ip + 1
+ switch (value[ip]) {
+ case 'Y', 'y':
+ Memb[colptr+record-1] = true
+ case 'N', 'n':
+ Memb[colptr+record-1] = false
+ default:
+ Memb[colptr+record-1] = false
+ }
+ case TY_CHAR:
+ if (ctowrd (value, ip, Memc[colptr+(record-1)*colwidth],
+ colwidth) <= 0)
+ Memc[colptr+(record-1)*colwidth] = EOS
+ default:
+ ;
+ }
+end
+
+
+# PT_FLIPI -- Filp an integer array in place.
+
+procedure pt_flipi (a, npix)
+
+int a[ARB] # array to be flipped
+int npix # number of pixels
+
+int i, nhalf, ntotal, itemp
+
+begin
+ nhalf = npix / 2
+ ntotal = npix + 1
+ do i = 1, nhalf {
+ itemp = a[i]
+ a[i] = a[ntotal-i]
+ a[ntotal-i] = itemp
+ }
+end
+
+
+# PT_RWRECORD -- Read a text record and write it out to the output file.
+
+procedure pt_rwrecord (tp_in, tp_out, line)
+
+int tp_in # input file descriptor
+int tp_out # output file descriptor
+char line[ARB] # line buffer
+
+int nchars
+int getline()
+
+begin
+ nchars = getline (tp_in, line)
+ while (nchars != EOF) {
+ call putline (tp_out, line)
+ if (line[nchars-1] != KY_CHAR_CONT)
+ break
+ nchars = getline (tp_in, line)
+ }
+end
diff --git a/noao/digiphot/ptools/txtools/ptxcalc.x b/noao/digiphot/ptools/txtools/ptxcalc.x
new file mode 100644
index 00000000..5e3d07ac
--- /dev/null
+++ b/noao/digiphot/ptools/txtools/ptxcalc.x
@@ -0,0 +1,255 @@
+include <ctype.h>
+include <error.h>
+include <evexpr.h>
+include "../../lib/ptkeysdef.h"
+
+define LEN_LONGLINE 10
+
+# PT_XCALC -- Edit a field in a record using a value expression and a
+# a selection expression.
+
+int procedure pt_xcalc (tp_in, tp_out, field, value, expr)
+
+int tp_in # the input text file descriptor
+int tp_out # the output text file descriptor
+char field[ARB] # field to be edited
+char value[ARB] # the new value expression
+char expr[ARB] # the expression to be evaluated
+
+bool oexpr
+int first_rec, nunique, uunique, funique, fieldno, fieldtype, fieldlen
+int elem, record, editall, ncontinue, recptr, nchars, buflen, lenrecord
+int offset, fieldptr
+pointer key, lline, o, v, sp, line, name, newvalue, fmtstr
+
+bool streq()
+extern pt_getop()
+int getline(), strncmp(), pt_kstati(), pt_fmkrec()
+pointer evexpr(), locpr()
+errchk evexpr(), locpr(), pt_getop()
+
+begin
+ # Get some working space.
+ call smark (sp)
+ call salloc (line, SZ_LINE, TY_CHAR)
+ call salloc (name, SZ_FNAME, TY_CHAR)
+ call salloc (newvalue, SZ_FNAME, TY_CHAR)
+ call salloc (fmtstr, SZ_FNAME, TY_CHAR)
+
+ # Initialize keyword structure.
+ call pt_kyinit (key)
+
+ # Initialize the file read.
+ first_rec = YES
+ nunique = 0
+ uunique = 0
+ funique = 0
+ record = 0
+
+ # Initialize the buffers.
+ buflen = LEN_LONGLINE * SZ_LINE
+ call malloc (lline, buflen, TY_CHAR)
+
+ # Initilize the record read.
+ ncontinue = 0
+ recptr = 1
+ fieldptr = 0
+
+ # Initialize the expression decoding.
+ o = NULL
+ if (streq (expr, "yes") || streq (expr, "YES"))
+ editall = YES
+ else
+ editall = NO
+ v = NULL
+
+ # Loop over the text file records.
+ repeat {
+
+ # Read in a line of the text file.
+ nchars = getline (tp_in, Memc[line])
+ if (nchars == EOF)
+ break
+
+ # Determine the type of record.
+ if (Memc[line] == KY_CHAR_POUND) {
+
+ if (strncmp (Memc[line], KY_CHAR_KEYWORD, KY_LEN_STR) == 0) {
+ call pt_kyadd (key, Memc[line], nchars)
+ call putline (tp_out, Memc[line])
+ } else if (strncmp (Memc[line], KY_CHAR_NAME,
+ KY_LEN_STR) == 0) {
+ nunique = nunique + 1
+ call pt_kname (key, Memc[line], nchars, nunique)
+ call putline (tp_out, Memc[line])
+ } else if (strncmp (Memc[line], KY_CHAR_UNITS,
+ KY_LEN_STR) == 0) {
+ uunique = uunique + 1
+ call pt_knunits (key, Memc[line], nchars, uunique)
+ call putline (tp_out, Memc[line])
+ } else if (strncmp (Memc[line], KY_CHAR_FORMAT,
+ KY_LEN_STR) == 0) {
+ funique = funique + 1
+ call pt_knformats (key, Memc[line], nchars, funique)
+ call putline (tp_out, Memc[line])
+ } else {
+ # skip lines beginning with # sign
+ call putline (tp_out, Memc[line])
+ }
+
+ } else if (Memc[line] == KY_CHAR_NEWLINE) {
+ # skip blank lines
+ call putline (tp_out, Memc[line])
+
+ } else {
+
+ # Set the record size and set the column to be altered.
+ if (recptr == 1) {
+ lenrecord = nchars
+ if (first_rec == YES) {
+ call pt_kid (field, Memc[name], elem)
+ fieldno = pt_kstati (key, Memc[name], KY_INDEX)
+ if (fieldno <= 0) {
+ call eprintf (
+ "Cannot find field %s in input file\n")
+ call pargstr (Memc[name])
+ break
+ }
+ fieldtype = pt_kstati (key, Memc[name], KY_DATATYPE)
+ if (fieldtype != TY_INT && fieldtype != TY_REAL) {
+ call eprintf ("Field %s is not numeric\n")
+ call pargstr (Memc[name])
+ break
+ }
+ fieldlen = pt_kstati (key, Memc[name], KY_LENGTH)
+ call pt_kstats (key, Memc[name], KY_FMTSTR,
+ Memc[fmtstr], SZ_FNAME)
+ }
+ } else
+ lenrecord = lenrecord + nchars
+
+ # Build the record.
+ offset = pt_fmkrec (key, fieldno, elem, Memc[line],
+ nchars, first_rec, recptr, ncontinue)
+ if (offset > 0)
+ fieldptr = lenrecord - nchars + offset
+
+ # Reallocate the temporary record space if necessary.
+ if (lenrecord > buflen) {
+ buflen = buflen + SZ_LINE
+ call realloc (lline, buflen, TY_CHAR)
+ }
+
+ # Store the record.
+ call amovc (Memc[line], Memc[lline+lenrecord-nchars], nchars)
+ Memc[lline+lenrecord] = EOS
+
+ # Do the record bookkeeping.
+ if (Memc[line+nchars-2] != KY_CHAR_CONT) {
+
+ # Evaluate the value and selection expression.
+ iferr {
+
+ if (editall == NO) {
+ call pt_apset (key)
+ o = evexpr (expr, locpr (pt_getop), 0)
+ if (O_TYPE(o) != TY_BOOL)
+ call error (0,
+ "Selection expression must be a boolean")
+ oexpr = O_VALB(o)
+ } else
+ oexpr = true
+
+ if (oexpr) {
+ call pt_apset (key)
+ v = evexpr (value, locpr (pt_getop), 0)
+ switch (fieldtype) {
+ case TY_BOOL:
+ if (O_TYPE(v) != TY_BOOL) {
+ call error (0,
+ "Value must be a boolean expression")
+ } else if (fieldptr > 0) {
+ call sprintf (Memc[newvalue], fieldlen,
+ Memc[fmtstr])
+ call pargb (O_VALB(v))
+ call amovc (Memc[newvalue],
+ Memc[lline+fieldptr-1], fieldlen)
+ }
+ case TY_INT:
+ if (O_TYPE(v) != TY_INT) {
+ call error (0,
+ "Value must be an integer expression")
+ } else if (fieldptr > 0) {
+ call sprintf (Memc[newvalue], fieldlen,
+ Memc[fmtstr])
+ call pargi (O_VALI(v))
+ call amovc (Memc[newvalue],
+ Memc[lline+fieldptr-1], fieldlen)
+ }
+ case TY_REAL:
+ if (O_TYPE(v) != TY_REAL) {
+ call error (0,
+ "Value must be a real expression")
+ } else if (fieldptr > 0) {
+ call sprintf (Memc[newvalue], fieldlen,
+ Memc[fmtstr])
+ call pargr (O_VALR(v))
+ call amovc (Memc[newvalue],
+ Memc[lline+fieldptr-1], fieldlen)
+ }
+ case TY_CHAR:
+ if (O_TYPE(v) != TY_CHAR) {
+ call error (0,
+ "Value must be a string expression")
+ } else if (fieldptr > 0) {
+ call sprintf (Memc[newvalue], fieldlen,
+ Memc[fmtstr])
+ call pargstr (O_VALC(v))
+ call amovc (Memc[newvalue],
+ Memc[lline+fieldptr-1], fieldlen)
+ }
+ default:
+ call error (0,
+ "Value expression is undefined")
+ }
+ }
+
+ } then {
+ call erract (EA_WARN)
+ call error (0,
+ "Error evaluating the value expression")
+ }
+
+ # Write out the record.
+ call putline (tp_out, Memc[lline])
+
+ # Increment the record counter.
+ record = record + 1
+ first_rec = NO
+
+ # Reinitialize the record read.
+ ncontinue = 0
+ recptr = 1
+ fieldptr = 0
+ if (o != NULL) {
+ call xev_freeop (o)
+ call mfree (o, TY_STRUCT)
+ }
+ o = NULL
+ if (v != NULL) {
+ call xev_freeop (v)
+ call mfree (v, TY_STRUCT)
+ }
+ v = NULL
+ }
+ }
+
+ }
+
+ # Cleanup.
+ call mfree (lline, TY_CHAR)
+ call sfree (sp)
+ call pt_kyfree (key)
+
+ return (record)
+end
diff --git a/noao/digiphot/ptools/txtools/ptxdump.x b/noao/digiphot/ptools/txtools/ptxdump.x
new file mode 100644
index 00000000..5d98f1e3
--- /dev/null
+++ b/noao/digiphot/ptools/txtools/ptxdump.x
@@ -0,0 +1,421 @@
+include <fset.h>
+include <error.h>
+include <evexpr.h>
+include "../../lib/ptkeysdef.h"
+
+# PT_XDUMP -- Procedure to select records from a text file in apphot/daophot
+# format. This procedure reads through an apphot/daophot output file line by
+# line. The lines preceded by #K define the task parameters. These are
+# fields which do not often change during the execution of an apphot/daophot
+# task. The lines beginning with #N describe the fields in the output
+# record which change for each star. The lines beginning with #U describe
+# the units of each field, while those beginning with #F describe the format
+# of each field. Blank lines and lines beginning with # are ignored.
+
+procedure pt_xdump (fd, fields, expr, headers, parameters)
+
+int fd # text file descriptor
+char fields[ARB] # fields to be output
+char expr[ARB] # boolean expression to be evaluated
+int headers # format the output file ?
+int parameters # dump the parameters ?
+
+bool oexpr
+int nchars, nunique, uunique, funique, ncontinue, first_rec, recptr
+int nselect, szbuf, nmove, printall
+pointer sp, line, key, outline, o
+
+bool streq()
+extern pt_getop()
+int fstati(), getline(), strncmp(), pt_kszselbuf, pt_fmt(), pt_ffmt()
+pointer pt_choose(), evexpr(), locpr()
+errchk evexpr (), pt_getop()
+
+begin
+ # If the output has been redirected do not flush on a newline.
+ if (fstati (STDOUT, F_REDIR) == NO)
+ call fseti (STDOUT, F_FLUSHNL, YES)
+
+ # Allocate temporary space and space for the keyword structure.
+ call smark (sp)
+ call salloc (line, SZ_LINE, TY_CHAR)
+ call pt_kyinit (key)
+
+ # Initialize counters.
+ nunique = 0
+ uunique = 0
+ funique = 0
+
+ # Setup the record counters. First_rec is set to NO after the first
+ # record is read. A record usually consists of several lines of text.
+ # A '\' in column 80 indicats that the current line is a part of
+ # the previous record. If there is a blank in column 80 the current
+ # line terminates the current record. In some cases the fields of a
+ # record may have more than one value, for example the magnitude field.
+ # These lines are marked by a '*\' in columns 79 and 80 respectively.
+
+ # The variable first_rec is set to NO after the first record is read.
+ # The variable recptr maintains a counter of the number of unique
+ # lines there are in a given record while ncontinue maintains a count
+ # of the number of times a given portion of the record is repeated.
+
+ # Initialize the record reading.
+ outline = NULL
+ first_rec = YES
+ recptr = 1
+ ncontinue = 0
+
+ # Initialize the expression decoding.
+ o = NULL
+ if (streq (expr, "yes")) {
+ oexpr = true
+ printall = YES
+ } else {
+ oexpr = false
+ printall = NO
+ }
+
+ # Loop over the text file records.
+ nchars = getline (fd, Memc[line])
+ while (nchars != EOF) {
+
+ # Determine the type of record. Add keywords to the database.
+ if (Memc[line] == KY_CHAR_POUND) {
+
+ if (strncmp (Memc[line], KY_CHAR_KEYWORD, KY_LEN_STR) == 0) {
+ call pt_kyadd (key, Memc[line], nchars)
+ if (headers == YES && parameters == YES)
+ call putline (STDOUT, Memc[line])
+ } else if (strncmp (Memc[line], KY_CHAR_NAME,
+ KY_LEN_STR) == 0) {
+ nunique = nunique + 1
+ call pt_kname (key, Memc[line], nchars, nunique)
+ } else if (strncmp (Memc[line], KY_CHAR_UNITS,
+ KY_LEN_STR) == 0) {
+ uunique = uunique + 1
+ call pt_knunits (key, Memc[line], nchars, uunique)
+ } else if (strncmp (Memc[line], KY_CHAR_FORMAT,
+ KY_LEN_STR) == 0) {
+ funique = funique + 1
+ call pt_knformats (key, Memc[line], nchars, funique)
+ } else if (headers == YES && parameters == YES) {
+ if (nunique == 0 || nunique != uunique || nunique !=
+ funique)
+ call putline (STDOUT, Memc[line])
+ }
+
+ } else if (Memc[line] == KY_CHAR_NEWLINE) {
+ # Skip lines beginning with a newline
+
+ } else {
+
+ # Construct the record. This routine is called repeatedly
+ # until a record without the continuation character is
+ # encountered.
+
+ call pt_mkrec (key, Memc[line], nchars, first_rec, recptr,
+ ncontinue)
+
+ # Construct the output record when there is no terminating
+ # continuation char.
+ if (Memc[line+nchars-2] != KY_CHAR_CONT) {
+
+ # Select the appropriate records and compute the size of
+ # the output buffer. This routine only needs to be called
+ # once.
+
+ if (outline == NULL) {
+ nselect = pt_choose (key, fields)
+ if (nselect <= 0)
+ break
+ szbuf = pt_kszselbuf (key)
+ call malloc (outline, szbuf, TY_CHAR)
+ } else
+ Memc[outline] = EOS
+
+ # Evaluate the expression.
+ iferr {
+ if (printall == NO) {
+ call pt_apset (key)
+ o = evexpr (expr, locpr (pt_getop), 0)
+ if (O_TYPE(o) != TY_BOOL)
+ call error (0, "Expression must be a boolean")
+ oexpr = O_VALB(o)
+ }
+ } then {
+ call erract (EA_WARN)
+ call error (0, "Error evaluating selection expression")
+ }
+
+ if (first_rec == YES && headers == YES) {
+ call pt_fnstr (key, Memc[outline], szbuf)
+ call putline (STDOUT, Memc[outline])
+ call pt_fustr (key, Memc[outline], szbuf)
+ call putline (STDOUT, Memc[outline])
+ call pt_ffstr (key, Memc[outline], szbuf)
+ call putline (STDOUT, Memc[outline])
+ call putline (STDOUT, "#\n")
+ }
+
+ # Construct the output record.
+ if (oexpr) {
+ if (headers == YES)
+ nmove = pt_fmt (key, Memc[outline], szbuf)
+ else
+ nmove = pt_ffmt (key, Memc[outline], szbuf)
+ if (nmove > 0)
+ call putline (STDOUT, Memc[outline])
+ }
+
+ # Get ready for next record.
+ first_rec = NO
+ recptr = 1
+ ncontinue = 0
+ if (o != NULL) {
+ call xev_freeop (o)
+ call mfree (o, TY_STRUCT)
+ }
+ }
+ }
+
+ # Read the next line.
+ nchars = getline (fd, Memc[line])
+ }
+
+ # Free space.
+ call pt_kyfree (key)
+ if (outline != NULL)
+ call mfree (outline, TY_CHAR)
+ call sfree (sp)
+end
+
+
+# PT_FMT -- Procedure to format an apphot/daophot output record.
+
+int procedure pt_fmt (key, line, szbuf)
+
+pointer key # pointer to keys strucuture
+char line[ARB] # output line
+int szbuf # maximum buffer size
+
+char blank
+int i, op, kip, nk, index, elem, maxch
+data blank /' '/
+
+begin
+ # Add leading three blanks.
+ call strcpy (" ", line[1], 3)
+
+ # Move records.
+ op = 4
+ do i = 1, KY_NSELECT(key) {
+
+ # Find the key.
+ index = Memi[KY_SELECT(key)+i-1]
+ elem = Memi[KY_ELEM_SELECT(key)+i-1]
+ maxch = Memi[KY_LEN_SELECT(key)+i-1]
+ kip = Memi[KY_PTRS(key)+index-1] + (elem - 1) * maxch
+
+ # Trim leading whitespace.
+ for (nk = 0; Memc[kip] == ' ' && nk < maxch; nk = nk + 1)
+ kip = kip + 1
+
+ # Check the buffer size.
+ if ((op + maxch) >= szbuf)
+ break
+
+ # Copy value to output buffer.
+ call amovc (Memc[kip], line[op], maxch - nk)
+ op = op + maxch - nk
+ call amovkc (blank, line[op], nk)
+ op = op + nk
+ }
+
+ line[op] = '\n'
+ line[op+1] = EOS
+ return (op)
+end
+
+
+# PT_FFMT -- Procedure to free format an apphot output record.
+
+int procedure pt_ffmt (key, line, szbuf)
+
+pointer key # pointer to keys strucuture
+char line[ARB] # output line
+int szbuf # size of the output buffer
+
+int i, op, kip, nk, index, elem, maxch
+
+begin
+ op = 1
+ do i = 1, KY_NSELECT(key) {
+
+ # Find the key.
+ index = Memi[KY_SELECT(key)+i-1]
+ elem = Memi[KY_ELEM_SELECT(key)+i-1]
+ maxch = Memi[KY_LEN_SELECT(key)+i-1]
+ kip = Memi[KY_PTRS(key)+index-1] + (elem - 1) * maxch
+
+ # Trim leading whitespace.
+ for (nk = 0; Memc[kip] == ' ' && nk < maxch; nk = nk + 1)
+ kip = kip + 1
+
+ # Trim trailing whitesapce.
+ for (nk = 0; Memc[kip+nk] != ' ' && nk < maxch; nk = nk + 1)
+ ;
+
+ # Check buffer space.
+ if ((op + nk + 2) >= szbuf)
+ break
+
+ # Copy value to output buffer.
+ call amovc (Memc[kip], line[op], nk)
+ op = op + nk
+ line[op] = ' '
+ op = op + 1
+ line[op] = ' '
+ op = op + 1
+ }
+
+ if (op > 1) {
+ line[op-2] = '\n'
+ line[op-1] = EOS
+ return (op - 2)
+ } else {
+ line[1] = EOS
+ return (0)
+ }
+end
+
+
+# PT_FNSTR -- Format an apphot/daophot selected name string.
+
+procedure pt_fnstr (key, line, maxline)
+
+pointer key # pointer to keys strucuture
+char line[ARB] # output line
+int maxline # add new line every max lines
+
+int op, nchars
+int gstrcpy()
+
+begin
+ # Add leading three characters.
+ call strcpy (KY_CHAR_NAME, line[1], KY_LEN_STR)
+
+ # Copy the selected name string.
+ op = KY_LEN_STR + 1
+ nchars = gstrcpy (Memc[KY_NAME_SELECT(key)], line[op], maxline -
+ KY_LEN_STR)
+
+ # Add the newline and EOS character.
+ op = op + nchars
+ line[op] = '\n'
+ line[op+1] = EOS
+end
+
+
+# PT_FUSTR -- Format an apphot/daophot selected units string.
+
+procedure pt_fustr (key, line, maxline)
+
+pointer key # pointer to keys strucuture
+char line[ARB] # output line
+int maxline # add new line every max lines
+
+int op, nchars
+int gstrcpy()
+
+begin
+ # Add leading three blanks.
+ op = 1
+ call strcpy (KY_CHAR_UNITS, line[op], KY_LEN_STR)
+
+ # Copy the selected name string.
+ op = KY_LEN_STR + 1
+ nchars = gstrcpy (Memc[KY_UNIT_SELECT(key)], line[op], maxline -
+ KY_LEN_STR)
+
+ # Add the newline and EOS character.
+ op = op + nchars
+ line[op] = '\n'
+ line[op+1] = EOS
+end
+
+
+# PT_FFSTR -- Format an apphot selected format string.
+
+procedure pt_ffstr (key, line, maxline)
+
+pointer key # pointer to keys strucuture
+char line[ARB] # output line
+int maxline # add new line every max lines
+
+char ctype
+int fwidth, prec, type, op, nchars
+pointer sp, format
+int pt_kyfstr(), gstrcpy()
+
+begin
+ fwidth = Memi[KY_LEN_SELECT(key)]
+ call smark (sp)
+ call salloc (format, fwidth, TY_CHAR)
+
+ # Adjust the format of the first field to correct for the three
+ # blanks.
+ call strcpy (Memc[KY_FMT_SELECT(key)], Memc[format], fwidth)
+ if (pt_kyfstr (Memc[format], fwidth, prec, type, ctype) != ERR) {
+ if (type == TY_REAL) {
+ Memc[format] = '%'
+ call sprintf (Memc[format+1], fwidth - 1, "%d.%d%c%*t")
+ call pargi (-(fwidth+KY_LEN_STR))
+ call pargi (prec)
+ call pargc (ctype)
+ call pargi (fwidth)
+ } else {
+ Memc[format] = '%'
+ call sprintf (Memc[format+1], fwidth - 1, "%d%c%*t")
+ call pargi (-(fwidth+KY_LEN_STR))
+ call pargc (ctype)
+ call pargi (fwidth)
+ }
+ call amovc (Memc[format], Memc[KY_FMT_SELECT(key)], fwidth)
+ }
+
+ # Add leading three blanks.
+ op = 1
+ call strcpy (KY_CHAR_FORMAT, line[op], KY_LEN_STR)
+
+ # Copy the selected name string.
+ op = KY_LEN_STR + 1
+ nchars = gstrcpy (Memc[KY_FMT_SELECT(key)], line[op], maxline -
+ KY_LEN_STR)
+
+ # Add the newline and EOS character.
+ op = op + nchars
+ line[op] = '\n'
+ line[op+1] = EOS
+
+ call sfree (sp)
+end
+
+
+# PT_KSZSELBUF -- Compute the buffer size required to hold the output selected
+# line.
+
+int procedure pt_kszselbuf (key)
+
+pointer key # pointer to the keyword structure
+
+int i, szbuf
+
+begin
+ szbuf = 0
+
+ do i = 1, KY_NSELECT(key)
+ szbuf = szbuf + Memi[KY_LEN_SELECT(key)+i-1] + 2
+ szbuf = szbuf + 4
+
+ return (szbuf)
+end
diff --git a/noao/digiphot/ptools/txtools/ptxselect.x b/noao/digiphot/ptools/txtools/ptxselect.x
new file mode 100644
index 00000000..77990909
--- /dev/null
+++ b/noao/digiphot/ptools/txtools/ptxselect.x
@@ -0,0 +1,160 @@
+include <ctype.h>
+include <error.h>
+include <evexpr.h>
+include "../../lib/ptkeysdef.h"
+
+define LEN_LONGLINE 10
+
+# PT_XSELECT -- Select records based on evaluating a logical expression.
+
+int procedure pt_xselect (tp_in, tp_out, expr)
+
+int tp_in # the input text file descriptor
+int tp_out # the output text file descriptor
+char expr[ARB] # the expression to be evaluated
+
+bool oexpr
+int first_rec, nunique, uunique, funique, record, printall
+int ncontinue, recptr, nchars, buflen, lenrecord
+pointer key, line, lline, o
+
+bool streq()
+extern pt_getop()
+int getline(), strncmp()
+pointer evexpr(), locpr()
+errchk evexpr(), pt_getop()
+
+begin
+ # Initialize keyword structure.
+ call pt_kyinit (key)
+
+ # Initialize the file read.
+ first_rec = YES
+ nunique = 0
+ uunique = 0
+ funique = 0
+ record = 0
+
+ # Initialize the buffers.
+ buflen = LEN_LONGLINE * SZ_LINE
+ call malloc (line, SZ_LINE, TY_CHAR)
+ call malloc (lline, buflen, TY_CHAR)
+
+ # Initilize the record read.
+ ncontinue = 0
+ recptr = 1
+
+ # Initialize the expression decoding.
+ o = NULL
+ if (streq (expr, "yes")) {
+ oexpr = true
+ printall = YES
+ } else {
+ oexpr = false
+ printall = NO
+ }
+
+ # Loop over the text file records.
+ repeat {
+
+ # Read in a line of the text file.
+ nchars = getline (tp_in, Memc[line])
+ if (nchars == EOF)
+ break
+
+ # Determine the type of record.
+ if (Memc[line] == KY_CHAR_POUND) {
+
+ if (strncmp (Memc[line], KY_CHAR_KEYWORD, KY_LEN_STR) == 0) {
+ call pt_kyadd (key, Memc[line], nchars)
+ call putline (tp_out, Memc[line])
+ } else if (strncmp (Memc[line], KY_CHAR_NAME,
+ KY_LEN_STR) == 0) {
+ nunique = nunique + 1
+ call pt_kname (key, Memc[line], nchars, nunique)
+ call putline (tp_out, Memc[line])
+ } else if (strncmp (Memc[line], KY_CHAR_UNITS,
+ KY_LEN_STR) == 0) {
+ uunique = uunique + 1
+ call pt_knunits (key, Memc[line], nchars, uunique)
+ call putline (tp_out, Memc[line])
+ } else if (strncmp (Memc[line], KY_CHAR_FORMAT,
+ KY_LEN_STR) == 0) {
+ funique = funique + 1
+ call pt_knformats (key, Memc[line], nchars, funique)
+ call putline (tp_out, Memc[line])
+ } else {
+ # skip lines beginning with # sign
+ call putline (tp_out, Memc[line])
+ }
+
+ } else if (Memc[line] == KY_CHAR_NEWLINE) {
+ # skip blank lines
+ call putline (tp_out, Memc[line])
+
+ } else {
+
+ # Reset the record size.
+ if (recptr == 1)
+ lenrecord = nchars
+ else
+ lenrecord = lenrecord + nchars
+
+ # Build the record.
+ call pt_mkrec (key, Memc[line], nchars, first_rec, recptr,
+ ncontinue)
+
+ # Reallocate the temporary record space.
+ if (lenrecord > buflen) {
+ buflen = buflen + SZ_LINE
+ call realloc (lline, buflen, TY_CHAR)
+ }
+
+ # Store the record.
+ call amovc (Memc[line], Memc[lline+lenrecord-nchars], nchars)
+ Memc[lline+lenrecord] = EOS
+
+ # Do the record bookkeeping.
+ if (Memc[line+nchars-2] != KY_CHAR_CONT) {
+
+ # Evaluate the expression.
+ iferr {
+ if (printall == NO) {
+ call pt_apset (key)
+ o = evexpr (expr, locpr (pt_getop), 0)
+ if (O_TYPE(o) != TY_BOOL)
+ call error (0, "Expression must be a boolean")
+ oexpr = O_VALB(o)
+ }
+ } then {
+ call erract (EA_WARN)
+ call error (0, "Error evaluating selection expression")
+ }
+
+ # Write out the expression.
+ if (oexpr)
+ call putline (tp_out, Memc[lline])
+
+ # Increment the record counter.
+ record = record + 1
+ first_rec = NO
+
+ # Reinitialize the record read.
+ ncontinue = 0
+ recptr = 1
+ if (o != NULL) {
+ call xev_freeop (o)
+ call mfree (o, TY_STRUCT)
+ }
+ }
+ }
+
+ }
+
+ # Cleanup.
+ call mfree (line, TY_CHAR)
+ call mfree (lline, TY_CHAR)
+ call pt_kyfree (key)
+
+ return (record)
+end
diff --git a/noao/digiphot/ptools/txtools/t_txcalc.x b/noao/digiphot/ptools/txtools/t_txcalc.x
new file mode 100644
index 00000000..2c7c39db
--- /dev/null
+++ b/noao/digiphot/ptools/txtools/t_txcalc.x
@@ -0,0 +1,65 @@
+include <fset.h>
+
+# T_TXCALC -- Edit a field in an APPHOT/DAOPHOT text data base using a
+# value expression.
+
+procedure t_txcalc ()
+
+pointer infile # the input file list
+pointer outfile # the output file list
+pointer field # pointer to the field to be edited
+pointer value # pointer to the value expression string
+
+int inlist, tp_in, tp_out, nrecs
+pointer sp
+int clpopnu(), access(), open(), fstati(), clgfil(), pt_xcalc()
+
+begin
+ # Set the standard output to flush on newline.
+ if (fstati (STDOUT, F_REDIR) == NO)
+ call fseti (STDOUT, F_FLUSHNL, YES)
+
+ # Get some memory.
+ call smark (sp)
+ call salloc (infile, SZ_FNAME, TY_CHAR)
+ call salloc (outfile, SZ_FNAME, TY_CHAR)
+ call salloc (field, SZ_FNAME, TY_CHAR)
+ call salloc (value, SZ_LINE, TY_CHAR)
+
+ # Get the various task parameters.
+ inlist = clpopnu ("textfiles")
+ #outlist = clpopnu ("outfiles")
+ call clgstr ("field", Memc[field], SZ_FNAME)
+ call strupr (Memc[field])
+ call clgstr ("value", Memc[value], SZ_LINE)
+
+ while (clgfil (inlist, Memc[infile], SZ_FNAME) != EOF) {
+
+ # Open the input file.
+ if (access (Memc[infile], 0, TEXT_FILE) == YES)
+ tp_in = open (Memc[infile], READ_ONLY, TEXT_FILE)
+ else
+ call error (0, "The input file is a binary file.")
+
+ # Open an output text file.
+ call mktemp ("temp", Memc[outfile], SZ_FNAME)
+ tp_out = open (Memc[outfile], NEW_FILE, TEXT_FILE)
+
+ # Select the stars.
+ nrecs = pt_xcalc (tp_in, tp_out, Memc[field], Memc[value], "yes")
+
+ # Close up the input and output files.
+ call close (tp_in)
+ call close (tp_out)
+
+ if (nrecs <= 0) {
+ call delete (Memc[outfile])
+ } else {
+ call delete (Memc[infile])
+ call rename (Memc[outfile], Memc[infile])
+ }
+ }
+
+ call clpcls (inlist)
+ call sfree (sp)
+end
diff --git a/noao/digiphot/ptools/txtools/t_txconcat.x b/noao/digiphot/ptools/txtools/t_txconcat.x
new file mode 100644
index 00000000..cae8354b
--- /dev/null
+++ b/noao/digiphot/ptools/txtools/t_txconcat.x
@@ -0,0 +1,128 @@
+include <fset.h>
+include <error.h>
+include "../../lib/ptkeysdef.h"
+
+# T_TXCONCAT -- Procedure to concatenate standard APPHOT and DAOPHOT text
+# output files into a single file. The task checks to see that the list
+# of input files was produced by the same task.
+
+procedure t_txconcat()
+
+int list # input file list descriptor
+int tp_in # input file descriptor
+int tp_out # output file descriptor
+
+int len_list, first_file, stat
+pointer sp, infile, outfile, task, task1, task2
+int fstati(), clpopnu(), clplen(), open(), clgfil(), strncmp()
+
+begin
+ # Set the standard output to flush on newline.
+ if (fstati (STDOUT, F_REDIR) == NO)
+ call fseti (STDOUT, F_FLUSHNL, YES)
+
+ # Get some memory.
+ call smark (sp)
+ call salloc (infile, SZ_FNAME, TY_CHAR)
+ call salloc (outfile, SZ_FNAME, TY_CHAR)
+ call salloc (task, SZ_FNAME, TY_CHAR)
+ call salloc (task1, SZ_FNAME, TY_CHAR)
+ call salloc (task2, SZ_FNAME, TY_CHAR)
+
+ # Get the task parameters.
+ list = clpopnu ("textfiles")
+ len_list = clplen (list)
+ if (len_list <= 0)
+ call error (0, "Empty input file list.\n")
+ else if (len_list == 1)
+ call error (0, "Input file list has only one file.\n")
+ call clgstr ("outfile", Memc[outfile], SZ_FNAME)
+ call clgstr ("task", Memc[task], SZ_FNAME)
+
+ # Loop over the input files to check the task keyword.
+ first_file = YES
+ stat = OK
+ while (clgfil (list, Memc[infile], SZ_FNAME) != EOF) {
+ tp_in = open (Memc[infile], READ_ONLY, TEXT_FILE)
+ if (first_file == YES) {
+ call pt_gtaskname (tp_in, Memc[task], Memc[task1], SZ_FNAME)
+ if (Memc[task1] == EOS) {
+ call eprintf (
+ "File: %s is not an APPHOT/DAOPHOT text database file")
+ call pargstr (Memc[infile])
+ stat = ERR
+ }
+ first_file = NO
+ } else {
+ call pt_gtaskname (tp_in, Memc[task], Memc[task2], SZ_FNAME)
+ if (Memc[task2] == EOS) {
+ call eprintf (
+ "File: %s is not an APPHOT/DAOPHOT text database file\n")
+ call pargstr (Memc[infile])
+ stat = ERR
+ }
+ if (strncmp (Memc[task1], Memc[task2], SZ_FNAME) != 0) {
+ call eprintf (
+ "TASK keyword is not the same for all input files\n")
+ stat = ERR
+ }
+ }
+ call close (tp_in)
+ if (stat == ERR)
+ break
+ }
+ call clprew (list)
+
+ # Loop over the input text files and copy each file to the output
+ # file.
+ if (stat == OK) {
+ tp_out = open (Memc[outfile], NEW_FILE, TEXT_FILE)
+ while (clgfil (list, Memc[infile], SZ_FNAME) != EOF) {
+ tp_in = open (Memc[infile], READ_ONLY, TEXT_FILE)
+ call fcopyo (tp_in, tp_out)
+ call close (tp_in)
+ }
+ call close (tp_out)
+ }
+
+ call clpcls (list)
+ call sfree (sp)
+end
+
+
+# PT_GTASKNAME -- Fetch a task name from an APPHOT/DAOPHOT text file.
+
+procedure pt_gtaskname (tp_in, name, outname, maxch)
+
+int tp_in # input file descriptor
+char name[ARB] # task keyword
+char outname[ARB] # output task name
+int maxch # maximum number of characters
+
+int findex, lindex
+pointer sp, line
+int getline(), strncmp(), gstrmatch(), ctowrd()
+
+begin
+ call smark (sp)
+ call salloc (line, SZ_LINE, TY_CHAR)
+
+ outname[1] = EOS
+ while (getline (tp_in, Memc[line]) != EOF) {
+ if (Memc[line] != KY_CHAR_POUND)
+ break
+ if (strncmp (Memc[line], KY_CHAR_KEYWORD, KY_LEN_STR) != 0)
+ next
+ if (gstrmatch (Memc[line], name, findex, lindex) == 0)
+ next
+ lindex = lindex + 1
+ if (ctowrd (Memc[line], lindex, outname, maxch) <= 0)
+ break
+ lindex = lindex + 1
+ if (ctowrd (Memc[line], lindex, outname, maxch) <= 0)
+ outname[1] = EOS
+ break
+ }
+
+ call sfree (sp)
+end
diff --git a/noao/digiphot/ptools/txtools/t_txdump.x b/noao/digiphot/ptools/txtools/t_txdump.x
new file mode 100644
index 00000000..8d2b332e
--- /dev/null
+++ b/noao/digiphot/ptools/txtools/t_txdump.x
@@ -0,0 +1,45 @@
+# T_TXDUMP -- Procedure to perform a relational select operation upon a set of
+# records within a text file. Our function is to select all records from the
+# input file matching some criterion, printing the listed fields on the
+# standard output. Dumping the keywords and reheadersting is optional.
+
+procedure t_txdump ()
+
+pointer textfile # list of input text files
+pointer fields # list of fields to be dumped
+pointer expr # boolean expression to be evaluated
+int headers # format the output
+int parameters # print the headers
+
+int list, fd
+pointer sp
+bool clgetb()
+int clpopnu(), clgfil(), open(), btoi()
+
+begin
+ # Allocate working space.
+ call smark (sp)
+ call salloc (textfile, SZ_FNAME, TY_CHAR)
+ call salloc (fields, SZ_LINE, TY_CHAR)
+ call salloc (expr, SZ_LINE, TY_CHAR)
+
+ # Get the parameters.
+ list = clpopnu ("textfiles")
+ call clgstr ("fields", Memc[fields], SZ_LINE)
+ call strupr (Memc[fields])
+ call clgstr ("expr", Memc[expr], SZ_LINE)
+ headers = btoi (clgetb ("headers"))
+ parameters = btoi (clgetb ("parameters"))
+
+ # Select records.
+ while (clgfil (list, Memc[textfile], SZ_FNAME) != EOF) {
+ fd = open (Memc[textfile], READ_ONLY, TEXT_FILE)
+ if (Memc[fields] != EOS)
+ call pt_xdump (fd, Memc[fields], Memc[expr], headers,
+ parameters)
+ call close (fd)
+ }
+
+ call clpcls (list)
+ call sfree (sp)
+end
diff --git a/noao/digiphot/ptools/txtools/t_txrenumber.x b/noao/digiphot/ptools/txtools/t_txrenumber.x
new file mode 100644
index 00000000..2b41d541
--- /dev/null
+++ b/noao/digiphot/ptools/txtools/t_txrenumber.x
@@ -0,0 +1,65 @@
+include <fset.h>
+
+# T_TXRENUMBER -- Procedure to renumber standard APPHOT and DAOPHOT text
+# output files. The ST TTOOLS task can be used for binary format.
+# The program assumes that there is a column labelled ID.
+
+procedure t_txrenumber ()
+
+pointer tp_in # pointer to the input table
+pointer tp_out # pointer to the output table
+pointer id # name of the id column
+
+int inlist, nrecs, idoffset
+pointer sp, infile, outfile
+int clpopnu(), clgeti(), clgfil(), access(), open(), fstati(), pt_renumber()
+
+begin
+ # Set the standard output to flush on newline.
+ if (fstati (STDOUT, F_REDIR) == NO)
+ call fseti (STDOUT, F_FLUSHNL, YES)
+
+ # Get some memory.
+ call smark (sp)
+ call salloc (infile, SZ_FNAME, TY_CHAR)
+ call salloc (outfile, SZ_FNAME, TY_CHAR)
+ call salloc (id, SZ_FNAME, TY_CHAR)
+
+ # Get the various task parameters.
+ inlist = clpopnu ("textfiles")
+ idoffset = clgeti ("idoffset")
+ call clgstr ("id", Memc[id], SZ_FNAME)
+ call strlwr (Memc[id])
+
+ # Loop over the input files.
+ while (clgfil (inlist, Memc[infile], SZ_FNAME) != EOF) {
+
+ # Open the input file.
+ if (access (Memc[infile], 0, TEXT_FILE) == YES)
+ tp_in = open (Memc[infile], READ_ONLY, TEXT_FILE)
+ else
+ next
+
+ # Open an output text file.
+ call mktemp ("temp", Memc[outfile], SZ_FNAME)
+ tp_out = open (Memc[outfile], NEW_FILE, TEXT_FILE)
+
+ # Renumber the stars.
+ nrecs = pt_renumber (tp_in, tp_out, idoffset, Memc[id])
+
+ # Close up the input and output files.
+ call close (tp_in)
+ call close (tp_out)
+
+ # Rename the files.
+ if (nrecs <= 0)
+ call delete (Memc[outfile])
+ else {
+ call delete (Memc[infile])
+ call rename (Memc[outfile], Memc[infile])
+ }
+ }
+
+ call clpcls (inlist)
+ call sfree (sp)
+end
diff --git a/noao/digiphot/ptools/txtools/t_txselect.x b/noao/digiphot/ptools/txtools/t_txselect.x
new file mode 100644
index 00000000..3dee8a51
--- /dev/null
+++ b/noao/digiphot/ptools/txtools/t_txselect.x
@@ -0,0 +1,64 @@
+include <fset.h>
+
+# T_TXSELECT -- Select records from an APPHOT file based on the value of
+# a logical expression.
+
+procedure t_txselect ()
+
+int tp_in # input file descriptor
+int tp_out # output file descriptor
+pointer expr # pointer to the expression string
+
+int inlist, outlist
+pointer sp, infile, outfile
+int clpopnu(), clplen(), access(), open(), fstati(), clgfil(), pt_xselect()
+
+begin
+ # Set the standard output to flush on newline.
+ if (fstati (STDOUT, F_REDIR) == NO)
+ call fseti (STDOUT, F_FLUSHNL, YES)
+
+ # Get some memory.
+ call smark (sp)
+ call salloc (infile, SZ_FNAME, TY_CHAR)
+ call salloc (outfile, SZ_FNAME, TY_CHAR)
+ call salloc (expr, SZ_LINE, TY_CHAR)
+
+ # Get the various task parameters.
+ inlist = clpopnu ("textfiles")
+ outlist = clpopnu ("outfiles")
+ call clgstr ("expr", Memc[expr], SZ_LINE)
+
+ # Check that the input and output file lists have the
+ # same length.
+ if (clplen (inlist) != clplen (outlist))
+ call error (0,
+ "Input and output file lists are not the same length")
+
+ while ((clgfil (inlist, Memc[infile], SZ_FNAME) != EOF) &&
+ (clgfil (outlist, Memc[outfile], SZ_FNAME) != EOF)) {
+
+ # Open the input file.
+ if (access (Memc[infile], 0, TEXT_FILE) == YES)
+ tp_in = open (Memc[infile], READ_ONLY, TEXT_FILE)
+ else
+ call error (0, "The input file is a binary file.")
+
+ # Open an output text file.
+ tp_out = open (Memc[outfile], NEW_FILE, TEXT_FILE)
+
+ # Select the stars.
+ if (pt_xselect (tp_in, tp_out, Memc[expr]) <= 0) {
+ call eprintf ("File: %s is empty\n")
+ call pargstr (Memc[infile])
+ }
+
+ # Close up the input and output files.
+ call close (tp_in)
+ call close (tp_out)
+ }
+
+ call clpcls (inlist)
+ call clpcls (outlist)
+ call sfree (sp)
+end
diff --git a/noao/digiphot/ptools/txtools/t_txsort.x b/noao/digiphot/ptools/txtools/t_txsort.x
new file mode 100644
index 00000000..4635a881
--- /dev/null
+++ b/noao/digiphot/ptools/txtools/t_txsort.x
@@ -0,0 +1,65 @@
+include <fset.h>
+
+# T_TXSORT -- Procedure to sort standard APPHOT and DAOPHOT text
+# output files. The ST TTOOLS task can be used for binary format.
+
+procedure t_txsort ()
+
+int tp_in # input file descriptor
+int tp_out # input file descriptor
+
+int inlist, ascend, nrecs
+pointer sp, infile, outfile, column
+bool clgetb()
+int clpopnu(), clgfil(), access(), btoi(), open(), fstati(), pt_sortnum()
+
+begin
+ # Set the standard output to flush on newline.
+ if (fstati (STDOUT, F_REDIR) == NO)
+ call fseti (STDOUT, F_FLUSHNL, YES)
+
+ # Get some memory.
+ call smark (sp)
+ call salloc (infile, SZ_FNAME, TY_CHAR)
+ call salloc (outfile, SZ_FNAME, TY_CHAR)
+ call salloc (column, SZ_FNAME, TY_CHAR)
+
+ # Get the various task parameters.
+ inlist = clpopnu ("textfiles")
+ call clgstr ("field", Memc[column], SZ_FNAME)
+ ascend = btoi (clgetb ("ascend"))
+
+ # Check the column on which to sort.
+ call strlwr (Memc[column])
+ if (Memc[column] == EOS)
+ call error (0, "The sort column is undefined.")
+
+ while (clgfil (inlist, Memc[infile], SZ_FNAME) != EOF) {
+
+ # Open the input file.
+ if (access (Memc[infile], 0, TEXT_FILE) == YES)
+ tp_in = open (Memc[infile], READ_ONLY, TEXT_FILE)
+ else
+ call error (0, "The input file is not a text file.")
+
+ # Open an output text file.
+ call mktemp ("temp", Memc[outfile], SZ_FNAME)
+ tp_out = open (Memc[outfile], NEW_FILE, TEXT_FILE)
+
+ # Sort the stars.
+ nrecs = pt_sortnum (tp_in, tp_out, Memc[column], ascend)
+
+ # Close up the input and output files.
+ call close (tp_in)
+ call close (tp_out)
+ if (nrecs <= 0)
+ call delete (Memc[outfile])
+ else {
+ call delete (Memc[infile])
+ call rename (Memc[outfile], Memc[infile])
+ }
+ }
+
+ call clpcls (inlist)
+ call sfree (sp)
+end
generated by cgit (git 2.34.1) at 2025-09-20 07:17:13 -0400