aboutsummaryrefslogtreecommitdiff
path: root/noao/digiphot/daophot/daoedit/dpemark.x
diff options
context:
space:
mode:
Diffstat (limited to 'noao/digiphot/daophot/daoedit/dpemark.x')
-rw-r--r--noao/digiphot/daophot/daoedit/dpemark.x734
1 files changed, 734 insertions, 0 deletions
diff --git a/noao/digiphot/daophot/daoedit/dpemark.x b/noao/digiphot/daophot/daoedit/dpemark.x
new file mode 100644
index 00000000..de72fc2c
--- /dev/null
+++ b/noao/digiphot/daophot/daoedit/dpemark.x
@@ -0,0 +1,734 @@
+include <ctype.h>
+include "daoedit.h"
+
+# DP_MFWHMPSF -- Mark the fwhmpsf on the radial profile plot and confirm.
+
+procedure dp_mfwhmpsf (gd)
+
+pointer gd # pointer to the graphics stream
+
+int wcs, key, stat
+pointer sp, cmd
+real rmin, rmax, imin, imax, scale, fwhmpsf, wx, wy
+int clgcur()
+real clgetr()
+
+begin
+ call smark (sp)
+ call salloc (cmd, SZ_LINE, TY_CHAR)
+
+ # Determine the x and y limits of the current plot.
+ call ggwind (gd, rmin, rmax, imin, imax)
+
+ # Get the current parameters.
+ scale = 1.0 / clgetr ("datapars.scale")
+ fwhmpsf = clgetr ("datapars.fwhmpsf") / 2.0
+
+ # Mark the FWHM of the PSF on the radial profile plot.
+ call printf ("Mark HWHM of the psf (%g pixels):")
+ call pargr (fwhmpsf * scale)
+ call gscur (gd, fwhmpsf * scale, (imin + imax) / 2.0)
+ stat = clgcur ("gcommands", wx, wy, wcs, key, Memc[cmd], SZ_LINE)
+ if (stat == EOF || wx <= 0.0 || wx > rmax)
+ ;
+ else
+ fwhmpsf = wx / scale
+
+ # Store the new fwhmpsf.
+ call clputr ("datapars.fwhmpsf", 2.0 * fwhmpsf)
+
+ call sfree (sp)
+end
+
+
+# DP_MSIGMA -- Mark the sky sigma on the radial profile plot and confirm.
+
+procedure dp_msigma (gd)
+
+pointer gd # pointer to the grapics stream
+
+int wcs, key, stat
+pointer sp, cmd
+real rmin, rmax, imin, imax, mean, sigma, wx, wy
+int clgcur()
+real clgetr()
+
+begin
+ call smark (sp)
+ call salloc (cmd, SZ_LINE, TY_CHAR)
+
+ # Determine the range of the plot
+ call ggwind (gd, rmin, rmax, imin, imax)
+
+ # Mark the mean sky on the radial profile plot.
+ call printf ("Mark mean sky background level:")
+ call gscur (gd, (rmin + rmax) / 2.0, imin)
+ stat = clgcur ("gcommands", wx, wy, wcs, key, Memc[cmd], SZ_LINE)
+ if (stat == EOF || wy < imin || wy > imax)
+ mean = imin
+ else
+ mean = wy
+
+ # Get the current value.
+ sigma = clgetr ("datapars.sigma")
+ if (! IS_INDEFR (sigma))
+ sigma = 3.0 * sigma
+
+ # Mark the sky sigma on the radial profile plot.
+ call printf ("Mark 3 sigma sky level (%g counts):")
+ call pargr (sigma)
+ if (IS_INDEFR(sigma))
+ call gscur (gd, (rmin + rmax) / 2.0, imax)
+ else
+ call gscur (gd, (rmin + rmax) / 2.0, mean + sigma)
+ stat = clgcur ("gcommands", wx, wy, wcs, key, Memc[cmd], SZ_LINE)
+ if (stat == EOF || wy < imin || wy > imax)
+ ;
+ else
+ sigma = abs (wy - mean) / 3.0
+
+ # Store the new sky sigma.
+ call clputr ("datapars.sigma", sigma)
+
+ call sfree (sp)
+end
+
+
+# DP_MDMIN -- Mark the minimum good data value on the radial profile plot
+# and confirm.
+
+procedure dp_mdmin (gd)
+
+pointer gd # pointer to the grapics stream
+
+int wcs, key, stat
+pointer sp, cmd
+real rmin, rmax, imin, imax, datamin, wx, wy
+int clgcur()
+real clgetr()
+
+begin
+ call smark (sp)
+ call salloc (cmd, SZ_LINE, TY_CHAR)
+
+ # Determine the limits of the plot.
+ call ggwind (gd, rmin, rmax, imin, imax)
+
+ # Get the current value.
+ datamin = clgetr ("datapars.datamin")
+
+ # Mark the threshold on the radial profile plot.
+ call printf ("Mark the minimum good data level (%g counts):")
+ call pargr (datamin)
+
+ if (IS_INDEFR(datamin) || datamin < imin)
+ call gscur (gd, (rmin + rmax) / 2.0, imin)
+ else
+ call gscur (gd, (rmin + rmax) / 2.0, datamin)
+ stat = clgcur ("gcommands", wx, wy, wcs, key, Memc[cmd], SZ_LINE)
+ if (stat == EOF || wy < imin || wy > imax)
+ ;
+ else
+ datamin = wy
+
+ # Store the new good data minimum.
+ call clputr ("datapars.datamin", datamin)
+
+ call sfree (sp)
+end
+
+
+# DP_MDMAX -- Mark the maximum good data value on the radial profile plot
+# and confirm.
+
+procedure dp_mdmax (gd)
+
+pointer gd # pointer to the grapics stream
+
+int wcs, key, stat
+pointer sp, cmd
+real rmin, rmax, imin, imax, datamax, wx, wy
+int clgcur()
+real clgetr()
+
+begin
+ call smark (sp)
+ call salloc (cmd, SZ_LINE, TY_CHAR)
+
+ # Determine the limits of the plot.
+ call ggwind (gd, rmin, rmax, imin, imax)
+
+ # Get the current value.
+ datamax = clgetr ("datapars.datamax")
+
+ # Mark the threshold on the radial profile plot.
+ call printf ("Mark the maximum good data level (%g counts):")
+ call pargr (datamax)
+
+ if (IS_INDEFR(datamax) || datamax > imax)
+ call gscur (gd, (rmin + rmax) / 2.0, imax)
+ else
+ call gscur (gd, (rmin + rmax) / 2.0, datamax)
+ stat = clgcur ("gcommands", wx, wy, wcs, key, Memc[cmd], SZ_LINE)
+ if (stat == EOF || wy < imin || wy > imax)
+ ;
+ else
+ datamax = wy
+
+ # Store the new maximum good data value.
+ call clputr ("datapars.datamax", datamax)
+
+ call sfree (sp)
+end
+
+
+# DP_MCBOX -- Mark the centering aperture on the radial profile plot and
+# confirm.
+
+procedure dp_mcbox (gd)
+
+pointer gd # pointer to the grapics stream
+
+int wcs, key, stat
+pointer sp, cmd
+real rmin, rmax, imin, imax, scale, capert, wx, wy
+int clgcur()
+real clgetr()
+
+begin
+ call smark (sp)
+ call salloc (cmd, SZ_LINE, TY_CHAR)
+
+ # Determine the x and y limits of the current plot.
+ call ggwind (gd, rmin, rmax, imin, imax)
+
+ # Get the current values.
+ scale = 1.0 / clgetr ("datapars.scale")
+ capert = clgetr ("centerpars.cbox") / 2.0
+
+ # Mark the centering aperture on the radial profile plot.
+ call printf ("Mark centering box half width (%g pixels):")
+ call pargr (capert * scale)
+ call gscur (gd, capert * scale, (imin + imax) / 2.0)
+ stat = clgcur ("gcommands", wx, wy, wcs, key, Memc[cmd], SZ_LINE)
+ if (stat == EOF || wx <= 0.0 || wx > rmax)
+ ;
+ else
+ capert = wx / scale
+
+ # Store the new centering box.
+ call clputr ("centerpars.cbox", 2.0 * capert)
+
+ call sfree (sp)
+end
+
+
+# DP_MRCLEAN -- Mark the cleaning radius on the radial profile plot and
+# confirm.
+
+procedure dp_mrclean (gd)
+
+pointer gd # pointer to the graphics stream
+
+int wcs, key, stat
+pointer sp, cmd
+real rmin, rmax, imin, imax, scale, rclean, wx, wy
+int clgcur()
+real clgetr()
+
+begin
+ call smark (sp)
+ call salloc (cmd, SZ_LINE, TY_CHAR)
+
+ # Get the current plot window.
+ call ggwind (gd, rmin, rmax, imin, imax)
+
+ # Get the current values.
+ scale = 1.0 / clgetr ("datapars.scale")
+ rclean = clgetr ("centerpars.rclean")
+
+ # Mark the cleaning radius on the plot.
+ call printf (
+ "Mark the centering algorithm cleaning radius (%g pixels):")
+ call pargr (scale * rclean)
+ call gscur (gd, scale * rclean, (imin + imax) / 2.0)
+ stat = clgcur ("gcommands", wx, wy, wcs, key, Memc[cmd], SZ_LINE)
+ if (stat == EOF || wx <= 0.0 || wx > rmax)
+ ;
+ else
+ rclean = wx / scale
+
+ # Store the new cleaning radius.
+ call clputr ("centerpars.rclean", rclean)
+
+ call sfree (sp)
+end
+
+
+# DP_MRCLIP -- Mark the clipping radius on the radial profile plot and.
+# confirm.
+
+procedure dp_mrclip (gd)
+
+pointer gd # pointer to the grapics stream
+
+int wcs, key, stat
+pointer sp, cmd
+real rmin, rmax, imin, imax, scale, rclip, wx, wy
+int clgcur()
+real clgetr()
+
+begin
+ call smark (sp)
+ call salloc (cmd, SZ_LINE, TY_CHAR)
+
+ # Get the current plot window.
+ call ggwind (gd, rmin, rmax, imin, imax)
+
+ # Get the clipping radius values.
+ scale = 1.0 / clgetr ("datapars.scale")
+ rclip = clgetr ("centerpars.rclip")
+
+ # Mark clipping radius on the plot.
+ call printf (
+ "Mark the centering algorithm clipping radius (%g pixels):")
+ call pargr (scale * rclip)
+ call gscur (gd, scale * rclip, (imin + imax) / 2.0)
+ stat = clgcur ("gcommands", wx, wy, wcs, key, Memc[cmd], SZ_LINE)
+ if (stat == EOF || wx <= 0.0 || wx > rmax)
+ ;
+ else
+ rclip = wx / scale
+
+ # Store the new clipping radius.
+ call clputr ("centerpars.rclip", rclip)
+
+ call sfree (sp)
+end
+
+
+# DP_MANNULUS -- Mark the sky annulus on the radial profile plot and confirm.
+
+procedure dp_mannulus (gd)
+
+pointer gd # pointer to the grapics stream
+
+int wcs, key, stat
+pointer sp, cmd
+real rmin, rmax, imin, imax, scale, annulus, wx, wy
+int clgcur()
+real clgetr()
+
+begin
+ call smark (sp)
+ call salloc (cmd, SZ_LINE, TY_CHAR)
+
+ # Get the current plot window.
+ call ggwind (gd, rmin, rmax, imin, imax)
+
+ # Get the current values.
+ scale = 1.0 / clgetr ("datapars.scale")
+ annulus = clgetr ("fitskypars.annulus")
+
+ # Mark the inner sky radius.
+ call printf ("Mark inner sky radius (%g pixels):")
+ call pargr (annulus * scale)
+ call gscur (gd, annulus * scale, (imin + imax) / 2.0)
+ stat = clgcur ("gcommands", wx, wy, wcs, key, Memc[cmd], SZ_LINE)
+ if (stat == EOF || wx < 0.0 || wx > rmax)
+ ;
+ else
+ annulus = wx / scale
+
+ # Store the new sky annulus.
+ call clputr ("fitskypars.annulus", annulus)
+
+ call sfree (sp)
+
+end
+
+
+# DP_MDANNULUS -- Mark the sky annulus width on the radial profile plot and
+# confirm.
+
+procedure dp_mdannulus (gd)
+
+pointer gd # pointer to the grapics stream
+
+int wcs, key, stat
+pointer sp, cmd
+real rmin, rmax, imin, imax, scale, annulus, dannulus, wx, wy
+int clgcur()
+real clgetr()
+
+begin
+ call smark (sp)
+ call salloc (cmd, SZ_LINE, TY_CHAR)
+
+ # Get the current plot window.
+ call ggwind (gd, rmin, rmax, imin, imax)
+
+ # Get the current values.
+ scale = 1.0 / clgetr ("datapars.scale")
+ annulus = clgetr ("fitskypars.annulus")
+ dannulus = clgetr ("fitskypars.dannulus")
+
+ # Mark the outer sky radius.
+ call printf ("Mark outer sky radius (%g pixels):")
+ call pargr (scale * (annulus + dannulus))
+ call gscur (gd, scale * (annulus + dannulus), (imin + imax) / 2.0)
+ stat = clgcur ("gcommands", wx, wy, wcs, key, Memc[cmd], SZ_LINE)
+ if (stat == EOF || (wx / scale < annulus) || wx > rmax)
+ ;
+ else
+ dannulus = (wx / scale - annulus)
+
+ # Save the new sky annulus width.
+ call clputr ("fitskypars.dannulus", dannulus)
+
+ call sfree (sp)
+end
+
+
+# DP_MRGROW -- Mark the regions growing radius the radial profile plot.
+
+procedure dp_mrgrow (gd)
+
+pointer gd # pointer to the grapics stream
+
+int wcs, key, stat
+pointer sp, cmd
+real rmin, rmax, imin, imax, scale, rgrow, wx, wy
+int clgcur()
+real clgetr()
+
+begin
+ call smark (sp)
+ call salloc (cmd, SZ_LINE, TY_CHAR)
+
+ # Get the current plot window.
+ call ggwind (gd, rmin, rmax, imin, imax)
+
+ # Get the current values.
+ scale = 1.0 / clgetr ("datapars.scale")
+ rgrow = clgetr ("fitskypars.rgrow")
+
+ # Mark the inner sky radius.
+ call printf ("Mark region growing radius (%g pixels):")
+ call pargr (rgrow * scale)
+ call gscur (gd, rgrow * scale, (imin + imax) / 2.0)
+ stat = clgcur ("gcommands", wx, wy, wcs, key, Memc[cmd], SZ_LINE)
+ if (stat == EOF || wx < 0.0 || wx > rmax)
+ ;
+ else
+ rgrow = wx / scale
+
+ # Store the new sky annulus.
+ call clputr ("fitskypars.rgrow", rgrow)
+
+ call sfree (sp)
+
+end
+
+
+# DP_MAPER -- Mark the photometry apertures on the radial profile plot and
+# confirm.
+
+procedure dp_maper (gd)
+
+pointer gd # pointer to the grapics stream
+
+int wcs, key, naperts
+pointer sp, oapstr, aperts, tapstr, apstr, cmd
+real rmin, rmax, imin, imax, scale, wx, wy
+int dp_gaperts(), clgcur(), strlen()
+real clgetr()
+
+begin
+ call smark (sp)
+ call salloc (oapstr, SZ_LINE, TY_CHAR)
+ call salloc (aperts, MAX_NAPERTS, TY_REAL)
+ call salloc (apstr, SZ_LINE, TY_CHAR)
+ call salloc (tapstr, SZ_LINE, TY_CHAR)
+ call salloc (cmd, SZ_LINE, TY_CHAR)
+
+ # Determine the current plot window.
+ call ggwind (gd, rmin, rmax, imin, imax)
+
+ # Decode the apertures.
+ scale = 1.0 / clgetr ("datapars.scale")
+ call clgstr ("photpars.apertures", Memc[oapstr], SZ_LINE)
+ naperts = dp_gaperts (Memc[oapstr], Memr[aperts], MAX_NAPERTS)
+
+ # Type prompt string.
+ call printf ("Mark apertures (%s pixels) [q=quit]:")
+ call pargstr (Memc[oapstr])
+ call gscur (gd, Memr[aperts] * scale, (imin + imax) / 2.0)
+
+ # Mark the apertures.
+ Memc[apstr] = EOS
+ Memc[tapstr] = EOS
+ while (clgcur ("gcommands", wx, wy, wcs, key, Memc[cmd],
+ SZ_LINE) != EOF) {
+ if (key == 'q')
+ break
+ if (wx <= 0.0 || wx > rmax)
+ next
+ call sprintf (Memc[apstr+strlen(Memc[apstr])], SZ_FNAME,"%.2f,")
+ call pargr (wx / scale)
+ call sprintf (Memc[tapstr+strlen(Memc[tapstr])], SZ_FNAME,"%.2f,")
+ call pargr (wx)
+ call printf ("Mark apertures (%s pixels) [q=quit]:")
+ call pargstr (Memc[tapstr])
+ }
+ Memc[apstr+strlen(Memc[apstr])-1] = EOS
+
+ # Save the new aperture string.
+ call clpstr ("photpars.apertures", Memc[apstr])
+
+ call sfree (sp)
+end
+
+
+# DP_MPSFRAD -- Mark the psf radius on the radial profile plot and confirm.
+
+procedure dp_mpsfrad (gd)
+
+pointer gd # pointer to the graphics stream
+
+int wcs, key, stat
+pointer sp, cmd
+real rmin, rmax, imin, imax, scale, psfrad, wx, wy
+int clgcur()
+real clgetr()
+
+begin
+ call smark (sp)
+ call salloc (cmd, SZ_LINE, TY_CHAR)
+
+ # Determine the x and y limits of the current plot.
+ call ggwind (gd, rmin, rmax, imin, imax)
+
+ # Get the current values.
+ scale = 1.0 / clgetr ("datapars.scale")
+ psfrad = clgetr ("daopars.psfrad")
+
+ # Mark the FWHM of the PSF on the radial profile plot.
+ call printf ("Mark the PSF radius (%g pixels):")
+ call pargr (psfrad * scale)
+ call gscur (gd, psfrad * scale, (imin + imax) / 2.0)
+ stat = clgcur ("gcommands", wx, wy, wcs, key, Memc[cmd], SZ_LINE)
+ if (stat == EOF || wx <= 0.0 || wx > rmax)
+ ;
+ else
+ psfrad = wx / scale
+
+ # Store the new PSF radius.
+ call clputr ("daopars.psfrad", psfrad)
+
+ call sfree (sp)
+end
+
+
+# DP_MFITRAD -- Mark the fitting radius on the radial profile plot and confirm.
+
+procedure dp_mfitrad (gd)
+
+pointer gd # pointer to the graphics stream
+
+int wcs, key, stat
+pointer sp, cmd
+real rmin, rmax, imin, imax, scale, fitrad, wx, wy
+int clgcur()
+real clgetr()
+
+begin
+ call smark (sp)
+ call salloc (cmd, SZ_LINE, TY_CHAR)
+
+ # Determine the x and y limits of the current plot.
+ call ggwind (gd, rmin, rmax, imin, imax)
+
+ # Get the current values.
+ scale = 1.0 / clgetr ("datapars.scale")
+ fitrad = clgetr ("daopars.fitrad")
+
+ # Mark the FWHM of the PSF on the radial profile plot.
+ call printf ("Mark the fitting radius (%g pixels):")
+ call pargr (fitrad * scale)
+ call gscur (gd, fitrad * scale, (imin + imax) / 2.0)
+ stat = clgcur ("gcommands", wx, wy, wcs, key, Memc[cmd], SZ_LINE)
+ if (stat == EOF || wx <= 0.0 || wx > rmax)
+ ;
+ else
+ fitrad = wx / scale
+
+ # Store the new fitting radius.
+ call clputr ("daopars.fitrad", fitrad)
+
+ call sfree (sp)
+end
+
+
+# DP_GAPERTS -- Decode the aperture string.
+
+int procedure dp_gaperts (str, aperts, max_naperts)
+
+char str[ARB] # aperture string
+real aperts[ARB] # aperture array
+int max_naperts # maximum number of apertures
+
+int naperts, ip, op, ndecode, nap
+pointer sp, outstr
+real apstart, apend, apstep
+bool fp_equalr()
+int dp_gctor()
+
+begin
+ call smark (sp)
+ call salloc (outstr, SZ_LINE, TY_CHAR)
+
+ naperts = 0
+ for (ip = 1; str[ip] != EOS && naperts < max_naperts;) {
+
+ # Initialize.
+ apstart = 0.0
+ apend = 0.0
+ apstep = 0.0
+ ndecode = 0
+
+ # Skip past white space and commas.
+ while (IS_WHITE(str[ip]))
+ ip = ip + 1
+ if (str[ip] == ',')
+ ip = ip + 1
+
+ # Get the starting aperture number.
+ op = 1
+ while (IS_DIGIT(str[ip]) || str[ip] == '.') {
+ Memc[outstr+op-1] = str[ip]
+ ip = ip + 1
+ op = op + 1
+ }
+ Memc[outstr+op-1] = EOS
+
+ # Decode the starting aperture.
+ op = 1
+ if (dp_gctor (Memc[outstr], op, apstart) > 0) {
+ apend = apstart
+ ndecode = 1
+ } else
+ apstart = 0.0
+
+ # Skip past white space and commas.
+ while (IS_WHITE(str[ip]))
+ ip = ip + 1
+ if (str[ip] == ',')
+ ip = ip + 1
+
+ # Search for the ending aperture.
+ if (str[ip] == ':') {
+ ip = ip + 1
+
+ # Get the ending aperture.
+ op = 1
+ while (IS_DIGIT(str[ip]) || str[ip] == '.') {
+ Memc[outstr+op-1] = str[ip]
+ ip = ip + 1
+ op = op + 1
+ }
+ Memc[outstr+op-1] = EOS
+
+ # Decode the ending aperture.
+ op = 1
+ if (dp_gctor (Memc[outstr], op, apend) > 0) {
+ ndecode = 2
+ apstep = apend - apstart
+ }
+ }
+
+ # Skip past the white space.
+ while (IS_WHITE(str[ip]))
+ ip = ip + 1
+
+ # Skip past the commas.
+ if (str[ip] == ',')
+ ip = ip + 1
+
+ # Get the step size.
+ if (str[ip] == ':') {
+ ip = ip + 1
+
+ # Get the step size.
+ op = 1
+ while (IS_DIGIT(str[ip]) || str[ip] == '.') {
+ Memc[outstr+op-1] = str[ip]
+ ip = ip + 1
+ op = op + 1
+ }
+ Memc[outstr+op-1] = EOS
+
+ # Decode the step size.
+ op = 1
+ if (dp_gctor (Memc[outstr], op, apstep) > 0) {
+ if (fp_equalr (apstep, 0.0))
+ apstep = apend - apstart
+ else
+ ndecode = (apend - apstart) / apstep + 1
+ if (ndecode < 0) {
+ ndecode = -ndecode
+ apstep = - apstep
+ }
+ }
+ }
+
+ # Negative apertures are not permitted.
+ if (apstart <= 0.0 || apend <= 0.0)
+ break
+
+ # Fill in the apertures.
+ if (ndecode == 0) {
+ ;
+ } else if (ndecode == 1) {
+ naperts = naperts + 1
+ aperts[naperts] = apstart
+ } else if (ndecode == 2) {
+ naperts = naperts + 1
+ aperts[naperts] = apstart
+ if (naperts >= max_naperts)
+ break
+ naperts = naperts + 1
+ aperts[naperts] = apend
+ } else {
+ for (nap = 1; nap <= ndecode && naperts < max_naperts;
+ nap = nap + 1) {
+ naperts = naperts + 1
+ aperts[naperts] = apstart + (nap - 1) * apstep
+ }
+ }
+ }
+
+ call sfree (sp)
+
+ return (naperts)
+end
+
+
+# DP_GCTOR -- Procedure to convert a character variable to a real number.
+# This routine is just an interface routine to the IRAF procedure gctod.
+
+int procedure dp_gctor (str, ip, rval)
+
+char str[ARB] # string to be converted
+int ip # pointer to the string
+real rval # real value
+
+double dval
+int nchars
+int gctod()
+
+begin
+ nchars = gctod (str, ip, dval)
+ rval = dval
+ return (nchars)
+end
generated by cgit (git 2.34.1) at 2025-09-20 11:47:05 -0400