diff options
Diffstat (limited to 'noao/twodspec/apextract/apids.x')
| -rw-r--r-- | noao/twodspec/apextract/apids.x | 401 |
1 files changed, 401 insertions, 0 deletions
diff --git a/noao/twodspec/apextract/apids.x b/noao/twodspec/apextract/apids.x new file mode 100644 index 00000000..572890a5 --- /dev/null +++ b/noao/twodspec/apextract/apids.x @@ -0,0 +1,401 @@ +include <error.h> +include <mach.h> +include "apertures.h" + +# Data structure for user aperture id table. +define IDS_LEN 4 # Length of ID structure +define IDS_NIDS Memi[$1] # Number of aperture IDs +define IDS_APS Memi[$1+1] # Aperture numbers (pointer) +define IDS_BEAMS Memi[$1+2] # Beam numbers (pointer) +define IDS_TITLES Memi[$1+3] # Titles (pointer) + +# AP_GIDS -- Get user aperture ID's. + +procedure ap_gids (ids) + +pointer ids # ID structure + +int nids, ap, beam, fd, nalloc +double ra, dec +pointer sp, key, str, aps, beams, titles, im, list + +int nowhite(), open(), fscan(), nscan() +pointer immap(), imofnlu(), imgnfn() +errchk open + +begin + call smark (sp) + call salloc (key, SZ_FNAME, TY_CHAR) + call salloc (str, SZ_LINE, TY_CHAR) + + nids = 0 + nalloc = 0 + + call apgstr ("apidtable", Memc[key], SZ_FNAME) + if (nowhite (Memc[key], Memc[key], SZ_FNAME) > 0) { + iferr { + # Read aperture information from an image. + ifnoerr (im = immap (Memc[key], READ_ONLY, 0)) { + list = imofnlu (im, "SLFIB[0-9]*") + while (imgnfn (list, Memc[key], SZ_FNAME) != EOF) { + call imgstr (im, Memc[key], Memc[str], SZ_LINE) + call sscan (Memc[str]) + call gargi (ap) + if (nscan() == 0) + next + if (ap < 1) { + call imcfnl (list) + call imunmap (im) + call error (1, + "Aperture numbers in apidtable must be > 0") + } + if (nalloc == 0) { + nalloc = 50 + call malloc (aps, nalloc, TY_INT) + call malloc (beams, nalloc, TY_INT) + call malloc (titles, nalloc, TY_POINTER) + } else if (nids == nalloc) { + nalloc = nalloc + 50 + call realloc (aps, nalloc, TY_INT) + call realloc (beams, nalloc, TY_INT) + call realloc (titles, nalloc, TY_POINTER) + } + Memi[aps+nids] = ap + call gargi (Memi[beams+nids]) + call gargd (ra) + call gargd (dec) + if (nscan() != 4) { + call reset_scan () + call gargi (ap) + call gargi (beam) + Memc[str] = EOS + call gargstr (Memc[str], SZ_LINE) + call xt_stripwhite (Memc[str]) + if (Memc[str] == EOS) + Memi[titles+nids] = NULL + else { + call malloc (Memi[titles+nids], SZ_APTITLE, + TY_CHAR) + call strcpy (Memc[str], Memc[Memi[titles+nids]], + SZ_APTITLE) + } + } else { + Memc[str] = EOS + call gargstr (Memc[str], SZ_LINE) + call xt_stripwhite (Memc[str]) + call malloc (Memi[titles+nids], SZ_APTITLE, TY_CHAR) + if (Memc[str] == EOS) { + call sprintf (Memc[Memi[titles+nids]], + SZ_APTITLE, "(%.2h %.2h)") + call pargd (ra) + call pargd (dec) + } else { + call sprintf (Memc[Memi[titles+nids]], + SZ_APTITLE, "%s (%.2h %.2h)") + call pargstr (Memc[str]) + call pargd (ra) + call pargd (dec) + } + } + nids = nids + 1 + } + call imcfnl (list) + call imunmap (im) + + # Read aperture information from a file. + } else { + fd = open (Memc[key], READ_ONLY, TEXT_FILE) + while (fscan (fd) != EOF) { + call gargi (ap) + if (nscan() == 0) + next + if (ap < 1) { + call close (fd) + call error (1, + "Aperture numbers in apidtable must be > 0") + } + if (nalloc == 0) { + nalloc = 50 + call malloc (aps, nalloc, TY_INT) + call malloc (beams, nalloc, TY_INT) + call malloc (titles, nalloc, TY_POINTER) + } else if (nids == nalloc) { + nalloc = nalloc + 50 + call realloc (aps, nalloc, TY_INT) + call realloc (beams, nalloc, TY_INT) + call realloc (titles, nalloc, TY_POINTER) + } + Memi[aps+nids] = ap + Memi[beams+nids] = ap + Memc[str] = EOS + call gargi (beam) + if (nscan() == 2) + Memi[beams+nids] = beam + call gargstr (Memc[str], SZ_LINE) + call xt_stripwhite (Memc[str]) + if (Memc[str] == EOS) + Memi[titles+nids] = NULL + else { + call malloc (Memi[titles+nids], SZ_APTITLE, TY_CHAR) + call strcpy (Memc[str], Memc[Memi[titles+nids]], + SZ_APTITLE) + } + nids = nids + 1 + } + call close (fd) + } + } then + call erract (EA_WARN) + } + + if (nalloc > nids) { + call realloc (aps, nids, TY_INT) + call realloc (beams, nids, TY_INT) + call realloc (titles, nids, TY_INT) + } + + if (nids > 0) { + call malloc (ids, IDS_LEN, TY_STRUCT) + IDS_NIDS(ids) = nids + IDS_APS(ids) = aps + IDS_BEAMS(ids) = beams + IDS_TITLES(ids) = titles + } + + call sfree (sp) +end + + +procedure ap_fids (ids) + +pointer ids # ID structure +int i + +begin + if (ids != NULL) { + do i = 1, IDS_NIDS(ids) + call mfree (Memi[IDS_TITLES(ids)+i-1], TY_CHAR) + call mfree (IDS_APS(ids), TY_INT) + call mfree (IDS_BEAMS(ids), TY_INT) + call mfree (IDS_TITLES(ids), TY_POINTER) + call mfree (ids, TY_STRUCT) + } +end + + + +# AP_IDS -- Set aperture IDs +# Do not allow negative or zero aperture numbers. + +procedure ap_ids (aps, naps, ids) + +pointer aps[ARB] # Aperture pointers +int naps # Number of apertures +int ids # ID structure + +int i, j, k, l, m, axis, nids, ap, beam, skip, nused +real maxsep, apgetr() +pointer sp, used, a, b + +begin + if (naps < 1) + return + + axis = AP_AXIS(aps[1]) + maxsep = apgetr ("maxsep") + + # Dereference ID structure pointers. + if (ids != NULL) { + nids = IDS_NIDS(ids) + a = IDS_APS(ids) + b = IDS_BEAMS(ids) + } else + nids = 0 + + # Make a list of used aperture numbers + call smark (sp) + call salloc (used, naps, TY_INT) + nused = 0 + do i = 1, naps + if (!IS_INDEFI(AP_ID(aps[i]))) { + Memi[used+nused] = AP_ID(aps[i]) + nused = nused + 1 + } + + # Find first aperture with a defined aperture number. + for (i=1; i<=naps && IS_INDEFI(AP_ID(aps[i])); i=i+1) + ; + + # If there are no defined aperture numbers start with 1 or first + # aperture in the ID table. + + if (i > naps) { + i = 1 + if (nids > 0) { + ap = Memi[a] + beam = Memi[b] + } else { + ap = i + beam = ap + } + AP_ID(aps[i]) = ap + AP_BEAM(aps[i]) = beam + Memi[used+nused] = ap + nused = nused + 1 + } else { + ap = AP_ID(aps[i]) + for (l = 1; l <= nids && ap != Memi[a+l-1]; l = l + 1) + ; + if (l <= nids) + AP_BEAM(aps[i]) = Memi[b+l-1] + else + AP_BEAM(aps[i]) = ap + } + + # Work backwards through the undefined apertures. + for (j = i - 1; j > 0; j = j - 1) { + skip = abs (AP_CEN(aps[j],axis)-AP_CEN(aps[j+1],axis)) / maxsep + if (ids != NULL) { + ap = AP_ID(aps[j+1]) + for (l = 1; l <= nids && ap != Memi[a+l-1]; l = l + 1) + ; + if (nids <= naps) + skip = 0 + m = l - skip + if (l > nids) { + l = 1 + for (k = 2; k <= nids; k = k + 1) + if (abs (ap - Memi[a+k-1]) < abs (ap - Memi[a+l-1])) + l = k + m = l - skip + 1 + } + repeat { + m = m - 1 + if (m > 0) { + ap = Memi[a+m-1] + beam = Memi[b+m-1] + } else { + ap = Memi[a+l-1] + m + beam = max (0, Memi[b+l-1] + m) + } + if (ap == 0) + next + for (k = 0; k < nused && abs(ap) != Memi[used+k]; k = k + 1) + ; + if (k == nused) + break + } + } else { + ap = AP_ID(aps[j+1]) - skip + repeat { + ap = ap - 1 + beam = abs (ap) + if (ap == 0) + next + for (k = 0; k < nused && abs(ap) != Memi[used+k]; k = k + 1) + ; + if (k == nused) + break + } + } + ap = abs (ap) + AP_ID(aps[j]) = ap + AP_BEAM(aps[j]) = beam + Memi[used+nused] = ap + nused = nused + 1 + } + + # Work forwards through the undefined apertures. + for (i = i + 1; i <= naps; i = i + 1) { + if (IS_INDEFI(AP_ID(aps[i]))) { + skip = abs (AP_CEN(aps[i],axis)-AP_CEN(aps[i-1],axis)) / maxsep + if (nids > 0) { + ap = AP_ID(aps[i-1]) + for (l = 1; l <= nids && ap != Memi[a+l-1]; l = l + 1) + ; + if (nids <= naps) + skip = 0 + m = l + skip + if (l > nids) { + l = 1 + for (k = 2; k <= nids; k = k + 1) + if (abs (ap-Memi[a+k-1]) < abs (ap-Memi[a+l-1])) + l = k + m = l + skip - 1 + } + m = nids - m + 1 + repeat { + m = m - 1 + if (m > 0) { + ap = Memi[a+nids-m] + beam = Memi[b+nids-m] + } else { + ap = Memi[a+l-1] - m + beam = max (0, Memi[b+l-1] - m) + } + if (ap == 0) + next + for (k=0; k<nused && abs(ap)!=Memi[used+k]; k=k+1) + ; + if (k == nused) + break + } + } else { + ap = AP_ID(aps[i-1]) + skip + repeat { + ap = ap + 1 + beam = abs (ap) + if (ap == 0) + next + for (k=0; k<nused && abs(ap)!=Memi[used+k]; k=k+1) + ; + if (k == nused) + break + } + } + ap = abs(ap) + AP_ID(aps[i]) = ap + AP_BEAM(aps[i]) = beam + Memi[used+nused] = ap + nused = nused + 1 + } + } + + call sfree (sp) +end + + +procedure ap_titles (aps, naps, ids) + +pointer aps[ARB] # Aperture pointers +int naps # Number of apertures +pointer ids # ID structure + +int i, j, nids +pointer a, titles, title + +begin + if (ids == NULL) + return + + nids = IDS_NIDS(ids) + a = IDS_APS(ids) + titles = IDS_TITLES(ids) + + do i = 1, naps { + if (AP_TITLE(aps[i]) != NULL) + next + do j = 1, nids { + if (AP_ID(aps[i]) == Memi[a+j-1]) { + title = Memi[titles+j-1] + if (title != NULL) { + if (AP_TITLE(aps[i]) == NULL) + call malloc (AP_TITLE(aps[i]), SZ_APTITLE, TY_CHAR) + call strcpy (Memc[title], Memc[AP_TITLE(aps[i])], + SZ_APTITLE) + } else if (AP_TITLE(aps[i]) != NULL) + call mfree (AP_TITLE(aps[i]), TY_CHAR) + } + } + } +end |