aboutsummaryrefslogtreecommitdiff
path: root/noao/onedspec/identify/iddb.x
diff options
context:
space:
mode:
Diffstat (limited to 'noao/onedspec/identify/iddb.x')
-rw-r--r--noao/onedspec/identify/iddb.x515
1 files changed, 515 insertions, 0 deletions
diff --git a/noao/onedspec/identify/iddb.x b/noao/onedspec/identify/iddb.x
new file mode 100644
index 00000000..e354d1c4
--- /dev/null
+++ b/noao/onedspec/identify/iddb.x
@@ -0,0 +1,515 @@
+include <imset.h>
+include <math/curfit.h>
+include <smw.h>
+include <units.h>
+include "identify.h"
+include <pkg/dttext.h>
+
+
+# ID_DBREAD -- Read features data from the database.
+
+procedure id_dbread (id, name, ap, add, verbose)
+
+pointer id # ID pointer
+char name[SZ_LINE] # Image name
+int ap[2] # Aperture number
+int add # Add features?
+int verbose # Verbose flag
+
+int rec, dtlocate()
+pointer sp, line, str
+errchk dtremap, dtlocate, id_dbread_rec
+
+begin
+ call smark (sp)
+ call salloc (line, SZ_LINE, TY_CHAR)
+
+ call strcpy ("id", Memc[line], SZ_LINE)
+ call imgcluster (name, Memc[line+2], SZ_LINE)
+ call dtremap (ID_DT(id), ID_DATABASE(id), Memc[line], READ_ONLY)
+
+ call id_dbsection (id, name, ap, ID_SECTION(id), ID_LENSTRING)
+ call sprintf (Memc[line], SZ_LINE, "identify %s%s")
+ call pargstr (name)
+ call pargstr (ID_SECTION(id))
+
+ iferr (rec = dtlocate (ID_DT(Id), Memc[line])) {
+ call salloc (str, SZ_LINE, TY_CHAR)
+ call sprintf (Memc[str], SZ_LINE, "Entry not found: %s")
+ call pargstr (Memc[line])
+ call error (0, Memc[str])
+ }
+
+ call id_dbread_rec (id, rec, add)
+
+ if (ID_NFEATURES(id) > 0) {
+ ID_NEWGRAPH(id) = YES
+ ID_NEWFEATURES(id) = YES
+ ID_CURRENT(id) = 1
+ } else
+ ID_CURRENT(id) = 0
+
+ if (verbose == YES) {
+ call printf ("identify %s%s\n")
+ call pargstr (name)
+ call pargstr (ID_SECTION(id))
+ }
+
+ call sfree (sp)
+end
+
+
+# ID_DBSAVE -- Read all entries from a database and save.
+
+procedure id_dbsave (id, name)
+
+pointer id # ID pointer
+char name[SZ_LINE] # Image name
+
+int rec, dtgeti()
+pointer sp, line, dt
+errchk dtremap, dtgeti, id_dbread_rec, id_saveap
+
+begin
+ call smark (sp)
+ call salloc (line, SZ_FNAME, TY_CHAR)
+
+ call strcpy ("id", Memc[line], SZ_FNAME)
+ call imgcluster (name, Memc[line+2], SZ_FNAME)
+ call dtremap (ID_DT(id), ID_DATABASE(id), Memc[line], READ_ONLY)
+
+ dt = ID_DT(id)
+ do rec = 1, DT_NRECS(dt) {
+ ID_AP(id,1) = dtgeti (dt, rec, "aperture")
+ ID_AP(id,2) = 1
+ call id_dbread_rec (id, rec, NO)
+ call id_saveap (id)
+ }
+
+ call sfree (sp)
+end
+
+
+# ID_DBREAD_REC -- Read specified record from the database.
+
+procedure id_dbread_rec (id, rec, add)
+
+pointer id # ID pointer
+int rec # Database record
+int add # Add features?
+
+double pix
+int i, j, k, ncoeffs
+pointer dt, sh, un, sp, line, coeffs
+
+int dtgeti(), dcvstati(), dtscan(), nscan()
+real dtgetr()
+double dcvstatd()
+bool un_compare()
+pointer un_open()
+errchk un_open, dtgeti(), dtgad()
+
+begin
+ call smark (sp)
+ call salloc (line, SZ_LINE, TY_CHAR)
+
+ dt = ID_DT(id)
+ sh = ID_SH(id)
+
+ if (add == YES) {
+ j = dtgeti (dt, rec, "features")
+ k = j + ID_NFEATURES(id)
+ ID_NALLOC(id) = k
+
+ call realloc (ID_PIX(id), k, TY_DOUBLE)
+ call realloc (ID_FIT(id), k, TY_DOUBLE)
+ call realloc (ID_USER(id), k, TY_DOUBLE)
+ call realloc (ID_WTS(id), k, TY_DOUBLE)
+ call realloc (ID_FWIDTHS(id), k, TY_REAL)
+ call realloc (ID_FTYPES(id), k, TY_INT)
+ call realloc (ID_LABEL(id), k, TY_POINTER)
+
+ do i = 1, j {
+ k = dtscan (dt)
+ call gargd (pix)
+
+ ID_NFEATURES(id) = ID_NFEATURES(id) + 1
+ for (k=ID_NFEATURES(id); (k>1)&&(pix<PIX(id,k-1)); k=k-1) {
+ PIX(id,k) = PIX(id,k-1)
+ FIT(id,k) = FIT(id,k-1)
+ USER(id,k) = USER(id,k-1)
+ WTS(id,k) = WTS(id,k-1)
+ FWIDTH(id,k) = FWIDTH(id,k-1)
+ FTYPE(id,k) = FTYPE(id,k-1)
+ Memi[ID_LABEL(id)+k-1] = Memi[ID_LABEL(id)+k-2]
+ }
+ PIX(id,k) = pix
+ call gargd (FIT(id,k))
+ call gargd (USER(id,k))
+ call gargr (FWIDTH(id,k))
+ call gargi (FTYPE(id,k))
+ call gargd (WTS(id,k))
+ call gargstr (Memc[line], SZ_LINE)
+ Memi[ID_LABEL(id)+k-1] = NULL
+ call id_label (Memc[line], Memi[ID_LABEL(id)+k-1])
+
+ # The following initialization is for backwards compatibility.
+ if (nscan() < 5) {
+ FWIDTH(id,k) = ID_FWIDTH(id)
+ FTYPE(id,k) = ID_FTYPE(id)
+ } else if (nscan() < 6)
+ WTS(id,k) = 1.
+ }
+
+ if (ID_UN(id) != NULL) {
+ ifnoerr (call dtgstr (dt, rec, "units", Memc[line], SZ_LINE)) {
+ un = un_open (Memc[line])
+ if (!un_compare (un, ID_UN(id)) && j > 0) {
+ k = ID_NFEATURES(id) - j
+ call un_ctrand (un, ID_UN(id), FIT(id,k), FIT(id,k), j)
+ call un_ctrand (un, ID_UN(id), USER(id,k), USER(id,k),j)
+ }
+ call un_close (un)
+ }
+ }
+
+ } else {
+ if (sh != NULL) {
+ if (SMW_FORMAT(MW(sh))==SMW_ES || SMW_FORMAT(MW(sh))==SMW_MS) {
+ iferr (APLOW(sh,1) = dtgetr (dt, rec, "aplow"))
+ APLOW(sh,1) = INDEF
+ iferr (APHIGH(sh,1) = dtgetr (dt, rec, "aphigh"))
+ APHIGH(sh,1) = INDEF
+ }
+ }
+
+ do i = 1, ID_NFEATURES(id)
+ call mfree (Memi[ID_LABEL(id)+i-1], TY_CHAR)
+
+ k = dtgeti (dt, rec, "features")
+ ID_NFEATURES(id) = k
+ ID_NALLOC(id) = k
+ call realloc (ID_PIX(id), k, TY_DOUBLE)
+ call realloc (ID_FIT(id), k, TY_DOUBLE)
+ call realloc (ID_USER(id), k, TY_DOUBLE)
+ call realloc (ID_WTS(id), k, TY_DOUBLE)
+ call realloc (ID_FWIDTHS(id), k, TY_REAL)
+ call realloc (ID_FTYPES(id), k, TY_INT)
+ call realloc (ID_LABEL(id), k, TY_POINTER)
+
+ do i = 1, ID_NFEATURES(id) {
+ k = dtscan (dt)
+ call gargd (PIX(id,i))
+ call gargd (FIT(id,i))
+ call gargd (USER(id,i))
+ call gargr (FWIDTH(id,i))
+ call gargi (FTYPE(id,i))
+ call gargd (WTS(id,i))
+ call gargstr (Memc[line], SZ_LINE)
+ Memi[ID_LABEL(id)+i-1] = NULL
+ call id_label (Memc[line], Memi[ID_LABEL(id)+i-1])
+
+ # The following initialization is for backwards compatibility.
+ if (nscan() < 5) {
+ FWIDTH(id,i) = ID_FWIDTH(id)
+ FTYPE(id,i) = ID_FTYPE(id)
+ } else if (nscan() < 6)
+ WTS(id,i) = 1.
+ }
+
+ iferr (ID_SHIFT(id) = dtgetr (dt, rec, "shift"))
+ ID_SHIFT(id) = 0.
+
+ iferr {
+ ncoeffs = dtgeti (dt, rec, "coefficients")
+ call salloc (coeffs, ncoeffs, TY_DOUBLE)
+ call dtgad (dt, rec, "coefficients", Memd[coeffs], ncoeffs,
+ ncoeffs)
+
+ if (ID_CV(id) != NULL)
+ call dcvfree (ID_CV(id))
+ call dcvrestore (ID_CV(id), Memd[coeffs])
+
+ call ic_putr (ID_IC(id), "xmin", real (dcvstatd(ID_CV(id),
+ CVXMIN)))
+ call ic_putr (ID_IC(id), "xmax", real (dcvstatd(ID_CV(id),
+ CVXMAX)))
+ ifnoerr (call dtgstr (dt,rec,"function",Memc[line],SZ_LINE)) {
+ call ic_pstr (ID_IC(id), "function", Memc[line])
+ call ic_puti (ID_IC(id), "order", dtgeti (dt, rec, "order"))
+ call dtgstr (dt, rec, "sample", Memc[line], SZ_LINE)
+ call ic_pstr (ID_IC(id), "sample", Memc[line])
+ call ic_puti (ID_IC(id), "naverage",
+ dtgeti (dt, rec, "naverage"))
+ call ic_puti (ID_IC(id), "niterate",
+ dtgeti (dt, rec, "niterate"))
+ call ic_putr (ID_IC(id), "low",
+ dtgetr (dt, rec, "low_reject"))
+ call ic_putr (ID_IC(id), "high",
+ dtgetr (dt, rec, "high_reject"))
+ call ic_putr (ID_IC(id), "grow", dtgetr (dt, rec, "grow"))
+ } else {
+ call ic_puti (ID_IC(id), "order", dcvstati (ID_CV(id),
+ CVORDER))
+ switch (dcvstati (ID_CV(id), CVTYPE)) {
+ case LEGENDRE:
+ call ic_pstr (ID_IC(id), "function", "legendre")
+ case CHEBYSHEV:
+ call ic_pstr (ID_IC(id), "function", "chebyshev")
+ case SPLINE1:
+ call ic_pstr (ID_IC(id), "function", "spline1")
+ case SPLINE3:
+ call ic_pstr (ID_IC(id), "function", "spline3")
+ }
+ }
+
+ ID_NEWCV(id) = YES
+ ID_CURRENT(id) = min (1, ID_NFEATURES(id))
+ } then
+ ;
+
+ ifnoerr (call dtgstr (dt, rec, "units", Memc[line], SZ_LINE)) {
+ if (ID_UN(id) == NULL)
+ ID_UN(id) = un_open (Memc[line])
+ else {
+ un = un_open (Memc[line])
+ if (!un_compare (un, ID_UN(id))) {
+ call id_unitsll (id, Memc[line])
+ call un_close (ID_UN(id))
+ ID_UN(id) = un
+ } else
+ call un_close (un)
+ }
+ }
+ }
+
+ call sfree (sp)
+end
+
+
+# ID_DBWRITE -- Write features data to the database.
+
+procedure id_dbwrite (id, name, ap, verbose)
+
+pointer id # ID pointer
+char name[ARB] # Image name
+int ap[2] # Aperture number
+int verbose # Verbose flag
+
+int i, ncoeffs
+pointer dt, sp, coeffs, root, sh, im
+
+int dcvstati(), ic_geti()
+real ic_getr()
+
+errchk dtremap
+
+begin
+ call smark (sp)
+ call salloc (root, SZ_FNAME, TY_CHAR)
+
+ call strcpy ("id", Memc[root], SZ_FNAME)
+ call imgcluster (name, Memc[root+2], SZ_FNAME)
+ call dtremap (ID_DT(id), ID_DATABASE(id), Memc[root], APPEND)
+
+ call id_dbsection (id, name, ap, ID_SECTION(id), ID_LENSTRING)
+
+ sh = ID_SH(id)
+ dt = ID_DT(id)
+ call dtptime (dt)
+ call dtput (dt, "begin\tidentify %s%s\n")
+ call pargstr (name)
+ call pargstr (ID_SECTION(id))
+ call dtput (dt, "\tid\t%s\n")
+ call pargstr (name)
+ call dtput (dt, "\ttask\tidentify\n")
+ call dtput (dt, "\timage\t%s%s\n")
+ call pargstr (ID_IMAGE(id))
+ call pargstr (ID_SECTION(id))
+ if (SMW_FORMAT(MW(sh)) == SMW_ES || SMW_FORMAT(MW(sh)) == SMW_MS) {
+ call dtput (dt, "\taperture\t%d\n")
+ call pargi (ID_AP(id,1))
+ call dtput (dt, "\taplow\t%g\n")
+ call pargr (APLOW(sh,1))
+ call dtput (dt, "\taphigh\t%g\n")
+ call pargr (APHIGH(sh,1))
+ }
+
+ if (ID_UN(id) != NULL) {
+ call dtput (dt, "\tunits\t%s\n")
+ call pargstr (UN_USER(ID_UN(id)))
+ }
+ call dtput (dt, "\tfeatures\t%d\n")
+ call pargi (ID_NFEATURES(id))
+ do i = 1, ID_NFEATURES(id) {
+ call dtput (dt, "\t %10.2f %10.9g %10.9g %5.1f %d %d %s\n")
+ call pargd (PIX(id,i))
+ call pargd (FIT(id,i))
+ call pargd (USER(id,i))
+ call pargr (FWIDTH(id,i))
+ call pargi (FTYPE(id,i))
+ call pargd (WTS(id,i))
+ if (Memi[ID_LABEL(id)+i-1] != NULL)
+ call pargstr (Memc[Memi[ID_LABEL(id)+i-1]])
+ else
+ call pargstr ("")
+ }
+
+ if (ID_SHIFT(id) != 0.) {
+ call dtput (dt, "\tshift\t%g\n")
+ call pargd (ID_SHIFT(id))
+ }
+
+ if (ID_CV(id) != NULL) {
+ call dtput (dt, "\tfunction %s\n")
+ call ic_gstr (ID_IC(id), "function", Memc[root], SZ_FNAME)
+ call pargstr (Memc[root])
+ call dtput (dt, "\torder %d\n")
+ call pargi (ic_geti (ID_IC(id), "order"))
+ call dtput (dt, "\tsample %s\n")
+ call ic_gstr (ID_IC(id), "sample", Memc[root], SZ_FNAME)
+ call pargstr (Memc[root])
+ call dtput (dt, "\tnaverage %d\n")
+ call pargi (ic_geti (ID_IC(id), "naverage"))
+ call dtput (dt, "\tniterate %d\n")
+ call pargi (ic_geti (ID_IC(id), "niterate"))
+ call dtput (dt, "\tlow_reject %g\n")
+ call pargr (ic_getr (ID_IC(id), "low"))
+ call dtput (dt, "\thigh_reject %g\n")
+ call pargr (ic_getr (ID_IC(id), "high"))
+ call dtput (dt, "\tgrow %g\n")
+ call pargr (ic_getr (ID_IC(id), "grow"))
+
+ ncoeffs = dcvstati (ID_CV(id), CVNSAVE)
+ call salloc (coeffs, ncoeffs, TY_DOUBLE)
+ call dcvsave (ID_CV(id), Memd[coeffs])
+ call dtput (dt, "\tcoefficients\t%d\n")
+ call pargi (ncoeffs)
+ do i = 1, ncoeffs {
+ call dtput (dt, "\t\t%g\n")
+ call pargd (Memd[coeffs+i-1])
+ }
+ }
+
+ call dtput (dt, "\n")
+
+ ID_NEWFEATURES(id) = NO
+ ID_NEWCV(id) = NO
+ ID_NEWDBENTRY(id) = NO
+
+ if (verbose == YES) {
+ call printf ("identify %s%s\n")
+ call pargstr (name)
+ call pargstr (ID_SECTION(id))
+ }
+
+ # Enter reference spectrum name in image header.
+ im = IM(sh)
+ call imseti (im, IM_WHEADER, YES)
+ call imastr (im, "REFSPEC1", ID_IMAGE(id))
+ iferr (call imdelf (im, "REFSPEC2"))
+ ;
+
+ call sfree (sp)
+end
+
+
+# ID_DBCHECK -- Check if there is an entry in the database.
+# This does not actually read the database entry. It also assumes that
+# if a database is already open it is for the same image (the image
+# names are not checked) and the database has been scanned.
+
+int procedure id_dbcheck (id, name, ap)
+
+pointer id # ID pointer
+char name[SZ_LINE] # Image name
+int ap[2] # Aperture number
+
+int rec, stat
+pointer sp, line, sec
+
+int dtlocate()
+
+errchk dtremap(), dtlocate()
+
+begin
+ call smark (sp)
+ call salloc (line, SZ_LINE, TY_CHAR)
+ call salloc (sec, SZ_LINE, TY_CHAR)
+
+ if (ID_DT(id) == NULL) {
+ call strcpy ("id", Memc[line], SZ_LINE)
+ call imgcluster (name, Memc[line+2], SZ_LINE)
+ iferr (call dtremap (ID_DT(id), ID_DATABASE(id), Memc[line],
+ READ_ONLY)) {
+ call sfree (sp)
+ return (NO)
+ }
+ }
+
+ call id_dbsection (id, name, ap, Memc[sec], SZ_LINE)
+ call sprintf (Memc[line], SZ_LINE, "identify %s%s")
+ call pargstr (name)
+ call pargstr (Memc[sec])
+
+ iferr (rec = dtlocate (ID_DT(id), Memc[line]))
+ stat = NO
+ else
+ stat = YES
+
+ call sfree (sp)
+ return (stat)
+end
+
+
+# ID_DBSECTION -- Make the IDENTIFY section.
+
+procedure id_dbsection (id, name, ap, section, sz_section)
+
+pointer id #I ID pointer
+char name[SZ_LINE] #I Image name
+int ap[2] #I Aperture number
+char section[sz_section] #O IDENTIFY section
+int sz_section #I Size of section string
+
+pointer sh, smw
+bool streq()
+
+begin
+ sh = ID_SH(id)
+ smw = MW(sh)
+
+ switch (SMW_FORMAT(smw)) {
+ case SMW_ND:
+ section[1] = EOS
+ if (streq (name, ID_IMAGE(id))) {
+ switch (SMW_LDIM(smw)) {
+ case 2:
+ switch (SMW_LAXIS(smw,1)) {
+ case 1:
+ call sprintf (section, sz_section, "[*,%d]")
+ case 2:
+ call sprintf (section, sz_section, "[%d,*]")
+ }
+ #call pargi (LINDEX(sh,1))
+ call pargi (ap[1])
+ case 3:
+ switch (SMW_LAXIS(smw,1)) {
+ case 1:
+ call sprintf (section, sz_section, "[*,%d,%d]")
+ case 2:
+ call sprintf (section, sz_section, "[%d,*,%d]")
+ case 3:
+ call sprintf (section, sz_section, "[%d,%d,*]")
+ }
+ #call pargi (LINDEX(sh,1))
+ #call pargi (LINDEX(sh,2))
+ call pargi (ap[1])
+ call pargi (ap[2])
+ }
+ }
+ case SMW_ES, SMW_MS:
+ call sprintf (section, sz_section, " - Ap %d")
+ call pargi (ap[1])
+ }
+end
generated by cgit (git 2.34.1) at 2025-09-20 09:08:46 -0400