Initial commit

8 files changed, 1017 insertions, 0 deletions

diff --git a/noao/digiphot/photcal/io/README b/noao/digiphot/photcal/io/README
new file mode 100644
index 00000000..ffb5bab5
--- /dev/null
+++ b/noao/digiphot/photcal/io/README
@@ -0,0 +1,2 @@
+This subdirectory contains the the i/o routines for the FITCOEFFS, EVALUATE
+and INVEVAL tasks.
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
diff --git a/noao/digiphot/photcal/io/iocoeffs.x b/noao/digiphot/photcal/io/iocoeffs.x
new file mode 100644
index 00000000..142a5f3e
--- /dev/null
+++ b/noao/digiphot/photcal/io/iocoeffs.x
@@ -0,0 +1,282 @@
+include "../lib/io.h"
+include "../lib/fitparams.h"
+include	"../lib/parser.h"
+
+# IO_GCOEFFS - Get fit coefficients from a text database file
+
+int procedure io_gcoeffs (fname, sym, stat, chisqr, rms, params, errors,
+	nparams)
+
+char	fname[ARB]		# output database name
+int	sym			# equation symbol
+int	stat			# fit error code (output)
+real	chisqr			# reduced chi-squared of the fit
+real	rms			# RMS of the fit
+real	params[nparams]		# parameter values (output)
+real	errors[nparams]		# parameter errors (output)
+int	nparams			# number of parameters
+
+#int	i
+int	nread, rec
+pointer	dt
+
+#bool	clgetb()
+int	dtlocate(), dtgeti()
+pointer	dtmap(), pr_xgetname()
+real	dtgetr()
+errchk	dtmap()
+
+begin
+	# Debug ?
+	#if (clgetb ("debug.iocode")) {
+	    #call eprintf ("io_gcoeffs.in: (fname=%s) (sym=%d) (npar=%d)\n")
+		#call pargstr (fname)
+		#call pargi (sym)
+		#call pargi (nparams)
+	#}
+
+	# Map database.
+	dt = dtmap (fname, READ_ONLY)
+
+	# Locate record for the equation.
+	iferr (rec = dtlocate (dt, Memc[pr_xgetname (sym)])) {
+	    call dtunmap (dt)
+	    return (0)
+	}
+
+	# Get fit status code, chisqr, and rms.
+	iferr (stat   = dtgeti (dt, rec, STATUS))
+	    stat = INDEFI
+	iferr (chisqr = dtgetr (dt, rec, CHISQR))
+	    chisqr = INDEFR
+	iferr (rms = dtgetr (dt, rec, RMS))
+	    rms = INDEFR
+
+	# Get parameter values and errors.
+	iferr (call dtgar (dt, rec, VALUES, params, nparams, nread))
+	    nread = 0
+	iferr (call dtgar (dt, rec, ERRORS, errors, nparams, nread))
+	    nread = 0
+
+	# Debug ?
+	#if (clgetb ("debug.iocode")) {
+	    #call eprintf (
+	        #"io_gcoeffs.out: (stat=%d) (chisqr=%g) (rms=%g) (nread=%s)")
+		#call pargi (stat)
+		#call pargr (chisqr)
+		#call pargr (rms)
+		#call pargi (nread)
+	    #call eprintf ("\nvalues:")
+	    #do i = 1, nread {
+		#call eprintf (" (%g)")
+		    #call pargr (params[i])
+	    #}
+	    #call eprintf ("\nerrors:")
+	    #do i = 1, nread {
+		#call eprintf (" (%g)")
+		    #call pargr (errors[i])
+	    #}
+	    #call eprintf ("\n")
+	#}
+
+	# Unmap the database.
+	call dtunmap (dt)
+
+	# Return number of values read.
+	return (nread)
+end
+
+
+# IO_PCOEFFS - Put fit coefficients in the output file
+
+procedure io_pcoeffs (fname, sym, stat, wtflag, variance, chisqr, scatter,
+	rms, params, errors, plist, nparams)
+
+char	fname[ARB]		# output database name
+int	sym			# equation symbol
+int	stat			# fit error code
+int	wtflag			# type of weighting
+real	variance		# variance of the fit
+real	chisqr			# reduced chi-squared of the fit
+real	scatter			# additional scatter squared in the fit
+real	rms			# RMS of the fit
+real	params[nparams]		# parameter values
+real	errors[nparams]		# parameter errors
+int	plist[nparams]		# parameter list
+int	nparams			# number of parameters
+
+bool	isfit
+char	str[SZ_LINE]
+int	i, j
+pointer	dt
+real	rval
+
+#bool	clgetb()
+int	pr_gpari()
+pointer	pr_xgetname(), pr_gsymc(), pr_gsymp(), pr_gderc(), dtmap(), pr_gderp()
+real	pr_gsymr()
+errchk	dtmap()
+
+begin
+	# Debug ?
+	#if (clgetb ("debug.iocode")) {
+	    #call eprintf ("io_pcoeffs: (fname=%s) (sym=%d) (stat=%d) "
+		#call pargstr (fname)
+		#call pargi (sym)
+		#call pargi (stat)
+	    #call eprintf ("(chisqr=%g) (rms=%g) (npar=%d)\n")
+		#call pargr (chisqr)
+		#call pargr (rms)
+		#call pargi (nparams)
+	#}
+
+	# Map the database.
+	dt = dtmap (fname, APPEND)
+
+	# Put time stamp and record identification.
+	call dtptime (dt)
+	call dtput (dt, "begin\t%s\n")
+	    call pargstr (Memc[pr_xgetname (sym)])
+
+	# Write fit status code and message.
+	call nlerrmsg (stat, str, SZ_LINE)
+	call dtput (dt, "\t%s\t%d\t(%s)\n")
+	    call pargstr (STATUS)
+	    call pargi (stat)
+	    call pargstr (str)
+
+	# Write the variance and standard deviation.
+	call dtput (dt, "\t%s\t%g\n")
+	    call pargstr (VARIANCE)
+	    call pargr (variance)
+	call dtput (dt, "\t%s\t%g\n")
+	    call pargstr (STDEV)
+	if (variance > 0.0)
+	    call pargr (sqrt (variance))
+	else
+	    call pargr (0.0)
+
+	# Write the average square error and the average error.
+	call dtput (dt, "\t%s\t%g\n")
+	    call pargstr (AVSQERROR)
+	if (chisqr <= 0.0)
+	    rval = 0.0
+	else
+	    rval = variance / chisqr
+	    call pargr (rval)
+	call dtput (dt, "\t%s\t\t%g\n")
+	    call pargstr (AVERROR)
+	    call pargr (sqrt (rval))
+
+	# Write out the average square scatter and the average scatter.
+	call dtput (dt, "\t%s\t%g\n")
+	    call pargstr (AVSQSCATTER)
+	    if (scatter <= 0.0)
+		rval = 0.0
+	    else
+		rval = scatter
+	    call pargr (rval)
+	call dtput (dt, "\t%s\t%g\n")
+	    call pargstr (AVSCATTER)
+	    call pargr (sqrt (rval))
+
+	# Write reduced chi-squared.
+	call dtput (dt, "\t%s\t\t%g\n")
+	    call pargstr (CHISQR)
+	    call pargr (chisqr)
+
+	# Write RMS.
+	call dtput (dt, "\t%s\t\t%g\n")
+	    call pargstr (MSQ)
+	    call pargr (rms * rms)
+	call dtput (dt, "\t%s\t\t%g\n")
+	    call pargstr (RMS)
+	    call pargr (rms)
+
+	# Write reference equation. 
+	call dtput (dt, "\t%s\t%s\n")
+	    call pargstr (REFERENCE)
+	    call pargstr (Memc[pr_gsymc (sym, PTEQREF)])
+
+	# Write the fitting equation. 
+	call dtput (dt, "\t%s\t\t%s\n")
+	    call pargstr (FITTING)
+	    call pargstr (Memc[pr_gsymc (sym, PTEQFIT)])
+
+	# Write the weighting information.
+	call dtput (dt, "\t%s\t\t%s\n")
+	switch (wtflag) {
+	case FWT_UNIFORM:
+	    call pargstr (WEIGHTING)
+	    call pargstr ("uniform")
+	case FWT_PHOTOMETRIC:
+	    call pargstr (WEIGHTING)
+	    call pargstr ("photometric")
+	case FWT_EQUATIONS:
+	    call pargstr (WEIGHTING)
+	    if (pr_gsymp (sym, PTEQRPNWEIGHT) == NULL)
+	        call pargstr ("uniform")
+	    else
+	        call pargstr (Memc[pr_gsymc (sym, PTEQWEIGHT)])
+	default:
+	    call pargstr (WEIGHTING)
+	    call pargstr ("uniform")
+	}
+
+	# Write the parameter names.
+	call dtput (dt, "\t%s\t%d\n")
+	    call pargstr (PARAMETERS)
+	    call pargi (nparams)
+	do i = 1, nparams {
+	    call dtput (dt, "\t\t%s\t(%s)\n")
+		call pargstr (Memc[pr_xgetname (pr_gpari (sym, i, PTEQPAR))])
+	    isfit = false
+	    do j = 1, nparams
+		if (plist[j] == i) {
+		    isfit = true
+		    break
+		}
+	    if (isfit)
+		call pargstr ("fit")
+	    else
+		call pargstr ("constant")
+	}
+
+	# Write the derivatives.
+	call dtput (dt, "\t%s\t%d\n")
+	    call pargstr (DERIVATIVES)
+	    call pargi (nparams)
+	do i = 1, nparams {
+	    if (pr_gderp (sym, i, PTEQRPNDER) != NULL) {
+	        call dtput (dt, "\t\t%s\n")
+		    call pargstr (Memc[pr_gderc (sym, i, PTEQDER)])
+	    } else {
+	        call dtput (dt, "\t\t%g\n")
+		    call pargr (pr_gsymr (pr_gpari (sym, i, PTEQPAR),
+		        PFITDELTA))
+	    }
+	}
+
+	# Write the parameter values.
+	call dtput (dt, "\t%s\t%d\n")
+	    call pargstr (VALUES)
+	    call pargi (nparams)
+	do i = 1, nparams {
+	    call dtput (dt, "\t\t%g\n")
+		call pargr (params[i])
+	}
+
+	# Write the parameter errors.
+	call dtput (dt, "\t%s\t%d\n")
+	    call pargstr (ERRORS)
+	    call pargi (nparams)
+	do i = 1, nparams {
+	    call dtput (dt, "\t\t%g\n")
+		call pargr (errors[i])
+	}
+
+	call dtput (dt,"\n")
+
+	# Close the database.
+	call dtunmap (dt)
+end
diff --git a/noao/digiphot/photcal/io/iogetline.x b/noao/digiphot/photcal/io/iogetline.x
new file mode 100644
index 00000000..040c4aeb
--- /dev/null
+++ b/noao/digiphot/photcal/io/iogetline.x
@@ -0,0 +1,89 @@
+include	"../lib/io.h"
+
+
+# IO_GETLINE -- Get an input line from the data file. The line returned may
+# be composed by one or more physical lines in the output file, if subsequent
+# lines start with a continuation character. The continuation character must
+# be the first character in the subsequent lines. Comment and blank lines
+# are skipped.
+
+int procedure io_getline (fd, line, maxch)
+
+int	fd				# file descriptor
+char	line[maxch]			# line from file
+int	maxch				# line size
+
+bool	first				# first line ?
+int	pending				# pending line in buffer ?
+char	buffer[SZ_LINE]			# line buffer
+
+common	/iogetcom/	pending
+
+int	fscan()
+int	strlen(), strmatch()
+
+begin
+	# Initialize flag to differentiate the first input line
+	# within the loop.
+	first = true
+
+	# Read lines until a non-comment and non-blank line is found, or
+	# the end of the file is reached. Lines starting with a continuation
+	# character are concatenated.
+	repeat {
+
+	    # Get next line. If there is no pending line already in
+	    # the buffer, read a new line from the file. Otherwise,
+	    # use the pending line and clear the pending flag.
+	    if (pending == NO) {
+		if (fscan (fd) != EOF)
+	            call gargstr (buffer, SZ_LINE)
+		else if (first)
+		    return (EOF)
+		else
+		    return (OK)
+	    } else
+		pending = NO
+
+	    # Skip blank and comment lines 
+	    if (strlen (buffer) == 0)
+	        next
+	    if (strmatch (buffer, COMMENT) != 0)
+	        next
+
+	    # If the input line contains a continuation character, then
+	    # concatenate it to the accumulated line. Otherwise, leave
+	    # it in the buffer, and set the pending flag. For the first
+	    # input line no continuation characters are allowed.
+	    if (first) {
+		if (strmatch (buffer, CONTINUATION) != 0)
+		    call error (0, "Continuation character found in first line")
+		else {
+		    call strcpy (buffer, line, maxch)
+		    first = false
+		    next
+		}
+	    } else {
+		if (strmatch (buffer, CONTINUATION) != 0) {
+		    call strcat (buffer[2], line, maxch)
+		    next
+		} else {
+		    pending = YES
+		    return (OK)
+		}
+	    }
+	}
+end
+
+
+# IO_GETLINE_INIT -- Initialize get line.
+
+procedure io_getline_init ()
+
+int	pending				# pending line in buffer ?
+
+common	/iogetcom/	pending
+
+begin
+	pending = NO
+end
diff --git a/noao/digiphot/photcal/io/iolineid.x b/noao/digiphot/photcal/io/iolineid.x
new file mode 100644
index 00000000..a7955c6e
--- /dev/null
+++ b/noao/digiphot/photcal/io/iolineid.x
@@ -0,0 +1,51 @@
+include	<ctype.h>
+
+
+# IO_LINEID - Get the line identification string from input line and advance
+# pointer to next non-white character. Convert matching string to uppercase,
+# and keep characters in the [A..Z, 0..9] set, but return both the original
+# and compressed matching strings. The first one is intended for output to
+# the user, and the second for internal use to avoid typos.
+
+int procedure io_lineid (line, ip, uid, cid, maxch)
+
+char	line[ARB]		# input line
+int	ip			# input pointer
+char	uid[ARB]		# user's (original) line identification string
+char	cid[ARB]		# compressed line identification string
+int	maxch			# output chars
+
+int	i, op
+
+begin
+	# Discard the leading whitespaces.
+	while (IS_WHITE (line[ip]) && line[ip] != EOS)
+	    ip = ip + 1
+
+	# Get the line identifier.
+	for (op = 1; !IS_WHITE (line[ip]) && line[ip] != EOS && op <= maxch;
+	     op = op + 1) {
+	    uid[op] = line[ip]
+	    ip = ip + 1
+	}
+	uid[op] = EOS
+
+	# Copy the orignal identifier into the compressed identifier,
+	# and convert the latter to upper case.
+	call strcpy (uid, cid, maxch)
+	call strupr (cid)
+
+	# Take out all characters not belonging to the [A-Z,0-9,+,-,_] set.
+	op = 1
+	for (i = 1; cid[i] != EOS; i = i + 1) {
+	    if (IS_UPPER (cid[i]) || IS_DIGIT (cid[i]) || (cid[i] == '+') ||
+	        (cid[i] == '-') || (cid[i] == '_')) {
+		cid[op] = cid[i]
+		op = op + 1
+	    }
+	}
+	cid[op] = EOS
+
+	# Return number of characters in compressed identifier
+	return (op - 1)
+end
diff --git a/noao/digiphot/photcal/io/ioobs.x b/noao/digiphot/photcal/io/ioobs.x
new file mode 100644
index 00000000..cc9934d3
--- /dev/null
+++ b/noao/digiphot/photcal/io/ioobs.x
@@ -0,0 +1,150 @@
+include "../lib/io.h"
+
+# IO_GOBS - Get next observation from a file, either from data in the catalog
+# or not. For data found in the catalog return its catalog values at the end of
+# the array. Otherwise append INDEF values. If catalog matching is not being
+# used don't append anything. Return the number of variables read, or EOF.
+
+int procedure io_gobs (fd, ctable, map, type, vars, nvars, getid, ulineid,
+	clineid, maxch)
+
+int	fd			# file descriptor
+pointer	ctable			# catalog table
+pointer	map			# mapped columns
+int	type			# type of object to be processed
+real	vars[nvars]		# observations (output)
+int	nvars			# number of variables
+int	getid			# get the object id
+char	ulineid[maxch]		# user's line identifier (output)
+char	clineid[maxch]		# compresses line identifier (output)
+int	maxch			# max number of chars.
+
+int	i, num, col, ip, tp, index, nread
+pointer	sp, line, token, indices, sym
+real	rval
+
+#bool	clgetb()
+int	ctowrd(), ctor(), pr_findmap(), io_getline(), io_lineid()
+pointer	stfind()
+
+begin
+	# Debug ?
+	#if (clgetb ("debug.iocode")) {
+	    #call eprintf ("io_obs.in: (fd=%d) (ctable=%d) (map=%d) ")
+		#call pargi (fd)
+		#call pargi (ctable)
+		#call pargi (map)
+	    #call eprintf ("(nvars=%d) (maxch=%d)\n")
+		#call pargi (nvars)
+		#call pargi (maxch)
+	#}
+
+	# Allocate working space.
+	call smark (sp)
+	call salloc (line, MAX_CONT * SZ_LINE, TY_CHAR)
+	call salloc (token, SZ_LINE, TY_CHAR)
+	call salloc (indices, nvars, TY_INT)
+
+	# Loop reading lines until the next desired data is found.
+	# Return EOF if there are no more lines, and the number of
+	# variables read otherwise.
+
+	repeat {
+
+	    # Get next line from file
+	    if (io_getline (fd, Memc[line], MAX_CONT * SZ_LINE) == EOF) {
+		call sfree (sp)
+		return (EOF)
+	    }
+
+	    #if (clgetb ("debug.iocode")) {
+		#call eprintf ("[%s]\n") 
+		    #call pargstr (Memc[line])
+	    #}
+
+	    # Get the line id if catalog matching is being used.
+	    ip = 1
+	    if (getid == YES) {
+		if (io_lineid (Memc[line], ip, ulineid, clineid, maxch) == 0)
+		    next
+		col = 2
+	    } else {
+		col = 1
+		ulineid[1] = EOS
+	    }
+
+	    # Break the loop when the appropiate data type is found.
+	    # This is always the case when all the data type is selected,
+	    # or no catalog matching is being used.
+
+	    if (ctable == NULL) {
+	        sym = NULL
+		break
+	    } else {
+		sym = stfind (ctable, clineid)
+		if (type == TYPE_ALL)
+		    break
+		else if ((type == TYPE_PROGRAM) && (sym == NULL))
+		    break
+		else if  ((type == TYPE_STANDARDS) && (sym != NULL))
+		    break
+	    }
+	}
+
+	# Initialize the variables array to INDEF.
+	call amovkr (INDEFR, vars, nvars)
+
+	# Scan input colums and get all observational variable values.
+	nread = 0
+	while (ctowrd (Memc[line], ip, Memc[token], SZ_LINE) > 0) {
+
+	    # Enter variable 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))
+		        next
+	    	    if (index > nvars)
+		        call error (0, "Array index out of bounds (io_gobs)")
+		    vars[index] = rval
+		    nread = max (nread, index)
+		}
+	    } else if (col == 1 && getid == YES)
+		call strcpy (Memc[token], ulineid, SZ_LINE)
+
+	    # Count the input columns.
+	    col = col + 1
+	}
+
+	# If catalog matching is being used append to the output array
+	# all the catalog values from the catalog table. If these values
+	# are not defined (not found in the catalog) append INDEF values.
+
+	if (sym != NULL) {
+	    do num = nread + 1, nvars
+		vars[num] = Memr[P2R(sym+num-nread-1)]
+	    nread = nvars
+	}
+
+	# Debug ?
+	#if (clgetb ("debug.iocode")) {
+	    #call eprintf ("io_obs.out: (nread=%d)")
+		#call pargi (nread)
+	    #do ip = 1, nread {
+		#call eprintf (" (%g)")
+		    #call pargr (vars[ip])
+	    #}
+	    #call eprintf (" (ulineid=%s) (clineid=%s)\n")
+		#call pargstr (ulineid)
+		#call pargstr (clineid)
+	#}
+
+	call sfree (sp)
+
+	# Return the number of variables read.
+	return (nread)
+end
diff --git a/noao/digiphot/photcal/io/iostrwrd.x b/noao/digiphot/photcal/io/iostrwrd.x
new file mode 100644
index 00000000..d7520451
--- /dev/null
+++ b/noao/digiphot/photcal/io/iostrwrd.x
@@ -0,0 +1,51 @@
+# IO_STRWRD -- Search a dictionary string for a given string index number.
+# This is the opposite function of strdic(), that returns the index for
+# given string.  The entries in the dictionary string are separated by
+# a delimiter character which is the first character of the dictionary
+# string.  The index of the string found is returned as the function value.
+# Otherwise, if there is no string for that index, a zero is returned.
+
+int procedure io_strwrd (index, outstr, maxch, dict)
+
+int	index			# String index
+char	outstr[ARB]		# Output string as found in dictionary
+int	maxch			# Maximum length of output string
+char	dict[ARB]		# Dictionary string
+
+int	i, len, start, count
+
+int	strlen()
+
+begin
+	# Clear output string
+	outstr[1] = EOS
+
+	# Return if the dictionary is not long enough
+	if (dict[1] == EOS)
+	    return (0)
+
+	# Initialize counters
+	count = 1
+	len   = strlen (dict)
+
+	# Search the dictionary string. This loop only terminates
+	# successfully if the index is found. Otherwise the procedure
+	# returns with and error condition.
+	for (start = 2; count < index; start = start + 1) {
+	    if (dict[start] == dict[1])
+		count = count + 1
+	    if (start == len)
+		return (0)
+	}
+
+	# Extract the output string from the dictionary
+	for (i = start; dict[i] != EOS && dict[i] != dict[1]; i = i + 1) {
+	    if (i - start + 1 > maxch)
+		break
+	    outstr[i - start + 1] = dict[i]
+	}
+	outstr[i - start + 1] = EOS
+
+	# Return index for output string
+	return (count)
+end
diff --git a/noao/digiphot/photcal/io/mkpkg b/noao/digiphot/photcal/io/mkpkg
new file mode 100644
index 00000000..32009504
--- /dev/null
+++ b/noao/digiphot/photcal/io/mkpkg
@@ -0,0 +1,16 @@
+# The MKPKG file for the io subdirectory.
+
+$checkout	libpkg.a ".."
+$update		libpkg.a
+$checkin	libpkg.a ".."
+$exit
+
+libpkg.a:
+	iocat.x		"../lib/io.h" <time.h> <error.h>
+	iocoeffs.x	"../lib/parser.h"  "../lib/fitparams.h"\
+			"../lib/io.h"
+	iogetline.x	"../lib/io.h"
+	iolineid.x	<ctype.h>
+	ioobs.x	        "../lib/io.h"
+	iostrwrd.x
+	;