diff options
Diffstat (limited to 'noao/digiphot/photcal/io')
| -rw-r--r-- | noao/digiphot/photcal/io/README | 2 | ||||
| -rw-r--r-- | noao/digiphot/photcal/io/iocat.x | 376 | ||||
| -rw-r--r-- | noao/digiphot/photcal/io/iocoeffs.x | 282 | ||||
| -rw-r--r-- | noao/digiphot/photcal/io/iogetline.x | 89 | ||||
| -rw-r--r-- | noao/digiphot/photcal/io/iolineid.x | 51 | ||||
| -rw-r--r-- | noao/digiphot/photcal/io/ioobs.x | 150 | ||||
| -rw-r--r-- | noao/digiphot/photcal/io/iostrwrd.x | 51 | ||||
| -rw-r--r-- | noao/digiphot/photcal/io/mkpkg | 16 |
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 + ; |