aboutsummaryrefslogtreecommitdiff
path: root/noao/digiphot/photcal/io/iocat.x
diff options
context:
space:
mode:
Diffstat (limited to 'noao/digiphot/photcal/io/iocat.x')
-rw-r--r--noao/digiphot/photcal/io/iocat.x376
1 files changed, 376 insertions, 0 deletions
diff --git a/noao/digiphot/photcal/io/iocat.x b/noao/digiphot/photcal/io/iocat.x
new file mode 100644
index 00000000..81fb5aaa
--- /dev/null
+++ b/noao/digiphot/photcal/io/iocat.x
@@ -0,0 +1,376 @@
+include <error.h>
+include <time.h>
+include "../lib/io.h"
+
+
+# IO_GCATDAT - Get catalog data from a list of files. These data will be
+# stored in memory as a symbol table for later use.
+
+procedure io_gcatdat (catdir, list, ctable, ncat, nvars)
+
+char catdir[ARB] # name of the catalog directory
+int list # file list
+pointer ctable # catalog table (output)
+int ncat # number of table entries (output)
+int nvars # number of catalog variables
+
+int i, fd, num, col, ip, tp, index
+pointer sp, input, fname, line, token, dummy, indices, sym, map
+real rval
+
+#bool clgetb()
+int fntgfnb(), access(), ctowrd(), ctor(), open(), stnsymbols()
+int pr_findmap(), io_getline(), io_lineid()
+pointer stopen(), stfind(), stenter()
+
+begin
+ # Debug ?
+ #if (clgetb ("debug.iocode")) {
+ #call eprintf ("io_gcatdat.in: (list=%d) (nvars=%d)\n")
+ #call pargi (list)
+ #call pargi (nvars)
+ #}
+
+ # Map catalog variables.
+ call pr_catmap (map, nvars)
+
+ # Open a symbol table for catalog data.
+ ctable = stopen ("catalog", 2 * LEN_CATDAT, LEN_CATDAT,
+ 10 * LEN_CATDAT)
+
+ # Allocate temporary space.
+ call smark (sp)
+ call salloc (input, SZ_FNAME, TY_CHAR)
+ call salloc (fname, SZ_FNAME, TY_CHAR)
+ call salloc (line, MAX_CONT * SZ_LINE, TY_CHAR)
+ call salloc (token, SZ_LINE, TY_CHAR)
+ call salloc (dummy, SZ_LINE, TY_CHAR)
+ call salloc (indices, nvars, TY_INT)
+
+ # Read the catalog data.
+ call fntrewb (list)
+ while (fntgfnb (list, Memc[input], SZ_FNAME) != EOF) {
+
+ # Create the file name.
+ call sprintf (Memc[fname], SZ_FNAME, "%s%s.dat")
+ call pargstr (catdir)
+ call pargstr (Memc[input])
+ if (access (Memc[fname], READ_ONLY, TEXT_FILE) == NO)
+ call strcpy (Memc[input], Memc[fname], SZ_FNAME)
+
+ # Try to open the input file.
+ iferr (fd = open (Memc[fname], READ_ONLY, TEXT_FILE)) {
+ call erract (EA_WARN)
+ next
+ }
+
+ # Read the file lines.
+ call io_getline_init ()
+ while (io_getline (fd, Memc[line], MAX_CONT * SZ_LINE) != EOF) {
+
+ # Get the line id from the first column.
+ ip = 1
+ if (io_lineid (Memc[line], ip, Memc[dummy], Memc[token],
+ SZ_LINE) == 0)
+ next
+
+ # Enter the line identifier in the symbol table.
+ if (stfind (ctable, Memc[token]) == NULL) {
+ sym = stenter (ctable, Memc[token], nvars)
+ call amovkr (INDEFR, Memr[P2R(sym)], nvars)
+ } else
+ next
+
+ # Get the values from the next columns.
+ col = 2
+ while (ctowrd (Memc[line], ip, Memc[token], SZ_LINE) > 0) {
+
+ # Enter value into symbol table if it was declared in the
+ # configuration file.
+
+ tp = 1
+ if (ctor (Memc[token], tp, rval) > 0) {
+ num = pr_findmap (map, col, Memi[indices], nvars)
+ do i = 1, num {
+ index = Memi[indices+i-1]
+ if (! IS_INDEFI (index))
+ Memr[P2R(sym+index-1)] = rval
+ }
+ }
+
+ # Count columns
+ col = col + 1
+ }
+ }
+
+ # Close file
+ call close (fd)
+ }
+
+ # Get number of entries.
+ ncat = stnsymbols (ctable, 0)
+
+ # Free mapped variables.
+ call pr_unmap (map)
+
+ # Debug ?
+ #if (clgetb ("debug.iocode")) {
+ #call eprintf ("io_gcatdat.out: (ctable=%d) (ncat=%d) (nvars=%d)\n")
+ #call pargi (list)
+ #call pargi (ncat)
+ #call pargi (nvars)
+ #}
+ #call dg_dcatdat ("from io_gcatdat", ctable, nvars)
+
+ call sfree (sp)
+end
+
+
+# IO_GCATOBS - Get catalog observations from a list of files, and store them
+# in a multicolumn table. The catalog data will be appended to the last
+# columns of the table, so each line will be "complete".
+
+procedure io_gcatobs (list, ctable, ncatvars, getid, logfile, otable, ntable,
+ nobs)
+
+int list # file list
+pointer ctable # catalog table
+int ncatvars # number of catalog variables
+int getid # match the ids
+char logfile[ARB] # output log file
+pointer otable # catalog observations table (output)
+pointer ntable # name table (output)
+int nobs # number of observations (output)
+
+char eoschar
+int i, log, fd, nvars, num, col, ip, tp, index
+pointer sp, input, line, token, dummy, indices, map, sym
+real rval
+
+#bool clgetb()
+int fntgfnb(), ctowrd(), ctor(), open(), pr_findmap()
+int io_getline(), io_lineid()
+pointer stfind(), mct_getrow()
+
+data eoschar /EOS/
+
+begin
+ # Debug ?
+ #if (clgetb ("debug.iocode")) {
+ #call eprintf ("io_gcatobs.in: (list=%d) (ctable=%d) (ncatv=%d)\n")
+ #call pargi (list)
+ #call pargi (ctable)
+ #call pargi (ncatvars)
+ #}
+
+ # Map the observational variables.
+ call pr_obsmap (map, nvars)
+
+ # Allocate the catalog observation table.
+ call mct_alloc (otable, LEN_CATOBS, nvars + ncatvars, TY_REAL)
+
+ # Allocate the star name table.
+ if (getid == YES)
+ call mct_alloc (ntable, LEN_CATOBS, SZ_FNAME + 1, TY_CHAR)
+ else
+ call mct_alloc (ntable, LEN_CATOBS, 2, TY_CHAR)
+
+ # Open the log file.
+ if (logfile[1] == EOS) {
+ log = NULL
+ } else {
+ iferr (log = open (logfile, APPEND, TEXT_FILE)) {
+ call erract (EA_WARN)
+ log = NULL
+ }
+ }
+
+ # Allocate working space.
+ call smark (sp)
+ call salloc (input, SZ_FNAME, TY_CHAR)
+ call salloc (line, MAX_CONT * SZ_LINE, TY_CHAR)
+ call salloc (token, SZ_LINE, TY_CHAR)
+ call salloc (dummy, SZ_LINE, TY_CHAR)
+ call salloc (indices, nvars, TY_INT)
+
+ # Print banner.
+ if (log != NULL)
+ call fprintf (log, "\n#UNMATCHED OBJECTS\n\n")
+
+ # Read the catalog observations.
+ nobs = 0
+ call fntrewb (list)
+ while (fntgfnb (list, Memc[input], SZ_LINE) != EOF) {
+
+ # Try to open the input file.
+ iferr (fd = open (Memc[input], READ_ONLY, TEXT_FILE)) {
+ call erract (EA_WARN)
+ next
+ }
+
+ # Read the file lines.
+ call io_getline_init ()
+ while (io_getline (fd, Memc[line], MAX_CONT * SZ_LINE) != EOF) {
+
+ # Get line id from first column if there is a catalog to
+ # match them. Otherwise assume that there is no catalog.
+
+ ip = 1
+ if (getid == YES) {
+ if (io_lineid (Memc[line], ip, Memc[dummy], Memc[token],
+ SZ_LINE) == 0)
+ next
+ col = 2
+ } else
+ col = 1
+
+ # Search for this string in the catalog symbol table if
+ # one is defined. If it's not found skip to the next
+ # line or observation.
+
+ if (ctable != NULL) {
+ sym = stfind (ctable, Memc[token])
+ if (sym == NULL) {
+ if (log != NULL) {
+ call fprintf (log,
+ "File: %s Object: %s was unmatched\n")
+ call pargstr (Memc[input])
+ call pargstr (Memc[token])
+ }
+ next
+ }
+ }
+
+ # Count the observations.
+ nobs = nobs + 1
+
+ # Add the symbol to the name table.
+ if (getid == YES) {
+ call mct_putc (ntable, nobs, 1, eoschar)
+ call strcpy (Memc[token], Memc[mct_getrow(ntable, nobs)],
+ SZ_FNAME)
+ } else
+ call mct_putc (ntable, nobs, 1, eoschar)
+
+ # Scan input colums and get all variable values.
+ while (ctowrd (Memc[line], ip, Memc[token], SZ_LINE) > 0) {
+
+ # Enter variable value into the observation table
+ # if it was declared in the configuration file.
+
+ tp = 1
+ if (ctor (Memc[token], tp, rval) > 0) {
+ num = pr_findmap (map, col, Memi[indices], nvars)
+ do i = 1, num {
+ index = Memi[indices+i-1]
+ if (!IS_INDEFI (index))
+ call mct_putr (otable, nobs, index, rval)
+ }
+ }
+
+ # Count input columns
+ col = col + 1
+ }
+
+ # Now append to the current row all the variable values
+ # from the catalog table for the same line id, if
+ # matching is enabled.
+
+ if (ncatvars > 0) {
+ if (ctable == NULL) {
+ do num = 1, ncatvars
+ call mct_putr (otable, nobs, nvars + num, INDEFR)
+ } else {
+ do num = 1, ncatvars {
+ rval = Memr[P2R(sym+num-1)]
+ call mct_putr (otable, nobs, nvars + num, rval)
+ }
+ }
+ }
+
+ }
+
+ # Close file.
+ call close (fd)
+ }
+
+ if (log != NULL) {
+ call fprintf (log, "\n")
+ call close (log)
+ }
+
+ # Free mapped variables.
+ call pr_unmap (map)
+
+ # Debug ?
+ #if (clgetb ("debug.iocode")) {
+ #call eprintf ("io_gcatobs.out: (otable=%d) (nobs=%d)\n")
+ #call pargi (otable)
+ #call pargi (nobs)
+ #}
+ #call dg_dcatobs ("from io_gcatobs", otable)
+
+ call sfree (sp)
+end
+
+
+# IO_LOGTIME -- Write a time stamp in the unmatched stars log file.
+
+procedure io_logtime (logfile)
+
+char logfile[ARB] # the name of the log file
+
+int log
+pointer sp, timestr
+int open()
+long clktime()
+
+begin
+ if (logfile[1] == EOS)
+ return
+
+ iferr (log = open (logfile, APPEND, TEXT_FILE)) {
+ call erract (EA_WARN)
+ return
+ }
+
+ call smark (sp)
+ call salloc (timestr, SZ_TIME, TY_CHAR)
+ call cnvtime (clktime(0), Memc[timestr], SZ_TIME)
+ call strupr (Memc[timestr])
+ call fprintf (log, "\n#%s\n")
+ call pargstr (Memc[timestr])
+ call sfree (sp)
+
+ call close (log)
+
+end
+
+
+# IO_TITLE -- Write the equation title to the logfile
+
+procedure io_title (logfile, title, sym)
+
+char logfile[ARB] # the name of the log file
+char title # title
+int sym # equation symbol
+
+int log
+int open()
+pointer pr_xgetname()
+
+begin
+ if (logfile[1] == EOS)
+ return
+
+ iferr (log = open (logfile, APPEND, TEXT_FILE)) {
+ call erract (EA_WARN)
+ return
+ }
+
+ call fprintf (log, "%s %s\n\n")
+ call pargstr (title)
+ call pargstr (Memc[pr_xgetname(sym)])
+
+ call close (log)
+end
generated by cgit (git 2.34.1) at 2025-09-20 09:04:20 -0400