aboutsummaryrefslogtreecommitdiff
path: root/noao/digiphot/photcal/debug
diff options
context:
space:
mode:
Diffstat (limited to 'noao/digiphot/photcal/debug')
-rw-r--r--noao/digiphot/photcal/debug/README1
-rw-r--r--noao/digiphot/photcal/debug/debug.h2
-rw-r--r--noao/digiphot/photcal/debug/debug.par14
-rw-r--r--noao/digiphot/photcal/debug/dginl.x30
-rw-r--r--noao/digiphot/photcal/debug/dgparser.x567
-rw-r--r--noao/digiphot/photcal/debug/dgptime.x21
-rw-r--r--noao/digiphot/photcal/debug/dgtable.x241
-rw-r--r--noao/digiphot/photcal/debug/mkpkg14
8 files changed, 890 insertions, 0 deletions
diff --git a/noao/digiphot/photcal/debug/README b/noao/digiphot/photcal/debug/README
new file mode 100644
index 00000000..09f34a17
--- /dev/null
+++ b/noao/digiphot/photcal/debug/README
@@ -0,0 +1 @@
+This directory contains code used for debugging.
diff --git a/noao/digiphot/photcal/debug/debug.h b/noao/digiphot/photcal/debug/debug.h
new file mode 100644
index 00000000..f26948d1
--- /dev/null
+++ b/noao/digiphot/photcal/debug/debug.h
@@ -0,0 +1,2 @@
+# Dump file
+define DUMPFILE "dump.log"
diff --git a/noao/digiphot/photcal/debug/debug.par b/noao/digiphot/photcal/debug/debug.par
new file mode 100644
index 00000000..504a0d3b
--- /dev/null
+++ b/noao/digiphot/photcal/debug/debug.par
@@ -0,0 +1,14 @@
+# Parameter file for the DEBUG task
+
+lexcode,b,h,no,,,Debug lexer code
+parcode,b,h,no,,,Debug parser code
+parvars,b,h,no,,,Dump parser variables
+partable,b,h,no,,,Dump parser tables
+fitcode,b,h,no,,,Debug fitcoeffs code
+photcode,b,h,no,,,Debug photproc code
+iocode,b,h,no,,,Debug i/o code
+cattable,b,h,no,,,Dump catalog data table
+obstable,b,h,no,,,Dump catalog observations table
+reftable,b,h,no,,,Dump reference equation table
+wtstable,b,h,no,,,Dump weight table
+nlfit,b,h,no,,,Dump NLFIT structure
diff --git a/noao/digiphot/photcal/debug/dginl.x b/noao/digiphot/photcal/debug/dginl.x
new file mode 100644
index 00000000..62e93c1b
--- /dev/null
+++ b/noao/digiphot/photcal/debug/dginl.x
@@ -0,0 +1,30 @@
+include "debug.h"
+
+# DG_INLDUMP -- Dump the NLFIT and INLFIT structures into a file.
+
+procedure dg_inldump (in, nl)
+
+pointer in # INLFIT descriptor
+pointer nl # NLFIT descriptor
+
+int fd
+
+int open()
+
+begin
+ # Open the dump file.
+ iferr (fd = open (DUMPFILE, APPEND, TEXT_FILE))
+ return
+
+ # Put in the time stamp.
+ call dg_ptime (fd, "dg_inldump")
+
+ # Dump the NLFIT structure.
+ call nl_dumpr (fd, nl)
+
+ # Dump the INLFIT structure.
+ call in_dumpr (fd, in)
+
+ # Close the dump file.
+ call close (fd)
+end
diff --git a/noao/digiphot/photcal/debug/dgparser.x b/noao/digiphot/photcal/debug/dgparser.x
new file mode 100644
index 00000000..7056fef5
--- /dev/null
+++ b/noao/digiphot/photcal/debug/dgparser.x
@@ -0,0 +1,567 @@
+include "../lib/parser.h"
+include "../lib/prstruct.h"
+include "../lib/preval.h"
+include "debug.h"
+
+# DG_PRVDUMP -- Dump the parser variables.
+
+procedure dg_prvdump (label)
+
+char label[ARB] # string label
+
+int fd
+
+include "../parser/parser.com"
+
+bool clgetb()
+int open()
+
+begin
+ # Debug ?
+ if (!clgetb ("debug.parvars"))
+ return
+
+ # Open the log file.
+ iferr (fd = open (DUMPFILE, APPEND, TEXT_FILE))
+ return
+
+ # Put in the time stamp.
+ call dg_ptime (fd, label)
+
+ # Dump the table pointers.
+ call fprintf (fd, "(obstable=%d) (cattable=%d) (partable=%d)\n")
+ call pargi (obstable)
+ call pargi (cattable)
+ call pargi (partable)
+ call fprintf (fd, "(settable=%d) (exttable=%d) (trntable=%d)\n")
+ call pargi (settable)
+ call pargi (exttable)
+ call pargi (trntable)
+ call fprintf (fd, "(trobstable=%d) (trcattable=%d)\n")
+ call pargi (trobstable)
+ call pargi (trcattable)
+ call fprintf (fd, "(tfobstable=%d) (tfcattable=%d)\n")
+ call pargi (tfobstable)
+ call pargi (tfcattable)
+ call fprintf (fd, "(tpartable=%d)\n")
+ call pargi (tpartable)
+
+ # Dump the counters.
+ call fprintf (fd, "(nerrors=%d) (nwarnings=%d)\n")
+ call pargi (nerrors)
+ call pargi (nwarnings)
+ call fprintf (fd,
+ "(nobsvars=%d) (ncatvars=%d) (nfitpars=%d) (ntotpars=%d)\n")
+ call pargi (nobsvars)
+ call pargi (ncatvars)
+ call pargi (nfitpars)
+ call pargi (ntotpars)
+ call fprintf (fd, "(nseteqs=%d) (nexteqs=%d) (ntrneqs=%d)\n")
+ call pargi (nseteqs)
+ call pargi (nexteqs)
+ call pargi (ntrneqs)
+
+ # Dump the column limits.
+ call fprintf (fd, "(mincol=%d)\n")
+ call pargi (mincol)
+ call fprintf (fd, "(minobscol=%d) (maxobscol=%d)\n")
+ call pargi (minobscol)
+ call pargi (maxobscol)
+ call fprintf (fd, "(mincatcol=%d) (maxcatcol=%d)\n")
+ call pargi (mincatcol)
+ call pargi (maxcatcol)
+
+ # Dump the flags.
+ call fprintf (fd, "(flageqsect=%d) (flagerrors=%d)\n")
+ call pargi (flageqsect)
+ call pargi (flagerrors)
+
+ # Close the dump file.
+ call close (fd)
+end
+
+
+# DG_PRTDUMP -- Dump the parser symbol table.
+
+procedure dg_prtdump (label, stp)
+
+char label[ARB] # string label
+pointer stp # symbol table pointer
+
+int fd
+pointer sym
+
+bool clgetb()
+int open()
+pointer sthead(), stnext()
+
+begin
+ # Debug ?
+ if (!clgetb ("debug.partable"))
+ return
+
+ # Open lthe og file.
+ iferr (fd = open (DUMPFILE, APPEND, TEXT_FILE))
+ return
+
+ # Put in the time stamp.
+ call dg_ptime (fd, label)
+
+ # Check for the null pointer.
+ if (stp == NULL) {
+ call fprintf (fd, "dg_prdump: Null pointer\n")
+ return
+ }
+
+ # Dump the table.
+ sym = sthead (stp)
+ while (sym != NULL) {
+
+ # Dump the symbol information.
+ call dg_symdump (fd, stp, sym)
+
+ # Dump the substructure information (if any).
+ call dg_subdump (fd, stp, sym)
+
+ # Advance to next symbol.
+ sym = stnext (stp, sym)
+ }
+
+ # Close the dump file.
+ call close (fd)
+end
+
+
+# DG_SYMDUMP -- Dump symbol structure.
+
+procedure dg_symdump (fd, stp, sym)
+
+int fd # dump file descriptor
+pointer stp # table pointer
+pointer sym # symbol pointer
+
+
+pointer stname(), strefstab()
+
+begin
+ # Check for a null substructure pointer.
+ if (sym == NULL) {
+ call fprintf (fd, "-- dg_symdump: Null pointer\n")
+ return
+ }
+
+ # Print the main structure.
+ call fprintf (fd,
+ "-- dg_symdump: (%s) (sym=%d) (offset=%d) (type=%d) (num=%d) (sub=%d)\n")
+ call pargstr (Memc[stname (stp, sym)])
+ call pargi (sym - strefstab (stp, 0))
+ call pargi (sym)
+ call pargi (PSYM_TYPE (sym))
+ call pargi (PSYM_NUM (sym))
+ call pargi (PSYM_SUB (sym))
+ call flush (fd)
+end
+
+
+# DG_SUBDUMP -- Dump symbol substructure.
+
+procedure dg_subdump (fd, stp, sym)
+
+int fd # dump file descriptor
+pointer stp # table pointer
+pointer sym # symbol pointer
+
+pointer ptr
+
+begin
+ # Check for a null substructure pointer.
+ ptr = PSYM_SUB (sym)
+ if (ptr == NULL) {
+ call fprintf (fd, "dg_subdump: Null substructure pointer\n")
+ return
+ }
+
+ # Branch according to symbol type.
+ switch (PSYM_TYPE (sym)) {
+ case PTY_CATVAR, PTY_OBSVAR:
+ call dg_inpdump (fd, stp, ptr)
+ case PTY_FITPAR, PTY_CONST:
+ call dg_fitdump (fd, stp, ptr)
+ case PTY_SETEQ:
+ call dg_setdump (fd, stp, ptr)
+ case PTY_EXTEQ:
+ call dg_extdump (fd, stp, ptr)
+ case PTY_TRNEQ:
+ call dg_trndump (fd, stp, ptr)
+ default:
+ call fprintf (fd, "dg_subdump: Unknown symbol type\n")
+ }
+end
+
+
+# DG_INPDUMP -- Dump the input variable substructure.
+
+procedure dg_inpdump (fd, stp, ptr)
+
+int fd # dump file descriptor
+pointer stp # table pointer
+pointer ptr # substructure pointer
+
+bool itob()
+
+begin
+ # Print substructure pointer.
+ call fprintf (fd, "dg_inpdump: (ptr=%d)\n")
+ call pargi (ptr)
+
+ # Print input, error and weight columns.
+ call fprintf (fd, "(input=%d) (error=%d) (weight=%d) (spare=%b)\n")
+ call pargi (PINP_COL (ptr))
+ call pargi (PINP_ERRCOL (ptr))
+ call pargi (PINP_WTSCOL (ptr))
+ call pargb (itob (PINP_SPARE(ptr)))
+ call flush (fd)
+end
+
+
+# DG_FITDUMP -- Dump the set equation substructure.
+
+procedure dg_fitdump (fd, stp, ptr)
+
+int fd # dump file descriptor
+pointer stp # table pointer
+pointer ptr # substructure pointer
+
+begin
+ # Print the substructure pointer.
+ call fprintf (fd, "dg_fitdump: (ptr=%d)\n")
+ call pargi (ptr)
+
+ # Print the parameter value and delta.
+ call fprintf (fd, "(value=%g) (delta=%g)\n")
+ call pargr (PFIT_VALUE (ptr))
+ call pargr (PFIT_DELTA (ptr))
+end
+
+
+# DG_SETDUMP -- Dump the set equation substructure.
+
+procedure dg_setdump (fd, stp, ptr)
+
+int fd # dump file descriptor
+pointer stp # table pointer
+pointer ptr # substructure pointer
+
+pointer strefsbuf()
+
+begin
+ # Print the substructure pointer.
+ call fprintf (fd, "dg_setdump: (ptr=%d)\n")
+ call pargi (ptr)
+
+ # Print the equation string.
+ call fprintf (fd, "equation: %d [%s]\n")
+ call pargi (PSEQ_EQ (ptr))
+ call pargstr (Memc[strefsbuf (stp, PSEQ_EQ (ptr))])
+
+ # Print the error equation strings.
+ call fprintf (fd, "error: %d [%s]\n")
+ call pargi (PSEQ_ERROR (ptr))
+ call pargstr (Memc[strefsbuf (stp, PSEQ_ERROR (ptr))])
+ call fprintf (fd, "error max: %d [%s]\n")
+ call pargi (PSEQ_ERRMIN (ptr))
+ call pargstr (Memc[strefsbuf (stp, PSEQ_ERRMIN (ptr))])
+ call fprintf (fd, "error min: %d [%s]\n")
+ call pargi (PSEQ_ERRMAX (ptr))
+ call pargstr (Memc[strefsbuf (stp, PSEQ_ERRMAX (ptr))])
+
+ # Print the weight equation strings.
+ call fprintf (fd, "weight: %d [%s]\n")
+ call pargi (PSEQ_WEIGHT (ptr))
+ call pargstr (Memc[strefsbuf (stp, PSEQ_WEIGHT (ptr))])
+ call fprintf (fd, "error max: %d [%s]\n")
+ call pargi (PSEQ_WTSMIN (ptr))
+ call pargstr (Memc[strefsbuf (stp, PSEQ_WTSMIN (ptr))])
+ call fprintf (fd, "error min: %d [%s]\n")
+ call pargi (PSEQ_WTSMAX (ptr))
+ call pargstr (Memc[strefsbuf (stp, PSEQ_WTSMAX (ptr))])
+
+ # Print the equation code.
+ call fprintf (fd, "equation rpn: ")
+ call dg_cdump (fd, PSEQ_RPNEQ (ptr))
+
+ # Print the error equation codes.
+ call fprintf (fd, "error rpn: ")
+ call dg_cdump (fd, PSEQ_RPNERROR (ptr))
+ call fprintf (fd, "error min rpn: ")
+ call dg_cdump (fd, PSEQ_RPNERRMIN (ptr))
+ call fprintf (fd, "error max rpn: ")
+ call dg_cdump (fd, PSEQ_RPNERRMAX (ptr))
+
+ # Print the weight equation codes.
+ call fprintf (fd, "weight rpn: ")
+ call dg_cdump (fd, PSEQ_RPNWEIGHT (ptr))
+ call fprintf (fd, "weight min rpn: ")
+ call dg_cdump (fd, PSEQ_RPNWTSMIN (ptr))
+ call fprintf (fd, "weight max rpn: ")
+ call dg_cdump (fd, PSEQ_RPNWTSMAX (ptr))
+end
+
+
+# DG_EXTDUMP -- Dump the extinction equation substructure.
+
+procedure dg_extdump (fd, stp, ptr)
+
+int fd # dump file descriptor
+pointer stp # table pointer
+pointer ptr # substructure pointer
+
+begin
+ # Print the substructure pointer.
+ call fprintf (fd, "dg_extdump: (ptr=%d)\n")
+ call pargi (ptr)
+end
+
+
+# DG_TRNDUMP -- Dump the transformation equation substructure.
+
+procedure dg_trndump (fd, stp, ptr)
+
+int fd # dump file descriptor
+pointer stp # table pointer
+pointer ptr # substructure pointer
+
+int i
+
+pointer strefsbuf()
+
+begin
+ # Print substructure pointer, number of variables, and parameters
+ call fprintf (fd,
+ "dg_trndump: (ptr=%d) (nrcat=%d) (nrobs=%d) (nrvar=%d) (nfcat=%d) ")
+ call pargi (ptr)
+ call pargi (PTEQ_NRCAT (ptr))
+ call pargi (PTEQ_NROBS (ptr))
+ call pargi (PTEQ_NRVAR (ptr))
+ call pargi (PTEQ_NFCAT (ptr))
+ call fprintf (fd,
+ "(nfobs=%d) (nfvar=%d) (nvar=%d) (npar=%d) (nfpar=%d)\n")
+ call pargi (PTEQ_NFOBS (ptr))
+ call pargi (PTEQ_NFVAR (ptr))
+ call pargi (PTEQ_NVAR (ptr))
+ call pargi (PTEQ_NPAR (ptr))
+ call pargi (PTEQ_NFPAR (ptr))
+ call flush (fd)
+
+ # Print reference equation variable offsets.
+ call fprintf (fd, "Reference variable offsets:")
+ do i = 1, PTEQ_NRVAR (ptr) {
+ call fprintf (fd, " %d")
+ call pargi (PTEQ_REFVAR (ptr, i))
+ }
+ call fprintf (fd, "\n")
+ call flush (fd)
+
+ # Print reference equation counters.
+ call fprintf (fd, "Reference equation counters:")
+ do i = 1, PTEQ_NRVAR (ptr) {
+ call fprintf (fd, " %d")
+ call pargi (PTEQ_REFCNT (ptr, i))
+ }
+ call fprintf (fd, "\n")
+ call flush (fd)
+
+ # Print fit equation variable offsets.
+ call fprintf (fd, "Fit variable offsets:")
+ do i = 1, PTEQ_NFVAR (ptr) {
+ call fprintf (fd, " %d")
+ call pargi (PTEQ_FITVAR (ptr, i))
+ }
+ call fprintf (fd, "\n")
+ call flush (fd)
+
+ # Print fit equation counters.
+ call fprintf (fd, "Fit equation counters:")
+ do i = 1, PTEQ_NFVAR (ptr) {
+ call fprintf (fd, " %d")
+ call pargi (PTEQ_FITCNT (ptr, i))
+ }
+ call fprintf (fd, "\n")
+ call flush (fd)
+
+ # Print parameter offsets.
+ call fprintf (fd, "Parameter offsets:")
+ do i = 1, PTEQ_NPAR (ptr) {
+ call fprintf (fd, " %d")
+ call pargi (PTEQ_PAR (ptr, i))
+ }
+ call fprintf (fd, "\n")
+ call flush (fd)
+
+ # Print the parameter values.
+ call fprintf (fd, "Parameter values:")
+ do i = 1, PTEQ_NPAR (ptr) {
+ call fprintf (fd, " %g")
+ call pargr (PTEQ_PARVAL (ptr, i))
+ }
+ call fprintf (fd, "\n")
+ call flush (fd)
+
+ # Print the fitting parameter list.
+ call fprintf (fd, "Parameter list:")
+ do i = 1, PTEQ_NPAR (ptr) {
+ call fprintf (fd, " %d")
+ call pargi (PTEQ_PLIST (ptr, i))
+ }
+ call fprintf (fd, "\n")
+ call flush (fd)
+
+ # Print fit and reference equation strings.
+ call fprintf (fd, "Fit: %d [%s]\n")
+ call pargi (PTEQ_FIT (ptr))
+ call pargstr (Memc[strefsbuf (stp, PTEQ_FIT (ptr))])
+ call fprintf (fd, "Reference: %d [%s]\n")
+ call pargi (PTEQ_REF (ptr))
+ call pargstr (Memc[strefsbuf (stp, PTEQ_REF (ptr))])
+ call flush (fd)
+
+ # Print error equation strings.
+ call fprintf (fd, "Error: %d [%s]\n")
+ call pargi (PTEQ_ERROR (ptr))
+ call pargstr (Memc[strefsbuf (stp, PTEQ_ERROR (ptr))])
+ call fprintf (fd, "Error max: %d [%s]\n")
+ call pargi (PTEQ_ERRMIN (ptr))
+ call pargstr (Memc[strefsbuf (stp, PTEQ_ERRMIN (ptr))])
+ call fprintf (fd, "Error min: %d [%s]\n")
+ call pargi (PTEQ_ERRMAX (ptr))
+ call pargstr (Memc[strefsbuf (stp, PTEQ_ERRMAX (ptr))])
+ call flush (fd)
+
+ # Print weight equation strings.
+ call fprintf (fd, "Weight: %d [%s]\n")
+ call pargi (PTEQ_WEIGHT (ptr))
+ call pargstr (Memc[strefsbuf (stp, PTEQ_WEIGHT (ptr))])
+ call fprintf (fd, "Weight min: %d [%s]\n")
+ call pargi (PTEQ_WTSMIN (ptr))
+ call pargstr (Memc[strefsbuf (stp, PTEQ_WTSMIN (ptr))])
+ call fprintf (fd, "Weight max: %d [%s]\n")
+ call pargi (PTEQ_WTSMAX (ptr))
+ call pargstr (Memc[strefsbuf (stp, PTEQ_WTSMAX (ptr))])
+ call flush (fd)
+
+ # Print plot equation strings.
+ call fprintf (fd, "Plot x: %d [%s]\n")
+ call pargi (PTEQ_XPLOT (ptr))
+ call pargstr (Memc[strefsbuf (stp, PTEQ_XPLOT (ptr))])
+ call fprintf (fd, "Plot y: %d [%s]\n")
+ call pargi (PTEQ_YPLOT (ptr))
+ call pargstr (Memc[strefsbuf (stp, PTEQ_YPLOT (ptr))])
+ call flush (fd)
+
+ # Print derivative strings.
+ call fprintf (fd, "Derivatives:\n")
+ do i = 1, PTEQ_NPAR (ptr) {
+ call fprintf (fd, "%d ")
+ call pargi (i)
+ if (!IS_INDEFI (PTEQ_DER (ptr, i))) {
+ call fprintf (fd, "(%d) [%s]\n")
+ call pargi (PTEQ_DER (ptr, i))
+ call pargstr (Memc[strefsbuf (stp, PTEQ_DER (ptr, i))])
+ } else
+ call fprintf (fd, "INDEF\n")
+ }
+ call flush (fd)
+
+ # Print equation codes.
+ call fprintf (fd, "Fit rpn: ")
+ call dg_cdump (fd, PTEQ_RPNFIT (ptr))
+ call fprintf (fd, "Reference rpn: ")
+ call dg_cdump (fd, PTEQ_RPNREF (ptr))
+
+ # Print error equation codes.
+ call fprintf (fd, "Error rpn: ")
+ call dg_cdump (fd, PTEQ_RPNERROR (ptr))
+ call fprintf (fd, "Error min rpn: ")
+ call dg_cdump (fd, PTEQ_RPNERRMIN (ptr))
+ call fprintf (fd, "Error max rpn: ")
+ call dg_cdump (fd, PTEQ_RPNERRMAX (ptr))
+
+ # Print weight equation codes.
+ call fprintf (fd, "Weight rpn: ")
+ call dg_cdump (fd, PTEQ_RPNWEIGHT (ptr))
+ call fprintf (fd, "Weight min rpn: ")
+ call dg_cdump (fd, PTEQ_RPNWTSMIN (ptr))
+ call fprintf (fd, "Weight max rpn: ")
+ call dg_cdump (fd, PTEQ_RPNWTSMAX (ptr))
+
+ # Print plot equation codes.
+ call fprintf (fd, "Plot x rpn: ")
+ call dg_cdump (fd, PTEQ_RPNXPLOT (ptr))
+ call fprintf (fd, "Plot y rpn: ")
+ call dg_cdump (fd, PTEQ_RPNYPLOT (ptr))
+
+ # Print derivative codes.
+ call fprintf (fd, "Derivative rpn:\n")
+ do i = 1, PTEQ_NPAR (ptr) {
+ call fprintf (fd, "%d ")
+ call pargi (i)
+ call dg_cdump (fd, PTEQ_RPNDER (ptr, i))
+ }
+
+ # Flush output.
+ call flush (fd)
+end
+
+
+# DG_CDUMP -- Dump equation code.
+
+procedure dg_cdump (fd, code)
+
+int fd # dump file descriptor
+pointer code # equation code
+
+int i, n
+
+begin
+ # Check the pointer.
+ if (code == NULL) {
+ call fprintf (fd, "Null code\n")
+ return
+ } else {
+ call fprintf (fd, "(%d) [")
+ call pargi (code)
+ }
+ call flush (fd)
+
+ # Print the equation code.
+ i = 1
+ n = Memi[code + i - 1]
+ while (n != PEV_EOC) {
+
+ # Print instruction according to type.
+ if (n == PEV_OBSVAR || n == PEV_CATVAR || n == PEV_PARAM ||
+ n == PEV_SETEQ || n == PEV_EXTEQ || n == PEV_TRNEQ) {
+ call fprintf (fd, "%d,%d ")
+ call pargi (n)
+ i = i + 1
+ call pargi (Memi[code + i - 1])
+ } else if (n == PEV_NUMBER) {
+ call fprintf (fd, "%d,%g ")
+ call pargi (n)
+ i = i + 1
+ call pargr (Memr[code + i - 1])
+ } else {
+ call fprintf (fd, "%d ")
+ call pargi (Memi[code + i - 1])
+ }
+
+ # Get next instruction.
+ i = i + 1
+ n = Memi[code + i - 1]
+ }
+ call fprintf (fd, "%d]\n")
+ call pargi (PEV_EOC)
+
+ # Flush output.
+ call flush (fd)
+end
diff --git a/noao/digiphot/photcal/debug/dgptime.x b/noao/digiphot/photcal/debug/dgptime.x
new file mode 100644
index 00000000..e7cb9ae9
--- /dev/null
+++ b/noao/digiphot/photcal/debug/dgptime.x
@@ -0,0 +1,21 @@
+include <time.h>
+
+
+# DG_PTIME - Put time stamp into a text file
+
+procedure dg_ptime (fd, label)
+
+int fd # log file descriptor
+char label[ARB] # string label
+
+char str[SZ_TIME] # time string
+
+long clktime()
+
+begin
+ call cnvtime (clktime (long (0)), str, SZ_TIME)
+
+ call fprintf (fd, "\n**** %s **** (%s) ****\n")
+ call pargstr (str)
+ call pargstr (label)
+end
diff --git a/noao/digiphot/photcal/debug/dgtable.x b/noao/digiphot/photcal/debug/dgtable.x
new file mode 100644
index 00000000..c207ef29
--- /dev/null
+++ b/noao/digiphot/photcal/debug/dgtable.x
@@ -0,0 +1,241 @@
+include <time.h>
+include "debug.h"
+
+# DG_DCATDAT - Dump catalog data symbol table
+
+procedure dg_dcatdat (label, ctable, nvars)
+
+char label[ARB] # string label
+pointer ctable # catalog data symbol table
+int nvars # number of catalog variables
+
+int n
+int fd
+pointer sym
+
+bool clgetb()
+int open()
+pointer sthead(), stnext(), stname()
+
+begin
+ # Debug ?
+ if (!clgetb ("debug.cattable"))
+ return
+
+ # Open the dump file.
+ iferr (fd = open (DUMPFILE, APPEND, TEXT_FILE))
+ return
+
+ # Log the time.
+ call dg_ptime (fd, label)
+
+ # Test the pointer.
+ if (ctable == NULL) {
+ call fprintf (fd, "dg_dcatat: Null table pointer\n")
+ call close (fd)
+ return
+ }
+
+ # Print the title.
+ call fprintf (fd, "dg_dcatdat: (ctable=%d) (nvars=%d)\n")
+ call pargi (ctable)
+ call pargi (nvars)
+
+ # Print the values in reverse order.
+ sym = sthead (ctable)
+ while (sym != NULL) {
+
+ # Print the matching name.
+ call fprintf (fd, "%d: (%s) ")
+ call pargi (sym)
+ call pargstr (Memc[stname (ctable, sym)])
+
+ # Print the indices.
+ do n = 1, nvars {
+ call fprintf (fd, "%g ")
+ call pargr (Memr[P2R(sym + n - 1)])
+ }
+
+ # Skip one line.
+ call fprintf (fd, "\n")
+
+ # Advance to the next symbol.
+ sym = stnext (ctable, sym)
+ }
+
+ # Close the file.
+ call close (fd)
+end
+
+
+# DG_DCATOBS - Dump the catalog observation table.
+
+procedure dg_dcatobs (label, otable)
+
+char label[ARB] # string label
+pointer otable # observation table
+
+int fd
+int row, col
+
+bool clgetb()
+
+int open()
+int mct_nrows(), mct_maxcol(), mct_ncols()
+real mct_getr()
+
+begin
+ # Debug ?
+ if (!clgetb ("debug.obstable"))
+ return
+
+ # Open the dump file.
+ iferr (fd = open (DUMPFILE, APPEND, TEXT_FILE))
+ return
+
+ # Log the time.
+ call dg_ptime (fd, label)
+
+ # Test the table pointer.
+ if (otable == NULL) {
+ call fprintf (fd, "dg_dcatobs: Null observation table pointer\n")
+ call close (fd)
+ return
+ }
+
+ # Print the title.
+ call fprintf (fd,
+ "dg_dcatobs: (otable=%d) (maxcols=%d) (nrows=%d) (ncols=%d\n")
+ call pargi (otable)
+ call pargi (mct_maxcol (otable))
+ call pargi (mct_nrows (otable))
+ call pargi (mct_ncols (otable))
+
+ # Loop over all data in the table.
+ do row = 1, mct_nrows (otable) {
+
+ # Print the running number.
+ call fprintf (fd, "%3d : ")
+ call pargi (row)
+
+ # Print the values.
+ do col = 1, mct_maxcol (otable) {
+ call fprintf (fd, "%g ")
+ call pargr (mct_getr (otable, row, col))
+ }
+
+ # Skip one line.
+ call fprintf (fd, "\n")
+ }
+
+ # Close the file.
+ call close (fd)
+end
+
+
+# DG_DREF - Dump the reference table.
+
+procedure dg_dref (label, rtable)
+
+char label[ARB] # string label
+pointer rtable # reference table
+
+int n
+int fd
+
+bool clgetb()
+int open()
+int mct_nrows(), mct_maxcol(), mct_ncols()
+real mct_getr()
+
+begin
+ # Debug ?
+ if (!clgetb ("debug.reftable"))
+ return
+
+ # Open the dump file.
+ iferr (fd = open (DUMPFILE, APPEND, TEXT_FILE))
+ return
+
+ # Log the time.
+ call dg_ptime (fd, label)
+
+ # Test the pointer.
+ if (rtable == NULL) {
+ call fprintf (fd, "dg_dref: Null reference table pointer\n")
+ call close (fd)
+ return
+ }
+
+ # Print the title.
+ call fprintf (fd,
+ "dg_dref: (rtable=%d) (maxcols=%d) (nrows=%d) (ncols=%d)\n")
+ call pargi (rtable)
+ call pargi (mct_maxcol (rtable))
+ call pargi (mct_nrows (rtable))
+ call pargi (mct_ncols (rtable))
+
+ # Print the values.
+ do n = 1, mct_nrows (rtable) {
+ call fprintf (fd, "%d: %g\n")
+ call pargi (n)
+ call pargr (mct_getr (rtable, n, 1))
+ }
+
+ # Close the file.
+ call close (fd)
+end
+
+
+# DG_DWEIGHTS - Dump the weight table.
+
+procedure dg_dweights (label, wtable)
+
+char label[ARB] # string label
+pointer wtable # weight table
+
+int n
+int fd
+
+bool clgetb()
+int open()
+int mct_nrows(), mct_maxcol(), mct_ncols()
+real mct_getr()
+
+begin
+ # Debug ?
+ if (!clgetb ("debug.wtstable"))
+ return
+
+ # Open the dump file.
+ iferr (fd = open (DUMPFILE, APPEND, TEXT_FILE))
+ return
+
+ # Log the time.
+ call dg_ptime (fd, label)
+
+ # Test the table pointer.
+ if (wtable == NULL) {
+ call fprintf (fd, "dg_dweight: Null weight table pointer\n")
+ call close (fd)
+ return
+ }
+
+ # Print the title.
+ call fprintf (fd,
+ "dg_dweight: (wtable=%d) (maxcols=%d) (nrows=%d) (ncols=%d)\n")
+ call pargi (wtable)
+ call pargi (mct_maxcol (wtable))
+ call pargi (mct_nrows (wtable))
+ call pargi (mct_ncols (wtable))
+
+ # Print the values.
+ do n = 1, mct_nrows (wtable) {
+ call fprintf (fd, "%d: %g\n")
+ call pargi (n)
+ call pargr (mct_getr (wtable, n, 1))
+ }
+
+ # Close the file.
+ call close (fd)
+end
diff --git a/noao/digiphot/photcal/debug/mkpkg b/noao/digiphot/photcal/debug/mkpkg
new file mode 100644
index 00000000..82d36e01
--- /dev/null
+++ b/noao/digiphot/photcal/debug/mkpkg
@@ -0,0 +1,14 @@
+# The MKPKG file for the DEBUG task.
+
+$checkout libpkg.a ".."
+$update libpkg.a
+$checkin libpkg.a ".."
+$exit
+
+libpkg.a:
+ dginl.x debug.h
+ dgparser.x ../lib/parser.h ../lib/preval.h \
+ ../lib/prstruct.h debug.h
+ dgtable.x debug.h <time.h>
+ dgptime.x <time.h>
+ ;