diff options
Diffstat (limited to 'noao/digiphot/photcal/debug')
-rw-r--r-- | noao/digiphot/photcal/debug/README | 1 | ||||
-rw-r--r-- | noao/digiphot/photcal/debug/debug.h | 2 | ||||
-rw-r--r-- | noao/digiphot/photcal/debug/debug.par | 14 | ||||
-rw-r--r-- | noao/digiphot/photcal/debug/dginl.x | 30 | ||||
-rw-r--r-- | noao/digiphot/photcal/debug/dgparser.x | 567 | ||||
-rw-r--r-- | noao/digiphot/photcal/debug/dgptime.x | 21 | ||||
-rw-r--r-- | noao/digiphot/photcal/debug/dgtable.x | 241 | ||||
-rw-r--r-- | noao/digiphot/photcal/debug/mkpkg | 14 |
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> + ; |