aboutsummaryrefslogtreecommitdiff
path: root/noao/twodspec/apextract/apdb.x
diff options
context:
space:
mode:
Diffstat (limited to 'noao/twodspec/apextract/apdb.x')
-rw-r--r--noao/twodspec/apextract/apdb.x314
1 files changed, 314 insertions, 0 deletions
diff --git a/noao/twodspec/apextract/apdb.x b/noao/twodspec/apextract/apdb.x
new file mode 100644
index 00000000..8bfb5244
--- /dev/null
+++ b/noao/twodspec/apextract/apdb.x
@@ -0,0 +1,314 @@
+include <math/curfit.h>
+include <pkg/dttext.h>
+include "apertures.h"
+
+# AP_DBWRITE -- Write aperture data to the database. The database is obtained
+# with a CL query.
+
+procedure ap_dbwrite (image, aps, naps)
+
+char image[ARB] # Image
+pointer aps # Apertures
+int naps
+
+int i, j, ncoeffs
+pointer sp, database, str, dt, coeffs, ap
+
+int cvstati(), ic_geti()
+real ic_getr()
+bool strne()
+pointer dtmap1()
+
+errchk dtmap1
+
+begin
+ # Set the aperture database file name and map as a NEW_FILE.
+ # The file name is "ap" appended with the image name with the
+ # special image section characters replaced by '_'.
+ # The reason for making image sections separate database
+ # files rather than combining all database entries for an image
+ # in one file is that then previous entries can be deleted
+ # by using NEW_FILE mode which deletes any existing database
+ # file before writing out the new apertures.
+
+ call smark (sp)
+ call salloc (database, SZ_FNAME, TY_CHAR)
+ call salloc (str, SZ_LINE, TY_CHAR)
+
+ call clgstr ("database", Memc[database], SZ_FNAME)
+ if ((Memc[database] == EOS) || (image[1] == EOS)) {
+ call sfree (sp)
+ return
+ }
+
+ # Map the database file name replacing special characters with '_'.
+ call sprintf (Memc[str], SZ_LINE, "ap%s")
+ call pargstr (image)
+ for (i=str; Memc[i] != EOS; i = i + 1)
+ switch (Memc[i]) {
+ case '[', ':', ',',']','*',' ', '/':
+ Memc[i] = '_'
+ }
+ dt = dtmap1 (Memc[database], Memc[str], NEW_FILE)
+
+ # Write aperture entries for all apertures.
+ for (j = 0; j < naps; j = j + 1) {
+ ap = Memi[aps+j]
+
+ call dtptime (dt)
+ call dtput (dt, "begin\taperture %s %d %g %g\n")
+ call pargstr (image)
+ call pargi (AP_ID(ap))
+ call pargr (AP_CEN(ap, 1))
+ call pargr (AP_CEN(ap, 2))
+ if (AP_TITLE(ap) != NULL) {
+ call dtput (dt, "\ttitle\t%s\n")
+ call pargstr (Memc[AP_TITLE(ap)])
+ }
+ call dtput (dt, "\timage\t%s\n")
+ call pargstr (image)
+ call dtput (dt, "\taperture\t%d\n")
+ call pargi (AP_ID(ap))
+ call dtput (dt, "\tbeam\t%d\n")
+ call pargi (AP_BEAM(ap))
+ call dtput (dt, "\tcenter\t%g %g\n")
+ call pargr (AP_CEN(ap, 1))
+ call pargr (AP_CEN(ap, 2))
+ call dtput (dt, "\tlow\t%g %g\n")
+ call pargr (AP_LOW(ap, 1))
+ call pargr (AP_LOW(ap, 2))
+ call dtput (dt, "\thigh\t%g %g\n")
+ call pargr (AP_HIGH(ap, 1))
+ call pargr (AP_HIGH(ap, 2))
+ if (AP_IC(ap) != NULL) {
+ call dtput (dt, "\tbackground\n")
+ call dtput (dt, "\t\txmin %g\n")
+ call pargr (ic_getr (AP_IC(ap), "xmin"))
+ call dtput (dt, "\t\txmax %g\n")
+ call pargr (ic_getr (AP_IC(ap), "xmax"))
+ call dtput (dt, "\t\tfunction %s\n")
+ call ic_gstr (AP_IC(ap), "function", Memc[str], SZ_LINE)
+ call pargstr (Memc[str])
+ call dtput (dt, "\t\torder %d\n")
+ call pargi (ic_geti (AP_IC(ap), "order"))
+ call dtput (dt, "\t\tsample %s\n")
+ call ic_gstr (AP_IC(ap), "sample", Memc[str], SZ_LINE)
+ call pargstr (Memc[str])
+ call dtput (dt, "\t\tnaverage %d\n")
+ call pargi (ic_geti (AP_IC(ap), "naverage"))
+ call dtput (dt, "\t\tniterate %d\n")
+ call pargi (ic_geti (AP_IC(ap), "niterate"))
+ call dtput (dt, "\t\tlow_reject %g\n")
+ call pargr (ic_getr (AP_IC(ap), "low"))
+ call dtput (dt, "\t\thigh_reject %g\n")
+ call pargr (ic_getr (AP_IC(ap), "high"))
+ call dtput (dt, "\t\tgrow %g\n")
+ call pargr (ic_getr (AP_IC(ap), "grow"))
+ }
+
+ # Write out the curve.
+ call dtput (dt, "\taxis\t%d\n")
+ call pargi (AP_AXIS(ap))
+ ncoeffs = cvstati (AP_CV(ap), CVNSAVE)
+ call malloc (coeffs, ncoeffs, TY_REAL)
+ call cvsave (AP_CV(ap), Memr[coeffs])
+ call dtput (dt, "\tcurve\t%d\n")
+ call pargi (ncoeffs)
+ do i = 1, ncoeffs {
+ call dtput (dt, "\t\t%g\n")
+ call pargr (Memr[coeffs+i-1])
+ }
+ call mfree (coeffs, TY_REAL)
+
+ call dtput (dt, "\n")
+ }
+ call dtunmap (dt)
+
+ # Log the write operation unless the output file is "last".
+ if (strne (image, "last")) {
+ call sprintf (Memc[str], SZ_LINE,
+ "DATABASE - %d apertures for %s written to %s")
+ call pargi (naps)
+ call pargstr (image)
+ call pargstr (Memc[database])
+ call ap_log (Memc[str], YES, YES, NO)
+ call appstr ("ansdbwrite1", "no")
+ }
+
+ call sfree (sp)
+end
+
+
+# AP_DBREAD - Get aperture information from the database.
+# If no apertures are found then the input apertures are unchanged.
+# The database is obtained with a CL query.
+
+procedure ap_dbread (image, aps, naps)
+
+char image[ARB] # Image
+pointer aps # Apertures
+int naps # Number of apertures
+
+int i, j, n, ncoeffs
+pointer sp, database, str, ap, dt, coeffs
+
+bool strne()
+int dtgeti()
+real dtgetr()
+pointer dtmap1()
+
+errchk dtmap1
+
+begin
+ # Return if the database or image are undefined.
+ call smark (sp)
+ call salloc (database, SZ_FNAME, TY_CHAR)
+ call clgstr ("database", Memc[database], SZ_FNAME)
+
+ if ((Memc[database] == EOS) || (image[1] == EOS)) {
+ call sfree (sp)
+ return
+ }
+
+ # Set the aperture database file name and map it.
+ # The file name is "ap" appended with the image name with the
+ # special image section characters replaced by '_'.
+ call salloc (str, SZ_LINE, TY_CHAR)
+ call sprintf (Memc[str], SZ_LINE, "ap%s")
+ call pargstr (image)
+ for (i=str; Memc[i] != EOS; i = i + 1)
+ switch (Memc[i]) {
+ case '[', ':', ',',']','*',' ', '/':
+ Memc[i] = '_'
+ }
+
+ # If an error occurs return the error.
+ dt = dtmap1 (Memc[database], Memc[str], READ_ONLY)
+
+ # Read through the database finding records matching the input image.
+ n = naps
+ naps = 0
+ do i = 1, DT_NRECS(dt) {
+
+ call dtgstr (dt, i, "image", Memc[str], SZ_LINE)
+ if (strne (Memc[str], image))
+ next
+
+ # If an aperture is found delete any input apertures.
+ if (naps == 0)
+ for (j = 0; j < n; j = j + 1)
+ call ap_free (Memi[aps+j])
+
+ if (mod (naps, 100) == 0)
+ call realloc (aps, naps+100, TY_POINTER)
+
+ call ap_alloc (ap)
+ ifnoerr (call dtgstr (dt, i, "title", Memc[str], SZ_LINE)) {
+ call malloc (AP_TITLE(ap), SZ_APTITLE, TY_CHAR)
+ call strcpy (Memc[str], Memc[AP_TITLE(ap)], SZ_APTITLE)
+ }
+ AP_ID(ap) = dtgeti (dt, i, "aperture")
+ iferr (AP_BEAM(ap) = dtgeti (dt, i, "beam"))
+ AP_BEAM(ap) = AP_ID(ap)
+ call dtgstr (dt, i, "center", Memc[str], SZ_LINE)
+ call sscan (Memc[str])
+ call gargr (AP_CEN(ap, 1))
+ call gargr (AP_CEN(ap, 2))
+ call dtgstr (dt, i, "low", Memc[str], SZ_LINE)
+ call sscan (Memc[str])
+ call gargr (AP_LOW(ap, 1))
+ call gargr (AP_LOW(ap, 2))
+ call dtgstr (dt, i, "high", Memc[str], SZ_LINE)
+ call sscan (Memc[str])
+ call gargr (AP_HIGH(ap, 1))
+ call gargr (AP_HIGH(ap, 2))
+ ifnoerr (call dtgstr (dt, i, "background", Memc[str], SZ_LINE)) {
+ call ic_open (AP_IC(ap))
+ call ic_putr (AP_IC(ap), "xmin", dtgetr (dt, i, "xmin"))
+ call ic_putr (AP_IC(ap), "xmax", dtgetr (dt, i, "xmax"))
+ call dtgstr (dt, i, "function", Memc[str], SZ_LINE)
+ call ic_pstr (AP_IC(ap), "function", Memc[str])
+ call ic_puti (AP_IC(ap), "order", dtgeti (dt, i, "order"))
+ call dtgstr (dt, i, "sample", Memc[str], SZ_LINE)
+ call ic_pstr (AP_IC(ap), "sample", Memc[str])
+ call ic_puti (AP_IC(ap), "naverage", dtgeti (dt, i, "naverage"))
+ call ic_puti (AP_IC(ap), "niterate", dtgeti (dt, i, "niterate"))
+ call ic_putr (AP_IC(ap), "low", dtgetr (dt, i, "low_reject"))
+ call ic_putr (AP_IC(ap), "high", dtgetr (dt, i, "high_reject"))
+ call ic_putr (AP_IC(ap), "grow", dtgetr (dt, i, "grow"))
+ }
+
+ AP_AXIS(ap) = dtgeti (dt, i, "axis")
+ ncoeffs = dtgeti (dt, i, "curve")
+ call malloc (coeffs, ncoeffs, TY_REAL)
+ call dtgar (dt, i, "curve", Memr[coeffs], ncoeffs, ncoeffs)
+ call cvrestore (AP_CV(ap), Memr[coeffs])
+ call mfree (coeffs, TY_REAL)
+
+ Memi[aps+naps] = ap
+ naps = naps + 1
+ }
+ call dtunmap (dt)
+
+ # Log the read operation.
+ call sprintf (Memc[str], SZ_LINE,
+ "DATABASE - %d apertures read for %s from %s")
+ call pargi (naps)
+ call pargstr (image)
+ call pargstr (Memc[database])
+ call ap_log (Memc[str], YES, YES, NO)
+
+ # If no apertures were found then reset the number to the input value.
+ if (naps == 0)
+ naps = n
+ else
+ call appstr ("ansdbwrite1", "no")
+
+ call sfree (sp)
+end
+
+
+# AP_DBACCESS - Check if a database file can be accessed.
+# This does not check the contents of the file.
+# The database is obtained with a CL query.
+
+int procedure ap_dbaccess (image)
+
+char image[ARB] # Image
+int access # Database file access?
+
+int i
+pointer sp, database, str, dt
+pointer dtmap1()
+errchk dtmap1
+
+begin
+ call smark (sp)
+ call salloc (database, SZ_FNAME, TY_CHAR)
+ call clgstr ("database", Memc[database], SZ_FNAME)
+
+ if ((Memc[database] != EOS) && (image[1] != EOS)) {
+ # Set the aperture database file name and map it.
+ # The file name is "ap" appended with the image name with the
+ # special image section characters replaced by '_'.
+ call salloc (str, SZ_LINE, TY_CHAR)
+ call sprintf (Memc[str], SZ_LINE, "ap%s")
+ call pargstr (image)
+ for (i=str; Memc[i] != EOS; i = i + 1)
+ switch (Memc[i]) {
+ case '[', ':', ',',']','*',' ', '/':
+ Memc[i] = '_'
+ }
+
+ iferr {
+ dt = dtmap1 (Memc[database], Memc[str], READ_ONLY)
+ call dtunmap (dt)
+ access = YES
+ } then
+ access = NO
+ } else
+ access = NO
+
+ call sfree (sp)
+ return (access)
+end
generated by cgit (git 2.34.1) at 2025-09-20 16:23:34 -0400