Repatch (from linux) of OSX IRAF

1 files changed, 415 insertions, 0 deletions

diff --git a/noao/digiphot/apphot/aplib/apwparam1.x b/noao/digiphot/apphot/aplib/apwparam1.x
new file mode 100644
index 00000000..54086aeb
--- /dev/null
+++ b/noao/digiphot/apphot/aplib/apwparam1.x
@@ -0,0 +1,415 @@
+include <time.h>
+include "../lib/apphotdef.h"
+include "../lib/apphot.h"
+include "../lib/noise.h"
+include	"../lib/center.h"
+include "../lib/fitsky.h"
+include "../lib/phot.h"
+
+# AP_PARAM -- Procedure to write the apphot parameters to a text file.
+
+procedure ap_param (ap, out, task)
+
+pointer	ap		# pointer to the apphot structure
+int	out		# output file descriptor
+char	task[ARB]	# task name
+
+int	nchars
+pointer	sp, outstr, date, time
+bool	itob()
+int	strmatch(), envfind(), gstrcpy(), apstati()
+real	apstatr()
+
+begin
+	if (out == NULL)
+	    return
+	 
+	# Allocate working space.
+	call smark (sp)
+	call salloc (outstr, SZ_LINE, TY_CHAR)
+	call salloc (date, SZ_DATE, TY_CHAR)
+	call salloc (time, SZ_DATE, TY_CHAR)
+
+	# Write the id.
+
+	nchars = envfind ("version", Memc[outstr], SZ_LINE)
+	if (nchars <= 0)
+	    nchars = gstrcpy ("NOAO/IRAF", Memc[outstr], SZ_LINE)
+	call ap_rmwhite (Memc[outstr], Memc[outstr], SZ_LINE)
+	call ap_sparam (out, "IRAF", Memc[outstr], "version",
+	    "current version of IRAF")
+
+	nchars = envfind ("userid", Memc[outstr], SZ_LINE)
+	call ap_sparam (out, "USER", Memc[outstr], "name", "user id")
+
+	call gethost (Memc[outstr], SZ_LINE)
+	call ap_sparam (out, "HOST", Memc[outstr], "computer",
+	    "IRAF host machine")
+
+	call apdate (Memc[date], Memc[time], SZ_DATE)
+	call ap_sparam (out, "DATE", Memc[date], "yyyy-mm-dd", "date")
+	call ap_sparam (out, "TIME", Memc[time], "hh:mm:ss", "time")
+
+	call ap_sparam (out, "PACKAGE", "apphot", "name",
+	    "name of IRAF package")
+	call ap_sparam (out, "TASK", task, "name", "name of apphot task")
+	call fprintf (out, "#\n")
+
+	# Write out the apphot parameters.
+	call ap_rparam (out, KY_SCALE, 1.0 / apstatr (ap, SCALE), UN_AUNITS,
+	    "scale in units per pixel")
+	call ap_rparam (out, KY_FWHMPSF, apstatr (ap, FWHMPSF), UN_ASCALEUNIT,
+	    "full width half maximum of the psf")
+	call ap_bparam (out, KY_POSITIVE, itob (apstati (ap, POSITIVE)),
+	    UN_ASWITCH, "positive feature")
+	call ap_rparam (out, KY_DATAMIN, apstatr (ap, DATAMIN), UN_ACOUNTS,
+	    "minimum good data value")
+	call ap_rparam (out, KY_DATAMAX, apstatr (ap, DATAMAX), UN_ACOUNTS,
+	    "maximum good data value")
+
+	# Write out the image header keyword parameters.
+	call apstats (ap, EXPOSURE, Memc[outstr], SZ_FNAME)
+	if (Memc[outstr] == EOS)
+	    call strcpy ("\"\"", Memc[outstr], SZ_FNAME)
+	call ap_sparam (out, KY_EXPOSURE, Memc[outstr], UN_AKEYWORD,
+	    "exposure time keyword")
+	call apstats (ap, AIRMASS, Memc[outstr], SZ_FNAME)
+	if (Memc[outstr] == EOS)
+	    call strcpy ("\"\"", Memc[outstr], SZ_FNAME)
+	call ap_sparam (out, KY_AIRMASS, Memc[outstr], UN_AKEYWORD,
+	    "airmass keyword")
+	call apstats (ap, FILTER, Memc[outstr], SZ_FNAME)
+	if (Memc[outstr] == EOS)
+	    call strcpy ("\"\"", Memc[outstr], SZ_FNAME)
+	call ap_sparam (out, KY_FILTER, Memc[outstr], UN_AKEYWORD,
+	    "filter keyword")
+	call apstats (ap, OBSTIME, Memc[outstr], SZ_FNAME)
+	if (Memc[outstr] == EOS)
+	    call strcpy ("\"\"", Memc[outstr], SZ_FNAME)
+	call ap_sparam (out, KY_OBSTIME, Memc[outstr], UN_AKEYWORD,
+	    "obstime keyword")
+	call fprintf (out, "#\n")
+
+	# Write the noise model parameters.
+	call ap_wnse (ap, out)
+
+	# Write the centering parameters.
+	call ap_wctrs (ap, out)
+
+	# Write sky fitting parameters.
+	call ap_wskys (ap, out)
+
+	# Write the phot parameters.
+	call ap_wwphot (ap, out)
+
+	# Write the polyphot parameters.
+	call ap_wpoly (ap, out)
+
+	# Write the radial profile parameters.
+	call ap_wprofs (ap, out)
+
+	# Write the psf fitting parameters.
+	call ap_wpsf (ap, out)
+
+	# Write the header banner
+	if (strmatch ("^center", task) > 0)
+	    call ap_cphdr (ap, out)
+	else if (strmatch ("^fitsky", task) > 0)
+	    call ap_sphdr (ap, out)
+	else if (strmatch ("^phot", task) > 0)
+	    call ap_maghdr (ap, out)
+	else if (strmatch ("^qphot", task) > 0)
+	    call ap_maghdr (ap, out)
+	else if (strmatch ("^wphot", task) > 0)
+	    call ap_maghdr (ap, out)
+	else if (strmatch ("^polyphot", task) > 0)
+	    call ap_yhdr (ap, out)
+	else if (strmatch ("^fitpsf", task) > 0)
+	    call ap_pfhdr (ap, out)
+	else if (strmatch ("^radprof", task) > 0)
+	    call ap_rphdr (ap, out)
+	#else if (strmatch ("^daofind", task) > 0)
+	    #call ap_fdhdr (ap, out)
+
+	call sfree (sp)
+end
+
+
+# AP_WCTRS -- Procedure to write out the centering parameters.
+
+procedure ap_wctrs (ap, out)
+
+pointer	ap		# apphot pointer
+int	out		# output file descriptor
+
+pointer	sp, str
+bool	itob()
+int	apstati()
+real	apstatr()
+
+begin
+	if (out == NULL)
+	    return
+
+	call smark (sp)
+	call salloc (str, SZ_FNAME, TY_CHAR)
+
+	if (AP_PCENTER(ap) != NULL) {
+	    call apstats (ap, CSTRING, Memc[str], SZ_FNAME)
+	    call ap_sparam (out, KY_CSTRING, Memc[str], UN_CALGORITHM,
+		"centering algorithm")
+	    call ap_rparam (out, KY_CAPERT, 2.0* apstatr (ap, CAPERT),
+	        UN_CSCALEUNIT, "centering box width")
+	    call ap_rparam (out, KY_CTHRESHOLD, apstatr (ap, CTHRESHOLD),
+	        UN_CSIGMA, "threshold for centering")
+	    call ap_rparam (out, KY_MINSNRATIO, apstatr (ap, MINSNRATIO),
+		UN_CNUMBER, "minimum signal to noise ratio")
+	    call ap_iparam (out, KY_CMAXITER, apstati (ap, CMAXITER),
+	        UN_CNUMBER, "maximum number of iterations")
+	    call ap_rparam (out, KY_MAXSHIFT, apstatr (ap, MAXSHIFT),
+	        UN_CSCALEUNIT, "maximum shift")
+	    call ap_bparam (out, KY_CLEAN, itob (apstati (ap, CLEAN)),
+		UN_CSWITCH, "apply clean algorithm before centering")
+	    call ap_rparam (out, KY_RCLEAN, apstatr (ap, RCLEAN),
+	        UN_CSCALEUNIT, "cleaning radius")
+	    call ap_rparam (out, KY_RCLIP, apstatr (ap, RCLIP), UN_CSCALEUNIT,
+		"clipping radius")
+	    call ap_rparam (out, KY_SIGMACLEAN, apstatr (ap, SIGMACLEAN),
+	        UN_CSIGMA, "k-sigma clean rejection criterion")
+	    call fprintf (out, "#\n")
+	}
+
+	call sfree (sp)
+end
+
+
+# AP_WSKYS -- Procedure to write out the sky fitting  parameters.
+
+procedure ap_wskys (ap, out)
+
+pointer	ap		# apphot structure
+int	out		# output pointer
+
+pointer sp, str
+bool	itob()
+int	apstati()
+real	apstatr()
+
+begin
+	if (out == NULL)
+	    return
+
+	call smark (sp)
+	call salloc (str, SZ_FNAME, TY_CHAR)
+
+	if (AP_PSKY(ap) != NULL) {
+	    call apstats (ap, SSTRING, Memc[str], SZ_FNAME)
+	    call ap_sparam (out, KY_SSTRING, Memc[str], UN_SALGORITHM,
+		" sky fitting algorithm")
+	    call ap_rparam (out, KY_ANNULUS, apstatr (ap, ANNULUS),
+	        UN_SSCALEUNIT, "inner radius of sky annulus")
+	    call ap_rparam (out, KY_DANNULUS, apstatr (ap, DANNULUS),
+	        UN_SSCALEUNIT, "width of the sky annulus")
+	    call ap_rparam (out, KY_SKY_BACKGROUND, apstatr (ap,
+	        SKY_BACKGROUND), UN_SCOUNTS, "user supplied sky value")
+	    call ap_rparam (out, KY_K1, apstatr (ap, K1), UN_SSIGMA,
+		"half width of sky histogram")
+	    call ap_rparam (out, KY_BINSIZE, apstatr (ap, BINSIZE),
+	        UN_SSIGMA, "width of sky histogram bin")
+	    call ap_bparam (out, KY_SMOOTH, itob (apstati (ap, SMOOTH)),
+		UN_SSWITCH, "Lucy smooth the histogram")
+	    call ap_iparam (out, KY_SMAXITER, apstati (ap, SMAXITER),
+	        UN_SNUMBER, "maximum number of iterations")
+	    call ap_rparam (out, KY_SLOCLIP, apstatr (ap, SLOCLIP),
+	        UN_SPERCENT, "lower clipping limit")
+	    call ap_rparam (out, KY_SHICLIP, apstatr (ap, SHICLIP),
+	        UN_SPERCENT, "upper clipping limit")
+	    call ap_iparam (out, KY_SNREJECT, apstati (ap, SNREJECT),
+	        UN_SNUMBER, "maximum number of rejection cycles")
+	    call ap_rparam (out, KY_SLOREJECT, apstatr (ap, SLOREJECT),
+	        UN_SSIGMA, "lower k-sigma rejection criterion")
+	    call ap_rparam (out, KY_SHIREJECT, apstatr (ap, SHIREJECT),
+	        UN_SSIGMA, "upper k-sigma rejection criterion")
+	    call ap_rparam (out, KY_RGROW, apstatr (ap, RGROW), UN_SSCALEUNIT,
+		"region growing radius")
+	    call fprintf (out, "#\n")
+	}
+
+	call sfree (sp)
+end
+
+
+# AP_WNSE -- Porcedure to compute the noise model parameters.
+
+procedure ap_wnse (ap, out)
+
+pointer	ap		# apphot pointer
+int	out		# output file descriptor
+
+pointer	sp, str
+real	apstatr()
+
+begin
+	if (out == NULL)
+	    return
+	call smark (sp)
+	call salloc (str, SZ_FNAME, TY_CHAR)
+
+	if (AP_NOISE(ap) != NULL) {
+	    call apstats (ap, NSTRING, Memc[str], SZ_FNAME)
+	    call ap_sparam (out, KY_NSTRING, Memc[str], UN_NMODEL,
+	        "noise model")
+	    call ap_rparam (out, KY_SKYSIGMA, apstatr (ap, SKYSIGMA),
+	        UN_NCOUNTS, "standard deviation of 1 sky pixel")
+	    call apstats (ap, GAIN, Memc[str], SZ_FNAME)
+	    if (Memc[str] == EOS)
+	        call strcpy ("\"\"", Memc[str], SZ_FNAME)
+	    call ap_sparam (out, KY_GAIN, Memc[str], UN_NKEYWORD,
+	        "gain keyword")
+	    call ap_rparam (out, KY_EPADU, apstatr (ap, EPADU), UN_NEPADU,
+	        "electrons per adu")
+	    call apstats (ap, CCDREAD, Memc[str], SZ_FNAME)
+	    if (Memc[str] == EOS)
+	        call strcpy ("\"\"", Memc[str], SZ_FNAME)
+	    call ap_sparam (out, KY_CCDREAD, Memc[str], UN_NKEYWORD,
+	        "read noise keyword")
+	    call ap_rparam (out, KY_READNOISE, apstatr (ap, READNOISE),
+	        UN_NELECTRONS, "electrons")
+	    call fprintf (out, "#\n")
+	}
+
+	call sfree (sp)
+end
+
+
+# AP_WWPHOT -- Procedure to write out the photometry parameters.
+
+procedure ap_wwphot (ap, out)
+
+pointer	ap		# apphot structure pointer
+int	out		# output file descriptor
+
+pointer	sp, str
+real	apstatr()
+
+begin
+	if (out == NULL)
+	    return
+
+	call smark (sp)
+	call salloc (str, SZ_LINE, TY_CHAR)
+
+	if (AP_PPHOT(ap) != NULL) {
+	    call apstats (ap, PWSTRING, Memc[str], SZ_LINE)
+	    call ap_sparam (out, KY_PWSTRING, Memc[str], UN_PMODEL,
+		"photometric weighting scheme")
+	    call apstats (ap, APERTS, Memc[str], SZ_LINE)
+	    call ap_sparam (out, KY_APERTS, Memc[str], UN_PSCALEUNIT,
+		"list of apertures")
+	    call ap_rparam (out, KY_ZMAG, apstatr (ap, ZMAG), UN_PZMAG,
+		"zero point of magnitdue scale")
+	    call fprintf (out, "#\n")
+	}
+
+	call sfree (sp)
+end
+
+
+# AP_RPARAM -- Procedure to encode a real apphot parameter.
+
+procedure ap_rparam (out, keyword, value, units, comments)
+
+int	out		# output file descriptor
+char	keyword[ARB]	# keyword string
+real	value		# parameter value
+char	units[ARB]	# units string
+char	comments[ARB]	# comment string
+
+begin
+	if (out == NULL)
+	    return
+
+	call strupr (keyword)
+        call fprintf (out,
+	    "#K%4t%-10.10s%14t = %17t%-23.7g%41t%-10.10s%52t%-10s\n")
+	    call pargstr (keyword)
+	    call pargr (value)
+	    call pargstr (units)
+	    call pargstr ("%-23.7g")
+	    call pargstr (comments)
+end
+
+
+# AP_IPARAM -- Procedure to encode an apphot integer parameter.
+
+procedure ap_iparam (out, keyword, value, units, comments)
+
+int	out		# output file descriptor
+char	keyword[ARB]	# keyword string
+int	value		# parameter value
+char	units[ARB]	# units string
+char	comments[ARB]	# comment string
+
+begin
+	if (out == NULL)
+	    return
+
+	call strupr (keyword)
+        call fprintf (out,
+	    "#K%4t%-10.10s%14t = %17t%-23d%41t%-10.10s%52t%-10s\n")
+	    call pargstr (keyword)
+	    call pargi (value)
+	    call pargstr (units)
+	    call pargstr ("%-23d")
+	    call pargstr (comments)
+end
+
+
+# AP_BPARAM -- Procedure to encode an apphot boolean parameter.
+
+procedure ap_bparam (out, keyword, value, units, comments)
+
+int	out		# output file descriptor
+char	keyword[ARB]	# keyword string
+bool	value		# parameter value
+char	units[ARB]	# units string
+char	comments[ARB]	# comment string
+
+begin
+	if (out == NULL)
+	    return
+
+	call strupr (keyword)
+        call fprintf (out,
+	    "#K%4t%-10.10s%14t = %17t%-23b%41t%-10.10s%52t%-10s\n")
+	    call pargstr (keyword)
+	    call pargb (value)
+	    call pargstr (units)
+	    call pargstr ("%-23b")
+	    call pargstr (comments)
+end
+
+
+# AP_SPARAM -- Procedure to encode an apphot string parameter.
+
+procedure ap_sparam (out, keyword, value, units, comments)
+
+int	out		# output file descriptor
+char	keyword[ARB]	# keyword string
+char	value[ARB]	# parameter value
+char	units[ARB]	# units string
+char	comments[ARB]	# comment string
+
+begin
+	if (out == NULL)
+	    return
+
+	call strupr (keyword)
+        call fprintf (out,
+	    "#K%4t%-10.10s%14t = %17t%-23.23s%41t%-10.10s%52t%-10s\n")
+	    call pargstr (keyword)
+	    call pargstr (value)
+	    call pargstr (units)
+	    call pargstr ("%-23s")
+	    call pargstr (comments)
+end