Initial commit

80 files changed, 20074 insertions, 0 deletions

diff --git a/noao/obsutil/lib/noao/kpno/kpno.cl b/noao/obsutil/lib/noao/kpno/kpno.cl
new file mode 100644
index 00000000..01b95349
--- /dev/null
+++ b/noao/obsutil/lib/noao/kpno/kpno.cl
@@ -0,0 +1,13 @@
+#{ KPNO.CL -- KPNO observing utilities package.
+
+package	kpno
+
+task	kpnofocus = "obsnoao$kpno/kpnofocus.cl"
+
+if (access ("spectimedb$")) {
+    set sptimeKPNO = "spectimedb$KPNO/"
+    task mars = "spectimedb$scripts/mars.cl"
+} else
+    ;
+
+clbye
diff --git a/noao/obsutil/lib/noao/kpno/kpnofocus.cl b/noao/obsutil/lib/noao/kpno/kpnofocus.cl
new file mode 100644
index 00000000..a719c81d
--- /dev/null
+++ b/noao/obsutil/lib/noao/kpno/kpnofocus.cl
@@ -0,0 +1,41 @@
+# KPNOFOCUS -- KPNO Focus measuring task.
+# This is customized to the header keywords provided by ICE.
+
+procedure kpnofocus (images)
+
+string	images		{prompt="List of focus images"}
+int	frame = 1	{prompt="Display frame to use"}
+real	level = 0.5	{prompt="Measurement level (fraction or percent)"}
+string	size = "FWHM"	{prompt="Size to display",
+			 enum="Radius|FWHM|GFWHM|MFWHM"}
+real	scale = 1.	{prompt="Pixel scale"}
+real	radius = 5.	{prompt="Measurement radius (pixels)"}
+real	sbuffer = 5.	{prompt="Sky buffer (pixels)"}
+real	swidth = 5.	{prompt="Sky width (pixels)"}
+real	saturation = INDEF {prompt="Saturation level"}
+bool	ignore_sat = no {prompt="Ignore objects with saturated pixels?"}
+int	iterations = 2	{prompt="Number of radius adjustment iterations",
+			 min=1}
+string	logfile = "logfile" {prompt="Logfile"}
+
+begin
+	string	ims
+
+	ims = images
+
+#print ("\nKPNOFOCUS: Estimate best focus from ICE focus images.")
+#print ("  The stars to mark are from the first focus exposure which are the")
+#print ("  top ones in each sequence unless the display is flipped.")
+#print ("  Specifically, they are those with the largest y value in the")
+#print ("  sequence and closest to the double step gap.\n")
+print ("Mark the top star (in unflipped display).")
+
+	starfocus (ims, focus="FOCSTART", fstep="FOCSTEP",
+	    nexposures="FOCNEXPO", step="FOCSHIFT", direction="-line",
+	    gap="beginning", coords="markall", wcs="logical", display=yes,
+	    frame=frame, imagecur="", graphcur="", level=level, size=size,
+	    beta=INDEF, scale=scale, radius=radius, sbuffer=sbuffer,
+	    swidth=swidth, saturation=saturation, ignore_sat=ignore_sat,
+	    xcenter=INDEF, ycenter=INDEF, logfile=logfile,
+	    iterations=iterations)
+end
diff --git a/noao/obsutil/lib/noao/scripts.cl b/noao/obsutil/lib/noao/scripts.cl
new file mode 100644
index 00000000..9b913863
--- /dev/null
+++ b/noao/obsutil/lib/noao/scripts.cl
@@ -0,0 +1,12 @@
+# Logical directories
+
+set obsnoao = (obsutil.custom)
+
+# Database directories.
+
+#set ccdtime = noaolib$ccdtime/
+#set spectimedb = /iraf/extern/noaospectime/
+
+task $kpno.pkg = obsnoao$kpno/kpno.cl
+
+keep
diff --git a/noao/obsutil/mkpkg b/noao/obsutil/mkpkg
new file mode 100644
index 00000000..d180168e
--- /dev/null
+++ b/noao/obsutil/mkpkg
@@ -0,0 +1,8 @@
+# Make the OBSUTIL package.
+
+$call update@src
+$exit
+
+update:
+	$call update@src
+        ;
diff --git a/noao/obsutil/obsutil.cl b/noao/obsutil/obsutil.cl
new file mode 100644
index 00000000..dba19b08
--- /dev/null
+++ b/noao/obsutil/obsutil.cl
@@ -0,0 +1,42 @@
+#{ OBSUTIL.CL -- Observing utilities package.
+
+package	obsutil
+
+# Logical directories
+
+set	obssrc = "obsutil$src/"
+set	ccdtimesrc = "obssrc$ccdtime/"
+set	pairmass = "obssrc$pairmass/"
+set	sptime = "obssrc$sptime/"
+set	sptimelib = "sptime$lib/"
+set	specfocus = "obssrc$specfocus/"
+set	starfocus = "obssrc$starfocus/"
+
+
+# Executable Tasks
+
+task	bitcount	= "obssrc$x_obsutil.e"
+task	ccdtime		= "ccdtimesrc$x_obsutil.e"
+task	pairmass	= "pairmass$x_obsutil.e"
+task	specfocus	= "specfocus$x_obsutil.e"
+task	sptime,
+	$cgiparse	= "sptime$x_obsutil.e"
+task	psfmeasure,
+	starfocus	= "starfocus$x_obsutil.e"
+
+# Script Tasks
+
+task	findgain = "obssrc$findgain.cl"
+task	shutcor = "obssrc$shutcor.cl"
+
+# Pset Tasks
+
+task	specpars = "sptime$specpars.par"
+
+# User Tasks.
+if (access (obsutil.custom//"scripts.cl"))
+    cl (< obsutil.custom//"scripts.cl")
+else
+    ;
+
+clbye
diff --git a/noao/obsutil/obsutil.hd b/noao/obsutil/obsutil.hd
new file mode 100644
index 00000000..e2e5bae7
--- /dev/null
+++ b/noao/obsutil/obsutil.hd
@@ -0,0 +1,19 @@
+# Help directory for the OBSUTIL package.
+
+$src		= "./src/"
+$doc		= "./src/doc/"
+
+bitcount	hlp=doc$bitcount.hlp,		src=src$t_bitcount.x
+ccdtime		hlp=doc$ccdtime.hlp,		src=src$t_ccdtime.x
+cgiparse	hlp=doc$cgiparse.hlp,		src=src$sptime/t_cgiparse.x
+findgain	hlp=doc$findgain.hlp,		src=src$findgain.cl
+pairmass	hlp=doc$pairmass.hlp
+psfmeasure	hlp=doc$psfmeasure.hlp
+shutcor		hlp=doc$shutcor.hlp,		src=src$shutcor.cl
+specfocus	hlp=doc$specfocus.hlp
+sptime		hlp=doc$sptime.hlp
+starfocus	hlp=doc$starfocus.hlp
+
+kpnofocus	hlp=doc$kpnofocus.hlp
+
+revisions	sys=src$Revisions
diff --git a/noao/obsutil/obsutil.men b/noao/obsutil/obsutil.men
new file mode 100644
index 00000000..50885226
--- /dev/null
+++ b/noao/obsutil/obsutil.men
@@ -0,0 +1,18 @@
+-- Focusing and PSF measuring tasks --
+     psfmeasure - Measure PSF sizes from stellar images
+      specfocus - Determine spectral focus and alignment variations
+      starfocus - Determine direct focus variations from stellar images
+
+-- Observation planning tasks --
+	ccdtime - CCD photometry exposure time calculator
+       pairmass - Plot airmass vs time for a given coordinate
+	 sptime - Spectroscopic exposure time calculator
+       specpars - Spectrograph instrument parameters for sptime
+
+-- Instrument/detector characterization --
+       bitcount - Accumulate the bit statistics for a list of images
+       findgain - Estimate the gain and readnoise of a CCD 
+        shutcor - Shutter correction from images of varying exposure times
+
+-- Miscellaneous
+       cgiparse - Parse STRING_QUERY environment variable into task parameters
diff --git a/noao/obsutil/obsutil.par b/noao/obsutil/obsutil.par
new file mode 100644
index 00000000..845ed33f
--- /dev/null
+++ b/noao/obsutil/obsutil.par
@@ -0,0 +1,3 @@
+# OBSUTIL
+
+custom,f,h,"obsutil$lib/noao/",,,"Customization database"
diff --git a/noao/obsutil/src/Revisions b/noao/obsutil/src/Revisions
new file mode 100644
index 00000000..44497e52
--- /dev/null
+++ b/noao/obsutil/src/Revisions
@@ -0,0 +1,139 @@
+.help Revisions Nov01 obsutuil
+
+sptime/t_sptime.x
+    Made the graphs all auto-scale.  (11/14/08, Valdes)
+
+sptime/t_sptime.x
+sptime/stdisperser.x
+sptime/grating.x
+sptime/specpars.par
+sptime/sptime.h
+doc/sptime.hlp
+    Added a "generic" disperser type to force using the desired wavelength
+    and dispersion without defining a grating whose mapping between
+    position on the detector and wavelength might be wrong.  Also fixed
+    a couple of typos.  (11/13/08, Valdes)
+
+=======
+V2.14.1
+=======
+
+=======
+V2.13
+=======
+
+doc/ccdtime.hlp
+ccdtime/t_ccdtime.x
+    In order to get more than five filters while not changing the parameters
+    the f1-f5 input parameters may not be a comma delimited list of
+    desired filters.  Note that whitespace is not stripped and the
+    filter must match the string in the database so "U, V" will match
+    "U" but not "V".  Instead use "U,V".  (9/21/06, Valdes)
+
+
+=======
+V2.12.3
+=======
+
+t_sptime.x
+    1. For fibers or circular aperture the area of the aperture applied to
+    the sky flux was wrong because the size was treated as a radius instead
+    of a diameter.
+    2. In computing the sky flux reported the way seeing throughput was
+    applied was wrong.  (1/5/05, Valdes)
+
+
+========
+V2.12.2a
+========
+
+grating.x
+t_sptime.x
+    Added some checks against unphysical parameters.
+    (7/7/04, Valdes)
+
+mkpkg
+    Did not follow the standard convention of building xx_obsutil.e.
+    (7/7/04, Valdes)
+
+=======
+V2.12.2
+=======
+
+sptime/t_sptime.x
+sptime/sptime.par
+sptime/sptime.h
+    1.  Improved algorithm for handling saturation.
+    2.  Added a minimum exposure parameter.
+    (5/15/03, Valdes)
+
+starfocus/stfprofile.x
+    Limits on centroided image raster at the boundary have been removed.
+    Instead boundary reflection allows a somewhat unbiased centroid estimation
+    for sources near the edge.  (5/6/03, Valdes)
+
+starfocus/t_starfocus.x
+starfocus/starfocus.h
+starfocus/mkpkg
+    1.  Added 100 pixels of boundary reflection to allow some attempt at
+	measuring PSFs near the image edges.
+    2.  Now starting coordinates closer that a radius distance from the
+	image edge are allowed.  (5/6/03, Valdes)
+
+starfocus/stfprofile.x
+    The selection of a point to get a first estimation of the FWHM in
+    stf_fit did not check for the case of a zero value.  This could cause
+    a floating divide by zero.  (5/5/03, Valdes)
+
+starfocus/stfprofile.x
+    The subpixel evaluation involves fitting an image interpolator to a
+    subraster.  To avoid attempting to evaluate a point outside the center
+    of the edge pixels, which is a requirement of the image interpolators,
+    the interpolator is fit to the full data raster and the evaluations
+    exclude the boundary pixels.  (5/5/03, Valdes)
+
+ccdtime.par
+t_ccdtime.x
+    1.	The minimum seeing is now 0.001.
+    2.  The formating of the seeing was changed in case the seeing is set
+	less than 0.1.
+    (4/24/03, Valdes)
+
+t_sptime.x
+    The thermal background calculation was wrong.  (3/17/03, Valdes)
+
+../doc/cgiparse.hlp        +
+../../obsutil.hd
+    Added CGIPARSE task help.  (3/3/03, Valdes)
+
+sptime/t_cgiparse.x	+
+sptime/x_spectime.x
+sptime/mkpkg.x
+x_obsutil.x
+../obsutil.cl
+../obsutil.men
+    Added CGIPARSE task.  (3/3/03, Valdes)
+
+sptime/t_sptime.x
+sptime/specpars.par
+sptime/sptime.par
+sptime/sptime.h
+    See sptime/Revisions.  (3/3/03, Valdes)
+
+=======
+V2.12.1
+=======
+
+=====
+V2.12
+=====
+
+New obsutil package installed.
+    1. STARFOCUS, PSFMEASURE, SPECFOCUS extracted from NMISC.
+    2. CCDTIME copied from ASTUTIL
+    3. SPTIME, SPECPARS extracted from SPECTIME.
+    4. FINDGAIN copied and modified from MSCFINDGAIN.
+    5. BITCOUNT, PAIRMASS copied from NLOCAL.
+    (11/14/01, Valdes)
+
+.endhelp
diff --git a/noao/obsutil/src/bitcount.par b/noao/obsutil/src/bitcount.par
new file mode 100644
index 00000000..be93f6c2
--- /dev/null
+++ b/noao/obsutil/src/bitcount.par
@@ -0,0 +1,4 @@
+images,s,a,,,,Input image names
+grandtotal,b,h,no,,,Accumulate a grand total over all the images?
+leftzeroes,b,h,yes,,,Count the leftmost zeroes?
+verbose,b,h,yes,,,Verbose output?
diff --git a/noao/obsutil/src/ccdtime/Revisions b/noao/obsutil/src/ccdtime/Revisions
new file mode 100644
index 00000000..44405b23
--- /dev/null
+++ b/noao/obsutil/src/ccdtime/Revisions
@@ -0,0 +1,79 @@
+.help revisions Jun88 noao.obsutil
+.nf
+
+=======
+V2.12.2
+=======
+
+ccdtime.par
+t_ccdtime.x
+    1.	The minimum seeing is now 0.001.
+    2.  The formating of the seeing was changed in case the seeing is set
+	less than 0.1.
+    (4/24/03, Valdes)
+
+=======
+V2.12.1
+=======
+
+=====
+V2.12
+=====
+
+t_ccdtime.x
+../doc/ccdtime.hlp
+    It is now an error if time<0, time>10-000, abs(mag)>40, snr<0 or
+    snr>100000.  (8/24/00, Valdes)
+
+../doc/ccdtime.hlp
+    In the formula for r(sky) was pixel area term was in the wrong place.
+    (3/9/99, Valdes)
+
+t_ccdtime.x
+    For the case where SNR is very large and a time is specified the
+    iteration on the magnitude might not complete.  The iteration is now
+    capped at 100 and the test for convergence is now normalized.
+    (11/6/98, Valdes)
+
+t_ccdtime.x
+../doc/ccdtime.hlp
+    1.  The calculation of exposure time given a SNR was changed from an
+	interative solution to an analytic solution.
+    2.  The times are printed to 0.01s.
+    3.  The photometry aperture is now the rounded-up integer with a minimum
+	of 9 pixels.
+    (9/8/98, Valdes)
+
+t_ccdtime.x
+ccddb.x
+../doc/ccdtime.hlp
+    1.	The database keywords can now be index by reference to the telescope,
+	filter, and/or telescope.
+    2.  A new filter keyword, "extinction", was added to specify the
+	extinction.
+    3.	The extinction is now used to fixe the previous incorrect behavior
+	that used 1 mag/airmass extinction.  The old results are preserved
+	by making the default extinction be 1 if missing.  However the
+	database files should be updated to have correct extinctions.
+    (8/19/98, Valdes)
+
+ccddb.x
+../doc/ccdtime.hlp
+    1.	The code would not work with database entries containing whitespace.
+    2.	The help was not correct in describing how the number of pixels used
+	in the photometry is calculated from the seeing FWHM.
+    (4/5/94, Valdes)
+
+t_ccdtime.x
+    Modified CCDTIME to use a plate scale instead of the f/ratio and to
+    include an airmass term.  (10/23/93, Valdes)
+
+t_ccdtime.x	+
+ccddb.x		+
+ccdtime.x	-
+ccdtime.par
+doc/ccdtime.hlp
+    Revised CCDTIME to use a telescope/filter/detector database and to
+    compute and print additional information.  (8/16/93, Valdes)
+
+.endhelp
diff --git a/noao/obsutil/src/ccdtime/ccddb.x b/noao/obsutil/src/ccdtime/ccddb.x
new file mode 100644
index 00000000..e0f4dd1d
--- /dev/null
+++ b/noao/obsutil/src/ccdtime/ccddb.x
@@ -0,0 +1,222 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+# General text database routines.
+
+# Symbol table definitions.
+define	LEN_INDEX	10		# Length of symtab index
+define	LEN_STAB	512		# Length of symtab
+define	SZ_SBUF		512		# Size of symtab string buffer
+define	SYMLEN		40		# Length of symbol structure
+define	SZ_DBVAL	79		# Size of database value string
+
+# Symbol table structure
+define	DBVAL		Memc[P2C($1)]	# Database value string
+
+
+# DBOPEN -- Open database and store the requested information in symbol table.
+
+pointer procedure dbopen (dname, fname, kname, ename)
+
+char	dname[ARB]			#I Directory name
+char	fname[ARB]			#I File name
+char	kname[ARB]			#I Key name
+char	ename[ARB]			#I Entry name
+pointer	db				#O Database symbol table pointer
+
+int	fd, found, open(), fscan(), nscan()
+pointer	sp, pname, name, key, str, sym
+pointer	stopen(), stenter()
+bool	streq(), strne()
+errchk	open, stopen, stenter, fscan, dberror
+
+begin
+	call smark (sp)
+	call salloc (pname, SZ_FNAME, TY_CHAR)
+	call salloc (name, SZ_LINE, TY_CHAR)
+	call salloc (key, SZ_FNAME, TY_CHAR)
+	call salloc (str, SZ_LINE, TY_CHAR)
+
+	# Open database.
+	call sprintf (Memc[pname], SZ_FNAME, "%s%s")
+	    call pargstr (dname)
+	    call pargstr (fname)
+	fd = open (Memc[pname], READ_ONLY, TEXT_FILE)
+
+	# Strip entry name whitespace and convert to lower case.
+	call strcpy (ename, Memc[name], SZ_LINE)
+	call xt_stripwhite (Memc[name])
+	call strlwr (Memc[name])
+
+	# List entries in database.
+	if (Memc[name] == '?') {
+	    Call printf ("Entries for %s in database %s:\n")
+		call pargstr (kname)
+		call pargstr (Memc[pname])
+	    while (fscan (fd) != EOF) {
+		call gargwrd (Memc[key], SZ_FNAME)
+		call gargwrd (Memc[str], SZ_LINE)
+		call gargwrd (Memc[str], SZ_LINE)
+		if (nscan()<3 || Memc[key]=='#' || strne (Memc[key], kname))
+		    next
+		call printf ("\t%s\n")
+		    call pargstr (Memc[str])
+	    }
+	    call close (fd)
+	    call sfree (sp)
+	    return (NULL)
+	}
+	    
+	# Find entry.
+	found = 0
+	while (fscan (fd) != EOF) {
+	    call gargwrd (Memc[key], SZ_FNAME)
+	    call gargwrd (Memc[str], SZ_LINE)
+	    call gargwrd (Memc[str], SZ_LINE)
+	    if (nscan()<3 || Memc[key]=='#' || strne (Memc[key], kname))
+		next
+	    found = 1
+	    call strlwr (Memc[str])
+	    if (streq (Memc[str], Memc[name])) {
+		found = 2
+		break
+	    }
+	}
+
+	# Check if entry was found.
+	if (found != 2) {
+	    call close (fd)
+	    if (found != 1)
+		call dberror ("DBOPEN: Database entry not found", kname)
+	    else
+		call dberror ("DBOPEN: Database entry not found", ename)
+	}
+
+	# Create symbol table.
+	db = stopen (ename, LEN_INDEX, LEN_STAB, SZ_SBUF)
+
+	# Read the file and enter the parameters in the symbol table.
+	sym = stenter (db, Memc[key], SYMLEN)
+	call strcpy (ename, DBVAL(sym), SZ_DBVAL)
+	while (fscan(fd) != EOF) {
+	    call gargwrd (Memc[key], SZ_FNAME)
+	    call gargwrd (Memc[str], SZ_LINE)
+	    call gargwrd (Memc[str], SZ_LINE)
+	    if (nscan()>0 && (streq(Memc[key],"end") || streq(Memc[key],kname)))
+		break
+	    if (nscan() < 3 || Memc[key] == '#')
+		next
+	    sym = stenter (db, Memc[key], SYMLEN)
+	    call strcpy (Memc[str], DBVAL(sym), SZ_DBVAL)
+	}
+
+	call close (fd)
+	call sfree (sp)
+
+	return (db)
+end
+
+
+# DBCLOSE -- Close the database symbol table pointer.
+
+procedure dbclose (db)
+
+pointer	db			# Database symbol table pointer
+
+begin
+	if (db != NULL)
+	    call stclose (db)
+end
+
+
+# DBGETD -- Get double database parameter.
+
+double procedure dbgetd (db, param, arg1, arg2)
+
+pointer	db			# Database symbol table pointer
+char	param[ARB]		# Database parameter
+char	arg1[ARB], arg2[ARB]	# Optional arguments
+
+char	str[SZ_LINE]
+int	ip, ctod()
+double	dval
+errchk	dbgstr
+
+begin
+	call dbgstr (db, param, arg1, arg2, str, SZ_LINE)
+
+	ip = 1
+	if (ctod (str, ip, dval) <= 0)
+	    call dberror ("DBGETD: Database parameter not double", param)
+	return (dval)
+end
+
+
+# DBGSTR -- Get string valued parameter.
+
+procedure dbgstr (db, param, arg1, arg2, str, maxchar)
+
+pointer	db			# Database symbol table pointer
+char	param[ARB]		# Database parameter
+char	arg1[ARB], arg2[ARB]	# Optional arguments
+char	str[maxchar]		# Database parameter value
+int	maxchar			# Maximum characters for string
+
+pointer	sp, param1, sym, stfind()
+errchk	dberror
+
+begin
+	call smark (sp)
+	call salloc (param1, SZ_LINE, TY_CHAR)
+
+	sym = NULL
+	if (arg1[1] != EOS && arg2[1] != EOS) {
+	    call sprintf (Memc[param1], SZ_LINE, "%s(%s,%s)")
+		call pargstr (param)
+		call pargstr (arg1)
+		call pargstr (arg2)
+	    sym = stfind (db, Memc[param1])
+	    if (sym == NULL) {
+		call sprintf (Memc[param1], SZ_LINE, "%s(%s,%s)")
+		    call pargstr (param)
+		    call pargstr (arg2)
+		    call pargstr (arg1)
+		sym = stfind (db, Memc[param1])
+	    }
+	}
+	if (sym == NULL && arg1[1] != EOS) {
+	    call sprintf (Memc[param1], SZ_LINE, "%s(%s)")
+		call pargstr (param)
+		call pargstr (arg1)
+	    sym = stfind (db, Memc[param1])
+	}
+	if (sym == NULL && arg2[1] != EOS) {
+	    call sprintf (Memc[param1], SZ_LINE, "%s(%s)")
+		call pargstr (param)
+		call pargstr (arg2)
+	    sym = stfind (db, Memc[param1])
+	}
+	if (sym == NULL)
+	    sym = stfind (db, param)
+
+	call sfree (sp)
+
+	if (sym == NULL)
+	    call dberror ("DBGSTR: Database parameter not found", param)
+	call strcpy (DBVAL(sym), str, maxchar)
+end
+
+
+# DBERROR -- Print database error.
+
+procedure dberror (errstr, param)
+
+char	errstr[ARB]		# Error string
+char	param[ARB]		# Parameter
+char	errmsg[SZ_LINE]		# Error message
+
+begin
+	call sprintf (errmsg, SZ_LINE, "%s (%s)")
+	    call pargstr (errstr)
+	    call pargstr (param)
+	call error (1, errmsg)
+end
diff --git a/noao/obsutil/src/ccdtime/ccdtime.par b/noao/obsutil/src/ccdtime/ccdtime.par
new file mode 100644
index 00000000..d7a36c24
--- /dev/null
+++ b/noao/obsutil/src/ccdtime/ccdtime.par
@@ -0,0 +1,15 @@
+time,r,h,INDEF,,,Time (seconds)
+magnitude,r,h,20.,,,Magnitude
+snr,r,h,10.,0.1,,Signal-to-noise ratio
+database,s,h,"ccdtime$kpno.dat",,,Database file
+telescope,s,h,,,,Telescope name (? for list)
+detector,s,h,,,,Detector name (? for list)
+sum,i,h,1,,,CCD summing factor
+seeing,r,h,1.5,0.001,10.0,Seeing (arcsec)
+airmass,r,h,1.2,1.,,Airmass
+phase,r,h,0.,0.,28.,Moon phase (0-28)
+f1,s,h,U,,,Filter 1
+f2,s,h,B,,,Filter 2
+f3,s,h,V,,,Filter 3
+f4,s,h,R,,,Filter 4
+f5,s,h,I,,,Filter 5
diff --git a/noao/obsutil/src/ccdtime/mkpkg b/noao/obsutil/src/ccdtime/mkpkg
new file mode 100644
index 00000000..d468ef93
--- /dev/null
+++ b/noao/obsutil/src/ccdtime/mkpkg
@@ -0,0 +1,17 @@
+# Make the CCDTIME task.
+
+$checkout libpkg.a ../
+$update   libpkg.a
+$checkin  libpkg.a ../
+$exit
+
+standalone:
+	$update	libpkg.a
+	$omake	x_ccdtime.x
+	$link	x_ccdtime.o libpkg.a -lxtools -o xx_ccdtime.e
+	;
+
+libpkg.a:
+	ccddb.x	
+	t_ccdtime.x	
+	;
diff --git a/noao/obsutil/src/ccdtime/t_ccdtime.x b/noao/obsutil/src/ccdtime/t_ccdtime.x
new file mode 100644
index 00000000..0c0e8822
--- /dev/null
+++ b/noao/obsutil/src/ccdtime/t_ccdtime.x
@@ -0,0 +1,307 @@
+define	NF		25		# Maximum number of filters
+define	SZ_FILTER	7		# Maximum length of filter name
+define	TOL		0.0001		# Convergence tolerance
+
+
+# T_CCDTIME -- Compute the time, magnitude, and signal-to-noise for CCD
+# exposures for a given telescope, detector, and filters.  The telescope
+# detector, and filter data come from a text database.  The computed
+# quantities fix two parameters and compute the third.
+
+procedure t_ccdtime()
+
+pointer	database		# Telescope, detector, filter database
+pointer	telescope		# Telescope
+pointer	detector		# Detector
+pointer	fltr[5]			# Filters
+real	time			# Target time (sec)
+real	mag			# Target magnitude
+real	snr			# Target SNR
+int	sum			# CCD summing
+real	seeing			# Seeing (arcsec)
+real	phase			# Moon phase (0-28)
+real	airmass			# Airmass
+
+int	i, j, k, nf, n
+real	a, b, c
+real	aper, scale, trans, nread, dark, pixsize, lum, p
+real	star[NF], sky[NF], t, m, s, nstar, nsky, ndark, noise, npix
+real	dqe, ext, starmag, counts, sky0, sky1, sky2
+pointer	sp, tdb, ddb, filter[NF], fdb[NF]
+
+int	clgeti()
+real	clgetr()
+double	dbgetd()
+pointer	dbopen()
+errchk	dbopen
+
+define	done_	10
+
+begin
+	call smark (sp)
+	call salloc (database, SZ_FNAME, TY_CHAR)
+	call salloc (telescope, SZ_FNAME, TY_CHAR)
+	call salloc (detector, SZ_FNAME, TY_CHAR)
+	do i = 1, 5
+	    call salloc (fltr[i], SZ_LINE, TY_CHAR)
+	do i = 1, NF
+	    call salloc (filter[i], SZ_FILTER, TY_CHAR)
+
+	# Get task parameters.
+	call clgstr ("database", Memc[database], SZ_FNAME)
+	call clgstr ("telescope", Memc[telescope], SZ_FNAME)
+	call clgstr ("detector", Memc[detector], SZ_FNAME)
+	call clgstr ("f1", Memc[fltr[1]], SZ_LINE)
+	call clgstr ("f2", Memc[fltr[2]], SZ_LINE)
+	call clgstr ("f3", Memc[fltr[3]], SZ_LINE)
+	call clgstr ("f4", Memc[fltr[4]], SZ_LINE)
+	call clgstr ("f5", Memc[fltr[5]], SZ_LINE)
+
+	time = clgetr ("time")
+	mag = clgetr ("magnitude")
+	snr = clgetr ("snr")
+	sum = clgeti ("sum")
+	seeing = clgetr ("seeing")
+	phase = clgetr ("phase")
+	airmass = clgetr ("airmass")
+
+	# The input filter strings may be lists of filters and here
+	# we expand them into all filters.
+
+	nf = 1; k = 0
+	do i = 1, 5 {
+	    for (j = fltr[i]; Memc[j] != EOS; j = j + 1) {
+	        Memc[filter[nf]+k] = Memc[j]
+	        if (Memc[j] == ',') {
+		    Memc[filter[nf]+k] = EOS
+		    if (k > 0) {
+			nf = nf + 1; k = 0
+		    }
+		} else
+		    k = k + 1
+	    }
+	    Memc[filter[nf]+k] = EOS
+	    if (k > 0) {
+		nf = nf + 1; k = 0
+	    }
+	}
+	nf = nf - 1
+
+	i = 0
+	if (IS_INDEFR(time))
+	    i = i + 1
+	 else if (time <= 0.)
+	    call error (1, "Requested time must be greater than zero")
+	 else if (time > 100000.)
+	    call error (1, "Requested time must be less than 100,000")
+
+	if (IS_INDEFR(mag))
+	    i = i + 1
+	else if (mag > 40.)
+	    call error (1, "Requested magnitude must be less than 40")
+	else if (mag < -40.)
+	    call error (1, "Requested magnitude must be greater than -40")
+
+	if (IS_INDEFR(snr))
+	    i = i + 1
+	 else if (snr <= 0.)
+	    call error (1, "Requested SNR must be greater than zero")
+	 else if (snr > 100000.)
+	    call error (1, "Requested SNR must be less than 100,000")
+
+	if (i > 1) {
+	    call sfree (sp)
+	    call error (1,
+		"At least two of time, magnitude, and snr must be specified")
+	}
+
+	if (phase < 14)
+	    p = phase
+	else
+	    p = 28 - phase
+
+	# Open database entries.
+	# If '?' this will print list and then the task will exit.
+	# If an error occurs in the telescope or detector abort.
+	# If an error occurs in the filter ignore the filter.
+
+	tdb = dbopen ("", Memc[database], "telescope", Memc[telescope])
+	ddb = dbopen ("", Memc[database], "detector", Memc[detector])
+
+	n = 0
+	do i = 1, nf {
+	    iferr (fdb[n+1]=dbopen("",Memc[database],"filter",Memc[filter[i]]))
+		next
+	    if (fdb[n+1] == NULL)
+		goto done_
+	    n = n + 1
+	    filter[n] = filter[i]
+	}
+	if (tdb == NULL || ddb == NULL || n == 0)
+	    goto done_
+
+	# Get star and sky rates for telescope/detector/filter combination.
+	# Convert to a standard rate at 20th magnitude at the given airmass.
+
+	do i = 1, n {
+	    # Get telescope parameters.
+	    aper = dbgetd (tdb, "aperture", Memc[filter[i]], Memc[detector])
+	    scale = dbgetd (tdb, "scale", Memc[filter[i]], Memc[detector])
+	    trans = dbgetd (tdb, "transmission", Memc[filter[i]],
+		Memc[detector])
+
+	    # Get detector parameters.
+	    dqe = dbgetd (ddb, Memc[filter[i]], Memc[filter[i]],
+		Memc[telescope])
+	    nread = dbgetd (ddb, "rdnoise", Memc[filter[i]], Memc[telescope])
+	    dark = dbgetd (ddb, "dark", Memc[filter[i]], Memc[telescope])
+	    pixsize = dbgetd (ddb,"pixsize",Memc[filter[i]],Memc[telescope]) *
+		(scale / 1000) * sum
+	    npix  =  max (9, nint (1.4 * (seeing / pixsize)**2+0.5))
+
+	    # Get filter parameters.
+	    iferr (ext = dbgetd (fdb[i], "extinction", Memc[telescope],
+		Memc[detector]))
+		ext = 1
+	    starmag = dbgetd (fdb[i], "mag", Memc[telescope], Memc[detector])
+	    counts = dbgetd (fdb[i], "star", Memc[telescope], Memc[detector])
+	    sky0 = dbgetd (fdb[i], "sky0", Memc[telescope], Memc[detector])
+	    sky1 = dbgetd (fdb[i], "sky1", Memc[telescope], Memc[detector])
+	    sky2 = dbgetd (fdb[i], "sky2", Memc[telescope], Memc[detector])
+
+	    lum = 10. ** (0.4 * (starmag - 20.))
+	    star[i] = counts * lum * aper ** 2 * trans *
+		10 ** (0.4 * (1 - airmass) * ext)
+	    star[i] = star[i] * dqe
+	    sky[i] = sky0 + sky1 * p + sky2 * p * p
+	    sky[i] = star[i] * pixsize ** 2 * 10. ** ((20. - sky[i]) / 2.5)
+	}
+	if (!IS_INDEFR(mag))
+	    lum = 10. ** (0.4 * (20. - mag))
+
+	# Print header and column labels.
+	call printf ("Database: %-20s  Telescope: %-10s  Detector: %-10s\n")
+	    call pargstr (Memc[database])
+	    call pargstr (Memc[telescope])
+	    call pargstr (Memc[detector])
+	call printf ("  Sum: %-2d  Arcsec/pixel: %-4.2f  Pixels/star: %-4.1f\n")
+	    call pargi (sum)
+	    call pargr (pixsize)
+	    call pargr (npix)
+	call printf ("  Seeing: %-.3g  Airmass: %-4.2f  Phase: %-4.1f\n")
+	    call pargr (seeing)
+	    call pargr (airmass)
+	    call pargr (phase)
+	call printf ("\n%7s %7s %7s %7s %7s %7s %s\n")
+	    call pargstr ("Filter")
+	    call pargstr ("Time")
+	    call pargstr ("Mag")
+	    call pargstr ("SNR")
+	    call pargstr ("Star")
+	    call pargstr ("Sky/pix")
+	    call pargstr ("   Noise contributions")
+	call printf ("%47w %7s %7s %7s\n")
+	    call pargstr ("Star")
+	    call pargstr ("Sky")
+	    call pargstr ("CCD")
+
+	# Compute exposure time through each filter.
+
+	if (!IS_INDEFR(mag) && !IS_INDEFR(snr)) {
+	    call printf ("\n")
+	    do i = 1, n {
+		a = ((star[i] * lum) / snr) ** 2
+		b = -(star[i] * lum + npix * (sky[i] + dark))
+		c = -npix * nread ** 2
+		t = (-b + sqrt (b**2 - 4 * a * c)) / (2 * a)
+
+		nstar = star[i] * lum * t
+		nsky  = sky[i] * t
+		ndark = dark * t
+		noise = sqrt(nstar + npix * (nsky + ndark + nread**2))
+		s = nstar / noise
+		m = mag
+
+		call printf (
+		    "%7s %7.2f %7.1f %7.1f %7.1f %7.1f %7.2f %7.2f %7.2f\n")
+		    call pargstr (Memc[filter[i]])
+		    call pargr (t)
+		    call pargr (m)
+		    call pargr (s)
+		    call pargr (nstar)
+		    call pargr (nsky)
+		    call pargr (sqrt (nstar))
+		    call pargr (sqrt (npix * nsky))
+		    call pargr (sqrt (npix * (ndark + nread**2)))
+	    }
+	}
+
+	# Compute magnitude through each filter.
+	# Use resubstitution to iterate for SNR.
+
+	if (!IS_INDEFR(time) && !IS_INDEFR(snr)) {
+	    call printf ("\n")
+	    do i = 1, n {
+		m = 20
+		s = 0
+		do j = 1, 100 {
+		    t = time
+		    nstar = star[i] * 10**(0.4*(20.0-m)) * t
+		    nsky  = sky[i] * t
+		    ndark = dark * t
+		    noise = sqrt(nstar + npix * (nsky + ndark + nread**2))
+		    m = 20 - 2.5 * log10 (snr * noise / (t * star[i]))
+		    s = nstar / noise
+		    if (abs(1-s/snr) <= TOL)
+			break
+		}
+
+		call printf (
+		    "%7s %7.2f %7.1f %7.1f %7.1f %7.1f %7.2f %7.2f %7.2f\n")
+		    call pargstr (Memc[filter[i]])
+		    call pargr (t)
+		    call pargr (m)
+		    call pargr (s)
+		    call pargr (nstar)
+		    call pargr (nsky)
+		    call pargr (sqrt (nstar))
+		    call pargr (sqrt (npix * nsky))
+		    call pargr (sqrt (npix * (ndark + nread**2)))
+	    }
+	}
+
+	# Compute SNR through each filter.
+
+	if (!IS_INDEFR(time) && !IS_INDEFR(mag)) {
+	    call printf ("\n")
+	    do i = 1, n {
+		t = time
+		m = mag
+		nstar = star[i] * lum * t
+		nsky  = sky[i] * t
+		ndark = dark * t
+		noise = sqrt(nstar + npix * (nsky + ndark + nread**2))
+		s = nstar / noise
+
+		call printf (
+		    "%7s %7.2f %7.1f %7.1f %7.1f %7.1f %7.2f %7.2f %7.2f\n")
+		    call pargstr (Memc[filter[i]])
+		    call pargr (t)
+		    call pargr (m)
+		    call pargr (s)
+		    call pargr (nstar)
+		    call pargr (nsky)
+		    call pargr (sqrt (nstar))
+		    call pargr (sqrt (npix * nsky))
+		    call pargr (sqrt (npix * (ndark + nread**2)))
+	    }
+	}
+	call printf ("\n")
+
+done_
+	call dbclose (tdb)
+	call dbclose (ddb)
+	do i = 1, n
+	    call dbclose (fdb[i])
+	call sfree (sp)
+end
diff --git a/noao/obsutil/src/ccdtime/x_ccdtime.x b/noao/obsutil/src/ccdtime/x_ccdtime.x
new file mode 100644
index 00000000..cccfa908
--- /dev/null
+++ b/noao/obsutil/src/ccdtime/x_ccdtime.x
@@ -0,0 +1 @@
+task	ccdtime	= t_ccdtime
diff --git a/noao/obsutil/src/doc/bitcount.hlp b/noao/obsutil/src/doc/bitcount.hlp
new file mode 100644
index 00000000..22744f83
--- /dev/null
+++ b/noao/obsutil/src/doc/bitcount.hlp
@@ -0,0 +1,80 @@
+.help bitcount Mar93 noao.obsutil
+.ih
+NAME
+bitcount - accumulate the bit statistics for a list of images
+.ih
+USAGE
+bitcount images
+.ih
+PARAMETERS
+.ls images
+A list of image names whose bit statistics will be counted.  The
+statistics can either be reported for each individual image (the
+default) or as a grand total over all the images.
+.le
+.ls grandtotal = no
+If \fIgrandtotal\fR = yes, accumulate a grand total over all the
+images.  If \fIgrandtotal\fR = no (the default), report the statistics
+individually for each image in turn.
+.le
+.ls leftzeroes = yes
+If \fIleftzeroes\fR = yes, leftmost zeroes are counted into the
+statistics (the default).  If \fIleftzeroes\fR = no, leftmost zeroes
+(those past the most significant digit for each individual pixel)
+are omitted from the statistics.
+.le
+.ls verbose = yes
+If \fIverbose\fR = no, only the raw bit counts will be reported.
+.le
+.ih
+DESCRIPTION
+\fIBitcount\fR will report the absolute and relative proportions
+of zeroes and ones populating each bit plane of a list of images.
+This is useful for diagnosing problems with a CCD's A/D converter,
+especially when an input image is supplied that contains a linear
+ramp in exposure across the range of the A/D.
+
+The statistics for the list of images can be accumulated either
+individually for each image, or as a grand total over all of the
+images depending on the value of the \fIgrandtotal\fR parameter.
+A single linear exposure ramp can be mimiced by a grand total
+over a list of progressively more exposed images.  Care should
+be taken to arrange that the exposures sample all parts of the
+A/D's range.
+
+The \fIleftzeroes\fR parameter is used to correct a problem seen
+with the ctio.bitstat task.  Bitstat under-reports zeroes for the
+more significant bits since only pixels with values greater than
+the bit being currently counted participate in that count.  The
+severity and precise nature of this problem depends on the exposure
+level of a particular test image.  \fILeftzeroes\fR may be set to
+"no" if there is some reason to restore this behavior.
+
+The \fIverbose\fR parameter may be set to "no" in order to pass
+the raw bit counts on to some other task.
+.ih
+EXAMPLES
+To report the bit statistics for a test exposure ramp:
+
+.nf
+    nl> bitcount testramp
+.fi
+
+To accumulate a grand total over a list of images:
+
+.nf
+    nl> bitcount a001*.imh grandtotal+
+.fi
+.ih
+BUGS
+A warning will be issued when accumulating a grand total over a list
+of images whose datatypes vary.  In this case, the totals for each bit
+will be correct - to the extent that some images may not populate some
+bits - but the datatype of the final image in the list will control the
+range of bitplanes included in the output report.  The interpretation
+of the most significant bit as a sign bit will also depend on the
+datatype of this final image.
+.ih
+SEE ALSO
+imstatistics, ctio.bitstat
+.endhelp
diff --git a/noao/obsutil/src/doc/ccdtime.hlp b/noao/obsutil/src/doc/ccdtime.hlp
new file mode 100644
index 00000000..0dee4ed1
--- /dev/null
+++ b/noao/obsutil/src/doc/ccdtime.hlp
@@ -0,0 +1,364 @@
+.help ccdtime Nov01 noao.obsutil
+.ih
+NAME
+ccdtime -- compute time, magnitude, and signal-to-noise for CCDs
+.ih
+USAGE
+ccdtime
+.ih
+PARAMETERS
+.ls time = INDEF
+Time in seconds for output of magnitude at the specified signal-to-noise and
+signal-to-noise at the specified magnitude.  This time applies to all
+filters.  If specified as INDEF then no output at fixed exposure time will
+be produced.  If the value is not greater than zero or less than 100000
+an error is reported.
+.le
+.ls magnitude = 20.
+Magnitude for output of time at the specified signal-to-noise and
+signal-to-noise at the specified time.  This magnitude applies to all
+filters. If specified as INDEF then no output at fixed magnitude will
+be produced.  If the absolute value of the magnitude is greater than 40
+an error will be reported.
+.le
+.ls snr = 20.
+Signal-to-noise ratio for output of time at the specified magnitude and
+magnitude at the specified time.  This signal-to-noise ratio applies to all
+filters. If specified as INDEF then no output at fixed signal-to-noise
+ratio will be produced.  If the value is not greater than zero or less than
+100000 an error is reported.
+.le
+
+.ls database = "ccdtime$kpno.dat"
+Database file for telescope, filter, and detector information.  The format
+of this file is described elsewhere.  This file is typically a standard
+file from the logical directory "ccdtime$" or a personal copy in a
+user's directory.
+.le
+.ls telescope = "?"
+Telescope entry from the database.  If "?" a list of telescopes in the
+database is produced.  The name must match the entry name in the database
+but ignoring case.  If the same telescope has multiple focal ratios then
+there must be multiple entries in the database.
+.le
+.ls detector = ""
+Detector entry from the database.  If "?" a list of detectors in the
+database is produced.  The name must match the entry name in the database
+but ignoring case.
+.le
+.ls sum = 1
+CCD on-chip summing or binning factor.
+.le
+.ls seeing = 1.5
+Expected seeing (FWHM) in arc seconds.  The number of pixels used for computing
+the total star counts and the signal-to-noise is given by 1.4 times the square
+of the seeing converted to pixels and rounded up.
+.le
+.ls airmass = 1.2
+Airmass for observation.
+.le
+.ls phase = 0.
+Moon phase in days (0-28) for the estimation of sky brightness.  A
+phase of zero is new moon or dark sky conditions and a phase of 14
+is full moon.
+.le
+
+.ls f1 = "U", f2 = "B", f3 = "V", f4 = "R", f5 = "I"
+Filters for which to compute the CCD information.  If given as "?"
+a list of filters in the database is produced.  If the name (ignoring
+case) is not found then it is ignored.  A null name, that is "", is used
+to eliminate listing of a filter.  If more than five filters is desired
+each of the parameters may be a comma delimited list of desired filters.
+Note that whitespace is preserved so "U, V" will expand to "U" and " V"
+and so will not match "V" in the database.  Use "U,V" instead.
+.le
+.ih
+DESCRIPTION
+A telescope, CCD detector, and list of filters is selected from a database
+to define the expected photon/electron count rates.  These rates along with
+a specified seeing and airmass are used to estimate the signal-to-noise
+ratio (SNR) for a stellar observation in each filter.  The output provides
+three results per filter; the exposure time to achieve a desired SNR for a
+given magnitude, the magnitude to achieve a desired SNR in a given time, and
+the SNR at a specified magnitude and exposure time.  With each of these,
+the number of star photons (or CCD electrons) in an area 1.4 times the
+square of the seeing, the number of sky photons per pixel, and the RMS noise
+contributions from photon noise in the star, the sky, and the detector
+noise from dark current and read out noise are given.  Note that least two
+of the time, magnitude, and signal-to-noise ratio must be specified but if
+one is INDEF then output with that quantity fixed will be skipped or, in
+other words, only the output where the quantity is computed is produced.
+
+The calibration information needed to define the count rates are
+taken from a database file.  This file may be standard ones given in
+the logical directory "ccdtime$" or the user may create their own.
+The database contains entries organized by telescope name (which may
+include a focal ratio if there are multiple ones), detector name,
+and filter name.  One of the standard files may be used as a template.
+
+The file is actually in free format with whitespace and comments ignored.
+However, following the template formatting makes it easy to see the logical
+structure.  All lines, except the "end" line which separates the different
+catagories of entries, consist of a keyword an equal sign, and a value
+separated by whitespace.  An entry begins with one of the keywords
+"telescope", "detector", or "filter" and ends with the beginning of
+a new entry or the "end" separator.
+
+A keyword is one of the words shown in the example below.  These keywords
+can also be indexed by the name of a telescope, filter, and/or detector
+entry.  This allows having different transmissions in different filters
+due to correctors, different scales for different detectors which may
+have fore-optics, etc.
+
+Specifically a keyword in the telescope section may have arguments
+from the filter or detector entries, a keyword in the filter section may
+have arguments from the telescope and detector entries, and a keyword
+in the detector section may have arguments from the telescope and filter
+entries.  The formats are keyword, keyword(arg), and keyword(arg,arg).
+The arg fields must match an entry name exactly (without the quotes)
+and there can be no whitespace between the keyword and (, between (
+and the argument, between the arguments and the comma, and between the
+last argument and the closing ).  The software will first look for
+keywords with both arguments in either order, then for keywords with
+one argument, and then for keywords with no arguments.
+
+Below is an example of each type of entry:
+
+.nf
+    telescope = "0.9m"
+	    aperture = 0.91
+	    scale = 30.2
+	    transmission = 1.0
+	    transmission(U) = 0.8
+	    transmission(U,T1KA) = 0.7
+
+    filter = "U"
+	    mag = 20
+	    star = 18.0
+	    extinction = 0.2
+	    sky0 = 22.0
+	    sky1 = -0.2666
+	    sky2 = -.00760
+
+    detector = "T1KA"
+	    rdnoise = 3.5
+	    dark = 0.001
+	    pixsize = 24
+	    U = 0.36
+	    B = 0.61
+	    V = 0.71
+	    R = 0.78
+	    I = 0.60
+.fi
+
+In the example, a transmission of 0.7 will be used if the filter is U
+and the detector is T1KA, a value of 0.8 if the filter is U and the
+detector is not T1KA, and a value of 1 for all other cases.
+
+The telescope entry contains the aperture diameter in meters, the
+scale in arcsec/mm, and a transmission factor.  The transmission factor is
+mostly a fudge factor but may be useful if a telescope has various
+configurations with additional mirrors and optics.
+
+The filter entry contains a fiducial magnitude and the total photon count
+rate for a star of that magnitude.  The units are photons per second
+per square meter of aperture.  An effective extinction in magnitudes/airmass is
+given here.  The sky is defined by a quadratic
+function of lunar phase in days:
+
+.nf
+	if (phase < 14)
+	    sky = sky0 + sky1 * phase + sky2 * phase**2
+	else
+	    sky = sky0 + sky1 * (14 - phase) + sky2 * (14 - phase)**2
+.fi
+
+One may set the higher order terms to zero if the moon contribution
+is to be ignored.  The units are magnitudes per square arc second.
+
+The detector entry contains the read out noise in electrons, the
+dark current rate in electrons per second, the pixel size in
+microns, and the detective quantum efficiency (DQE); the fraction of
+detected photons converted to electrons.  Note that the actual
+values used are the DQE times the rates given by the filter entries.
+Thus, one may set the DQE values to 1 and adjust the filter values
+or set the star count rates to 1 in the filter and set the actual
+count rates in the DQE values.
+
+The computed quantities are formally given as follows.  The
+star count rates for the specified telescope/detector/filter are:
+
+.nf
+	r(star) = star * aperture**2 * transmission *
+	    10**(0.4*(1-airmass)*extinction) * dqe
+.fi
+
+where the "star", "aperture", "transmission", "extinction", are those
+in the database and the "dqe" is the appropriate filter value.  The sky
+rate per pixel is:
+
+.nf
+	r(sky) = r(star) * 10 ** (0.4 * (mag - sky)) * pixel**2
+	pixel = pixsize * scale * sum
+.fi
+
+where mag is the fiducial magnitude, sky is the value computed using
+the quadratic formula for the specified moon phase and the database
+coefficients, the "pixel" size is computed using the CCD pixel size and
+the telescope scale from the database, and sum is the
+specified CCD binning factor.
+
+The number of pixels per star is computed from the seeing as:
+
+.nf
+	npix = 1.4 * (seeing / pixel) ** 2
+.fi
+
+where the number is rounded up to the next integer and a minimum of 9
+pixels is enforced.  This number is a compromise between a large aperture
+for high SNR stars and a smaller aperture for fainter stars.
+
+The number of star photons/electrons per star of magnitude m,
+the number of sky photons per pixel, and the number of dark current
+electrons, all in exposure time t, are given by:
+
+.nf
+	nstar = r(star) * 10 ** (0.4 * (mag - m)) * t
+	nsky = r(sky) * t
+	ndark = dark * t
+.fi
+
+where dark is taken from the detector database entry.
+
+Finally the noise contributions, total noise, and signal-to-noise are
+given by:
+
+.nf
+	noise star = nstar ** 1/2
+	noise sky = (npix * nsky) ** 1/2
+	noise ccd = (npix * (ndark + rdnoise**2)) ** 1/2
+	noise total = (nstar+npix*(nsky+ndark+rdnoise**2)) ** 1/2
+	SNR = nstar / noise total
+.fi
+.ih
+EXAMPLES
+1.  To get a list of the telescopes, filters, and detectors in a database:
+
+.nf
+    cl> ccdtime telescope=? detector=? f1=?
+    Entries for telescope in database ccdtime$kpno.dat:
+	    0.9m
+	    ...
+	    4m
+    Entries for detector in database ccdtime$kpno.dat:
+	    T1KA
+	    T2KA
+	    T2KB
+	    TI2
+	    TI3
+	    T5HA
+	    S2KA
+    Entries for filter in database ccdtime$kpno.dat:
+	    U
+	    B
+	    V
+	    R
+	    I
+.fi
+
+2.  The following is for the default magnitude and SNR and with
+a 1 second exposure time specified.  The output has some
+whitespace removed to fit on this page.
+
+.nf
+    cl> ccdtime time=1
+    Telescope: 0.9m
+    Detector: t1ka
+    Database: ccdtime$kpno.dat Telescope: 0.9m    Detector: t1ka
+      Sum: 1 Arcsec/pixel: 0.72  Pixels/star: 6.0
+      Seeing: 1.5  Airmass: 1.20  Phase: 0.0
+
+
+     Filter  Time   Mag   SNR   Star Sky/pix Noise contributions
+					      Star    Sky    CCD
+
+	  U  70.2  20.0  10.0  196.6    8.8  14.02   8.90  10.53
+	  B  13.0  20.0  10.0  208.8   13.0  14.45  10.82  10.51
+	  V  13.2  20.0  10.0  250.7   29.8  15.83  16.37  10.51
+	  R  17.3  20.0  10.0  365.8   95.9  19.13  29.38  10.51
+	  I 126.4  20.0  10.0 1259.2 1609.8  35.49 120.37  10.55
+
+	  U   1.0  15.6  10.0  166.6    0.1  12.91   1.06  10.50
+	  B   1.0  17.4  10.0  170.0    1.0  13.04   3.00  10.50
+	  V   1.0  17.6  10.0  174.6    2.3  13.21   4.50  10.50
+	  R   1.0  17.6  10.0  186.0    5.5  13.64   7.06  10.50
+	  I   1.0  16.7  10.0  207.9   12.7  14.42  10.71  10.50
+
+	  U   1.0  20.0   0.3    2.8    0.1   1.67   1.06  10.50
+	  B   1.0  20.0   1.4   16.0    1.0   4.00   3.00  10.50
+	  V   1.0  20.0   1.6   19.0    2.3   4.36   4.50  10.50
+	  R   1.0  20.0   1.6   21.1    5.5   4.59   7.06  10.50
+	  I   1.0  20.0   0.7   10.0   12.7   3.16  10.71  10.50
+
+.fi
+
+Note that the default of 1 second in the last section
+gives the count rates per second for star and sky.
+
+3.  Sometimes one may want to vary one parameter easily on the command
+line or query.  This can be done by changing the parameter to query
+mode.  In the following example we want to change the magnitude.
+
+.nf
+    cl> ccdtime.magnitude.p_mode=query
+    cl> ccdtime.telescope="0.9m"
+    cl> ccdtime.detector="t1ka"
+    cl> ccdtime.f1=""; ccdtime.f5=""
+    cl> ccdtime
+    Magnitude (20.):
+    Database: ccdtime$kpno.dat   Telescope: 0.9m     Detector: t1ka
+      Sum: 1 Arcsec/pixel: 0.72  Pixels/star: 6.0
+      Seeing: 1.5  Airmass: 1.20  Phase: 0.0
+
+     Filter  Time   Mag   SNR  Star Sky/pix  Noise contributions
+					       Star   Sky    CCD
+
+	  B  13.0  20.0  10.0 208.8    13.0  14.45  10.82  10.51
+	  V  13.2  20.0  10.0 250.7    29.8  15.83  16.37  10.51
+	  R  17.3  20.0  10.0 365.8    95.9  19.13  29.38  10.51
+
+    cl> ccdtime 21
+    ...
+    cl> ccdtime 22
+    ...
+.fi
+.ih
+REVISIONS
+.ls CCDTIME V2.13
+The f1 to f5 parameters were modified to allow lists of filters so
+that more than five filters can be output without changing the parameter
+interface.
+.le
+.ls CCDTIME V2.12
+Task added to OBSUTIL package.
+.le
+.ls CCDTIME V2.11.4
+A error will be reported if the requested time or SNR is not greater
+than zero and less than 100000., or if the absolute value
+of the magnitude is greater than 40.
+.le
+.ls CCDTIME V2.11.2
+The incorrect usage of a 1 mag/airmass extinction was fixed by adding an
+expected "extinction" entry in the filter entries.  Note that old files
+will still give the same result by using an extinction of 1 if the keyword
+is not found.
+
+The database keywords can not be indexed by telescope, filter, and/or
+detector.
+
+The number of pixels per aperture now has a minimum of 9 pixels.
+.le
+.ih
+SEE ALSO
+sptime
+.endhelp
diff --git a/noao/obsutil/src/doc/cgiparse.hlp b/noao/obsutil/src/doc/cgiparse.hlp
new file mode 100644
index 00000000..f054ca4e
--- /dev/null
+++ b/noao/obsutil/src/doc/cgiparse.hlp
@@ -0,0 +1,166 @@
+.help cgiparse Mar03 noao.obsutil
+.ih
+NAME
+cgiparse -- parse STRING_QUERY environment var. into parameters
+.ih
+SYNOPSIS
+CGIPARSE parses the STRING_QUERY environment varabile and sets parameters.
+The string format is a list of task.param=value pairs which includes the
+standard QUERY string special characters '&', '+', and '%'.  This is
+intended to parse a query from a CGI script.
+.ih
+USAGE
+cgiparse
+.ih
+PARAMETERS
+There are no parameters.  The input is the value of the QUERY_STRING
+environment variable.
+.ih
+DESCRIPTION
+CGIPARSE parses the STRING_QUERY environment varabile and sets parameters.
+The string format is a list of task.param=value pairs which includes the
+standard QUERY string special characters '&', '+', and '%'.  This is
+intended to parse a query from a CGI script.
+
+The only input is the STRING_QUERY variable.  If it is undefined the
+task simply does nothing.  The string will normally use the standard
+parameters for this type of string.  The data fields are task.param=value
+strings.  As each is parsed the values will be set for the task.  This
+assumes the tasks are defined.  Theere is no error checking for
+undefined tasks or parameters.
+.ih
+EXAMPLES
+1.  A CGI script calls a CL script with the STRING_QUERY string set.
+The string has "imheader.longheader=yes".  CGIPARSE is called and
+when it completes the parameter value is set.
+
+.nf
+    cl> lpar imhead
+    cl> lpar imheader
+           images =                 image names
+          (imlist = "*.imh,*.fits,*.pl,*.qp,*.hhh") default image ...
+      (longheader = no)             print header in multi-line format
+      (userfields = yes)            print the user fields ...
+            (mode = "ql")           
+    cl> cgiparse
+    cl> lpar imheader
+           images =                 image names
+          (imlist = "*.imh,*.fits,*.pl,*.qp,*.hhh") default image ...
+      (longheader = yes)            print header in multi-line format
+      (userfields = yes)            print the user fields ...
+            (mode = "ql")           
+.fi
+
+Note that when running this in a "#!cl" script where the "login.cl" is
+not used that you must be careful to have all tasks referenced by the
+query string defined.
+
+2.  Below is a "#!cl" type script that uses CGIPARSE.  It is used for
+a spectral exposure time calculator based on OBSUTIL.SPTIME though many
+aspects are fairly generic for this type of application.
+
+.nf
+#!/iraf/iraf/bin.freebsd/cl.e -f
+
+file	urldir
+
+# The following must be set for different hosts.
+# The home directory and the urldir are the same but in different syntax.
+# The home directory must have a world writable tmp subdirectory.
+
+set arch = ".freebsd"
+set (home = osfn ("/www/htdocs/noao/staff/brooke/gsmt/"))
+urldir = "/noao/staff/brooke/gsmt/"
+
+# The uparm is a unique temporary directory.
+s1 = mktemp ("uparm") // "/"
+set (uparm = "home$/tmp/" // s1)
+mkdir uparm$
+cd uparm
+printf ("!/bin/chmod a+rw %s\n", osfn("uparm$")) | cl
+
+# The URL directory is the same as uparm.
+urldir = urldir // "tmp/" // s1
+
+# A private graphcap is required to give an path for sgidispatch.
+set graphcap = home$graphcap
+
+# Load packages.
+dataio
+proto
+noao
+onedspec
+spectime
+gsmt
+
+# Parse the CGI string and set parameters.
+cgiparse
+
+# Create the output.
+
+# Start HTML.
+printf ("Content-Type: text/html\n\n")
+printf ("<html><head><title>Test</title></head>\n")
+printf ("<body>\n")
+if (cl.line == "...")
+    printf ("<center><h2>SPECTIME</h2></center>\n", cl.line)
+else
+    printf ("<center><h2>%s</h2></center>\n", cl.line)
+printf ("<pre>\n")
+
+# Execute task(s).
+#show QUERY_STRING
+
+setup interactive=no mode=h
+printf ("</pre>\n")
+printf ("<A Href='http://www.noao.edu/noao/staff/brooke/gsmt/gsmt.php?stage=1'>Back to form</A>")
+printf ("<pre>\n")
+
+sptime output="counts,snr" graphics="g-gif" interactive=no mode=h
+
+printf ("</pre>\n")
+printf ("<A Href='http://www.noao.edu/noao/staff/brooke/gsmt/gsmt.php?stage=1'>Back to form</A>\n")
+
+printf ("<pre>\n")
+
+# Add any gifs created.  We have to wait for them to be created.
+
+gflush
+
+i = 0; j = 1
+while (i != j) {
+    sleep 2
+    j = i
+    files *.gif | count STDIN | scan (i)
+}
+
+
+if (i > 0) {
+    printf ("<br><p><em>Note: DN and S/N are per-pixel</em><br>\n")
+	
+    files *.gif > gifs
+    list = "gifs"
+    while (fscan (list, s1) != EOF) {
+	if (access (s1))
+		printf ("<img src=\"%s%s\">\n", urldir, s1)
+    }
+    list = ""
+    ## delete ("uparm$gifs", verify-)
+}
+
+printf ("</pre>\n")
+
+# Finish HTML.
+
+printf ("<A Href='http://www.noao.edu/noao/staff/brooke/gsmt/gsmt.php?stage=1'>Back to form</A>")
+
+printf ("</body></html>\n")
+
+# Clean up.
+## delete ("*[^g][^i][^f]", verify-)
+
+logout
+.fi
+.ih
+SEE ALSO
+.endhelp
diff --git a/noao/obsutil/src/doc/findgain.hlp b/noao/obsutil/src/doc/findgain.hlp
new file mode 100644
index 00000000..91bf7eaf
--- /dev/null
+++ b/noao/obsutil/src/doc/findgain.hlp
@@ -0,0 +1,168 @@
+.help findgain Nov01 noao.obsutil
+.ih
+NAME
+findgain -- calculate the gain and readout noise of a CCD
+.ih
+SYNOPSIS
+FINDGAIN uses Janesick's method for determining the gain and read noise
+in a CCD from a pair of dome flat exposures and a pair of zero frame
+exposures (zero length dark exposures).
+.ih
+USAGE
+findgain flat1 flat2 zero1 zero2
+.ih
+PARAMETERS
+.ls flat1, flat2
+First and second dome flats.
+.le
+.ls zero1, zero2
+First and second zero frames (zero length dark exposures).
+.le
+.ls section = ""
+The selected image section for the statistics.  This should be chosen
+to exclude bad columns or rows, cosmic rays and other blemishes, and
+the overscan region.  The flat field iillumination should be constant
+over this section.
+.le
+.ls center = "mean"
+The statistical measure of central tendency that is used to estimate
+the data level of each image.  This can have the values:  \fBmean\fR,
+\fBmidpt\fR, or \fBmode\fR.  These are calculated using the same
+algorithm as the IMSTATISTICS task.
+.le
+.ls nclip = 3
+Number of sigma clipping iterations.  If the value is zero then no clipping
+is performed.
+.le
+.ls lsigma = 4, usigma = 4
+Lower and upper sigma clipping factors used with the mean value and
+standard deviation to eliminate cosmic rays.
+Since \fBfindgain\fR is sensitive to the statistics of the data the
+clipping factors should be symmetric (the same both above and below the
+mean) and should not bias the standard deviation.  Thus the values should
+not be made smaller than around 4 sigma otherwise the gain and readnoise
+estimates will be affected.
+.le
+.ls binwidth = 0.1
+The bin width of the histogram (in sigma) that is used to estimate the
+\fBmidpt\fR or \fBmode\fR of the data section in each image.
+The default case of center=\fBmean\fR does not use this parameter.
+.le
+.ls verbose = yes
+Verbose output?
+.le
+.ih
+DESCRIPTION
+FINDGAIN uses Janesick's method for determining the gain and read noise
+in a CCD from a pair of dome flat exposures and a pair of zero frame
+exposures (zero length dark exposures).
+The task requires that the flats and zeros be unprocessed and uncoadded so
+that the noise characteristics of the data are preserved.  Note, however,
+that the frames may be bias subtracted if the average of many zero frames
+is used, and that the overscan region may be removed prior to using this
+task.
+
+Bad pixels should be eliminated to avoid affecting the statistics.
+This can be done with sigma clipping and/or an image section.
+The sigma clipping should not significantly affect the assumed gaussian
+distribution while eliminating outlyers due to cosmic rays and
+unmasked bad pixels.  This means that clipping factors should be
+symmetric and should have values four or more sigma from the mean.
+.ih
+ALGORITHM
+The formulae used by the task are:
+
+.nf
+    flatdif = flat1 - flat2
+
+    zerodif = zero1 - zero2
+
+       gain = ((mean(flat1) + mean(flat2)) - (mean(zero1) + mean(zero2))) /
+	      ((sigma(flatdif))**2 - (sigma(zerodif))**2 )
+
+   readnoise = gain * sigma(zerodif) / sqrt(2)
+.fi
+
+where the gain is given in electrons per ADU and the readnoise in
+electrons.  Pairs of each type of comparison frame are used to reduce
+the effects of gain variations from pixel to pixel.  The derivation
+follows from the definition of the gain (N(e) = gain * N(ADU)) and from
+simple error propagation.  Also note that the measured variance
+(sigma**2) is related to the exposure level and read-noise variance
+(sigma(readout)**2) as follows:
+
+.nf
+     variance(e) = N(e) + variance(readout)
+.fi
+
+Where N(e) is the number of electrons (above the zero level) in a
+given duration exposure.
+
+In our implementation, the \fBmean\fR used in the formula for the gain
+may actually be any of the \fBmean\fR, \fBmidpt\fR (an estimate of the
+median), or \fBmode\fR as determined by the \fBcenter\fR parameter.
+For the \fBmidpt\fR or \fBmode\fR choices only, the value of the
+\fBbinwidth\fR parameter determines the bin width (in sigma) of the
+histogram that is used in the calculation.  \fBFindgain\fR uses the
+\fBimstatistics\fR task to compute the statistics.
+.ih
+EXAMPLES
+To calculate the gain and readnoise within a 100x100 section:
+
+.nf
+    ms> findgain flat1 flat2 zero1 zero2 section="[271:370,361:460]"
+.fi
+
+To calculate the gain and readnoise using the mode to estimate the data
+level for each image section:
+
+.nf
+    ms> findgain.section="[271:370,361:460]"
+    ms> findgain flat1 flat2 zero1 zero2 center=mode
+.fi
+
+The effects of cosmic rays can be seen in the following example using
+artificial noise created with the \fBartdata.mknoise\fR package.  The
+images have a gain of 5 and a readnoise of 10 with 100 cosmic rays added
+over the 512x512 images.  The zero level images have means of zero and the
+flat field images have means of 1000.  The first execution uses the default
+clipping and the second turns off the clipping.
+
+.nf
+    cl> findgain flat1 flat2 zero1 zero2
+    FINDGAIN:
+      center = mean, binwidth = 0.1
+      nclip = 3, lclip = 4., uclip = 4.
+
+      Flats      = flat1 &  flat2
+      Zeros      = zero1 &  zero2
+      Gain       =  5.01 electrons per ADU
+      Read noise = 10.00 electrons
+    cl> findgain flat1 flat2 zero1 zero2 nclip=0
+    FINDGAIN:
+      center = mean, binwidth = 0.1
+      nclip = 0, lclip = 4., uclip = 4.
+
+      Flats      = flat1  &  flat2
+      Zeros      = zero1  &  zero2
+      Gain       =  2.86 electrons per ADU
+      Read noise = 189.5 electrons
+.fi
+
+.ih
+BUGS
+The image headers are not checked to see if the frames have been
+processed.
+
+There is no provision for finding the "best" values and their errors
+from several flats and zeros.
+.ih
+REVISIONS
+.ls FINDGAIN - V2.12
+New task derived from MSCFINDGAIN.  This makes use of the new clipping
+feature in IMSTATISTICS.
+.le
+.ih
+SEE ALSO
+imstatistics
+.endhelp
diff --git a/noao/obsutil/src/doc/kpnofocus.hlp b/noao/obsutil/src/doc/kpnofocus.hlp
new file mode 100644
index 00000000..176a8fe7
--- /dev/null
+++ b/noao/obsutil/src/doc/kpnofocus.hlp
@@ -0,0 +1,214 @@
+.help kpnofocus Mar96 noao.obsutil
+.ih
+NAME
+kpnofocus -- Determine the best focus from KPNO focus images
+.ih
+USAGE
+kpnofocus images
+.ih
+PARAMETERS
+.ls images
+List of focus images.
+.le
+.ls frame = 1
+The image display is checked to see if the image is already in one of
+the display frames.  If it is not the \fBdisplay\fR task is called to
+display the image in the frame specified by the \fBframe\fR parameter.  All
+other display parameters are taken from the current settings of the task.
+This option requires that the image display be active.
+.le
+
+.ls level = 0.5
+The parameter used to quantify an object image size is the radius from the
+image center enclosing the fraction of the total flux given by this
+parameter.  If the value is greater than 1 it is treated as a percentage.
+.le
+.ls size = "FWHM" (Radius|FWHM|GFWHM|MFWHM)
+There are four ways the PSF size may be shown in graphs and given in
+the output.  These are:
+
+.nf
+    Radius - the radius enclosing the specified fraction of the flux
+    FWHM   - a direct FWHM from the measured radial profile
+    GFWHM  - the FWHM of the best fit Gaussian profile
+    MFWHM  - the FWHM of the best fit Moffat profile
+.fi
+
+The labels in the graphs and output will be the value of this parameter
+to distinguish the different types of size measurements.
+.le
+.ls beta = INDEF
+For the Moffat profile fit (size = MFWHM) the exponent parameter may
+be fixed at a specified value or left free to be determined from the
+fit.  The exponent parameter is determined by the fit if \fIbeta\fR
+task parameter is INDEF.
+.le
+.ls scale = 1.
+Pixel scale in user units per pixel.  Usually the value is 1 to measure
+sizes in pixels or the image pixel scale in arc seconds per pixel.
+.le
+.ls radius = 5., iterations = 2
+Measurement radius in pixels and number of iterations on the radius.  The
+enclosed flux profile is measured out to this radius.  This radius may be
+adjusted if the \fIiteration\fR parameter is greater than 1.  In that case
+after each iteration a new radius is computed from the previous FWHM
+estimate to be the radius the equivalent gaussian enclosing 99.5% of the
+light.  The purpose of this is so that if the initial PSF size of the image
+need not be known.  However, the radius should then be larger than true
+image size since the iterations best converge to smaller values.
+.le
+.ls sbuffer = 5., swidth = 5.
+Sky buffer and sky width in pixels.  The buffer is added to the specified
+measurement \fIradius\fR to define the inner radius for a circular sky
+aperture.  The sky width is the width of the circular sky aperture.
+.le
+.ls saturation=INDEF, ignore_sat=no
+Data values (prior to sky subtraction) to be considered saturated within
+measurement radius.  A value of INDEF treats all pixels as unsaturated.  If
+a measurement has saturated pixels there are two actions.  If
+\fIignore_sat\fR=no then a warning is given but the measurement is saved
+for use.  The object will also be indicated as saturated in the output
+log.  If \fIignore_sat\fR=yes then a warning is given and the object is
+discarded as if it was not measured.  In a focus sequence only the
+saturated objects are discarded and not the whole sequence.
+.le
+.ls logfile = "logfile"
+File in which to record the final results.  If no log file is desired a
+null string may be specified.
+.le
+.ih
+CURSOR COMMANDS
+When selecting objects with the image cursor the following commands are
+available.
+
+.nf
+?  Page cursor command summary
+g  Measure object and graph the results.
+m  Measure object.
+q  Quit object marking and go to next image.
+   At the end of all images go to analysis of all measurements.
+
+:show  Show current results.
+.fi
+
+When in the interactive graphics the following cursor commands are available.
+All plots may not be available depending on the number of focus values and
+the number of stars.
+
+.nf
+?  Page cursor command summary
+a  Spatial plot at a single focus
+b  Spatial plot of best focus values
+d  Delete star nearest to cursor
+e  Enclosed flux for stars at one focus and one star at all focus
+f  Size and ellipticity vs focus for all data
+i  Information about point nearest the cursor
+m  Size and ellipticity vs relative magnitude at one focus
+n  Normalize enclosed flux at x cursor position
+o  Offset enclosed flux to by adjusting background
+p  Radial profiles for stars at one focus and one star at all focus
+q  Quit
+r  Redraw
+s  Toggle magnitude symbols in spatial plots
+t  Size and ellipticity vs radius from field center at one focus
+u  Undelete all deleted points
+x  Delete nearest point, star, or focus (selected by query)
+z  Zoom to a single measurement
+<space> Step through different focus or stars in current plot type
+
+
+:beta <val>     Beta parameter for Moffat fits
+:level <val>	Level at which the size parameter is evaluated
+:overplot <y|n> Overplot the profiles from the narrowest profile?
+:radius <val>   Change profile radius
+:show <file>	Page all information for the current set of objects
+:size <type>	Size type (Radius|FWHM)
+:scale <val>	Pixel scale for size values
+:xcenter <val>	X field center for radius from field center plots
+:ycenter <val>	Y field center for radius from field center plots
+
+The profile radius may not exceed the initial value set by the task
+parameter.
+.fi
+.ih
+DESCRIPTION
+This task is a script based on the task \fBstarfocus\fR.  The details
+of the algorithms and display modes are given in the help for that
+task.  The purpose of \fBkpnofocus\fR is to provide a simpler task
+with fewer parameters because the format of the multiple exposure
+images is given by header keywords.
+
+As a summary of the algorithm, the center of each star image is
+found using centroids, a background is determined from the mode
+of a sky annulus, and the enclosed flux profile is measured.  The
+PSF width is then the radius enclose a specified fraction of the
+flux.  Alternatively a direct FWHM from the radial intensity profile,
+a FWHM for a Moffat profile fit to the enclosed flux profile, or
+a FWHM for a Gaussian profile fit to the enclosed flux profile may be
+used.
+
+If a saturation value is specified then all pixels within the specified
+measurement radius are checked for saturation.  If any saturated pixels are
+found a warning is given and \fIignore_sat\fR parameter may be used ot
+ignore the measurement.  If not ignored the object will still be indicated
+as saturated in the output log.  In a focus sequence only the saturated
+objects are discarded and not the whole sequence.
+
+To use this task consists of specifying a focus image name.  Multiple
+images could be analyzed together but this is uncommon.  The task
+will then display the image, using the current parameters of the
+\fBdisplay\fR task, if the image is not already in the display.
+The user then marks the first exposure (the top one) by pointing
+the image cursor and typing 'm'.  This may be done for more than
+one star if desired.  After all stars to be used are marked type
+'q' to go to the graphical analysis.
+
+A plot showing the variation of the PSF width and ellipticity with
+focus is shown along with a magnitude weighted, parabolic
+interpolated estimate for the best focus.  One may delete bad points
+with the cursor 'd' key.  To exit and record the results to
+a logfile use the 'q' key.  There are many graphical display
+options for more sophisticated analysis such as variations with
+position.  The best thing to do is to try the various keystroke
+commands given in the CURSOR section.  For details about
+the various plots see the \fBstarfocus\fR help.
+
+The other task parameters allow setting the enclosed flux level,
+the object and sky apertures, and the type and scale of the
+reported PSF size.  The log filename may also be specified.
+.ih
+EXAMPLES
+1.  A multiple exposure frame is taken with 7 exposures of a bright
+star, each exposure shifted by 30 pixels using the version of the
+ICE software which records the focus information in the keywords
+FOCSTART, FOCSTEP, FOCNEXPO, and FOCSHIFT.
+
+.nf
+cl> kpnofocus focus1
+<The image is displayed and the image cursor activated>
+<The bright star is marked with 'm'>
+<Marking is finished with 'q'>
+<A graph of FWHM vs focus is shown>
+<Exit with 'q'>
+NOAO/IRAF IRAFV2.10.3 valdes@puppis Fri 15:48:01 12-Nov-93
+
+   Image  Column    Line     Mag   Focus    FWHM   Ellip      PA SAT
+ 36inch1  536.63  804.03    0.07   4660.  13.878    0.06     -11
+	  535.94  753.28   -0.12   4680.   8.569    0.09      89
+	  535.38  703.96   -0.08   4700.   5.164    0.11     -88
+	  537.12  655.36   -0.02   4720.   3.050    0.08     -77
+	  534.20  604.59    0.00   4740.   4.336    0.11      74
+	  534.41  554.99   -0.00   4760.   9.769    0.09     -35
+	  534.83  456.08    0.16   4780.  12.569    0.13     -10
+
+  Best focus of 4722.44 with FWHM (at 50% level) of 3.02
+.fi
+
+The estimated best focus is between the 4th and 5th focus setting
+at a value of 4722.4 and the best focus FWHM is 3.02 pixels.
+.ih
+SEE ALSO
+.nf
+imexamine, implot, pprofile, pradprof, psfmeasure, radlist,
+radplt, radprof, ranges, specfocus, splot, starfocus
+.endhelp
diff --git a/noao/obsutil/src/doc/pairmass.hlp b/noao/obsutil/src/doc/pairmass.hlp
new file mode 100644
index 00000000..d271b42b
--- /dev/null
+++ b/noao/obsutil/src/doc/pairmass.hlp
@@ -0,0 +1,132 @@
+.help pairmass Nov01 noao.obsutil
+.ih
+NAME
+pairmass -- plot the airmass for a given object
+.ih
+USAGE
+pairmass
+.ih
+PARAMETERS
+.ls ra
+The right ascension of the object in hours.
+.le
+.ls dec
+The declination of the object in degrees.
+.le
+.ls epoch=INDEF
+The epoch of the coordinates in years.
+.le
+.ls year
+The year of the observation.
+.le
+.ls month
+The month of the observation (a number from 1 to 12).
+.le
+.ls day
+The day of the month of the observation.
+.le
+.ls observatory = "observatory"
+The observatory identifier in the observatory database.  See the
+help for \fBobservatory\fR task for more information.
+.le
+.ls timesys = "Standard" (Universal|Standard|Siderial)
+Time system for the plot or output list.  The choices are
+"Universal" for universal time, "Standard" for standard time (where
+the time zone is determined from the observatory database), and "Siderial"
+for the siderial time.
+.le
+
+.ls resolution=4
+The number of UT points per hour for which to calculate the airmass.
+.le
+.ls listout=no
+List, rather than plot, the airmass versus time?  Only airmasses
+below that given by the \fIwy2\fR parameters are listed.
+.le
+.ih
+PLOT PARAMETERS
+.ls wx1=-7., wx2=7., wy1=0., wy2=5.
+The range of window (user) coordinates to be included in the plot.
+If the range of values in x or y = 0, the plot is automatically
+scaled from the minimum to maximum data values along that axis.
+The times are available from -24 hours to 48 hours so one can use
+negative numbers to plot hours from midnight or in actual hours.
+.le
+.ls pointmode = no
+Plot individual points instead of a continuous line?
+.le
+.ls marker="box"
+If \fBpointmode\fR = yes, the marker drawn at each point is set with this
+parameter.  The acceptable choices are "point", "box", "plus", "cross",
+"circle", "hebar", "vebar", "hline", "vline", and "diamond".
+.le
+.ls szmarker = 0.005
+The size of the marker drawn when \fBpointmode\fR = yes.  A value of 0
+(zero) indicates that the task should read the size from the input list.
+.le
+.ls logx = no, logy = no
+Draw the x or y axis in log units, versus linear?
+.le
+.ls xlabel="default"
+Label for the X-axis.  The value "default" uses the specified time system.
+.le
+.ls ylabel="Airmass"
+Labels for the Y-axis.
+.le
+.ls title="default"
+Title for plot.  If not changed from "default", a title string consisting
+of the date, observatory, and  object position is used.
+.le
+.ls vx1=0., vx2=0., vy1=0., vy2=0.
+NDC coordinates (0-1) of the plotting device viewport.  If not set
+by the user, a suitable viewport which allows sufficient room for all
+labels is used.
+.le
+.ls majrx=5, minrx=5, majry=5, minry=5
+The number of major and minor divisions along the x or y axis.
+.le
+.ls round = no
+Round axes up to nice values?
+.le
+.ls fill = yes
+Fill the plotting viewport regardless of the device aspect ratio?
+.le
+.bp
+.ls append = no
+Append to an existing plot?
+.le
+.ls device="stdgraph"
+Output device.
+.le
+.ih
+DESCRIPTION
+The airmass is plotted over a specified set of hours for a given
+observatory.  The observatory is specified by an identifier as given
+in the observatory database.  See the help for "observatory" for more
+information about the database and identifiers.
+
+The results can be shown in universal, standard, or siderial time.
+The standard time simply adds the time zone from the observatory
+database tothe universal time and so there is no explicit facility
+for daylight savings time.  The times are computed in the range
+-24 hours to +48 hours.  By setting the \fIwx1\fR and \fIwx2\fR
+parameters one can plot either in hours relative to 0 in the specified
+time system or as positive hours.  This simple task does not support
+axis labeling which wraps around.
+
+The list output prints date, observatory, object coordinates, and
+the time system.  This is followed by the time sorted between 0 and 24
+and the airmasses.  The list only includes airmasses below the
+value specified by \fIwy2\fR.
+.ih
+EXAMPLES
+To plot the airmass for M82 from Kitt Peak for Groundhog's Day in 1992:
+
+.nf
+    pairmass ra=9:51:42 dec=69:56 epoch=1950 year=1992 month=2 day=2
+.fi
+
+.ih
+SEE ALSO
+observatory, airmass, setairmass, graph
+.endhelp
diff --git a/noao/obsutil/src/doc/psfmeasure.hlp b/noao/obsutil/src/doc/psfmeasure.hlp
new file mode 100644
index 00000000..479268b1
--- /dev/null
+++ b/noao/obsutil/src/doc/psfmeasure.hlp
@@ -0,0 +1,633 @@
+.help psfmeasure Nov01 noao.obsutil
+.ih
+NAME
+psfmeasure -- Measure PSF widths in stellar images
+.ih
+USAGE
+psfmeasure images
+.ih
+PARAMETERS
+.ls images
+List of images.
+.le
+.ls coords = "mark1" (center|mark1|markall)
+Method by which the coordinates of objects to be measured are specified.
+If "center" then a single object at the center of each image is measured.
+If "mark1" then the \fIimagecur\fR parameter, typically the interactive
+image display cursor, defines the coordinates of one or more objects in the
+first image ending with a 'q' key value and then the same coordinates are
+automatically used in subsequent images.  If "markall" then the
+\fIimagecur\fR parameter defines the coordinates for objects in each image
+ending with a 'q' key value.
+.le
+.ls wcs = "logical" (logical|physical|world)
+Coordinate system for input coordinates.  When using image cursor input
+this will always be "logical".  When using cursor input from a file this
+could be "physical" or "world".
+.le
+.ls display = yes, frame = 1
+Display the image or images as needed?  If yes the image display is checked
+to see if the image is already in one of the display frames.  If it is not
+the \fBdisplay\fR task is called to display the image in the frame
+specified by the \fBframe\fR parameter.  All other display parameters are
+taken from the current settings of the task.  This option requires that the
+image display be active.  A value of no is typically used when an input
+cursor file is used instead of the image display cursor.  An image display
+need not be active in that case.
+.le
+
+.ls level = 0.5
+The parameter used to quantify an object image size is the radius from the
+image center enclosing the fraction of the total flux given by this
+parameter.  If the value is greater than 1 it is treated as a percentage.
+.le
+.ls size = "FWHM" (Radius|FWHM|GFWHM|MFWHM)
+There are four ways the PSF size may be shown in graphs and given in
+the output.  These are:
+
+.nf
+    Radius - the radius enclosing the specified fraction of the flux
+    FWHM   - a direct FWHM from the measured radial profile
+    GFWHM  - the FWHM of the best fit Gaussian profile
+    MFWHM  - the FWHM of the best fit Moffat profile
+.fi
+
+The labels in the graphs and output will be the value of this parameter
+to distinguish the different types of size measurements.
+.le
+.ls beta = INDEF
+For the Moffat profile fit (size = MFWHM) the exponent parameter may
+be fixed at a specified value or left free to be determined from the
+fit.  The exponent parameter is determined by the fit if \fIbeta\fR
+task parameter is INDEF.
+.le
+.ls scale = 1.
+Pixel scale in user units per pixel.  Usually the value is 1 to measure
+sizes in pixels or the image pixel scale in arc seconds per pixel.
+.le
+.ls radius = 5., iterations = 3
+Measurement radius in pixels and number of iterations on the radius.  The
+enclosed flux profile is measured out to this radius.  This radius may be
+adjusted if the \fIiteration\fR parameter is greater than 1.  In that case
+after each iteration a new radius is computed from the previous direct FWHM
+estimate.  The new radius is three times direct FWHM (six times the
+half-maximum radius).  The purpose of this is so that if the initial PSF
+size of the image need not be known.  However, the radius should then be
+larger than true image size since the iterations best converge to smaller
+values.
+.le
+.ls sbuffer = 5, swidth = 5.
+Sky buffer and sky width in pixels.  The buffer is added to the specified
+measurement \fIradius\fR to define the inner radius for a circular sky
+aperture.  The sky width is the width of the circular sky aperture.
+.le
+.ls saturation=INDEF, ignore_sat=no
+Data values (prior to sky subtraction) to be considered saturated within
+measurement radius.  A value of INDEF treats all pixels as unsaturated.  If
+a measurement has saturated pixels there are two actions.  If
+\fIignore_sat\fR=no then a warning is given but the measurement is saved
+for use.  The object will also be indicated as saturated in the output
+log.  If \fIignore_sat\fR=yes then a warning is given and the object is
+discarded as if it was not measured.
+.le
+.ls xcenter = INDEF, ycenter = INDEF
+The optical field center of the image given in image pixel coordinates.
+These values need not lie in the image.  If INDEF the center of the image
+is used.  These values are used to make plots of size verse distance from
+the field center for studies of radial variations.
+.le
+.ls logfile = "logfile"
+File in which to record the final results.  If no log file is desired a
+null string may be specified.
+.le
+
+.ls imagecur = ""
+Image cursor input for the "mark1" and "markall" options.  If null then the
+image dispaly cursor is used interactively.  If a file name is specified
+then the coordinates come from this file.  The format of the file are lines
+of x, y, id, and key.  Values of x an y alone may be used to select objects
+and the single character 'q' (or the end of the file) may be used to end
+the list.
+.le
+.ls graphcur = ""
+Graphics cursor input.  If null then the standard graphics cursor
+is used otherwise a standard cursor format file may be specified.
+.le
+.ih
+CURSOR COMMANDS
+When selecting objects with the image cursor the following commands are
+available.
+
+.nf
+?  Page cursor command summary
+g  Measure object and graph the results.
+m  Measure object.
+q  Quit object marking and go to next image.
+   At the end of all images go to analysis of all measurements.
+
+:show  Show current results.
+.fi
+
+When in the interactive graphics the following cursor commands are available.
+All plots may not be available depending on the number of stars.
+
+.nf
+?  Page cursor command summary
+a  Spatial plot
+d  Delete star nearest to cursor
+e  Enclosed flux for all stars
+i  Information about star nearest the cursor
+m  Size and ellipticity vs relative magnitude
+n  Normalize enclosed flux at x cursor position
+o  Offset enclosed flux by adjusting background
+p  Radial profiles for all stars
+q  Quit
+r  Redraw
+s  Toggle magnitude symbols in spatial plot
+t  Size and ellipticity vs radius from field center
+u  Undelete all deleted points
+x  Delete nearest point or star (selected by query)
+z  Zoom to a single measurement
+<space> Step through different stars in some plots
+
+:beta <val>     Set the beta parameter for the Moffat profile fit
+:level <val>	Level at which the size parameter is evaluated
+:overplot <y|n> Overplot the profiles from the narrowest profile?
+:radius <val>   Change profile radius
+:show <file>	Page all information for the current set of objects
+:size <type>	Size type (Radius|FWHM)
+:scale <val>	Pixel scale for size values
+:xcenter <val>	X field center for radius from field center plots
+:ycenter <val>	Y field center for radius from field center plots
+.fi
+.ih
+DESCRIPTION
+This task measures the point-spread function (PSF) width of stars or other
+unresolved objects in digital images.  The width is measured from the
+enclosed flux verses radius profile.  The details of this are described in
+the ALGORITHMS section.  Measurements of multiple stars in multiple images
+may be made.  When there are multiple stars, variations in the PSF with
+position may be examined.  The task has three stages; selecting objects and
+measuring the PSF width and other parameters, an interactive graphical
+analysis, and a final output of the results to the terminal and to a
+logfile.
+
+If a saturation value is specified then all pixels within the specified
+measurement radius are checked for saturation.  If any saturated pixels are
+found a warning is given and \fIignore_sat\fR parameter may be used ot
+ignore the measurement.  If not ignored the object will still be indicated
+as saturated in the output log.  In a focus sequence only the saturated
+objects are discarded and not the whole sequence.
+
+The input images are specified by an image template list.  The list may
+consist of explicit image names, wildcard templates, and @ files.
+Identifying the object or objects to be measured may be accomplished in
+several ways.  If a single object near the center of the image is to be
+measured then the \fIcoords\fR parameter takes the value "center".  When
+the "center" option is used the \fIdisplay\fR and \fIimagecur\fR parameters
+are ignored.
+
+If there are multiple objects or the desired object is not at the center of
+the frame the object coordinates are entered with the \fIimagecur\fR
+parameter.  This type of coordinate input is selected by specifying either
+"mark1" or "markall" for the \fIcoords\fR parameter.  If the value is
+"mark1" then the coordinates are entered for the first image and the same
+values are automatically used for subsequent images.  If "markall" is
+specified then the objects in each image are marked.
+
+Normally the \fIimagecur\fR parameter would select the interactive image
+display cursor though a standard cursor file could be used to make this
+part noninteractive.  When the image display cursor is used either the
+image must be displayed previously by the user, or the task may be allowed
+to load the image display using the \fBdisplay\fR task by setting the
+parameter \fIdisplay\fR to yes and \fIframe\fR to a display frame.  If yes
+the image display must be active.  The task will look at the image names as
+stored in the image display and only load the display if needed.
+
+If one wants to enter a coordinate list rather than use the interactive
+image cursor the list can consist of just the column and line coordinates
+since the key will default to 'm'.  To finish the list either the end
+of file may be encountered or a single 'q' may be given since the
+coordinates are irrelevant.  For the "markall" option with multiple
+images there would need to be a 'q' at the end of each object except
+possibly the last.
+
+When objects are marked interactively with the image cursor there
+are a four keys which may be used as shown in the CURSOR COMMAND section.
+The important distinction is between 'm' to mark and measure an
+object and 'g' to mark, measure, and graph the results.  The former
+accumulates the results until the end while the latter can give an
+immediate result to be examined.  Unless only one object is marked
+the 'g' key also accumulates the results for later graphical analysis.
+It is important to note that the measurements are done as each
+object is marked so there can be a significant delay before the
+next object may be marked.
+
+The quantities measured and the algorithms used are described in the
+ALGORITHMS section.  Once all the objects have been measured an
+interactive (unless only one object is measured) graphical presentation
+of the measurements is entered.
+
+When the task exits it prints the results to the terminal (STDOUT) and also
+to the \fIlogfile\fR if one is specified.  The results may also be
+previewed during the execution of the task with the ":show" command.  The
+results begin with a banner and the overall estimate of the PSF size.
+Following this the individual measurements are given.  The columns give the
+image name, the column and line position, the relative magnitude, the PSF
+size as either the enclosed flux radius or the various FWHM, the
+ellipticity, and the position angle.
+.ih
+ALGORITHMS
+The PSF of an object is characterized using a radially symmetric
+enclosed flux profile.  First the center of the object is determined from
+an initial rough coordinate.  The center is computed from marginal profiles
+which are sums of lines or columns centered at the initial coordinate and
+with a width given by the sum of the \fIradius\fR, \fIsbuffer\fR, and
+\fIswidth\fR parameters.  The mean of the marginal profile is determined
+and then the centroid of the profile above this is computed.  The centroids
+from the two marginal profiles define a new object center.  These steps of
+forming the marginal profiles centered at the estimated object position and
+then computing the centroids are repeated until the centroids converge or
+three iterations have been completed.
+
+Next a background is determined from the mode of the pixel values in the
+sky annulus defined by the object center and \fIradius\fR, \fIsbuffer\fR,
+and \fIswidth\fR parameters.  The pixel values in the annulus are sorted
+and the mode is estimated as the point of minimum slope in this sorted
+array using a width of 5% of the number of points.  If there are multiple
+regions with the same minimum slope the lowest pixel value is used.
+
+The background subtracted enclosed flux profile is determined next.
+To obtain subpixel precision and to give accurate estimates for small
+widths relative to the pixel sampling, several things are done.
+First interpolation between pixels is done using a cubic spline surface.
+The radii measured are in subpixel steps.  To accommodate small and
+large PSF widths (and \fIradius\fR parameters) the steps are nonuniform
+with very fine steps at small radii (steps of 0.05 pixels in the
+central pixel) and coarser steps at larger radii (beyond 9 pixels
+the steps are one pixel) out to the specified \fIradius\fR.  Similarly each
+pixel is subsampled finely near the center and more coarsely at larger
+distances from the object center.  Each subpixel value, as obtained by
+interpolation, is background subtracted and added into the enclosed flux
+profile.  Even with subpixel sampling there is still a point where a
+subpixel straddles a particular radius.  At those points the fraction of
+the subpixel dimension in radius falling within the radius being measured
+is used as the fraction of the pixel value accumulated.
+
+Because of errors in the background determination due to noise and
+contaminating objects it is sometimes the case that the enclosed flux
+is not completely monotonic with radius.  The enclosed flux
+normalization, and the magnitude used in plots and reported in
+results, is the maximum of the enclosed flux profile even if it
+occurs at a radius less than the maximum radius.  It is possible
+to change the normalization and subtract or add a background correction
+interactively.
+
+Because a very narrow PSF will produce significant errors in the cubic
+spline interpolation due to the steepness and rapid variation in the pixel
+values near the peak, the Gaussian profile with FWHM that encloses the same
+80% of the flux is computed as:
+
+    FWHM(80%) = 2 * r(80%) * sqrt (ln(2) / (ln (1/.2)))
+
+If this is less than five pixels the Gaussian model is subtracted from the
+data.  The Gaussian normalization is chosed to perfectly subtract the
+central pixel.  The resulting subtraction will not be perfect but the
+residual data will have much lower amplitudes and variations.  A spline
+interpolation is fit to this residual data and the enclosed flux profile is
+recomputed in exactly the same manner as previously except the subpixel
+intensity is evaluated as the sum of the analytic Gaussian and the
+interpolation to the residual data.
+
+The Gaussian normalization is chosed to perfectly subtract the central
+pixel.  The resulting subtraction will not be perfect but the residual data
+will have much lower amplitudes and variations.  A spline interpolation is
+fit to this residual data and the enclosed flux profile is recomputed in
+exactly the same manner as previously except the subpixel intensity is
+evaluated as the sum of the analytic Gaussian and the interpolation to the
+residual data.  This technique yields accurate FWHM for simulated Gaussian
+PSFs down to at least a FWHM of 1 pixel.
+
+In addition to the enclosed flux profile, an estimate of the radially
+symmetric intensity profile is computed from the enclosed flux profile.
+This is based on the equation
+
+.nf
+    F(R) = integral from 0 to R { P(r) r dr }
+.fi
+
+where F(R) is the enclosed flux at radius R and P(r) is the intensity per
+unit area profile.  Thus the derivative of F(R) divided by R gives an
+estimate of P(R).
+
+Cubic spline interpolation functions are fit to the normalized enclosed
+flux profile and the intensity profile.  These are used to find the radius
+enclosing any specified fraction of the flux and to find the direct FWHM of
+the intensity profile.  These are output when \fIsize\fR is "Radius" or
+"FWHM" respectively.
+
+In addition to enclosed flux radius and direct FWHM size measurements
+there are also two size measurements based on fitting analytic profiles.
+A Gaussian profile and a Moffat profile are fit to the final enclosed flux
+profile to the points with enclosed flux less than 80%.  The limit is
+included to minimize the effects of poor background values and to make the
+profile fit be representative of the core of the PSF profile.  These profiles
+are fit whether or not the selected \fIsize\fR requires it.  This is done
+for simplicity and to allow quickly changing the size estimate with the
+":size" command.
+
+The intensity profile functions (with unit peak) are:
+
+.nf
+    I(r) = exp (-0.5 * (r/sigma)**2)			Gaussian
+    I(r) = (1 + (r/alpha)**2)) ** (-beta)		Moffat
+.fi
+
+with parameters sigma, alpha, and beta.  The normalized enclosed flux
+profiles, which is what is actually fit, are then:
+
+.nf
+    F(r) = 1 - exp (-0.5 * (r/sigma)**2)		Gaussian
+    F(r) = 1 - (1 + (r/alpha)**2)) ** (1-beta)		Moffat
+.fi
+
+The fits determine the parameters sigma or alpha and beta (if a
+beta value is not specified by the users).  The reported FWHM values
+are given by:
+
+.nf
+    GFWHM = 2 * sigma * sqrt (2 * ln (2))		Gaussian
+    MFWHM = 2 * alpha * sqrt (2 ** (1/beta) - 1)	Moffat
+.fi
+
+were the units are adjusted by the pixel scale factor.
+
+In addition to the four size measurements there are several additional
+quantities which are determined.  
+Other quantities which are computed are the relative magnitude,
+ellipticity, and position angle.  The magnitude of an individual
+measurement is obtained from the maximum flux attained in the enclosed
+flux profile computation.  Though the normalization and background may be
+adjusted interactively later, the magnitude is not changed from the
+initial determination.  The relative magnitude of an object is then
+computed as
+
+.nf
+    rel. mag. = -2.5 * log (object flux / maximum star flux)
+.fi
+
+The maximum star magnitude over all stars is used as the zero point for the
+relative magnitudes (hence it is possible for an individual object relative
+magnitude to be less than zero).
+
+The ellipticity and positional angle of an object are derived from the
+second central intensity weighted moments.  The moments are:
+
+.nf
+	Mxx = sum { (I - B) * x * x } / sum { I - B }
+	Myy = sum { (I - B) * y * y } / sum { I - B }
+	Mxy = sum { (I - B) * x * y } / sum { I - B }
+.fi
+
+where x and y are the distances from the object center, I is
+the pixel intensity and B is the background intensity.  The sum is
+over the same subpixels used in the enclosed flux evaluation with
+intensities above an isophote which is slightly above the background.
+The ellipticity and position angles are derived from the moments
+by the equations:
+
+.nf
+	M1 = (Mxx - Myy) / (Mxx + Myy)
+	M2 = 2 * Mxy / (Mxx + Myy)
+	ellip = (M1**2 + M2**2) ** 1/2
+	pa = atan (M2 / M1) / 2
+.fi
+
+where ** is the exponentiation operator and atan is the arc tangent
+operator.  The ellipticity is essentially (a - b) / (a + b) where a
+is a major axis scale length and b is a minor axis scale length.  A
+value of zero corresponds to a circular image.  The position angle is
+given in degrees counterclockwise from the x or column axis.
+
+The overall size when there are multiple stars is estimated by averaging
+the individual sizes weighted by the flux of the star as described above.
+Thus, when there are multiple stars, the brighter stars are given greater
+weight in the average size.  This average size is what is given in the
+banner for the graphs and in the printed output.
+
+One of the quantities computed for the graphical analysis is the
+FWHM of a Gaussian or Moffat profile that encloses the same flux
+as the measured object as a function of the level.  The equation are:
+
+.nf
+   FWHM = 2 * r(level) * sqrt (ln(2.) / ln (1/(1-level)))  Gaussian
+
+   FWHM = 2 * r(level) * sqrt (2**(1/beta)-1) /
+	  sqrt ((1-level)**(1/(1-beta))-1)		   Moffat
+.fi
+
+where r(level) is the radius that encloses "level" fraction of the total
+flux.  ln is the natural logarithm and sqrt is the square root.  The beta
+value is either the user specified value or the value determined by fitting
+the enclosed flux profile.
+
+This function of level will be a constant if the object profile matches
+the Gaussian or Moffat profile.  Deviations from a constant show
+the departures from the profile model.  The Moffat profile used in making
+the graphs except for the case where the \fIsize\fR is GFWHM.
+.ih
+INTERACTIVE GRAPHICS MODE
+The graphics part of \fBpsfmeasure\fR consists of a number of different
+plots selected by cursor keys.  The available plots depend on the number of
+stars.  The various plots and the keys which select them are summarized
+below.
+
+.nf
+a  Spatial plot
+e  Enclosed flux for all stars
+m  Size and ellipticity vs relative magnitude
+p  Radial profiles for all stars
+t  Size and ellipticity vs radius from field center
+z  Zoom to a single measurement
+.fi
+
+If there is only one object the only available plot is
+the 'z' or zoom plot.  This has three graphs; a graph of the normalized
+enclosed flux verses scaled radius, a graph of the intensity profile verses
+scaled radius, and equivalent Moffat/Gaussian full width at half maximum verses
+enclosed flux fraction.  The latter two graphs are derived from the
+normalized enclosed flux profile as described in the ALGORITHMS section.
+In the graphs the measured points are shown with symbols, a smooth curve is
+drawn through the symbols and dashed lines indicate the measurement level
+and enclosed flux radius at that level.
+
+Overplotted on these graphs are the Moffat profile fit or the
+Gaussian profile fit when \fIsize\fR is GFWHM.
+
+The zoom plot is always available from any other plot.  The cursor position
+when the 'z' key is typed selects a particular object measurement.
+This plot is also the one presented with the 'g' key when marking objects for
+single exposure images.  In that case the graphs are drawn followed by
+a return to image cursor mode.
+
+There are two types of symbol plots showing the measured PSF size (either
+enclosed flux radius or FWHM) and ellipticity.  These plot the measurements
+verses relative magnitude ('m' key) and radius from the field center ('t'
+key).  These plots are only available when there are multiple stars
+measured.  The magnitude plot is the initial plot in this case.  The field
+center for the field radius graph may be changed interactively using the
+":xcenter" and ":ycenter" commands.
+
+Grids of enclosed flux vs. radius, intensity profile vs. radius, and
+FWHM vs. enclosed flux fraction are shown with the 'e', 'p', and
+'g' keys respectively when there is more than one star.  The grid shows
+a profile for each star.  The profiles in the grid have no axis labels or
+ticks.  Within each box are the coordinates of the object
+and the PSF size.  Below the grid is shown a graph of a single objects
+including axis labels and ticks.
+
+In the grid there is one profile which is highlighted (by a second box or
+by a color border).  This is the profile shown in the lower graph.  To
+change the star in the lower graph on can type the space bar to advance to
+the next star or use the cursor and the 'e', 'p', or 'g' key again.  Other
+keys will select another plot using the star nearest the cursor to select a
+measurement.
+
+Any of the graphs with enclosed flux or intensity profiles vs radius may
+have the profiles of the object with the smallest size overplotted.  The
+overplot has a dashed line, a different color on color graphics devices,
+and no symbols marking the measurement points.  The overplots may be
+enabled or disabled with the ":overplot" command.  Initially it is
+disabled.
+
+The final plot, the 'a' key, gives a spatial representation.  This requires
+more than one star.  This plot has a central graph of column and line
+coordinates with symbols indicating the position of an object.  The objects
+are marked with a circle (when plotted at unit aspect ratio) whose size is
+proportional to the measured PSF size.  In addition an optional asterisk
+symbol with size proportional to the relative brightness of the object may
+be plotted.  This symbol is toggled with the 's' key.  On color displays
+the circles may have two colors, one if object size is above the average
+best size and the other if the size is below the best size.  The purpose of
+this is to look for a spatial pattern in the PSF sizes.
+
+Adjacent to the central graph are graphs with column or line as one
+coordinate and radius or ellipticity as the other.  The symbols
+are the same as described previously.  These plots can show spatial
+gradients in the PSF size and shape across the image.
+
+In addition to the keys which select plots there are other keys which
+do various things.  These are summarized below.
+
+.nf
+?  Page cursor command summary
+d  Delete star nearest to cursor
+i  Information about point nearest the cursor
+n  Normalize enclosed flux at x cursor position
+o  Offset enclosed flux by adjusting background
+q  Quit
+r  Redraw
+s  Toggle magnitude symbols in spatial plots
+u  Undelete all deleted points
+x  Delete nearest point or star (selected by query)
+<space> Step through different stars in current plot type
+.fi
+
+The help, redraw, and quit keys are provide the standard functions.
+The 's' and space keys were described previously.  The 'i' key
+locates the nearest object to the cursor in whatever plot is shown and
+prints one line of information about the object on the graphics device
+status area.
+
+The 'd' key deletes the star nearest the cursor in whatever plot is
+currently displayed.  To delete all objects from an image, all
+values for one star (the same as 'd'), or a
+single measurement, the 'x' key is used.  Typing this key produces a query
+for which type of deletion and the user responds with 'i', 's', or
+'p'.  Deleted measurements do not appear in any subsequent
+graphics, are excluded from all computations, and are not output in the
+results.  The 'u' key allows one to recover deleted measurements.  This
+undeletes all previously deleted data.
+
+Due to various sources of error the sky value may be wrong causing
+the enclosed flux profile to not converge properly but instead
+decreases beyond some point (overestimated sky) or linearly
+increases with radius (underestimated sky).  This affects the size
+measurement by raising or lowering the normalization and altering
+the shape of the enclosed flux profile.  The 'n' and 'o' keys allow
+fudging the enclosed flux profiles.  These keys apply only in
+the zoom plot or 'e' key plot of the enclosed flux profile.
+
+The 'n' key normalizes the enclosed flux profile at the point
+set by the x position of the cursor.  The 'o' key increases or
+decreases the background estimate to bring curve up or down to
+the point specified by the cursor.  The effect of this is to
+add or subtract a quadratic function since the number of pixels
+at a particular radius varies as the square of the radius.
+To restore the original profile, type 'n' or 'o' at a radius
+less than zero.
+
+The colon commands, shown below, allow checking or changing parameters
+initially set by the task parameters, toggling the overplotting of the
+smallest PSF profiles, and showing the current results.  The overplotting
+option and the contents of the results displayed by :show were described
+previously.
+
+.nf
+:beta <val>     Beta value for Moffat profile fits
+:level <val>	Level at which the size parameter is evaluated
+:overplot <y|n> Overplot the profiles from the narrowest profile?
+:radius <val>   Change profile radius
+:show <file>	Page all information for the current set of objects
+:size <type>	Size type (Radius|FWHM)
+:scale <val>	Pixel scale for size values
+:xcenter <val>	X field center for radius from field center plots
+:ycenter <val>	Y field center for radius from field center plots
+.fi
+
+The important values which one might want to change interactively are
+the measurement level and the profile radius.  The measurement level
+directly affects the results reported.  When it is changed the sizes
+of all object PSFs are recomputed and the displayed plots and title
+information are updated.  The profile radius is the
+maximum radius shown in plots and used to set the enclosed flux normalization.
+It does not affect the object centering or sky region definition and
+evaluation which are done when the image data is accessed.  Because
+the objects are not remeasured from the image data the radius may
+not be made larger than the radius defined by the task parameter though
+it may be decreased and then increased again.
+.ih
+EXAMPLES
+1.  An image of a star field is studied with default values.
+
+.nf
+cl> psfmeasure field1
+<The image is displayed and the image cursor activated>
+<A number of brighter stars are marked>
+<Marking is finished with 'q'>
+<Graph of FWHM and ellipticity vs relative magnitude are shown>
+<A couple of bad measurements due to blending are deleted>
+<Exit with 'q'>
+NOAO/IRAF IRAFV2.10.3 valdes@puppis Tue 18:22:36 06-Jul-93
+  Average full width at half maximum of 4.5722
+
+       Image  Column    Line     Mag    FWHM   Ellip      PA SAT
+      field1   68.96   37.87    0.75   5.636    0.03      15
+	      488.41  116.78    1.61   5.376    0.03     -68
+	       72.17  156.35    1.47   4.728    0.06     -14
+	       33.72  211.86    2.74   4.840    0.05     -52
+	      212.80  260.73    2.99   3.888    0.11      83
+	      250.51  277.37    1.92   3.914    0.02     -14
+	      411.81  292.83    1.93   5.032    0.04      34
+	      131.85  301.12    2.67   4.028    0.06       4
+	      168.37  413.70    2.20   4.408    0.05      75
+	      256.02  255.99    0.00   3.940    0.00     -70
+
+The estimated average FWHM is 4.5722.  The variation in size is real
+in this artificial image having a radial variation in PSF.
+.ih
+SEE ALSO
+.nf
+imexamine, implot, pprofile, pradprof, radlist, radplt, radprof,
+specfocus, starfocus, splot
+.endhelp
diff --git a/noao/obsutil/src/doc/shutcor.hlp b/noao/obsutil/src/doc/shutcor.hlp
new file mode 100644
index 00000000..6968bdff
--- /dev/null
+++ b/noao/obsutil/src/doc/shutcor.hlp
@@ -0,0 +1,93 @@
+.help shutcor Nov01 noao.obsutil
+.ih
+NAME
+shutcor -- shutter correction from images of varying exposure
+.ih
+SYNOPSIS
+SHUTCOR calculate the shutter correction for a detector given a
+sequence of overscan corrected images of varying durations.  Typically
+these would be flat field exposures.  The shutter correction is the
+intercept on a plot of exposure duration versus exposure level.
+.ih
+USAGE
+shutcor images
+.ih
+PARAMETERS
+.ls images
+List of overscan corrected images.  These would usually be flat
+field exposures.
+.le
+.ls section = ""
+The selected image section for the statistics.  This should be chosen
+to exclude bad columns or rows, cosmic rays, and other non-linear
+features.
+.le
+.ls center = "mode"
+The statistical measure of central tendency that is used to estimate
+the data level of each image.  This can have the values:  \fBmean\fR,
+\fBmidpt\fR, or \fBmode\fR.  These are calculated using the same
+algorithm as the IMSTATISTICS task.
+.le
+.ls nclip = 3
+Number of sigma clipping iterations.  If the value is zero then no clipping
+is performed.
+.le
+.ls lsigma = 4, usigma = 4
+Lower and upper sigma clipping factors used with the mean value and
+standard deviation to eliminate cosmic rays.
+Since \fBfindgain\fR is sensitive to the statistics of the data the
+clipping factors should be symmetric (the same both above and below the
+mean).
+.le
+.ls exposure = "exptime"
+Keyword giving the exposure time.
+.le
+.ls verbose = yes
+Verbose output?
+.le
+.ih
+DESCRIPTION
+SHUTCOR calculate the shutter correction for a detector given a
+sequence of overscan corrected images of varying durations.  Typically
+these would be flat field exposures.  The shutter correction is the
+intercept on a plot of exposure duration versus exposure level.
+
+The images must contain the keyword OVERSCAN otherwise and error will
+be given.
+
+Bad pixels should be eliminated to avoid affecting the statistics.
+This can be done with sigma clipping and/or an image section.
+The sigma clipping should not significantly affect the assumed gaussian
+distribution while eliminating outlyers due to cosmic rays and
+unmasked bad pixels.  This means that clipping factors should be
+symmetric.
+.ih
+EXAMPLES
+A sequence of flat fields with varying exposure times are taken and
+processed to subtract the overscan.
+
+.nf
+    cl> shutcor flat*
+
+    Shutter correction = 0.538 +/- 0.043 seconds
+
+    Information about the mode versus exptime fit:
+
+	   intercept        slope     (and errors)
+	    5.347105      9.933618
+	   0.4288701    0.01519613
+	
+	chi sqr:  0.2681   ftest: 419428.   correlation:      1.
+	 nr pts:      4.   std dev res: 0.422769
+	
+	x(data)     y(calc)     y(data)     sigy(data)
+	     3.      35.148     34.6725          0.
+	    12.     124.551     125.015          0.
+	    27.     273.555     273.778          0.
+	    48.     482.161     481.949          0.
+.fi
+.le
+.ih
+SEE ALSO
+imstatistics
+.endhelp
diff --git a/noao/obsutil/src/doc/specfocus.hlp b/noao/obsutil/src/doc/specfocus.hlp
new file mode 100644
index 00000000..137eca23
--- /dev/null
+++ b/noao/obsutil/src/doc/specfocus.hlp
@@ -0,0 +1,375 @@
+.help specfocus Nov01 noao.obsutil
+.ih
+NAME
+specfocus -- Determine spectral focus and alignment variations
+.ih
+USAGE
+specfocus images
+.ih
+PARAMETERS
+.ls images
+List of 1D or 2D focus images.  Typically the input is a list of raw
+2D CCD images of arc slit spectra.  The 1D image input is provided to
+allow use of extraction techniques beyond those provided by this task.
+.le
+.ls focus = ""
+List of focus identification values to be associated with each input image
+or an image header keyword containing the values.  The list may be an
+explicit list of values, a range specification, an @ file containing the
+values, or an image header keyword.  If none of these is given the
+identification values are simple index values in the order of the input
+images.  A range specification has the forms A, AxC, A-BxC where A is a
+starting value, B is an ending value, and C is an increment.
+.le
+.ls corwidth = 20.
+Correlation width in pixels.
+.le
+.ls level = 0.5
+Percent or fraction of the correlation peak at which to measure focus
+widths.  The default is 50% or full width at half maximum.
+.le
+.ls shifts = yes
+Compute dispersion shifts across the dispersion when there are multiple
+samples?  If yes and there are multiple samples across the dispersion
+(\fIndisp\fR > 1), pixel shifts relative to the central sample are
+determine by crosscorrelation.
+.le
+
+.ls dispaxis = 2
+Dispersion axis for 2D images.  The image header keyword DISPAXIS has
+precedence over this value.
+.le
+.ls nspectra = 1, ndisp = 1
+The number of spectral samples across the dispersion
+and the number of subpieces along the dispersion to divide the spectra
+into.  If \fInspectra\fR is greater than one then information about
+variations across the dispersion will be determined and if \fIndisp\fR is
+greater than 1 information about variations along the dispersion will be
+determined.  \fINspectra\fR applies only to 2D images.  For 1D spectra in
+multispec format each line is used as a separate sample.
+.le
+.ls slit1 = INDEF, slit2 = INDEF
+The lower and upper edges of the slit (or data region) in pixel
+coordinates (lines or columns) across the dispersion axis.  A value
+of INDEF specifies the image edges.
+.le
+
+.ls logfile = "logfile"
+File in which to record the results.  If no file is specified no log
+output is produced.
+.le
+.ih
+CURSOR COMMANDS
+All keys select an image and a sample (one of the \fIndisp\fR samples along
+the dispersion and one of the \fInspectra\fR samples across the dispersion)
+which is then generally highlighted.
+
+.nf
+   ?  Help summary
+   b  Best focus at each sample summary graphs
+   d  Delete image, sample, or point
+   p  Profiles at one sample for all images and all samples for one image
+   q  Quit
+   r  Redraw
+   s  Spectra at one sample for all images and all samples for one image
+   u  Undelete spectrum, sample, or point
+   w  Profile widths verses focus and distribution of widths
+   z  Zoom on a single sample showing correlation profile and spectrum
+   <space>  Status line output for selected image and sample
+.fi
+
+.ih
+DESCRIPTION
+This task estimates the dispersion width of spectral lines in sequences of
+arc spectra taken at different focus settings (or with some other parameter
+varied).  The widths can be measured at different spatial and dispersion
+positions, called "samples", on the detector.  The width estimates are
+recorded and displayed graphically to investigate dependencies and
+determine appropriate settings for the spectrograph setup.  The task may
+also measure dispersion shifts when multiple spectral samples are
+specified.  This task does not measure the focus point-spread-function
+width across the dispersion.
+
+The input images are specified with an image template list.  The list may
+consist of explicit image names, wildcard templates, and @ files.  A
+"focus" value is associated with each image.  This may be any numeric
+quantity (integer or floating point).  The focus values may be specified in
+several ways.  If no value is given then index numbers are assigned to
+the images in the order in which they appear in the image list.  A range
+list may be specified as described in the help topic \fBranges\fR.  This
+consists of individual values, ranges of values, a starting value and a
+step, and a range with a step.  The elements of the list are separated by
+commas, ranges are separated by hyphens, and a step is indicated by the
+character 'x'.  Long range lists, such as a list of individual focus
+values, may be placed in a file and specified with the @<filename>
+convention.  Finally, a parameter in the image header may be used for the
+focus values by simply specifying the parameter name.
+
+Two dimensional long slit images are summed into one or more one
+dimensional spectra across the dispersion.  The dispersion axis is defined
+either by the image header parameter DISPAXIS or the \fIdispaxis\fR task
+parameter with the image header parameter having precedence.  The range of
+lines or columns across the dispersion to be used is specified by the
+parameters \fIslit1\fR and \fIslit2\fR.  If specified as INDEF then the
+image limits are used.  This range is then divided into the number of
+spectra given by the parameter \fInspectra\fR.  Use of more than one
+spectrum across the dispersion allows investigation of variations along the
+slit.  In addition, if the parameter \fIshifts\fR is set the spectrum
+nearest the center is used as a reference against which shifts in the
+dispersion positions of the features in the other spectra are determined by
+crosscorrelation.
+
+The conversion of two dimensional spectra to one dimensional spectra may
+also be performed separately using the tasks in the \fBapextract\fR
+package.  This would be done typically for multifiber or echelle format
+spectra.  If the two dimensional spectra have been extracted to one
+dimensional spectra in this way the task ignores the dispersion axis and
+number of spectra parameters.  The data limits (\fIslit1\fR and
+\fIslit2\fR) are still used to select a range of lines in  "multispec"
+format images.  The \fIshifts\fR parameter also applies when there are
+multiple spectra per image.  However, it does not make sense in the case of
+echelle spectra and so it should be set to no in that case.
+
+In addition to dividing the spatial axis into a number of spectra the
+dispersion axis may also be divided into a set of subspectra.  The number
+of divisions is specified by the \fIndisp\fR parameter which applies to
+both long slit and 1D extracted spectra.  When the dispersion axis is
+divided into more than one sample, the dependence of the dispersion widths
+and shifts along the dispersion may be investigated.
+
+Each spectral sample has a low order continuum subtracted using a
+noninteractive iterative rejection algorithm to exclude the spectral
+lines.  This technique is described further under the topic
+\fIcontinuum\fR.  The continuum subtracted spectrum is then tapered with a
+cosine bell function and autocorrelated.  The length of the taper and the
+range of shifts for the correlation is set by the \fIcorwidth\fR
+parameter.  This parameter should be only slightly bigger than the expected
+feature widths to prevent correlations between different spectral lines.
+The correlation profile is offset to zero at the edges of the profile and
+normalized to unity at the profile center.  The profiles may be viewed as
+described below.
+
+If there is more than one spatial sample the central spectrum is also
+crosscorrelated against the other spectra at the same dispersion
+sample.  The crosscorrelation is computed in exactly the same way as
+the autocorrelation.  The crosscorrelation profiles are only used for
+determining shifts between the two samples and are not used in the
+width determinations.
+
+A cubic spline interpolator is fit to the profiles and this interpolation
+function is used to determined the profile width and center.  The width is
+measured at a point given by the \fIlevel\fR parameter relative to the
+profile peak.  It may be specified as a fraction of the peak if it is less
+than one or a percentage of the peak if it is greater than one.  The
+default value of 0.5 selects the full width at half maximum.  The
+autocorrelation width is divided by the square root of two to yield an
+estimate of the width of the spectral features in the spectrum in units of
+pixels.
+
+Having computed the width and shift for each input image at each sample,
+the "best focus" values (focus, width, and shift) are estimated for each
+sample.  As discussed later, it is possible to exclude some samples
+from this calculation by deleting them graphically.
+First the images with the smallest measured width at each distinct
+focus are selected since it is possible to input more than one image at the
+same focus.  The selected images are sorted by focus value and the image
+with the smallest width is found.  If that image has the lowest or highest
+focus (which will always be the case if there are only one or two images)
+then the best focus, width, and shift are those measured for that image.
+If there are three or more focus values and the minimum width focus image
+is not an endpoint then parabolic interpolation is used to find the minimum
+width.  The focus at this minimum width is the "best focus".
+The dispersion shift is the parabolic interpolation of the shifts at
+the best focus.  The "average best focus" values are then the average of
+the "best focus" values over all samples.
+
+After computing the correlation profiles, the profile widths and shifts,
+and the best focus values, an interactive graphics mode is entered.  This
+is described in detail below.  The graphics mode is exited with the 'q'
+key.  At this point the results are written to the standard output (usually
+the terminal) and to a logfile if one is specified.  The output begins with
+a banner identifying the task, version of IRAF, the user, and the date and
+time.  The next line gives the best average focus and width.  This banner
+also appears in all plots.  Then each image is listed with the focus value
+and average width (over all samples).  Finally the image with the smallest
+average width is identified and tables showing the width and shifts (if
+computed) at each sample position are printed.  If there is only one sample
+then the tables are not output.
+
+INTERACTIVE GRAPHICS MODE
+
+There are five types of plot formats which are selected with the 'b', 'p',
+'s', 'w', and 'z' keys.  The available formats and their content are
+modified depending on the number of images and the number of samples.  If
+there is only one image or one sample per image some of the plot formats
+are not available.  If there are a large number of images or a large number
+of samples the content of the plot formats may be abbreviated for
+legibility.
+
+In all plots there is a concept of the current image and the current
+sample.  In general there is an indication, usually a box, of which image
+and sample is the current one.  The current image and sample are
+changed by pointing at a particular point, box, circle, or symbol for that
+image and sample and typing a key.
+
+The 'b' key produces summary graphs of the best focus values (as described
+above) at each sample position.  There must be more than one image and more
+than one sample (either along or across the dispersion or both).  This is
+the initial plot shown when this condition is satisfied.  The central graph,
+which is always drawn, represents the best focus (smallest) width at each
+sample by circles of size proportional to the width.  The position of the
+circle indicates the central line and column of the sample.  If there are
+multiple samples across the dispersion and the \fIshifts\fR parameter is
+set then little vectors are also drawn from the center of the circle in the
+direction of the shift and with length proportional to the shift.  If there
+are 5 or fewer samples in each dimension the values of the best focus and
+the width and shift (if computed and nonzero) at that focus, are printed on
+the graph next to the circles.  If there are more samples this information
+may be obtained by pointing at the sample and typing the space key.
+
+In addition to the spatial graph there may be graphs along the line or column
+axes.  These graphs again show the widths as circles but one axis is either
+the line or column and the other axis is either the best focus value or the
+shift.  The focus graph marks the best average focus (over all samples) by
+a dashed line and a solid line connects the mean focus at each column or
+line.  The focus graphs will only appear if there is more than one sample
+along a particular image axis.  The shift graphs will only appear if the
+shifts are computed (\fIshifts\fR parameter is yes) and there is more than
+one sample along a particular dimension.  Lines are drawn at zero shift and
+connecting the mean shift at each point along the spatial axis.  Note that
+there is always a point at zero shift which is the reference sample.
+
+The best focus graphs are the exception in showing a current image and
+sample.  When changing to one of the other plots based on a current image
+and sample the circle from the central spatial graph nearest the cursor is
+used (note that the other focus and shift graphs are ignored).  The sample
+is defined by it's spatial position and the image is the one with
+focus closest to the best focus value of that sample.
+
+The 'w' key produces a graph showing the sample widths as a function of
+focus value.  There must be more than one image and more than one sample
+for this type of graph.  The top graph is a symbol plot of width verses
+focus.  The symbols are crosses except for the current image which is shown
+with pluses.  The current sample is highlighted with a box.  Also shown is
+a long dashed line connecting the widths for the current sample at each
+focus value and short dashed lines showing the best average focus and
+width.
+
+The lower portion of the 'w' key are graphs showing the
+widths as circles with size proportional to the width and position
+corresponding to the spatial position of the sample in the image.  If there
+are more than 5 samples in either dimension the graph is for the current
+image.  Otherwise there is a box for each image with the focus value
+(provided there are not too many images) indicated.  The circles are
+arranged as they would be spatially in columns and rows.  The samples
+closest to the best focus are indicated by pluses.  This allows seeing
+where the best focus values cluster.  The current image and sample are
+indicated by highlighting boxes.
+
+The 'p' key produces graphs of the autocorrelation profiles.  This also
+requires more than one image and more than one sample.  The top graph shows
+the profiles of all images at a particular sample and the bottom graph shows
+the profiles of all samples at a particular image.  The bottom sample boxes
+are arranged in columns and rows in the same way the samples are
+distributed in the image.  The current image and current sample are
+highlighted by a box.
+
+The profiles are drawn with a solid line using the interpolator function
+and the actual pixel lags are indicated with pluses.  The profiles are
+drawn shifted by the amount computed from the crosscorrelation.
+Note that the shift is added to the autocorrelation profile
+and the crosscorrelation profile is not what is plotted.  The zero shift
+position is indicated by a vertical line.  If there are less than 25 boxes
+the boxes are labeled by the width, shift (if nonzero), and focus.
+
+The 's' key plot is similar to the 'p' key plot but shows the spectra
+rather than the profiles.  The top graphs are the spectra of each image at
+a particular sample and the bottom graphs are the spectra of each sample
+for a particular image.  The current image and sample are highlighted by a
+box.
+
+The 'z' key graphs the autocorrelation profile and the spectrum
+of a single sample.  This graph provides scales which are not
+provided with the 'p' and 's' graphs.  If there is only one image
+and one sample then this is the only plot available.
+
+It is possible to exclude some of the samples from the calculation
+of the best focus and best average focus values.  This is done by
+deleting them using the 'd' key.  When using the 'd' key you must
+specify the sample to be deleted in one of the graphs.  You are
+then asked if only that sample (point) is to be deleted, if all
+samples from that image are to be deleted, or if the same sample
+from all images is to be deleted.  The deleted data is no longer
+shown explicitly but the space occupied by the data is still present
+so that the data may be included again by typing the 'u' undelete
+key.  When the task is exited with the 'q' key the printed and
+logged results will have the deleted data excluded.
+
+The remaining cursor keys do the following.  The '?' key gives a
+summary of the cursor keys.  The 'r' key redraws the current plot.
+The space key prints information about the current sample.  This
+is mostly used when there are too many images or samples to annotate
+the graphs with the focus, width, and shift.  Finally the 'q'
+key quits the task.
+.ih
+EXAMPLES
+1.  A series of 2D focus images is obtained with focus values
+starting at 400 in steps of -50.  The slit is between columns 50
+and 130.  There are 3 samples across the dispersion and 3 along
+the dispersion.
+
+.nf
+    cl> lpar specfocus
+	   images = "@imlist"       List of images
+	   (focus = "400x-50")     Focus values
+	(corwidth = 20)             Correlation width
+	   (level = 0.5)            Percent or fraction of peak
+	  (shifts = yes)            Compute shifts across the disp?\n
+	(dispaxis = 2)              Dispersion axis (long slit only)
+	(nspectra = 3)              Number of spec samples (ls only)
+	   (ndisp = 3)              Number of dispersion samples
+	   (slit1 = 50)             Lower slit edge
+	   (slit2 = 130)            Upper slit edge\n
+	 (logfile = "logfile")      Logfile
+	    (mode = "ql")
+    cl> specfocus @imlist
+    <Interactive graphics which is exited with the 'q' key>
+    SPECFOCUS: NOAO/IRAF V2.10EXPORT valdes Thu 19:41:41 17-Sep-92
+      Best avg focus at 206.6584 with avg width of 2.91 at 50% of peak
+
+      -- Average Over All Samples
+
+				     Image  Focus  Width
+				jdv011.imh   100.   3.78
+				jdv010.imh   150.   3.28
+				jdv009.imh   200.   2.95
+				jdv008.imh   250.   3.17
+				jdv007.imh   300.   3.41
+				jdv006.imh   350.   3.74
+				jdv005.imh   400.   4.16
+
+      -- Image jdv009.imh at Focus 200. --
+
+
+	    Width at 50% of Peak:
+
+			 Columns
+			   50-76      77-103    104-130 
+	       Lines  +---------------------------------
+	       2-267  |    2.93       2.58       2.74   
+	     268-533  |    3.17       2.76       2.89   
+	     534-799  |    3.77       2.23       3.50   
+
+	    Position Shifts Relative To Central Sample:
+
+			 Columns
+			   50-76      77-103    104-130 
+	       Lines  +---------------------------------
+	       2-267  |    0.68       0.00       0.18   
+	     268-533  |    0.64       0.00       0.13   
+	     534-799  |    0.92       0.00       0.16   
+.fi
+.ih
+SEE ALSO
+imexamine, implot, ranges, splot
+.endhelp
diff --git a/noao/obsutil/src/doc/sptime.hlp b/noao/obsutil/src/doc/sptime.hlp
new file mode 100644
index 00000000..a2c0f242
--- /dev/null
+++ b/noao/obsutil/src/doc/sptime.hlp
@@ -0,0 +1,1218 @@
+.help sptime Nov01 noao.obsutil
+.ih
+NAME
+sptime -- spectroscopic exposure time calculator
+.ih
+USAGE
+sptime
+.ih
+PARAMETERS
+The parameters in this task have certain common features.
+.ls (1)
+All parameters, except \fIspectrograph\fR and \fIsearch\fR, may be
+specified as spectrograph table parameters of the same name.  Some
+parameters may also be specified in other tables.  The tables in which the
+paramters may be specified are shown in brackets.  Table values are used
+only if a string parameter is "" or a numeric parameter is INDEF.
+Therefore parameter set values override values in the tables.  To override
+a table specified in the spectrograph file by no file the special value
+"none" is used.  This task also uses default values, shown below in
+parenthesis, for parameters that have no value specified either in the
+parameter set or in a table.
+.le
+.ls (2)
+Parameters that specify a table take the value of a file or a numeric
+constant.  A constant is like a table with the same values for all value
+of the independent variable(s).
+.le
+.ls (3)
+Tables which are specified as filenames are sought first in the current
+working directory, then in one of the directories given by the
+\fIsearch\fR parameter, and finally in the package library directory
+sptimelib$.
+.le
+
+
+.ls time = INDEF (INDEF) [spectrograph]
+Total exposure time in seconds.  This time may be divided into shorter
+individual exposure times as defined by the \fImaxexp\fR parameter.  If
+the value is INDEF then the exposure time needed to achieve the
+signal-to-noise per pixel specified by the \fIsn\fR parameter is computed.
+.le
+.ls sn = 25. (25.) [spectrograph]
+Desired signal-to-noise per pixel at the central wavelength if the
+exposure \fItime\fR parameter is not specified.
+.le
+
+
+The following parameters define the source and sky/atmosphere background
+spectra.
+.ls spectrum = "blackbody"
+Source spectrum.  This may be a table or one of the following  special words:
+.ls blackbody
+Blackbody spectrum with temperature given by the \fItemperature\fR
+parameter.
+.le
+.ls flambda_power
+Power law in f(lambda) with index given by the \fIindex\fR parameter;
+f(lambda) proportional to lambda^(index).
+.le
+.ls fnu_power
+Power law in f(nu) with index given by the \fIindex\fR parameter;
+f(nu) proportional to nu^(index).
+.le
+
+The table is a two column text file of wavelength in Angstroms and flux in
+ergs/s/cm^2/A.
+.le
+.ls spectitle = "" [spectrum|spectrograph]
+Spectrum title.
+.le
+.ls E = 0. (0.) [spectrum|spectrograph]
+The E(B-V) color excess to apply a reddening to the source spectrum.  The
+reddening maintains the same table or reference flux at the reference
+wavelength.  A value of zero corresponds to no reddening.
+.le
+.ls R = 3.1 (3.1) [spectrum|spectrograph]
+The R(V) = A(V)/E(B-V) for the extinction law.  The extinction law is that
+of Cardelli, Clayton, and Mathis, \fBApJ 345:245\fR, 1989.  The default
+R(V) is typical of the interstellar medium.
+.le
+.ls sky = "" ("none") [spectrograph]
+Sky or background table.  The table is a two or three column text file
+consisting of wavelength in Angstroms, optional moon phase between 0 (new
+moon) and 14 (full moon), and flux in ergs/s/cm^2/A/arcsec^2.
+.le
+.ls skytitle = "" [sky|spectrograph]
+Sky title.
+.le
+.ls extinction = "" ("none") [spectrograph]
+Extinction table.  The table is a two column text file consisting of
+wavelength in Angstroms and extinction in magnitudes per airmass.
+.le
+.ls exttitle = "" [spectrograph]
+Extinction title.
+.le
+
+
+The following parameters are used with the source spectrum is specified
+by the special functions.
+.ls refwave = INDEF (INDEF) [spectrum|spectrograph]
+Reference wavelength, in units given by the \fIunits\fR parameter, defining
+the flux of the source.  This is also used as the wavelength where
+reddening does not change the spectrum flux.  A value of INDEF uses the
+observation central wavelength.
+.le
+.ls refflux = 10. (10.) [spectrograph]
+Reference source flux or magnitude at the reference wavelength for the
+model spectral distributions.  The units are specified by the funits parameter.
+.le
+.ls funits = "AB" ("AB") [spectrograph]
+Flux units for the reference flux.  The values are "AB" for monochromatic
+magnitude, "F_lambda" for ergs/s/cm^2/A, "F_nu" for ergs/s/cm^2/Hz,
+and standard bandpasses of U, B, V, R, I, J, H, Ks, K, L, L' and M.
+.le
+.ls temperature = 6000. (6000.) [spectrograph]
+Blackbody temperature for a blackbody source spectrum in degrees Kelvin.
+.le
+.ls index = 0. (0.) [spectrograph]
+Power law index for the power law source spectrum.
+.le
+
+
+The following parameters are observational parameters describing either
+the observing conditions or spectrograph setup.
+.ls seeing = 1. (1.) [spectrograph]
+The full width at half maximum (FWHM) of a point source in arc seconds.
+.le
+.ls airmass = 1. (1.) [spectrograph]
+The airmass of the observation.  This is only used if an extinction table
+is specified.
+.le
+.ls phase = 0. (0.) [spectrograph]
+The moon phase running from 0 for new moon to 14 for full moon.  This is
+used if the sky spectrum is given as a function of the moon phase.
+.le
+.ls thermal = 0. (0.) [telescope|spectrograph]
+Temperature in degress Kelvin for the thermal background of the telescope
+and spectrograph.  If greater than zero a blackbody surface brightness
+background is computed and multiplied by an emissivity specified by
+the \fIemissivity\fR table.
+.le
+.ls wave = INDEF (INDEF) [spectrograph]
+Central wavelength of observation in units given by the \fIunits\fR
+parameter.  If the value is INDEF it is determined from the efficiency peak
+of the disperser.
+.le
+.ls order = INDEF (INDEF) [spectrograph]
+Order for grating or grism dispersers.  If the value is INDEF it is
+determined from the order nearest the desired central wavelength.  If both
+the order and central wavelength are undefined the first order is used.
+.le
+.ls xorder = INDEF (INDEF) [spectrograph]
+Order for grating or grism cross dispersers.  If the value is INDEF it
+is determined from the order nearest the desired central wavelength.  If
+both the order and central wavelength are undefined the first order is
+used.
+.le
+.ls width = INDEF (-2.) [aperture|spectrograph]
+The aperture width (dispersion direction) for rectangular apertures
+such as slits.  Values may be positive to specify in arc seconds or
+negative to specify in projected pixels on the detector.
+.le
+.ls length = INDEF (-100.) [aperture|spectrograph]
+The aperture length (cross dispersion direction) for rectangular
+apertures such as slits.  Values may be positive to specify in arc seconds
+or negative to specify in projected pixels on the detector.
+.le
+.ls diameter = INDEF (-2.) [fiber|aperture|spectrograph]
+The aperture diameter for circular apertures.  Values
+may be positive to specify in arc seconds or negative to specify in
+projected pixels on the detector.  If it is found in the fiber table,
+positive values are treated as mm at the focal plane instead of arc seconds.
+.le
+.ls xbin = 1 (1) [detector|spectrograph]
+Detector binning along the dispersion direction.
+.le
+.ls ybin = 1 (1) [detector|spectrograph]
+Detector binning along the spatial direction.
+.le
+
+
+The following parameters a miscellaneous parameters for the task.
+.ls search = "spectimedb$"
+List of directories to search for the various table files.  The current
+direction is always searched first and the directory sptimelib$ is searched
+last so it is not necessary to include these directories.  The list may be
+a comma delimited list of directories, an @file, or a template.
+.le
+.ls minexp = 0.01 (0.01) [spectrograph]
+Minimumm time in seconds per individual exposure time.  This only applies
+when \fItime\fR is INDEF.  Adjustment of the exposure time for saturation
+will not allow the exposure time to fall below this value.
+.le
+.ls maxexp = 3600. (3600.) [spectrograph]
+Maximum time in seconds per individual exposure.  The minimum exposure time
+has precedence over this value.  If the total exposure time exceeds this
+amount by more than 1% then the total exposure time will be divided up into
+the fewest individual exposures with equal exposure time that are less than
+this amount.  Note that by making the minimum and maximum times the same a
+fixed integration time can be defined.
+.le
+.ls units = "Angstroms" ("Angstroms") [spectrograph]
+Dispersion units for input and output dispersion coordinates.  The
+units syntax is described in the UNITS section.  The most common units
+are "Angstroms", "nm", "micron", and "wn".  Note that this does not
+apply to the dispersion units in the tables which are always in Angstroms.
+.le
+.ls skysub = "" (default based on context) [spectrograph]
+Type of sky and background subtraction.  The values are "none" for no
+background subtraction, "longslit" for subtraction using pixels in the
+aperture, "multiap" for background determined from a number of other
+apertures, and "shuffle" for shuffled observations.  The multiap case is
+typical for fiber spectrographs.  For shuffle the duty cycle is 50% and the
+exposure times are the sum of both sky and object.  If no sky or thermal
+background is specified then the default is "none".  If a fiber table or
+circular aperture is specified the default is "multiap" otherwise the
+default is "longslit".
+.le
+.ls nskyaps = 10  (10) [spectrograph]
+Number of sky apertures when using "multiap" sky subtraction.
+.le
+.ls subpixels = 1 (1) [spectrograph]
+Number of subpixels within each computed pixel.
+The dispersion pixel width is divided into this number of equal
+width subpixels.  The flux at the dispersions represented by the subpixels
+are computed and then summed to form the full pixel flux.  This option is used
+when there is structure in the tables, such as the sky and filter tables to
+simulate instrumental masking of sky lines, which is finer than a pixel
+dispersion width.
+.le
+.ls sensfunc = "" [spectrograph]
+Sensitivity function table.  This is a two column text file consisting
+of wavelength in Angstroms and sensitivity defined as
+2.5*(log(countrate)-log(flambda)),
+where countrate is the count rate (without extinction) in counts/s/A
+and flambda is the source flux in ergs/s/cm^2/A.  This table is used
+to compute an efficiency correction given a measurement of the
+sensitivity function from standard stars for the instrument.
+.le
+
+
+The following parameters control the output of the task.  The task
+always prints a result page at the central wavelength but additional
+graphical and text output may be produced at a set of equally spaced
+points across the size of the detector.
+.ls output = "object" ("") [spectrograph]
+List of quantities to output as graphs and/or in a text file.  These are
+given as a function of dispersion (as specified by units parameters)
+sampled across the dispersion coverage of the detector.  The choices are:
+.ls counts
+Object and background counts per individual exposure.
+.le
+.ls snr
+Signal-to-noise ratio per pixel per individual exposure.
+.le
+.ls object
+Object counts per individual exposure.  This includes contribution
+from other orders if there is no cross dispersion and the blocking
+filters do not completely exclude other orders.
+.le
+.ls rate
+Photons/second/A per individual exposure for the object and background.
+.le
+.ls atmosphere
+Percent transmission of the atmosphere.
+.le
+.ls telescope
+Percent transmission of the telescope.
+.le
+.ls adc
+Percent transmission of the ADC if one is used.
+.le
+.ls aperture
+Percent transmission of the aperture.
+.le
+.ls fiber
+Percent transmission of the fiber if one is used.
+.le
+.ls filter
+Percent transmission of the first filter if one is used.
+.le
+.ls filter2
+Percent transmission of the second filter if one is used.
+.le
+.ls collimator
+Percent transmission of the collimator.
+.le
+.ls disperser
+Percent efficiency of the disperser.
+.le
+.ls xdisperser
+Percent efficiency of the cross disperser if one is used.
+.le
+.ls corrector
+Percent transmission of the corrector if one is used.
+.le
+.ls camera
+Percent transmission of the camera.
+.le
+.ls detector
+Percent DQE of the detector.
+.le
+.ls spectrograph
+Percent transmission of the spectrograph if a transmission
+function is defined.
+.le
+.ls emissivity
+Emissivity of the telescope/spectrograph if an emissivity function
+is defined.
+.le
+.ls thruput
+Percent system thruput from telescope to detected photons.
+.le
+.ls sensfunc
+Sensitivity function values given as 2.5*(log(countrate)-log(flambda)),
+where countrate is the count rate (without extinction) in counts/s/A
+and flambda is the source flux in ergs/s/cm^2/A.
+.le
+.ls correction
+Multiplicative correction factor needed to convert the computed
+count rate to that given by an input sensitivity function.
+.le
+.ls ALL  
+All of the above.
+.le
+.le
+.ls nw = 101 (101) [spectrograph]
+Number of dispersion points to use in the output graphs and text
+file.  Note that this is generally less than the number of pixels in
+the detector for execution speed.
+.le
+.ls list = "" [spectrograph]
+Filename for list output of the selected quantities.  The output
+will be appended if the file already exists.
+.le
+.ls graphics = "stdgraph" ("stdgraph") [spectrograph]
+Graphics output device for graphs of the output quantities.
+.le
+.ls interactive = "yes" ("yes") [spectrograph]
+Interactive pause after each graph?  If "yes" then cursor input is
+enabled after each graph otherwise all the graphs will be drawn without
+pause.  When viewing the graphs interactively this should be "yes" otherwise
+the graphs will flash by rapidly leaving the last graph on the screen.
+When outputing only one graph or when redirecting the graphs to a
+printer or file then setting this parameter to "no" is suggested.
+.le
+
+The last parameter is a "parameter set" ("pset") containing all the
+spectrograph parameters.
+.ls specpars = ""
+Spectrograph parameter set.  If "" then the default pset \fBspecpars\fR
+is used otherwise the named pset is used.
+.le
+
+
+
+SPECPARS PARAMETERS
+.ls spectrograph = ""
+Spectrograph efficiency table.  This text file may contain parameters and an
+efficiency table.  The table consists of two columns containing
+wavelengths and efficiencies.  The efficiencies are for all elements
+which are not accounted for by other tables.
+.le
+.ls title = "" [spectrograph]
+Title for the spectrograph.
+.le
+.ls apmagdisp = INDEF (1.), apmagxdisp = INDEF (1.) [spectrograph]
+Magnification between the entrance aperture and the detector along and
+across the dispersion direction.  This describes any magnification (or
+demagnification) in the spectrograph other than that produced by the ratio
+of the collimator and camera focal lengths and anamorphic magnification
+from the disperser.  The may consist of actual magnification optics or
+projection effects such as tilted aperture plates (when the aperture size
+is specified in the untilted plate).
+.le
+.ls inoutangle = INDEF (INDEF) [spectrograph]
+Incident to diffracted grating angle in degrees for grating dispersers.
+For typical spectrographs which are not cross dispersed this is the
+collimator to camera angle.  If the value is INDEF derived from the grating
+parameters.
+.le
+.ls xinoutangle = INDEF (INDEF) [spectrograph]
+Incident to diffracted grating angle in degrees for grating cross
+dispersers.  If the value is INDEF it is derived from the grating
+parameters.
+.le
+
+
+.ls telescope = "" [spectrograph]
+Telescope efficiency table as a function of wavelength.  
+.le
+.ls teltitle = "" [telescope|spectrograph]
+Telescope title.
+.le
+.ls area = INDEF (1.) [telescope|spectrograph]
+Effective collecting area of the telescope in m^2.  The effective area
+includes reductions in the primary area due to obstructions.
+.le
+.ls scale = INDEF (10.) [telescope|spectrograph]
+Telescope plate scale, in arcsec/mm, at the entrance aperture of the
+spectrograph.
+.le
+.ls emissivity = "" [telescope|spectrograph]
+Emissivity table.  The emissivity is for all elements in the telescope
+and spectrograph.  If an emissivity is specified and an the \fIthermal\fR
+temperature parameter is greater than zero then a thermal background
+is added to the calculation.
+.le
+.ls emistitle = "" [emissivity|spectrograph]
+Title for the emissivity table used.
+.le
+
+
+.ls corrector = "" [spectrograph]
+Efficiency table for one or more correctors.
+.le
+.ls cortitle = "" [corrector|spectrograph]
+Title for corrector table used.
+.le
+.ls adc = "" [spectrograph]
+Efficiency table for atmospheric dispersion compensator.
+.le
+.ls adctitle = "" [adc|spectrograph]
+Title for ADC table used.
+.le
+
+
+.ls disperser = "" [spectrograph]
+Disperser table.  If this file contains an efficiency table it applies
+only to first order.  An alternate first order table and tables for
+other orders are given by table parameters "effN", where N is the order.
+.le
+.ls disptitle = "" [disperser|spectrograph]
+Title for disperser.
+.le
+.ls disptype = "" ("grating") [disperser|spectrograph]
+Type of disperser element.  The chocies are "grating", "grism", or "generic".
+The generic setting will simply use the desired central wavelength and
+dispersion without a grating or grism model.  One effect of this is that
+the mapping between detector pixel and wavelength is linear; i.e. a constant
+dispersion per pixel.
+.le
+.ls gmm = INDEF (300.) [disperser|spectrograph]
+Ruling in lines per mm.  If not specified it will be derived from the
+other disperser parameters.  If there is not enough information to
+derive the ruling then an ultimate default of 300 lines/mm is used.
+.le
+.ls blaze = INDEF (6.) [disperser|spectrograph]
+Blaze (grating) or prism (grism) angle in degrees.  If not specified it
+will be derived from the other disperser parameters.  If there is not
+enough information to derive the angle then an ultimate default of 6
+degrees is used.
+.le
+.ls oref = INDEF (1) [disperser|spectrograph]
+When a central (blaze) wavelength is specified this parameter indicates
+which order it is for.
+.le
+.ls wavelength = INDEF (INDEF) [disperser|spectrograph]
+Central (blaze) wavelength in Angstroms for the reference order.  This
+parameter only applies to gratings.  If it is not specified it will
+be derived from the other disperser parameters.
+.le
+.ls dispersion = INDEF (INDEF) [disperser|spectrograph]
+Central dispersion in A/mm for the reference order.  This parameter only
+applies to gratings.  If it is not specified it will be derived from the
+other disperser parameters.
+.le
+.ls indexref = INDEF (INDEF) [disperser|spectrograph]
+Grism index of refraction for the reference order.  This parameter only
+applies to grisms.  If it is not specified it will be derived from
+the other disperser parameters.
+.le
+.ls eff = INDEF (1.) [disperser|spectrograph]
+Peak efficiency for the theoretical disperser efficiency function.
+When an efficiency table is not specified then a theoretical efficiency
+is computed for the disperser.  This theoretical efficiency is scaled
+to peak efficiency given by this parameter.
+.le
+
+
+.ls xdisperser = "" [spectrograph]
+Crossdisperser table.  If this file contains an efficiency table it applies
+only to first order.  An alternate first order table and tables for
+other orders are given by table parameters "xeffN", where N is the order.
+.le
+.ls xdisptitle = "" [xdisperser|spectrograph]
+Title for crossdisperser.
+.le
+.ls disptype = "" ("grating") [xdisperser|spectrograph]
+Type of crossdisperser element.  The chocies are "", "grating", "grism",
+or "generic".  The empty string eliminates use of a cross disperser.
+The generic setting will simply use the desired central wavelength and
+dispersion without a grating or grism model.  One effect of this is that
+the mapping between detector pixel and wavelength is linear; i.e. a constant
+dispersion per pixel.
+.le
+.ls gmm = INDEF (INDEF) [xdisperser|spectrograph]
+Ruling in lines per mm.  If not specified it will be derived from the
+other crossdisperser parameters.
+.le
+.ls xblaze = INDEF (6.) [xdisperser|spectrograph]
+Blaze (grating) or prism (grism) angle in degrees.  If not specified it
+will be derived from the other crossdisperser parameters.
+.le
+.ls xoref = INDEF (1) [xdisperser|spectrograph]
+When a central (blaze) wavelength is specified this parameter indicates
+which order it is for.
+.le
+.ls xwavelength = INDEF (INDEF) [xdisperser|spectrograph]
+Central (blaze) wavelength in Angstroms for the reference order.  This
+parameter only applies to gratings.  If it is not specified it will
+be derived from the other crossdisperser parameters.
+.le
+.ls xdispersion = INDEF (INDEF) [xdisperser|spectrograph]
+Central dispersion in A/mm for the reference order.  This parameter only
+applies to gratings.  If it is not specified it will be derived from the
+other crossdisperser parameters.
+.le
+.ls xindexref = INDEF (INDEF) [xdisperser|spectrograph]
+Grism index of refraction for the reference order.  This parameter only
+applies to grisms.  If it is not specified it will be derived from
+the other crossdisperser parameters.
+.le
+.ls xeff = INDEF (1.) [xdisperser|spectrograph]
+Peak efficiency for the theoretical crossdisperser efficiency function.
+When an efficiency table is not specified then a theoretical efficiency
+is computed for the crossdisperser.  This theoretical efficiency is scaled
+to peak efficiency given by this parameter.
+.le
+
+
+.ls aperture = "" (default based on context) [spectrograph]
+Aperture table.  The text file gives aperture thruput as a function of the
+aperture size in units of seeing FWHM.  For rectangular apertures there are
+two independent variables corresponding to the width and length while for
+circular apertures there is one independent variable corresponding to the
+diameter.  If not specified a default table is supplied.  If a fiber table
+or a diameter is specified then the table "circle" is used otherwise the
+table "slit" is used.  Because "sptimelib$" is the last directory searched
+there are default files with these names in this directory for Gaussian
+seeing profiles passing through a circular or slit aperture.
+.le
+.ls aptitle = "" [aperture|spectrograph]
+Title for aperture used.
+.le
+.ls aptype = "" (default based on context) [aperture|spectrograph]
+The aperture types are "rectangular" or "circular".  If the
+parameter is not specified then if the aperture table has two columns the
+type is "circular" otherwise it is "rectangular".
+.le
+
+
+.ls fiber = "" [spectrograph]
+Fiber transmission table.  The transmission is a function of wavelength
+in Angstroms.  If no fiber transmission is specified then no fiber
+component is included.
+.le
+.ls fibtitle = "" [fiber|spectrograph]
+Title for fiber transmission used.
+.le
+
+
+.ls filter = "" [spectrograph]
+Filter transmission table.  The transmission is a function of wavelength
+in Angstroms.  If no filter transmission is specified then no filter
+component is included.
+.le
+.ls ftitle = "" [filter|spectrograph]
+Title for filter transmission used.
+.le
+.ls filter2 = "" [spectrograph]
+Filter transmission table.  The transmission is a function of wavelength
+in Angstroms.  If no filter transmission is specified then no filter
+component is included.
+.le
+.ls f2title = "" [filter|spectrograph]
+Title for filter transmission used.
+.le
+.ls block = "" ("no") [filter|spectrograph]
+If "yes" then no check will be made for other orders.
+.le
+
+
+.ls collimator = "" (1.) [spectrograph]
+Collimator transmission table.  The transmission is a function of
+wavelength in Angstroms.  If no collimator is specified then a unit
+transmission is used.
+.le
+.ls coltitle = "" [collimator|spectrograph]
+Title for collimator.
+.le
+.ls colfl = INDEF (1.) [collimator|spectrograph]
+Collimator focal length in meters.  The ratio of the collimator to camera
+focal lengths determines the magnification between the aperture and the
+detector.
+.le
+
+.ls camera = "" (1.) [spectrograph]
+Camera transmission table.  The transmission is a function of wavelength
+in Angstroms.  If no camera is specified then a unit transmission
+is used.
+.le
+.ls camtitle = "" [camera|spectrograph]
+Title for camera.
+.le
+.ls camfl = "" (1.) [camera|spectrograph]
+Camera focal length in meters.  The ratio of the collimator to
+camera focal lengths determines the magnification between the aperture
+and the detector.  The camera focal length also determines the dispersion
+scale at the detector.
+.le
+.ls resolution = "" (2 pixels) [camera|spectrograph]
+Camera resolution on the detector in mm.
+.le
+.ls vignetting = "" (1.) [camera|spectrograph]
+Vignetting table.  The independent variable is distance from the center
+of the detector in mm.  The value is the fraction the light transmitted.
+If no vignetting table is specified then no vignetting effect is applied.
+.le
+
+
+.ls detector = "" (1.) [spectrograph]
+Detector DQE table.  The DQE is a function of wavelength in Angstroms.
+.le
+.ls dettitle = "" [detector|spectrograph]
+Title for detector.
+.le
+.ls ndisp = INDEF (2048) [detector|spectrograph]
+Number of pixels along the dispersion.
+.le
+.ls pixsize = INDEF (0.02) [detector|spectrograph]
+Pixel size (assumed square) in mm.
+.le
+.ls gain = INDEF (1.) [detector|spectrograph]
+The conversion between photons and detector data numbers or counts.
+This is given as photons/ADU where ADU is analog-to-digital unit.
+.le
+.ls rdnoise = INDEF (0.) [detector|spectrograph]
+Readout noise in photons.
+.le
+.ls dark = INDEF (0.) [detector|spectrograph]
+Dark count rate in photons/s.
+.le
+.ls saturation = INDEF [detector|spectrograph]
+Number of detected photons in a pixel resulting in saturation.
+The default is no saturation.  The time per exposure will be reduced,
+but no lower than the minimum time per exposure,
+and the number of exposures increased to try and avoid saturation.
+.le
+.ls dnmax = INDEF [detector|spectrograph]
+Maximum data number or ADU allowed.  The default is no maximum.
+The time per exposure will be reduced,
+but no lower than the minimum time per exposure,
+and the number of exposures increased to try and avoid overflow.
+.le
+.ls xbin = 1 (1) [detector|spectrograph]
+Detector binning along the dispersion direction.
+.le
+.ls ybin = 1 (1) [detector|spectrograph]
+Detector binning along the spatial direction.
+.le
+.ih
+DISCUSSION
+
+
+OVERVIEW
+
+The spectroscopic exposure time package, \fBSPECTIME\fR, consists of a
+general calculation engine, \fBSPTIME\fR, and a collection of user or
+database defined IRAF scripts.  The scripts are one type of user interface
+for \fBSPTIME\fR.  Other user interfaces are Web-based forms and IRAF
+graphics/window applications.  The user interfaces customize the general
+engine to specific spectrographs by hiding components and parameters not
+applicable to that spectrograph and guiding the user, through menus or
+other facilities, in the choice of filters, gratings, etc.  However,
+\fBSPTIME\fR is a standard IRAF task that can be executed directly.
+
+\fBSPTIME\fR takes an input source spectrum (either a reference blackbody,
+a power law, or a user spectrum), a background "sky" spectrum and a
+instrumental thermal background, reddening to apply to the spectrum,
+observing parameters such as exposure time, central wavelength, seeing,
+airmass, and moon phase, instrument parameters such as aperture sizes and
+detector binning, a description of the spectrograph, and produces
+information about the expected signal and signal-to-noise ratio in the
+extracted one-dimensional spectrum.  The output consists of a description
+of the observation, signal-to-noise statistics, and optional graphs and
+tables of various quantities as a function of wavelength over the
+spectrograph wavelength coverage.
+
+\fBSPTIME\fR models a spectroscopic system as a flow of photons from a
+source to the detector through various optical components.  Background
+photons from the sky, atmosphere, and the thermal emission from the
+telescope and spectrograph are added.  It then computes signal-to-noise
+ratios from the detected photons of the source and background and the
+instrumental noise characteristics.  The spectroscopic system components
+are defined at a moderate level of detail.  It is not so detailed that
+every optical element has to be described and modeled and not so coarse
+that a single throughput function is used (though one is free to put all
+the thruput information into one component).  Not all components modeled by
+the task occur in all spectroscopic systems.  Therefore many of the
+components can be left out of the calculation.
+
+The components currently included in \fBSPTIME\fR are:
+
+.nf
+    - the atmosphere (extinction and IR transmission)
+    - the telescope (all elements considered as a unit)
+    - an optional atmospheric dispersion compensator
+    - the entrance aperture (slits, fibers, masks, etc.)
+    - an optional fiber feed
+    - a spectrograph (for components not represented elsewhere)
+    - filters
+    - a collimator
+    - a disperser (grating, grism, prism, etc)
+    - a optional cross disperser (grating, grism, prism, etc)
+    - a corrector (either in the telescope of spectrograph)
+    - a camera
+    - a detector
+.fi
+
+Each of these components represent a transmission function specifying the
+fraction of incident light transmitted or detected as a function of some
+parameter or parameters.  Except for the aperture, which is a function of
+the incident source profile (typically the seeing profile) relative to the
+aperture size, the transmissions of the components listed above are all
+functions of wavelength.
+
+All the component transmission functions may be specified as either numeric
+values or as tables.  A numeric value is considered to be a special type of
+table which has the same value at all values of the independent parameters.
+By specifying only numeric values the task may be run without any table
+files.  To obtain information at a single wavelength this is all that is
+needed.
+
+To specify a dependence on wavelength or other parameter a text file table
+with two or more columns may be specified.  The tables are interpolated in
+the parameter columns to find the desired value in the last column.  The
+tables are searched for in the current directory and then in a list of user
+specified directories.  Thus, users may place files in their work area to
+override system supplied files and observatories can organize the data
+files in a database directory tree.
+
+In addition to transmission or DQE functions the spectrograph is described
+by various parameters.  All the parameters are described in the PARAMETERS
+section.  For flexibility parameters may be defined either in the
+parameter set or in one or more table files.  In all cases the parameter
+set values have precedence.   But if the values are "" for string  parameters
+or INDEF for numeric parameters the values are found either in the
+spectrograph table or in a table that is associated with the parameter.
+
+Therefore table files provide for interchangeable components, each with
+their own transmission curves, and for organizing parameters for different
+instruments.  Note that a table file may contain only parameters, only
+a table, or both.
+
+There is also another way to maintain a separate file for different
+instruments.  The \fIspecpars\fR parameter is a "parameter set" or "pset".
+The default value of "" corresponds to the pset task \fBspecpars\fR.
+However, using \fBeparam\fR one can edit this pset and then save the
+parameters to a named parameter file with ":e <name>.par".  This
+pset can be edited with \fBeparam\fR and specified in the
+\fIspecpars\fR parameter.  One other point about pset parameters is that
+they can also be included as command line arguments just as any other
+parameter in the main task parameters.
+
+Many spectrographs provide a wide variety of wavelength regions and
+dispersions.  For gratings (and to some extent for grisms) this means use
+of different gratings, orders, tilts, and possibly camera angles in the
+spectrograph.  The transmission as a function of wavelength (the grating
+efficiency) changes with these different setups.  If the transmission
+function is given as an interpolation table this would require data files
+for each setup of each disperser.  The structure of \fBSPTIME\fR allows
+for this.
+
+However, it is also possible to specify the grating and spectrograph
+parameters and have the task predict the grating efficiency in any
+particular setup.  In many cases it may be easier to use the calculated
+efficiencies rather than measure them.  Depending on the level of accuracy
+desired this may be adequate or deviations from the analytic blaze function
+can be accounted for in another component.
+
+
+TABLES
+
+\fBSPTIME\fR uses text files to provide parameters and interpolation
+tables.  The files may contain comments, parameters, and tables.
+
+Comment lines begin with '#' and may contain any text.  They can occur
+anywhere in the file, though normally they are at the beginning of the file.
+
+Parameters are comment lines of the form
+
+.nf
+    # [parameter] = [value]
+.fi
+
+where whitespace is required between each field, [parameter] is a single
+word parameter name, and [value] is a single word value.  A quoted string
+is a single word so if the value field contains whitespace, such as in
+titles, it must be quoted.  Any text following the value is ignored and may
+be used for units (not read or used by the program) or comments.
+
+The parameters are those described in the PARAMETERS section.  The tables
+in which the parameters may be included are identified in that section
+in the square brackets.  Note that it is generally true that any parameter
+may appear in the spectrograph table.
+
+The table data is a multicolumn list of numeric values.  The list must be
+in increasing order in the independent columns.  Only 1D (two columns) and
+2D (three columns) tables are currently supported.  2D tables must form a
+regular grid.  This means that any particular value from column one must
+occur for all values of column 2 and vice versa.   The table is
+interpolated as needed.  The interpolation is linear or bi-linear.
+Extrapolation outside of the table consists of the taking the nearest
+value; thus, a single line may be used to define a constant value for all
+values of the independent variable(s).
+
+Normally the table values, the dependent variable in the last column, are
+in fractional transmission or DQE.  There is a special parameter,
+"tablescale", which may be specified to multiply the dependent variable
+column.  This would mainly be used to provide tables in percent rather
+than fraction.
+
+The independent variable columns depend on the type of table.  Most tables
+are a function of wavelength.  Currently wavelengths must be in Angstroms.
+
+The types of tables and the units of the columns are listed below.
+
+.nf
+        spectrum - Angstroms ergs/s/cm^2/A
+             sky - Angstroms ergs/s/cm^2/A/arcsec^2
+      extinction - Angstroms mag/airmass
+    spectrograph - Angstroms transmission
+       telescope - Angstroms transmission
+      emissivity - Angstroms emissivity
+             adc - Angstroms transmission
+           fiber - Angstroms transmission
+      collimator - Angstroms transmission
+          filter - Angstroms transmission
+       disperser - Angstroms transmission
+      xdisperser - Angstroms transmission
+       corrector - Angstroms transmission
+          camera - Angstroms transmission
+        detector - Angstroms transmission
+     sensitivity - Angstroms 2.5*(log(countrate)-log(flambda)),
+
+             sky - Angstroms moonphase ergs/s/cm^2/A/arcsec^2
+        aperture - diameter/FWHM transmission
+        aperture - width/FWHM length/FWHM transmission
+      vignetting - mm transmission
+.fi
+
+The disperser and crossdisperser files have an additional feature to allow
+for efficiency curves at different orders.  The parameter "effN" (or "xeffN
+for crossdispersers), where N is the order, may be specified whose value is
+a separate table (or constant).  If there is no "eff1/xeff1" (efficiency in
+first order) then any efficiency table in the disperser table is used.  In
+other words, any table in the disperser file applies only to first order
+and only if there is no "eff1/xeff1" parameter defining a separate first
+order efficiency file.
+
+DISPERSION UNITS
+
+The output results, text file, and graphs are presented in dispersion
+units defined by the \fIunits\fR parameter.  In addition the \fIwave\fR
+and \fIrefwave\fR input parameters are specified in the selected units.
+All other dispersion values must currently be specified in Angstroms.
+
+The dispersion units are specified by strings having a unit type from the
+list below along with the possible preceding modifiers, "inverse", to
+select the inverse of the unit and "log" to select logarithmic units. For
+example "log angstroms" to select the logarithm of wavelength in Angstroms
+and "inv microns" to select inverse microns.  The various identifiers may
+be abbreviated as words but the syntax is not sophisticated enough to
+recognize standard scientific abbreviations except for those given
+explicitly below.
+
+.nf
+	   angstroms - Wavelength in Angstroms
+	  nanometers - Wavelength in nanometers
+	millimicrons - Wavelength in millimicrons
+	     microns - Wavelength in microns
+	 millimeters - Wavelength in millimeters
+	  centimeter - Wavelength in centimeters
+	      meters - Wavelength in meters
+	       hertz - Frequency in hertz (cycles per second)
+	   kilohertz - Frequency in kilohertz
+	   megahertz - Frequency in megahertz
+	    gigahertz - Frequency in gigahertz
+	         m/s - Velocity in meters per second
+	        km/s - Velocity in kilometers per second
+	          ev - Energy in electron volts
+	         kev - Energy in kilo electron volts
+	         mev - Energy in mega electron volts
+
+	          nm - Wavelength in nanometers
+	          mm - Wavelength in millimeters
+	          cm - Wavelength in centimeters
+	           m - Wavelength in meters
+	          Hz - Frequency in hertz (cycles per second)
+	         KHz - Frequency in kilohertz
+	         MHz - Frequency in megahertz
+	         GHz - Frequency in gigahertz
+		  wn - Wave number (inverse centimeters)
+.fi
+
+The velocity units require a trailing value and unit defining the
+velocity zero point.  For example to transform to velocity relative to
+a wavelength of 1 micron the unit string would be:
+
+.nf
+	km/s 1 micron
+.fi
+
+
+CALCULATIONS
+
+This section describes the calculations, and assumptions behind the
+calculations, performed by \fBSPTIME\fR.  These include the dispersion and
+efficiencies of gratings and grisms, the dispersion resolution, the spatial
+resolution and how it applies to the number of object and sky pixels in the
+apertures, the object and sky detected photons/counts, the signal-to-noise
+ratio , and the exposure time for a given S/N.
+
+
+Gratings
+
+Gratings are assumed to tilted only around the axis parallel to the
+groves and with the incident angle greater than the blaze angle.  The
+grating equation is then
+
+.nf
+    g * m * w = sin(tilt+phi/2) + sin(beta)
+.fi
+
+where g is the number of groves per wavelength unit, m is the order, w is
+the wavelength, tilt is the grating tilt measured from the grating normal,
+phi is the angle between the incident and diffracted rays, and beta is the
+diffracted angle.  Phi is a spectrograph parameter and g is a grating
+parameter.  At the desired central wavelength beta is tilt-phi/2 and at the
+blaze peak it is 2*blaze-tilt-phi/2 where blaze is the blaze angle.
+
+The tilt is computed from the desired central wavelength.  It is
+also used to compute the grating magnification
+
+.nf
+    magnification = cos(tilt-phi/2) / cos(tilt+phi/2)
+.fi
+
+which is used in calculating the projected slit size at the detector.
+This number is less than zero so the aperture is actually demagnified.
+
+The dispersion, treated as constant over the spectrum for the sake of
+simplicity, is given by the derivative of the grating equation at
+the blaze peak,
+
+.nf
+    dispersion = cos(blaze-phi/2) / (g * m * f)
+.fi
+
+where f is the camera focal length.
+
+The grating efficiency or blaze function is computed as described by
+Schroeder and Hilliard (Applied Optics, vol 19, 1980, p. 2833).  The
+requirements on the grating noted previously correspond to their case A.
+As they show, use of incident angles less than the blaze angle, their case
+B, significantly degrades the efficiency due to back reflection which is
+why this case is not included.  The efficiency formulation includes
+variation in the peak efficiency due light diffracted into other orders,
+shadowing of the groves, and a reflectance parameter.  The reflectance
+parameter is basically the blaze peak normalization and does not currently
+include a wavelength dependence.  Thus the peak efficiency is near the
+reflectance value but somewhat lower and is order dependent due to the other
+effects.
+
+
+Grisms
+
+Grisms are assumed to have a prism angle equal to the blaze angle of
+the inscribed grating.  The index of refraction is treated as constant
+over the wavelength range of an order, though different index of refraction
+values can be specified for each order.
+
+The grism formula used is a variation on the grating equation.
+
+.nf
+    g * m * w = n * sin (theta+prism) - sin (beta+prism)
+.fi
+
+where n is the index of refraction, prism is the prism or blaze angle,
+theta is the incident angle relative to the prism face, and beta is the
+refracted angle relative to the prism face.  Theta and beta are defined so
+that at the undeviated wavelength they are zero.  In other words at the
+undeviated wavelength the light path is a straight through transmission.
+
+The efficiency is also computed in an analogous manner to the
+reflection grating except that shadowing is not included (a consequence of
+the blaze face being parallel to the prism face and theta being near
+zero).  Instead of a reflectance value normalizing the blaze function a
+transmission value is used.
+
+
+Scales and Sizes
+
+The scale between arc seconds on the sky and millimeters at the
+aperture(s) of the spectrograph is specified by the \fIscale\fR parameter.
+This parameter is used to convert aperture sizes between arc seconds and
+millimeters.
+
+The aperture sizes are magnified or demagnified by three possible factors.
+The basic magnification is given by the ratio of the collimator focal
+length to the camera focal length.  This magnification applies both along
+and across the dispersion.
+
+The camera focal length also determines the dispersion scale on the detector.
+It converts radians of dispersion to mm at the detector.
+
+For grating dispersers there is a demagnification along the dispersion
+due to the tilt of the grating(s).  The demagnification is computed (as
+given previously) from the grating parameters and the spectrograph
+parameter giving the angle between the incident and diffracted rays at the
+detector center.
+
+The last magnification factor is given by the spectrograph parameters
+"apmagdisp" and apxmagdisp".  These define magnifications of the aperture
+along and across the dispersion apart from the other two magnifications.
+These parameters are often missing which means no additional
+magnifications.
+
+One use for the last magnification parameters is to correct aperture
+sizes given as millimeters or arc seconds on a plane tilted with respect to
+the focal plane.  Such tilted apertures occur with aperture mechanisms
+(usually slits) that reflect light for acquisition and guiding.  Note that
+one only needs to use these terms if users are expected to define the
+apertures sizes on the tilted plane.  If instead the projection factors are
+handled by the spectrograph system and users specify aperture size as
+millimeters or arc seconds on the sky then these terms are not needed.
+
+The above scale factors map arc seconds on the sky and aperture sizes
+in millimeter to arc seconds and millimeters projected on the detector.  To
+convert to pixels on the detector requires the pixel size.
+One option in \fBSPTIME\fR is to specify aperture
+sizes as projected pixels on the detector (either in the user parameters or
+in the aperture description file).  Using the detector pixel size and the
+scale factors allows conversion of aperture sizes specified in this way
+back to the actual aperture size.
+
+
+Resolution
+
+A camera resolution parameter may be set in the camera description.  If
+a resolution value is not given it is taken to be 2 pixels.  This parameter
+is used to define the dispersion resolution element and the number of
+pixels across the dispersion imaged by the detector for the aperture and
+the object.  The latter usage is discussed in the next section.
+
+The dispersion resolution element, in pixels, is given by
+
+.nf
+				 |  2 pixels
+    disp resolution = maximum of |  camera resolution
+				 |  1 + min (seeing, apsize)
+.fi
+
+where seeing is the FWHM seeing diameter in pixels and apsize is the
+aperture size in pixels.  For circular apertures the aperture size is
+the diameter and for rectangular apertures it is the width.  The first term
+comes from sampling considerations, the second from the camera resolution,
+and the third from the finite resolution of a pixel (the factor of 1) and
+the spread of wavelengths across the aperture or seeing disk.  The
+dispersion resolution is printed for information and the S/N per dispersion
+resolution element is given in addition to the per pixel value.
+
+
+Object and Sky Pixels Across the Dispersion
+
+The number of pixels across the dispersion in the object and the sky
+are required to compute the S/N statistics.  The number of pixels
+in the projected aperture image is taken to be
+
+.nf
+		       | diameter + resolution  (circular apertures)
+    aperture pixels =  |
+		       | length + resolution    (rectangular apertures)
+.fi
+
+where resolution is the camera resolution discussed previously.  The value
+is rounded up to an integer.
+
+Objects are assumed to fill circular (fiber) apertures.  Therefore the
+number of object pixels is the same as the number of pixels in the
+aperture.  In rectangular (slit) apertures the number of object pixels is
+taken to be
+
+.nf
+				| 3*seeing + resolution
+    object pixels = minimum of  |
+				| number of aperture pixels
+.fi
+
+where seeing is the FWHM seeing diameter converted to pixels.  The values
+are rounded up to an integer.
+
+The number of sky pixels depends on the type of sky subtraction.
+For "longslit" sky subtraction the number of sky pixels is given
+by the difference of the number of aperture pixels and the number of
+object pixels.  For circular apertures this always comes out to zero so
+it does not make sense to use longslit sky subtraction.  For rectangular
+apertures the number of sky pixels in the aperture depends on the
+aperture size and the seeing.  If the number of sky pixels comes out to
+zero a warning is printed.
+
+For "multiap" sky subtraction the number of sky pixels is the
+number of sky apertures times the number of pixels per aperture.
+
+
+Source Counts
+
+The source spectrum flux at each wavelength, either given in a spectrum
+table or as a model distribution, is in units of
+photons per second per Angstrom per square centimeter.  This is multiplied
+by the telescope effective area, the exposure time, and the pixel size in
+Angstroms to give the source photons per dispersion pixel per exposure.
+This is then multiplied by any of the following terms that apply to arrive
+at the number of source photons detected over all spatial pixels.  The
+spatial integration is implicit in the aperture function.
+
+.nf
+    - the extinction using the specified airmass
+    - the telescope transmission
+    - the ADC transmission
+    - the aperture transmission based on the aperture size relative
+      to the seeing
+    - the fiber transmission
+    - the filter transmission (one or two filters)
+    - the collimator transmission
+    - the disperser efficiency (one or two dispersers)
+    - the corrector transmission
+    - the camera transmission
+    - the detector DQE
+.fi
+
+
+Background Counts
+
+The sky or atmospheric background spectrum, if one is given, defines a
+photon flux per square arc second.  When it is given as a function of the
+moon phase it is interpolated to the specified moon phase.  In addition
+if a thermal temperature and an emissivity are given then a thermal
+background is computed and added to the sky/atmospheric background.
+
+The surface brightness of the background is multiplied by the area of the
+aperture occupied by the object (in arc seconds) and divided by the
+aperture transmission of the source.  This is the quantity reported in the
+output for the sky photon flux.  It is comparable to the source photon
+flux.
+
+Next this flux is multiplied by the telescope effective area, the
+exposure time, and the pixel size in Angstroms.  Finally it is multiplied
+by the same transmission terms as the object except for the extinction.
+Note that this removes the aperture transmission term included earlier
+giving the background photons as the number passing through the aperture per
+object profile.  The final value is the number of background photons from the
+object.  To get the background photons per spatial pixel the value is divided by
+the number of spatial pixels occupied by the source.
+
+If no background subtraction is specified then the background counts are added
+to the source counts to define the final source counts and the background
+counts are set to zero.
+
+
+Signal-to-Noise Ratio
+
+The noise attributed to the source and background is based on Poisson
+statistics; namely the noise is the square root of the number of photons.
+The detector noise is given by a dark count component and a readout noise
+component.  The noise from the dark counts is obtain by multiplying the
+dark count rate by the exposure time and the number of spatial pixels used
+in extracting the source and taking the square root.  The readout noise is
+the detector readout noise parameter multiplied by the square root of the
+number of spatial source pixels.
+
+If background subtraction is selected and the number of available
+background pixels is greater than zero then the uncertainty in the
+background estimation is computed.  The uncertainty in a single pixel is
+the square root of the background photons per pixel, the dark counts per
+pixel, and the readout noise per pixel.  This is divided by the square root
+of the number of background pixels to get the uncertainty in the background
+estimation for subtraction from the source.
+
+The total noise is the combination of the source, background, dark count,
+and readout noise values and the background subtraction uncertainty added
+in quadrature.
+
+The signal-to-noise ratio per pixel per exposure is the source counts
+divided by total noise.  This value is multiplied by the square root of
+number of pixels per resolution element to get the S/N per resolution
+element.  If multiple exposures are used to make up the total exposure time
+then the single exposure S/N is multiplied by the square root of the number
+of exposures.
+
+
+Exposure Time From Signal-to-Noise Ratio
+
+If no exposure time is specified, that is a value of INDEF, then
+the exposure time required to reach a desired signal-to-noise ratio
+per pixel is determined.  The computation is done at the specified central
+wavelength.  The task iterates, starting with the specified maximum time per
+exposure, by computing the S/N and adjusting the exposure time
+(possibly breaking the total exposure up into subexposures) until
+the computed S/N matches the desired S/N to 0.1%.
+
+In addition to breaking the exposure time into individual exposure less
+than the maximum per exposure, the task will break single exposures that
+exceed the specified saturation and maximum data number values at the
+reference wavelength.  If other wavelengths are then saturated or exceed
+the data maximum a warning is printed.
+.endhelp
diff --git a/noao/obsutil/src/doc/starfocus.hlp b/noao/obsutil/src/doc/starfocus.hlp
new file mode 100644
index 00000000..351bf14c
--- /dev/null
+++ b/noao/obsutil/src/doc/starfocus.hlp
@@ -0,0 +1,820 @@
+.help starfocus Nov01 noao.obsutil
+.ih
+NAME
+starfocus -- Measure focus variations using stellar images
+.ih
+USAGE
+starfocus images
+.ih
+PARAMETERS
+.ls images
+List of images.  The images may be either taken at a sequence
+of focus values or be multiple shifted exposures at a sequence of
+focus settings.
+.le
+.ls focus = "1x1"
+If the parameter \fIfstep\fR is not set (a "" null string) then this
+parameter is interpreted as either a list of focus values or an
+image header keyword to one focus value per image.  A list may be an explicit
+list of values, a range specification, or an @ file containing the values.
+If there is only a single exposure per image then the focus list gives one
+value per image while if there are multiple exposures per image the list
+applies to the multiple exposures with the same values reused for other
+images.  If the parameter \fIfstep\fR is given then this parameter is
+interpreted as a single starting focus value and the focus step
+defines the increment between subsequent single exposure images or
+for the various exposures in a multiple exposure image.
+.le
+.ls fstep = ""
+A focus increment value or an image header keyword to the focus increment.
+.le
+
+.ls nexposures = "1"
+The number of exposures per image specified either as a value or as
+an image header keyword.  A double step gap in a multiple
+exposure sequence does not count as an exposure.
+.le
+.ls step = "30."
+The step in pixels between exposures specified either as a value or
+as an image header keyword.
+.le
+.ls direction = "-line" (-line|+line|-column|+column)
+The direction of the exposure sequence in the image.  The values are
+"-line" for successive object images appearing at smaller line numbers,
+"+line" for objects appearing at larger line numbers, "-column" for
+objects appearing at smaller column numbers, and "+column" for objects
+appearing at larger column numbers.
+.le
+.ls gap = "end" (none|beginning|end)
+Location of a double step gap in a sequence with the specified direction.
+The available cases are "none" for an even sequence with no gap,
+"beginning" where a double step is taken between the first and
+the second exposure, and "end" where a double step is taken before
+the last exposure.  Note that "beginning" and "end" are defined in
+terms of the \fIdirection\fR parameter.
+.le
+
+.ls coords = "mark1" (center|mark1|markall)
+Method by which the coordinates of objects to be measured are specified.
+If "center" then a single object at the center of each image is measured.
+If "mark1" then the \fIimagecur\fR parameter, typically the interactive
+image display cursor, defines the coordinates of one or more objects in the
+first image ending with a 'q' key value and then the same coordinates are
+automatically used in subsequent images.  If "markall" then the
+\fIimagecur\fR parameter defines the coordinates for objects in each image
+ending with a 'q' key value.
+.le
+.ls wcs = "logical" (logical|physical|world)
+Coordinate system for input coordinates.  When using image cursor input
+this will always be "logical".  When using cursor input from a file this
+could be "physical" or "world".
+.le
+.ls display = yes, frame = 1
+Display the image or images as needed?  If yes the image display is checked
+to see if the image is already in one of the display frames.  If it is not
+the \fBdisplay\fR task is called to display the image in the frame
+specified by the \fBframe\fR parameter.  All other display parameters are
+taken from the current settings of the task.  This option requires that the
+image display be active.  A value of no is typically used when an input
+cursor file is used instead of the image display cursor.  An image display
+need not be active in that case.
+.le
+
+.ls level = 0.5
+The parameter used to quantify an object image size is the radius from the
+image center enclosing the fraction of the total flux given by this
+parameter.  If the value is greater than 1 it is treated as a percentage.
+.le
+.ls size = "FWHM" (Radius|FWHM|GFWHM|MFWHM)
+There are four ways the PSF size may be shown in graphs and given in
+the output.  These are:
+
+.nf
+    Radius - the radius enclosing the specified fraction of the flux
+    FWHM   - a direct FWHM from the measured radial profile
+    GFWHM  - the FWHM of the best fit Gaussian profile
+    MFWHM  - the FWHM of the best fit Moffat profile
+.fi
+
+The labels in the graphs and output will be the value of this parameter
+to distinguish the different types of size measurements.
+.le
+.ls beta = INDEF
+For the Moffat profile fit (size = MFWHM) the exponent parameter may
+be fixed at a specified value or left free to be determined from the
+fit.  The exponent parameter is determined by the fit if \fIbeta\fR
+task parameter is INDEF.
+.le
+.ls scale = 1.
+Pixel scale in user units per pixel.  Usually the value is 1 to measure
+sizes in pixels or the image pixel scale in arc seconds per pixel.
+.le
+.ls radius = 5., iterations = 2
+Measurement radius in pixels and number of iterations on the radius.  The
+enclosed flux profile is measured out to this radius.  This radius may be
+adjusted if the \fIiteration\fR parameter is greater than 1.  In that case
+after each iteration a new radius is computed from the previous FWHM
+estimate to be the radius the equivalent gaussian enclosing 99.5% of the
+light.  The purpose of this is so that if the initial PSF size of the image
+need not be known.  However, the radius should then be larger than true
+image size since the iterations best converge to smaller values.
+.le
+.ls sbuffer = 5, swidth = 5.
+Sky buffer and sky width in pixels.  The buffer is added to the specified
+measurement \fIradius\fR to define the inner radius for a circular sky
+aperture.  The sky width is the width of the circular sky aperture.
+.le
+.ls saturation=INDEF, ignore_sat=no
+Data values (prior to sky subtraction) to be considered saturated within
+measurement radius.  A value of INDEF treats all pixels as unsaturated.  If
+a measurement has saturated pixels there are two actions.  If
+\fIignore_sat\fR=no then a warning is given but the measurement is saved
+for use.  The object will also be indicated as saturated in the output
+log.  If \fIignore_sat\fR=yes then a warning is given and the object is
+discarded as if it was not measured.  In a focus sequence only the
+saturated objects are discarded and not the whole sequence.
+.le
+.ls xcenter = INDEF, ycenter = INDEF
+The optical field center of the image given in image pixel coordinates.
+These values need not lie in the image.  If INDEF the center of the image
+is used.  These values are used to make plots of size verse distance from
+the field center for studies of radial variations.
+.le
+.ls logfile = "logfile"
+File in which to record the final results.  If no log file is desired a
+null string may be specified.
+.le
+
+.ls imagecur = ""
+Image cursor input for the "mark1" and "markall" options.  If null then the
+image dispaly cursor is used interactively.  If a file name is specified
+then the coordinates come from this file.  The format of the file are lines
+of x, y, id, and key.  Values of x an y alone may be used to select objects
+and the single character 'q' (or the end of the file) may be used to end
+the list.
+.le
+.ls graphcur = ""
+Graphics cursor input.  If null then the standard graphics cursor
+is used otherwise a standard cursor format file may be specified.
+.le
+.ih
+CURSOR COMMANDS
+When selecting objects with the image cursor the following commands are
+available.
+
+.nf
+?  Page cursor command summary
+g  Measure object and graph the results.
+m  Measure object.
+q  Quit object marking and go to next image.
+   At the end of all images go to analysis of all measurements.
+
+:show  Show current results.
+.fi
+
+When in the interactive graphics the following cursor commands are available.
+All plots may not be available depending on the number of focus values and
+the number of stars.
+
+.nf
+?  Page cursor command summary
+a  Spatial plot at a single focus
+b  Spatial plot of best focus values
+d  Delete star nearest to cursor
+e  Enclosed flux for stars at one focus and one star at all focus
+f  Size and ellipticity vs focus for all data
+i  Information about point nearest the cursor
+m  Size and ellipticity vs relative magnitude at one focus
+n  Normalize enclosed flux at x cursor position
+o  Offset enclosed flux to by adjusting background
+p  Radial profiles for stars at one focus and one star at all focus
+q  Quit
+r  Redraw
+s  Toggle magnitude symbols in spatial plots
+t  Size and ellipticity vs radius from field center at one focus
+u  Undelete all deleted points
+x  Delete nearest point, star, or focus (selected by query)
+z  Zoom to a single measurement
+<space> Step through different focus or stars in current plot type
+
+
+:beta <val>     Beta parameter for Moffat fit
+:level <val>	Level at which the size parameter is evaluated
+:overplot <y|n> Overplot the profiles from the narrowest profile?
+:radius <val>   Change profile radius
+:show <file>	Page all information for the current set of objects
+:size <type>	Size type (Radius|FWHM)
+:scale <val>	Pixel scale for size values
+:xcenter <val>	X field center for radius from field center plots
+:ycenter <val>	Y field center for radius from field center plots
+
+The profile radius may not exceed the initial value set by the task
+parameter.
+.fi
+.ih
+DESCRIPTION
+This task measures the point-spread function (PSF) width of stars or other
+unresolved objects in digital images.  The width is measured based on the
+circular radius which encloses a specified fraction of the background
+subtracted flux.  The details of this are described in the ALGORITHMS
+section.  When a sequence of images or multiple exposures in a single image
+are made with the focus varied the program provides an estimate of the best
+focus and various views of how the PSF width varies with focus and position
+in the image.  A single star may be measured at each focus or measurements
+of multiple stars may be made and combined.  The task has three stages;
+selecting objects and measuring the PSF width and other parameters, an
+interactive graphical analysis, and a final output of the results to the
+terminal and to a logfile.
+
+If a saturation value is specified then all pixels within the specified
+measurement radius are checked for saturation.  If any saturated pixels are
+found a warning is given and \fIignore_sat\fR parameter may be used ot
+ignore the measurement.  If not ignored the object will still be indicated
+as saturated in the output log.  In a focus sequence only the saturated
+objects are discarded and not the whole sequence.
+
+The input images are specified by an image template list.  The list may
+consist of explicit image names, wildcard templates, and @ files.  A
+"focus" value or values is associated with each image; though this may be
+any numeric quantity (integer or floating point) and not just a focus.  The
+focus values may be specified in several ways.  If each image has a focus
+value recorded in the image header, the keyword name may be specified.  If
+the images consists of multiple exposures the \fIfstep\fR parameter would
+specify a second image header keyword (or constant value) giving the
+focus increment per exposure.  
+
+The focus values may also be specified as a range list
+as described in the help topic \fBranges\fR.  This consists of
+individual values, ranges of values, a starting value and a step, and a
+range with a step.  The elements of the list are separated by commas,
+ranges are separated by hyphens, and a step is indicated by the character
+'x'.  Long range lists, such as a list of individual focus values, may be
+placed in a file and specified with the @<filename> convention.  The
+assignment of a focus value from a list depends on whether the images
+are single or multiple exposure as specified by the \fInexposure\fR
+parameter.  Single exposure images are assigned focus values from the
+list in the order in which the images and focus values are given.  If
+the images are multiple exposure focus frames in which each offset exposure
+has a different focus, the focus values from the list are assigned in
+order to the multiple exposures and if there are multiple images the
+assignments are repeated.
+
+For a simple sequence of a starting focus value and focus increment,
+either for multiple single exposure images or multiple exposure
+images the \fIfocus\fR and \fIfstep\fR parameters by be used
+togther as single values or image header keywords.  Note that if
+\fIfstep\fR is specified then the focus parameter is NOT interpreted
+as a list.
+
+There are two common ways of doing focus sequences.  One is to take an
+exposure at each focus value.  In this case the parameter \fInexposure\fR
+is given the value 1.  The second is to take an image with multiple
+exposures where the objects in the image are shifted between exposures and
+the focus is changed.  In this case \fInexposure\fR is greater than 1 and
+other parameters are used to specify the shift size and direction.  The
+\fInexposure\fR parameter may be a number of an image header keyword.
+
+Currently the task allows only multiple exposure shifts along either the
+column or line dimension and the shifts must be the same between each
+exposure except that there may be a double shift at either end of the
+sequence.  The shift magnitude, in pixels, is specified as either a number
+or image header keyword.  The shift direction is given by the
+\fIdirection\fR parameter.  It is specified relative to the image; i.e. it
+need not be the same as the physical shifts of the telescope or detector
+but depends on how the image was created.  Steps in which the object
+positions decrease in column or line are specified with a leading minus and
+those which increase with a leading plus.  The step is specified as a
+positive number of pixels between exposures.  Often a double shift is made
+at the beginning or end of the sequence.  If this is done the \fIgap\fR
+parameter is used to identify which end the gap is on.  Note that one may
+change the sense of the exposure sequence from that used to make the focus
+frame by properly adjust the direction, the gap, the focus list, and which
+object is marked as the start of the sequence.
+
+Identifying the object or objects to be measured may be accomplished in
+several ways.  If a single object near the center of the image is to be
+measured then the \fIcoords\fR parameter takes the value "center".  This
+may be used with multiple exposure focus frames if the first exposure of
+the object sequence is at the center.  When the "center" option is used
+the \fIdisplay\fR and \fIimagecur\fR parameters are ignored.
+
+If there are multiple objects or the desired object is not at the center of
+the frame the object coordinates are entered with the \fIimagecur\fR
+parameter.  This type of coordinate input is selected by specifying either
+"mark1" or "markall" for the \fIcoords\fR parameter.  If the value is
+"mark1" then the coordinates are entered for the first image and the same
+values are automatically used for subsequent images.  If "markall" is
+specified then the objects in each image are marked.
+
+Normally the \fIimagecur\fR parameter would select the interactive image
+display cursor though a standard cursor file could be used to make this
+part noninteractive.  When the image display cursor is used either the
+image must be displayed previously by the user, or the task may be allowed
+to load the image display using the \fBdisplay\fR task by setting the
+parameter \fIdisplay\fR to yes and \fIframe\fR to a display frame.  If yes
+the image display must be active.  The task will look at the image names as
+stored in the image display and only load the display if needed.
+
+If one wants to enter a coordinate list rather than use the interactive
+image cursor the list can consist of just the column and line coordinates
+since the key will default to 'm'.  To finish the list either the end
+of file may be encountered or a single 'q' may be given since the
+coordinates are irrelevant.  For the "markall" option with multiple
+images there would need to be a 'q' at the end of each object except
+possibly the last.
+
+When objects are marked interactively with the image cursor there
+are a four keys which may be used as shown in the CURSOR COMMAND section.
+The important distinction is between 'm' to mark and measure an
+object and 'g' to mark, measure, and graph the results.  The former
+accumulates the results until the end while the latter can give an
+immediate result to be examined.  Unless only one object is marked
+the 'g' key also accumulates the results for later graphical analysis.
+It is important to note that the measurements are done as each
+object is marked so there can be a significant delay before the
+next object may be marked.
+
+The quantities measured and the algorithms used are described in the
+ALGORITHMS section.  Once all the objects have been measured an
+interactive (unless only one object is measured) graphical presentation
+of the measurements is entered.
+
+When the task exits it prints the results to the terminal (STDOUT)
+and also to the \fIlogfile\fR if one is specified.  The results may
+also be previewed during the execution of the task with the
+":show" command.  The results begin with a banner and the overall
+estimate of the best focus and PSF size.  If there are multiple
+stars measured at multiple focus values the best focus estimate
+for each star is printed.  The star is identified by it's position
+(the starting position for multiple exposure images).  The average
+size, relative magnitude, and best focus estimate are then given.
+If there are multiple focus values the average of the
+PSF size over all objects at each focus are listed next.
+Finally, the individual measurements are given.  The columns
+give the image name, the column and line position, the relative
+magnitude, the focus value, the PSF size as either the enclosed
+flux radius or the FWHM, the ellipticity, the position angle, and
+an indication of saturation.
+.ih
+ALGORITHMS
+The PSF of an object is characterized using a radially symmetric
+enclosed flux profile.  First the center of the object is determined from
+an initial rough coordinate.  The center is computed from marginal profiles
+which are sums of lines or columns centered at the initial coordinate and
+with a width given by the sum of the \fIradius\fR, \fIsbuffer\fR, and
+\fIswidth\fR parameters.  The mean of the marginal profile is determined
+and then the centroid of the profile above this is computed.  The centroids
+from the two marginal profiles define a new object center.  These steps of
+forming the marginal profiles centered at the estimated object position and
+then computing the centroids are repeated until the centroids converge or
+three iterations have been completed.
+
+Next a background is determined from the mode of the pixel values in the
+sky annulus defined by the object center and \fIradius\fR, \fIsbuffer\fR,
+and \fIswidth\fR parameters.  The pixel values in the annulus are sorted
+and the mode is estimated as the point of minimum slope in this sorted
+array using a width of 5% of the number of points.  If there are multiple
+regions with the same minimum slope the lowest pixel value is used.
+
+The background subtracted enclosed flux profile is determined next.
+To obtain subpixel precision and to give accurate estimates for small
+widths relative to the pixel sampling, several things are done.
+First interpolation between pixels is done using a cubic spline surface.
+The radii measured are in subpixel steps.  To accommodate small and
+large PSF widths (and \fIradius\fR parameters) the steps are nonuniform
+with very fine steps at small radii (steps of 0.05 pixels in the
+central pixel) and coarser steps at larger radii (beyond 9 pixels
+the steps are one pixel) out to the specified \fIradius\fR.  Similarly each
+pixel is subsampled finely near the center and more coarsely at larger
+distances from the object center.  Each subpixel value, as obtained by
+interpolation, is background subtracted and added into the enclosed flux
+profile.  Even with subpixel sampling there is still a point where a
+subpixel straddles a particular radius.  At those points the fraction of
+the subpixel dimension in radius falling within the radius being measured
+is used as the fraction of the pixel value accumulated.
+
+Because of errors in the background determination due to noise and
+contaminating objects it is sometimes the case that the enclosed flux
+is not completely monotonic with radius.  The enclosed flux
+normalization, and the magnitude used in plots and reported in
+results, is the maximum of the enclosed flux profile even if it
+occurs at a radius less than the maximum radius.  It is possible
+to change the normalization and subtract or add a background correction
+interactively.
+
+Because a very narrow PSF will produce significant errors in the cubic
+spline interpolation due to the steepness and rapid variation in the pixel
+values near the peak, the Gaussian profile with FWHM that encloses the same
+80% of the flux is computed as:
+
+    FWHM(80%) = 2 * r(80%) * sqrt (ln(2) / (ln (1/.2)))
+
+If this is less than five pixels the Gaussian model is subtracted from the
+data.  The Gaussian normalization is chosed to perfectly subtract the
+central pixel.  The resulting subtraction will not be perfect but the
+residual data will have much lower amplitudes and variations.  A spline
+interpolation is fit to this residual data and the enclosed flux profile is
+recomputed in exactly the same manner as previously except the subpixel
+intensity is evaluated as the sum of the analytic Gaussian and the
+interpolation to the residual data.
+
+The Gaussian normalization is chosed to perfectly subtract the central
+pixel.  The resulting subtraction will not be perfect but the residual data
+will have much lower amplitudes and variations.  A spline interpolation is
+fit to this residual data and the enclosed flux profile is recomputed in
+exactly the same manner as previously except the subpixel intensity is
+evaluated as the sum of the analytic Gaussian and the interpolation to the
+residual data.  This technique yields accurate FWHM for simulated Gaussian
+PSFs down to at least a FWHM of 1 pixel.
+
+In addition to the enclosed flux profile, an estimate of the radially
+symmetric intensity profile is computed from the enclosed flux profile.
+This is based on the equation
+
+.nf
+    F(R) = integral from 0 to R { P(r) r dr }
+.fi
+
+where F(R) is the enclosed flux at radius R and P(r) is the intensity per
+unit area profile.  Thus the derivative of F(R) divided by R gives an
+estimate of P(R).
+
+Cubic spline interpolation functions are fit to the normalized enclosed
+flux profile and the intensity profile.  These are used to find the radius
+enclosing any specified fraction of the flux and to find the direct FWHM of
+the intensity profile.  These are output when \fIsize\fR is "Radius" or
+"FWHM" respectively.
+
+In addition to enclosed flux radius and direct FWHM size measurements
+there are also two size measurements based on fitting analytic profiles.
+A Gaussian profile and a Moffat profile are fit to the final enclosed flux
+profile to the points with enclosed flux less than 80%.  The limit is
+included to minimize the effects of poor background values and to make the
+profile fit be representative of the core of the PSF profile.  These profiles
+are fit whether or not the selected \fIsize\fR requires it.  This is done
+for simplicity and to allow quickly changing the size estimate with the
+":size" command.
+
+The intensity profile functions (with unit peak) are:
+
+.nf
+    I(r) = exp (-0.5 * (r/sigma)**2)			Gaussian
+    I(r) = (1 + (r/alpha)**2)) ** (-beta)		Moffat
+.fi
+
+with parameters sigma, alpha, and beta.  The normalized enclosed flux
+profiles, which is what is actually fit, are then:
+
+.nf
+    F(r) = 1 - exp (-0.5 * (r/sigma)**2)		Gaussian
+    F(r) = 1 - (1 + (r/alpha)**2)) ** (1-beta)		Moffat
+.fi
+
+The fits determine the parameters sigma or alpha and beta (if a
+beta value is not specified by the users).  The reported FWHM values
+are given by:
+
+.nf
+    GFWHM = 2 * sigma * sqrt (2 * ln (2))		Gaussian
+    MFWHM = 2 * alpha * sqrt (2 ** (1/beta) - 1)	Moffat
+.fi
+
+were the units are adjusted by the pixel scale factor.
+
+In addition to the four size measurements there are several additional
+quantities which are determined.  
+Other quantities which are computed are the relative magnitude,
+ellipticity, and position angle.  The magnitude of an individual
+measurement is obtained from the maximum flux attained in the enclosed
+flux profile computation.  Though the normalization and background may be
+adjusted interactively later, the magnitude is not changed from the
+initial determination.  The relative magnitude of an object is then
+computed as
+
+.nf
+    rel. mag. = -2.5 * log (object flux / maximum star flux)
+.fi
+
+The maximum star magnitude over all stars is used as the zero point for the
+relative magnitudes (hence it is possible for an individual object relative
+magnitude to be less than zero).
+
+The ellipticity and positional angle of an object are derived from the
+second central intensity weighted moments.  The moments are:
+
+.nf
+	Mxx = sum { (I - B) * x * x } / sum { I - B }
+	Myy = sum { (I - B) * y * y } / sum { I - B }
+	Mxy = sum { (I - B) * x * y } / sum { I - B }
+.fi
+
+where x and y are the distances from the object center, I is
+the pixel intensity and B is the background intensity.  The sum is
+over the same subpixels used in the enclosed flux evaluation with
+intensities above an isophote which is slightly above the background.
+The ellipticity and position angles are derived from the moments
+by the equations:
+
+.nf
+	M1 = (Mxx - Myy) / (Mxx + Myy)
+	M2 = 2 * Mxy / (Mxx + Myy)
+	ellip = (M1**2 + M2**2) ** 1/2
+	pa = atan (M2 / M1) / 2
+.fi
+
+where ** is the exponentiation operator and atan is the arc tangent
+operator.  The ellipticity is essentially (a - b) / (a + b) where a
+is a major axis scale length and b is a minor axis scale length.  A
+value of zero corresponds to a circular image.  The position angle is
+given in degrees counterclockwise from the x or column axis.
+
+The overall size when there are multiple stars is estimated by averaging
+the individual sizes weighted by the flux of the star as described above.
+Thus, when there are multiple stars, the brighter stars are given greater
+weight in the average size.  This average size is what is given in the
+banner for the graphs and in the printed output.
+
+One of the quantities computed for the graphical analysis is the
+FWHM of a Gaussian or Moffat profile that encloses the same flux
+as the measured object as a function of the level.  The equation are:
+
+.nf
+   FWHM = 2 * r(level) * sqrt (ln(2.) / ln (1/(1-level)))  Gaussian
+
+   FWHM = 2 * r(level) * sqrt (2**(1/beta)-1) /
+	  sqrt ((1-level)**(1/(1-beta))-1)		   Moffat
+.fi
+
+where r(level) is the radius that encloses "level" fraction of the total
+flux.  ln is the natural logarithm and sqrt is the square root.  The beta
+value is either the user specified value or the value determined by fitting
+the enclosed flux profile.
+
+This function of level will be a constant if the object profile matches
+the Gaussian or Moffat profile.  Deviations from a constant show
+the departures from the profile model.  The Moffat profile used in making
+the graphs except for the case where the \fIsize\fR is GFWHM.
+
+The task estimates a value for the best focus and PSF size at that focus
+for each star.  This is done by finding the minimum size at each focus
+value (in case there are multiple measurements of the same star at the same
+focus), sorting them by focus value, finding the focus value with the
+minimum size, and parabolically interpolating using the nearest focus
+values on each side.  When the minimum size occurs at either extreme of the
+focus range the best focus is at that extreme focus; in other words there
+is no extrapolation outside the range of focus values.
+
+The overall best focus and size when there are multiple stars are estimated
+by averaging the best focus values for each star weighted by the
+average flux of the star as described above.  Thus, when there are
+multiple stars, the brighter stars are given greater weight in the
+overall best average focus and size.  This best average focus and
+size are what are given in the banner for the graphs and in the
+printed output.
+
+The log output also includes an average PSF size for all measurements
+at a single focus value.  This average is also weighted by the
+average flux of each star at that focus.
+.ih
+INTERACTIVE GRAPHICS MODE
+The graphics part of \fBstarfocus\fR consists of a number of different
+plots selected by cursor keys.  The available plots depend on the
+number of stars and the number of focus values.  The various plots
+and the keys which select them are summarized below.
+
+.nf
+a  Spatial plot at a single focus
+b  Spatial plot of best focus values
+e  Enclosed flux for stars at one focus and one star at all focus
+f  Size and ellipticity vs focus for all data
+m  Size and ellipticity vs relative magnitude at one focus
+p  Radial profiles for stars at one focus and one star at all focus
+t  Size and ellipticity vs radius from field center at one focus
+z  Zoom to a single measurement
+.fi
+
+If there is only one object at a single focus the only available plot is
+the 'z' or zoom plot.  This has three graphs; a graph of the normalized
+enclosed flux verses scaled radius, a graph of the intensity profile verses
+scaled radius, and equivalent Moffat/Gaussian full width at half maximum verses
+enclosed flux fraction.  The latter two graphs are derived from the
+normalized enclosed flux profile as described in the ALGORITHMS section.
+In the graphs the measured points are shown with symbols, a smooth curve is
+drawn through the symbols and dashed lines indicate the measurement level
+and enclosed flux radius at that level.
+
+Overplotted on these graphs are the Moffat profile fit or the
+Gaussian profile fit when \fIsize\fR is GFWHM.
+
+The zoom plot is always available from any other plot.  The cursor position
+when the 'z' key is typed selects a particular object measurement.
+This plot is also the one presented with the 'g' key when marking objects for
+single exposure images.  In that case the graphs are drawn followed by
+a return to image cursor mode.
+
+There are three types of symbol plots showing the measured PSF size (either
+enclosed flux radius or FWHM) and ellipticity.  These plot the measurements
+verses focus ('f' key), relative magnitude ('m' key), and radius from the
+field center ('t' key).  The focus plot includes all measurements and shows
+dashed lines at the estimated best focus and size.  This plot is only
+available when there are multiple focus values.  It is the initial plot in
+this case for both the 'g' key when there are multiple exposures and when
+the graphical analysis stage is entered after defining the objects.
+
+The magnitude and field radius plots are only available when there are
+multiple objects measured.  The relative magnitude used for a particular
+measurement is the average magnitude of the star over all focus values and
+not the individual object magnitude.  The data shown is for a single focus
+value.  The focus value is selected when typing 'm' or 't' by the focus of
+the nearest object to the cursor in the preceding plot.  When in one of
+these plots, other focus values may be shown by typing <space>, the space
+bar.  This scrolls through the focus values.  The field center for the
+field radius graph may be changed interactively using the ":xcenter" and
+":ycenter" commands.
+
+Grids of enclosed flux vs. radius, intensity profile vs. radius, and
+FWHM vs. enclosed flux fraction are shown with the 'e', 'p', and
+'g' keys respectively.  If there are multiple objects at multiple focus
+values there are two grids. One grid is all objects at one focus and the
+other is one object at all focuses.  The titles identify the object (by
+location) and focus.  The profiles in the grids have no axis labels or
+ticks.  Within each box are the coordinates of the object or the focus
+value, and the PSF size are given.  When there is only one object at
+multiple focus values or multiple objects at only one focus value then
+there is only one grid and a graph of a one object.  The single object
+graph does have axis labels and  ticks.
+
+In the grids there is one profile which is highlighted (by a second
+box or by a color border).  The highlighted profile is the current
+object.  To change the current object, and thus change either
+the contents of the other grid or the single object graphed, one
+can type the space bar to advance to the next object or
+use the cursor and the 'e', 'p', or 'g' key again.  Other keys
+will select another plot using the object nearest the cursor to select
+a focus or object.
+
+Any of the graphs with enclosed flux or intensity profiles vs radius may
+have the profiles of the object with the smallest size overplotted.  The
+overplot has a dashed line, a different color on color graphics devices,
+and no symbols marking the measurement points.  The overplots may be
+enabled or disabled with the ":overplot" command.  Initially it is
+disabled.
+
+The final plots give a spatial representation.  These require more than one
+object.  The 'a' key gives a spatial plot at a single focus.  The space bar
+can be used to advance to another focus.  This plot has a central graph of
+column and line coordinates with symbols indicating the position of an
+object.  The objects are marked with a circle (when plotted at unit aspect
+ratio) whose size is proportional to the measured PSF size.  In addition an
+optional asterisk symbol with size proportional to the relative
+brightness of the object may be plotted.  This symbol is toggled with the
+'s' key.  On color displays the circles may have two colors, one if object
+size is above the average best size and the other if the size is below the
+best size.  The purpose of this is to look for a spatial pattern in the
+smallest PSF sizes.
+
+Adjacent to the central graph are graphs with column or line as one
+coordinate and radius or ellipticity as the other.  The symbols
+are the same as described previously.  These plots can show spatial
+gradients in the PSF size and shape across the image.
+
+The 'b' key gives a spatial plot of the best focus estimates for each
+object.  This requires multiple objects and multiple focus values.
+As discussed previously, given more than one focus a best focus
+value and size at the best focus is computed by parabolic interpolation.
+This plot type shows the object positions in the same way as the 'a'
+plot except that the radius is the estimated best radius.  Instead
+of adjacent ellipticity plots there are plots of best focus verses
+columns and lines.  Also the two colors in the symbol plots are
+selected depending on whether the object's best focus estimate is
+above or below the overall best focus estimate.  This allows seeing
+spatial trends in the best focus.
+
+In addition to the keys which select plots there are other keys which
+do various things.  These are summarized below.
+
+.nf
+?  Page cursor command summary
+d  Delete star nearest to cursor
+i  Information about point nearest the cursor
+n  Normalize enclosed flux at x cursor position
+o  Offset enclosed flux by adjusting background
+q  Quit
+r  Redraw
+s  Toggle magnitude symbols in spatial plots
+u  Undelete all deleted points
+x  Delete nearest point, star, or focus (selected by query)
+<space> Step through different focus or stars in current plot type
+.fi
+
+The help, redraw, and quit keys are provide the standard functions.
+The 's' and space keys were described previously.  The 'i' key
+locates the nearest object to the cursor in whatever plot is shown and
+prints one line of information about the object on the graphics device
+status area.
+
+The 'd' key deletes the star nearest the cursor in whatever plot is
+currently displayed.  Deleting a star deletes all measurements of an object
+at different focus values.  To delete all objects from an image, all focus
+values for one star (the same as 'd'), all objects at one focus, or a
+single measurement, the 'x' key is used.  Typing this key produces a query
+for which type of deletion and the user responds with 'i', 's', 'f', or
+'p'.  The most common use of this is to delete all objects at the extreme
+focus values.  Deleted measurements do not appear in any subsequent
+graphics, are excluded from all computations, and are not output in the
+results.  The 'u' key allows one to recover deleted measurements.  This
+undeletes all previously deleted data.
+
+Due to various sources of error the sky value may be wrong causing
+the enclosed flux profile to not converge properly but instead
+decreases beyond some point (overestimated sky) or linearly
+increases with radius (underestimated sky).  This affects the size
+measurement by raising or lowering the normalization and altering
+the shape of the enclosed flux profile.  The 'n' and 'o' keys allow
+fudging the enclosed flux profiles.  These keys apply only in
+the zoom plot of the enclosed flux profile or the case where
+a single enclosed flux profile is shown with the 'e' key; in other
+words plots of the enclosed flux which have axes labels.
+
+The 'n' key normalizes the enclosed flux profile at the point
+set by the x position of the cursor.  The 'o' key increases or
+decreases the background estimate to bring curve up or down to
+the point specified by the cursor.  The effect of this is to
+add or subtract a quadratic function since the number of pixels
+at a particular radius varies as the square of the radius.
+To restore the original profile, type 'n' or 'o' at a radius
+less than zero.
+
+The colon commands, shown below, allow checking or changing parameters
+initially set by the task parameters, toggling the overplotting of the
+smallest PSF profiles, and showing the current results.  The overplotting
+option and the contents of the results displayed by :show were described
+previously.
+
+.nf
+:beta <val>     Beta parameter for Moffat fits
+:level <val>	Level at which the size parameter is evaluated
+:overplot <y|n> Overplot the profiles from the narrowest profile?
+:radius <val>   Change profile radius
+:show <file>	Page all information for the current set of objects
+:size <type>	Size type (Radius|FWHM)
+:scale <val>	Pixel scale for size values
+:xcenter <val>	X field center for radius from field center plots
+:ycenter <val>	Y field center for radius from field center plots
+.fi
+
+The important values which one might want to change interactively are
+the measurement level and the profile radius.  The measurement level
+directly affects the results reported.  When it is changed the sizes
+of all object PSFs are recomputed and the displayed plots and title
+information are updated.  The profile radius is the
+maximum radius shown in plots and used to set the enclosed flux normalization.
+It does not affect the object centering or sky region definition and
+evaluation which are done when the image data is accessed.  Because
+the objects are not remeasured from the image data the radius may
+not be made larger than the radius defined by the task parameter though
+it may be decreased and then increased again.
+.ih
+EXAMPLES
+1.  A multiple exposure frame is taken with 7 exposures of a bright
+star, each exposure shifted by 50 pixels to lower line positions, with a
+double gap at the end.  The exposure pattern is typical of Kitt Peak and
+the default values for the direction and gap position are applicable.  The
+default focus value numbering and measurements in pixels are also used.
+
+.nf
+cl> starfocus focus1 nexp=7 step=50
+<The image is displayed and the image cursor activated>
+<The bright star is marked with 'm'>
+<Marking is finished with 'q'>
+<A graph of FWHM vs focus index is shown>
+<Exit with 'q'>
+NOAO/IRAF IRAFV2.10.3 valdes@puppis Wed 16:09:39 30-Jun-93
+  Best focus of 4.12073 with FWHM (at 50% level) of 3.04
+
+   Image  Column    Line     Mag   Focus    FWHM   Ellip      PA SAT
+  focus1  536.63  804.03    0.07      1.  13.878    0.06     -11
+	  535.94  753.28   -0.11      2.   8.579    0.09      89
+	  535.38  703.96   -0.08      3.   5.184    0.11     -87
+	  537.12  655.36   -0.02      4.   3.066    0.07     -77
+	  534.20  604.59    0.00      5.   4.360    0.10      74
+	  534.41  554.99   -0.00      6.   9.799    0.09     -35
+	  534.83  456.08    0.16      7.  12.579    0.13     -10
+.fi
+
+The estimated best focus is between the 4th and 5th focus setting
+and the best focus FWHM is 3.04 pixels.
+
+Note that in more recent Kitt Peak multiple exposure focus images the
+starting focus value, the focus step, the number of exposures, and
+the shift are recorded in the image header with the keywords
+FOCSTART, FOCSTEP, FOCNEXPO, and FOCSHIFT.  Thus the task parameters
+\fIfocus\fR, \fIfstep\fR, \fInexposures\fR, and \fIstep\fR may be
+set to those names.  However, rather than use \fBstarfocus\fR
+one would use the more convenient \fBkpnofocus\fR.
+.ih
+SEE ALSO
+.nf
+imexamine, implot, kpnofocus, pprofile, pradprof, psfmeasure, radlist,
+radplt, radprof, ranges, specfocus, splot
+.endhelp
diff --git a/noao/obsutil/src/findgain.cl b/noao/obsutil/src/findgain.cl
new file mode 100644
index 00000000..0236627d
--- /dev/null
+++ b/noao/obsutil/src/findgain.cl
@@ -0,0 +1,119 @@
+# FINDGAIN - calculate the gain and readnoise given two flats and two
+# bias frames.  Algorithm (method of Janesick) courtesy Phil Massey.
+#
+#	flatdif = flat1 - flat2
+#	biasdif = bias1 - bias2
+#
+#	e_per_adu = ((mean(flat1)+mean(flat2)) - (mean(bias1)+mean(bias2))) /
+#		    ((rms(flatdif))**2 - (rms(biasdif))**2)
+#
+#	readnoise = e_per_adu * rms(biasdif) / sqrt(2)
+#
+# In our implementation, `mean' may actually be any of `mean',
+# `midpt', or `mode' as in the IMSTATISTICS task.
+
+procedure findgain (flat1, flat2, zero1, zero2)
+
+string	flat1			{prompt="First flat frame"}
+string	flat2			{prompt="Second flat frame"}
+string	zero1			{prompt="First zero frame"}
+string	zero2			{prompt="Second zero frame"}
+
+string	section = ""		{prompt="Selected image section"}
+string	center = "mean"		{prompt="Central statistical measure",
+				    enum="mean|midpt|mode"}
+int	nclip = 3		{prompt="Number of clipping iterations"}
+real	lsigma = 4		{prompt="Lower clipping sigma factor"}
+real	usigma = 4		{prompt="Upper clipping sigma factor"}
+real	binwidth = 0.1		{prompt="Bin width of histogram in sigma"}
+bool	verbose = yes		{prompt="Verbose output?"}
+
+string	*fd
+
+begin
+	bool	err
+	file	f1, f2, z1, z2, lf1, lf2, lz1, lz2
+	file	flatdiff, zerodiff, statsfile
+	real	e_per_adu, readnoise, m_f1, m_f2, m_b1, m_b2, s_fd, s_bd, junk
+	struct	images
+
+	# Temporary files.
+	flatdif = mktemp ("tmp$iraf")
+	zerodif = mktemp ("tmp$iraf")
+	statsfile = mktemp ("tmp$iraf")
+
+	# Query parameters.
+	f1	= flat1
+	f2	= flat2
+	z1	= zero1
+	z2	= zero2
+
+	lf1 = f1 // section
+	lf2 = f2 // section
+	lz1 = z1 // section
+	lz2 = z2 // section
+
+	imarith (lf1, "-", lf2, flatdif)
+	imarith (lz1, "-", lz2, zerodif)
+
+	printf ("%s,%s,%s,%s,%s,%s\n",
+	    lf1, lf2, lz1, lz2, flatdif, zerodif) | scan (images)
+	imstat (images, fields=center//",stddev", lower=INDEF, upper=INDEF,
+	    nclip=nclip, lsigma=lsigma, usigma=usigma, binwidth=binwidth,
+	    format-, > statsfile)
+	imdelete (flatdif, verify-)
+	imdelete (zerodif, verify-)
+
+	fd = statsfile
+	err = NO
+	if (fscan (fd, m_f1, junk) != 2) {
+	    printf ("WARNING: Failed to compute statisics for %s\n", lf1)
+	    err = YES
+	}
+	if (fscan (fd, m_f2, junk) != 2) {
+	    printf ("WARNING: Failed to compute statisics for %s\n", lf2)
+	    err = YES
+	}
+	if (fscan (fd, m_b1, junk) != 2) {
+	    printf ("WARNING: Failed to compute statisics for %s\n", lz1)
+	    err = YES
+	}
+	if (fscan (fd, m_b2, junk) != 2) {
+	    printf ("WARNING: Failed to compute statisics for %s\n", lz1)
+	    err = YES
+	}
+	if (fscan (fd, junk, s_fd) != 2) {
+	    printf ("WARNING: Failed to compute statisics for %s - %s\n",
+		lf1, lf2)
+	    err = YES
+	}
+	if (fscan (fd, junk, s_bd) != 2) {
+	    printf ("WARNING: Failed to compute statisics for %s - %s\n",
+		lz1, lz2)
+	    err = YES
+	}
+	fd = ""; delete (statsfile, verify-)
+
+	if (err == YES)
+	    error (1, "Can't compute gain and readout noise")
+
+	e_per_adu = ((m_f1 + m_f2) - (m_b1 + m_b2)) / (s_fd**2 - s_bd**2)
+	readnoise = e_per_adu * s_bd / sqrt(2)
+
+	# round to three decimal places
+	e_per_adu = real (nint (e_per_adu * 1000.)) / 1000.
+	readnoise = real (nint (readnoise * 1000.)) / 1000.
+
+	# print results
+	if (verbose) {
+	    printf ("FINDGAIN:\n")
+	    printf ("  center = %s, binwidth = %g\n", center, binwidth)
+	    printf ("  nclip = %d, lsigma = %g, usigma = %g\n",
+		nclip, lsigma, usigma)
+	    printf ("\n  Flats      = %s  &  %s\n", lf1, lf2)
+	    printf ("  Zeros      = %s  &  %s\n", lz1, lz2)
+	    printf ("  Gain       = %5.2f electrons per ADU\n", e_per_adu)
+	    printf ("  Read noise = %5.2f electrons\n", readnoise)
+	} else
+	    printf ("%5.2f\t%5.2f\n", e_per_adu, readnoise)
+end
diff --git a/noao/obsutil/src/mkpkg b/noao/obsutil/src/mkpkg
new file mode 100644
index 00000000..d13fabbc
--- /dev/null
+++ b/noao/obsutil/src/mkpkg
@@ -0,0 +1,31 @@
+# Make the OBSUTIL package
+
+$call	relink
+$exit
+
+update:
+	$call	relink
+	$call	install
+	;
+
+relink:
+	$update	libpkg.a
+	$omake	x_obsutil.x
+	$link	x_obsutil.o libpkg.a -lxtools -lcurfit -liminterp\
+	    -lsmw -lnlfit -lgsurfit -lds -lasttools -o xx_obsutil.e
+	;
+
+install:
+	$move	xx_obsutil.e noaobin$x_obsutil.e
+	;
+
+
+libpkg.a:
+	@ccdtime
+	@pairmass
+	@specfocus
+	@sptime
+	@starfocus
+
+	t_bitcount.x	<error.h> <imhdr.h> <mach.h>
+        ;
diff --git a/noao/obsutil/src/pairmass/airmass.x b/noao/obsutil/src/pairmass/airmass.x
new file mode 100644
index 00000000..8e9c585d
--- /dev/null
+++ b/noao/obsutil/src/pairmass/airmass.x
@@ -0,0 +1,23 @@
+include	<math.h>
+
+# AIRMASS -- Compute airmass from DEC, LATITUDE and HA
+
+# Airmass formulation from Allen "Astrophysical Quantities" 1973 p.125,133.
+# and John Ball's book on Algorithms for the HP-45
+
+double procedure airmass (ha, dec, lat)
+
+double  ha, dec, lat, cos_zd, x
+
+define  SCALE   750.0d0                 # Atmospheric scale height
+
+begin
+        if (IS_INDEFD (ha) || IS_INDEFD (dec) || IS_INDEFD (lat))
+            call error (1, "Can't determine airmass")
+
+        cos_zd = sin(DEGTORAD(lat)) * sin(DEGTORAD(dec)) +
+                 cos(DEGTORAD(lat)) * cos(DEGTORAD(dec)) * cos(DEGTORAD(ha*15.))
+        x  = SCALE * cos_zd
+
+        return (sqrt (x**2 + 2*SCALE + 1) - x)
+end
diff --git a/noao/obsutil/src/pairmass/drawvector.x b/noao/obsutil/src/pairmass/drawvector.x
new file mode 100644
index 00000000..770689d3
--- /dev/null
+++ b/noao/obsutil/src/pairmass/drawvector.x
@@ -0,0 +1,121 @@
+# DRAW_VECTOR -- Draw the projected vector to the screen.
+
+include <gset.h>
+include	<mach.h>
+
+procedure draw_vector (def_title, timesys, xvec, yvec, n,
+	xmin, xmax, ymin, ymax)
+
+char	def_title[ARB]				#I default plot title
+char	timesys[ARB]				#I time system
+real	xvec[n], yvec[n]			#I vectors to plot
+int	n					#I npts in vectors
+real	xmin, xmax				#I x vector min & max
+real	ymin, ymax				#I y vector min & max
+
+pointer	sp, gp
+pointer	device, marker, xlabel, ylabel, title, suffix
+real	wx1, wx2, wy1, wy2, vx1, vx2, vy1, vy2, szm, tol
+int	mode, imark
+bool	pointmode
+
+pointer	gopen()
+real	clgetr()
+bool	clgetb(), streq()
+int	btoi(), clgeti()
+
+begin
+	call smark (sp)
+	call salloc (device, SZ_FNAME, TY_CHAR)
+	call salloc (marker, SZ_FNAME, TY_CHAR)
+	call salloc (xlabel, SZ_LINE,  TY_CHAR)
+	call salloc (ylabel, SZ_LINE,  TY_CHAR)
+	call salloc (title,  SZ_LINE,  TY_CHAR)
+	call salloc (suffix, SZ_FNAME, TY_CHAR)
+
+	call clgstr ("device", Memc[device], SZ_FNAME)
+	mode = NEW_FILE
+	if (clgetb ("append"))
+	    mode = APPEND
+
+	gp = gopen (Memc[device], mode, STDGRAPH)
+	tol = 10. * EPSILONR
+
+	if (mode != APPEND) {
+	    # Establish window.
+	    wx1 = clgetr ("wx1")
+	    wx2 = clgetr ("wx2")
+	    wy1 = clgetr ("wy1")
+	    wy2 = clgetr ("wy2")
+
+	    # Set window limits to defaults if not specified by user.
+	    if ((wx2 - wx1) < tol) {
+	        wx1 = xmin
+	        wx2 = xmax
+	    }
+
+	    if ((wy2 - wy1) < tol) {
+	        wy1 = ymin
+	        wy2 = ymax
+	    }
+
+	    call gswind (gp, wx1, wx2, wy1, wy2)
+    
+	    # Establish viewport.
+	    vx1 = clgetr ("vx1")
+	    vx2 = clgetr ("vx2")
+	    vy1 = clgetr ("vy1")
+	    vy2 = clgetr ("vy2")
+
+	    # Set viewport only if specified by user.
+	    if ((vx2 - vx1) > tol && (vy2 - vy1) > tol)
+	        call gsview (gp, vx1, vx2, vy1, vy2)
+	    else {
+		if (!clgetb ("fill"))
+		    call gseti (gp, G_ASPECT, 1)
+	    }
+   
+            call clgstr ("xlabel", Memc[xlabel], SZ_LINE)
+            call clgstr ("ylabel", Memc[ylabel], SZ_LINE)
+            call clgstr ("title",  Memc[title],  SZ_LINE)
+
+            if (streq (Memc[title], "default"))
+                call strcpy (def_title, Memc[title], SZ_LINE)
+            if (streq (Memc[xlabel], "default")) {
+                call sprintf (Memc[xlabel], SZ_LINE, "%s Time")
+		    call pargstr (timesys)
+	    }
+    
+	    call gseti (gp, G_XNMAJOR, clgeti ("majrx"))
+	    call gseti (gp, G_XNMINOR, clgeti ("minrx"))
+	    call gseti (gp, G_YNMAJOR, clgeti ("majry"))
+	    call gseti (gp, G_YNMINOR, clgeti ("minry"))
+
+	    call gseti (gp, G_ROUND, btoi (clgetb ("round")))
+
+	    if (clgetb ("logx"))
+	        call gseti (gp, G_XTRAN, GW_LOG)
+	    if (clgetb ("logy"))
+	        call gseti (gp, G_YTRAN, GW_LOG)
+
+	    # Draw axes using all this information.
+	    call glabax (gp, Memc[title], Memc[xlabel], Memc[ylabel])
+	}
+    
+	pointmode = clgetb ("pointmode")
+        if (pointmode) {
+            call clgstr ("marker", Memc[marker], SZ_FNAME)
+            szm = clgetr ("szmarker")
+            call init_marker (Memc[marker], imark)
+        }
+
+        # Now to actually draw the plot.
+        if (pointmode)
+            call gpmark (gp, xvec, yvec, n, imark, szm, szm)
+        else
+            call gpline (gp, xvec, yvec, n)
+       
+	call gflush (gp)
+        call gclose (gp)
+	call sfree (sp)
+end
diff --git a/noao/obsutil/src/pairmass/initmarker.x b/noao/obsutil/src/pairmass/initmarker.x
new file mode 100644
index 00000000..c506ecbb
--- /dev/null
+++ b/noao/obsutil/src/pairmass/initmarker.x
@@ -0,0 +1,39 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<gset.h>
+
+# INIT_MARKER -- Returns integers code for marker type string.
+
+procedure init_marker (marker, imark)
+
+char	marker[SZ_FNAME]	# Marker type as a string
+int	imark			# Integer code for marker - returned
+
+bool	streq()
+
+begin
+	if (streq (marker, "point"))
+	    imark = GM_POINT
+	else if (streq (marker,   "box"))
+	    imark = GM_BOX
+	else if (streq (marker,  "plus"))
+	    imark = GM_PLUS
+	else if (streq (marker, "cross"))
+	    imark = GM_CROSS
+	else if (streq (marker, "circle"))
+	    imark = GM_CIRCLE
+	else if (streq (marker, "hebar"))
+	    imark = GM_HEBAR
+	else if (streq (marker, "vebar"))
+	    imark = GM_VEBAR
+	else if (streq (marker, "hline"))
+	    imark = GM_HLINE
+	else if (streq (marker, "vline"))
+	    imark = GM_VLINE
+	else if (streq (marker, "diamond"))
+	    imark = GM_DIAMOND
+	else {
+	    call eprintf ("Unrecognized marker type, using 'box'\n")
+	    imark = GM_BOX
+	}
+end
diff --git a/noao/obsutil/src/pairmass/mkpkg b/noao/obsutil/src/pairmass/mkpkg
new file mode 100644
index 00000000..bfc564e5
--- /dev/null
+++ b/noao/obsutil/src/pairmass/mkpkg
@@ -0,0 +1,19 @@
+# Make the PAIRMASS task.
+
+$checkout libpkg.a ../
+$update   libpkg.a
+$checkin  libpkg.a ../
+$exit
+
+standalone:
+	$update	libpkg.a
+	$omake	x_pairmass.x
+	$link	x_pairmass.o libpkg.a -lxtools -lasttools -o xx_pairmass.e
+	;
+
+libpkg.a:
+	airmass.x	<math.h>
+	drawvector.x	<gset.h> <mach.h>
+	initmarker.x	<gset.h>
+	t_pairmass.x
+	;
diff --git a/noao/obsutil/src/pairmass/pairmass.par b/noao/obsutil/src/pairmass/pairmass.par
new file mode 100644
index 00000000..1b0f28d6
--- /dev/null
+++ b/noao/obsutil/src/pairmass/pairmass.par
@@ -0,0 +1,40 @@
+ra,r,h,,0.,24.,Right Ascension of the object
+dec,r,h,,-90.,90.,Declination of the object
+epoch,r,h,INDEF,,,Epoch of the coordinates
+
+year,i,h,,,,Year of the observation
+month,i,h,,1,12,Numerical month specification
+day,i,h,,1,31,Day of the month
+
+observatory,s,h,"observatory",,,Observatory
+
+timesys,s,h,"Standard","|Universal|Standard|Siderial|",,Time system
+resolution,r,h,4,0.25,,Number of UT points per hour
+listout,b,h,no,,,"List, rather than plot, the airmass vs. UT"
+
+wx1,r,h,-7.,,,left user x-coord if not autoscaling
+wx2,r,h,7.,,,right user x-coord if not autoscaling
+wy1,r,h,0.,,,lower user y-coord if not autoscaling
+wy2,r,h,5.,,,upper user y-coord if not autoscaling
+pointmode,b,h,no,,,plot points instead of lines
+marker,s,h,"box",\
+  "point|box|plus|cross|circle|hebar|vebar|hline|vline|diamond",\
+  ,point marker character 
+szmarker,r,h,5E-3,,,marker size (0 for list input)
+logx,b,h,no,,,log scale x-axis
+logy,b,h,no,,,log scale y-axis
+xlabel,s,h,"default",,,x-axis label
+ylabel,s,h,"Airmass",,,y-axis label
+title,s,h,"default",,,title for plot
+vx1,r,h,0.,,,left limit of device window (ndc coords)
+vx2,r,h,0.,,,right limit of device window (ndc coords)
+vy1,r,h,0.,,,bottom limit of device window (ndc coords)
+vy2,r,h,0.,,,upper limit of device window (ndc coords)
+majrx,i,h,5,,,number of major divisions along x grid
+minrx,i,h,5,,,number of minor divisions along x grid
+majry,i,h,5,,,number of major divisions along y grid
+minry,i,h,5,,,number of minor divisions along y grid
+round,b,h,no,,,round axes to nice values
+fill,b,h,yes,,,fill device viewport regardless of aspect ratio?
+append,b,h,no,,,append to existing plot
+device,s,h,"stdgraph",,,output device
diff --git a/noao/obsutil/src/pairmass/t_pairmass.x b/noao/obsutil/src/pairmass/t_pairmass.x
new file mode 100644
index 00000000..7b9294a1
--- /dev/null
+++ b/noao/obsutil/src/pairmass/t_pairmass.x
@@ -0,0 +1,112 @@
+# PAIRMASS -- plot the airmass for a given RA & Dec on a given date.
+
+procedure t_pairmass()
+
+pointer	sp, observat, timesys, ut, air, title
+pointer	obs
+double	ra, dec, epoch, ra0, dec0, epoch0
+double	longitude, latitude, zone, st, ha, utd, resolution
+int	day, month, year, nsteps, i, tsys
+real	amin, amax
+
+pointer	obsopen()
+double	clgetd(), obsgetd(), ast_mst(), airmass()
+bool	clgetb()
+int	clgeti(), clgwrd()
+
+begin
+	call smark (sp)
+	call salloc (observat, SZ_FNAME, TY_CHAR)
+	call salloc (timesys, SZ_FNAME, TY_CHAR)
+
+	ra0 = clgetd ("ra")
+	dec0 = clgetd ("dec")
+	epoch0 = clgetd ("epoch")
+
+	year = clgeti ("year")
+	month = clgeti ("month")
+	day = clgeti ("day")
+
+	# Set time to plot.
+	tsys = clgwrd ("timesys", Memc[timesys], SZ_FNAME,
+	    "|Universal|Standard|Siderial|")
+
+	# Get observatory information.
+	call clgstr ("observatory", Memc[observat], SZ_FNAME)
+	obs = obsopen (Memc[observat])
+	#call obslog (obs, "PAIRMASS", "latitude longitude timezone", STDOUT)
+	call obsgstr (obs, "name", Memc[observat], SZ_FNAME)
+	longitude = obsgetd (obs, "longitude")
+	latitude = obsgetd (obs, "latitude")
+	zone = obsgetd (obs, "timezone")
+	call obsclose (obs)
+
+	resolution = clgetd ("resolution")
+	nsteps = nint (24 * resolution) + 1
+
+	call salloc (ut, 3*nsteps, TY_REAL)
+	call salloc (air, 3*nsteps, TY_REAL)
+	call salloc (title, SZ_LINE, TY_CHAR)
+
+	call ast_date_to_epoch (year, month, day, 12.d0, epoch)
+	call ast_precess (ra0, dec0, epoch0, ra, dec, epoch)
+
+	do i = 1, nsteps {
+	    utd = (i-1) / resolution
+	    call ast_date_to_epoch (year, month, day, utd, epoch)
+	    st = ast_mst (epoch, longitude)
+	    ha = st - ra
+
+	    switch (tsys) {
+	    case 1:
+		Memr[ut+i-1] = utd
+	    case 2:
+		if (utd < zone)
+		    Memr[ut+i-1] = utd - zone + 24
+		else
+		    Memr[ut+i-1] = utd - zone
+	    case 3:
+		Memr[ut+i-1] = st
+	    }
+	    Memr[air+i-1] = real (airmass (ha, dec, latitude))
+
+	    Memr[ut+i-1+nsteps] = Memr[ut+i-1] - 24
+	    Memr[ut+i-1+2*nsteps] = Memr[ut+i-1] + 24
+	    Memr[air+i-1+nsteps] = Memr[air+i-1]
+	    Memr[air+i-1+2*nsteps] = Memr[air+i-1]
+	}
+	call xt_sort2 (Memr[ut], Memr[air], 3*nsteps)
+	call alimr (Memr[air], 3*nsteps, amin, amax)
+
+	call sprintf (Memc[title], SZ_LINE,
+	    "Airmass for %d/%d/%d\n%s\nRA=%h, Dec=%h (%g)")
+	    call pargi (month)
+	    call pargi (day)
+	    call pargi (year)
+	    call pargstr (Memc[observat])
+	    call pargd (ra0)
+	    call pargd (dec0)
+	    call pargd (epoch0)
+
+	if (clgetb ("listout")) {
+	    call printf ("%s\nTime System=%s\n\n")
+		call pargstr (Memc[title])
+		call pargstr (Memc[timesys])
+	    amax = clgetd ("wy2")
+	    if (amax < 1)
+		amax = 5
+	    do i = 1, 3*nsteps {
+		if (Memr[ut+i-1] < 0. || Memr[ut+i-1] >= 24.)
+		    next
+		if (Memr[air+i-1] > amax)
+		    next
+		call printf ("%6.0m\t%8.4f\n")
+		    call pargr (Memr[ut+i-1])
+		    call pargr (Memr[air+i-1])
+	    }
+	} else
+	    call draw_vector (Memc[title], Memc[timesys], Memr[ut], Memr[air],
+		3*nsteps, 0., 24., amin, amax)
+
+	call sfree (sp)
+end
diff --git a/noao/obsutil/src/pairmass/x_pairmass.x b/noao/obsutil/src/pairmass/x_pairmass.x
new file mode 100644
index 00000000..82f80509
--- /dev/null
+++ b/noao/obsutil/src/pairmass/x_pairmass.x
@@ -0,0 +1 @@
+task	pairmass = t_pairmass
diff --git a/noao/obsutil/src/shutcor.cl b/noao/obsutil/src/shutcor.cl
new file mode 100644
index 00000000..473615fb
--- /dev/null
+++ b/noao/obsutil/src/shutcor.cl
@@ -0,0 +1,120 @@
+# SHUTCOR - calculate the shutter correction for a detector given
+# a sequence of overscan corrected flats of varying durations.  The
+# shutter correction is the intercept on a plot of exposure duration
+# versus exposure level.  Notion courtesy Phil Massey.
+
+procedure shutcor (images)
+
+string	images			{prompt="Overscan corrected images"}
+string	section	= "[*,*]"	{prompt="Image section for statistics"}
+string	center	= "mode"	{prompt="Central statistical measure",
+				    enum="mean|midpt|mode"}
+int	nclip = 3		{prompt="Number of clipping iterations"}
+real	lsigma = 4		{prompt="Lower clipping sigma factor"}
+real	usigma = 4		{prompt="Upper clipping sigma factor"}
+string	exposure = "exptime"	{prompt="Header keyword for the exposure time"}
+bool	verbose	= yes		{prompt="Verbose output?"}
+
+string	*list
+
+begin
+	string	limages, img, imglist, statlist, explist, tmplist
+	real	exp, shutcorr, shutcorr_err
+	real	slope, slope_err, intercept, intercept_err
+	int	nstat, nexp, junk
+	struct	tmp
+
+	cache sections
+
+	limages = images
+
+	imglist = mktemp ("tmp$tmp")
+	statlist = mktemp ("tmp$tmp")
+	explist = mktemp ("tmp$tmp")
+	tmplist = mktemp ("tmp$tmp")
+
+	sections (limages, option="fullname", > imglist)
+	if (sections.nimages < 4) {
+	    printf ("You need a minimum of four images!\n")
+	    delete (imglist, ver-, >& "dev$null")
+	    return
+	}
+
+	hselect ("@"//imglist, "$I,"//exposure//",overscan", yes, > tmplist)
+	list = tmplist
+	while (fscan (list, img, exp, tmp) != EOF) {
+	    if (strlen (tmp) == 0) {
+		printf ("%s is not overscan corrected! (Check with ccdlist)\n",
+		    img)
+		delete (imglist, ver-, >& "dev$null")
+		delete (tmplist, ver-, >& "dev$null")
+		return
+	    }
+	    if (exp <= 0) {
+		printf ("%s has zero exposure time!\n",
+		    img)
+		delete (imglist, ver-, >& "dev$null")
+		delete (tmplist, ver-, >& "dev$null")
+		return
+	    }
+	}
+
+	list = ""; delete (tmplist, ver-, >& "dev$null")
+
+	hselect ("@"//imglist, "$I,flatcor", yes, > tmplist)
+	list = tmplist
+	while (fscan (list, img, tmp) != EOF)
+	    if (strlen (tmp) != 0)
+		printf ("%s is flat fielded\n", img)
+
+	list = ""; delete (tmplist, ver-, >& "dev$null")
+
+	imstatistics ("@"//imglist, fields=center,
+	    lower=INDEF, upper=INDEF, nclip=nclip, lsigma=lsigma,
+	    usigma=usigma, binwidth=0.1, format-, > statlist)
+
+	hselect ("@"//imglist, exposure, yes, > explist)
+	delete (imglist, ver-, >& "dev$null")
+
+	count (statlist) | scan (nstat)
+	count (explist) | scan (nexp)
+
+	if (nstat != nexp) {
+	    printf ("Problem matching statistics with exposure times!\n")
+	    delete (statlist, ver-, >& "dev$null")
+	    delete (explist, ver-, >& "dev$null")
+	    return
+	}
+
+	join (explist, statlist, output="STDOUT", delim=" ", missing="INDEF",
+	    shortest+, verbose-) | polyfit ("STDIN", 1, weighting="uniform",
+	    verbose=verbose, listdata-, > tmplist)
+
+	delete (explist, ver-, >& "dev$null")
+	delete (statlist, ver-, >& "dev$null")
+
+	list = tmplist
+	junk = fscan (list, intercept, slope)
+	junk = fscan (list, intercept_err, slope_err)
+	list = ""
+
+	shutcorr = intercept / slope
+	shutcorr_err = abs (shutcorr) *
+	    sqrt ((intercept_err/intercept)**2 + (slope_err/slope)**2)
+
+	if (verbose)
+	    printf ("\n")
+
+	printf ("Shutter correction = %.3f +/- %.3f seconds\n",
+	    shutcorr, shutcorr_err)
+
+	if (verbose) {
+	    printf ("\nInformation about the %s versus %s fit:\n\n",
+		center, exposure)
+	    printf ("       intercept        slope     (and errors)\n")
+	    printf ("!sed 's+^+    +' %s\n", osfn(tmplist)) | cl
+	    printf ("\n")
+	}
+
+	delete (tmplist, ver-, >& "dev$null")
+end
diff --git a/noao/obsutil/src/specfocus/Revisions b/noao/obsutil/src/specfocus/Revisions
new file mode 100644
index 00000000..3104b9f7
--- /dev/null
+++ b/noao/obsutil/src/specfocus/Revisions
@@ -0,0 +1,9 @@
+.help revisions Nov01 obsutil
+.nf
+spfgraph.x
+    Fixed case where if the average of the minimum and maximum focus values
+    is zero then a floating divide by zero would occur.  (2/14/97, Valdes)
+
+t_specfocus.x
+    Fixed bug in interpreting the focus parameter.  (6/26/95, Valdes)
+.endhelp
diff --git a/noao/obsutil/src/specfocus/mkpkg b/noao/obsutil/src/specfocus/mkpkg
new file mode 100644
index 00000000..c41d9a34
--- /dev/null
+++ b/noao/obsutil/src/specfocus/mkpkg
@@ -0,0 +1,19 @@
+# Make the SPECFOCUS task.
+
+$checkout libpkg.a ../
+$update   libpkg.a
+$checkin  libpkg.a ../
+$exit
+
+standalone:
+	$update	libpkg.a
+	$omake	x_specfocus.x
+	$link	x_specfocus.o libpkg.a -lxtools -lcurfit -liminterp\
+	    -o xx_specfocus.e
+	;
+
+libpkg.a:
+	spfgraph.x	specfocus.h <gset.h> <mach.h>
+	t_specfocus.x	specfocus.h <error.h> <imhdr.h> <mach.h> <math.h>\
+			<math/curfit.h> <math/iminterp.h>
+	;
diff --git a/noao/obsutil/src/specfocus/specfocus.h b/noao/obsutil/src/specfocus/specfocus.h
new file mode 100644
index 00000000..d79f7c6e
--- /dev/null
+++ b/noao/obsutil/src/specfocus/specfocus.h
@@ -0,0 +1,33 @@
+# Data structures for SPECFOCUS
+
+define	SZ_SFFNAME	79		  # Length of file names
+define	LEN_SF		54		  # Length of image data structure
+
+define	SF_IMAGE	Memc[P2C($1)]	  # Image name
+define	SF_FOCUS	Memr[P2R($1+40)]  # Focus
+define	SF_WIDTH	Memr[P2R($1+41)]  # Width
+define	SF_LEVEL	Memr[P2R($1+42)]  # Level of width
+define	SF_AXIS		Memi[$1+43]	  # Dispersion axis
+define	SF_X1		Memi[$1+44]	  # Start of dispersion sampling
+define	SF_DX		Memi[$1+45]	  # Dispersion sampling step
+define	SF_NX		Memi[$1+46]	  # Number of dispersion samples
+define	SF_Y1		Memi[$1+47]	  # Start of cross-dispersion sampling
+define	SF_DY		Memi[$1+48]	  # Cross-dispersion sampling step
+define	SF_NY		Memi[$1+49]	  # Number of cross-dispersion samples
+define	SF_SFD		Memi[$1+50]	  # Pointer to data structures
+define	SF_NSFD		Memi[$1+51]	  # Number of data structures
+define	SF_DATA		Memi[$1+52]	  # Pointer to spectrum data 
+define	SF_NPIX		Memi[$1+53]	  # Number of pixels per spectrum
+
+define	LEN_SFD		8		  # Length of spectrum data structure
+
+define	SF_X		Memr[P2R($1)]	  # Dispersion axis coordinate
+define	SF_Y		Memr[P2R($1+1)]	  # Spatial axis coordinate
+define	SF_SPEC		Memi[$1+2]	  # Pointer to spectrum
+define	SF_ASI		Memi[$1+3]	  # Pointer to correlation profile
+define	SF_FOC		Memr[P2R($1+4)]	  # Focus
+define	SF_WID		Memr[P2R($1+5)]	  # Width
+define	SF_POS		Memr[P2R($1+6)]	  # Position
+define	SF_DEL		Memi[$1+7]	  # Deleted?
+
+define	SFD		Memi[SF_SFD($1)+($3-1)*SF_NX($1)+$2-1]
diff --git a/noao/obsutil/src/specfocus/specfocus.par b/noao/obsutil/src/specfocus/specfocus.par
new file mode 100644
index 00000000..bf21416c
--- /dev/null
+++ b/noao/obsutil/src/specfocus/specfocus.par
@@ -0,0 +1,13 @@
+images,s,a,,,,List of images
+focus,s,h,"",,,Focus values
+corwidth,i,h,20,,,Correlation width
+level,r,h,0.5,,,Percent or fraction of peak for width measurement
+shifts,b,h,yes,,,"Compute shifts across the dispersion?
+"
+dispaxis,i,h,2,1,2,Dispersion axis (long slit only)
+nspectra,i,h,1,1,,Number of spectral samples (long slit only)
+ndisp,i,h,1,1,,Number of dispersion samples
+slit1,i,h,INDEF,,,Lower slit edge
+slit2,i,h,INDEF,,,"Upper slit edge
+"
+logfile,s,h,"logfile",,,"Logfile"
diff --git a/noao/obsutil/src/specfocus/spfgraph.x b/noao/obsutil/src/specfocus/spfgraph.x
new file mode 100644
index 00000000..0430d494
--- /dev/null
+++ b/noao/obsutil/src/specfocus/spfgraph.x
@@ -0,0 +1,1637 @@
+include	<gset.h>
+include	<mach.h>
+include	"specfocus.h"
+
+define	HELP		"specfocus$specfocus.key"
+define	PROMPT		"specfocus options"
+
+define	VX1	.15		# Minimum X viewport
+define	VX2	.95		# Maximum X viewport
+define	VY1	.10		# Minimum Y viewport for bottom graph
+define	VY2	.44		# Minimum Y viewport for bottom graph
+define	VY3	.54		# Minimum Y viewport for top graph
+define	VY4	.88		# Maximum Y viewport for top graph
+
+define	NMAX	5		# Maximum number of samples
+define	HLCOLOR	2		# Highlight color
+define	HLWIDTH	4.		# Highlight width
+
+
+# SPF_GRAPH -- Interactive graphing of results
+
+procedure spf_graph (sfavg, sfbest, sfs, nimages, lag)
+
+pointer	sfavg			# Average image
+pointer	sfbest			# Best image
+pointer	sfs[nimages]		# Images
+int	nimages			# Number of images
+int	lag			# Maximum lag
+
+char	cmd[10]
+real	wx, wy, f, w, r2, r2min, fa[8]
+int	i, j, k, l, i1, j1, nx, ny, nxgrid, nygrid, nsfd
+int	wcs, key, pkey, del, clgcur()
+pointer	sp, sysidstr, title, gp, gopen()
+pointer	sf, sfd, sfcur
+
+data	fa/0.,1.,1.,0.,0.,0.,1.,1./
+
+begin
+	call smark (sp)
+	call salloc (sysidstr, SZ_LINE, TY_CHAR)
+	call salloc (title, SZ_LINE, TY_CHAR)
+
+	# Set system id label
+	call sysid (Memc[sysidstr], SZ_LINE)
+
+	# Set current image and sample
+	nsfd = SF_NSFD(sfavg)
+	nx = SF_NX(sfavg)
+	ny = SF_NY(sfavg)
+	i = (nx + 1) / 2
+	j = (ny + 1) / 2
+	for (k=1; k<nimages && sfs[k]!=sfbest; k=k+1)
+	    ;
+
+	# Set grid layout
+	if (nimages < 3) {
+	    nxgrid = nimages
+	    nygrid = 1
+	} else {
+	    nxgrid = nint (sqrt (real (nimages)))
+	    if (mod (nimages, nxgrid+1) >= mod (nimages, nxgrid))
+		nxgrid = nxgrid + 1
+	    nygrid = (nimages-1) / nxgrid + 1
+	}
+
+	# Open graphics and enter interactive graphics loop
+	gp = gopen ("stdgraph", NEW_FILE, STDGRAPH)
+	key = 'b'
+	wcs = 0
+	repeat {
+	    # Verify keys, check for '?', and 'q', set redraw.
+	    switch (key) {
+	    case '?':
+		call gpagefile (gp, HELP, PROMPT)
+		next
+	    case 'b', 'p', 's', 'w', 'z':
+		pkey = key
+		del = NO
+	    case 'q':
+		break
+	    case 'r':
+		key = pkey
+		del = NO
+	    case ' ', 'd':
+		del = NO
+	    case 'u':
+		del = YES
+	    default:
+		call printf ("\007")
+		next
+	    }
+
+	    # Map the cursor position to an image and sample.
+	    switch (wcs) {
+	    case 1:
+		k = 1
+		call spf_sample (sfavg, 1, del, wx, wy, i, j, k)
+		f = SF_FOC(SFD(sfavg,i,j))
+		r2min = MAX_REAL
+		do l = 1, nimages {
+		    sf = sfs[l]
+		    sfd = SFD(sf,i,j)
+		    if (SF_DEL(sfd) == del) {
+			r2 = abs (f - SF_FOC(sfd))
+			if (r2 < r2min) {
+			    r2min = r2
+			    k = l
+			}
+		    }
+		}
+		call spf_sample (sfs, nimages, del, wx, wy, i, j, k)
+	    case 2, 6:
+		call spf_sample (sfs, nimages, del, wx, wy, i, j, k)
+	    case 3:
+		r2min = MAX_REAL
+		call gctran (gp, wx, wy, wx, wy, wcs, 0)
+		do l = 1, nimages {
+		    sf = sfs[l]
+		    do j1 = 1, ny {
+			do i1 = 1, nx {
+			    sfd = SFD(sf,i1,j1)
+			    if (SF_DEL(sfd) == del) {
+				f = SF_FOC(sfd)
+				w = SF_WID(sfd)
+				call gctran (gp, f, w, f, w, wcs, 0)
+				r2 = (f-wx)**2 + (w-wy)**2
+				if (r2 < r2min) {
+				    r2min = r2
+				    i = i1
+				    j = j1
+				    k = l
+				}
+			    }
+			}
+		    }
+		}
+	    case 4, 5, 8:
+		i1 = max (1, min (nxgrid, nint(wx)))
+		j1 = max (1, min (nygrid, nint(wy)))
+		k = max (1, min (nimages, (j1-1) * nxgrid + i1))
+		call spf_sample (sfs, nimages, del, real(i), real(j), i, j, k)
+		if (wcs == 8) {
+		    wx = nx * (wx - nint (wx) + 0.5) + 0.5
+		    wy = -(ny+1) * (wy - nint (wy) + 0.5) + (ny+1.5)
+		    call spf_sample (sfs, nimages, del, wx, wy, i, j, k)
+		}
+	    }
+
+	    # Switch on action key
+	    switch (key) {
+	    case ' ':
+		if (wcs == 1)
+		    sf = sfavg
+		else
+		    sf = sfs[k]
+		sfd = SFD(sf,i,j)
+		call printf (
+		    "Image %s at (%d, %d), Focus = %.3g, Width = %.2f")
+		    call pargstr (SF_IMAGE(sf))
+		    call pargr (SF_X(sfd))
+		    call pargr (SF_Y(sfd))
+		    call pargr (SF_FOC(sfd))
+		    call pargr (SF_WID(sfd))
+		if (abs (SF_POS(sfd)) > .01) {
+		    call printf (", Shift = %.2f")
+			call pargr (SF_POS(sfd))
+		}
+		call printf ("\n")
+		next
+	    case 'd':
+		repeat {
+		    switch (key) {
+		    case 'i':
+			do j1 = 1, ny
+			   do i1 = 1, nx
+				SF_DEL(SFD(sfs[k],i1,j1)) = YES
+			call spf_sample (sfs, nimages, del, real(i), real(j),
+			    i, j, k)
+		    case 's':
+			do l = 1, nimages {
+			    sfd = SFD(sfs[l],i,j)
+			    SF_DEL(sfd) = YES
+			}
+			call spf_sample (sfs, nimages, del, real(i), real(j),
+			    i, j, k)
+		    case 'p':
+			sfd = SFD(sfs[k],i,j)
+			SF_DEL(sfd) = YES
+			call spf_sample (sfs, nimages, del, real(i), real(j),
+			    i, j, k)
+		    default:
+			call printf ("Delete image, sample, or point?")
+			next
+		    }
+		    call spf_fitfocus (sfs, nimages, sfavg, sfbest)
+		    key = pkey
+		    break
+		} until (clgcur ("gcur", wx, wy, wcs, key, cmd, 10) == EOF)
+	    case 'u':
+		repeat {
+		    switch (key) {
+		    case 'i':
+			call spf_sample (sfs, nimages, del, real(i), real(j),
+			    i, j, k)
+			do j1 = 1, ny
+			   do i1 = 1, nx
+				SF_DEL(SFD(sfs[k],i1,j1)) = NO
+		    case 's':
+			call spf_sample (sfs, nimages, del, real(i), real(j),
+			    i, j, k)
+			do l = 1, nimages {
+			    sfd = SFD(sfs[l],i,j)
+			    SF_DEL(sfd) = NO
+			}
+		    case 'p':
+			call spf_sample (sfs, nimages, del, real(i), real(j),
+			    i, j, k)
+			sfd = SFD(sfs[k],i,j)
+			SF_DEL(sfd) = NO
+		    default:
+			call printf ("Undelete image, sample or point?")
+			next
+		    }
+		    call spf_fitfocus (sfs, nimages, sfavg, sfbest)
+		    key = pkey
+		    break
+		} until (clgcur ("gcur", wx, wy, wcs, key, cmd, 10) == EOF)
+	    }
+	    sfcur = sfs[k]
+	    sfd = SFD(sfcur,i,j)
+
+	    # Make the graphs.
+	    call gclear (gp)
+	    call gseti (gp, G_FACOLOR, 0)
+
+	    if (nimages > 1 && nsfd > 1) {
+		switch (key) {
+		case 'p':
+		    call gseti (gp, G_WCS, 4)
+		    call gsview (gp, VX1, VX2, VY3, VY4)
+		    call spf_g4 (gp, sfavg, sfbest, sfcur, sfs, nimages, i, j,
+			nxgrid, nygrid, lag)
+		    if (nx > NMAX || ny > NMAX) {
+			call gseti (gp, G_WCS, 1)
+			call gsview (gp, VX1, VX2, VY1, VY2)
+			call gfill (gp, fa, fa[5], 4, GF_SOLID)
+			call spf_g1 (gp, sfcur, i, j, NO, NO)
+		    } else {
+			call gseti (gp, G_WCS, 2)
+			call gsview (gp, VX1, VX2, VY1, VY2)
+			call gfill (gp, fa, fa[5], 4, GF_SOLID)
+			call spf_g2 (gp, sfavg, sfbest, sfcur, i, j, lag)
+		    }
+		case 's':
+		    call gseti (gp, G_WCS, 5)
+		    call gsview (gp, VX1, VX2, VY3, VY4)
+		    call spf_g5 (gp, sfcur, sfs, nimages, i, j, nxgrid, nygrid)
+		    if (nx > NMAX || ny > NMAX) {
+			call gseti (gp, G_WCS, 1)
+			call gsview (gp, VX1, VX2, VY1, VY2)
+			call gfill (gp, fa, fa[5], 4, GF_SOLID)
+			call spf_g1 (gp, sfcur, i, j, NO, NO)
+		    } else {
+			call gseti (gp, G_WCS, 6)
+			call gsview (gp, VX1, VX2, VY1, VY2)
+			call gfill (gp, fa, fa[5], 4, GF_SOLID)
+			call spf_g6 (gp, sfcur, i, j)
+		    }
+		case 'w':
+		    call gseti (gp, G_WCS, 3)
+		    call gsview (gp, VX1, VX2, VY3, VY4)
+		    call spf_g3 (gp, sfavg, sfcur, sfs, nimages, i, j)
+		    if (nx > NMAX || ny > NMAX) {
+			call gseti (gp, G_WCS, 1)
+			call gsview (gp, VX1, VX2, VY1, VY2)
+			call gfill (gp, fa, fa[5], 4, GF_SOLID)
+			call spf_g1 (gp, sfcur, i, j, NO, NO)
+		    } else {
+			call gseti (gp, G_WCS, 8)
+			call gsview (gp, VX1, VX2, VY1, VY2)
+			call gfill (gp, fa, fa[5], 4, GF_SOLID)
+			call spf_g8 (gp, sfavg, sfcur, sfd, sfs, nimages,
+			    nxgrid, nygrid)
+		    }
+		case 'z':
+		    call gseti (gp, G_WCS, 7)
+		    call gsview (gp, VX1, VX2, VY3, VY4)
+		    call spf_g7 (gp, sfbest, sfcur, i, j, lag)
+		    call gseti (gp, G_WCS, 9)
+		    call gsview (gp, VX1, VX2, VY1, VY2)
+		    call gfill (gp, fa, fa[5], 4, GF_SOLID)
+		    call spf_g9 (gp, sfcur, i, j)
+		default:
+		    call gseti (gp, G_WCS, 1)
+		    call gsview (gp, VX1, VX2, VY1, VY4)
+		    call spf_g1 (gp, sfavg, i, j, YES, YES)
+		}
+	    } else if (nimages > 1) {
+		switch (key) {
+		case 'z':
+		    call gseti (gp, G_WCS, 7)
+		    call gsview (gp, VX1, VX2, VY3, VY4)
+		    call spf_g7 (gp, sfbest, sfcur, i, j, lag)
+		    call gseti (gp, G_WCS, 9)
+		    call gsview (gp, VX1, VX2, VY1, VY2)
+		    call gfill (gp, fa, fa[5], 4, GF_SOLID)
+		    call spf_g9 (gp, sfcur, i, j)
+		case 's':
+		    call gseti (gp, G_WCS, 3)
+		    call gsview (gp, VX1, VX2, VY3, VY4)
+		    call spf_g3 (gp, sfavg, sfcur, sfs, nimages, i, j)
+		    call gseti (gp, G_WCS, 5)
+		    call gsview (gp, VX1, VX2, VY1, VY2)
+		    call gfill (gp, fa, fa[5], 4, GF_SOLID)
+		    call spf_g5 (gp, sfcur, sfs, nimages, i, j, nxgrid, nygrid)
+		default:
+		    call gseti (gp, G_WCS, 3)
+		    call gsview (gp, VX1, VX2, VY3, VY4)
+		    call spf_g3 (gp, sfavg, sfcur, sfs, nimages, i, j)
+		    call gseti (gp, G_WCS, 4)
+		    call gsview (gp, VX1, VX2, VY1, VY2)
+		    call spf_g4 (gp, sfavg, sfbest, sfcur, sfs, nimages, i, j,
+			nxgrid, nygrid, lag)
+		}
+	    } else if (nsfd > 1) {
+		switch (key) {
+		case 'z':
+		    call gseti (gp, G_WCS, 7)
+		    call gsview (gp, VX1, VX2, VY3, VY4)
+		    call spf_g7 (gp, sfbest, sfcur, i, j, lag)
+		    call gseti (gp, G_WCS, 9)
+		    call gsview (gp, VX1, VX2, VY1, VY2)
+		    call gfill (gp, fa, fa[5], 4, GF_SOLID)
+		    call spf_g9 (gp, sfcur, i, j)
+		default:
+		    call gseti (gp, G_WCS, 2)
+		    call gsview (gp, VX1, VX2, VY3, VY4)
+		    call spf_g2 (gp, sfavg, sfbest, sfcur, i, j, lag)
+		    call gseti (gp, G_WCS, 6)
+		    call gsview (gp, VX1, VX2, VY1, VY2)
+		    call gfill (gp, fa, fa[5], 4, GF_SOLID)
+		    call spf_g6 (gp, sfcur, i, j)
+		}
+	    } else {
+		call gseti (gp, G_WCS, 7)
+		call gsview (gp, VX1, VX2, VY3, VY4)
+		call spf_g7 (gp, sfbest, sfcur, i, j, lag)
+		call gseti (gp, G_WCS, 9)
+		call gsview (gp, VX1, VX2, VY1, VY2)
+		call gfill (gp, fa, fa[5], 4, GF_SOLID)
+		call spf_g9 (gp, sfcur, i, j)
+	    }
+
+	    call sprintf (Memc[title], SZ_LINE,
+		"Best Average Focus at %.3g with Width of %.3g at %d%% of Peak")
+		call pargr (SF_FOCUS(sfavg))
+		call pargr (SF_WIDTH(sfavg))
+		call pargr (100 * SF_LEVEL(sfavg))
+	    call gseti (gp, G_WCS, 0)
+	    call gsetr (gp, G_PLWIDTH, 2.0)
+	    call gline (gp, 0., 0., 0., 0.)
+	    call gtext (gp, 0.5, 0.99, Memc[sysidstr], "h=c,v=t")
+	    call gtext (gp, 0.5, 0.96, Memc[title], "h=c,v=t")
+
+	    pkey = key
+	} until (clgcur ("gcur", wx, wy, wcs, key, cmd, 10) == EOF)
+
+	call gclose (gp)
+	call sfree (sp)
+end
+
+
+# SPF_G1 -- Best Focus at each sample
+
+procedure spf_g1 (gp, sf, ix, iy, focplot, posplot)
+
+pointer	gp		# GIO pointer
+pointer	sf		# SF pointer
+int	ix, iy		# Sample
+int	focplot		# Focus plot?
+int	posplot		# Position plot?
+
+int	i, j, n, nx, ny
+real	wx1, wx2, wy1, wy2, ww1, ww2, wf1, wf2, wp1, wp2
+real	vx[3,2], vy[3,2], dvx, dvy, fa[8]
+real	x, y, z, last
+pointer	sp, str, sfd
+
+data	fa/0.,1.,1.,0.,0.,0.,1.,1./
+
+begin
+	call smark (sp)
+	call salloc (str, SZ_LINE, TY_CHAR)
+
+	nx = SF_NX(sf)
+	ny = SF_NY(sf)
+	wx1 = SF_X1(sf)
+	wy1 = SF_Y1(sf)
+	wx2 = wx1 + (nx + .3) * SF_DX(sf)
+	wy2 = wy1 + ny * SF_DY(sf)
+
+	# Determine the range of WID, FOC, and POS.
+	ww1 = MAX_REAL
+	wf1 = MAX_REAL
+	wp1 = MAX_REAL
+	ww2 = -MAX_REAL
+	wf2 = -MAX_REAL
+	wp2 = -MAX_REAL
+	do j = 1, ny {
+	    do i = 1, nx {
+		sfd = SFD(sf,i,j)
+		if (SF_DEL(sfd) == NO) {
+		    ww1 = min (ww1, SF_WID(sfd))
+		    wf1 = min (wf1, SF_FOC(sfd))
+		    wp1 = min (wp1, SF_POS(sfd))
+		    ww2 = max (ww2, SF_WID(sfd))
+		    wf2 = max (wf2, SF_FOC(sfd))
+		    wp2 = max (wp2, SF_POS(sfd))
+		}
+	    }
+	}
+	ww2 = max (2., ww2 - ww1)
+
+	# Set view ports
+	call ggview (gp, vx[1,1], vx[3,2], vy[1,1], vy[3,2])
+	dvx = vx[3,2] - vx[1,1]
+	dvy = vy[3,2] - vy[1,1]
+	vx[1,2] = vx[1,1] + 0.20 * dvx
+	vx[2,1] = vx[1,1] + 0.25 * dvx
+	vx[2,2] = vx[1,1] + 0.75 * dvx
+	vx[3,1] = vx[1,1] + 0.80 * dvx
+	vy[1,2] = vy[1,1] + 0.20 * dvy
+	vy[2,1] = vy[1,1] + 0.25 * dvy
+	vy[2,2] = vy[1,1] + 0.75 * dvy
+	vy[3,1] = vy[1,1] + 0.80 * dvy
+
+	z = abs ((wf1 + wf2) / 2.)
+	if (z == 0.)
+	    z = max (abs(wf1), abs(wf2))
+	if (z == 0.)
+	    z = 1.
+	if (focplot == NO || abs (wf2 - wf1) / z <= 0.01) {
+	    vx[2,1] = vx[1,1]
+	    vy[2,1] = vy[1,1]
+	}
+	if (posplot == NO || abs (wp2 - wp1) <= .05) {
+	    vx[2,2] = vx[3,2]
+	    vy[2,2] = vy[3,2]
+	}
+	if (nx == 1) {
+	    vy[2,1] = vy[1,1]
+	    vy[2,2] = vy[3,2]
+	}
+	if (ny == 1) {
+	    vx[2,1] = vx[1,1]
+	    vx[2,2] = vx[3,2]
+	}
+
+	call gseti (gp, G_DRAWAXES, 3)
+	call gseti (gp, G_DRAWTICKS, YES)
+
+	# FOC plot
+	if (focplot == YES && abs (wf2 - wf1) / z > 0.01) {
+	    z = wf2 - wf1
+	    wf1 = wf1 - 0.05 * z
+	    wf2 = wf2 + 0.05 * z
+
+	    if (nx > 1) {
+		call gseti (gp, G_LABELTICKS, YES)
+		call gseti (gp, G_NMAJOR, 6)
+		call gseti (gp, G_NMINOR, 4)
+		call gseti (gp, G_YNMAJOR, 4)
+		call gseti (gp, G_YNMINOR, 0)
+		call gsview (gp, vx[2,1], vx[2,2], vy[1,1], vy[1,2])
+		call gswind (gp, 0., 1., 0., 1.)
+		call gfill (gp, fa, fa[5], 4, GF_SOLID)
+		call gswind (gp, wx1, wx2, wf1, wf2)
+		if (SF_AXIS(sf) == 1)
+		    call glabax (gp, "", "Column (Dispersion)", "Focus")
+		else
+		    call glabax (gp, "", "Column (Slit)", "Focus")
+
+		call gswind (gp, 0.5, 0.8+nx, wf1, wf2)
+		last = INDEF
+		do i = 1, nx {
+		    x = i
+		    do j = 1, ny {
+			sfd = SFD(sf,i,j)
+			if (SF_DEL(sfd) == NO) {
+			    z = SF_WID(sfd)
+			    z = 0.008 * (1 + (z - ww1) / ww2 * 3)
+			    call gmark (gp, x, SF_FOC(sfd), GM_CIRCLE, z, z)
+			}
+		    }
+
+		    n = 0
+		    z = 0.
+		    do j = 1, ny {
+			sfd = SFD(sf,i,j)
+			if (SF_DEL(sfd) == NO) {
+			    z = z + SF_FOC(SFD(sf,i,j))
+			    n = n + 1
+			}
+		    }
+		    if (n > 0) {
+			if (!IS_INDEF(last))
+			    call gline (gp, last, y, x, z/n)
+			y = z / n
+			last = x
+		    }
+		}
+
+		call gseti (gp, G_PLTYPE, 2)
+		call gline (gp, 0.5, SF_FOCUS(sf), 0.8+nx, SF_FOCUS(sf))
+		call gseti (gp, G_PLTYPE, 1)
+	    }
+
+	    if (ny > 1) {
+		call gseti (gp, G_LABELTICKS, YES)
+		call gseti (gp, G_NMAJOR, 6)
+		call gseti (gp, G_NMINOR, 4)
+		call gseti (gp, G_XNMAJOR, 4)
+		call gseti (gp, G_XNMINOR, 0)
+		call gsview (gp, vx[1,1], vx[1,2], vy[2,1], vy[2,2])
+		call gswind (gp, 0., 1., 0., 1.)
+		call gfill (gp, fa, fa[5], 4, GF_SOLID)
+		call gswind (gp, wf1, wf2, wy1, wy2)
+		if (SF_AXIS(sf) == 1)
+		    call glabax (gp, "", "Focus", "Line (Slit)")
+		else
+		    call glabax (gp, "", "Focus", "Line (Dispersion)")
+
+		call gswind (gp, wf1, wf2, 0.5, 0.5+ny)
+		last = INDEF
+		do j = 1, ny {
+		    y = j
+		    do i = 1, nx {
+			sfd = SFD(sf,i,j)
+			if (SF_DEL(sfd) == NO) {
+			    z = SF_WID(sfd)
+			    z = 0.008 * (1 + (z - ww1) / ww2 * 3)
+			    call gmark (gp, SF_FOC(sfd), y, GM_CIRCLE, z, z)
+			}
+		    }
+
+		    n = 0
+		    z = 0.
+		    do i = 1, nx {
+			sfd = SFD(sf,i,j)
+			if (SF_DEL(sfd) == NO) {
+			    z = z + SF_FOC(SFD(sf,i,j))
+			    n = n + 1
+			}
+		    }
+		    if (n > 0) {
+			if (!IS_INDEF(last))
+			    call gline (gp, x, last, z/n, y)
+			x = z / n
+			last = y
+		    }
+		}
+
+		call gseti (gp, G_PLTYPE, 2)
+		call gline (gp, SF_FOCUS(sf), 0.5, SF_FOCUS(sf), 0.5+ny)
+		call gseti (gp, G_PLTYPE, 1)
+	    }
+	}
+
+	# POS plot
+	if (posplot == YES && abs (wp2 - wp1) > .05) {
+	    z = wp2 - wp1
+	    wp1 = wp1 - 0.05 * z
+	    wp2 = wp2 + 0.05 * z
+
+	    if (nx > 1) {
+		call gseti (gp, G_XLABELTICKS, NO)
+		call gseti (gp, G_YLABELTICKS, YES)
+		call gseti (gp, G_NMAJOR, 6)
+		call gseti (gp, G_NMINOR, 4)
+		call gseti (gp, G_YNMAJOR, 4)
+		call gseti (gp, G_YNMINOR, 0)
+		call gsview (gp, vx[2,1], vx[2,2], vy[3,1], vy[3,2])
+		call gswind (gp, 0., 1., 0., 1.)
+		call gfill (gp, fa, fa[5], 4, GF_SOLID)
+		call gswind (gp, wx1, wx2, wp1, wp2)
+		call glabax (gp, "", "", "Shift")
+
+		call gswind (gp, 0.5, 0.8+nx, wp1, wp2)
+		last = INDEF
+		do i = 1, nx {
+		    x = i
+		    do j = 1, ny {
+			sfd = SFD(sf,i,j)
+			if (SF_DEL(sfd) == NO) {
+			    z = SF_WID(sfd)
+			    z = 0.008 * (1 + (z - ww1) / ww2 * 3)
+			    call gmark (gp, x, SF_POS(sfd), GM_CIRCLE, z, z)
+			}
+		    }
+
+		    n = 0
+		    z = 0.
+		    do j = 1, ny {
+			sfd = SFD(sf,i,j)
+			if (SF_DEL(sfd) == NO) {
+			    z = z + SF_POS(SFD(sf,i,j))
+			    n = n + 1
+			}
+		    }
+		    if (n > 0) {
+			if (!IS_INDEF(last))
+			    call gline (gp, last, y, x, z/n)
+			y = z / n
+			last = x
+		    }
+		}
+
+		call gseti (gp, G_PLTYPE, 2)
+		call gline (gp, 0.5, 0., 0.8+nx, 0.)
+		call gseti (gp, G_PLTYPE, 1)
+	    }
+
+	    if (ny > 1) {
+		call gseti (gp, G_XLABELTICKS, YES)
+		call gseti (gp, G_YLABELTICKS, NO)
+		call gseti (gp, G_NMAJOR, 6)
+		call gseti (gp, G_NMINOR, 4)
+		call gseti (gp, G_XNMAJOR, 4)
+		call gseti (gp, G_XNMINOR, 0)
+		call gsview (gp, vx[3,1], vx[3,2], vy[2,1], vy[2,2])
+		call gswind (gp, 0., 1., 0., 1.)
+		call gfill (gp, fa, fa[5], 4, GF_SOLID)
+		call gswind (gp, wp1, wp2, wy1, wy2)
+		call glabax (gp, "", "Shift", "")
+
+		call gswind (gp, wp1, wp2, 0.5, 0.5+ny)
+		last = INDEF
+		do j = 1, ny {
+		    y = j
+		    do i = 1, nx {
+			sfd = SFD(sf,i,j)
+			if (SF_DEL(sfd) == NO) {
+			    z = SF_WID(sfd)
+			    z = 0.008 * (1 + (z - ww1) / ww2 * 3)
+			    call gmark (gp, SF_POS(sfd), y, GM_CIRCLE, z, z)
+			}
+		    }
+
+		    n = 0
+		    z = 0.
+		    do i = 1, nx {
+			sfd = SFD(sf,i,j)
+			if (SF_DEL(sfd) == NO) {
+			    z = z + SF_POS(sfd)
+			    n = n + 1
+			}
+		    }
+		    if (n > 0) {
+			if (!IS_INDEF(last))
+			    call gline (gp, x, last, z/n, y)
+			x = z / n
+			last = y
+		    }
+		}
+
+		call gseti (gp, G_PLTYPE, 2)
+		call gline (gp, 0., 0.5, 0., 0.5+ny)
+		call gseti (gp, G_PLTYPE, 1)
+	    }
+	}
+
+	# Spatial plot
+	call gsview (gp, vx[2,1], vx[2,2], vy[2,1], vy[2,2])
+	call gswind (gp, 0., 1., 0., 1.)
+	call gfill (gp, fa, fa[5], 4, GF_SOLID)
+	call gswind (gp, wx1, wx2, wy1, wy2)
+	call gseti (gp, G_NMAJOR, 6)
+	call gseti (gp, G_NMINOR, 4)
+	if (vx[2,1] == vx[1,1] && vy[2,1] == vy[1,1]) {
+	    call gseti (gp, G_LABELTICKS, YES)
+	    if (SF_AXIS(sf) == 1)
+		call glabax (gp, "", "Column (Dispersion)", "Line (Slit)")
+	    else
+		call glabax (gp, "", "Column (Slit)", "Line (Dispersion)")
+	} else if (vx[2,1] == vx[1,1]) {
+	    call gseti (gp, G_XLABELTICKS, NO)
+	    call gseti (gp, G_YLABELTICKS, YES)
+	    if (SF_AXIS(sf) == 1)
+		call glabax (gp, "", "", "Line (Slit)")
+	    else
+		call glabax (gp, "", "", "Line (Dispersion)")
+	} else if (vy[2,1] == vy[1,1]) {
+	    call gseti (gp, G_XLABELTICKS, YES)
+	    call gseti (gp, G_YLABELTICKS, NO)
+	    if (SF_AXIS(sf) == 1)
+		call glabax (gp, "", "Column (Dispersion)", "")
+	    else
+		call glabax (gp, "", "Column (Slit)", "")
+	} else {
+	    call gseti (gp, G_LABELTICKS, NO)
+	    call glabax (gp, "", "", "")
+	}
+
+	call gswind (gp, 0.5, 0.8+nx, 0.5, 0.5+ny)
+
+	do j = 1, ny {
+	    do i = 1, nx {
+		sfd = SFD(sf,i,j)
+		if (SF_DEL(sfd) == NO) {
+		    x = i
+		    y = j
+		    z = SF_WID(sfd)
+		    z = 0.008 * (1 + (z - ww1) / ww2 * 3)
+		    call gmark (gp, x, y, GM_CIRCLE, z, z)
+		    if (i == ix && j == iy) {
+			call gseti (gp, G_PLCOLOR, HLCOLOR)
+			call gmark (gp, x, y, GM_BOX, -.8, -.8)
+			call gseti (gp, G_PLCOLOR, 1)
+		    }
+		    if (abs (wp2 - wp1) > .05) {
+			if (SF_AXIS(sf) == 1) {
+			    z =  0.25 * SF_POS(sfd) / max (abs(wp1), abs(wp2))
+			    call gadraw (gp, x+z, y)
+			} else {
+			    z = 0.25 * SF_POS(sfd) / max (abs(wp1), abs(wp2))
+			    call gadraw (gp, x, y+z)
+			}
+		    }
+		}
+	    }
+	}
+
+	if (nx <= 3 && ny <= 3) {
+	    call gsetr (gp, G_PLWIDTH, 2.)
+	    call gline (gp, wx1, wy1, wx1, wy1)
+	    do j = 1, ny {
+		do i = 1, nx {
+		    sfd = SFD(sf,i,j)
+		    if (SF_DEL(sfd) == NO) {
+			x = i
+			y = j
+			
+			call sprintf (Memc[str], SZ_LINE, "%.3g")
+			    call pargr (SF_FOC(sfd))
+			call gtext (gp, x+0.2, y+0.2, Memc[str], "h=l;v=c")
+			call sprintf (Memc[str], SZ_LINE, "%.2f")
+			    call pargr (SF_WID(sfd))
+			call gtext (gp, x+0.2, y-0.2, Memc[str], "h=l;v=c")
+			if (abs (SF_POS(sfd)) >= .01) {
+			    call sprintf (Memc[str], SZ_LINE, "%.2f")
+				call pargr (SF_POS(sfd))
+			    call gtext (gp, x+0.2, y, Memc[str], "h=l;v=c")
+			}
+		    }
+		}
+	    }
+	    call gsetr (gp, G_PLWIDTH, 1.)
+	}
+
+	if (SF_DATA(sf) == NULL) {
+	    call strcpy ("Best Focus at Each Sample", Memc[str], SZ_LINE)
+	} else {
+	    call sprintf (Memc[str], SZ_LINE, "Image %s with Focus %.3g")
+		call pargstr (SF_IMAGE(sf))
+		call pargr (SF_FOCUS(sf))
+	}
+	call gseti (gp, G_DRAWAXES, 0)
+	call gsview (gp, vx[1,1], vx[3,2], vy[1,1], vy[3,2])
+	call glabax (gp, Memc[str], "", "")
+
+	call sfree (sp)
+end
+
+
+# SPF_G2 -- Profiles at each sample for a given image
+
+procedure spf_g2 (gp, sfavg, sfbest, sfcur, ix, iy, lag)
+
+pointer	gp		# GIO pointer
+pointer	sfavg		# Average image
+pointer	sfbest		# Best image
+pointer	sfcur		# Current image
+int	ix, iy		# Sample
+int	lag		# Maximum lag
+
+int	i, j, nx, ny
+real	x1, x2, y1, y2, z1, z2, dz, vx, dvx, vy, dvy, p, x, fa[10], asieval()
+pointer	sp, str, sfd, asi
+
+begin
+	call smark (sp)
+	call salloc (str, SZ_LINE, TY_CHAR)
+
+	# Set range and draw axes
+	i = min (lag, nint (3 * SF_WIDTH(sfavg)))
+	x1 = -i
+	x2 = i
+	y1 = -0.05
+	y2 = 1.55
+	fa[1] = x1; fa[6] = y1
+	fa[2] = x2; fa[7] = y1
+	fa[3] = x2; fa[8] = y2
+	fa[4] = x1; fa[9] = y2
+	fa[5] = x1; fa[10] = y1
+	call gswind (gp, x1, x2, y1, y2)
+
+	call gseti (gp, G_DRAWTICKS, NO)
+	call sprintf (Memc[str], SZ_LINE, "Image %s with Focus %.3g")
+	    call pargstr (SF_IMAGE(sfcur))
+	    call pargr (SF_FOCUS(sfcur))
+	call glabax (gp, Memc[str], "", "")
+
+	# Set subviewport
+	nx = SF_NX(sfcur)
+	ny = SF_NY(sfcur)
+	call ggview (gp, vx, dvx, vy, dvy)
+	dvx = (dvx - vx) / nx
+	dvy = (dvy - vy) / ny
+
+	# Draw correlation profiles
+	do j = 1, ny {
+	    do i = 1, nx {
+		call gsview (gp, vx+(i-1)*dvx, vx+i*dvx, vy+(j-1)*dvy, vy+j*dvy)
+		call glabax (gp, "", "", "")
+
+		if (i == ix && j == iy) {
+		    call gsview (gp, vx+(i-1)*dvx+.005, vx+i*dvx-.005,
+			vy+(j-1)*dvy+.005, vy+j*dvy-.005)
+		    call gsetr (gp, G_PLWIDTH, HLWIDTH)
+		    call gseti (gp, G_PLCOLOR, HLCOLOR)
+		    call gpline (gp, fa, fa[6], 5)
+		    call gsetr (gp, G_PLWIDTH, 1.)
+		    call gseti (gp, G_PLCOLOR, 1)
+		}
+
+		sfd = SFD(sfcur,i,j)
+		if (SF_DEL(sfd) == NO) {
+		    asi = SF_ASI(sfd)
+		    p = sqrt (2.) * SF_POS(sfd)
+		    z1 = max (x1, x1-p)
+		    z2 = min (x2, x2-p)
+		    dz = 1
+		    for (x=nint(z1); x<=nint(z2); x=x+dz)
+			call gmark (gp, x+p, asieval (asi, x+lag+1),
+			    GM_PLUS, 2., 2.)
+		    call gamove (gp, z1+p, asieval (asi, z1+lag+1))
+		    dz = .1
+		    for (x=z1+dz; x<=z2; x=x+dz)
+			call gadraw (gp, x+p, asieval (asi, x+lag+1))
+		    if (sfcur != sfbest) {
+			asi = SF_ASI(SFD(sfbest,i,j))
+			call gamove (gp, z1+p, asieval (asi, z1+lag+1))
+			for (x=z1+dz; x<=z2; x=x+dz)
+			    call gadraw (gp, x+p, asieval (asi, x+lag+1))
+		    }
+
+		    call gseti (gp, G_PLTYPE, 3)
+		    call gline (gp, 0., 0., 0., 1.)
+		    call gseti (gp, G_PLTYPE, 1)
+
+		    if (nx <= NMAX && ny <= NMAX)
+			call spf_label (gp, sfd, 21, 2)
+		}
+	    }
+	}
+
+	call gswind (gp, 0.5, 0.5+nx, 0.5, 0.5+ny)
+	call gsview (gp, vx, vx+nx*dvx, vy, vy+ny*dvy)
+	call gamove (gp, 1., 1.)
+
+	call sfree (sp)
+end
+
+
+# SPF_G3 -- Width vs. Focus
+
+procedure spf_g3 (gp, sfavg, sfcur, sfs, nimages, ix, iy)
+
+pointer	gp			# GIO pointer
+pointer	sfavg			# Average image
+pointer	sfcur			# Current image
+pointer	sfs[nimages]		# Images
+int	nimages			# Number of images
+int	ix, iy			# Current sample
+
+int	i, j, k, mark
+real	x, x1, x2, dx, y, y1, y2, dy, size
+pointer	sf, sfd
+
+begin
+	# Determine data range
+	x1 = MAX_REAL
+	y1 = MAX_REAL
+	x2 = -MAX_REAL
+	y2 = -MAX_REAL
+	do i = 1, nimages {
+	    sf = sfs[i]
+	    do j = 1, SF_NSFD(sf) {
+		sfd = SFD(sf,j,1)
+		if (SF_DEL(sfd) == NO) {
+		    x = SF_FOC(sfd)
+		    y = SF_WID(sfd)
+		    x1 = min (x1, x)
+		    x2 = max (x2, x)
+		    y1 = min (y1, y)
+		    y2 = max (y2, y)
+		}
+	    }
+	}
+
+	dx = (x2 - x1)
+	dy = (y2 - y1)
+	x1 = x1 - dx * 0.05
+	x2 = x2 + dx * 0.05
+	y1 = y1 - dy * 0.05
+	y2 = y2 + dy * 0.05
+	call gswind (gp, x1, x2, y1, y2)
+	call glabax (gp, "Profile Width vs. Focus", "", "")
+
+	do k = 1, nimages {
+	    sf = sfs[k]
+	    do j = 1, SF_NY(sf) {
+		do i = 1, SF_NX(sf) {
+		    call gseti (gp, G_PLCOLOR, 1)
+		    if (sf == sfcur)
+			mark = GM_PLUS
+		    else
+			mark = GM_CROSS
+		    size = 2.
+		    if (sf == sfcur && i == ix && j == iy) {
+			call gseti (gp, G_PLCOLOR, HLCOLOR)
+			mark = mark + GM_BOX
+			size = 3.
+		    }
+		    sfd = SFD(sf,i,j)
+		    if (SF_DEL(sfd) == NO) {
+			x = SF_FOC(sfd)
+			y = SF_WID(sfd)
+			call gmark (gp, x, y, mark, size, size)
+		    }
+		}
+	    }
+	}
+
+	call gseti (gp, G_PLTYPE, 3)
+	x = INDEF
+	do k = 1, nimages {
+	    sf = sfs[k]
+	    sfd = SFD(sf,ix,iy)
+	    if (SF_DEL(sfd) == NO) {
+		if (!IS_INDEF(x))
+		    call gline (gp, x, y, SF_FOC(sfd), SF_WID(sfd))
+		x = SF_FOC(sfd)
+		y = SF_WID(sfd)
+	    }
+	}
+
+	call gseti (gp, G_PLTYPE, 2)
+	call gline (gp, SF_FOCUS(sfavg), y1, SF_FOCUS(sfavg), y2)
+	call gline (gp, x1, SF_WIDTH(sfavg), x2, SF_WIDTH(sfavg))
+	call gseti (gp, G_PLTYPE, 1)
+end
+
+
+# SPF_G4 -- Profiles at a given sample
+
+procedure spf_g4 (gp, sfavg, sfbest, sfcur, sfs, nimages, ix, iy, nx, ny, lag)
+
+pointer	gp		# GIO pointer
+pointer	sfavg		# Average image
+pointer	sfbest		# Best image
+pointer	sfcur		# Current image
+pointer	sfs[nimages]	# Images
+int	nimages		# Number of images
+int	ix, iy		# Sample
+int	nx, ny		# Grid layout
+int	lag		# Maximum lag
+
+int	i, j, k
+real	x1, x2, y1, y2, z1, z2, dz, p, x, fa[10], asieval()
+real	vx, dvx, vy, dvy
+pointer	sp, str, sf, sfd, asi
+
+begin
+	call smark (sp)
+	call salloc (str, SZ_LINE, TY_CHAR)
+
+	if (SF_NSFD(sfcur) > 1) {
+	    call sprintf (Memc[str], SZ_LINE,
+		"All Images at Sample [%d:%d,%d:%d]")
+		call pargi (SF_X1(sfcur)+(ix-1)*SF_DX(sfcur))
+		call pargi (SF_X1(sfcur)+ix*SF_DX(sfcur)-1)
+		call pargi (SF_Y1(sfcur)+(iy-1)*SF_DY(sfcur))
+		call pargi (SF_Y1(sfcur)+iy*SF_DY(sfcur)-1)
+	} else
+	     Memc[str] = EOS
+
+	# Set windows
+	i = min (lag, nint (3 * SF_WIDTH(sfavg)))
+	x1 = -i
+	x2 = i
+	y1 = -0.05
+	y2 = 1.55
+	call gswind (gp, x1, x2, y1, y2)
+	fa[1] = x1; fa[6] = y1
+	fa[2] = x2; fa[7] = y1
+	fa[3] = x2; fa[8] = y2
+	fa[4] = x1; fa[9] = y2
+	fa[5] = x1; fa[10] = y1
+
+	# Set subview port
+	call ggview (gp, vx, dvx, vy, dvy)
+	dvx = (dvx - vx) / nx
+	dvy = (dvy - vy) / ny
+
+	# Draw correlation profiles
+	k = 0
+	do i =  1, ny {
+	    do j = 1, nx {
+		k = k + 1
+		if (k > nimages)
+		    break
+		sf = sfs[k]
+		sfd = SFD(sf,ix,iy)
+
+		call gsview (gp, vx+(j-1)*dvx, vx+j*dvx,
+		    vy+(ny-i)*dvy, vy+(ny-i+1)*dvy)
+		call gfill (gp, fa, fa[6], 4, GF_SOLID)
+		if (sf == sfcur) {
+		    call gsview (gp, vx+(j-1)*dvx+.005, vx+j*dvx-.005,
+			vy+(ny-i)*dvy+.005, vy+(ny-i+1)*dvy-.005)
+		    call gsetr (gp, G_PLWIDTH, HLWIDTH)
+		    call gseti (gp, G_PLCOLOR, HLCOLOR)
+		    call gpline (gp, fa, fa[6], 5)
+		    call gsetr (gp, G_PLWIDTH, 1.)
+		    call gseti (gp, G_PLCOLOR, 1)
+		    call gsview (gp, vx+(j-1)*dvx, vx+j*dvx,
+			vy+(ny-i)*dvy, vy+(ny-i+1)*dvy)
+		}
+		call gseti (gp, G_DRAWAXES, 3)
+		call gseti (gp, G_DRAWTICKS, NO)
+		call glabax (gp, "", "", "")
+
+
+		if (SF_DEL(sfd) == NO) {
+		    asi = SF_ASI(sfd)
+		    p = sqrt (2.) * SF_POS(sfd)
+		    z1 = max (x1, x1-p)
+		    z2 = min (x2, x2-p)
+		    dz = 1
+		    for (x=nint(z1); x<=nint(z2); x=x+dz)
+			call gmark (gp, x+p, asieval (asi, x+lag+1),
+			    GM_PLUS, 2., 2.)
+		    call gamove (gp, z1+p, asieval (asi, z1+lag+1))
+		    dz = .1
+		    for (x=z1+dz; x<=z2; x=x+dz)
+			call gadraw (gp, x+p, asieval (asi, x+lag+1))
+		    if (sf != sfbest) {
+			asi = SF_ASI(SFD(sfbest,ix,iy))
+			call gamove (gp, z1+p, asieval (asi, z1+lag+1))
+			for (x=z1+dz; x<=z2; x=x+dz)
+			    call gadraw (gp, x+p, asieval (asi, x+lag+1))
+		    }
+
+		    call gseti (gp, G_PLTYPE, 3)
+		    call gline (gp, 0., 0., 0., 1.)
+		    call gseti (gp, G_PLTYPE, 1)
+
+		    if (nx <= NMAX && ny <= NMAX)
+			call spf_label (gp, sfd, 31, 2)
+		}
+	    }
+	}
+
+	call gsview (gp, vx, vx+nx*dvx, vy, vy+ny*dvy)
+	call gswind (gp, 0.5, 0.5+nx, 0.5+ny, 0.5)
+	call gamove (gp, 1., 1.)
+
+	# Draw label
+	call gseti (gp, G_DRAWAXES, 0)
+	call glabax (gp, Memc[str], "", "")
+
+	call sfree (sp)
+end
+
+
+# SPF_G5 -- Spectra at a given sample
+
+procedure spf_g5 (gp, sfcur, sfs, nimages, ix, iy, nx, ny)
+
+pointer	gp		# GIO pointer
+pointer	sfcur		# Current image
+pointer	sfs[nimages]	# Images
+int	nimages		# Number of images
+int	ix, iy		# Sample
+int	nx, ny		# Grid layout
+
+int	i, j, k, npts
+real	x1, x2, y1, y2, vx, dvx, vy, dvy, fa[10]
+pointer	sp, str, sf, sfd, spec
+
+begin
+	call smark (sp)
+	call salloc (str, SZ_LINE, TY_CHAR)
+
+	# Set subviewport parameters
+	call ggview (gp, vx, dvx, vy, dvy)
+	dvx = (dvx - vx) / nx
+	dvy = (dvy - vy) / ny
+
+	# Draw bounding box and label
+	if (SF_NSFD(sfcur) > 1) {
+	    call sprintf (Memc[str], SZ_LINE,
+		"All Images at Sample [%d:%d,%d:%d]")
+		call pargi (SF_X1(sfcur)+(ix-1)*SF_DX(sfcur))
+		call pargi (SF_X1(sfcur)+ix*SF_DX(sfcur)-1)
+		call pargi (SF_Y1(sfcur)+(iy-1)*SF_DY(sfcur))
+		call pargi (SF_Y1(sfcur)+iy*SF_DY(sfcur)-1)
+	} else
+		 Memc[str] = EOS
+
+	call gseti (gp, G_DRAWAXES, 0)
+	call gseti (gp, G_DRAWTICKS, NO)
+	call glabax (gp, Memc[str], "", "")
+	call gseti (gp, G_DRAWAXES, 3)
+
+	# Draw spectra
+	k = 0
+	do j = 1, ny {
+	    do i = 1, nx {
+		k = k + 1
+		if (k > nimages)
+		    break
+
+		sf = sfs[k]
+		sfd = SFD(sf, ix, iy)
+		spec = SF_SPEC(sfd)
+		if (SF_AXIS(sf) == 1)
+		    npts = SF_DX(sf)
+		else
+		    npts = SF_DY(sf)
+
+		x1 = 0.; x2 = 1.
+		call alimr (Memr[spec], npts, y1, y2)
+		y2 = y1 + (y2 - y1) * 1.5
+		fa[1] = x1; fa[6] = y1
+		fa[2] = x2; fa[7] = y1
+		fa[3] = x2; fa[8] = y2
+		fa[4] = x1; fa[9] = y2
+		fa[5] = x1; fa[10] = y1
+		call gswind (gp, x1, x2, y1, y2)
+
+		if (sf == sfcur) {
+		    call gsview (gp, vx+(i-1)*dvx+.005, vx+i*dvx-.005,
+			vy+(ny-j)*dvy+.005, vy+(ny-j+1)*dvy-.005)
+		    call gsetr (gp, G_PLWIDTH, HLWIDTH)
+		    call gseti (gp, G_PLCOLOR, HLCOLOR)
+		    call gpline (gp, fa, fa[6], 5)
+		    call gsetr (gp, G_PLWIDTH, 1.)
+		    call gseti (gp, G_PLCOLOR, 1)
+		}
+
+		call gsview (gp, vx+(i-1)*dvx, vx+i*dvx,
+		    vy+(ny-j)*dvy, vy+(ny-j+1)*dvy)
+		call glabax (gp, "", "", "")
+
+		if (SF_DEL(sfd) == NO) {
+		    call gvline (gp, Memr[spec], npts, x1, x2)
+
+		    if (nx <= NMAX && ny <= NMAX)
+			call spf_label (gp, sfd, 31, 2)
+		}
+	    }
+	}
+
+	call gsview (gp, vx, vx+nx*dvx, vy, vy+ny*dvy)
+	call gswind (gp, 0.5, 0.5+nx, 0.5+ny, 0.5)
+	call gamove (gp, 1., 1.)
+
+	call sfree (sp)
+end
+
+
+# SPF_G6 -- Spectra at a given image
+
+procedure spf_g6 (gp, sfcur, ix, iy)
+
+pointer	gp		# GIO pointer
+pointer	sfcur		# Current image
+int	ix, iy		# Sample
+
+int	i, j, nx, ny, npts
+real	x1, x2, y1, y2, vx, dvx, vy, dvy, fa[10]
+pointer	sp, str, sfd, spec
+
+begin
+	call smark (sp)
+	call salloc (str, SZ_LINE, TY_CHAR)
+
+	nx = SF_NX(sfcur)
+	ny = SF_NY(sfcur)
+	if (SF_AXIS(sfcur) == 1)
+	    npts = SF_DX(sfcur)
+	else
+	    npts = SF_DY(sfcur)
+
+	# Set subviewport parameters
+	call ggview (gp, vx, dvx, vy, dvy)
+	dvx = (dvx - vx) / nx
+	dvy = (dvy - vy) / ny
+
+	# Draw bounding box and label
+	call sprintf (Memc[str], SZ_LINE, "Image %s with Focus %.3g")
+	    call pargstr (SF_IMAGE(sfcur))
+	    call pargr (SF_FOCUS(sfcur))
+
+	call gseti (gp, G_DRAWTICKS, NO)
+	call glabax (gp, Memc[str], "", "")
+
+	# Draw spectra
+	do j = 1, ny {
+	    do i = 1, nx {
+		sfd = SFD(sfcur,i,j)
+		spec = SF_SPEC(sfd)
+
+		x1 = 0.; x2 = 1.
+		call alimr (Memr[spec], npts, y1, y2)
+		y2 = y1 + (y2 - y1) * 1.5
+		fa[1] = x1; fa[6] = y1
+		fa[2] = x2; fa[7] = y1
+		fa[3] = x2; fa[8] = y2
+		fa[4] = x1; fa[9] = y2
+		fa[5] = x1; fa[10] = y1
+		call gswind (gp, x1, x2, y1, y2)
+
+		if (i == ix && j == iy) {
+		    call gsview (gp, vx+(i-1)*dvx+.005, vx+i*dvx-.005,
+			vy+(j-1)*dvy+.005, vy+j*dvy-.005)
+		    call gsetr (gp, G_PLWIDTH, HLWIDTH)
+		    call gseti (gp, G_PLCOLOR, HLCOLOR)
+		    call gpline (gp, fa, fa[6], 5)
+		    call gsetr (gp, G_PLWIDTH, 1.)
+		    call gseti (gp, G_PLCOLOR, 1)
+		}
+
+		call gsview (gp, vx+(i-1)*dvx, vx+i*dvx, vy+(j-1)*dvy, vy+j*dvy)
+		call glabax (gp, "", "", "")
+
+		if (SF_DEL(sfd) == NO) {
+		    call gvline (gp, Memr[spec], npts, x1, x2)
+
+		    if (nx <= NMAX && ny <= NMAX)
+			call spf_label (gp, sfd, 21, 2)
+		}
+	    }
+	}
+
+	call gsview (gp, vx, vx+nx*dvx, vy, vy+ny*dvy)
+	call gswind (gp, 0.5, 0.5+nx, 0.5, 0.5+ny)
+	call gamove (gp, 1., 1.)
+
+	call sfree (sp)
+end
+
+
+# SPF_G7 -- Profile at a given image and sample
+
+procedure spf_g7 (gp, sfbest, sfcur, ix, iy, lag)
+
+pointer	gp		# GIO pointer
+pointer	sfbest		# Best image
+pointer	sfcur		# Current image
+int	ix, iy		# Sample
+int	lag		# Maximum lag
+
+real	x1, x2, y1, y2, z1, z2, dz, x, p, s, asieval()
+pointer	sp, str, sf, sfd, asi
+
+begin
+	call smark (sp)
+	call salloc (str, SZ_LINE, TY_CHAR)
+
+	sf = sfcur
+	sfd = SFD(sf,ix,iy)
+	asi = SF_ASI(sfd)
+
+	s = 1 / sqrt (2.)
+	x2 = s * min (lag, nint (3 * SF_WIDTH(sf)))
+	x1 = -x2
+	y1 = -0.05
+	y2 = 1.05
+	call gswind (gp, x1, x2, y1, y2)
+
+	if (abs (SF_POS(sfd)) > .01) {
+	    call sprintf (Memc[str], SZ_LINE,
+	    "%s at (%d, %d), Focus %.3g, Width %.2f, Shift %.2f")
+	    call pargstr (SF_IMAGE(sf))
+	    call pargr (SF_X(sfd))
+	    call pargr (SF_Y(sfd))
+	    call pargr (SF_FOC(sfd))
+	    call pargr (SF_WID(sfd))
+	    call pargr (SF_POS(sfd))
+	} else {
+	    call sprintf (Memc[str], SZ_LINE,
+		"%s at (%d, %d), Focus %.3g, Width %.2f")
+	    call pargstr (SF_IMAGE(sf))
+	    call pargr (SF_X(sfd))
+	    call pargr (SF_Y(sfd))
+	    call pargr (SF_FOC(sfd))
+	    call pargr (SF_WID(sfd))
+	}
+	call glabax (gp, Memc[str], "Pixel", "Correlation")
+
+	# Draw correlation profiles
+	if (SF_DEL(sfd) == NO) {
+	    p = SF_POS(sfd)
+	    z1 = max (x1, x1-p)
+	    z2 = min (x2, x2-p)
+	    dz = s
+	    for (x=s*nint(z1/s); x<=s*nint(z2/s); x=x+dz)
+		call gmark (gp, x+p, asieval (asi, x/s+lag+1), GM_PLUS, 2., 2.)
+	    call gamove (gp, z1+p, asieval (asi, z1/s+lag+1))
+	    dz = .1 * s
+	    for (x=z1+dz; x<=z2; x=x+dz)
+		call gadraw (gp, x+p, asieval (asi, x/s+lag+1))
+	    if (sf != sfbest) {
+		asi = SF_ASI(SFD(sfbest,ix,iy))
+		call gamove (gp, z1+p, asieval (asi, z1/s+lag+1))
+		for (x=z1+dz; x<=z2; x=x+dz)
+		    call gadraw (gp, x+p, asieval (asi, x/s+lag+1))
+	    }
+
+	    call gseti (gp, G_PLTYPE, 3)
+	    call gline (gp, 0., y1, 0., y2)
+	    call gseti (gp, G_PLTYPE, 1)
+	}
+
+	call sfree (sp)
+end
+
+
+# SPF_G8 -- Spatial distribution of widths
+
+procedure spf_g8 (gp, sfavg, sfcur, sfdcur, sfs, nimages, nxgrid, nygrid)
+
+pointer	gp		# GIO pointer
+pointer	sfavg		# Average image
+pointer	sfcur		# Current image
+pointer	sfdcur		# Current sample
+pointer	sfs[nimages]	# Images
+int	nimages		# Number of images
+int	nxgrid, nygrid	# Grid layout
+
+int	nx, ny
+int	i, j, k, l, m
+real	x, y, z, x1, x2, y1, y2, z1, z2, fa[10]
+pointer	sp, str, sf, sfd, kmin, kptr
+
+begin
+	call smark (sp)
+	call salloc (str, SZ_LINE, TY_CHAR)
+
+	# Set subviewport parameters
+	nx = SF_NX(sfavg)
+	ny = SF_NY(sfavg)
+	call ggview (gp, x1, x2, y1, y2)
+	x2 = (x2 - x1) / nxgrid
+	y2 = (y2 - y1) / nygrid
+	fa[1] = 0.; fa[6] = 0.
+	fa[2] = 1.; fa[7] = 0.
+	fa[3] = 1.; fa[8] = 1.
+	fa[4] = 0.; fa[9] = 1.
+	fa[5] = 0.; fa[10] = 0.
+
+	call gseti (gp, G_DRAWTICKS, NO)
+
+	# Find best focus at each sample and range of WID
+	call salloc (kmin, nx*ny, TY_INT)
+	kptr = kmin
+	z1 = MAX_REAL
+	z2 = -MAX_REAL
+	do j = 1, ny {
+	    do i = 1, nx {
+		l = 0
+		sfd = SFD(sfavg,i,j)
+		if (SF_DEL(sfd) == NO) {
+		    x = SF_FOC(sfd)
+		    y = MAX_REAL
+		    do k = 1, nimages {
+			sfd = SFD(sfs[k],i,j)
+			if (SF_DEL(sfd) == NO) {
+			    z1 = min (z1, SF_WID(sfd))
+			    z2 = max (z2, SF_WID(sfd))
+			    z = abs (SF_FOC(sfd) - x)
+			    if (z < y) {
+				l = k
+				y = z
+			    }
+			}
+		    }
+		}
+		Memi[kptr] = l
+		kptr = kptr + 1
+	    }
+	}
+	z2 = max (2., z2 - z1)
+
+	# Make graphs
+	k = 0
+	do j = 1, nygrid {
+	    do i = 1, nxgrid {
+		k = k + 1
+		if (k > nimages)
+		    break
+
+		sf = sfs[k]
+		nx = SF_NX(sfs[1])
+		ny = SF_NY(sfs[1])
+
+		if (sf == sfcur) {
+		    call gsview (gp, x1+(i-1)*x2+.005, x1+i*x2-.005,
+			y1+(nygrid-j)*y2+.005, y1+(nygrid-j+1)*y2-.005)
+		    call gswind (gp, 0., 1., 0., 1.)
+		    call gsetr (gp, G_PLWIDTH, HLWIDTH)
+		    call gseti (gp, G_PLCOLOR, HLCOLOR)
+		    call gpline (gp, fa, fa[6], 5)
+		    call gsetr (gp, G_PLWIDTH, 1.)
+		    call gseti (gp, G_PLCOLOR, 1)
+		}
+
+		call gsview (gp, x1+(i-1)*x2, x1+i*x2,
+		    y1+(nygrid-j)*y2, y1+(nygrid-j+1)*y2)
+		call gswind (gp, 0.5, 0.5+nx, 0.5, 1.5+ny)
+		call glabax (gp, "", "", "")
+
+		kptr = kmin
+		do m = 1, ny {
+		    do l = 1, nx {
+			sfd = SFD(sf,l,m)
+			if (SF_DEL(sfd) == NO) {
+			    x = l
+			    y = m
+			    z = SF_WID(sfd)
+			    z = 0.008 * (1 + (z - z1) / z2 * 3)
+			    call gmark (gp, x, y, GM_CIRCLE, z, z)
+			    if (Memi[kptr] == k)
+				call gmark (gp, x, y, GM_PLUS, z, z)
+			    if (sfd == sfdcur) {
+				call gseti (gp, G_PLCOLOR, HLCOLOR)
+				call gmark (gp, x, y, GM_BOX, -.8, -.8)
+				call gseti (gp, G_PLCOLOR, 1)
+			    }
+			}
+			kptr = kptr + 1
+		    }
+		}
+			
+		if (nxgrid <= NMAX && nygrid <= NMAX)
+		    call spf_label (gp, sfd, 11, 2)
+	    }
+	}
+
+	call gsview (gp, x1, x1+nxgrid*x2, y1, y1+nygrid*y2)
+	call gswind (gp, 0.5, 0.5+nxgrid, 0.5+nygrid, 0.5)
+	call gamove (gp, 1., 1.)
+
+	call sfree (sp)
+end
+
+
+# SPF_G9 -- Spectrum at a given image and sample
+
+procedure spf_g9 (gp, sfcur, ix, iy)
+
+pointer	gp		# GIO pointer
+pointer	sfcur		# Current image
+int	ix, iy		# Sample
+
+int	npts
+real	x1, x2
+pointer	sf, sfd, spec
+
+begin
+	sf = sfcur
+	sfd = SFD(sf,ix,iy)
+	spec = SF_SPEC(sfd)
+	if (SF_AXIS(sf) == 1) {
+	    npts = SF_DX(sf)
+	    x1 = SF_X1(sf) + (ix - 1) * npts
+	} else {
+	    npts = SF_DY(sf)
+	    x1 = SF_Y1(sf) + (iy - 1) * npts
+	}
+	x2 = x1 + npts - 1
+	call gswind (gp, x1, x2, INDEF, INDEF)
+	call gascale (gp, Memr[spec], npts, 2)
+
+	if (SF_AXIS(sf) == 1)
+	    call glabax (gp, "", "Column", "")
+	else
+	    call glabax (gp, "", "Line", "")
+	if (SF_DEL(sfd) == NO)
+	    call gvline (gp, Memr[spec], npts, x1, x2)
+end
+
+
+# SPF_LABEL -- Label
+
+procedure spf_label (gp, sfd, type, width)
+
+pointer	gp		# GIO pointer
+pointer	sfd		# Sample pointer
+int	type		# Label type
+int	width		# Line width
+
+int	bkup, gstati()
+real	x1, x2, y1, y2, xs, ys, x, y
+pointer	sp, str
+
+begin
+	call smark (sp)
+	call salloc (str, SZ_LINE, TY_CHAR)
+
+	bkup = gstati (gp, G_PLWIDTH)
+	call gseti (gp, G_PLWIDTH, width)
+	call ggwind (gp, x1, x2, y1, y2)
+	call ggscale (gp, x1, y1, xs, ys)
+	call gline (gp, x1, y1, x1, y1)
+
+	switch (type) {
+	case 11: # 1 across the top
+	    x = x2 - 0.01 * xs; y = y2 - 0.01 * ys
+	    call sprintf (Memc[str], SZ_LINE, "%.3g")
+		call pargr (SF_FOC(sfd))
+	    call gtext (gp, x, y, Memc[str], "h=r;v=t")
+	case 21: # 2 across the top
+	    x = x1 + 0.01 * xs; y = y2 - 0.01 * ys
+	    call sprintf (Memc[str], SZ_LINE, "%.2f")
+		call pargr (SF_WID(sfd))
+	    call gtext (gp, x, y, Memc[str], "h=l;v=t")
+	    if (abs (SF_POS(sfd)) >= .01) {
+		x = x2 - 0.01 * xs; y = y2 - 0.01 * ys
+		call sprintf (Memc[str], SZ_LINE, "%.2f")
+		    call pargr (SF_POS(sfd))
+		call gtext (gp, x, y, Memc[str], "h=r;v=t")
+	    }
+	case 31: # 3 across the top
+	    x = x1 + 0.01 * xs; y = y2 - 0.01 * ys
+	    call sprintf (Memc[str], SZ_LINE, "%.2f")
+		call pargr (SF_WID(sfd))
+	    call gtext (gp, x, y, Memc[str], "h=l;v=t")
+	    x = x2 - 0.01 * xs; y = y2 - 0.01 * ys
+	    call sprintf (Memc[str], SZ_LINE, "%.3g")
+		call pargr (SF_FOC(sfd))
+	    call gtext (gp, x, y, Memc[str], "h=r;v=t")
+	    if (abs (SF_POS(sfd)) >= .01) {
+		x = (x1 + x2) / 2; y = y2 - 0.01 * ys
+		call sprintf (Memc[str], SZ_LINE, "%.2f")
+		    call pargr (SF_POS(sfd))
+		call gtext (gp, x, y, Memc[str], "h=c;v=t")
+	    }
+	case 12: # 2 along the left
+	    x = x1 + 0.02 * xs; y = y2 - 0.02 * ys
+	    call sprintf (Memc[str], SZ_LINE, "%.2f")
+		call pargr (SF_WID(sfd))
+	    call gtext (gp, x, y, Memc[str], "h=l;v=t")
+	    if (abs (SF_POS(sfd)) >= .01) {
+		x = x1 + 0.02 * xs; y = y2 - 0.06 * ys
+		call sprintf (Memc[str], SZ_LINE, "%.2f")
+		    call pargr (SF_POS(sfd))
+		call gtext (gp, x, y, Memc[str], "h=l;v=t")
+	    }
+	case 13: # 3 along the left
+	    x = x1 + 0.02 * xs; y = y2 - 0.02 * ys
+	    call sprintf (Memc[str], SZ_LINE, "%.2f")
+		call pargr (SF_WID(sfd))
+	    call gtext (gp, x, y, Memc[str], "h=l;v=t")
+	    x = x1 + 0.02 * xs; y = y2 - 0.10 * ys
+	    call sprintf (Memc[str], SZ_LINE, "%.3g")
+		call pargr (SF_FOC(sfd))
+	    call gtext (gp, x, y, Memc[str], "h=l;v=t")
+	    if (abs (SF_POS(sfd)) >= .01) {
+		x = x1 + 0.02 * xs; y = y2 - 0.06 * ys
+		call sprintf (Memc[str], SZ_LINE, "%.2f")
+		    call pargr (SF_POS(sfd))
+		call gtext (gp, x, y, Memc[str], "h=l;v=t")
+	    }
+	}
+
+	call gseti (gp, G_PLWIDTH, bkup)
+
+	call sfree (sp)
+end
+
+
+# SPF_SAMPLE -- Find the nearest sample to the cursor position
+
+procedure spf_sample (sfs, nimages, del, wx, wy, i, j, k)
+
+pointer	sfs[nimages]	#I Images
+int	nimages		#I Number of images
+int	del		#I Deletion flag
+real	wx, wy		#I Cursor coordinate
+int	i, j, k		#O Nearest sample and image
+
+int	i1, j1, k1, k2
+real	r, rmin
+
+begin
+	rmin = MAX_REAL
+	k1 = k
+	do k2 = 0, 2 * nimages {
+	    if (mod (k2, 2) == 0)
+		k1 = k1 + k2
+	    else
+		k1 = k1 - k2
+	    if (k1 < 1 || k1 > nimages)
+		next
+	    do j1 = 1, SF_NY(sfs[k1]) {
+		do i1 = 1, SF_NX(sfs[k1]) {
+		    if (SF_DEL(SFD(sfs[k1],i1,j1)) == del) {
+			r = (i1 - wx) ** 2 + (j1 - wy) ** 2
+			if (r < rmin) {
+			    i = i1
+			    j = j1
+			    k = k1
+			    rmin = r
+			}
+		    }
+		}
+	    }
+
+	    if (rmin < MAX_REAL)
+		break
+	}
+end
diff --git a/noao/obsutil/src/specfocus/t_specfocus.x b/noao/obsutil/src/specfocus/t_specfocus.x
new file mode 100644
index 00000000..7f176de5
--- /dev/null
+++ b/noao/obsutil/src/specfocus/t_specfocus.x
@@ -0,0 +1,762 @@
+include	<error.h>
+include	<imhdr.h>
+include	<mach.h>
+include	<math.h>
+include	<math/curfit.h>
+include	<math/iminterp.h>
+include	"specfocus.h"
+
+
+# T_SPECFOCUS -- Spectral focusing task
+
+procedure t_specfocus ()
+
+int	list		# List of images
+pointer	fvals		# List of focus values
+int	dispaxis	# Default dispersion axis
+int	amin		# Lower edge of data along slit
+int	amax		# Upper edge of data along slit
+int	nspec		# Number of spectra to subdivide width
+int	ndisp		# Number of dispersion samples
+int	lag		# Maximum lag
+real	level		# Level for width
+bool	shifts		# Measure shifts?
+int	log		# Log file descriptor
+
+int	i, j, k, l, nimages, npix, nprep
+int	aaxis, a1, da, na
+int	baxis, b1, db, nb
+int	c1, dc, nc
+int	l1, dl, nl
+pointer	sp, image, sys
+pointer	rg, sfs, sf, sfd, sfavg, sfbest, im, mw, data, buf1, buf2
+pointer	rng_open(), immap(), imgl2r(), mw_openim()
+int	clgeti(), imgeti(), imtopenp(), imtlen(), imtgetim(), nowhite()
+int	rng_index(), open()
+real	rval, clgetr(), imgetr(), asumr()
+bool	ms, clgetb(), streq()
+errchk	immap, spf_width
+
+int	spf_compare()
+extern	spf_compare
+
+begin
+	call smark (sp)
+	call salloc (fvals, SZ_LINE, TY_CHAR)
+	call salloc (image, SZ_FNAME, TY_CHAR)
+	call salloc (sys, SZ_FNAME, TY_CHAR)
+
+	# Get task parameters (except log file)
+	list = imtopenp ("images")
+	call clgstr ("focus", Memc[fvals], SZ_LINE)
+	dispaxis = clgeti ("dispaxis")
+	amin = clgeti ("slit1")
+	amax = clgeti ("slit2")
+	nspec = clgeti ("nspectra")
+	ndisp = clgeti ("ndisp")
+	lag = (clgeti ("corwidth") + 1) / 2
+	level = clgetr ("level")
+	shifts = clgetb ("shifts")
+
+	if (level > 1.)
+	    level = level / 100.
+	level = max (0.05, min (0.95, level))
+
+	# Initialize focus values
+	if (nowhite (Memc[fvals], Memc[fvals], SZ_LINE) == 0)
+	    call strcpy ("1x1", Memc[fvals], SZ_LINE)
+	iferr (rg = rng_open (Memc[fvals], -MAX_REAL, MAX_REAL, 1.))
+	    rg = NULL
+
+	# Allocate array for the image focus data structure pointers
+	nimages = imtlen (list)
+	call malloc (sfs, nimages, TY_POINTER)
+
+	# Accumulate the focus data
+	nimages = 0
+	while (imtgetim (list, Memc[image], SZ_FNAME) != EOF) {
+	    im = immap (Memc[image], READ_ONLY, 0)
+	    mw = mw_openim (im)
+	    call mw_gsystem (mw, Memc[sys], SZ_FNAME)
+	    ms = streq (Memc[sys], "multispec")
+	    call mw_close (mw)
+
+	    # Set the focus value
+	    if (rg != NULL) {
+		if (rng_index (rg, nimages+1, rval) == EOF)
+		    call error (1, "Focus list ended prematurely")
+	    } else
+		rval = imgetr (im, Memc[fvals])
+
+	    # Set dispersion and cross dispersion axes
+	    if (ms) {
+		baxis = 1
+		aaxis = 2
+
+		# Set sampling across the dispersion axis
+		if (IS_INDEFI (amin))
+		    i = 1
+		else
+		    i = amin
+		if (IS_INDEFI (amax))
+		    j = IM_LEN(im,aaxis)
+		else
+		    j = amax
+		a1 = max (1, min (i, j))
+		da = min (IM_LEN(im,aaxis), max (i, j)) - a1 + 1
+		if (da < 1)
+		    call error (1, "Error in slit limits")
+		na = da
+		da = da / na
+
+		# Set sampling along the dispersion axis
+		npix = IM_LEN(im,baxis)
+		nb = min (ndisp, npix / 100)
+		db = npix / nb
+		b1 = 1 + (npix - nb * db) / 2
+
+		# Set sampling along the columns and lines
+		c1 = b1; dc = db; nc = nb
+		l1 = a1; dl = da; nl = na
+	    } else {
+		iferr (baxis = imgeti (im, "dispaxis"))
+		    baxis = dispaxis
+		aaxis = 3 - baxis
+
+		# Set sampling across the dispersion axis
+		if (IS_INDEFI (amin))
+		    i = 1
+		else
+		    i = amin
+		if (IS_INDEFI (amax))
+		    j = IM_LEN(im,aaxis)
+		else
+		    j = amax
+		a1 = max (1, min (i, j))
+		da = min (IM_LEN(im,aaxis), max (i, j)) - a1 + 1
+		if (da < 1)
+		    call error (1, "Error in slit limits")
+		na = min (nspec, da)
+		da = da / na
+
+		# Set sampling along the dispersion axis
+		npix = IM_LEN(im,baxis)
+		nb = min (ndisp, npix / 100)
+		db = npix / nb
+		b1 = 1 + (npix - nb * db) / 2
+
+		# Set sampling along the columns and lines
+		if (baxis == 1) {
+		    c1 = b1; dc = db; nc = nb
+		    l1 = a1; dl = da; nl = na
+		} else {
+		    c1 = a1; dc = da; nc = na
+		    l1 = b1; dl = db; nl = nb
+		}
+	    }
+
+	    # Check for consistency
+	    if (nimages > 0) {
+		if (baxis!=SF_AXIS(sf) ||
+		    c1!=SF_X1(sf) || dc!=SF_DX(sf) || nc!=SF_NX(sf) ||
+		    l1!=SF_Y1(sf) || dl!=SF_DY(sf) || nl!=SF_NY(sf))
+		    call error (1, "Input images have different formats")
+	    }
+
+	    # Allocate the focus data structure for the image
+	    call spf_alloc (sf, Memc[image], rval, level, baxis, npix, na,
+		c1, dc, nc, l1, dl, nl)
+
+	    # Get the spectrum samples
+	    if (baxis == 1) {
+		do i = 1, na {
+		    k = a1 + (i - 1) * da
+		    l = k + da - 1
+		    data = SF_DATA(sf) + (i - 1) * npix
+		    do j = k, l
+			call aaddr (Memr[imgl2r(im,j)], Memr[data], Memr[data],
+			    npix)
+		}
+	    } else {
+		do j = 1, npix {
+		    buf1 = imgl2r (im, j)
+		    data = SF_DATA(sf) + j - 1
+		    do i = 1, na {
+			k = a1 + (i - 1) * da
+			Memr[data] = asumr (Memr[buf1+k-1], da)
+			data = data + npix
+		    }
+		}
+	    }
+	    Memi[sfs+nimages] = sf
+	    nimages = nimages + 1
+
+	    call imunmap (im)
+	}
+
+	if (nimages == 0)
+	    call error (1, "No input data")
+
+	# Sort the structures
+	call qsort (Memi[sfs], nimages, spf_compare)
+
+	# Allocate structure for the best focus
+	call spf_alloc (sfavg, "Best", INDEF, level, baxis, 0, 0, c1, dc, nc,
+	    l1, dl, nl)
+
+	# Compute the correlations and profile width and position
+	nprep = db + 2 * lag
+	call malloc (buf1, nprep, TY_REAL)
+	call malloc (buf2, nprep, TY_REAL)
+	l = (na + 1) / 2
+	do k = 1, nimages {
+	    sf = Memi[sfs+k-1]
+	    do i = 1, nb {
+		if (baxis == 1)
+		    sfd = SFD(sf,i,l)
+		else
+		    sfd = SFD(sf,l,i)
+		call spf_prep (Memr[SF_SPEC(sfd)], db, Memr[buf1], nprep)
+		call spf_corr (Memr[buf1], Memr[buf1], nprep, lag,
+		    SF_ASI(sfd), SF_POS(sfd), SF_WID(sfd), SF_LEVEL(sf))
+		do j = 1, na {
+		    if (j != l) {
+			if (baxis == 1)
+			    sfd = SFD(sf,i,j)
+			else
+			    sfd = SFD(sf,j,i)
+			call spf_prep (Memr[SF_SPEC(sfd)], db, Memr[buf2],
+			    nprep)
+			call spf_corr (Memr[buf2], Memr[buf2], nprep, lag,
+			    SF_ASI(sfd), SF_POS(sfd), SF_WID(sfd), SF_LEVEL(sf))
+			if (shifts)
+			    call spf_corr (Memr[buf2], Memr[buf1], nprep,
+				lag, SF_ASI(sfd), SF_POS(sfd), rval,
+				SF_LEVEL(sf))
+		    }
+		}
+	    }
+	}
+	call mfree (buf1, TY_REAL)
+	call mfree (buf2, TY_REAL)
+
+	# Set the averages
+	call spf_fitfocus (Memi[sfs], nimages, sfavg, sfbest)
+
+	# Graph the results
+	call spf_graph (sfavg, sfbest, Memi[sfs], nimages, lag)
+
+	# Log the results
+	call spf_log (sfavg, sfbest, Memi[sfs], nimages, shifts, STDOUT)
+	call clgstr ("logfile", Memc[image], SZ_FNAME)
+	ifnoerr (log = open (Memc[image], APPEND, TEXT_FILE)) {
+	    call spf_log (sfavg, sfbest, Memi[sfs], nimages, shifts, log)
+	    call close (log)
+	}
+
+	# Finish up
+	do i = 1, nimages
+	    call spf_free (Memi[sfs+i-1])
+	call spf_free (sfavg)
+	call mfree (sfs, TY_POINTER)
+	call rng_close (rg)
+	call imtclose (list)
+	call sfree (sp)
+end
+
+
+# SPF_ALLOC -- Allocate a focus data structure for an image
+
+procedure spf_alloc (sf, image, focus, level, axis, ndisp, nspec,
+    x1, dx, nx, y1, dy, ny)
+
+pointer	sf		# Image focus data structure
+char	image[ARB]	# Image name
+real	focus		# Focus value
+real	level		# Level for width
+int	axis		# Dispersion axis
+int	ndisp		# Number of pixels (along dispersion)
+int	nspec		# Number of spectra (across dispersion)
+int	x1, dx, nx	# X sampling
+int	y1, dy, ny	# Y sampling
+
+int	i, j
+pointer	data, sfd
+
+begin
+	call calloc (sf, LEN_SF, TY_STRUCT)
+
+	call strcpy (image, SF_IMAGE(sf), SZ_SFFNAME)
+	SF_FOCUS(sf) = focus
+	SF_WIDTH(sf) = INDEF
+	SF_LEVEL(sf) = level
+	SF_AXIS(sf) = axis
+	SF_X1(sf) = x1
+	SF_DX(sf) = dx
+	SF_NX(sf) = nx
+	SF_Y1(sf) = y1
+	SF_DY(sf) = dy
+	SF_NY(sf) = ny
+	call malloc (SF_SFD(sf), nx*ny, TY_POINTER)
+	SF_NSFD(sf) = nx*ny
+	SF_NPIX(sf) = ndisp
+	if (ndisp > 0)
+	    call calloc (SF_DATA(sf), ndisp * nspec, TY_REAL)
+
+	data = SF_DATA(sf)
+	do j = 1, ny {
+	    do i = 1, nx {
+		call calloc (sfd, LEN_SFD, TY_STRUCT)
+		SFD(sf,i,j) = sfd
+		SF_X(sfd) = x1 + (i - 0.5) * dx
+		SF_Y(sfd) = y1 + (j - 0.5) * dy
+		if (ndisp > 0) {
+		    if (axis == 1)
+			SF_SPEC(sfd) = data + (j-1)*ndisp + (i-1)*dx + x1-1
+		    else
+			SF_SPEC(sfd) = data + (i-1)*ndisp + (j-1)*dy + y1-1
+		}
+		call asiinit (SF_ASI(sfd), II_SPLINE3)
+		SF_FOC(sfd) = focus
+		SF_WID(sfd) = INDEF
+		SF_POS(sfd) = INDEF
+		SF_DEL(sfd) = NO
+	    }
+	}
+end
+
+
+# SPF_FREE -- Free a focus image data structure
+
+procedure spf_free (sf)
+
+pointer	sf		# Image focus data structure
+
+int	i
+pointer	sfd
+
+begin
+	do i = 1, SF_NSFD(sf) {
+	    sfd = SFD(sf,i,1)
+	    call asifree (SF_ASI(sfd))
+	    call mfree (sfd, TY_STRUCT)
+	}
+	call mfree (SF_DATA(sf), TY_REAL)
+	call mfree (SF_SFD(sf), TY_POINTER)
+	call mfree (sf, TY_STRUCT)
+end
+
+
+# SPF_PREP -- Prepare spectra for correlation: fit continuum, subtract, taper
+
+procedure spf_prep (in, nin, out, nout)
+
+real	in[nin]			# Input spectrum
+int	nin			# Number of pixels in input spectrum
+real	out[nout]		# Output spectrum
+int	nout			# Number of pixels output spectrum (nin+2*lag)
+
+int	i, lag
+real	cveval()
+pointer	sp, x, w, ic, cv
+
+begin
+	call smark (sp)
+	call salloc (x, nin, TY_REAL)
+	call salloc (w, nin, TY_REAL)
+
+	call ic_open (ic)
+	call ic_pstr (ic, "function", "chebyshev")
+	call ic_puti (ic, "order", 3)
+	call ic_putr (ic, "low", 3.)
+	call ic_putr (ic, "high", 1.)
+	call ic_puti (ic, "niterate", 5)
+	call ic_putr (ic, "grow", 1.)
+	call ic_putr (ic, "xmin", 1.)
+	call ic_putr (ic, "xmax", real(nin))
+
+	do i = 1, nin {
+	    Memr[x+i-1] = i
+	    Memr[w+i-1] = 1
+	}
+	call ic_fit (ic, cv, Memr[x], in, Memr[w], nin, YES, YES, YES, YES)
+
+	lag = (nout - nin) / 2
+	do i = 1-lag, 0
+	    out[i+lag] = 0.
+	do i = 1, lag-1
+	    out[i+lag] = (1-cos (PI*i/lag))/2 * (in[i] - cveval (cv, real(i))) 
+	do i = lag, nin-lag+1
+	    out[i+lag] = (in[i] - cveval (cv, real(i))) 
+	do i = nin-lag+2, nin
+	    out[i+lag] = (1-cos (PI*(nin+1-i)/lag))/2 *
+		(in[i] - cveval (cv, real(i))) 
+	do i = nin+1, nin+lag
+	    out[i+lag] = 0.
+
+	call cvfree (cv)
+	call ic_closer (ic)
+	call sfree (sp)
+end
+
+
+# SPF_CORR -- Correlate spectra, fit profile, and measure center/width
+
+procedure spf_corr (spec1, spec2, npix, lag, asi, center, width, level)
+
+real	spec1[npix]		# First spectrum
+real	spec2[npix]		# Second spectrum
+int	npix			# Number of pixels in spectra
+int	lag			# Maximum correlation lag
+pointer	asi			# Pointer to correlation profile interpolator
+real	center			# Center of profile
+real	width			# Width of profile
+real	level			# Level at which width is determined
+
+int	i, j, nprof
+real	x, p, pmin, pmax, asieval()
+pointer	sp, prof
+
+begin
+	nprof = 2 * lag + 1
+
+	call smark (sp)
+	call salloc (prof, nprof, TY_REAL)
+
+	do j = -lag, lag {
+	    p = 0.
+	    do i = 1+lag, npix-lag
+		p = p + spec1[i] * spec2[i-j]
+	    Memr[prof+j+lag] = p
+	}
+
+	# Fit interpolator
+	call asifit (asi, Memr[prof], nprof)
+
+	# Find the minimum and maximum
+	center = 1.
+	pmin = asieval (asi, 1.)
+	pmax = pmin
+	for (x=1; x<=nprof; x=x+.01) {
+	    p = asieval (asi, x)
+	    if (p < pmin)
+		pmin = p
+	    if (p > pmax) {
+		pmax = p
+		center = x
+	    }
+	}
+
+	# Normalize
+	pmax = pmax - pmin
+	do i = 0, nprof-1
+	    Memr[prof+i] = (Memr[prof+i] - pmin) / pmax
+
+	call asifit (asi, Memr[prof], nprof)
+
+	# Find the equal flux points
+	for (x=center; x>=1 && asieval (asi,x)>level; x=x-0.01)
+	    ;
+	width = x
+	for (x=center; x<=nprof && asieval (asi,x)>level; x=x+0.01)
+	    ;
+	width = (x - width - 0.01) / sqrt (2.)
+	center = center - lag - 1
+
+	call sfree (sp)
+end
+
+
+# SPF_FITFOCUS -- Find the best focus at each sample and the average over all
+# samples.
+
+procedure spf_fitfocus (sfs, nimages, sfavg, sfbest)
+
+pointer	sfs[nimages]		#I Images
+int	nimages			#I Number of images
+pointer	sfavg			#U Average image
+pointer	sfbest			#U Best focus image
+
+int	i, j, n, jmin, nims
+pointer	sp, x, y, z, sfd
+real	focus, fwhm, pos, foc
+bool	fp_equalr()
+
+define	avg_	10
+
+begin
+	call smark (sp)
+	call salloc (x, nimages, TY_REAL)
+	call salloc (y, nimages, TY_REAL)
+	call salloc (z, nimages, TY_REAL)
+
+	do i = 1, SF_NSFD(sfavg) {
+	    # Collect the focus values
+	    nims = 0
+	    do j = 1, nimages {
+		sfd = SFD(sfs[j],i,1)
+		if (SF_DEL(sfd) == NO) {
+		    Memr[x+nims] = SF_FOC(sfd)
+		    Memr[y+nims] = SF_WID(sfd)
+		    Memr[z+nims] = SF_POS(sfd)
+		    nims = nims + 1
+		}
+	    }
+	    sfd = SFD(sfavg,i,1)
+
+	    # Take the smallest width at each unique focus.
+	    if (nims > 0) {
+		call xt_sort3 (Memr[x], Memr[y], Memr[z], nims)
+		n = 0
+		do j = 1, nims-1 {
+		    if (fp_equalr (Memr[x+n], Memr[x+j])) {
+			if (Memr[y+n] > Memr[y+j]) {
+			    Memr[y+n] = Memr[y+j]
+			    Memr[z+n] = Memr[z+j]
+			}
+		    } else {
+			n = n + 1
+			Memr[x+n] = Memr[x+j]
+			Memr[y+n] = Memr[y+j]
+			Memr[z+n] = Memr[z+j]
+		    }
+		}
+
+		# Find the minimum width
+		jmin = 0
+		do j = 1, n
+		    if (Memr[y+j] < Memr[y+jmin])
+			jmin = j
+
+		# Use parabolic interpolation to find the best focus
+		if (jmin == 0 || jmin == n) {
+		    focus = Memr[x+jmin]
+		    fwhm = Memr[y+jmin]
+		    pos = Memr[z+jmin]
+		} else
+		    call spf_parab (Memr[x+jmin-1], Memr[y+jmin-1],
+			Memr[z+jmin-1], focus, fwhm, pos)
+
+		SF_FOC(sfd) = focus
+		SF_WID(sfd) = fwhm
+		SF_POS(sfd) = pos
+		SF_DEL(sfd) = NO
+	    } else {
+		SF_FOC(sfd) = INDEF
+		SF_WID(sfd) = INDEF
+		SF_POS(sfd) = INDEF
+		SF_DEL(sfd) = YES
+	    }
+	}
+
+	call sfree (sp)
+
+avg_
+	# Set the averages over all samples
+	n = 0
+	focus = 0.
+	fwhm = 0.
+	do i = 1, SF_NSFD(sfavg) {
+	    sfd = SFD(sfavg,i,1)
+	    if (SF_DEL(sfd) == NO) {
+		focus = focus + SF_FOC(sfd)
+		fwhm = fwhm + SF_WID(sfd)
+		n = n + 1
+	    }
+	}
+
+	if (n > 0) {
+	    SF_FOCUS(sfavg) = focus / n
+	    SF_WIDTH(sfavg) = fwhm / n
+	} else {
+	    SF_FOCUS(sfavg) = INDEF
+	    SF_WIDTH(sfavg) = INDEF
+	}
+
+	do j = 1, nimages {
+	    n = 0
+	    focus = 0.
+	    fwhm = 0.
+	    do i = 1, SF_NSFD(sfs[j]) {
+		sfd = SFD(sfs[j],i,1)
+		if (SF_DEL(sfd) == NO) {
+		    fwhm = fwhm + SF_WID(sfd)
+		    n = n + 1
+		}
+	    }
+
+	    if (n > 0)
+		SF_WIDTH(sfs[j]) = fwhm / n
+	    else
+		SF_WIDTH(sfs[j]) = INDEF
+	}
+
+	# Set the best focus image
+	sfbest = NULL
+	focus = SF_FOCUS(sfavg)
+	if (!IS_INDEF(focus)) {
+	    pos = MAX_REAL
+	    do j = 1, nimages {
+		foc = SF_FOCUS(sfs[j])
+		if (!IS_INDEF(foc)) {
+		    fwhm = abs (focus - foc)
+		    if (fwhm < pos) {
+			pos = fwhm
+			sfbest = sfs[j]
+		    }
+		}
+	    }
+	}
+end
+
+
+# SPF_PARAB -- Find the minimum of a parabolic fit to three points.
+
+procedure spf_parab (x, y, z, xmin, ymin, zmin)
+
+real	x[3]
+real	y[3]
+real	z[3]
+real	xmin
+real	ymin
+real	zmin
+
+real	x12, x13, x23, x212, x213, x223, y12, y13, y23, a, b, c
+
+begin
+	x12 = x[1] - x[2]
+	x13 = x[1] - x[3]
+	x23 = x[2] - x[3]
+	x212 = x[1] * x[1] - x[2] * x[2]
+	x213 = x[1] * x[1] - x[3] * x[3]
+	x223 = x[2] * x[2] - x[3] * x[3]
+	y12 = y[1] - y[2]
+	y13 = y[1] - y[3]
+	y23 = y[2] - y[3]
+	c = (y13 - y23 * x13 / x23) / (x213 - x223 * x13 / x23)
+	b = (y23 - c * x223) / x23
+	a = y[3] - b * x[3] - c * x[3] * x[3]
+	xmin = -b / (2 * c)
+	ymin = a + b * xmin + c * xmin * xmin
+
+	if (xmin < x[2])
+	    zmin = z[2] + (z[1] - z[2]) / (x[1] - x[2]) * (xmin - x[2])
+	else
+	    zmin = z[2] + (z[3] - z[2]) / (x[3] - x[2]) * (xmin - x[2])
+end
+
+
+# SPF_COMPARE -- Compare two structures by focus values
+
+int procedure spf_compare (sf1, sf2)
+
+pointer	sf1, sf2	# Structures to be compared.
+
+begin
+	if (SF_FOCUS[sf1] < SF_FOCUS[sf2])
+	    return (-1)
+	else if (SF_FOCUS[sf1] > SF_FOCUS[sf2])
+	    return (1)
+	else
+	    return (0)
+end
+
+
+# SPF_LOG -- Print log of results
+
+procedure spf_log (sfavg, sfbest, sfs, nimages, shifts, log)
+
+pointer	sfavg			# Average image
+pointer	sfbest			# Best focus image
+pointer	sfs[nimages]		# Images
+int	nimages			# Number of images
+bool	shifts			# Measure shifts?
+int	log			# Log file descriptor
+
+int	i, j
+pointer	sp, str, sfd
+
+begin
+	call smark (sp)
+	call salloc (str, SZ_LINE, TY_CHAR)
+
+	call sysid (Memc[str], SZ_LINE)
+	call fprintf (log, "SPECFOCUS: %s\n")
+	    call pargstr (Memc[str])
+
+	call fprintf (log,
+    "  Best average focus at %g with average width of %.2f at %d%% of peak\n\n")
+	    call pargr (SF_FOCUS(sfavg))
+	    call pargr (SF_WIDTH(sfavg))
+	    call pargr (100 * SF_LEVEL(sfavg))
+
+	call fprintf (log, "  -- Average Over All Samples\n\n")
+	call fprintf (log, "\t%25wImage  Focus  Width\n")
+	do i = 1, nimages {
+	    call fprintf (log, "\t%30s  %5.3g  %5.2f\n")
+		call pargstr (SF_IMAGE(sfs[i]))
+		call pargr (SF_FOCUS(sfs[i]))
+		call pargr (SF_WIDTH(sfs[i]))
+	}
+	call fprintf (log, "\n")
+
+	call fprintf (log, "  -- Image %s at Focus %g --\n")
+	    call pargstr (SF_IMAGE(sfbest))
+	    call pargr (SF_FOCUS(sfbest))
+
+	if (SF_NSFD(sfbest) > 1) {
+	    call fprintf (log, "\n\n\tWidth at %d%% of Peak:\n")
+		call pargr (100 * SF_LEVEL(sfavg))
+	    call fprintf (log, "\n\t%9w    Columns\n\t%9w  ")
+	    do i = 1, SF_NX(sfbest) {
+		call fprintf (log, "  %4d-%-4d")
+		    call pargi (SF_X1(sfbest)+(i-1)*SF_DX(sfbest))
+		    call pargi (SF_X1(sfbest)+i*SF_DX(sfbest)-1)
+	    }
+	    call fprintf (log, "\n\t   Lines  +")
+	    do i = 1, SF_NX(sfbest)
+		call fprintf (log, "-----------")
+	    do j = 1, SF_NY(sfbest) {
+		if (SF_DY(sfbest) > 1.) {
+		    call fprintf (log, "\n\t%4d-%-4d |")
+			call pargi (SF_Y1(sfbest)+(j-1)*SF_DY(sfbest))
+			call pargi (SF_Y1(sfbest)+j*SF_DY(sfbest)-1)
+		} else {
+		    call fprintf (log, "\n\t%9d |")
+			call pargi (SF_Y1(sfbest)+(j-1)*SF_DY(sfbest))
+			call pargi (SF_Y1(sfbest)+j*SF_DY(sfbest)-1)
+		}
+		do i = 1, SF_NX(sfbest) {
+		    sfd = SFD(sfbest,i,j)
+		    call fprintf (log, "   %5.2f   ")
+			call pargr (SF_WID(sfd))
+		}
+	    }
+	    if (shifts) {
+		call fprintf (log, 
+		    "\n\n\tPosition Shifts Relative To Central Sample:\n")
+		call fprintf (log, "\n\t%9w    Columns\n\t%9w  ")
+		do i = 1, SF_NX(sfbest) {
+		    call fprintf (log, "  %4d-%-4d")
+			call pargi (SF_X1(sfbest)+(i-1)*SF_DX(sfbest))
+			call pargi (SF_X1(sfbest)+i*SF_DX(sfbest)-1)
+		}
+		call fprintf (log, "\n\t   Lines  +")
+		do i = 1, SF_NX(sfbest)
+		    call fprintf (log, "-----------")
+		do j = 1, SF_NY(sfbest) {
+		    call fprintf (log, "\n\t%4d-%-4d |")
+			call pargi (SF_Y1(sfbest)+(j-1)*SF_DY(sfbest))
+			call pargi (SF_Y1(sfbest)+j*SF_DY(sfbest)-1)
+		    do i = 1, SF_NX(sfbest) {
+			sfd = SFD(sfbest,i,j)
+			call fprintf (log, "   %5.2f   ")
+			    call pargr (SF_POS(sfd))
+		    }
+		}
+	    }
+	}
+	call fprintf (log, "\n\n")
+	    
+	call sfree (sp)
+end
diff --git a/noao/obsutil/src/specfocus/x_specfocus.f b/noao/obsutil/src/specfocus/x_specfocus.f
new file mode 100644
index 00000000..12500041
--- /dev/null
+++ b/noao/obsutil/src/specfocus/x_specfocus.f
@@ -0,0 +1,146 @@
+      integer function sysruk (task, cmd, rukarf, rukint)
+      integer rukarf
+      integer rukint
+      integer*2 task(*)
+      integer*2 cmd(*)
+      integer i
+      integer ntasks
+      integer lmarg
+      integer rmarg
+      integer maxch
+      integer ncol
+      integer rukean
+      integer envgei
+      integer envscn
+      logical streq
+      logical xerpop
+      logical xerflg
+      common /xercom/ xerflg
+      integer iyy
+      integer dp(2)
+      integer*2 dict(10)
+      integer*2 st0001(9)
+      integer*2 st0002(6)
+      integer*2 st0003(3)
+      integer*2 st0004(6)
+      integer*2 st0005(6)
+      integer*2 st0006(4)
+      integer*2 st0007(6)
+      integer*2 st0008(2)
+      integer*2 st0009(29)
+      integer*2 st0010(25)
+      save
+      data (dict(iyy),iyy= 1, 8) /115,112,101, 99,102,111, 99,117/
+      data (dict(iyy),iyy= 9,10) /115, 0/
+      data (st0001(iyy),iyy= 1, 8) /116,116,121,110, 99,111,108,115/
+      data (st0001(iyy),iyy= 9, 9) / 0/
+      data st0002 / 99,104,100,105,114, 0/
+      data st0003 / 99,100, 0/
+      data st0004 /104,111,109,101, 36, 0/
+      data st0005 / 72, 79, 77, 69, 36, 0/
+      data st0006 /115,101,116, 0/
+      data st0007 /114,101,115,101,116, 0/
+      data st0008 / 9, 0/
+      data (st0009(iyy),iyy= 1, 8) /105,110,118, 97,108,105,100, 32/
+      data (st0009(iyy),iyy= 9,16) /115,101,116, 32,115,116, 97,116/
+      data (st0009(iyy),iyy=17,24) /101,109,101,110,116, 58, 32, 39/
+      data (st0009(iyy),iyy=25,29) / 37,115, 39, 10, 0/
+      data (st0010(iyy),iyy= 1, 8) /105,110,118, 97,108,105,100, 32/
+      data (st0010(iyy),iyy= 9,16) / 83, 69, 84, 32,105,110, 32, 73/
+      data (st0010(iyy),iyy=17,24) / 82, 65, 70, 32, 77, 97,105,110/
+      data (st0010(iyy),iyy=25,25) / 0/
+      data (dp(iyy),iyy= 1, 2) / 1, 0/
+      data lmarg /5/, maxch /0/, ncol /0/, rukean /3/
+      data ntasks /0/
+         if (.not.(ntasks .eq. 0)) goto 110
+            i=1
+120         if (.not.(dp(i) .ne. 0)) goto 122
+121            i=i+1
+               goto 120
+122         continue
+            ntasks = i - 1
+110      continue
+         if (.not.(task(1) .eq. 63)) goto 130
+            call xerpsh
+            rmarg = envgei (st0001)
+            if (.not.xerpop()) goto 140
+               rmarg = 80
+140         continue
+            call strtbl (4, dict, dp, ntasks, lmarg, rmarg, maxch, ncol)
+            sysruk = (0)
+            goto 100
+130      continue
+         if (.not.(streq(task,st0002) .or. streq(task,st0003))) goto 150
+            call xerpsh
+            if (.not.(cmd(rukarf) .eq. 0)) goto 170
+               call xerpsh
+               call xfchdr(st0004)
+               if (.not.xerpop()) goto 180
+                  call xfchdr(st0005)
+180            continue
+               goto 171
+170         continue
+               call xfchdr(cmd(rukarf))
+171         continue
+162         if (.not.xerpop()) goto 160
+               if (.not.(rukint .eq. 1)) goto 190
+                  call erract (rukean)
+                  if (xerflg) goto 100
+                  goto 191
+190            continue
+191            continue
+160         continue
+            sysruk = (0)
+            goto 100
+150      continue
+         if (.not.(streq(task,st0006) .or. streq(task,st0007))) goto 200
+            call xerpsh
+            if (.not.(cmd(rukarf) .eq. 0)) goto 220
+               call envlit (4, st0008, 1)
+               call xffluh(4)
+               goto 221
+220         continue
+            if (.not.(envscn (cmd) .le. 0)) goto 230
+               if (.not.(rukint .eq. 1)) goto 240
+                  call eprinf (st0009)
+                  call pargsr (cmd)
+                  goto 241
+240            continue
+                  goto 91
+241            continue
+230         continue
+221         continue
+212         if (.not.xerpop()) goto 210
+               if (.not.(rukint .eq. 1)) goto 250
+                  call erract (rukean)
+                  if (xerflg) goto 100
+                  goto 251
+250            continue
+91                call syspac (0, st0010)
+251            continue
+210         continue
+            sysruk = (0)
+            goto 100
+200      continue
+151      continue
+131      continue
+         if (.not.(streq (task, dict(dp(1))))) goto 260
+            call tspecs
+            sysruk = (0)
+            goto 100
+260      continue
+         sysruk = (-1)
+         goto 100
+100      return
+      end
+c     rukint  ruk_interact
+c     sysruk  sys_runtask
+c     envscn  envscan
+c     tspecs  t_specfocus
+c     envgei  envgeti
+c     syspac  sys_panic
+c     eprinf  eprintf
+c     rukarf  ruk_argoff
+c     rukean  ruk_eawarn
+c     pargsr  pargstr
+c     envlit  envlist
diff --git a/noao/obsutil/src/specfocus/x_specfocus.x b/noao/obsutil/src/specfocus/x_specfocus.x
new file mode 100644
index 00000000..063f2ce6
--- /dev/null
+++ b/noao/obsutil/src/specfocus/x_specfocus.x
@@ -0,0 +1 @@
+task    specfocus	= t_specfocus
diff --git a/noao/obsutil/src/sptime/Revisions b/noao/obsutil/src/sptime/Revisions
new file mode 100644
index 00000000..67cc787b
--- /dev/null
+++ b/noao/obsutil/src/sptime/Revisions
@@ -0,0 +1,81 @@
+.help revisions Jun01 spectime
+.nf
+
+t_sptime.x
+    1.  The use of the fiber diameter to set the aperture was not working.
+    2.  The listing of the fiber information was not working because it was
+	looking for a table "fibers" instead of "fiber".
+    3.  Fixed typo in label "indivdual" -> "individual".
+    (8/13/04, Valdes)
+
+============================
+SPECTIME V2.2: May 15, 2003
+============================
+
+t_sptime.x
+sptime.par
+sptime.h
+    1.  Improved algorithm for handling saturation.
+    2.  Added a minimum exposure parameter.
+    (5/15/03, Valdes)
+
+t_sptime.x
+    The thermal background calculation was wrong.  (3/17/03, Valdes)
+
+============================
+SPECTIME V2.1: March 3, 2003
+============================
+
+sptime.h
+t_sptime.x
+sptime.par
+../doc/sptime.hlp
+    Added a "shuffle" option for the sky subtraction.  This assumes half
+    the cycle is object and half is sky and the same number of pixels are
+    used for both.  The times in the calculator are the total time
+    (object+sky).  (2/10/03)
+
+specpars.par
+    The choices for aperture type listed "cicle" instead of the correct
+    "circular".  (2/10/03, Valdes)
+
+t_cgiparse.x	+
+mkpkg
+x_spectime.x
+../../obsutil.cl
+    Task to parse the CGI QUERY_STRING and set task parameters.
+    (4/19/02, Valdes)
+
+============================
+SPECTIME V2.0: August 15, 2001
+============================
+
+Greatly revised version.
+
+t_sptime.x
+    Fixed a type mismatch in a max() function.  (6/13/02, Valdes)
+
+============================
+SPECTIME V1.2: June 13, 2001
+============================
+
+mkpkg
+    Added missing dependencies for t_sptime.x and tabinterp.x  (12/13/01, MJF)
+
+t_sptime.x
+sptime.par
+sptime.h
+mkpkg
+    1. Added "units" parameter to allow different dispersion units.
+       This requires linking with libsmw.a from the noao package.
+    2. Added IR bands.
+    3. Changed so that transmisions of 1 are not reported.
+    4. Added a parameter to the filter to override order overlap message.
+       The idea is that a single filter function can be used without requiring
+       the user to chose the filter.
+    (6/13/01, Valdes)
+
+================================
+SPECTIME V1.1: February 11, 2000
+================================
+.endhelp
diff --git a/noao/obsutil/src/sptime/abzero.cl b/noao/obsutil/src/sptime/abzero.cl
new file mode 100644
index 00000000..c8b3e76b
--- /dev/null
+++ b/noao/obsutil/src/sptime/abzero.cl
@@ -0,0 +1,10 @@
+procedure abzero (w, logf)
+
+real	w		{prompt="Wavelength (microns)"}
+real	logf		{prompt="Log f_lambda (W/cm^2/micron)"}
+
+begin
+	x = 10000 * w
+	y = -2.5 * (logf + 3) - 5 * log10 (x) - 2.4
+	printf ("%d %.3f\n", x, y)
+end
diff --git a/noao/obsutil/src/sptime/blazeang.cl b/noao/obsutil/src/sptime/blazeang.cl
new file mode 100644
index 00000000..2c55b3a2
--- /dev/null
+++ b/noao/obsutil/src/sptime/blazeang.cl
@@ -0,0 +1,24 @@
+procedure blazeang (g, w)
+
+real	g = 316		{prompt="l/mm"}
+real	w = 7500	{prompt="Blaze wavelength (A)"}
+real	phi = 46.	{prompt="Camera-collimator angle (deg)"}
+real	m = 1		{prompt="Order"}
+real	n = 1.		{prompt="Index of refraction"}
+real	prism = 22	{prompt="Prism angle (deg)"}
+
+begin
+	real	dtor, val
+
+	dtor = 3.14159 / 180.
+
+	if (n <= 1.) {
+	    val = g * w * m  / cos (phi/2*dtor) / 2e7
+	    val = atan2 (val, sqrt (1 - val**2)) / dtor
+	} else {
+#	    val = g * w * m  / 1e7 / (n - 1.)
+#	    val = atan2 (val, sqrt (1 - val**2)) / dtor
+	    val = g * w * m / 1e7 / sin (dtor * prism) + 1
+	}
+	printf ("%.4g\n", val)
+end
diff --git a/noao/obsutil/src/sptime/blazefunc.cl b/noao/obsutil/src/sptime/blazefunc.cl
new file mode 100644
index 00000000..31416fc7
--- /dev/null
+++ b/noao/obsutil/src/sptime/blazefunc.cl
@@ -0,0 +1,76 @@
+procedure blazefunc (grating, order)
+
+file	grating			{prompt="Grating"}
+int	order = INDEF		{prompt="Order"}
+real	camcolangle = 45.	{prompt="Camera-grating-collimator angle (deg)"}
+string	search = "spectimedb$KPNO/Gratings" {prompt="Directory search list\n"}	
+
+string	title = ""		{prompt="Title"}
+real	w1 = 3000.		{prompt="Lower wavelength to plot"}
+real	w2 = 12000.		{prompt="Upper wavelength to plot\n"}
+
+real	x1 = 3000.		{prompt="Left graph wavelength"}
+real	x2 = 12000.		{prompt="Right graph wavelength"}
+real	y1 = -5.		{prompt="Bottom graph efficiency"}
+real	y2 = 105.		{prompt="Top graph efficiency"}
+string	ltype = "1"		{prompt="Line type"}
+string	color = "1"		{prompt="Color"}
+bool	append = no		{prompt="Append?"}
+
+struct	*fd
+
+begin
+	file	tmp1, tmp2
+	real	x, y
+
+	tmp1 = mktemp ("tmp$iraf")
+	tmp2 = mktemp ("tmp$iraf")
+
+	# Spectrograph.
+	print ("# area = 1", >> tmp1)
+	print ("# scale = 1", >> tmp1)
+	print ("# fl = 1", >> tmp1)
+	print ("# ndisp = 2000", >> tmp1)
+	print ("# pixsize = 1", >> tmp1)
+
+	sptime (time=1., maxexp=3600., sn=25., spectrum="blackbody",
+	    sky="", sensfunc="none", airmass=1., seeing=1., phase=0.,
+	    temperature=6000., index=0., refwave=INDEF, refflux=10.,
+	    funits="AB", abjohnson="none", wave=INDEF, order=order,
+	    xorder=INDEF, width=1., length=1., diameter=1.,
+	    inoutangle=camcolangle, xinoutangle=INDEF, xbin=1, ybin=1,
+	    search=search, spectrograph=tmp1, filter="none",
+	    filter2="none", disperser=grating, xdisperser="none",
+	    fiber="none", telescope=tmp1, adc="none", collimator=tmp1,
+	    corrector="none", camera=tmp1, detector=tmp1, aperture=tmp1,
+	    extinction="", gain=1., rdnoise=0., dark=0., skysub="none",
+	    nskyaps=10, output="disperser", list=tmp2, graphics="",
+	    interactive=no, nw=1000, > "dev$null")
+
+	delete (tmp1, verify-)
+
+	fd = tmp2
+	while (fscan (fd, x, y) != EOF) {
+	    if (nscan() != 2)
+		next
+	    if (x < w1 || x > w2)
+		next
+	    print (x, y, >> tmp1)
+	}
+	fd = ""
+
+	if (title == "")
+	    title = grating
+
+	graph (tmp1, wx1=x1, wx2=x2, wy1=y1, wy2=y2, wcs="logical", axis=1,
+	    transpose=no, pointmode=no, marker="box", szmarker=0.005,
+	    ltypes=ltype, colors=color, logx=no, logy=no, box=yes,
+	    ticklabels=yes, xlabel="Wavelength (A)", ylabel="Efficiency (%)",
+	    xformat="wcsformat", yformat="", title=title,
+	    lintran=no, p1=0., p2=0., q1=0., q2=1., vx1=0., vx2=0., vy1=0.,
+	    vy2=0., majrx=5, minrx=5, majry=7, minry=5, overplot=no,
+	    append=append, device="stdgraph", round=no, fill=yes)
+
+	delete (tmp1, verify-)
+	delete (tmp2, verify-)
+end
diff --git a/noao/obsutil/src/sptime/grating.x b/noao/obsutil/src/sptime/grating.x
new file mode 100644
index 00000000..373b335d
--- /dev/null
+++ b/noao/obsutil/src/sptime/grating.x
@@ -0,0 +1,1107 @@
+include	<error.h>
+include	<math.h>
+
+define	GR_LEN		24
+define	GR_W		Memr[P2R($1)]	# Wavelength
+define	GR_O		Memi[$1+1]	# Order
+define	GR_P		Memr[P2R($1+2)]	# Blaze peak scale factor
+define	GR_WB		Memr[P2R($1+3)]	# First order wavelength at blaze (A)
+define	GR_DB		Memr[P2R($1+4)]	# First order dispersion at blaze (A/mm)
+define	GR_OREF		Memi[$1+5]	# Reference order
+define	GR_F		Memr[P2R($1+6)]	# Focal length (mm)
+define	GR_G		Memr[P2R($1+7)]	# Ruling (groves/A)
+define	GR_BLAZE	Memr[P2R($1+8)]	# Blaze angle (rad)
+define	GR_N		Memr[P2R($1+9)]	# Index of refraction
+define	GR_PHI		Memr[P2R($1+10)]	# Alpha - beta (rad)
+define	GR_ALPHA	Memr[P2R($1+11)]	# Incident angle (rad)
+define	GR_BETA		Memr[P2R($1+12)]	# Diffraction angle (rad)
+define	GR_TYPE		Memr[P2R($1+13)]	# 1=Reflection, -1=Transmission
+define	GR_FULL		Memi[$1+14]		# Full solution?
+
+define	GR_PIS		Memr[P2R($1+15)]	# PI/G*S
+define	GR_CA		Memr[P2R($1+16)]	# cos (ALPHA)
+define	GR_SA		Memr[P2R($1+17)]	# sin (ALPHA)
+define	GR_CB		Memr[P2R($1+18)]	# cos (BETA)
+define	GR_TB		Memr[P2R($1+19)]	# tan (BETA)
+define	GR_SE		Memr[P2R($1+20)]	# sin (ALPHA - BLAZE)
+define	GR_CE		Memr[P2R($1+21)]	# cos (ALPHA - BLAZE)
+define	GR_CBLZ		Memr[P2R($1+22)]	# cos (BLAZE)
+define	GR_T2BLZ	Memr[P2R($1+23)]	# tan (2 * BLAZE)
+
+
+# Definitions of INDEF parameter flags.
+define	F	1B		# Focal length
+define	G	2B		# Groves	
+define	T	4B		# Blaze angle
+define	A	10B		# Incident angle
+define	B	20B		# Diffracted angle
+define	P	40B		# Incident - diffracted
+define	W	100B		# Wavelength
+define	D	200B		# Dispersions
+define	N	400B		# Index of refraction
+
+# Combinations
+define	FG	3B
+define	FT	5B
+define	FA	11B
+define	FW	101B
+define	GT	6B
+define	GA	12B
+define	GW	102B
+define	GD	202B
+define	TA	14B
+define	TAW	114B
+define	TAD	214B
+define	TB	24B
+define	TP	44B
+define	TW	104B
+define	TD	204B
+define	AB	30B
+define	AP	50B
+define	AW	110B
+define	AD	210B
+define	BP	140B
+define	WD	300B
+define	ABP	70B
+define	GTA	16B
+
+
+# GRATING_OPEN -- Open grating structure.
+# Check and derive grating parameters.
+#
+# This procedure hasn't yet been fixed up for grisms (index of refraction
+# is not accounted for) so all input parameters should be defined with
+# alpha=beta=blaze=prism angle.
+
+pointer procedure gr_open (w, o, p, wb, db, oref, f, gmm, blaze, n, phi,
+	alpha, beta, mode, full)
+
+real	w		#I Wavelength (A)
+int	o		#I Order
+real	p		#I Blaze peak scale factor
+real	f		#I Focal length (mm)
+real	wb		#I Blaze wavelength (A)
+real	db		#I Blaze dispersion (A/mm)
+int	oref		#I Reference order
+real	gmm		#I Groves (groves/mm)
+real	blaze		#I Blaze angle (deg)
+real	n		#I Index of refraction for grism
+real	phi		#I Incident - diffracted (deg)
+real	alpha		#I Incident angle (deg)
+real	beta		#I Diffracted angle (deg)
+int	mode		#I 1 = incident > diffracted
+int	full		#I Do full solution?
+pointer	gr		#O Grating pointer
+
+int	flags
+real	x
+define	err_	10
+
+begin
+	call malloc (gr, GR_LEN, TY_STRUCT)
+
+	GR_W(gr) = w
+	GR_O(gr) = o
+	GR_P(gr) = p
+
+	GR_F(gr) = f
+	GR_G(gr) = gmm
+	GR_BLAZE(gr) = blaze
+	GR_N(gr) = n
+	GR_PHI(gr) = phi
+	GR_ALPHA(gr) = alpha
+	GR_BETA(gr) = beta
+
+	GR_OREF(gr) = oref
+	GR_WB(gr) = wb
+	GR_DB(gr) = db
+
+	# The grating is reflection unless the index of refraction is not
+	# 1, the blaze dispersion is negative, beta is greater than
+	# 180 degrees, or the incident and diffraction angles are the same.
+
+	if (GR_N(gr) == 1.)
+	    GR_TYPE(gr) = 1
+	else if (!IS_INDEF(GR_N(gr)))
+	    GR_TYPE(gr) = -1
+	else {
+	    if (!IS_INDEF(GR_BETA(gr))
+		&& (GR_BETA(gr) > 180. || GR_BETA(gr) < -180))
+		GR_TYPE(gr) = -1
+	    else if (!IS_INDEF(GR_DB(gr)) && GR_DB(gr) < 0.)
+		GR_TYPE(gr) = -1
+	    else if (!IS_INDEF(GR_ALPHA(gr)) && !IS_INDEF(GR_BETA(gr)) &&
+		GR_ALPHA(gr) == GR_BETA(gr))
+		GR_TYPE(gr) = -1
+	    else if (GR_PHI(gr) == 0.)
+		GR_TYPE(gr) = -1
+	    else
+		GR_TYPE(gr) = 1
+	}
+
+	# Set INDEF values to reasonable defaults.  Convert degrees to radians.
+	if (IS_INDEF(GR_P(gr)))
+	    GR_P(gr) = 1
+	if (!IS_INDEF(GR_WB(gr))) {
+	    if (GR_WB(gr) <= 0.)
+		GR_WB(gr) = INDEF
+	    else
+		GR_WB(gr) = GR_WB(gr) * GR_OREF(gr)
+	}
+	if (!IS_INDEF(GR_DB(gr)))
+	    GR_DB(gr) = GR_TYPE(gr) * GR_OREF(gr) * abs (GR_DB(gr))
+	if (!IS_INDEF(GR_F(gr))) {
+	    if (GR_F(gr) <= 0.)
+		GR_F(gr) = INDEF
+	}
+	if (!IS_INDEF(GR_G(gr))) {
+	    if (GR_G(gr) <= 0.)
+		GR_G(gr) = INDEF
+	    else
+		GR_G(gr) = GR_G(gr) / 1e7
+	}
+	if (!IS_INDEF(GR_PHI(gr)))
+	    GR_PHI(gr) = DEGTORAD (GR_PHI(gr))
+	if (!IS_INDEF(GR_ALPHA(gr)))
+	    GR_ALPHA(gr) = DEGTORAD (GR_ALPHA(gr))
+	if (!IS_INDEF(GR_BETA(gr))) {
+	    GR_BETA(gr) = DEGTORAD (GR_BETA(gr))
+	    if (GR_BETA(gr) > HALFPI)
+		GR_BETA(gr) = GR_BETA(gr) - PI
+	    else if (GR_BETA(gr) < -HALFPI)
+		GR_BETA(gr) = GR_BETA(gr) + PI
+	}
+	if (!IS_INDEF(GR_BLAZE(gr)))
+	    GR_BLAZE(gr) = DEGTORAD (GR_BLAZE(gr))
+
+	# Compute missing angles, if possible,  based on the other angles.
+	# This assumes the given values are for the blaze peak.
+
+	flags = 0
+	if (IS_INDEF(GR_BLAZE(gr)))
+	    flags = flags + T
+	if (IS_INDEF(GR_ALPHA(gr)))
+	    flags = flags + A
+	if (IS_INDEF(GR_BETA(gr)))
+	    flags = flags + B
+	if (IS_INDEF(GR_PHI(gr)))
+	    flags = flags + P
+
+	switch (flags) {
+	case T, P, TP:
+	    GR_PHI(gr) = GR_ALPHA(gr) - GR_BETA(gr)
+	    GR_BLAZE(gr) = (GR_ALPHA(gr) + GR_BETA(gr)) / 2.
+	case A, TA:
+	    GR_ALPHA(gr) = GR_BETA(gr) + GR_PHI(gr)
+	    GR_BLAZE(gr) = (GR_ALPHA(gr) + GR_BETA(gr)) / 2.
+	case AB:
+	    if (mode == 1) {
+		GR_ALPHA(gr) = GR_BLAZE(gr) + GR_PHI(gr)/2.
+		GR_BETA(gr) = GR_BLAZE(gr) - GR_PHI(gr)/2.
+	    } else {
+		GR_ALPHA(gr) = GR_BLAZE(gr) - GR_PHI(gr)/2.
+		GR_BETA(gr) = GR_BLAZE(gr) + GR_PHI(gr)/2.
+	    }
+	case AP:
+	    GR_ALPHA(gr) = 2 * GR_BLAZE(gr) - GR_BETA(gr)
+	    GR_PHI(gr) = GR_ALPHA(gr) - GR_BETA(gr)
+	case B, TB:
+	    GR_BETA(gr) = GR_ALPHA(gr) - GR_PHI(gr)
+	    GR_BLAZE(gr) = (GR_ALPHA(gr) + GR_BETA(gr)) / 2.
+	case BP:
+	    GR_BETA(gr) = 2 * GR_BLAZE(gr) - GR_ALPHA(gr)
+	    GR_PHI(gr) = GR_ALPHA(gr) - GR_BETA(gr)
+	case ABP:
+	    GR_ALPHA(gr) = GR_BLAZE(gr)
+	    GR_BETA(gr) = GR_BLAZE(gr)
+	    GR_PHI(gr) = 0.
+	}
+
+	# Compute index of refraction if possible.
+	if (IS_INDEF(GR_N(gr))) {
+	    if (GR_TYPE(gr) == 1)
+		GR_N(gr) = 1
+	    else if (!IS_INDEF(GR_WB(gr)) && !IS_INDEF(GR_G(gr)) &&
+		!IS_INDEF(GR_BLAZE(gr)))
+		GR_N(gr) = (GR_G(gr) * GR_WB(gr)) / sin (GR_BLAZE(gr)) + 1
+	}
+
+	# Compute other parameters if possible.
+	flags = 0
+	if (IS_INDEF(GR_F(gr)))
+	    flags = flags + F
+	if (IS_INDEF(GR_G(gr)))
+	    flags = flags + G
+	if (IS_INDEF(GR_BLAZE(gr)))
+	    flags = flags + T
+	if (IS_INDEF(GR_ALPHA(gr)))
+	    flags = flags + A
+	if (IS_INDEF(GR_WB(gr)))
+	    flags = flags + W
+	if (IS_INDEF(GR_DB(gr)))
+	    flags = flags + D
+	if (IS_INDEF(GR_N(gr)))
+	    flags = flags + N
+
+	switch (flags) {
+	case 0, F, G, T, A, N, W, D:
+	    switch (flags) {
+	    case F:
+		GR_F(gr) = GR_TYPE(gr) * cos (GR_BETA(gr)) /
+		    (GR_G(gr) * GR_DB(gr))
+	    case G: 
+		GR_G(gr) = (GR_N(gr) * sin (GR_ALPHA(gr)) +
+		    GR_TYPE(gr) * sin (GR_BETA(gr))) / GR_WB(gr)
+		if (GR_G(gr) == 0.)
+		    GR_G(gr) = INDEF
+	    case T:
+		if (GR_ALPHA(gr) > PI) {
+		    x = GR_G(gr) * GR_WB(gr) / (2 * cos (GR_ALPHA(gr)))
+		    if (abs (x) > 1.)
+			goto err_
+		    GR_BLAZE(gr) = asin (x)
+		    GR_ALPHA(gr) = GR_ALPHA(gr) - TWOPI + GR_BLAZE(gr)
+		} else {
+		    x = GR_G(gr) * GR_WB(gr) - GR_N(gr) * sin (GR_ALPHA(gr))
+		    if (abs (x) > 1.)
+			goto err_
+		    GR_BLAZE(gr) = (GR_ALPHA(gr) + asin (x)) / 2
+		}
+		GR_BETA(gr) = 2 * GR_BLAZE(gr) - GR_ALPHA(gr)
+		GR_PHI(gr) = GR_ALPHA(gr) - GR_BETA(gr)
+	    case A:
+		x = GR_TYPE(gr) * GR_G(gr) * GR_WB(gr) / (2 * sin(GR_BLAZE(gr)))
+		if (abs (x) > 1.)
+		    goto err_
+		if (mode == 1) {
+		    GR_ALPHA(gr) = GR_BLAZE(gr) + acos (x)
+		    GR_BETA(gr) = 2 * GR_BLAZE(gr) - GR_ALPHA(gr)
+		} else {
+		    GR_BETA(gr) = GR_BLAZE(gr) + acos (x)
+		    GR_ALPHA(gr) = 2 * GR_BLAZE(gr) - GR_BETA(gr)
+		}
+		GR_PHI(gr) = GR_ALPHA(gr) - GR_BETA(gr)
+	    case N:
+		GR_N(gr) = (GR_G(gr) * GR_WB(gr)) / sin (GR_BLAZE(gr)) + 1
+	    }
+	    GR_WB(gr) = (GR_N(gr) * sin (GR_ALPHA(gr)) +
+		GR_TYPE(gr) * sin (GR_BETA(gr))) / GR_G(gr)
+	    GR_DB(gr) = GR_TYPE(gr) * cos (GR_BETA(gr)) / (GR_F(gr)*GR_G(gr))
+	case FG:
+	    x = (GR_N(gr) * sin (GR_ALPHA(gr)) +
+		GR_TYPE(gr) * sin (GR_BETA(gr))) / GR_WB(gr)
+	    if (x == 0.)
+		goto err_
+	    GR_G(gr) = x
+	    GR_F(gr) = GR_TYPE(gr) * cos (GR_BETA(gr)) / (GR_G(gr) * GR_DB(gr))
+	case FT:
+	    if (GR_ALPHA(gr) > PI) {
+		x = GR_TYPE(gr) * GR_G(gr) * GR_WB(gr) /
+		    (2 * cos (GR_ALPHA(gr)))
+		if (abs (x) > 1.)
+		    goto err_
+		GR_BLAZE(gr) = asin (x)
+		GR_ALPHA(gr) = GR_ALPHA(gr) - TWOPI + GR_BLAZE(gr)
+	    } else {
+		x = GR_TYPE(gr) * GR_G(gr) * GR_WB(gr) -
+		    GR_N(gr) * sin (GR_ALPHA(gr))
+		if (abs (x) > 1.)
+		    goto err_
+		GR_BLAZE(gr) = (GR_ALPHA(gr) + asin (x)) / 2
+	    }
+	    GR_BETA(gr) = 2 * GR_BLAZE(gr) - GR_ALPHA(gr)
+	    GR_PHI(gr) = GR_ALPHA(gr) - GR_BETA(gr)
+	    GR_F(gr) = GR_TYPE(gr) * cos (GR_BETA(gr)) / (GR_G(gr) * GR_DB(gr))
+	case FA:
+	    x = GR_TYPE(gr) * GR_G(gr) * GR_WB(gr) / (2 * sin (GR_BLAZE(gr)))
+	    if (abs (x) > 1.)
+		goto err_
+	    if (mode == 1) {
+		GR_ALPHA(gr) = GR_BLAZE(gr) + acos (x)
+		GR_BETA(gr) = 2 * GR_BLAZE(gr) - GR_ALPHA(gr)
+	    } else {
+		GR_BETA(gr) = GR_BLAZE(gr) + acos (x)
+		GR_ALPHA(gr) = 2 * GR_BLAZE(gr) - GR_BETA(gr)
+	    }
+	    GR_PHI(gr) = GR_ALPHA(gr) - GR_BETA(gr)
+	    GR_F(gr) = GR_TYPE(gr) * cos (GR_BETA(gr)) / (GR_G(gr) * GR_DB(gr))
+	case FW:
+	    GR_WB(gr) = (GR_N(gr) * sin (GR_ALPHA(gr)) +
+		GR_TYPE(gr) * sin (GR_BETA(gr))) / GR_G(gr)
+	    GR_F(gr) = GR_TYPE(gr) * cos (GR_BETA(gr)) / (GR_G(gr) * GR_DB(gr))
+	case GT:
+	    x = GR_TYPE(gr) * GR_F(gr) * GR_DB(gr) / GR_WB(gr)
+	    if (GR_ALPHA(gr) > PI) {
+		GR_BLAZE(gr) = atan (1 / (2 * x - tan (GR_ALPHA(gr))))
+		GR_ALPHA(gr) = GR_ALPHA(gr) - TWOPI + GR_BLAZE(gr)
+	    } else {
+		x = (tan (GR_ALPHA(gr)) - x) / (1 + 2 * x * tan (GR_ALPHA(gr)))
+		GR_BLAZE(gr) = atan (x + sqrt (1 + x * x))
+	    }
+	    GR_BETA(gr) = 2 * GR_BLAZE(gr) - GR_ALPHA(gr)
+	    GR_PHI(gr) = GR_ALPHA(gr) - GR_BETA(gr)
+	    GR_G(gr) = (GR_N(gr) * sin (GR_ALPHA(gr)) +
+		GR_TYPE(gr) * sin (GR_BETA(gr))) / GR_WB(gr)
+	case GA:
+	    GR_ALPHA(gr) = GR_BLAZE(gr) +
+		atan (2 * GR_TYPE(gr) * GR_F(gr) * GR_DB(gr) /
+		GR_WB(gr) - 1 / tan (GR_BLAZE(gr)))
+	    GR_BETA(gr) = 2 * GR_BLAZE(gr) - GR_ALPHA(gr)
+	    GR_PHI(gr) = GR_ALPHA(gr) - GR_BETA(gr)
+	    GR_G(gr) = (GR_N(gr) * sin (GR_ALPHA(gr)) +
+		GR_TYPE(gr) * sin (GR_BETA(gr))) / GR_WB(gr)
+	case GW:
+	    GR_G(gr) = GR_TYPE(gr) * cos (GR_BETA(gr)) / (GR_F(gr) * GR_DB(gr))
+	    if (GR_G(gr) == 0.)
+		GR_G(gr) = INDEF
+	    else
+		GR_WB(gr) = (GR_N(gr) * sin (GR_ALPHA(gr)) +
+		    GR_TYPE(gr) * sin (GR_BETA(gr))) / GR_G(gr)
+	case GD:
+	    x = (GR_N(gr) * sin (GR_ALPHA(gr)) +
+		GR_TYPE(gr) * sin (GR_BETA(gr))) / GR_WB(gr)
+	    if (x == 0.)
+		goto err_
+	    GR_G(gr) = x
+	    GR_DB(gr) = GR_TYPE(gr) * cos (GR_BETA(gr)) / (GR_F(gr) * GR_G(gr))
+	case TAD:
+	    if (IS_INDEF(GR_PHI(gr)))
+		GR_PHI(gr) = 0.
+	    x = GR_G(gr) * GR_WB(gr) / (2 * cos (GR_PHI(gr)/2))
+	    if (mode == 1) {
+		GR_ALPHA(gr) = GR_PHI(gr)/2 + asin (x)
+		GR_BETA(gr) = GR_ALPHA(gr) - GR_PHI(gr)
+	    } else {
+		GR_BETA(gr) = GR_PHI(gr)/2 + asin (x)
+		GR_ALPHA(gr) = GR_BETA(gr) - GR_PHI(gr)
+	    }
+	    GR_BLAZE(gr) = (GR_ALPHA(gr) + GR_BETA(gr)) / 2
+	    GR_DB(gr) = GR_TYPE(gr) * cos (GR_BETA(gr)) /
+		(GR_F(gr) * GR_G(gr))
+	case TAW:
+	    if (!IS_INDEF(GR_PHI(gr))) {
+		x = GR_TYPE(gr) * GR_F(gr) * GR_G(gr) * GR_DB(gr)
+		if (abs (x) > 1.) {
+		    if (abs (x) > 1.1)
+			goto err_
+		    else {
+			x = 1. 
+			GR_DB(gr) = x / (GR_F(gr) * GR_G(gr))
+		    }
+		}
+		if (mode == 1) {
+		    GR_BETA(gr) = acos (x)
+		    GR_ALPHA(gr) = GR_BETA(gr) + GR_PHI(gr) 
+		} else {
+		    GR_ALPHA(gr) = acos (x)
+		    GR_BETA(gr) = GR_ALPHA(gr) + GR_PHI(gr) 
+		}
+		GR_BLAZE(gr) = (GR_ALPHA(gr) + GR_BETA(gr)) / 2
+		GR_WB(gr) = (GR_N(gr) * sin (GR_ALPHA(gr)) +
+		    GR_TYPE(gr) * sin (GR_BETA(gr))) / GR_G(gr)
+	    }
+	case TA:
+	    if (!IS_INDEF(GR_PHI(gr))) {
+		x = GR_G(gr) * GR_WB(gr) / (2 * cos (GR_PHI(gr)/2))
+		if (mode == 1) {
+		    GR_ALPHA(gr) = GR_PHI(gr)/2 + asin (x)
+		    GR_BETA(gr) = GR_ALPHA(gr) - GR_PHI(gr)
+		} else {
+		    GR_BETA(gr) = GR_PHI(gr)/2 + asin (x)
+		    GR_ALPHA(gr) = GR_BETA(gr) - GR_PHI(gr)
+		}
+		GR_BLAZE(gr) = (GR_ALPHA(gr) + GR_BETA(gr)) / 2
+		GR_DB(gr) = GR_TYPE(gr) * cos (GR_BETA(gr)) /
+		    (GR_F(gr) * GR_G(gr))
+	    } else {
+		x = GR_TYPE(gr) * GR_F(gr) * GR_G(gr) * GR_DB(gr)
+		if (abs (x) > 1.) {
+		    if (abs (x) > 1.1)
+			goto err_
+		    else {
+			x = 1. 
+			GR_DB(gr) = x / (GR_F(gr) * GR_G(gr))
+		    }
+		}
+		GR_BETA(gr) = acos (x)
+		x = GR_G(gr) * GR_WB(gr) - GR_TYPE(gr) * sin (GR_BETA(gr))
+		if (abs (x) > 1.)
+		    goto err_
+		GR_ALPHA(gr) = asin (x)
+		GR_BLAZE(gr) = (acos (GR_TYPE(gr) * GR_F(gr) * GR_G(gr) *
+		    GR_DB(gr)) + GR_ALPHA(gr)) / 2
+		GR_BETA(gr) = 2 * GR_BLAZE(gr) - GR_ALPHA(gr)
+		GR_PHI(gr) = GR_ALPHA(gr) - GR_BETA(gr)
+	    }
+	case TW:
+	    GR_BLAZE(gr) = (GR_ALPHA(gr) +
+		acos (GR_TYPE(gr) * GR_F(gr) * GR_G(gr) * GR_DB(gr))) / 2
+	    GR_BETA(gr) = 2 * GR_BLAZE(gr) - GR_ALPHA(gr)
+	    GR_PHI(gr) = GR_ALPHA(gr) - GR_BETA(gr)
+	    GR_WB(gr) = (GR_N(gr) * sin (GR_ALPHA(gr)) +
+		GR_TYPE(gr) * sin (GR_BETA(gr))) / GR_G(gr)
+	case TD:
+	    if (GR_ALPHA(gr) > PI) {
+		x = GR_G(gr) * GR_WB(gr) / (2 * cos (GR_ALPHA(gr)))
+		if (abs (x) > 1.)
+		    goto err_
+		GR_BLAZE(gr) = asin (x)
+		GR_ALPHA(gr) = GR_ALPHA(gr) - TWOPI + GR_BLAZE(gr)
+	    } else {
+		x = GR_G(gr) * GR_WB(gr) - GR_N(gr) * sin (GR_ALPHA(gr))
+		if (abs (x) > 1.)
+		    goto err_
+		GR_BLAZE(gr) = (GR_ALPHA(gr) + asin (x)) / 2
+	    }
+	    GR_BETA(gr) = 2 * GR_BLAZE(gr) - GR_ALPHA(gr)
+	    GR_PHI(gr) = GR_ALPHA(gr) - GR_BETA(gr)
+	    GR_DB(gr) = GR_TYPE(gr) * cos (GR_BETA(gr)) / (GR_F(gr) * GR_G(gr))
+	case AW:
+	    x = GR_TYPE(gr) * GR_F(gr) * GR_G(gr) * GR_DB(gr)
+	    if (abs (x) > 1.)
+		goto err_
+	    GR_ALPHA(gr) = 2 * GR_BLAZE(gr) - acos (x)
+	    GR_BETA(gr) = 2 * GR_BLAZE(gr) - GR_ALPHA(gr)
+	    GR_PHI(gr) = GR_ALPHA(gr) - GR_BETA(gr)
+	    GR_WB(gr) = (GR_N(gr) * sin (GR_ALPHA(gr)) + sin (GR_BETA(gr))) /
+		GR_G(gr)
+	case AD:
+	    x = GR_G(gr) * GR_WB(gr) / (2 * sin (GR_BLAZE(gr)))
+	    if (abs (x) > 1.)
+		goto err_
+	    if (mode == 1) {
+		GR_ALPHA(gr) = GR_BLAZE(gr) + acos (x)
+		GR_BETA(gr) = 2 * GR_BLAZE(gr) - GR_ALPHA(gr)
+	    } else {
+		GR_BETA(gr) = GR_BLAZE(gr) + acos (x)
+		GR_ALPHA(gr) = 2 * GR_BLAZE(gr) - GR_BETA(gr)
+	    }
+	    GR_PHI(gr) = GR_ALPHA(gr) - GR_BETA(gr)
+	    GR_DB(gr) = GR_TYPE(gr) * cos (GR_BETA(gr)) / (GR_F(gr) * GR_G(gr))
+	case WD:
+	    GR_WB(gr) = (GR_N(gr) * sin (GR_ALPHA(gr)) +
+		GR_TYPE(gr) * sin (GR_BETA(gr))) / GR_G(gr)
+	    GR_DB(gr) = GR_TYPE(gr) * cos (GR_BETA(gr)) / (GR_F(gr) * GR_G(gr))
+	case GTA:
+	    # Assume beta=alpha=blaze.
+	    x = (GR_TYPE(gr) * GR_WB(gr)) /
+		((GR_N(gr) + GR_TYPE(gr)) * GR_F(gr) * GR_DB(gr))
+	    GR_BETA(gr) = atan (x)
+	    GR_ALPHA(gr) = GR_BETA(gr)
+	    GR_BLAZE(gr) = GR_BETA(gr)
+	    GR_PHI(gr) = 0
+	    GR_G(gr) = (GR_N(gr) * sin (GR_ALPHA(gr)) +
+		GR_TYPE(gr) * sin (GR_BETA(gr))) / GR_WB(gr)
+	}
+
+	# The result should give the blaze wavelength and dispersion.
+	# If this cannot be computed then it is an error.
+
+	if (IS_INDEF(GR_WB(gr)) || IS_INDEF(GR_DB(gr))) {
+	    call gr_close (gr)
+	    call mfree (gr, TY_STRUCT)
+	    call error (1,
+		"Insufficient information to to resolve grating parameters")
+	}
+			   
+	# If all the other parameters cannot be computed then use linear.
+	if (full==NO || IS_INDEF(GR_F(gr)) || IS_INDEF(GR_G(gr)) ||
+	    IS_INDEF(GR_BETA(gr)) || IS_INDEF(GR_PHI(gr)) ||
+	    IS_INDEF(GR_N(gr))) {
+	    GR_FULL(gr) = NO
+	    if (IS_INDEF(GR_F(gr)))
+		GR_F(gr) = 1
+	    GR_W(gr) = GR_WB(gr)
+	    GR_O(gr) = GR_OREF(gr)
+	    GR_CE(gr) = PI * GR_DB(gr)
+	    GR_CA(gr) = 1.
+	    GR_CB(gr) = 1.
+
+	# A full grating solution is possible.
+	} else {
+	    GR_FULL(gr) = YES
+
+	    # Set the order and wavelength to the blaze values if not given.
+	    if (IS_INDEF(GR_W(gr))) {
+		if (!IS_INDEFI(GR_O(gr)))
+		    GR_W(gr) = GR_WB(gr) / GR_O(gr)
+		else
+		    GR_W(gr) = GR_WB(gr) / GR_OREF(gr)
+	    }
+	    if (IS_INDEFI(GR_O(gr)))
+		GR_O(gr) = max (1, nint (GR_WB(gr) / GR_W(gr)))
+
+	    # Convert to incident angle at desired wavelength.
+	    if (GR_PHI(gr) != 0.) {
+		x = GR_G(gr) * GR_O(gr) * GR_W(gr) /
+		    (2 * cos (GR_PHI(gr)/2))
+		if (abs (x) > 1.)
+		    goto err_
+		if (mode == 1) {
+		    GR_ALPHA(gr) = asin (x) + GR_PHI(gr) / 2
+		    GR_BETA(gr) = asin (x) - GR_PHI(gr) / 2
+		} else {
+		    GR_ALPHA(gr) = asin (x) - GR_PHI(gr) / 2
+		    GR_BETA(gr) = asin (x) + GR_PHI(gr) / 2
+		}
+	    } else {
+		x = (GR_G(gr) * GR_O(gr) * GR_W(gr) -
+		    GR_TYPE(gr) * sin (GR_BETA(gr))) / GR_N(gr)
+		if (abs (x) > 1.)
+		    goto err_
+		GR_ALPHA(gr) = asin (x)
+	    }
+
+	    # The following parameters are for efficiency.  Beta terms are
+	    # for the blaze peak diffraction.
+
+	    x = 2 * GR_BLAZE(gr) - GR_ALPHA(gr)
+	    GR_CA(gr) = cos (GR_ALPHA(gr))
+	    GR_SA(gr) = sin (GR_ALPHA(gr))
+	    GR_CB(gr) = GR_TYPE(gr) * cos (x)
+	    GR_TB(gr) = tan (x)
+	    GR_SE(gr) = sin (GR_ALPHA(gr) - GR_BLAZE(gr))
+	    GR_CE(gr) = cos (GR_ALPHA(gr) - GR_BLAZE(gr))
+	    GR_CBLZ(gr) = cos (GR_BLAZE(gr))
+	    GR_T2BLZ(gr) = tan (2 * GR_BLAZE(gr))
+	    if (GR_ALPHA(gr) > x)
+		GR_PIS(gr) = PI / GR_G(gr) * GR_CA(gr)
+	    else
+		GR_PIS(gr) = PI / GR_G(gr) * GR_CBLZ(gr)
+	}
+
+	return (gr)
+
+err_	call error (2, "Impossible combination of grating parameters")
+end
+
+
+# GR_CLOSE -- Free grating structure.
+
+procedure gr_close (gr)
+
+pointer	gr		#I Grating pointer
+
+begin
+	call mfree (gr, TY_STRUCT)
+end
+
+# GR_GETR -- Get grating parameter.
+
+real procedure gr_getr (gr, param)
+
+pointer	gr		#I Grating pointer
+char	param[ARB]	#I Parameter name
+
+bool	streq()
+
+begin
+	if (gr == NULL)
+	    return (INDEF)
+
+	switch (param[1]) {
+	case 'a':
+	    if (streq (param, "alpha")) {
+		if (IS_INDEFR(GR_ALPHA(gr)))
+		    return (GR_ALPHA(gr))
+		else
+		    return (RADTODEG(GR_ALPHA(gr)))
+	    }
+	case 'b':
+	    if (streq (param, "blaze")) {
+		if (IS_INDEFR(GR_BLAZE(gr)))
+		    return (GR_BLAZE(gr))
+		else
+		    return (RADTODEG(GR_BLAZE(gr)))
+	    } else if (streq (param, "beta")) {
+		if (IS_INDEFR(GR_BETA(gr)))
+		    return (GR_BETA(gr))
+		else
+		    return (RADTODEG(GR_BETA(gr)))
+	    }
+	case 'd':
+	    if (streq (param, "dblaze"))
+		return (GR_DB(gr) / GR_OREF(gr))
+	    if (streq (param, "dispersion")) {
+		if (GR_FULL(gr) == NO)
+		    return (GR_DB(gr) / GR_O(gr))
+		else
+		    return (GR_CB(gr) / (GR_G(gr) * GR_O(gr) *GR_F(gr)))
+	    }
+	case 'f':
+	    if (streq (param, "full"))
+		return (real (GR_FULL(gr)))
+	    else if (streq (param, "f"))
+		return (GR_F(gr))
+	case 'g':
+	    if (streq (param, "g")) {
+		if (IS_INDEFR(GR_G(gr)))
+		    return (GR_G(gr))
+		else
+		    return (GR_G(gr) * 1E7)
+	    }
+	case 'm':
+	    if (streq (param, "mag"))
+		return (GR_CA(gr) / GR_CB(gr))
+	case 'n':
+	    if (streq (param, "n"))
+		return (GR_N(gr))
+	case 'o':
+	    if (streq (param, "order"))
+		return (real (GR_O(gr)))
+	    if (streq (param, "oref"))
+		return (real (GR_OREF(gr)))
+	case 'p':
+	    if (streq (param, "phi")) {
+		if (IS_INDEFR(GR_PHI(gr)))
+		    return (GR_PHI(gr))
+		else
+		    return (RADTODEG(GR_PHI(gr)))
+	    }
+	case 't':
+	    if (streq (param, "tilt")) {
+		if (GR_FULL(gr) == NO)
+		    return (INDEFR)
+		else
+		    return (RADTODEG((GR_ALPHA(gr)+GR_TYPE(gr)*GR_BETA(gr))/2))
+	    }
+	case 'w':
+	    if (streq (param, "wavelength"))
+		return (GR_W(gr))
+	    if (streq (param, "wblaze"))
+		return (GR_WB(gr) / GR_OREF(gr))
+	}
+	call error (1, "gr_getr: unknown parameter")
+end
+
+
+# GR_LIST -- List grating parameters.
+
+procedure gr_list (gr, order, col)
+
+pointer	gr		#I Grating pointer
+int	order		#I Order
+int	col		#I Column to indent
+
+begin
+	if (gr == NULL)
+	    return
+
+	if (GR_FULL(gr) == NO) {
+	    call printf ("%*tReference order = %d\n")
+		call pargi (col)
+		call pargi (order)
+	    call printf (
+		"%*tBlaze wavelength of reference order = %.6g Angstroms\n")
+		call pargi (col)
+		call pargr (GR_WB(gr) / order)
+	    call printf (
+		"%*tBlaze dispersion of reference order = %.4g Angstroms/mm\n")
+		call pargi (col)
+		call pargr (GR_DB(gr) / order)
+	} else  {
+	    call printf ("%*tFocal length = %d mm\n")
+		call pargi (col)
+		call pargr (GR_F(gr))
+	    call printf ("%*tGrating = %.1f grooves/mm\n")
+		call pargi (col)
+		call pargr (GR_G(gr) * 1e7)
+	    call printf ("%*tBlaze angle = %.1f degrees\n")
+		call pargi (col)
+		call pargr (RADTODEG(GR_BLAZE(gr)))
+	    call printf ("%*tIncident to diffracted angle = %.1f degrees\n")
+		call pargi (col)
+		call pargr (RADTODEG(GR_PHI(gr)))
+	    call printf ("%*tReference order = %d\n")
+		call pargi (col)
+		call pargi (order)
+	    call printf (
+		"%*tBlaze wavelength = %.6g Angstroms\n")
+		call pargi (col)
+		call pargr (GR_WB(gr) / order)
+	    call printf (
+		"%*tBlaze dispersion = %.4g Angstroms/mm\n")
+		call pargi (col)
+		call pargr (GR_DB(gr) / order)
+
+	    call printf ("\n%*tCentral wavelength = %.6g Angstroms\n")
+		call pargi (col)
+		call pargr (GR_W(gr))
+	    call printf ("%*tCentral dispersion = %.4g Angstroms/mm\n")
+		call pargi (col)
+		call pargr (GR_TYPE(gr) * cos (GR_BETA(gr)) /
+		    (GR_G(gr) * order *GR_F(gr)))
+	    call printf ("%*tOrder = %d\n")
+		call pargi (col)
+		call pargi (GR_O(gr))
+	    call printf ("%*tTilt = %.1f degrees\n")
+		call pargi (col)
+		call pargr (RADTODEG(GR_ALPHA(gr) - GR_PHI(gr) / 2))
+	    call printf ("%*tGrating magnification = %.2f\n")
+		call pargi (col)
+		call pargr (GR_CA(gr)/GR_CB(gr))
+	    call printf ("%*tIncidence angle = %.1f degrees\n")
+		call pargi (col)
+		call pargr (RADTODEG(GR_ALPHA(gr)))
+	    call printf ("%*tDiffracted angle = %.1f degrees\n")
+		call pargi (col)
+		call pargr (RADTODEG(GR_BETA(gr)))
+	}
+end
+
+
+# GR_W2PSI -- Given wavelength return tan(psi).
+
+real procedure gr_w2psi (gr, w, m)
+
+pointer	gr		#I Grating pointer
+real	w		#I Wavelength
+int	m		#I Order
+real	x		#O Pixel position
+
+real	gr_sinbeta()
+
+begin
+	if (GR_FULL(gr) == NO)
+	    return ((m*w - GR_WB(gr)) / GR_DB(gr) * GR_F(gr))
+
+	x = gr_sinbeta (gr, w, m)
+	if (!IS_INDEF(x)) {
+	    x = x / sqrt (1 - x * x)
+	    x = (x - GR_TB(gr)) / (1 + x * GR_TB(gr))
+	}
+	return (x)
+
+end
+
+
+# GR_W2PSIR -- Given wavelength return tan(psi) of reflected component.
+
+real procedure gr_w2psir (gr, w, m)
+
+pointer	gr		#I Grating pointer
+real	w		#I Wavelength
+int	m		#I Order
+real	x		#O Pixel position
+
+real	gr_sinbeta()
+
+begin
+	x = gr_sinbeta (gr, w, m)
+	if (!IS_INDEF(x)) {
+	    #x = x / sqrt (1 - x * x)
+	    #x = (x - GR_TB(gr)) / (1 + x * GR_TB(gr))
+	    #x = (x + GR_T2BLZ(gr)) / (1 - x * GR_T2BLZ(gr))
+	    x = PI - asin(x)
+	    x = 2 * GR_BLAZE(gr) - x - GR_BETA(gr)
+	    x = tan (x)
+	}
+	return (x)
+end
+
+
+# GR_DELTA -- Given pixel position and wavelength return blaze function
+# phase angle.
+
+real procedure gr_delta (gr, w, m)
+
+pointer	gr		#I Grating pointer
+real	w		#I Wavelength
+int	m		#I Order
+real	d		#O Delta
+
+real	tanpsi, cospsi, sinpsi, gr_w2psi()
+
+begin
+	tanpsi = gr_w2psi (gr, w, m)
+	if (IS_INDEF(tanpsi))
+	    return (INDEF)
+
+	if (GR_FULL(gr) == NO)
+	    d = PI * GR_DB(gr) / w * tanpsi
+	else {
+	    cospsi = 1 / sqrt (1 + tanpsi * tanpsi)
+	    sinpsi = tanpsi * cospsi
+	    d = GR_PIS(gr) / w * (GR_CE(gr) * sinpsi + GR_SE(gr) * (1 - cospsi))
+	}
+	if (abs(d) < 0.01) {
+	    if (d < 0)
+		d = -0.01
+	    else
+		d = 0.01
+	}
+	return (d)
+end
+
+
+# GR_DELTAR -- Blaze function phase angle for reflected component.
+
+real procedure gr_deltar (gr, w, m)
+
+pointer	gr		#I Grating pointer
+real	w		#I Wavelength
+int	m		#I Order
+real	d		#O Delta
+
+real	tanpsi, cospsi, sinpsi, gr_w2psir()
+
+begin
+	tanpsi = gr_w2psir (gr, w, m)
+	if (IS_INDEF(tanpsi))
+	    return (INDEF)
+
+	if (GR_FULL(gr) == NO)
+	    d = PI * GR_DB(gr) / w * tanpsi
+	else {
+	    cospsi = 1 / sqrt (1 + tanpsi * tanpsi)
+	    sinpsi = tanpsi * cospsi
+	    d = GR_PIS(gr) / w * (GR_CE(gr) * sinpsi + GR_SE(gr) * (1 - cospsi))
+	}
+	if (abs(d) < 0.01) {
+	    if (d < 0)
+		d = -0.01
+	    else
+		d = 0.01
+	}
+	return (d)
+end
+
+
+# GR_BLAZE -- Blaze pattern at given wavelength.
+
+real procedure gr_blaze (gr, w, m)
+
+pointer	gr		#I Grating pointer
+real	w		#I Wavelength
+int	m		#I Order
+real	val		#O Blaze pattern
+
+real	d, gr_delta()
+
+begin
+	d = gr_delta (gr, w, m)
+	if (IS_INDEF(d))
+	    val = 0.
+	else
+	    val = (sin (d) / d) ** 2
+	return (val)
+end
+
+
+# GR_PEAK -- Blaze peak corrected for light defracted into other orders.
+
+real procedure gr_peak (gr, w, m)
+
+pointer	gr		#I Grating pointer
+real	w		#I Wavelength (A)
+int	m		#I Order
+real	val		#O Blaze peak
+
+int	i, j
+real	frac, p
+real	gr_delta(), gr_deltar()
+
+begin
+	# Find the absolute response of the gratings at the reference
+	# blaze peak.
+
+	p = gr_delta (gr, w, m)
+	if (IS_INDEF(p))
+	    return (INDEF)
+	val = (sin (p) / p) ** 2
+	frac = 0.
+	do i = m - 1, 1, -1 {
+	    p = gr_delta (gr, w, i)
+	    if (IS_INDEF(p))
+		break
+	    frac = frac + (sin (p) / p) ** 2
+	    if (abs (p) > 1000.)
+		break
+	}
+	do i = m + 1, ARB {
+	    p = gr_delta (gr, w, i)
+	    if (IS_INDEF(p))
+		break
+	    frac = frac + (sin (p) / p) ** 2
+	    if (abs (p) > 1000.)
+		break
+	}
+
+	if (GR_FULL(gr) == YES && GR_TYPE(gr) > 0) {
+	    j = (GR_N(gr) * GR_SA(gr) + GR_TYPE(gr)) / GR_G(gr) / w
+	    do i = j+1, ARB, 1 {
+		p = gr_deltar (gr, w, i)
+		if (IS_INDEF(p))
+		    break
+		frac = frac + (sin (p) / p) ** 2
+		if (abs (p) > 1000.)
+		    break
+	    }
+	}
+
+	val = val / (val + frac) 
+
+	# Shadowing
+	if (GR_ALPHA(gr) < GR_BETA(gr) && GR_TYPE(gr) > 0)
+	    val = val * abs (GR_CA(gr) / GR_CB(gr))
+
+	return (val)
+end
+
+
+# GR_EFF -- Efficiency at specified wavelength and order.
+
+real procedure gr_eff (gr, w, m)
+
+pointer	gr		#I Grating pointer
+real	w		#I Wavelength
+int	m		#I Order
+real	eff		#O Efficiency
+
+real	gr_blaze(), gr_peak()
+
+begin
+	if (gr == NULL)
+	    return (INDEF)
+
+	if (GR_FULL(gr) == NO)
+	    return (GR_P(gr))
+
+	eff = gr_blaze (gr, w, m)
+	if (eff > 0.)
+	    eff =  eff * GR_P(gr) * gr_peak (gr, GR_WB(gr)/m, m)
+
+	return (eff)
+end
+
+
+# GR_W2DW -- Grating dispersion = cos (beta(w,m)) / (g * m * f)
+# This is corrected to a detector plane.
+
+real procedure gr_w2dw (gr, w, m)
+
+pointer	gr		#I Grating pointer
+real	w		#I Wavelength
+int	m		#I Order
+real	disp		#O Dispersion (A/mm)
+
+real	gr_sinbeta(), gr_w2x()
+
+begin
+	if (GR_FULL(gr) == NO)
+	    return (GR_DB(gr) / m)
+	
+	disp = gr_sinbeta (gr, w, m)
+	if (!IS_INDEF(disp)) {
+	    disp = sqrt (1 - disp * disp) / (GR_G(gr) * m * GR_F(gr))
+	    disp = disp / (1 + (gr_w2x (gr, w, m) / GR_F(gr))**2)
+	}
+	return (disp)
+end
+
+
+# GR_X2W -- Wavelength at given position relative to center.
+
+real procedure gr_x2w (gr, x, m)
+
+pointer	gr		#I Grating pointer
+real	x		#I Pixel position (mm from center)
+int	m		#I Order
+real	w		#O Wavelength (Angstroms)
+
+begin
+	if (GR_FULL(gr) == NO) {
+	    w = GR_WB(gr) + GR_DB(gr) / m * x
+	    return (w)
+	}
+
+	w = x / GR_F(gr)
+	w = atan (w) + GR_BETA(gr)
+	w = (GR_N(gr) * GR_SA(gr) + GR_TYPE(gr) * sin (w)) /
+	    (GR_G(gr) * m)
+	return (w)
+end
+
+
+# GR_W2X -- Position at given wavelength.
+
+real procedure gr_w2x (gr, w, m)
+
+pointer	gr		#I Grating pointer
+real	w		#I Wavelength (Angstroms)
+int	m		#I Order
+real	x		#I Pixel position (mm from center)
+
+begin
+	if (GR_FULL(gr) == NO) {
+	    x = (w - GR_WB(gr)) * m / GR_DB(gr)
+	    return (x)
+	}
+
+	x = (w * m * GR_G(gr) - GR_N(gr) * GR_SA(gr)) / GR_TYPE(gr)
+	x = asin (x) - GR_BETA(gr)
+	x = x * GR_F(gr)
+	return (x)
+end
+
+
+# GR_MAG -- Grating magnification = cos (alpha) / cos (beta(w,m))
+
+real procedure gr_mag (gr, w, m)
+
+pointer	gr		#I Grating pointer
+real	w		#I Wavelength
+int	m		#I Order
+real	mag		#O mag
+
+real	gr_sinbeta()
+
+begin
+	mag = gr_sinbeta (gr, w, m)
+	if (!IS_INDEF(mag))
+	    mag = GR_CA(gr) / sqrt (1 - mag * mag)
+	return (mag)
+end
+
+
+# GR_TILT -- Grating tilt = (alpha + beta) / 2
+
+real procedure gr_tilt (gr, w, m)
+
+pointer	gr		#I Grating pointer
+real	w		#I Wavelength
+int	m		#I Order
+real	tilt		#O tilt
+
+real	gr_sinbeta()
+
+begin
+	tilt = gr_sinbeta (gr, w, m)
+	if (!IS_INDEF(tilt))
+	    tilt = (GR_ALPHA(gr) + GR_TYPE(gr)*asin(tilt)) / 2
+	return (tilt)
+end
+
+
+# GR_SINBETA -- sin(beta(w,m)) = g * m * w - n * sin(alpha)
+# n is index of refraction which is different from 1 for a grism.
+
+real procedure gr_sinbeta (gr, w, m)
+
+pointer	gr		#I Grating pointer
+real	w		#I Wavelength
+int	m		#I Order
+real	sb		#O sin(beta)
+
+begin
+	if (gr == NULL)
+	    return (INDEF)
+	if (GR_FULL(gr) == NO)
+	    return (INDEF)
+
+	sb = (GR_G(gr) * m * w - GR_N(gr) * GR_SA(gr)) / GR_TYPE(gr)
+	if (abs(sb) >= 1.)
+	    sb = INDEF
+
+	return (sb)
+end
diff --git a/noao/obsutil/src/sptime/lib/abjohnson b/noao/obsutil/src/sptime/lib/abjohnson
new file mode 100644
index 00000000..b2bd6d2a
--- /dev/null
+++ b/noao/obsutil/src/sptime/lib/abjohnson
@@ -0,0 +1,17 @@
+# AB zeropoints.
+# Values are from Astrophysical Quantities converted from
+# log f (in W/cm^2/micron) to AB = -2.5 * log (F_lambda) - 5 log (lambda) - 2.4
+# where lambda is in Angstroms and F_lambda is in ergs/s/cm^2/A.  The
+# values are for U, B, V, R, I, J, H, Ks, K, L, L', M.
+
+ 3650  0.714
+ 4400 -0.167
+ 5500 -0.052
+ 7000  0.275
+ 9000  0.529
+12150  0.878
+16540  1.356
+21570  1.857
+35470  2.803
+37610  2.921
+47690  3.397
diff --git a/noao/obsutil/src/sptime/lib/circle b/noao/obsutil/src/sptime/lib/circle
new file mode 100644
index 00000000..ff3ca32e
--- /dev/null
+++ b/noao/obsutil/src/sptime/lib/circle
@@ -0,0 +1,21 @@
+# title = "Circular aperture"
+# type = "circular"
+
+0.00 0.000
+0.10 0.007
+0.13 0.011
+0.16 0.017
+0.20 0.027
+0.25 0.043
+0.32 0.067
+0.40 0.104
+0.50 0.160
+0.63 0.241
+0.79 0.354
+1.00 0.500
+1.26 0.667
+1.58 0.825
+2.00 0.937
+2.51 0.987
+3.16 0.999
+3.98 1.000
diff --git a/noao/obsutil/src/sptime/lib/slit b/noao/obsutil/src/sptime/lib/slit
new file mode 100644
index 00000000..2c39234a
--- /dev/null
+++ b/noao/obsutil/src/sptime/lib/slit
@@ -0,0 +1,103 @@
+# title = "Slit with Gaussian profile"
+# type = "rectangular"
+
+0.00 0.00 0.000
+0.13 0.00 0.000
+0.21 0.00 0.000
+0.32 0.00 0.000
+0.52 0.00 0.000
+0.82 0.00 0.000
+1.30 0.00 0.000
+2.05 0.00 0.000
+3.26 0.00 0.000
+5.17 0.00 0.000
+0.00 0.13 0.000
+0.13 0.13 0.009
+0.21 0.13 0.014
+0.32 0.13 0.022
+0.52 0.13 0.034
+0.82 0.13 0.051
+1.30 0.13 0.071
+2.05 0.13 0.088
+3.26 0.13 0.093
+5.17 0.13 0.094
+0.00 0.21 0.000
+0.13 0.21 0.014
+0.21 0.21 0.022
+0.32 0.21 0.034
+0.52 0.21 0.053
+0.82 0.21 0.080
+1.30 0.21 0.113
+2.05 0.21 0.139
+3.26 0.21 0.148
+5.17 0.21 0.148
+0.00 0.32 0.000
+0.13 0.32 0.022
+0.21 0.32 0.034
+0.32 0.32 0.054
+0.52 0.32 0.084
+0.82 0.32 0.126
+1.30 0.32 0.177
+2.05 0.32 0.218
+3.26 0.32 0.232
+5.17 0.32 0.233
+0.00 0.52 0.000
+0.13 0.52 0.034
+0.21 0.52 0.053
+0.32 0.52 0.084
+0.52 0.52 0.130
+0.82 0.52 0.196
+1.30 0.52 0.275
+2.05 0.52 0.338
+3.26 0.52 0.360
+5.17 0.52 0.361
+0.00 0.82 0.000
+0.13 0.82 0.051
+0.21 0.82 0.080
+0.32 0.82 0.126
+0.52 0.82 0.196
+0.82 0.82 0.294
+1.30 0.82 0.413
+2.05 0.82 0.509
+3.26 0.82 0.541
+5.17 0.82 0.542
+0.00 1.30 0.000
+0.13 1.30 0.071
+0.21 1.30 0.113
+0.32 1.30 0.177
+0.52 1.30 0.275
+0.82 1.30 0.413
+1.30 1.30 0.579
+2.05 1.30 0.714
+3.26 1.30 0.759
+5.17 1.30 0.761
+0.00 2.05 0.000
+0.13 2.05 0.088
+0.21 2.05 0.139
+0.32 2.05 0.218
+0.52 2.05 0.338
+0.82 2.05 0.509
+1.30 2.05 0.714
+2.05 2.05 0.880
+3.26 2.05 0.935
+5.17 2.05 0.938
+0.00 3.26 0.000
+0.13 3.26 0.093
+0.21 3.26 0.148
+0.32 3.26 0.232
+0.52 3.26 0.360
+0.82 3.26 0.541
+1.30 3.26 0.759
+2.05 3.26 0.935
+3.26 3.26 0.994
+5.17 3.26 0.997
+0.00 5.17 0.000
+0.13 5.17 0.094
+0.21 5.17 0.148
+0.32 5.17 0.233
+0.52 5.17 0.361
+0.82 5.17 0.542
+1.30 5.17 0.761
+2.05 5.17 0.938
+3.26 5.17 0.997
+5.17 5.17 1.000
diff --git a/noao/obsutil/src/sptime/mkcircle.cl b/noao/obsutil/src/sptime/mkcircle.cl
new file mode 100644
index 00000000..2fc61210
--- /dev/null
+++ b/noao/obsutil/src/sptime/mkcircle.cl
@@ -0,0 +1,16 @@
+# MKCIRCLE -- Fraction of Gaussian profile going through a circular aperture
+# of specified diameter in units of the profile FWHM.
+
+real	d, logd
+
+printf ("## CIRCLE -- Fraction of Gaussian profile going through a")
+printf (" cicular\n## aperture as a function of the diameter in units")
+printf (" of FWHM.\n\n")
+
+printf ("%4.2f %5.3f\n", 0, 0)
+for (logd=-1; logd<=0.6; logd=logd+0.1) {
+    d = 10.**logd
+    z = d * 0.8325546111577
+    z = 1 - exp (-(z * z))
+    printf ("%4.2f %5.3f\n", d, z)
+}
diff --git a/noao/obsutil/src/sptime/mkpkg b/noao/obsutil/src/sptime/mkpkg
new file mode 100644
index 00000000..21f5845d
--- /dev/null
+++ b/noao/obsutil/src/sptime/mkpkg
@@ -0,0 +1,20 @@
+# Make SPECTIME.
+
+$checkout libpkg.a ../
+$update   libpkg.a
+$checkin  libpkg.a ../
+$exit
+
+standalone:
+	$update	libpkg.a
+	$omake	x_spectime.x
+	$link	x_spectime.o libpkg.a -lsmw -liminterp -o xx_spectime.e
+	;
+
+libpkg.a:
+	grating.x	<error.h> <math.h>
+	stdisperser.x	sptime.h
+	t_cgiparse.x
+	t_sptime.x	sptime.h <error.h> <gset.h> <math.h> <ctype.h> <mach.h>
+	tabinterp.x	<error.h> <math/iminterp.h> <mach.h>
+	;
diff --git a/noao/obsutil/src/sptime/mkslit.cl b/noao/obsutil/src/sptime/mkslit.cl
new file mode 100644
index 00000000..240f851e
--- /dev/null
+++ b/noao/obsutil/src/sptime/mkslit.cl
@@ -0,0 +1,37 @@
+# MKSLIT -- Fraction of Gaussian profile going through a slit aperture
+# of specified width and height in units of the profile FWHM.
+
+real	logx, logy, t, erfcc, xval, yval
+
+printf ("## SLIT -- Fraction of Gaussian profile going through a")
+printf (" slit\n## aperture as a function of the width and height")
+printf (" in units of FWHM.\n\n")
+
+printf ("%4.2f %4.2f %5.3f\n", 0, 0, 0)
+for (logx=-1; logx<=0.6; logx=logx+0.2) {
+    x = 10.**logx
+    printf ("%4.2f %4.2f %5.3f\n", x, 0, 0)
+}
+for (logy=-1; logy<=0.6; logy=logy+0.2) {
+    y = 10.**logy
+    z = y * 0.8325546111577
+    t = 1. / (1. + 0.5 * z)
+    erfcc = t * exp (-z * z - 1.26551223 + t * (1.00002368 +
+	t * (0.37409196 + t * (0.09678418 + t * (-0.18628806 +
+	t * (0.27886807 + t * (-1.13520398 + t * (1.48851587 +
+	t * (-0.82215223 + t * 0.17087277)))))))))
+    yval = (1 - erfcc)
+    printf ("%4.2f %4.2f %5.3f\n", 0, y, 0)
+    for (logx=-1; logx<=0.6; logx=logx+0.2) {
+	x = 10.**logx
+	z = x * 0.8325546111577
+	t = 1. / (1. + 0.5 * z)
+	erfcc = t * exp (-z * z - 1.26551223 + t * (1.00002368 +
+	    t * (0.37409196 + t * (0.09678418 + t * (-0.18628806 +
+	    t * (0.27886807 + t * (-1.13520398 + t * (1.48851587 +
+	    t * (-0.82215223 + t * 0.17087277)))))))))
+	xval = (1 - erfcc)
+	z = xval * yval
+	printf ("%4.2f %4.2f %5.3f\n", x, y, z)
+    }
+}
diff --git a/noao/obsutil/src/sptime/rates.cl b/noao/obsutil/src/sptime/rates.cl
new file mode 100644
index 00000000..f664b097
--- /dev/null
+++ b/noao/obsutil/src/sptime/rates.cl
@@ -0,0 +1,74 @@
+procedure rates (grating, filter, order)
+
+file	grating				{prompt="Grating"}
+file	filter				{prompt="Filter"}
+int	order = INDEF			{prompt="Order"}
+real	wave = INDEF			{prompt="Central wavelength"}
+file	spectrograph = "rcspec"		{prompt="Spectrograph"}
+real	width = 10.			{prompt="Slit width"}
+
+string	title = ""			{prompt="Title"}
+real	w1 = 3000.			{prompt="Lower wavelength to plot"}
+real	w2 = 12000.			{prompt="Upper wavelength to plot\n"}
+
+real	x1 = 3000.			{prompt="Left graph wavelength"}
+real	x2 = 12000.			{prompt="Right graph wavelength"}
+real	y1 = -5.			{prompt="Bottom graph efficiency"}
+real	y2 = 105.			{prompt="Top graph efficiency"}
+string	ltype = "1"			{prompt="Line type"}
+string	color = "1"			{prompt="Color"}
+bool	append = no			{prompt="Append?"}
+
+struct	*fd
+
+begin
+	string	search
+	file	tmp1, tmp2
+	real	x, y
+
+	tmp1 = mktemp ("tmp$iraf")
+	tmp2 = mktemp ("tmp$iraf")
+
+	search = "spectimedb$,sptimeKPNO$"
+	search = search // ",sptimeKPNO$Spectrographs"
+	search = search // ",sptimeKPNO$Gratings"
+	search = search // ",sptimeKPNO$Grisms"
+	search = search // ",sptimeKPNO$Filters/RCCRYO"
+	search = search // ",sptimeKPNO$Filters/GCAM"
+
+	sptime (time=1., maxexp=3600., sn=25., spectrum="fnu_power",
+	    sky="none", sensfunc="none", airmass=1., seeing=1.5, phase=0.,
+	    temperature=6000., index=0., refwave=INDEF, refflux=10.,
+	    funits="AB", abjohnson="none", wave=wave, order=order,
+	    xorder=INDEF, width=width, length=INDEF, diameter=INDEF,
+	    inoutangle=INDEF, xinoutangle=INDEF, xbin=1, ybin=1,
+	    search=search, spectrograph=spectrograph, filter=filter,
+	    filter2="none", disperser=grating, xdisperser="none",
+	    fiber="none", telescope="", adc="", collimator="",
+	    corrector="", camera="", detector="", aperture="",
+	    extinction="", gain=INDEF, rdnoise=INDEF, dark=INDEF, skysub="none",
+	    nskyaps=10, output="rate", list=tmp2, graphics="",
+	    interactive=no, nw=1000, > "dev$null")
+
+	fd = tmp2
+	while (fscan (fd, x, y) != EOF) {
+	    if (nscan() != 2)
+		next
+	    if (x < w1 || x > w2)
+		next
+	    print (x, y, >> tmp1)
+	}
+	fd = ""
+
+	graph (tmp1, wx1=x1, wx2=x2, wy1=y1, wy2=y2, wcs="logical", axis=1,
+	    transpose=no, pointmode=no, marker="box", szmarker=0.005,
+	    ltypes=ltype, colors=color, logx=no, logy=no, box=yes,
+	    ticklabels=yes, xlabel="Wavelength (A)", ylabel="Rate",
+	    xformat="wcsformat", yformat="", title=title,
+	    lintran=no, p1=0., p2=0., q1=0., q2=1., vx1=0., vx2=0., vy1=0.,
+	    vy2=0., majrx=7, minrx=3, majry=7, minry=3, overplot=no,
+	    append=append, device="stdgraph", round=no, fill=yes)
+
+	delete (tmp1, verify-)
+	delete (tmp2, verify-)
+end
diff --git a/noao/obsutil/src/sptime/specpars.par b/noao/obsutil/src/sptime/specpars.par
new file mode 100644
index 00000000..79c6c7f0
--- /dev/null
+++ b/noao/obsutil/src/sptime/specpars.par
@@ -0,0 +1,85 @@
+spectrograph,s,h,"",,,Spectrograph transmission or table
+title,s,h,"",,,Spectrograph title
+apmagdisp,r,h,INDEF,,,Aperture magnification along dispersion
+apmagxdisp,r,h,INDEF,,,Aperture magnification across dispersion
+inoutangle,r,h,INDEF,,,Incident to diffracted angle (deg)
+xinoutangle,r,h,INDEF,,,"Incident to diffracted cross disperser angle (deg)
+
+# Telescope"
+telescope,s,h,"",,,Telescope transmission or table
+teltitle,s,h,"",,,Telescope title
+area,r,h,INDEF,,,Telescope effective area (m^2)
+scale,r,h,INDEF,,,Telescope scale at entrance aperture (arcsec/mm)
+emissivity,s,h,"",,,Emissivity value or table
+emistitle,s,h,"",,,"Emissivity title
+
+# Correctors"
+corrector,s,h,"",,,Corrector transmission or table
+cortitle,s,h,"",,,Corrector title
+adc,s,h,"",,,ADC transmission or table
+adctitle,s,h,"",,,"ADC title
+
+# Disperser"
+disperser,s,h,"",,,Disperser efficiency or table
+disptitle,s,h,"",,,Disperser title
+disptype,s,h,"",,,Disperser type (grating|grism|generic)
+gmm,r,h,INDEF,,,Grating (grooves/mm)
+blaze,r,h,INDEF,,,Blaze or prism angle (deg)
+oref,r,h,INDEF,,,Reference order
+wavelength,r,h,INDEF,,,Central wavelength in ref order (A)
+dispersion,r,h,INDEF,,,Dispersion at central wavelength in ref order (A/mm)
+indexref,r,h,INDEF,,,Index of refraction at first order
+eff,r,h,INDEF,,,"Peak efficiency
+
+# Crossdisperser"
+xdisperser,s,h,"",,,Crossdisperser efficiency or table
+xdisptitle,s,h,"",,,Crossdisperser title
+xdisptype,s,h,"",,,Disperser type (grating|grism|generic)
+xgmm,r,h,INDEF,,,Grating (grooves/mm)
+xblaze,r,h,INDEF,,,Blaze or prism angle (deg)
+xoref,r,h,INDEF,,,Reference order
+xwavelength,r,h,INDEF,,,Central wavelength in ref order (A)
+xindexref,r,h,INDEF,,,Index of refraction at first order
+xdispersion,r,h,INDEF,,,Dispersion at central wavelength in ref order (A/mm)
+xeff,r,h,INDEF,,,"Peak efficiency
+
+# Aperture"
+aperture,s,h,"",,,Aperture transmission or table
+aptitle,s,h,"",,,Aperture title
+aptype,s,h,"",,,"Aperture type (rectanglular|circular)
+
+# Fiber"
+fiber,s,h,"",,,Fiber transmission or table
+fibtitle,s,h,"",,,"Fiber title
+
+# Filters"
+filter,s,h,"",,,Filter transmission or table
+ftitle,s,h,"",,,Filter title
+filter2,s,h,"",,,Filter transmission or table
+f2title,s,h,"",,,Filter title
+block,s,h,"",,,"Assume other orders are blocked (yes|no)
+
+# Collimator"
+collimator,s,h,"",,,Collimator transmission or table
+coltitle,s,h,"",,,Collimator title
+colfl,r,h,INDEF,,,"Collimator focal length (m)
+
+# Camera"
+camera,s,h,"",,,Camera transmission or table
+camtitle,s,h,"",,,Camera title
+camfl,r,h,INDEF,,,Camera focal length (m)
+resolution,r,h,INDEF,,,Camera resolution (mm)
+vignetting,s,h,"",,,"Vignetting table
+
+# Detector"
+detector,s,h,"",,,Detector DQE or table
+dettitle,s,h,"",,,Detector title
+ndisp,r,h,INDEF,,,Detector pixels along dispersion
+pixsize,r,h,INDEF,,,Detector pixel size (mm)
+gain,r,h,INDEF,,,Detector gain (photons/ADU)
+rdnoise,r,h,INDEF,,,Detector read noise (photons)
+dark,r,h,INDEF,,,Detector dark count rate (photons/s)
+saturation,r,h,INDEF,,,Detector saturation (photons)
+dnmax,r,h,INDEF,,,Detector maximum counts (ADU)
+xbin,i,h,1,1,,Detector binning (dispersion)
+ybin,i,h,1,1,,Detector binning (spatial)
diff --git a/noao/obsutil/src/sptime/sptime.h b/noao/obsutil/src/sptime/sptime.h
new file mode 100644
index 00000000..c17b377a
--- /dev/null
+++ b/noao/obsutil/src/sptime/sptime.h
@@ -0,0 +1,132 @@
+# Definitions for SPTIME.
+
+# Spectral distribution types.
+define	SPECTYPES	"|blackbody|flambda_power|fnu_power|"
+define	SPEC_TAB	0
+define	SPEC_BB		1
+define	SPEC_FL		2
+define	SPEC_FN		3
+
+# Flux units.
+define	FUNITS		"|AB|F_lambda|F_nu|U|B|V|R|I|J|H|Ks|K|L|L'|M|"
+define	AB		1
+define	FLAMBDA		2
+define	FNU		3
+define	UMAG		4
+define	BMAG		5
+define	VMAG		6
+define	RMAG		7
+define	IMAG		8
+define	JMAG		9
+define	HMAG		10
+define	KSMAG		11
+define	KMAG		12
+define	LMAG		13
+define	LPMAG		14
+define	MMAG		15
+
+# Sky subtraction options.
+define	SKYSUB		"|none|longslit|multiap|shuffle|"
+define	SKY_NONE	1
+define	SKY_LONGSLIT	2
+define	SKY_MULTIAP	3
+define	SKY_SHUFFLE	4
+
+# Aperture types.
+define	APTYPES		"|circular|rectangular|"
+define	CIRCULAR	1
+define	RECTANGULAR	2
+
+# Output types.
+define	OUTTYPES	"|counts|snr|object|rate|atmosphere|telescope|adc|\
+			 |aperture|fiber|filter|filter2|collimator|disperser|\
+			 |xdisperser|corrector|camera|detector|spectrograph|\
+			 |emissivity|thruput|sensfunc|correction|"
+define	OUT_COUNTS	1
+define	OUT_SNR		2
+define	OUT_OBJ		3
+define	OUT_RATE	4
+define	OUT_ATM		5
+define	OUT_TEL		6
+define	OUT_ADC		7
+define	OUT_AP		9
+define	OUT_FIB		10
+define	OUT_FILT	11
+define	OUT_FILT2	12
+define	OUT_COL		13
+define	OUT_DISP	14
+define	OUT_XDISP	16
+define	OUT_COR		17
+define	OUT_CAM		18
+define	OUT_DET		19
+define	OUT_SPEC	20
+define	OUT_EMIS	22
+define	OUT_THRU	23
+define	OUT_SENS	24
+define	OUT_CORRECT	25
+
+# Grating types.
+define	DISPTYPES	"|grating|grism|generic"
+define	GRATING		1
+define	GRISM		2
+define	GENERIC		3
+
+# Macros.
+define	MINEXP		0.01		# Minimum exposure time.
+define	MAXNEXP		10000		# Maximum number of exposures.
+define	MAXITER		50
+define	H		6.626E-27
+define	C		2.99792456E18
+
+# Data structure.
+define	ST_SZSTRING	99			# Length of strings
+define	ST_LEN		154			# Structure length
+
+define	ST_TAB		Memi[$1]		# Tables pointer
+define	ST_SEARCH	Memi[$1+1]		# Search list
+define	ST_SPEC		Memi[$1+2]		# Spectrum type
+define	ST_PARAM	Memr[P2R($1+3)]		# Spectrum parameter
+define	ST_THERMAL	Memr[P2R($1+4)]		# Thermal background temperature
+define	ST_AV		Memr[P2R($1+5)]		# A(V)
+define	ST_RV		Memr[P2R($1+6)]		# A(V)/E(B-V)
+define	ST_TIME		Memr[P2R($1+7)]		# Exposure time
+define	ST_NEXP		Memi[$1+8]		# Number of exposures
+define	ST_MINEXP	Memr[P2R($1+9)]		# Minimum time per integration
+define	ST_MAXEXP	Memr[P2R($1+10)]	# Maximum time per integration
+define	ST_AIRMASS	Memr[P2R($1+11)]	# Airmass
+define	ST_SEEING	Memr[P2R($1+12)]	# Seeing (FWHM in arcsec)
+define	ST_PHASE	Memr[P2R($1+13)]	# Moon phase
+define	ST_REFW		Memr[P2R($1+14)]	# Reference wavelength
+define	ST_REFF		Memr[P2R($1+15)]	# Reference flux
+define	ST_REFFL	Memr[P2R($1+16)]	# Reference flambda
+define	ST_CW		Memr[P2R($1+17)]	# Central wavelength
+define	ST_ORDER	Memi[$1+17+$2]		# Grating orders (2)
+define	ST_APSIZE	Memr[P2R($1+19+$2)]	# Aperture sizes (2) 
+define	ST_BIN		Memi[$1+21+$2]		# Binning (2)
+define	ST_GAIN		Memr[P2R($1+24)]	# Detector gain
+define	ST_RDNOISE	Memr[P2R($1+25)]	# Detector read noise
+define	ST_DARK		Memr[P2R($1+26)]	# Detector dark counts
+define	ST_INOUTA	Memr[P2R($1+26+$2)]	# Incident-diffracted angle(deg)
+define	ST_SKYSUB	Memi[$1+29]		# Sky subtraction type
+define	ST_NSKYAPS	Memi[$1+30]		# Number of sky apertures
+
+define	ST_DISPTYPE	Memi[$1+30+$2]		# Disperser type
+define	ST_GR		Memi[$1+32+$2]		# Grating pointer (2)
+define	ST_DISP		Memr[P2R($1+34+$2)]	# Dispersion (2)
+define	ST_SCALE	Memr[P2R($1+36+$2)]	# Scale at detector (2)
+define	ST_RES		Memr[P2R($1+38+$2)]	# Resolution at detector (2)
+define	ST_AREA		Memr[P2R($1+41)]	# Effective collecting area
+define	ST_TELSCALE	Memr[P2R($1+42)]	# Telescope scale at aperture
+define	ST_NOBJPIX	Memi[$1+43]		# Number of object pixels
+define	ST_NSKYPIX	Memi[$1+44]		# Number of sky pixels
+define	ST_APLIM	Memi[$1+45]		# Aperture limited?
+define	ST_APTYPE	Memi[$1+46]		# Aperture type
+define	ST_PIXSIZE	Memr[P2R($1+47)]	# Pixel weighted disp. size
+define	ST_FILTBLK	Memi[$1+48]		# Block filter flag
+define	ST_DUNANG	Memi[$1+49]		# Angstrom units pointer
+define	ST_DUN		Memi[$1+50]		# User units pointer
+define	ST_SUBPIXELS	Memi[$1+51]		# Number of subpixels
+define	ST_COLFL	Memr[P2R($1+52)]	# Collimator focal length
+define	ST_CAMFL	Memr[P2R($1+53)]	# Collimator focal length
+define	ST_DUNITS	Memc[P2C($1+54)]	# Dispersion units
+define	ST_FUNITS	Memc[P2C($1+104)]	# Flux units
diff --git a/noao/obsutil/src/sptime/sptime.par b/noao/obsutil/src/sptime/sptime.par
new file mode 100644
index 00000000..0342e4f2
--- /dev/null
+++ b/noao/obsutil/src/sptime/sptime.par
@@ -0,0 +1,53 @@
+time,r,h,INDEF,,,Total exposure time (sec)
+sn,r,h,25.,,,"S/N per pixel if time is INDEF
+
+# Source and background parameters"
+spectrum,s,h,"blackbody",,,Source spectrum
+spectitle,s,h,"",,,Spectrum title
+E,r,h,0.,,,E(B-V)
+R,r,h,3.1,,,A(V)/E(B-V)
+sky,s,h,"",,,Sky spectrum
+skytitle,s,h,"",,,Sky title
+extinction,s,h,"",,,Extinction value or table
+exttitle,s,h,"",,,"Extinction title
+
+# Spectral distribution parameters"
+refwave,r,h,INDEF,,,Reference wavelength
+refflux,r,h,10,,,Source flux at reference wavelength
+funits,s,h,"AB","AB|F_lambda|F_nu|U|B|V|R|I|J|H|Ks|K|L|L'|M|",,Reference flux units
+temperature,r,h,6000.,,,Blackbody temperature (K)
+index,r,h,0.,,,"Power law index
+
+# Observation parameters"
+seeing,r,h,1.,,,Seeing (arcsec)
+airmass,r,h,1.,0.,,Airmass
+phase,r,h,0.,0.,14.,Moon phase (0-14)
+thermal,r,h,0.,,,Thermal background temperature (K)
+wave,r,h,INDEF,,,Central wavelength
+order,i,h,INDEF,,,Order for grating
+xorder,i,h,INDEF,,,Order for crossdisperser grating
+width,r,h,INDEF,,,Slit width (-=pixels +=arcsec)
+length,r,h,INDEF,,,Slit length (-=pixels +=arcsec)
+diameter,r,h,INDEF,,,Circular/fiber aperture diameter (-=pixels +=arcsec)
+xbin,i,h,1,1,,Detector binning (dispersion)
+ybin,i,h,1,1,,"Detector binning (spatial)
+
+# Calculation parameters"
+search,s,h,"spectimedb$",,,List of directories to search for tables
+minexp,r,h,0.01,,,Minimum time per exposure (sec)
+maxexp,r,h,3600.,,,Maximum time per exposure (sec)
+units,s,h,"Angstroms",,,Wavelength units
+skysub,s,h,"",,,Type of sky subtaction (none|longslit|multiap|shuffle)
+nskyaps,i,h,10,0,,Number of multiap sky apertures
+subpixels,i,h,INDEF,,,Number of subpixels in calculation
+sensfunc,s,h,"",,,"Sensitivity function value or table
+
+# Output parameters"
+output,s,h,"",,,List of output quantities
+nw,i,h,101,,,Number of output dispersion points
+list,s,h,"",,,Output list file
+graphics,s,h,"stdgraph",,,Graphics device
+interactive,b,h,yes,,,"Interactive pause after graphs?
+
+# Spectrograph parameters"
+specpars,pset,h,"",,,Spectrograph parameters
diff --git a/noao/obsutil/src/sptime/stdisperser.x b/noao/obsutil/src/sptime/stdisperser.x
new file mode 100644
index 00000000..090cf010
--- /dev/null
+++ b/noao/obsutil/src/sptime/stdisperser.x
@@ -0,0 +1,455 @@
+include	"sptime.h"
+
+# These routines interface between any type of disperser and the
+# disperser type specific routines (such as those for gratings).
+
+
+# ST_DISPERSER -- Initialize disperser data.
+
+procedure st_disperser (st, name, index)
+
+pointer st		#I SPECTIME pointer
+char	name[ARB]	#I Table name
+int	index		#I Grating index
+
+int	order, oref, stgeti(), tabgeti(), strdic()
+real	f, phi, g, blaze, wb, db, ref, stgetr(), tabgetr(), gr_getr()
+pointer sp, str, fname, gr, gr_open()
+bool	streq()
+errchk	gr_open, tab_getr, gr_getr, st_gtable1
+
+begin
+	call smark (sp)
+	call salloc (str, SZ_LINE, TY_CHAR)
+	call salloc (fname, SZ_LINE, TY_CHAR)
+
+	ST_GR(st,index) = NULL
+	ST_DISPTYPE(st,index) = 0
+
+	# Get disperser type.
+	if (streq (name, "disperser")) {
+	    call stgstr (st, "disptype", "disperser", "", Memc[str], SZ_LINE)
+	    if (Memc[str] == EOS) {
+		iferr (call tabgstr (ST_TAB(st), "disperser", "spectrograph",
+		    "type", Memc[str], SZ_LINE))
+		    call strcpy ("generic", Memc[str], SZ_LINE)
+	    }
+	} else if (streq (name, "xdisperser")) {
+	    call stgstr (st, "xdisptype", "xdisperser", "", Memc[str], SZ_LINE)
+	    if (Memc[str] == EOS) {
+		iferr (call tabgstr (ST_TAB(st), "xdisperser", "spectrograph",
+		    "type", Memc[str], SZ_LINE))
+		    Memc[str] = EOS
+	    }
+	} else
+	    Memc[str] = EOS
+	ST_DISPTYPE(st,index) = strdic (Memc[str],Memc[str],SZ_LINE,DISPTYPES)
+
+	switch (ST_DISPTYPE(st,index)) {
+	case GRATING:
+	    f = ST_CAMFL(st) * 1000
+	    switch (index) {
+	    case 1:
+		g = stgetr (st, "gmm", name, INDEFR)
+		blaze = stgetr (st, "blaze", name, INDEFR)
+		oref = stgeti (st, "oref", name, 1)
+		wb = stgetr (st, "wavelength", name, INDEFR)
+		db = stgetr (st, "dispersion", name, INDEFR)
+		ref = stgetr (st, "eff", name, INDEFR)
+	    case 2:
+		g = stgetr (st, "xgmm", name, INDEFR)
+		blaze = stgetr (st, "xblaze", name, INDEFR)
+		oref = stgeti (st, "xoref", name, 1)
+		wb = stgetr (st, "xwavelength", name, INDEFR)
+		db = stgetr (st, "xdispersion", name, INDEFR)
+		ref = stgetr (st, "xeff", name, INDEFR)
+
+		# Check old names.
+		if (IS_INDEFR(g)) {
+		    iferr (g = tabgetr (ST_TAB(st), name, "spectrograph",
+			"gmm"))
+		    g = INDEFR
+		}
+	    }
+
+	    # Old names.
+	    if (IS_INDEFR(g)) {
+		iferr (g = tabgetr (ST_TAB(st), name, "spectrograph",
+		    "gmm"))
+		    g = INDEFR
+	    }
+	    if (IS_INDEFR(blaze)) {
+		iferr (blaze = tabgetr (ST_TAB(st), name, "spectrograph",
+		    "blaze"))
+		    blaze = INDEFR
+	    }
+	    if (IS_INDEFI(oref)) {
+		iferr (oref = tabgeti (ST_TAB(st), name, "spectrograph",
+		    "oref"))
+		    oref = 1
+	    }
+	    if (IS_INDEFR(wb)) {
+		iferr (wb = tabgetr (ST_TAB(st), name, "spectrograph",
+		    "wavelength"))
+		    wb = INDEFR
+	    }
+	    if (IS_INDEFR(db)) {
+		iferr (db = tabgetr (ST_TAB(st), name, "spectrograph",
+		    "dispersion"))
+		    db = INDEFR
+	    }
+	    if (IS_INDEFR(ref)) {
+		iferr (ref = tabgetr (ST_TAB(st), name, "spectrograph",
+		    "reflectance"))
+		    ref = 1.
+	    }
+
+	    phi = ST_INOUTA(st,index)
+#	    if (!IS_INDEFR(db))
+#		db = db / f
+
+	    iferr (gr = gr_open (ST_CW(st), ST_ORDER(st,index), ref, wb, db,
+		oref, f, g, blaze, 1., phi, INDEF, INDEF, 1, YES)) {
+		g = 300.
+		blaze = 6
+	        gr = gr_open (ST_CW(st), ST_ORDER(st,index), ref, wb, db,
+		    oref, f, g, blaze, 1., phi, INDEF, INDEF, 1, YES)
+	    }
+	    ST_GR(st,index) = gr
+
+	    if (IS_INDEF(ST_CW(st)))
+		ST_CW(st,index) = gr_getr (gr, "wavelength")
+	    if (IS_INDEFI(ST_ORDER(st,index)))
+		ST_ORDER(st,index) = nint (gr_getr (gr, "order"))
+	    ST_DISP(st,index) = gr_getr (gr, "dblaze") * oref * f
+
+	    # Look for explicit blaze functions.
+	    do order = ST_ORDER(st,index)-1, ST_ORDER(st,index)+1 {
+		call sprintf (Memc[str], SZ_LINE, "eff%d")
+		    call pargi (order)
+		ifnoerr (call tabgstr (ST_TAB(st), name, "spectrograph",
+		    Memc[str], Memc[fname], SZ_LINE)) {
+		    if (streq (name, "disperser"))
+			call st_gtable1 (st, Memc[str], Memc[fname])
+		    else if (streq (name, "xdisperser")) {
+			call sprintf (Memc[str], SZ_LINE, "xeff%d")
+			    call pargi (order)
+			call st_gtable1 (st, Memc[str], Memc[fname])
+		    }
+		}
+	    }
+	case GRISM:
+	    f = ST_CAMFL(st) * 1000
+	    switch (index) {
+	    case 1:
+		g = stgetr (st, "gmm", name, INDEFR)
+		blaze = stgetr (st, "blaze", name, INDEFR)
+		ref = stgetr (st, "eff", name, 1.)
+		db = stgetr (st, "indexref", name, INDEFR)
+		if (!IS_INDEFI(ST_ORDER(st,index)) && ST_ORDER(st,index)!=1) {
+		    call sprintf (Memc[str], SZ_LINE, "index%d")
+			call pargi (ST_ORDER(st,index))
+		    iferr (wb = tabgetr (ST_TAB(st), name, "spectrograph",
+			Memc[str]))
+			wb = db
+		    db = wb
+		}
+	    case 2:
+		g = stgetr (st, "xgmm", name, INDEFR)
+		blaze = stgetr (st, "xblaze", name, INDEFR)
+		ref = stgetr (st, "xeff", name, 1.)
+		db = stgetr (st, "xindexref", name, INDEFR)
+		if (!IS_INDEFI(ST_ORDER(st,index)) && ST_ORDER(st,index)!=1) {
+		    call sprintf (Memc[str], SZ_LINE, "index%d")
+			call pargi (ST_ORDER(st,index))
+		    iferr (wb = tabgetr (ST_TAB(st), name, "spectrograph",
+			Memc[str]))
+			wb = db
+		    db = wb
+		}
+	    }
+
+	    # Old names.
+	    if (IS_INDEFR(g)) {
+		iferr (g = tabgetr (ST_TAB(st), name, "spectrograph",
+		    "gmm"))
+		    g = INDEFR
+	    }
+	    if (IS_INDEFR(blaze)) {
+		iferr (blaze = tabgetr (ST_TAB(st), name, "spectrograph",
+		    "prism"))
+		    blaze = INDEFR
+	    }
+	    if (IS_INDEFR(ref)) {
+		iferr (ref = tabgetr (ST_TAB(st), name, "spectrograph",
+		    "transmission"))
+		    ref = 1
+	    }
+	    if (IS_INDEFR(db)) {
+		if (!IS_INDEFI(ST_ORDER(st,index))) {
+		    call sprintf (Memc[str], SZ_LINE, "index%d")
+			call pargi (ST_ORDER(st,index))
+		    iferr (db = tabgetr (ST_TAB(st), name, "spectrograph",
+			Memc[str]))
+			db = tabgetr (ST_TAB(st), name, "spectrograph",
+			    "index1")
+		} else
+		    db = tabgetr (ST_TAB(st), name, "spectrograph", "index1")
+	    }
+	    oref = 1
+
+	    iferr (gr = gr_open (ST_CW(st), ST_ORDER(st,index), ref, INDEF,
+		INDEF, oref, f, g, blaze, db, 0., blaze, blaze, 1, YES)) {
+		g = 300.
+		blaze = 6.
+		gr = gr_open (ST_CW(st), ST_ORDER(st,index), ref, INDEF,
+		    INDEF, oref, f, g, blaze, db, 0., blaze, blaze, 1, YES)
+	    }
+
+	    ST_GR(st,index) = gr
+
+	    if (IS_INDEF(ST_CW(st)))
+		ST_CW(st,index) = gr_getr (gr, "wavelength")
+	    if (IS_INDEFI(ST_ORDER(st,index)))
+		ST_ORDER(st,index) = nint (gr_getr (gr, "order"))
+	    ST_DISP(st,index) = gr_getr (gr, "dblaze") * oref * f
+
+	    # Look for explicit blaze functions.
+	    do order = ST_ORDER(st,index)-1, ST_ORDER(st,index)+1 {
+		call sprintf (Memc[str], SZ_LINE, "eff%d")
+		    call pargi (order)
+		ifnoerr (call tabgstr (ST_TAB(st), name, "spectrograph",
+		    Memc[str], Memc[fname], SZ_LINE)) {
+		    if (streq (name, "disperser"))
+			call st_gtable1 (st, Memc[str], Memc[fname])
+		    else if (streq (name, "xdisperser")) {
+			call sprintf (Memc[str], SZ_LINE, "xeff%d")
+			    call pargi (order)
+			call st_gtable1 (st, Memc[str], Memc[fname])
+		    }
+		}
+	    }
+	case GENERIC:
+	    f = ST_CAMFL(st) * 1000
+	    g = INDEFR
+	    blaze = INDEFR
+	    oref = 1
+
+	    switch (index) {
+	    case 1:
+		g = INDEFR
+		blaze = INDEFR
+		oref = 1
+		wb = stgetr (st, "wavelength", name, INDEFR)
+		db = stgetr (st, "dispersion", name, INDEFR)
+		ref = stgetr (st, "eff", name, INDEFR)
+	    case 2:
+		g = INDEFR
+		blaze = INDEFR
+		oref = 1
+		wb = stgetr (st, "xwavelength", name, INDEFR)
+		db = stgetr (st, "xdispersion", name, INDEFR)
+		ref = stgetr (st, "xeff", name, INDEFR)
+	    }
+
+	    if (IS_INDEFR(wb)) {
+		iferr (wb = tabgetr (ST_TAB(st), name, "spectrograph",
+		    "wavelength"))
+		    wb = INDEFR
+	    }
+	    if (IS_INDEFR(db)) {
+		iferr (db = tabgetr (ST_TAB(st), name, "spectrograph",
+		    "dispersion"))
+		    db = INDEFR
+	    }
+	    if (IS_INDEFR(ref)) {
+		iferr (ref = tabgetr (ST_TAB(st), name, "spectrograph",
+		    "reflectance"))
+		    ref = 1.
+	    }
+
+	    phi = ST_INOUTA(st,index)
+
+	    gr = gr_open (ST_CW(st), ST_ORDER(st,index), ref, wb, db,
+		oref, f, g, blaze, 1., phi, INDEF, INDEF, 1, NO)
+	    ST_GR(st,index) = gr
+
+	    if (IS_INDEF(ST_CW(st)))
+		ST_CW(st,index) = gr_getr (gr, "wavelength")
+	    if (IS_INDEFI(ST_ORDER(st,index)))
+		ST_ORDER(st,index) = nint (gr_getr (gr, "order"))
+	    ST_DISP(st,index) = gr_getr (gr, "dblaze") * oref * f
+
+	    # Look for explicit blaze functions.
+	    do order = ST_ORDER(st,index)-1, ST_ORDER(st,index)+1 {
+		call sprintf (Memc[str], SZ_LINE, "eff%d")
+		    call pargi (order)
+		ifnoerr (call tabgstr (ST_TAB(st), name, "spectrograph",
+		    Memc[str], Memc[fname], SZ_LINE)) {
+		    if (streq (name, "disperser"))
+			call st_gtable1 (st, Memc[str], Memc[fname])
+		    else if (streq (name, "xdisperser")) {
+			call sprintf (Memc[str], SZ_LINE, "xeff%d")
+			    call pargi (order)
+			call st_gtable1 (st, Memc[str], Memc[fname])
+		    }
+		}
+	    }
+	}
+
+	call sfree (sp)
+end
+
+
+# ST_DISPEFF -- Return disperser efficiency.
+
+real procedure st_dispeff (st, name, wave, order)
+
+pointer st		#I SPECTIME pointer
+char	name[ARB]	#I Table name
+real	wave		#I Wavelength
+int	order		#I Order
+real	eff		#O Efficiency
+
+real	w
+pointer	sp, tab, str
+
+int	tabgeti()
+real	tabinterp1(), tabgetr(), gr_eff()
+bool	tabexists(), streq()
+errchk	tabinterp1, gr_eff
+
+begin
+	tab = ST_TAB(st)
+	eff = INDEF
+
+	if (streq (name, "disperser") && ST_DISPTYPE(st,1) == 0)
+	    return (eff)
+	if (streq (name, "xdisperser") && ST_DISPTYPE(st,2) == 0)
+	    return (eff)
+
+	call smark (sp)
+	call salloc (str, SZ_FNAME, TY_CHAR)
+	if (streq (name, "disperser")) {
+	    call sprintf (Memc[str], SZ_FNAME, "eff%d")
+		call pargi (order)
+	    if (!tabexists (tab, Memc[str])) {
+		if (order == 1 && tabexists (tab, name)) {
+		    if (tabgeti (tab, name, "", "table.ndim") != 0)
+			call strcpy (name, Memc[str], SZ_FNAME)
+		}
+	    }
+	    if (tabexists (tab, Memc[str])) {
+		eff = tabinterp1 (tab, Memc[str], wave)
+		w = max (tabgetr (tab, Memc[str], "", "table.xmin"), wave)
+		w = min (tabgetr (tab, Memc[str], "", "table.xmax"), w)
+		if (w != wave) {
+		    eff = tabinterp1 (tab, Memc[str], w) /
+		        gr_eff (ST_GR(st,1), w, order)
+		    eff = eff * gr_eff (ST_GR(st,1), wave, order)
+		}
+	    } else
+		eff = gr_eff (ST_GR(st,1), wave, order)
+	} else if (streq (name, "xdisperser")) {
+	    call sprintf (Memc[str], SZ_FNAME, "xeff%d")
+		call pargi (order)
+	    if (!tabexists (tab, Memc[str])) {
+		if (order == 1 && tabexists (tab, name)) {
+		    if (tabgeti (tab, name, "", "table.ndim") != 0)
+			call strcpy (name, Memc[str], SZ_FNAME)
+		}
+	    }
+	    if (tabexists (tab, Memc[str])) {
+		eff = tabinterp1 (tab, Memc[str], wave)
+		w = max (tabgetr (tab, Memc[str], "", "table.xmin"), wave)
+		w = min (tabgetr (tab, Memc[str], "", "table.xmax"), w)
+		if (w != wave) {
+		    eff = tabinterp1 (tab, Memc[str], w) /
+		        gr_eff (ST_GR(st,2), w, order)
+		    eff = eff * gr_eff (ST_GR(st,2), wave, order)
+		}
+	    } else
+		eff = gr_eff (ST_GR(st,2), wave, order)
+	}
+
+	if (IS_INDEF(eff))
+	    eff = 0.
+
+	call sfree (sp)
+	return (eff)
+end
+
+
+# ST_X2W -- Return wavelength at given position on detector.
+
+real procedure st_x2w (st, index, x)
+
+pointer st		#I SPECTIME pointer
+int	index		#I Grating index
+real	x		#I Detector position (mm from center)
+real	w		#O Wavelength (Angstroms)
+
+real	gr_x2w()
+
+begin
+	switch (ST_DISPTYPE(st,index)) {
+	case GRATING:
+	    w = gr_x2w (ST_GR(st,index), x, ST_ORDER(st,index)) 
+	case GRISM:
+	    w = gr_x2w (ST_GR(st,index), x, ST_ORDER(st,index)) 
+	case GENERIC:
+	    w = gr_x2w (ST_GR(st,index), x, ST_ORDER(st,index)) 
+	}
+
+	return (w)
+end
+
+
+# ST_W2X -- Return wavelength at given position on detector.
+
+real procedure st_w2x (st, index, w)
+
+pointer st		#I SPECTIME pointer
+int	index		#I Grating index
+real	w		#I Wavelength (Angstroms)
+real	x		#O Detector position (mm from center)
+
+real	gr_w2x()
+
+begin
+	switch (ST_DISPTYPE(st,index)) {
+	case GRATING:
+	    x = gr_w2x (ST_GR(st,index), w, ST_ORDER(st,index)) 
+	case GRISM:
+	    x = gr_w2x (ST_GR(st,index), w, ST_ORDER(st,index)) 
+	case GENERIC:
+	    x = gr_w2x (ST_GR(st,index), w, ST_ORDER(st,index)) 
+	}
+
+	return (x)
+end
+
+
+# ST_W2DW -- Return dispersion on detector at given wavelength.
+
+real procedure st_w2dw (st, index, w)
+
+pointer st		#I SPECTIME pointer
+int	index		#I Grating index
+real	w		#I Wavelength (Angstroms)
+real	d		#I Dispersion (Angstroms/mm)
+
+real	gr_w2dw()
+
+begin
+	switch (ST_DISPTYPE(st,index)) {
+	case GRATING:
+	    d = gr_w2dw (ST_GR(st,index), w, ST_ORDER(st,index)) 
+	case GRISM:
+	    d = gr_w2dw (ST_GR(st,index), w, ST_ORDER(st,index)) 
+	case GENERIC:
+	    d = gr_w2dw (ST_GR(st,index), w, ST_ORDER(st,index)) 
+	}
+
+	return (d)
+end
diff --git a/noao/obsutil/src/sptime/t_cgiparse.x b/noao/obsutil/src/sptime/t_cgiparse.x
new file mode 100644
index 00000000..8985a8f0
--- /dev/null
+++ b/noao/obsutil/src/sptime/t_cgiparse.x
@@ -0,0 +1,110 @@
+define	SZ_QUERY	2048
+
+
+# T_CGIPARSE -- Parse the CGI QUERY_STRING environment variable.
+# The string is expected to be a set of task.param=value pairs.
+# The task parameter values are set.
+
+procedure t_cgiparse ()
+
+char	c, hex[2]
+int	i
+long	hexval
+pointer	sp, str, par, val
+pointer	ip, op
+
+int	envfind(), gctol()
+
+begin
+	call smark (sp)
+	call salloc (str, SZ_QUERY, TY_CHAR)
+	call salloc (par, SZ_LINE, TY_CHAR)
+	call salloc (val, SZ_LINE, TY_CHAR)
+
+	# Get the query string.  If there isn't one then do nothing.
+	if (envfind ("QUERY_STRING", Memc[str], SZ_QUERY) <= 0)
+	    return
+	
+	# Parse the query string into parameters and values.
+	# For each pair set the task parameter.
+
+	op = par
+	for (ip=str;; ip=ip+1) {
+	    c = Memc[ip]
+	    switch (c) {
+	    case '&', EOS:		# End of parameter=value
+		Memc[op] = EOS
+		call cgi_setpar (Memc[par], Memc[val])
+		if (c == EOS)
+		    break
+		Memc[par] = EOS
+		Memc[val] = EOS
+		op = par
+		next
+	    case '=':			# Separator between parameters and value
+		Memc[op] = EOS
+		op = val
+		next
+	    case '+':			# Space character
+		c = ' '
+	    case '%':			# Special characters in hex
+		call strcpy (Memc[ip+1], hex, 2)
+		i = 1
+		if (gctol (hex, i, hexval, 16) > 0) {
+		    c = hexval
+		    ip = ip + 2
+		}
+	    }
+
+	    Memc[op] = c
+	    op = op + 1
+	}
+
+	call sfree (sp)
+end
+
+
+# CGI_SETPAR -- Set parameter value.
+# There is no error check for undefined tasks or parameters.
+# Values of the wrong type are ignored.
+
+procedure cgi_setpar (param, val)
+
+char	param[ARB]		#I Task parameter
+char	val[ARB]		#I Value string
+
+bool	bval, streq()
+int	ival, ip, ctoi(), ctod()
+double	dval
+pointer	sp, str, type
+
+begin
+	call smark (sp)
+	call salloc (str, SZ_LINE, TY_CHAR)
+	call salloc (type, 10, TY_CHAR)
+
+	# Determine if parameter type.
+	call sprintf (Memc[str], SZ_LINE, "%s.p_type")
+	    call pargstr (param)
+	call clgstr (Memc[str], Memc[type], 10)
+
+	# Set parameter in the approriate type.
+	ip = 1
+	switch (Memc[type]) {
+	case 'i':
+	    if (ctoi (val, ip, ival) > 0)
+		call clputi (param, ival)
+	case 'r':
+	    if (ctod (val, ip, dval) > 0)
+		call clputd (param, dval)
+	case 'b':
+	    if (streq (val, "no") || streq (val, "yes")) {
+		bval = streq (val, "yes")
+		call clputb (param, bval)
+	    }
+	default:
+	    call clpstr (param, val)
+	}
+
+	call sfree (sp)
+end
diff --git a/noao/obsutil/src/sptime/t_sptime.x b/noao/obsutil/src/sptime/t_sptime.x
new file mode 100644
index 00000000..6d052acf
--- /dev/null
+++ b/noao/obsutil/src/sptime/t_sptime.x
@@ -0,0 +1,2530 @@
+include	<mach.h>
+include	<error.h>
+include <math.h>
+include <gset.h>
+include	<ctype.h>
+include	"sptime.h"
+
+
+# T_SPTIME -- Spectroscopic exposure time calculator.
+
+procedure t_sptime ()
+
+bool	interactive
+int	i, j, nexp, niter, npix, nw, fd, outlist
+real	nobj[4], nsky[4], time, minexp, maxexp, snr, sngoal
+real	wave, x, x1, dx, thruput, sat, dnmax
+pointer sp, str, err, st, tab, waves, counts, snrs, gp
+
+bool	streq(), tabexists(), fp_equalr()
+int	stgeti(), strdic()
+int	clpopnu(), fntopnb(), fntgfnb(), nowhite(), open(), tabgeti()
+real	stgetr(), tabgetr(), tabinterp1(), gr_mag(), gr_getr()
+real	st_x2w()
+pointer tabopen(), gopen(), un_open()
+errchk	tabopen, tabgeti, tabgetr, tabinterp1
+errchk	st_gtable, st_gtable1, stgeti, stgetr, st_snr, st_disperser
+errchk	open, gopen
+
+begin
+	call smark (sp)
+	call salloc (st, ST_LEN, TY_STRUCT)
+	call salloc (str, SZ_LINE, TY_CHAR)
+	call salloc (err, SZ_FNAME, TY_CHAR)
+
+	# Load tables.
+	ST_SEARCH(st) = clpopnu ("search")
+	ST_TAB(st) = tabopen ()
+	tab = ST_TAB(st)
+	call st_gtable (st, "spectrograph", "")
+	call st_gtable (st, "spectrum", "spectrograph")
+	call st_gtable (st, "sky", "spectrograph")
+	call st_gtable (st, "extinction", "spectrograph")
+	call st_gtable (st, "telescope", "spectrograph")
+	call st_gtable (st, "emissivity", "spectrograph")
+	call st_gtable (st, "adc", "spectrograph")
+	call st_gtable (st, "filter", "spectrograph")
+	call st_gtable (st, "filter2", "spectrograph")
+	call st_gtable (st, "aperture", "spectrograph")
+	call st_gtable (st, "fiber", "spectrograph")
+	call st_gtable (st, "aperture", "fiber")
+	call st_gtable (st, "collimator", "spectrograph")
+	call st_gtable (st, "disperser", "spectrograph")
+	call st_gtable (st, "xdisperser", "spectrograph")
+	call st_gtable (st, "corrector", "spectrograph")
+	call st_gtable (st, "camera", "spectrograph")
+	call st_gtable (st, "vignetting", "spectrograph")
+	call st_gtable (st, "vignetting", "camera")
+	call st_gtable (st, "detector", "spectrograph")
+	call st_gtable (st, "sensfunc", "spectrograph")
+	
+	call st_gtable1 (st, "abjohnson", "abjohnson")
+
+	# Set dispersion units.
+	call stgstr (st, "units", "spectrograph", "Angstroms",
+	    Memc[str], SZ_LINE)
+	call strcpy (Memc[str], ST_DUNITS(st), ST_SZSTRING) 
+	ST_DUNANG(st) = un_open ("angstroms")
+	ST_DUN(st) = un_open (ST_DUNITS(st))
+
+	# Set spectrum.
+	ST_REFW(st) = stgetr (st, "refwave", "spectrum", INDEFR)
+	if (!IS_INDEFR(ST_REFW(st)))
+	    call un_ctranr (ST_DUN(st), ST_DUNANG(st), ST_REFW(st),
+		ST_REFW(st), 1)
+	ST_REFF(st) = stgetr (st, "refflux", "spectrograph", 10.)
+	call stgstr (st, "funits", "spectrograph", "AB", Memc[str], SZ_LINE)
+	ST_FUNITS(st) = strdic (Memc[str], Memc[str], SZ_LINE, FUNITS)
+	switch (ST_SPEC(st)) {
+	case SPEC_BB:
+	    ST_PARAM(st) = stgetr (st, "temperature", "spectrograph", 6000.)
+	case SPEC_FL, SPEC_FN:
+	    ST_PARAM(st) = stgetr (st, "index", "spectrograph", 0.)
+	}
+	ST_RV(st) = stgetr (st, "R", "spectrum", 3.1)
+	ST_AV(st) = ST_RV(st) * stgetr (st, "E", "spectrum", 0.)
+
+	# Set observing conditions.
+	ST_SEEING(st) = stgetr (st, "seeing", "spectrograph", 1.)
+	ST_AIRMASS(st) = stgetr (st, "airmass", "spectrograph", 1.)
+	ST_PHASE(st) = stgetr (st, "phase", "spectrograph", 0.)
+
+	# Set thermal background.
+	ST_THERMAL(st) = stgetr (st, "thermal", "telescope", 0.)
+
+	# Set instrument.
+	ST_CW(st) = stgetr (st, "wave", "spectrograph", INDEFR)
+	if (!IS_INDEFR(ST_CW(st)))
+	    call un_ctranr (ST_DUN(st), ST_DUNANG(st), ST_CW(st), ST_CW(st), 1)
+	ST_ORDER(st,1) = stgeti (st, "order", "spectrograph", INDEFI)
+	ST_ORDER(st,2) = stgeti (st, "xorder", "spectrograph", INDEFI)
+
+	# Aperture.
+	if (!tabexists (tab, "aperture")) {
+	    if (tabexists (tab, "fiber"))
+		call st_gtable1 (st, "aperture", "circle")
+	    else if (!IS_INDEFR(stgetr(st, "diameter", "spectrograph", INDEFR)))
+		call st_gtable1 (st, "aperture", "circle")
+	    else
+		call st_gtable1 (st, "aperture", "slit")
+	}
+	call stgstr (st, "aptype", "aperture", "", Memc[str], SZ_LINE)
+	if (Memc[str] == EOS) {
+	    iferr (call tabgstr (tab, "aperture", "", "type",
+		Memc[str], SZ_LINE)) {
+		if (tabgeti (tab, "aperture", "", "table.ndim") == 2)
+		    call strcpy ("circular", Memc[str], SZ_LINE)
+		else
+		    call strcpy ("rectangular", Memc[str], SZ_LINE)
+	    }
+	}
+	ST_APTYPE(st) = strdic (Memc[str], Memc[str], SZ_LINE, APTYPES)
+	switch (ST_APTYPE(st)) {
+	case CIRCULAR:
+	    if (tabexists (tab, "fiber")) {
+		ST_APSIZE(st,1) = stgetr (st, "diameter", "fiber", INDEFR)
+		if (!IS_INDEFR(ST_APSIZE(st,1)) && ST_APSIZE(st,1) > 0.) {
+		    ST_TELSCALE(st) = stgetr (st, "scale", "telescope", 10.)
+		    ST_APSIZE(st,1) = ST_APSIZE(st,1) * ST_TELSCALE(st)
+		}
+	    }
+	    if (IS_INDEFR(ST_APSIZE(st,1)))
+		ST_APSIZE(st,1) = stgetr (st, "diameter", "aperture", -2.)
+	    ST_APSIZE(st,2) = ST_APSIZE(st,1)
+	case RECTANGULAR:
+	    ST_APSIZE(st,1) = stgetr (st, "width", "aperture", -2.)
+	    ST_APSIZE(st,2) = stgetr (st, "length", "aperture", -100.)
+	default:
+	    call sprintf (Memc[err], SZ_FNAME,
+		"Unknown aperture type (%s)")
+		call pargstr (Memc[str])
+	    call error (1, Memc[err])
+	}
+
+	ST_INOUTA(st,1) = stgetr (st, "inoutangle", "spectrograph", INDEFR)
+	ST_INOUTA(st,2) = stgetr (st, "xinoutangle", "spectrograph", INDEFR)
+	ST_BIN(st,1) = stgeti (st, "xbin", "detector", 1)
+	ST_BIN(st,2) = stgeti (st, "ybin", "detector", 1)
+	ST_GAIN(st) = stgetr (st, "gain", "detector", 1.)
+	ST_RDNOISE(st) = stgetr (st, "rdnoise", "detector", 0.)
+	ST_DARK(st) = stgetr (st, "dark", "detector", 0.)
+
+	# Set filter flag.
+	ST_FILTBLK(st) = NO
+	call stgstr (st, "block", "filter", "no", Memc[str], SZ_LINE) 
+	if (streq (Memc[str], "yes"))
+	    ST_FILTBLK (st) = YES
+
+	# Set sky subtraction parameters.
+	if (tabexists (tab, "sky") ||
+	    (tabexists (tab, "emissivity") && ST_THERMAL(st) > 0.)) {
+	    switch (ST_APTYPE(st)) {
+	    case CIRCULAR:
+		call stgstr (st, "skysub", "spectrograph", "multiap",
+		    Memc[str], SZ_LINE)
+		ST_NSKYAPS(st) = stgeti (st, "nskyaps", "spectrograph", 10)
+	    case RECTANGULAR:
+		call stgstr (st, "skysub", "spectrograph", "longslit",
+		    Memc[str], SZ_LINE)
+	    }
+	} else
+	    call stgstr (st, "skysub", "spectrograph", "none", Memc[str],
+		SZ_LINE)
+	    
+	ST_SKYSUB(st) = strdic (Memc[str], Memc[str], SZ_LINE, SKYSUB)
+
+	# Set calculation parameters.
+	ST_MINEXP(st) = stgetr (st, "minexp", "spectrograph", MINEXP)
+	ST_MAXEXP(st) = stgetr (st, "maxexp", "spectrograph", 3600.)
+	if (ST_MINEXP(st) <= 0.)
+	    ST_MINEXP(st) = MINEXP
+	if (ST_MAXEXP(st) <= ST_MINEXP(st))
+	    ST_MAXEXP(st) = ST_MINEXP(st)
+	time = stgetr (st, "time", "spectrograph", INDEFR)
+	sngoal = stgetr (st, "sn", "spectrograph", 25.)
+	if (IS_INDEF(time) && IS_INDEF(sngoal))
+	    call error (1,
+		"Either an exposure time or a desired S/N must be specified")
+	ST_SUBPIXELS(st) = stgeti (st, "subpixels", "spectrograph", 1)
+
+	# Set output parameters.
+	gp = NULL; fd = NULL
+	call stgstr (st, "output", "spectrograph", "", Memc[str], SZ_LINE)
+	outlist = fntopnb (Memc[str], NO)
+	if (fntgfnb (outlist, Memc[str], SZ_LINE) != EOF) {
+	    if (streq (Memc[str], "ALL")) {
+		call strcpy (OUTTYPES, Memc[str], SZ_LINE)
+		j = str+1
+		for (i=j; Memc[i] != EOS; i=i+1) { 
+		    if (IS_WHITE(Memc[i]) || Memc[i] == '\n')
+			next
+		    if (Memc[i] == Memc[str])
+			Memc[j] = ','
+		    else
+			Memc[j] = Memc[i]
+		    j = j + 1
+		}
+		Memc[j] = EOS
+		call fntclsb (outlist)
+		outlist = fntopnb (Memc[str+1], NO)
+	    } else
+		call fntrewb (outlist)
+	    nw = stgeti (st, "nw", "spectrograph", 101)
+	    call stgstr (st, "graphics", "spectrograph", "stdgraph",
+		Memc[str], SZ_LINE)
+	    if (nowhite (Memc[str], Memc[str], SZ_LINE) > 0) {
+		gp = gopen (Memc[str], NEW_FILE+AW_DEFER, STDGRAPH)
+		call stgstr (st, "interactive", "spectrograph", "yes",
+		    Memc[str], SZ_LINE)
+		interactive = streq (Memc[str], "yes")
+	    }
+	    call stgstr (st, "list", "spectrograph", "", Memc[str], SZ_LINE)
+	    if (nowhite (Memc[str], Memc[str], SZ_LINE) > 0)
+		fd = open (Memc[str], APPEND, TEXT_FILE)
+	}
+
+	# Focal lengths.
+	ST_COLFL(st) = stgetr (st, "colfl", "collimator", INDEFR)
+	if (IS_INDEFR(ST_COLFL(st))) {
+	    iferr (ST_COLFL(st) = tabgetr (tab, "collimator", "", "fl"))
+		ST_COLFL(st) = 1.
+	}
+	ST_CAMFL(st) = stgetr (st, "camfl", "camera", INDEFR)
+	if (IS_INDEFR(ST_CAMFL(st))) {
+	    iferr (ST_CAMFL(st) = tabgetr (tab, "camera", "", "fl"))
+		ST_CAMFL(st) = 1.
+	}
+
+	call st_disperser (st, "disperser", 1)
+	if (ST_DISPTYPE(st,1) == 0)
+	    call error (1, "No disperser specified")
+	call st_disperser (st, "xdisperser", 2)
+
+	ST_AREA(st) = 10000 * stgetr (st, "area", "telescope", 1.)
+
+	# Scales.
+	ST_TELSCALE(st) = stgetr (st, "scale", "telescope", 10.)
+	ST_SCALE(st,1) = ST_TELSCALE(st)
+	ST_SCALE(st,2) = ST_TELSCALE(st)
+	x = gr_mag (ST_GR(st,1), ST_CW(st), ST_ORDER(st,1))
+	if (!IS_INDEF(x))
+	    ST_SCALE(st,1) = ST_SCALE(st,1) / x
+	x = gr_mag (ST_GR(st,2), ST_CW(st), ST_ORDER(st,2))
+	if (!IS_INDEF(x))
+	    ST_SCALE(st,2) = ST_SCALE(st,2) / x
+	x = ST_COLFL(st) / ST_CAMFL(st)
+	ST_SCALE(st,1) = ST_SCALE(st,1) * x
+	ST_SCALE(st,2) = ST_SCALE(st,2) * x
+	ST_SCALE(st,1) = ST_SCALE(st,1) *
+	    stgetr (st, "apmagdisp", "spectrograph", 1.)
+	ST_SCALE(st,2) = ST_SCALE(st,2) *
+	    stgetr (st, "apmagxdisp", "spectrograph", 1.)
+	ST_PIXSIZE(st) = stgetr (st, "pixsize", "detector", 0.02)
+	ST_SCALE(st,1) = ST_SCALE(st,1) * ST_PIXSIZE(st) * ST_BIN(st,1)
+	ST_SCALE(st,2) = ST_SCALE(st,2) * ST_PIXSIZE(st) * ST_BIN(st,2)
+
+	# Convert aperture sizes to arcsec.
+	if (ST_APSIZE(st,1) < 0.)
+	    ST_APSIZE(st,1) = -ST_APSIZE(st,1) * ST_SCALE(st,1)
+	else
+	    ST_APSIZE(st,1) = ST_APSIZE(st,1)
+	if (ST_APSIZE(st,2) < 0.)
+	    ST_APSIZE(st,2) = -ST_APSIZE(st,2) * ST_SCALE(st,2)
+	else
+	    ST_APSIZE(st,2) = ST_APSIZE(st,2)
+
+	# Set dispersion per pixel and per resolution element.
+	ST_RES(st,1) = stgetr (st, "resolution", "camera", INDEFR)
+	if (IS_INDEFR(ST_RES(st,1)))
+	    ST_RES(st,1) = 2
+	else
+	    ST_RES(st,1) = ST_RES(st,1) / ST_PIXSIZE(st)
+	ST_RES(st,2) = ST_RES(st,1)
+	ST_DISP(st,1) = abs (gr_getr (ST_GR(st,1), "dispersion"))
+	ST_DISP(st,1) = ST_DISP(st,1) * ST_PIXSIZE(st) * ST_BIN(st,1)
+	x = 1 + min (ST_SEEING(st), ST_APSIZE(st,1)) / ST_SCALE(st,1)
+	ST_DISP(st,2) = ST_DISP(st,1) * max (2., ST_RES(st,1), x)
+
+	# Set number of pixels in object.
+	switch (ST_APTYPE(st)) {
+	case CIRCULAR:
+	    x = ST_APSIZE(st,2) / ST_SCALE(st,2) + ST_RES(st,2)
+	    npix = max (1, int (x + 0.999))
+	    ST_NOBJPIX(st) = npix
+	    ST_APLIM(st) = YES
+	case RECTANGULAR:
+	    x = ST_APSIZE(st,2) / ST_SCALE(st,2) + ST_RES(st,2)
+	    npix = max (1, int (x + 0.999))
+	    x = min (ST_APSIZE(st,2), 3*ST_SEEING(st)) / ST_SCALE(st,2) +
+		ST_RES(st,2)
+	    ST_NOBJPIX(st) = min (npix, int (x + 0.999))
+	    if (ST_NOBJPIX(st) > npix)
+		ST_APLIM(st) = NO
+	    else
+		ST_APLIM(st) = YES
+	}
+
+	# Set number of pixels in sky.
+	switch (ST_SKYSUB(st)) {
+	case SKY_NONE:
+	    ST_NSKYPIX(st) = 0
+	case SKY_LONGSLIT:
+	    ST_NSKYPIX(st) = max (0, npix - ST_NOBJPIX(st))
+	case SKY_MULTIAP:
+	    ST_NSKYPIX(st) = npix * ST_NSKYAPS(st)
+	case SKY_SHUFFLE:
+	    ST_NSKYPIX(st) = npix
+	}
+
+	# Compute exposure time and S/N.
+	if (!tabexists (tab, "spectrum")) {
+	    if (IS_INDEF(ST_REFW(st)))
+		ST_REFW(st) = ST_CW(st)
+	    switch (ST_FUNITS(st)) {
+	    case AB:
+		ST_REFFL(st) = 10. ** (-0.4 *
+		    (ST_REFF(st) + 5*log10(ST_REFW(st)) + 2.40))
+	    case FLAMBDA:
+		if (ST_REFF(st) < 0.)
+		    call error (1,
+			"Monochromatic flux (F-lambda) must be greater than 0")
+		ST_REFFL(st) = ST_REFF(st)
+	    case FNU:
+		if (ST_REFF(st) < 0.)
+		    call error (1,
+			"Monochromatic flux (F-nu) must be greater than 0")
+		ST_REFFL(st) = ST_REFF(st) * C / (ST_REFW(st) * ST_REFW(st))
+	    case UMAG,BMAG,VMAG,RMAG,IMAG,JMAG,HMAG,KSMAG,KMAG,LMAG,LPMAG,MMAG:
+		switch (ST_FUNITS(st)) {
+		case UMAG:
+		    ST_REFW(st) = 3650.
+		case BMAG:
+		    ST_REFW(st) = 4400.
+		case VMAG:
+		    ST_REFW(st) = 5500.
+		case RMAG:
+		    ST_REFW(st) = 7000.
+		case IMAG:
+		    ST_REFW(st) = 9000.
+		case JMAG:
+		    ST_REFW(st) = 12150.
+		case HMAG:
+		    ST_REFW(st) = 16540.
+		case KSMAG:
+		    ST_REFW(st) = 21570.
+		case KMAG:
+		    ST_REFW(st) = 21790.
+		case LMAG:
+		    ST_REFW(st) = 35470.
+		case LPMAG:
+		    ST_REFW(st) = 37610.
+		case MMAG:
+		    ST_REFW(st) = 47690.
+		}
+
+		ST_REFFL(st) = ST_REFF(st) +
+		    tabinterp1 (tab, "abjohnson", ST_REFW(st))
+		ST_REFFL(st) = 10. ** (-0.4 *
+		    (ST_REFFL(st) + 5*log10(ST_REFW(st)) + 2.40))
+	    }
+	}
+
+	# Check saturation.
+	sat = stgetr (st, "saturation", "detector", MAX_REAL)
+	dnmax = stgetr (st, "dnmax", "detector", MAX_REAL)
+
+	wave = ST_CW(st)
+	if (!IS_INDEF(time)) {
+	    if (time <= 0.) {
+		call eprintf ("Total Exposure Time must be greater than 0.\n")
+		return
+	    }
+
+	    if (ST_MAXEXP(st) > 0.) {
+		nexp = max (1, int (time / ST_MAXEXP(st) + 0.99))
+		time = time / nexp
+	    } else
+		nexp = 1
+
+	} else {
+	    if (sngoal <= 0.) {
+		call printf ("Desired S/N must be greater than 0.\n")
+		return
+	    }
+
+	    nexp = 1
+	    minexp = ST_MINEXP(st)
+	    maxexp = ST_MAXEXP(st)
+	    time = maxexp
+	    snr = 0.
+
+	    # Iterate to try and achieve the requested SNR.
+	    do niter = 1, MAXITER {
+
+		if (snr > 0.) {
+		    x = time
+		    i = nexp
+
+		    # After the first pass we use the last calculated SNR to
+		    # estimate a new time per exposure and number of exposures.
+		    time = time*sngoal*sngoal/(nexp*snr*snr)
+
+		    # Divide into multiple exposures if the time per exposure
+		    # exceeds a maximum.  Note the maximum may be reset by
+		    # saturation criteria.
+		    if (time > maxexp) {
+			nexp = nexp * max (1, int (time / maxexp + 0.99))
+			time = x*sngoal*sngoal/(nexp*snr*snr)
+		    } 
+
+		    # Apply a minimum time per exposure if possible.
+		    if (time < minexp && nexp > 1) {
+			nexp = max (1, nexp * time / minexp)
+			time = x*sngoal*sngoal/(nexp*snr*snr)
+		    }
+
+		    # New time per exposure to try.
+		    time = max (minexp, min (maxexp, time))
+		    if (fp_equalr (time, x) && nexp == i)
+			break
+		}
+
+		# Compute SNR.
+		call st_snr (st, NULL, wave, nexp, time, nobj, nsky,
+		    snr, thruput)
+
+		# Reset maximum time per exposure to avoid saturation.
+		if (nobj[1]+nsky[1] > sat && time > minexp && snr < sngoal) {
+		    time = time * nexp
+		    snr = snr * snr * nexp
+		    nexp = nexp * (1 + (nobj[1] + nsky[1]) / sat)
+		    time = time / nexp
+		    snr = sqrt (snr / nexp)
+		    maxexp = max (minexp, time)
+		    next
+		}
+		if ((nobj[1]+nsky[1])/ST_GAIN(st) > dnmax && time > minexp &&
+			snr < sngoal) {
+		    time = time * nexp
+		    snr = snr * snr * nexp
+		    nexp = nexp * (1 + (nobj[1] + nsky[1]) /
+			(ST_GAIN(st) * dnmax))
+		    time = time / nexp
+		    snr = sqrt (snr / nexp)
+		    maxexp = max (minexp, time)
+		    next
+		}
+
+		if (abs ((sngoal-sqrt(real(nexp))*snr)/sngoal) < 0.001)
+		    break
+	    }
+	}
+	ST_NEXP(st) = nexp
+	ST_TIME(st) = time
+
+	# Output.
+	npix = stgetr (st, "ndisp", "detector", 2048.)
+	nw = max (1, min (nw, npix))
+	x1 = npix * ST_PIXSIZE(st)
+
+	call salloc (waves, nw, TY_REAL)
+	call salloc (counts, nw, TY_REAL)
+	call salloc (snrs, nw, TY_REAL)
+
+	if (nw > 1) {
+	    dx = x1 / (nw - 1)
+	    x1 = -x1 / 2
+	    do i = 0, nw-1 {
+		x = x1 + dx * i
+		Memr[waves+i] = st_x2w (st, 1, x)
+	    }
+	} else
+	    Memr[waves] = wave
+
+	# Output result summary.
+	call st_results (st, STDOUT)
+	call st_check (st, STDOUT, Memr[waves], nw)
+	call st_snr (st, STDOUT, wave, nexp, time, nobj, nsky, snr, thruput)
+
+	while (fntgfnb (outlist, Memc[str], SZ_LINE) != EOF)
+	    call st_output (st, gp, fd, interactive, Memc[str], Memr[waves], nw)
+	    
+	# Finish up.
+	call un_close (ST_DUN(st))
+	call un_close (ST_DUNANG(st))
+	call clpcls (ST_SEARCH(st))
+	call tabclose (ST_TAB(st))
+	call gr_close (ST_GR(st,1))
+	call gr_close (ST_GR(st,2))
+	if (gp != NULL)
+	    call gclose (gp)
+	if (fd != NULL)
+	    call close (fd)
+	call fntclsb (outlist)
+	call sfree (sp)
+end
+
+
+# ST_RESULTS -- Print result summary.
+
+procedure st_results (st, fd)
+
+pointer st		#I SPECTIME structure
+int	fd		#I Output file descriptor
+
+char	eff[SZ_FNAME]
+real	x, y
+int	npix, order, tabgeti(), stgeti()
+pointer	tab
+real	gr_getr()
+bool	tabexists()
+
+begin
+	tab = ST_TAB(st)
+
+	call fprintf (fd, "\n")
+	if (tabexists (tab, "spectrum"))
+	    call st_description (st, fd, "Object spectrum: ", "spectitle",
+		"spectrum")
+	else {
+	    call fprintf (fd, "Object spectrum: ")
+	    switch (ST_SPEC(st)) {
+	    case SPEC_BB:
+		call fprintf (fd, "Blackbody spectrum of temperature %g K\n")
+		    call pargr (ST_PARAM(st))
+	    case SPEC_FL:
+		call fprintf (fd, "F(lambda) power law of index %g\n")
+		    call pargr (ST_PARAM(st))
+	    case SPEC_FN:
+		call fprintf (fd, "F(nu) power law of index %g\n")
+		    call pargr (ST_PARAM(st))
+	    }
+	    if (ST_AV(st) > 0.) {
+		call fprintf (fd,
+		    "Reddening: E(B-V) of %g with A(V)/E(B-V) of %g\n")
+		    call pargr (ST_AV(st) / ST_RV(st))
+		    call pargr (ST_RV(st))
+	    }
+	    call un_ctranr (ST_DUNANG(st), ST_DUN(st), ST_REFW(st), x, 1)
+	    call fprintf (fd, "Reference wavelength: %.4g %s\n")
+		call pargr (x)
+		call pargstr (ST_DUNITS(st))
+	    call fprintf (fd, "Reference flux: ")
+	    switch (ST_FUNITS(st)) {
+	    case AB:
+		call fprintf (fd, "AB = %.3g (%.3g ergs/s/cm^2/A)\n")
+		    call pargr (ST_REFF(st))
+		    call pargr (ST_REFFL(st))
+	    case FLAMBDA:
+		call fprintf (fd, "%.3g ergs/s/cm^2/A\n")
+		    call pargr (ST_REFF(st))
+	    case FNU:
+		call fprintf (fd, "%.3g ergs/s/cm^2/Hz\n")
+		    call pargr (ST_REFF(st))
+	    case UMAG, BMAG, VMAG, RMAG, IMAG, JMAG:
+		switch (ST_FUNITS(st)) {
+		case UMAG:
+		    call fprintf (fd, "U = %.3g ")
+			call pargr (ST_REFF(st))
+		case BMAG:
+		    call fprintf (fd, "B = %.3g ")
+			call pargr (ST_REFF(st))
+		case VMAG:
+		    call fprintf (fd, "V = %.3g ")
+			call pargr (ST_REFF(st))
+		case RMAG:
+		    call fprintf (fd, "R = %.3g ")
+			call pargr (ST_REFF(st))
+		case IMAG:
+		    call fprintf (fd, "I = %.3g ")
+			call pargr (ST_REFF(st))
+		case JMAG:
+		    call fprintf (fd, "J = %.3g ")
+			call pargr (ST_REFF(st))
+		}
+		call fprintf (fd, "(%.3g ergs/s/cm^2/A)\n")
+		    call pargr (ST_REFFL(st))
+	    }
+	}
+	if (tabexists (tab, "sky")) {
+	    call st_description (st, fd, "Sky spectrum: ", "skytitle", "sky")
+	    if (tabgeti (tab, "sky", "", "table.ndim") == 2) {
+		call fprintf (fd, "\tMoon phase: %d\n")
+		    call pargr (ST_PHASE(st))
+	    }
+	}
+	if (ST_AIRMASS(st) > 0) {
+	    call st_description (st, fd, "Extinction: ", "exttitle",
+		"extinction")
+	    call fprintf (fd, "\tAirmass: %.3g\n")
+		call pargr (ST_AIRMASS(st))
+	}
+	call fprintf (fd, "Seeing: %.2g\" (FWHM)\n")
+	    call pargr (ST_SEEING(st))
+	if (tabexists (tab, "emissivity") && ST_THERMAL(st) > 0.) {
+	    call fprintf (fd, "Thermal Background:\n")
+	    call st_description (st, fd, "\tEmissivity: ",
+		"emistitle", "emissivity")
+	    call fprintf (fd, "\tTemperature: %.1g K\n")
+		call pargr (ST_THERMAL(st))
+	}
+
+	call fprintf (fd, "\n")
+	call st_description (st, fd, "Telescope: ", "teltitle", "telescope")
+	call fprintf (fd, "\tArea: %.1f m^2, Scale: %.4g arcsec/mm\n")
+	    call pargr (ST_AREA(st) / 10000.)
+	    call pargr (ST_TELSCALE(st))
+	if (tabexists (tab, "adc"))
+	    call st_description (st, fd, "ADC: ", "adctitle", "adc")
+	if (tabexists (tab, "spectrograph"))
+	    call st_description (st, fd, "Spectrograph: ", "title",
+		"spectrograph")
+	call st_description (st, fd, "Collimator: ", "coltitle", "collimator")
+	call fprintf (fd, "\tFocal length = %.4g m\n")
+	    call pargr (ST_COLFL(st))
+	if (tabexists (tab, "aperture")) {
+	    call st_description (st, fd, "Apertures: ", "aptitle", "aperture")
+	    switch (ST_APTYPE(st)) {
+	    case CIRCULAR:
+		call fprintf (fd, "\tSize: %.2f\", %.3g mm, %.1f pixels\n")
+		    call pargr (ST_APSIZE(st,1))
+		    call pargr (ST_APSIZE(st,1) / ST_TELSCALE(st))
+		    call pargr (ST_APSIZE(st,1) / ST_SCALE(st,1))
+	    case RECTANGULAR:
+		call fprintf (fd,
+		"\tSize: %.2f\" x %.2f\", %.3g x %.3g mm, %.1f x %.1f pixels\n")
+		    call pargr (ST_APSIZE(st,1))
+		    call pargr (ST_APSIZE(st,2))
+		    call pargr (ST_APSIZE(st,1) / ST_TELSCALE(st))
+		    call pargr (ST_APSIZE(st,2) / ST_TELSCALE(st))
+		    call pargr (ST_APSIZE(st,1) / ST_SCALE(st,1))
+		    call pargr (ST_APSIZE(st,2) / ST_SCALE(st,2))
+	    }
+	}
+	if (tabexists (tab, "fiber"))
+	    call st_description (st, fd, "Fibers: ", "fibtitle", "fiber")
+	if (tabexists (tab, "filter"))
+	    call st_description (st, fd, "Filter: ", "ftitle", "filter")
+	if (tabexists (tab, "filter2"))
+	    call st_description (st, fd, "Filter: ", "f2title", "filter2")
+	if (ST_DISPTYPE(st,1) != 0) {
+	    call st_description (st, fd, "Disperser: ", "disptitle",
+		"disperser")
+	    order = nint (gr_getr (ST_GR(st,1), "order"))
+	    call fprintf (fd, "\tCentral order = %d\n")
+		call pargi (order)
+	    x = gr_getr (ST_GR(st,1), "wavelength")
+	    call un_ctranr (ST_DUNANG(st), ST_DUN(st), x, x, 1)
+	    call fprintf (fd, "\tCentral wavelength = %.6g %s\n")
+		call pargr (x)
+		call pargstr (ST_DUNITS(st))
+	    x = abs(gr_getr(ST_GR(st,1), "dispersion"))
+	    call un_ctranr (ST_DUNANG(st), ST_DUN(st), x, x, 1)
+	    call un_ctranr (ST_DUNANG(st), ST_DUN(st), ST_DISP(st,1), y, 1)
+	    call fprintf (fd,
+	    "\tCentral dispersion = %.3g %s/mm, %.3g %s/pixel\n")
+		call pargr (x)
+		call pargstr (ST_DUNITS(st))
+		call pargr (y)
+		call pargstr (ST_DUNITS(st))
+	    if (ST_DISPTYPE(st,1) == GRATING &&
+		int(gr_getr(ST_GR(st,1),"full"))==YES) {
+		call fprintf (fd, "\tRuling = %d lines/mm\n")
+		    call pargr (gr_getr (ST_GR(st,1), "g"))
+		call fprintf (fd, "\tBlaze = %.1f deg\n")
+		    call pargr (gr_getr (ST_GR(st,1), "blaze"))
+		x = gr_getr (ST_GR(st,1), "tilt")
+		if (abs(x) > 0.1) {
+		    call fprintf (fd, "\tGrating tilt = %.1f degrees\n")
+			call pargr (gr_getr (ST_GR(st,1), "tilt"))
+		    x = gr_getr (ST_GR(st,1), "mag")
+		    if (abs(x) < 0.99) {
+			call fprintf (fd, "\tGrating magnification = %.2f\n")
+			    call pargr (x)
+		    }
+		}
+		call sprintf (eff, SZ_FNAME, "eff%d")
+		    call pargi (order)
+		if (!tabexists (tab, eff)) {
+		    if (order == 1 && tabexists (tab, "disperser")) {
+			if (tabgeti (tab, "disperser", "", "table.ndim") != 0)
+			    call strcpy ("disperser", eff, SZ_FNAME)
+		    }
+		}
+		if (tabexists (tab, eff))
+		    call fprintf (fd, "\tUsing tabulated efficiencies\n")
+		else
+		    call fprintf (fd, "\tUsing predicted efficiencies\n")
+	    }
+	}
+	if (ST_DISPTYPE(st,2) != 0) {
+	    call st_description (st, fd, "Crossdisperser: ", "xdisptitle",
+		"xdisperser")
+	    order = nint (gr_getr (ST_GR(st,2), "order"))
+	    call fprintf (fd, "\tCentral order = %d\n")
+		call pargi (order)
+	    x = gr_getr (ST_GR(st,2), "wavelength")
+	    call un_ctranr (ST_DUNANG(st), ST_DUN(st), x, x, 1)
+	    call fprintf (fd, "\tCentral wavelength = %.6g %s\n")
+		call pargr (x)
+		call pargstr (ST_DUNITS(st))
+	    x = abs(gr_getr(ST_GR(st,1), "dispersion"))
+	    call un_ctranr (ST_DUNANG(st), ST_DUN(st), x, x, 1)
+	    call fprintf (fd, "\tCentral dispersion = %.3g %s/mm\n")
+		call pargr (x)
+		call pargstr (ST_DUNITS(st))
+	    if (ST_DISPTYPE(st,2) == GRATING &&
+		int(gr_getr(ST_GR(st,2),"full"))==YES) {
+		call fprintf (fd, "\tRuling = %d lines/mm\n")
+		    call pargr (gr_getr (ST_GR(st,2), "g"))
+		call fprintf (fd, "\tBlaze = %d deg\n")
+		    call pargr (gr_getr (ST_GR(st,2), "blaze"))
+		x = gr_getr (ST_GR(st,2), "tilt")
+		if (abs(x) > 0.1) {
+		    call fprintf (fd, "\tGrating tilt = %.1f degrees\n")
+			call pargr (gr_getr (ST_GR(st,2), "tilt"))
+		    x = gr_getr (ST_GR(st,2), "mag")
+		    if (abs(x) < 0.99) {
+			call fprintf (fd, "\tGrating magnification = %.2f\n")
+			    call pargr (x)
+		    }
+		}
+		call sprintf (eff, 10, "xeff%d")
+		    call pargi (order)
+		if (!tabexists (tab, eff)) {
+		    if (order == 1 && tabexists (tab, "xdisperser")) {
+			if (tabgeti (tab, "xdisperser", "", "table.ndim") != 0)
+			    call strcpy ("xdisperser", eff, SZ_FNAME)
+		    }
+		}
+		if (tabexists (tab, eff))
+		    call fprintf (fd, "\tUsing tabulated efficiencies\n")
+		else
+		    call fprintf (fd, "\tUsing predicted efficiencies\n")
+	    }
+	}
+	if (tabexists (tab, "corrector"))
+	    call st_description (st, fd, "Corrector: ", "cortitle", "corrector")
+	call st_description (st, fd, "Camera: ", "camtitle", "camera")
+	call fprintf (fd, "\tFocal length = %.4g m, Resolution = %.1g pixels\n")
+	    call pargr (ST_CAMFL(st))
+	    call pargr (ST_RES(st,1))
+	call st_description (st, fd, "Detector: ", "dettitle", "detector")
+	call fprintf (fd, "\tPixel size: %d microns, %.2f\"\n")
+	    call pargr (1000 * ST_PIXSIZE(st))
+	    call pargr (ST_SCALE(st,1))
+	if (ST_BIN(st,1) != 1 || ST_BIN(st,2) != 1) {
+	    call fprintf (fd, "\tBinning: %dx%d (XxY)\n")
+		call pargi (ST_BIN(st,1))
+		call pargi (ST_BIN(st,2))
+	}
+	npix = stgeti (st, "ndisp", "detector", 2048) / ST_BIN(st,1)
+	call fprintf (fd, "\tNumber of pixels = %d\n")
+	    call pargi (npix)
+	call fprintf (fd,
+	    "\tRead noise = %.1f e-, Gain = %.1f e-/DN, Dark = %.3g e-/s\n") 
+	    call pargr (ST_RDNOISE(st))
+	    call pargr (ST_GAIN(st))
+	    call pargr (ST_DARK(st))
+
+	call fprintf (fd, "\n")
+	call fprintf (fd,
+	    "Source pixels: %d pixels")
+	    call pargi (ST_NOBJPIX(st))
+	if (ST_APLIM(st) == YES)
+	    call fprintf (fd, " (aperture & camera resolution limited)\n")
+	else
+	    call fprintf (fd, " (3xFWHM seeing disk & camera resolution)\n")
+	switch (ST_SKYSUB(st)) {
+	case SKY_NONE:
+	    call fprintf (fd,
+		"Background pixels: no background subtraction done\n")
+	case SKY_LONGSLIT:
+	    call fprintf (fd, "Background pixels: %3d pixels\n")
+		call pargi (ST_NSKYPIX(st))
+	case SKY_MULTIAP:
+	    call fprintf (fd,
+		"Background pixels: %d apertures each with %d pixels\n")
+		call pargi (ST_NSKYAPS(st))
+		call pargi (ST_NSKYPIX(st) / ST_NSKYAPS(st))
+	case SKY_SHUFFLE:
+	    call fprintf (fd,
+		"Background pixels: shuffle with %d pixels (same as source)\n")
+		call pargi (ST_NSKYPIX(st))
+	}
+	call fprintf (fd, "\n")
+end
+
+
+# ST_DESCRIPTION -- Print description of table.
+
+procedure st_description (st, fd, label, title, table)
+
+pointer st		#I SPECTIME structure
+int	fd		#I Output file descriptor
+char	label[ARB]	#I Label
+char	title[ARB]	#I Title parameter name
+char	table[ARB]	#I Table name
+
+pointer sp, str
+
+begin
+	call smark (sp)
+	call salloc (str, SZ_LINE, TY_CHAR)
+
+	# Print label and title.
+	call st_gtitle (st, title, table, Memc[str], SZ_LINE)
+	call fprintf (fd, "%s%s\n")
+	    call pargstr (label)
+	    call pargstr (Memc[str])
+
+	# Print description if available.
+	ifnoerr (call tabgstr (ST_TAB(st), table, "", "description", Memc[str],
+	    SZ_LINE)) {
+	    call fprintf (fd, "%s\n")
+		call pargstr (Memc[str])
+	}
+
+	call sfree (sp)
+end
+
+
+# ST_GTITLE -- Get title.
+
+procedure st_gtitle (st, param, table, title, maxchar)
+
+pointer st		#I SPECTIME structure
+char	param[ARB]	#I Title parameter name
+char	table[ARB]	#I Table name
+char	title[ARB]	#O Title
+int	maxchar		#I Maximum string length
+
+char	dummy[1]
+int	nowhite()
+
+begin
+	call clgstr (param, title, maxchar)
+	if (nowhite (title, dummy, 1) > 0)
+	    return
+
+	iferr (call tabgstr (ST_TAB(st), table, "spectrograph", param, title,
+	    maxchar)) {
+	    iferr (call tabgstr (ST_TAB(st), table, "", "title",
+		title, maxchar)) {
+		iferr (call tabgstr (ST_TAB(st), table, "",
+		    "table.filename", title, maxchar))
+		    title[1] = EOS
+	    }
+	}
+end
+
+
+# ST_SNR -- Source, sky, SNR, and thruput including all orders.
+
+procedure st_snr (st, fd, wave, nexp, time, nobj, nsky, snr, thruput)
+
+pointer st		#I SPECTIME structure
+int	fd		#I Output descriptor
+real	wave		#I Wavelengths
+int	nexp		#I Number of exposures
+real	time		#I Exposure time
+real	nobj[4]		#O Number of object photons (1=total)
+real	nsky[4]		#O Number of sky photons (1=total)
+real	snr		#O S/N per pixel for total
+real	thruput		#O System thruput at primary wavelength
+
+int	i, j, order
+real	w, f, st_spectrum()
+errchk	st_spectrum, st_snr1
+
+begin
+	# Initialize.
+	do i = 1, 4 {
+	    nobj[i] = 0
+	    nsky[i] = 0
+	}
+
+	# If not x-dispersed and disperser is a grating do overlapping orders.
+	if (ST_DISPTYPE(st,2) == 0 && ST_FILTBLK(st) == NO &&
+	    (ST_DISPTYPE(st,1) == GRATING || ST_DISPTYPE(st,1) == GRISM)) {
+	    order = ST_ORDER(st,1)
+	    do j = 2, 4 {
+		i = order + j - 3
+		if (i < 1)
+		    next
+		w = wave * order / i
+		f = st_spectrum (st, w)
+		ST_ORDER(st,1) = i
+		call st_snr1 (st, NULL, w, f, nexp, time, nobj[j], nsky[j],
+		    snr, thruput)
+		if (i != order) {
+		    nobj[1] = nobj[1] + nobj[j]
+		    nsky[1] = nsky[1] + nsky[j]
+		}
+	    }
+	    ST_ORDER(st,1) = order
+
+	    w = wave
+	    f = st_spectrum (st, w)
+	    call st_snr1 (st, fd, w, f, nexp, time, nobj, nsky, snr, thruput)
+	} else {
+	    w = wave
+	    f = st_spectrum (st, w)
+	    call st_snr1 (st, fd, w, f, nexp, time, nobj, nsky, snr, thruput)
+	    nobj[3] = nobj[1]
+	    nsky[3] = nsky[1]
+	}
+end
+
+
+# ST_SNR1 -- Compute and print photons and S/N for given exposure time.
+
+procedure st_snr1 (st, fd, wave, flux, nexp, time, nobj, nbkg, snr, thruput)
+
+pointer st		#I SPECTIME structure
+int	fd		#I Output descriptor
+real	wave		#I Wavelength
+real	flux		#I Flux
+int	nexp		#I Number of exposures
+real	time		#I Exposure time
+real	nobj		#U Number of object photons
+real	nbkg		#U Number of bkg photons
+real	snr		#O S/N per pixel
+real	thruput		#O System thruput
+
+int	i, ncols
+real	tobs, n, ndark
+real	w, w1, nmag, sky, thermal, bkg, dobj, dbkg, ddark, dreadout, tnoise
+real	ext, tel, adc, ap, fib, inst, fltr1, fltr2, col, eff1, eff2, disp
+real	cor, cam, vig, dqe, cum, sqnexp
+
+real	tabinterp1(), tabinterp2(), st_dispeff(), st_w2dw(), st_w2x()
+errchk	tabinterp1, tabinterp2, st_dispeff
+
+begin
+	# Check for reasonable wavlength and source flux.
+	if (wave < 0. || flux < 0.) {
+	    nobj = 0.
+	    nbkg = 0.
+	    snr = 0.
+	    thruput = 0.
+	    return
+	}
+
+	# Set observation time.
+	switch (ST_SKYSUB(st)) {
+	case SKY_SHUFFLE:
+	    tobs = time / 2
+	default:
+	    tobs = time
+	}
+
+	# Compute pixel counts over subsampled pixels.
+	disp = st_w2dw (st, 1, wave) * ST_PIXSIZE(st) * ST_BIN(st,1) /
+	    ST_SUBPIXELS(st)
+	w1 = wave - disp * (ST_SUBPIXELS(st) + 1) / 2.
+	do i = 1, ST_SUBPIXELS(st) {
+	    w = w1 + disp * i
+
+	    # Atmospheric transmission.
+	    iferr {
+		ext = tabinterp1 (ST_TAB(st), "extinction", w)
+		ext = 10 ** (-0.4 * ext * ST_AIRMASS(st))
+	    } then
+		ext = INDEF
+
+	    # Telescope transmission.
+	    iferr (tel = tabinterp1 (ST_TAB(st), "telescope", w))
+		tel = 1
+
+	    # ADC transmission.
+	    iferr (adc = tabinterp1 (ST_TAB(st), "adc", w))
+		adc = INDEF
+
+	    # Aperture thruput.
+	    iferr {
+		switch (ST_APTYPE(st)) {
+		case CIRCULAR:
+		    ap = tabinterp1 (ST_TAB(st), "aperture",
+			ST_APSIZE(st,1) / ST_SEEING(st))
+		case RECTANGULAR:
+		    ap = tabinterp2 (ST_TAB(st), "aperture",
+			ST_APSIZE(st,1) / ST_SEEING(st),
+			ST_APSIZE(st,2) / ST_SEEING(st))
+		}
+	    } then
+		ap = 1
+
+	    # Fiber transmission.
+	    iferr (fib = tabinterp1 (ST_TAB(st), "fiber", w))
+		fib = INDEF
+
+	    # Spectrograph transmission.
+	    iferr (inst = tabinterp1 (ST_TAB(st), "spectrograph", w))
+		inst = INDEF
+
+	    # Filter transmission.
+	    iferr (fltr1 = tabinterp1 (ST_TAB(st), "filter", w))
+		fltr1 = INDEF
+	    iferr (fltr2 = tabinterp1 (ST_TAB(st), "filter2", w))
+		fltr2 = INDEF
+
+	    # Collimator transmission.
+	    iferr (col = tabinterp1 (ST_TAB(st), "collimator", w))
+		col = 1
+
+	    # Disperser efficiency.
+	    eff1 = st_dispeff (st, "disperser", w, ST_ORDER(st,1))
+	    eff2 = st_dispeff (st, "xdisperser", w, ST_ORDER(st,2))
+
+	    # Corrector transmission.
+	    iferr (cor = tabinterp1 (ST_TAB(st), "corrector", w))
+		cor = INDEF
+
+	    # Camera transmission.
+	    iferr (cam = tabinterp1 (ST_TAB(st), "camera", w))
+		cam = 1
+
+	    # Vignetting.
+	    iferr (vig = tabinterp1 (ST_TAB(st), "vignetting",
+		st_w2x (st, 1, w)))
+		vig = INDEF
+
+	    # Detector DQE.
+	    iferr (dqe = tabinterp1 (ST_TAB(st), "detector", w))
+		dqe = 1
+
+	    # Cumulative transmission.
+	    thruput = 1
+	    if (!IS_INDEF(tel)) {
+		tel = max (0., tel)
+		thruput = thruput * tel
+	    }
+	    if (!IS_INDEF(adc)) {
+		adc = max (0., adc)
+		thruput = thruput * adc
+	    }
+	    if (!IS_INDEF(ap)) {
+		ap = max (0., ap)
+		thruput = thruput * ap
+	    }
+	    if (!IS_INDEF(fib)) {
+		fib = max (0., fib)
+		thruput = thruput * fib
+	    }
+	    if (!IS_INDEF(inst)) {
+		inst = max (0., inst)
+		thruput = thruput * inst
+	    }
+	    if (!IS_INDEF(fltr1)) {
+		fltr1 = max (0., fltr1)
+		thruput = thruput * fltr1
+	    }
+	    if (!IS_INDEF(fltr2)) {
+		fltr2 = max (0., fltr2)
+		thruput = thruput * fltr2
+	    }
+	    if (!IS_INDEF(eff1)) {
+		eff1 = max (0., eff1)
+		thruput = thruput * eff1
+	    }
+	    if (!IS_INDEF(eff2)) {
+		eff2 = max (0., eff2)
+		thruput = thruput * eff2
+	    }
+	    if (!IS_INDEF(cor)) {
+		cor = max (0., cor)
+		thruput = thruput * cor
+	    }
+	    if (!IS_INDEF(col)) {
+		col = max (0., col)
+		thruput = thruput * col
+	    }
+	    if (!IS_INDEF(cam)) {
+		cam = max (0., cam)
+		thruput = thruput * cam
+	    }
+	    if (!IS_INDEF(vig)) {
+		vig = max (0., vig)
+		thruput = thruput * vig
+	    }
+	    if (!IS_INDEF(dqe)) {
+		dqe = max (0., dqe)
+		thruput = thruput * dqe
+	    }
+
+	    # Source photons detected.
+	    nmag = flux / (C * H / w)
+	    n = nmag * ST_AREA(st) * thruput * tobs * disp
+	    if (!IS_INDEF(ext))
+		n = n * ext
+	    n = max (0., n)
+	    if (n < 100000.)
+		n = int (n)
+	    nobj = nobj + n
+
+	    # Sky photon flux.
+	    iferr (sky = tabinterp2 (ST_TAB(st), "sky", w, ST_PHASE(st)))
+		iferr (sky = tabinterp1 (ST_TAB(st), "sky", w))
+		    sky = 0
+	    sky = sky / (C * H / w)
+
+	    # Thermal photon flux.
+	    thermal = 0.
+	    if (!IS_INDEF(ST_THERMAL(st))) {
+		iferr {
+		    thermal = tabinterp1 (ST_TAB(st), "emissivity", w)
+		    # 1.41e24 = 2 * c * (arcsec/rad)^2 * (A/cm) * (A/cm)^-4
+		    thermal = thermal * 1.41e24 / (w ** 4) /
+			(exp (min (30., 1.43877e8 / (w * ST_THERMAL(st)))) - 1)
+		} then
+		    thermal = 0.
+	    }
+
+	    # Total background.
+	    bkg = sky + thermal
+
+	    switch (ST_APTYPE(st)) {
+	    case CIRCULAR:
+		bkg = bkg * PI * (ST_APSIZE(st,1) / 2) ** 2
+	    case RECTANGULAR:
+		bkg = bkg * ST_APSIZE(st,1) * ST_SCALE(st,1) * ST_NOBJPIX(st)
+	    }
+	    n = bkg * ST_AREA(st) * thruput / ap * tobs * disp
+	    n = max (0., n)
+	    if (n < 100000.)
+		n = int (n)
+	    nbkg = nbkg + n
+	}
+
+	# Dark counts.
+	ndark = ST_NOBJPIX(st) * ST_DARK(st) * time
+	ndark = max (0., ndark)
+	if (ndark <100000.)
+	    ndark = int (ndark)
+
+	# Noise.
+	dobj = sqrt (nobj)
+	dbkg = sqrt (nbkg)
+	ddark = sqrt (ndark)
+	dreadout = sqrt (ST_NOBJPIX(st) * ST_RDNOISE(st)**2)
+	tnoise = nobj + nbkg + ndark + dreadout**2
+
+	# Background subtraction statistics.
+	switch (ST_SKYSUB(st)) {
+	case SKY_NONE:
+	    nobj = nobj + nbkg
+	    nbkg = 0.
+	default:
+	    if (ST_NSKYPIX(st) > 0)
+		tnoise = tnoise + ((nbkg + ndark) / ST_NOBJPIX(st) +
+		    ST_RDNOISE(st)**2) / ST_NSKYPIX(st)
+	}
+
+	# Final S/N.
+	snr = nobj
+	tnoise = sqrt (tnoise)
+	if (tnoise > 0.)
+	    snr = snr / tnoise
+
+	if (fd == NULL)
+	    return
+
+	# Print results.
+	sqnexp = sqrt (real(nexp))
+	ncols = nint (ST_DISP(st,2) / ST_DISP(st,1))
+
+	call un_ctranr (ST_DUNANG(st), ST_DUN(st), wave, w, 1)
+	if (nexp > 1) {
+	    call fprintf (fd,
+	    "---- Results for %d exposures of %.2fs at %.4g %s ----\n")
+		call pargi (nexp)
+		call pargr (time)
+		call pargr (w)
+		call pargstr (ST_DUNITS(st))
+	} else {
+	    call fprintf (fd,
+	    "---- Results for %.2fs exposure at %.4g %s ----\n")
+		call pargr (time)
+		call pargr (w)
+		call pargstr (ST_DUNITS(st))
+	}
+
+	call fprintf (fd, "\nSource flux: %.3g photons/s/cm^2/A (AB=%.3g)\n")
+	    call pargr (nmag)
+	    call pargr (-2.5*log10(flux) - 5*log10(wave) - 2.40)
+	call fprintf (fd, "Background flux: %.3g photons/s/cm^2/A (over source pixels)\n")
+	    call pargr (bkg)
+
+	call fprintf (fd, "\nTransmision/Efficiencies:%40t%10s %10s\n")
+	    call pargstr ("individual")
+	    call pargstr ("cumulative")
+	cum = 1
+	if (!IS_INDEF(ext) && ext < 1) {
+	    cum = cum * ext
+	    call fprintf (fd,
+		"    Atmosphere (%.2g mag/airmass)%40t%9.1f%% %9.1f%%\n")
+		call pargr (-2.5 * log10 (ext) / ST_AIRMASS(st))
+		call pargr (100 * ext)
+		call pargr (100 * cum)
+	}
+	if (!IS_INDEF(tel) && tel < 1) {
+	    cum = cum * tel
+	    call fprintf (fd, "    Telescope%40t%9.1f%% %9.1f%%\n")
+		call pargr (100 * tel)
+		call pargr (100 * cum)
+	}
+	if (!IS_INDEF(adc) && adc < 1) {
+	    cum = cum * adc
+	    call fprintf (fd, "    ADC%40t%9.1f%% %9.1f%%\n")
+		call pargr (100 * adc)
+		call pargr (100 * cum)
+	}
+	if (!IS_INDEF(ap) && ap < 1) {
+	    cum = cum * ap
+	    call fprintf (fd,
+		"    Aperture (seeing=%.2g\")%40t%9.1f%% %9.1f%%\n")
+		call pargr (ST_SEEING(st))
+		call pargr (100 * ap)
+		call pargr (100 * cum)
+	}
+	if (!IS_INDEF(fib) && fib < 1) {
+	    cum = cum * fib
+	    call fprintf (fd, "    Fiber%40t%9.1f%% %9.1f%%\n")
+		call pargr (100 * fib)
+		call pargr (100 * cum)
+	}
+	if (!IS_INDEF(fltr1) && fltr1 < 1) {
+	    cum = cum * fltr1
+	    call fprintf (fd, "    Filter%40t%9.1f%% %9.1f%%\n")
+		call pargr (100 * fltr1)
+		call pargr (100 * cum)
+	}
+	if (!IS_INDEF(fltr2) && fltr2 < 1) {
+	    cum = cum * fltr2
+	    call fprintf (fd, "    Filter%40t%9.1f%% %9.1f%%\n")
+		call pargr (100 * fltr2)
+		call pargr (100 * cum)
+	}
+	if (!IS_INDEF(inst) && inst < 1) {
+	    cum = cum * inst
+	    call fprintf (fd, "    Spectrograph%40t%9.1f%% %9.1f%%\n")
+		call pargr (100 * inst)
+		call pargr (100 * cum)
+	}
+	if (!IS_INDEF(col) && col < 1) {
+	    cum = cum * col
+	    call fprintf (fd, "    Collimator%40t%9.1f%% %9.1f%%\n")
+		call pargr (100 * col)
+		call pargr (100 * cum)
+	}
+	if (!IS_INDEF(eff1) && eff1 < 1) {
+	    cum = cum * eff1
+	    call fprintf (fd, "    Disperser%40t%9.1f%% %9.1f%%\n")
+		call pargr (100 * eff1)
+		call pargr (100 * cum)
+	}
+	if (!IS_INDEF(eff2) && eff2 < 1) {
+	    cum = cum * eff2
+	    call fprintf (fd, "    Cross disperser%40t%9.1f%% %9.1f%%\n")
+		call pargr (100 * eff2)
+		call pargr (100 * cum)
+	}
+	if (!IS_INDEF(cor) && cor < 1) {
+	    cum = cum * cor
+	    call fprintf (fd, "    Corrector%40t%9.1f%% %9.1f%%\n")
+		call pargr (100 * cor)
+		call pargr (100 * cum)
+	}
+	if (!IS_INDEF(cam) && cam < 1) {
+	    cum = cum * cam
+	    call fprintf (fd, "    Camera%40t%9.1f%% %9.1f%%\n")
+		call pargr (100 * cam)
+		call pargr (100 * cum)
+	}
+	if (!IS_INDEF(vig) && vig < 0.999) {
+	    cum = cum * vig
+	    call fprintf (fd, "    Vignetting%40t%9.1f%% %9.1f%%\n")
+		call pargr (100 * vig)
+		call pargr (100 * vig)
+	}
+	if (!IS_INDEF(dqe) && dqe < 1) {
+	    cum = cum * dqe
+	    call fprintf (fd, "    Detector DQE%40t%9.1f%% %9.1f%%\n")
+		call pargr (100 * dqe)
+		call pargr (100 * cum)
+	}
+
+	call fprintf (fd, "\nStatistics per exposure per pixel:%40t%10s %10s\n")
+	    call pargstr ("e-")
+	    call pargstr ("sigma")
+	call fprintf (fd, "    Source%40t%10d %10.1f\n")
+	    call pargr (nobj)
+	    call pargr (dobj)
+	if (nbkg > 0.) {
+	    call fprintf (fd, "    Background%40t%10d %10.1f\n")
+		call pargr (nbkg)
+		call pargr (dbkg)
+	}
+	call fprintf (fd, "    Dark%40t%10d %10.1f\n")
+	    call pargr (ndark)
+	    call pargr (ddark)
+	call fprintf (fd, "    Readout%40t%10w %10.1f\n")
+	    call pargr (dreadout)
+	call fprintf (fd, "    Net%40t%10d %10.1f\n")
+	    call pargr (nobj + nbkg + ndark)
+	    call pargr (tnoise)
+
+	call fprintf (fd, "\nSignal-to-Noise Statistics:\n")
+	call fprintf (fd, "  %3d%7tper exposure per pixel\n")
+	    call pargr (snr)
+	    call pargr (ST_DISP(st,1))
+	call un_ctranr (ST_DUNANG(st), ST_DUN(st), ST_DISP(st,2), w, 1)
+	call fprintf (fd,
+	    "  %3d%7tper exposure per %.3g %s (%d pixel) resolution element\n")
+	    call pargr (snr * sqrt (real (ncols)))
+	    call pargr (w)
+	    call pargstr (ST_DUNITS(st))
+	    call pargi (ncols)
+	if (nexp > 1.) {
+	    call fprintf (fd,
+		"  %3d%10tper %d exposures per pixel\n")
+		call pargr (snr * sqnexp)
+		call pargi (nexp)
+		call pargr (ST_DISP(st,1))
+	    call un_ctranr (ST_DUNANG(st), ST_DUN(st), ST_DISP(st,2), w, 1)
+	    call fprintf (fd,
+	"  %3d%10tper %d exposures per %.3g %s (%d pixel) resolution element\n")
+		call pargr (snr * sqrt (real (ncols)) * sqnexp)
+		call pargi (nexp)
+		call pargr (w)
+		call pargstr (ST_DUNITS(st))
+		call pargi (ncols)
+	}
+
+	if (nexp > 1) {
+	    call fprintf (fd,
+		"\nExposure time: %d exposures of %.2fs")
+		call pargi (nexp)
+		call pargr (time)
+	    if (nexp * time > 60.) {
+		call fprintf (fd, " (%.1h)")
+		    call pargr (nexp * time / 3600.)
+	    } else {
+		call fprintf (fd, " (%.1f)")
+		call pargr (nexp * time)
+	    }
+	} else {
+	    call fprintf (fd, "\nExposure time: %.2fs")
+		call pargr (time)
+	    if (time > 60.) {
+		call fprintf (fd, " (%.1h)")
+		    call pargr (time / 3600.)
+	    }
+	}
+	if (ST_SKYSUB(st) == SKY_SHUFFLE)
+	    call fprintf (fd, " (shuffled)\n")
+	else
+	    call fprintf (fd, "\n")
+	call fprintf (fd, "\n")
+end
+
+
+# ST_CHECK -- Check for possible errors such as lack of proper order blocking.
+
+procedure st_check (st, fd, waves, npix)
+
+pointer st		#I SPECTIME structure
+int	fd		#I Output file descriptor
+real	waves[ARB]	#I Wavelengths
+int	npix		#I Number of pixels
+
+int	i, n, step
+real	nobj[4], nsky[4]
+real	w1, w2, w, dw, snr, thruput, sat, dnmax, maxcount, maxfrac
+pointer	tab
+real	stgetr(), tabgetr(), gr_getr()
+
+begin
+	tab = ST_TAB(st)
+
+	# Check for extrapolations.  This has to be done before the order
+	# overlap because that may reference wavelength which are extrapolated.
+
+	ifnoerr (w1 = tabgetr (tab, "spectrum", "", "table.xmin")) {
+	    w2 = tabgetr (tab, "spectrum", "", "table.xmax")
+	    if (w1 > waves[1] || w2 < waves[npix])
+		call fprintf (fd,
+		    "WARNING: Spectrum table extrapolated in wavelength\n")
+	}
+	ifnoerr (w1 = tabgetr (tab, "sky", "", "table.xmin")) {
+	    w2 = tabgetr (tab, "sky", "", "table.xmax")
+	    if (w1 > waves[1] || w2 < waves[npix])
+		call fprintf (fd,
+		    "WARNING: Sky table extrapolated in wavelength\n")
+	    ifnoerr (w1 = tabgetr (tab, "sky", "", "table.ymin")) {
+		w2 = tabgetr (tab, "sky", "", "table.ymax")
+		if (w1 > ST_PHASE(st) || w2 < ST_PHASE(st))
+		    call fprintf (fd,
+			"WARNING: Sky table extrapolated in lunar phase\n")
+	    }
+	}
+	ifnoerr (w1 = tabgetr (tab, "sensfunc", "", "table.xmin")) {
+	    w2 = tabgetr (tab, "sensfunc", "", "table.xmax")
+	    if (w1 > waves[1] || w2 < waves[npix])
+		call fprintf (fd,
+		    "WARNING: Sensitivity table extrapolated in wavelength\n")
+	}
+	ifnoerr (w1 = tabgetr (tab, "extinction", "", "table.xmin")) {
+	    w2 = tabgetr (tab, "extinction", "", "table.xmax")
+	    if (w1 > waves[1] || w2 < waves[npix])
+		call fprintf (fd,
+		    "WARNING: Extinction table extrapolated in wavelength\n")
+	}
+	ifnoerr (w1 = tabgetr (tab, "telescope", "", "table.xmin")) {
+	    w2 = tabgetr (tab, "telescope", "", "table.xmax")
+	    if (w1 > waves[1] || w2 < waves[npix])
+		call fprintf (fd,
+		    "WARNING: Telescope table extrapolated in wavelength\n")
+	}
+	ifnoerr (w1 = tabgetr (tab, "adc", "", "table.xmin")) {
+	    w2 = tabgetr (tab, "adc", "", "table.xmax")
+	    if (w1 > waves[1] || w2 < waves[npix])
+		call fprintf (fd,
+		    "WARNING: ADC table extrapolated in wavelength\n")
+	}
+	ifnoerr (w1 = tabgetr (tab, "filter", "", "table.xmin")) {
+	    w2 = tabgetr (tab, "filter", "", "table.xmax")
+	    if (w1 > waves[1] || w2 < waves[npix])
+		call fprintf (fd,
+		    "WARNING: Filter table extrapolated in wavelength\n")
+	}
+	ifnoerr (w1 = tabgetr (tab, "filter2", "", "table.xmin")) {
+	    w2 = tabgetr (tab, "filter2", "", "table.xmax")
+	    if (w1 > waves[1] || w2 < waves[npix])
+	    call fprintf (fd,
+		"WARNING: Second filter table extrapolated in wavelength\n")
+	}
+	ifnoerr (w1 = tabgetr (tab, "fiber", "", "table.xmin")) {
+	    w2 = tabgetr (tab, "fiber", "", "table.xmax")
+	    if (w1 > waves[1] || w2 < waves[npix])
+		call fprintf (fd,
+		    "WARNING: Fiber table extrapolated in wavelength\n")
+	}
+	ifnoerr (w1 = tabgetr (tab, "collimator", "", "table.xmin")) {
+	    w2 = tabgetr (tab, "collimator", "", "table.xmax")
+	    if (w1 > waves[1] || w2 < waves[npix])
+		call fprintf (fd,
+		    "WARNING: Collimator table extrapolated in wavelength\n")
+	}
+	ifnoerr (w1 = tabgetr (tab,"disperser","","table.xmin")/ST_ORDER(st,1)) {
+	    w2 = tabgetr (tab, "disperser", "", "table.xmax") / ST_ORDER(st,1)
+	    if (w1 > waves[1] || w2 < waves[npix])
+		call fprintf (fd,
+		    "WARNING: Disperser table extrapolated in wavelength\n")
+	    ifnoerr (w1 = tabgetr (tab, "disperser", "", "table.ymin")) {
+		w2 = tabgetr (tab, "disperser", "", "table.ymax")
+		if (w1 > ST_ORDER(st,1) || w2 < ST_ORDER(st,1))
+		    call fprintf (fd,
+			"WARNING: Disperser table extrapolated in order\n")
+	    }
+	}
+	ifnoerr (w1 = tabgetr (tab,"xdisperser", "","table.xmin")/ST_ORDER(st,2)) {
+	    w2 = tabgetr (tab, "xdisperser", "", "table.xmax") / ST_ORDER(st,2)
+	    if (w1 > waves[1] || w2 < waves[npix])
+		call fprintf (fd,
+		"WARNING: Cross disperser table extrapolated in wavelength\n")
+	    ifnoerr (w1 = tabgetr (tab, "xdisperser", "", "table.ymin")) {
+		w2 = tabgetr (tab, "xdisperser", "", "table.ymax")
+		if (w1 > ST_ORDER(st,2) || w2 < ST_ORDER(st,2))
+		    call fprintf (fd,
+		    "WARNING: Cross disperser table extrapolated in order\n")
+	    }
+	}
+	ifnoerr (w1 = tabgetr (tab, "corrector", "", "table.xmin")) {
+	    w2 = tabgetr (tab, "corrector", "", "table.xmax")
+	    if (w1 > waves[1] || w2 < waves[npix])
+		call fprintf (fd,
+		    "WARNING: Corrector table extrapolated in wavelength\n")
+	}
+	ifnoerr (w1 = tabgetr (tab, "camera", "", "table.xmin")) {
+	    w2 = tabgetr (tab, "camera", "", "table.xmax")
+	    if (w1 > waves[1] || w2 < waves[npix])
+		call fprintf (fd,
+		    "WARNING: Camera table extrapolated in wavelength\n")
+	}
+	ifnoerr (w1 = tabgetr (tab, "detector", "", "table.xmin")) {
+	    w2 = tabgetr (tab, "detector", "", "table.xmax")
+	    if (w1 > waves[1] || w2 < waves[npix])
+		call fprintf (fd,
+		    "WARNING: Detector table extrapolated in wavelength\n")
+	}
+
+	# Check for saturation and DN limits.
+	sat = stgetr (st, "saturation", "detector", MAX_REAL)
+	dnmax = stgetr (st, "dnmax", "detector", MAX_REAL)
+
+	# Check for insufficient sky pixels.
+	switch (ST_SKYSUB(st)) {
+	case SKY_LONGSLIT:
+	    if (ST_NSKYPIX(st) <= 0)
+		call fprintf (fd,
+		    "WARNING: Slit is too short for sky subtraction\n")
+	}
+
+	# Check for order overlaps and saturation.
+	if (npix > 3) {
+	    step = max (1, npix / 21)
+	    maxfrac = 0.
+	    maxcount = 0
+	    do i = 3*step, npix-3*step, step {
+		w = waves[i]
+		call st_snr (st, NULL, w, ST_NEXP(st), ST_TIME(st), nobj, nsky,
+		    snr, thruput)
+		maxcount = max (nobj[1]+nsky[3], maxcount)
+		if (nobj[1] > 0.) {
+		    maxfrac = max (nobj[2]/nobj[1], maxfrac)
+		    maxfrac = max (nobj[4]/nobj[1], maxfrac)
+		}
+	    }
+	} else {
+	    w = waves[1]
+	    call st_snr (st, NULL, w, ST_NEXP(st), ST_TIME(st), nobj, nsky,
+		snr, thruput)
+	    maxcount = max (nobj[1]+nsky[3], maxcount)
+	    if (nobj[1] > 0.) {
+		maxfrac = max (nobj[2]/nobj[1], maxfrac)
+		maxfrac = max (nobj[4]/nobj[1], maxfrac)
+	    }
+	}
+
+	if (maxcount > sat)
+	    call fprintf (fd, "WARNING: Exposure may saturate.\n")
+	if (maxcount / ST_GAIN(st) > dnmax)
+	    call fprintf (fd, "WARNING: Exposure may overflow DN maximum.\n")
+	if (maxfrac > 0.1)
+	    call fprintf (fd,
+		"WARNING: More than 10%% contribution from other orders.\n")
+
+	if (ST_DISPTYPE(st,2) != 0 && !IS_INDEFI(ST_ORDER(st,1))) {
+	    w = ST_CW(st)
+	    i = ST_ORDER(st,1)
+	    dw = abs (gr_getr (ST_GR(st,2), "dispersion"))
+	    dw = dw * ST_PIXSIZE(st) * ST_BIN(st,2)
+	    n = w * (1 - real (i) / real (i + 1)) / dw
+	    if (n < ST_APSIZE(st,2) / ST_SCALE(st,2)) 
+		call fprintf (fd, "WARNING: Orders overlap\n")
+	}
+
+	call fprintf (fd, "\n")
+end
+
+
+# ST_GTABLE -- Get table name from CL and load if a name is given.
+# Otherwise get table name from another table, if specified, and load if
+# a name is found.
+
+procedure st_gtable (st, name, table)
+
+pointer st		#I SPECTIME structure
+char	name[ARB]	#I Table to load (CL parameter name and table name)
+char	table[ARB]	#I Table to use if not defined by CL parameter
+
+pointer sp, dir, path, fname
+int	i, nowhite(), strdic()
+bool	streq()
+errchk	st_gtable1
+
+define	done_	10
+
+begin
+	call smark (sp)
+	call salloc (dir, SZ_FNAME, TY_CHAR)
+	call salloc (path, SZ_FNAME, TY_CHAR)
+	call salloc (fname, SZ_FNAME, TY_CHAR)
+
+	# Determine table name from CL parameter or table.
+	call stgstr (st, name, table, "", Memc[fname], SZ_FNAME)
+	i = nowhite (Memc[fname], Memc[fname], SZ_FNAME)
+
+	# Special cases.
+	if (streq (Memc[fname], "none"))
+	    goto done_
+	if (streq (name, "spectrum")) {
+	    ST_SPEC(st) = strdic (Memc[fname], Memc[path], SZ_FNAME, SPECTYPES)
+	    if (ST_SPEC(st) != SPEC_TAB && streq (Memc[fname], Memc[path]))
+		goto done_
+	    ST_SPEC(st) = SPEC_TAB
+	}
+
+	# If a filename is given find it and load it.
+	if (Memc[fname] != EOS)
+	    call st_gtable1 (st, name, Memc[fname])
+
+done_	call sfree (sp)
+end
+
+
+# ST_GTABLE1 -- Load table with search path.
+# Otherwise get table name from another table, if specified, and load if
+# a name is found.
+
+procedure st_gtable1 (st, name, fname)
+
+pointer st		#I SPECTIME structure
+char	name[ARB]	#I Table name
+char	fname[ARB]	#I File
+
+pointer sp, dir, path
+real	value
+int	i, ctor(), strlen(), clgfil(), access()
+errchk	tabload
+
+define	done_	10
+
+begin
+	call smark (sp)
+	call salloc (dir, SZ_FNAME, TY_CHAR)
+	call salloc (path, SZ_FNAME, TY_CHAR)
+
+	# Check for constant value.
+	i = 1
+	if (ctor (fname, i, value) == strlen (fname)) {
+	    call tabload (ST_TAB(st), name, fname)
+	    goto done_
+	}
+
+	# Absolute path or current directory.
+	if (access (fname, READ_ONLY, 0) == YES) {
+	    call tabload (ST_TAB(st), name, fname)
+	    goto done_
+	}
+
+	# Search directories.
+	call clprew (ST_SEARCH(st))
+	while (clgfil (ST_SEARCH(st), Memc[dir], SZ_FNAME) != EOF) {
+	    call sprintf (Memc[path], SZ_FNAME, "%s/%s")
+		call pargstr (Memc[dir])
+		call pargstr (fname)
+	    if (access (Memc[path], READ_ONLY, 0) == NO)
+		next
+	    call tabload (ST_TAB(st), name, Memc[path])
+	    goto done_
+	}
+
+	# Search sptimelib$.
+	call sprintf (Memc[path], SZ_FNAME, "%s/%s")
+	    call pargstr ("sptimelib$")
+	    call pargstr (fname)
+	if (access (Memc[path], READ_ONLY, 0) == YES) {
+	    call tabload (ST_TAB(st), name, Memc[path])
+	    goto done_
+	}
+
+	call sprintf (Memc[path], SZ_FNAME, "Table `%s' not found")
+	    call pargstr (fname)
+	call error (1, Memc[path])
+
+done_	call sfree (sp)
+end
+
+
+# ST_SPECTRUM -- Return spectrum flux.
+
+real procedure st_spectrum (st, wave)
+
+pointer st		#I SPECTIME pointer
+real	wave		#I Wavelength
+real	flux		#O Flux
+
+real	tabinterp1(), ccm()
+errchk	tabinterp1, ccm
+
+begin
+	switch (ST_SPEC(st)) {
+	case SPEC_TAB:
+	    flux = tabinterp1 (ST_TAB(st), "spectrum", wave)
+	case SPEC_BB:
+	    flux = (exp (min (30., 1.4338e8/(ST_REFW(st)*ST_PARAM(st)))) - 1) /
+		(exp (min (30., 1.4338e8/(wave*ST_PARAM(st)))) - 1)
+	    flux = ST_REFFL(st) * (ST_REFW(st) / wave) ** 5 * flux
+	case SPEC_FL:
+	    flux = ST_REFFL(st) * (wave/ST_REFW(st)) ** ST_PARAM(st)
+	case SPEC_FN:
+	    flux = ST_REFFL(st) * (wave/ST_REFW(st)) ** (-2.-ST_PARAM(st))
+	}
+	flux = flux * 10. ** (0.4 * ST_AV(st) *
+	    (ccm (ST_REFW(st), ST_RV(st)) - ccm (wave, ST_RV(st))))
+
+	return (flux)
+end
+
+
+# ST_OUTPUT -- Output graphs and/or lists.
+
+procedure st_output (st, gp, fd, interactive, output, w, npts)
+
+pointer st			#I SPECTIME structure
+pointer gp			#U GIO pointer
+int	fd			#I FIO pointer
+bool	interactive		#I Interactive?
+char	output[ARB]		#I Output type
+real	w[npts]			#I Wavelengths
+int	npts			#I Number of points
+
+int	i, j, ndata, type
+real	nobj[4], nsky[4]
+real	wx1, wx2, wy1, wy2, wmin, wmax, a, b, buf, f, snr, thruput, airmass
+pointer sp, spec, name
+pointer	title, xlabel, ylabel, id[4], xdata, ydata, str, tab
+
+bool	tabexists()
+int	strdic(), clgcur()
+real	st_dispeff(), tabinterp1(), tabinterp2(), st_spectrum(), tabgetr()
+errchk	st_snr, st_dispeff, tabinterp1, tabinterp2, st_spectrum
+
+begin
+	if (gp == NULL && fd == NULL)
+	    return
+
+	call smark (sp)
+	call salloc (spec, SZ_LINE, TY_CHAR)
+	call salloc (name, SZ_LINE, TY_CHAR)
+	call salloc (title, SZ_LINE, TY_CHAR)
+	call salloc (xlabel, SZ_LINE, TY_CHAR)
+	call salloc (ylabel, SZ_LINE, TY_CHAR)
+	call salloc (id[1], SZ_LINE, TY_CHAR)
+	call salloc (id[2], SZ_LINE, TY_CHAR)
+	call salloc (id[3], SZ_LINE, TY_CHAR)
+	call salloc (id[4], SZ_LINE, TY_CHAR)
+	call salloc (xdata, npts, TY_REAL)
+	call salloc (ydata, 4*npts, TY_REAL)
+	call salloc (str, SZ_LINE, TY_CHAR)
+
+	tab = ST_TAB(st)
+
+	# Set title, data, and data limits.
+	call st_gtitle (st, "title", "spectrograph", Memc[title], SZ_LINE)
+	call st_gtitle (st, "spectitle", "spectrum", Memc[spec], SZ_LINE)
+	if (Memc[spec] == EOS) {
+	    switch (ST_SPEC(st)) {
+	    case SPEC_BB:
+		call sprintf (Memc[spec], SZ_LINE,
+		    "Blackbody spectrum of temperature %g K")
+		    call pargr (ST_PARAM(st))
+	    case SPEC_FL:
+		call sprintf (Memc[spec], SZ_LINE,
+		    "F(lambda) power law spectrum of index %g")
+		    call pargr (ST_PARAM(st))
+	    case SPEC_FN:
+		call sprintf (Memc[spec], SZ_LINE,
+		    "F(nu) power law spectrum of index %g")
+		    call pargr (ST_PARAM(st))
+	    }
+	}
+
+	call sprintf (Memc[xlabel], SZ_LINE, "Dispersion (%s)")
+	    call pargstr (ST_DUNITS(st))
+
+	ndata = npts
+	#call amovr (w, Memr[xdata], ndata)
+	call un_ctranr (ST_DUNANG(st), ST_DUN(st), w, Memr[xdata], ndata)
+	Memr[ydata] = INDEF
+	Memr[ydata+npts] = INDEF
+	Memr[ydata+2*npts] = INDEF
+	Memr[ydata+3*npts] = INDEF
+	#wx1 = INDEF; wx2 = INDEF; wy1 = -4.; wy2 = 104.
+	wx1 = INDEF; wx2 = INDEF; wy1 = INDEF; wy2 = INDEF
+
+	type = strdic (output, Memc[name], SZ_LINE, OUTTYPES)
+	switch (type) {
+	case OUT_RATE:
+	    if (Memc[title] != EOS)
+		call strcat ("\n", Memc[title], SZ_LINE)
+	    call strcat (Memc[spec], Memc[title], SZ_LINE)
+	    call strcpy ("Photons/s/A", Memc[ylabel], SZ_LINE)
+	    call strcpy ("Object (ph/s/A)", Memc[id[1]], SZ_LINE) 
+	    call strcpy ("Background (ph/s/A)", Memc[id[2]], SZ_LINE) 
+	    call strcpy ("Total (ph/s/A)", Memc[id[3]], SZ_LINE) 
+
+	    do i = 1, npts {
+		call st_snr (st, NULL, w[i], ST_NEXP(st), ST_TIME(st),
+		    nobj, nsky, snr, thruput)
+		Memr[ydata+i-1] = nobj[1] / ST_TIME(st) / ST_DISP(st,1)
+		Memr[ydata+npts+i-1] = nsky[1] / ST_TIME(st) / ST_DISP(st,1)
+		Memr[ydata+2*npts+i-1] = (nobj[1]+nsky[1]) /
+		    ST_TIME(st) / ST_DISP(st,1)
+	    }
+	    call alimr (Memr[ydata+npts], npts, a, b)
+	    if (b <= 0.) {
+		Memr[ydata+npts] = INDEF
+		Memr[ydata+2*npts] = INDEF
+		if (Memc[title] != EOS)
+		    call strcat ("\n", Memc[title], SZ_LINE)
+		call sprintf (Memc[str], SZ_LINE, "Object photon rates\n")
+		call strcat (Memc[str], Memc[title], SZ_LINE)
+	    } else {
+		if (Memc[title] != EOS)
+		    call strcat ("\n", Memc[title], SZ_LINE)
+		call sprintf (Memc[str], SZ_LINE,
+		    "Object, background, and total photon rates\n")
+		call strcat (Memc[str], Memc[title], SZ_LINE)
+	    }
+
+	    wy1 = INDEF; wy2 = INDEF
+	case OUT_OBJ:
+	    if (Memc[title] != EOS)
+		call strcat ("\n", Memc[title], SZ_LINE)
+	    call strcat (Memc[spec], Memc[title], SZ_LINE)
+	    call sprintf (Memc[str], SZ_LINE, "\nExposure time = %d seconds")
+		call pargr (ST_NEXP(st) * max (ST_TIME(st),1.))
+	    call strcat (Memc[str], Memc[title], SZ_LINE)
+	    if (ST_NEXP(st) > 1) {
+		call sprintf (Memc[str], SZ_LINE, "(%d exposures)")
+		    call pargi (ST_NEXP(st))
+		call strcat (Memc[str], Memc[title], SZ_LINE)
+	    }
+	    call strcpy ("Object DN", Memc[ylabel], SZ_LINE)
+	    call strcpy ("Total Object (counts)", Memc[id[1]], SZ_LINE) 
+	    call sprintf (Memc[id[2]], SZ_LINE, "Order %d (counts)")
+		call pargi (ST_ORDER(st,1)-1)
+	    call sprintf (Memc[id[3]], SZ_LINE, "Order %d (counts)")
+		call pargi (ST_ORDER(st,1))
+	    call sprintf (Memc[id[4]], SZ_LINE, "Order %d (counts)")
+		call pargi (ST_ORDER(st,1)+1)
+
+	    do i = 1, npts {
+		call st_snr (st, NULL, w[i], 1, ST_NEXP(st) * ST_TIME(st),
+		    nobj, nsky, snr, thruput)
+		Memr[ydata+i-1] = nobj[1] / ST_GAIN(st)
+		Memr[ydata+npts+i-1] = nobj[2] / ST_GAIN(st)
+		Memr[ydata+2*npts+i-1] = nobj[3] / ST_GAIN(st)
+		Memr[ydata+3*npts+i-1] = nobj[4] / ST_GAIN(st)
+	    }
+	    call alimr (Memr[ydata+npts], npts, a, b)
+	    if (b <= 0.)
+		Memr[ydata+npts] = INDEF
+	    call alimr (Memr[ydata+3*npts], npts, a, b)
+	    if (b <= 0.)
+		Memr[ydata+3*npts] = INDEF
+	    if (IS_INDEF(Memr[ydata+npts]) && IS_INDEF(Memr[ydata+3*npts])) {
+		Memr[ydata+2*npts] = INDEF
+		if (Memc[title] != EOS)
+		    call strcat ("\n", Memc[title], SZ_LINE)
+		call sprintf (Memc[str], SZ_LINE,
+		    "Object DN at gain of %.2g\n")
+		    call pargr (ST_GAIN(st))
+		call strcat (Memc[str], Memc[title], SZ_LINE)
+	    } else {
+		if (Memc[title] != EOS)
+		    call strcat ("\n", Memc[title], SZ_LINE)
+		call sprintf (Memc[str], SZ_LINE,
+		    "Object DN at gain of %.2g with order contributions\n")
+		    call pargr (ST_GAIN(st))
+		call strcat (Memc[str], Memc[title], SZ_LINE)
+	    }
+
+	    wy1 = INDEF; wy2 = INDEF
+	case OUT_SNR:
+	    if (Memc[title] != EOS)
+		call strcat ("\n", Memc[title], SZ_LINE)
+	    call strcat (Memc[spec], Memc[title], SZ_LINE)
+	    call sprintf (Memc[str], SZ_LINE, "\nExposure time = %d seconds")
+		call pargr (ST_NEXP(st) * max(ST_TIME(st),1.))
+	    call strcat (Memc[str], Memc[title], SZ_LINE)
+	    if (ST_NEXP(st) > 1) {
+		call sprintf (Memc[str], SZ_LINE, "(%d exposures)")
+		    call pargi (ST_NEXP(st))
+		call strcat (Memc[str], Memc[title], SZ_LINE)
+	    }
+	    call strcpy ("S/N", Memc[ylabel], SZ_LINE)
+	    call strcpy ("S/N", Memc[id[1]], SZ_LINE) 
+
+	    a = sqrt (real(ST_NEXP(st)))
+	    do i = 1, npts {
+		call st_snr (st, NULL, w[i], ST_NEXP(st), ST_TIME(st),
+		    nobj, nsky, snr, thruput)
+		Memr[ydata+i-1] = a * snr
+	    }
+	    wy1 = INDEF; wy2 = INDEF
+	case OUT_ATM:
+	    call st_gtitle (st, "exttitle", "extinction", Memc[str], SZ_LINE)
+	    if (Memc[str] == EOS)
+		call strcpy ("Extinction", Memc[str], SZ_LINE)
+	    if (Memc[title] != EOS)
+		call strcat ("\n", Memc[title], SZ_LINE)
+	    call strcat (Memc[str], Memc[title], SZ_LINE)
+	    call sprintf (Memc[str], SZ_LINE, "\nAirmass of %g")
+		call pargr (ST_AIRMASS(st))
+	    call strcat (Memc[str], Memc[title], SZ_LINE)
+	    call strcpy ("Transmission (%)", Memc[ylabel], SZ_LINE)
+	    call strcpy ("ATM Transmission (%)", Memc[id[1]], SZ_LINE) 
+
+	    iferr  {
+		do i = 1, npts {
+		    f = tabinterp1 (tab, "extinction", w[i])
+		    Memr[ydata+i-1] = 100 * 10 ** (-0.4 * f * ST_AIRMASS(st))
+		}
+	    } then
+		call amovkr (100., Memr[ydata], npts)
+	case OUT_TEL:
+	    call st_gtitle (st, "teltitle", "telescope", Memc[str], SZ_LINE)
+	    if (Memc[str] == EOS)
+		call strcpy ("Telescope", Memc[str], SZ_LINE)
+	    if (Memc[title] != EOS)
+		call strcat ("\n", Memc[title], SZ_LINE)
+	    call strcat (Memc[str], Memc[title], SZ_LINE)
+	    call strcpy ("Transmission (%)", Memc[ylabel], SZ_LINE)
+	    call strcpy ("Telescope Transmission (%)", Memc[id[1]], SZ_LINE) 
+
+	    iferr  {
+		do i = 1, npts
+		    Memr[ydata+i-1] = 100 *
+			tabinterp1 (tab, Memc[name], w[i])
+	    } then
+		call amovkr (100., Memr[ydata], npts)
+	case OUT_AP:
+	    call st_gtitle (st, "aptitle", "aperture", Memc[str], SZ_LINE)
+	    if (Memc[str] == EOS)
+		call strcpy ("Aperture", Memc[str], SZ_LINE)
+	    if (Memc[title] != EOS)
+		call strcat ("\n", Memc[title], SZ_LINE)
+	    call strcat (Memc[str], Memc[title], SZ_LINE)
+	    call sprintf (Memc[str], SZ_LINE, "\nSeeing of %.2f\"")
+		call pargr (ST_SEEING(st))
+	    call strcat (Memc[str], Memc[title], SZ_LINE)
+	    call strcpy ("Transmission (%)", Memc[ylabel], SZ_LINE)
+	    call strcpy ("Aperture (%)", Memc[id[1]], SZ_LINE) 
+
+	    iferr  {
+		switch (ST_APTYPE(st)) {
+		case CIRCULAR:
+		    f = 100 * tabinterp1 (tab, Memc[name],
+			ST_APSIZE(st,1) / ST_SEEING(st))
+		case RECTANGULAR:
+		    f = 100 * tabinterp2 (tab, Memc[name],
+			ST_APSIZE(st,1) / ST_SEEING(st),
+			ST_APSIZE(st,2) / ST_SEEING(st))
+		}
+	    } then
+		f = 100
+	    call amovkr (f, Memr[ydata], npts)
+	case OUT_FIB:
+	    if (tabexists (tab, Memc[name])) {
+		call st_gtitle (st, "fibtitle", "fiber", Memc[str], SZ_LINE)
+		if (Memc[str] == EOS)
+		    call strcpy ("Fiber", Memc[str], SZ_FNAME)
+		if (Memc[title] != EOS)
+		    call strcat ("\n", Memc[title], SZ_LINE)
+		call strcat (Memc[str], Memc[title], SZ_LINE)
+		call strcpy ("Transmission (%)", Memc[ylabel], SZ_LINE)
+
+		iferr  {
+		    do i = 1, npts
+			Memr[ydata+i-1] = 100 *
+			    tabinterp1 (tab, Memc[name], w[i])
+		} then
+		    call amovkr (100., Memr[ydata], npts)
+	    }
+	case OUT_FILT, OUT_FILT2:
+	    if (tabexists (tab, Memc[name])) {
+		if (type == OUT_FILT)
+		    call st_gtitle (st, "ftitle", "filter", Memc[str], SZ_LINE)
+		else
+		    call st_gtitle (st, "f2title", "filter2", Memc[str],SZ_LINE)
+		if (Memc[str] == EOS)
+		    call strcpy ("Filter", Memc[str], SZ_LINE)
+		if (Memc[title] != EOS)
+		    call strcat ("\n", Memc[title], SZ_LINE)
+		call strcat (Memc[str], Memc[title], SZ_LINE)
+		call strcpy ("Transmission (%)", Memc[ylabel], SZ_LINE)
+		call strcpy ("Fiber (%)", Memc[id[1]], SZ_LINE) 
+
+		iferr  {
+		    do i = 1, npts
+			Memr[ydata+i-1] = 100 *
+			    tabinterp1 (tab, Memc[name], w[i])
+		} then
+		    call amovkr (100., Memr[ydata], npts)
+	    }
+	case OUT_COL:
+	    call st_gtitle (st, "coltitle", "collimator", Memc[str], SZ_LINE)
+	    if (Memc[str] == EOS)
+		call strcpy ("Collimator", Memc[str], SZ_LINE)
+	    if (Memc[title] != EOS)
+		call strcat ("\n", Memc[title], SZ_LINE)
+	    call strcat (Memc[str], Memc[title], SZ_LINE)
+	    call strcpy ("Transmission (%)", Memc[ylabel], SZ_LINE)
+	    call strcpy ("Collimator (%)", Memc[id[1]], SZ_LINE) 
+
+	    iferr  {
+		do i = 1, npts
+		    Memr[ydata+i-1] = 100 *
+			tabinterp1 (tab, Memc[name], w[i])
+	    } then
+		call amovkr (100., Memr[ydata], npts)
+	case OUT_DISP:
+	    if (ST_DISPTYPE(st,1) != 0) {
+		call st_gtitle (st, "disptitle", "disperser", Memc[str],SZ_LINE)
+		if (Memc[str] == EOS)
+		    call strcpy ("Disperser", Memc[str], SZ_LINE)
+		if (Memc[title] != EOS)
+		    call strcat ("\n", Memc[title], SZ_LINE)
+		call strcat (Memc[str], Memc[title], SZ_LINE)
+		call strcpy ("Efficiency (%)", Memc[ylabel], SZ_LINE)
+		call strcpy ("Disperser (%)", Memc[id[1]], SZ_LINE) 
+
+		do i = 1, npts
+		    Memr[ydata+i-1] = 100 * st_dispeff (st, Memc[name], w[i],
+			ST_ORDER(st,1))
+	    }
+	case OUT_XDISP:
+	    if (ST_DISPTYPE(st,2) != 0) {
+		call st_gtitle (st, "xdisptitle","xdisperser",Memc[str],SZ_LINE)
+		if (Memc[str] == EOS)
+		    call strcpy ("Crossdisperser", Memc[str], SZ_LINE)
+		if (Memc[title] != EOS)
+		    call strcat ("\n", Memc[title], SZ_LINE)
+		call strcat (Memc[str], Memc[title], SZ_LINE)
+		call strcpy ("Efficiency (%)", Memc[ylabel], SZ_LINE)
+		call strcpy ("Cross-disperser (%)", Memc[id[1]], SZ_LINE) 
+
+		do i = 1, npts
+		    Memr[ydata+i-1] = 100 * st_dispeff (st, Memc[name], w[i],
+			ST_ORDER(st,2))
+	    }
+	case OUT_COR:
+	    if (tabexists (tab, Memc[name])) {
+		call st_gtitle (st, "cortitle", "corrector", Memc[str], SZ_LINE)
+		if (Memc[str] == EOS)
+		    call strcpy ("Corrector", Memc[str], SZ_LINE)
+		if (Memc[title] != EOS)
+		    call strcat ("\n", Memc[title], SZ_LINE)
+		call strcat (Memc[str], Memc[title], SZ_LINE)
+		call strcpy ("Transmission (%)", Memc[ylabel], SZ_LINE)
+		call strcpy ("Corrector (%)", Memc[id[1]], SZ_LINE) 
+
+		iferr  {
+		    do i = 1, npts
+			Memr[ydata+i-1] = 100 *
+			    tabinterp1 (tab, Memc[name], w[i])
+		} then
+		    call amovkr (100., Memr[ydata], npts)
+	    }
+	case OUT_CAM:
+	    call st_gtitle (st, "camtitle", "camera", Memc[str], SZ_LINE)
+	    if (Memc[str] == EOS)
+		call strcpy ("Camera", Memc[str], SZ_LINE)
+	    if (Memc[title] != EOS)
+		call strcat ("\n", Memc[title], SZ_LINE)
+	    call strcat (Memc[str], Memc[title], SZ_LINE)
+	    call strcpy ("Transmission (%)", Memc[ylabel], SZ_LINE)
+	    call strcpy ("Camera (%)", Memc[id[1]], SZ_LINE) 
+
+	    iferr  {
+		do i = 1, npts
+		    Memr[ydata+i-1] = 100 *
+			tabinterp1 (tab, Memc[name], w[i])
+	    } then
+		call amovkr (100., Memr[ydata], npts)
+	case OUT_DET:
+	    call st_gtitle (st, "dettitle", "detector", Memc[str], SZ_LINE)
+	    if (Memc[str] == EOS)
+		call strcpy ("Detector", Memc[str], SZ_LINE)
+	    if (Memc[title] != EOS)
+		call strcat ("\n", Memc[title], SZ_LINE)
+	    call strcat (Memc[str], Memc[title], SZ_LINE)
+	    call strcpy ("DQE (%)", Memc[ylabel], SZ_LINE)
+	    call strcpy ("DQE (%)", Memc[id[1]], SZ_LINE) 
+
+	    iferr  {
+		do i = 1, npts
+		    Memr[ydata+i-1] = 100 *
+			tabinterp1 (tab, Memc[name], w[i])
+	    } then
+		call amovkr (100., Memr[ydata], npts)
+	case OUT_SPEC:
+	    call strcpy ("Spectrograph Other", Memc[str], SZ_LINE)
+	    if (Memc[title] != EOS)
+		call strcat ("\n", Memc[title], SZ_LINE)
+	    call strcat (Memc[str], Memc[title], SZ_LINE)
+	    call strcpy ("Transmission (%)", Memc[ylabel], SZ_LINE)
+	    call strcpy ("Spectrograph Other (%s)", Memc[id[1]], SZ_LINE) 
+
+	    iferr  {
+		do i = 1, npts
+		    Memr[ydata+i-1] = 100 *
+			tabinterp1 (tab, Memc[name], w[i])
+	    } then
+		Memr[ydata] = INDEF
+	case OUT_ADC:
+	    if (tabexists (tab, Memc[name])) {
+		call st_gtitle (st, "adctitle", "adc", Memc[str], SZ_LINE)
+		if (Memc[str] == EOS)
+		    call strcpy ("ADC", Memc[str], SZ_LINE)
+		if (Memc[title] != EOS)
+		    call strcat ("\n", Memc[title], SZ_LINE)
+		call strcat (Memc[str], Memc[title], SZ_LINE)
+		call strcpy ("Transmission (%)", Memc[ylabel], SZ_LINE)
+		call strcpy ("ADC (%)", Memc[id[1]], SZ_LINE) 
+
+		iferr  {
+		    do i = 1, npts
+			Memr[ydata+i-1] = 100 *
+			    tabinterp1 (tab, Memc[name], w[i])
+		} then
+		    call amovkr (100., Memr[ydata], npts)
+	    }
+	case OUT_EMIS:
+	    if (tabexists (tab, Memc[name]) && ST_THERMAL(st) > 0.) {
+		if (Memc[title] != EOS)
+		    call strcat ("\n", Memc[title], SZ_LINE)
+		call st_gtitle (st, "emistitle", "emissivity",Memc[str],SZ_LINE)
+		if (Memc[str] == EOS)
+		    call strcpy ("Emissivity", Memc[str], SZ_LINE)
+		call strcat (Memc[str], Memc[title], SZ_LINE)
+		call sprintf (Memc[str], SZ_LINE, "\nTemperature  = %.1f K")
+		    call pargr (ST_THERMAL(st))
+		call strcat (Memc[str], Memc[title], SZ_LINE)
+		call strcpy ("Emissivity (%)", Memc[ylabel], SZ_LINE)
+		call strcpy ("Emissivity (%)", Memc[id[1]], SZ_LINE) 
+
+		iferr  {
+		    do i = 1, npts
+			Memr[ydata+i-1] = 100 *
+			    tabinterp1 (tab, Memc[name], w[i])
+		} then
+		    call amovkr (100., Memr[ydata], npts)
+	    }
+	case OUT_THRU:
+	    if (Memc[title] != EOS)
+		call strcat ("\n", Memc[title], SZ_LINE)
+	    call strcat ("System Thruput (Telescope to Detected Photons)",
+		Memc[title], SZ_LINE)
+	    call strcpy ("Thruput (%)", Memc[ylabel], SZ_LINE)
+	    call strcpy ("Thruput (%)", Memc[id[1]], SZ_LINE) 
+
+	    do i = 1, npts {
+		call st_snr (st, NULL, w[i], ST_NEXP(st), ST_TIME(st),
+		    nobj, nsky, snr, thruput)
+		Memr[ydata+i-1] = 100 * thruput
+	    }
+	case OUT_COUNTS:
+	    if (Memc[title] != EOS)
+		call strcat ("\n", Memc[title], SZ_LINE)
+	    call strcat (Memc[spec], Memc[title], SZ_LINE)
+	    call sprintf (Memc[str], SZ_LINE, "\nExposure time = %d seconds")
+		call pargr (ST_NEXP(st) * max(ST_TIME(st),1.))
+	    call strcat (Memc[str], Memc[title], SZ_LINE)
+	    if (ST_NEXP(st) > 1) {
+		call sprintf (Memc[str], SZ_LINE, "(%d exposures)")
+		    call pargi (ST_NEXP(st))
+		call strcat (Memc[str], Memc[title], SZ_LINE)
+	    }
+	    call strcpy ("DN", Memc[ylabel], SZ_LINE)
+	    call strcpy ("Object (counts)", Memc[id[1]], SZ_LINE) 
+	    call strcpy ("Background (counts)", Memc[id[2]], SZ_LINE) 
+	    call strcpy ("Total (counts)", Memc[id[3]], SZ_LINE) 
+
+	    do i = 1, npts {
+		call st_snr (st, NULL, w[i], 1, ST_NEXP(st) * ST_TIME(st),
+		    nobj, nsky, snr, thruput)
+		Memr[ydata+i-1] = nobj[1] / ST_GAIN(st)
+		Memr[ydata+npts+i-1] = nsky[1] / ST_GAIN(st)
+		Memr[ydata+2*npts+i-1] = (nobj[1]+nsky[1]) / ST_GAIN(st)
+	    }
+	    call alimr (Memr[ydata+npts], npts, a, b)
+	    if (b <= 0.) {
+		Memr[ydata+npts] = INDEF
+		Memr[ydata+2*npts] = INDEF
+		if (Memc[title] != EOS)
+		    call strcat ("\n", Memc[title], SZ_LINE)
+		call sprintf (Memc[str], SZ_LINE,
+		    "Object DN at gain of %.2g\n")
+		    call pargr (ST_GAIN(st))
+		call strcat (Memc[str], Memc[title], SZ_LINE)
+	    } else {
+		if (Memc[title] != EOS)
+		    call strcat ("\n", Memc[title], SZ_LINE)
+		call sprintf (Memc[str], SZ_LINE,
+		    "Object, background, and total DN at gain of %.2g\n")
+		    call pargr (ST_GAIN(st))
+		call strcat (Memc[str], Memc[title], SZ_LINE)
+	    }
+
+	    wy1 = INDEF; wy2 = INDEF
+	case OUT_SENS:
+	    airmass = ST_AIRMASS(st)
+	    ST_AIRMASS(st) = 0.
+
+	    if (Memc[title] != EOS)
+		call strcat ("\n", Memc[title], SZ_LINE)
+	    call strcat ("Sensitivity Function", Memc[title], SZ_LINE)
+	    call strcpy ("Magnitudes", Memc[ylabel], SZ_LINE)
+	    call strcpy ("Sensitivity (mag)", Memc[id[1]], SZ_LINE) 
+
+	    wy1 = MAX_REAL
+	    wy2 = -MAX_REAL
+	    do i = 1, npts {
+		call st_snr (st, NULL, w[i], ST_NEXP(st), ST_TIME(st),
+		    nobj, nsky, snr, thruput)
+		a = nobj[1] / ST_GAIN(st) / ST_TIME(st) / ST_DISP(st,1)
+		b = st_spectrum (st, w[i])
+		if (a > 0. && b > 0.) {
+		    a = 2.5 * (log10 (a) - log10 (b))
+		    wy1 = min (wy1, a)
+		    wy2 = max (wy2, a)
+		} else
+		    a = 0
+		Memr[ydata+i-1] = a
+	    }
+	    if (wy1 < wy2) {
+		buf = 0.1 * (wy2 - wy1)
+		wy1 = wy1 - buf
+		wy2 = wy2 + buf
+	    } else {
+		wy1 = INDEF
+		wy2 = INDEF
+	    }
+
+	    ST_AIRMASS(st) = airmass
+	case OUT_CORRECT:
+	    if (tabexists (tab, "sensfunc")) {
+		airmass = ST_AIRMASS(st)
+		ST_AIRMASS(st) = 0.
+
+		iferr (call tabgstr (tab, "sensfunc", "",
+		    "title", Memc[str], SZ_LINE)) {
+		    call tabgstr (tab, "sensfunc", "", "table.filename",
+			Memc[str], SZ_LINE)
+		}
+		if (Memc[title] != EOS)
+		    call strcat ("\n", Memc[title], SZ_LINE)
+		call strcat ("Correction from: ", Memc[title], SZ_LINE)
+		call strcat (Memc[str], Memc[title], SZ_LINE)
+		call strcpy ("Correction factor", Memc[ylabel], SZ_LINE)
+		call strcpy ("Correction factor", Memc[id[1]], SZ_LINE) 
+
+		wmin = tabgetr (tab, "sensfunc", "", "table.xmin")
+		wmax = tabgetr (tab, "sensfunc", "", "table.xmax")
+
+		wy1 = MAX_REAL
+		wy2 = -MAX_REAL
+		ndata = 0
+		do i = 1, npts {
+		    if (w[i] < wmin || w[i] > wmax)
+			next
+		    call st_snr (st, NULL, w[i], ST_NEXP(st), ST_TIME(st),
+			nobj, nsky, snr, thruput)
+		    a = nobj[1] / ST_GAIN(st) / ST_TIME(st) / ST_DISP(st,1)
+		    b = st_spectrum (st, w[i])
+		    if (a <= 0. || b <= 0.)
+			next
+		    a = 2.5 * (log10 (a) - log10 (b))
+		    b = tabinterp1 (tab, "sensfunc", w[i])
+		    a = 10. ** (0.4 * (b - a))
+		    wy1 = min (wy1, a)
+		    wy2 = max (wy2, a)
+		    Memr[xdata+ndata] = w[i]
+		    Memr[ydata+ndata] = a
+		    ndata = ndata + 1
+		}
+		if (wy1 < wy2) {
+		    buf = 0.1 * max (0.1, wy2 - wy1)
+		    wy1 = wy1 - buf
+		    wy2 = wy2 + buf
+		} else {
+		    wy1 = INDEF
+		    wy2 = INDEF
+		}
+
+		ST_AIRMASS(st) = airmass
+	    }
+	}
+
+	# Draw graph.
+	if (gp != NULL && !IS_INDEF(Memr[ydata])) {
+	    call greactivate (gp, 0)
+	    if (IS_INDEF(wx1) || IS_INDEF(wx2)) {
+		call alimr (Memr[xdata], ndata, wx1, wx2)
+		buf = 0.1 * (wx2 - wx1)
+		wx1 = wx1 - buf
+		wx2 = wx2 + buf
+	    }
+	    if (IS_INDEF(wy1) || IS_INDEF(wy2)) {
+		call alimr (Memr[ydata], ndata, wy1, wy2)
+		do i = 1, 3 {
+		    if (!IS_INDEF(Memr[ydata+i*npts])) { 
+			call alimr (Memr[ydata+i*npts], ndata, a, b)
+			wy1 = min (wy1, a)
+			wy2 = max (wy2, b)
+		    }
+		}
+		buf = 0.1 * (wy2 - wy1)
+		wy1 = wy1 - buf
+		wy2 = wy2 + buf
+	    }
+
+	    call gclear (gp)
+	    call gsview (gp, 0.15, 0.95, 0.15, 0.85)
+	    call gswind (gp, wx1, wx2, wy1, wy2)
+	    call glabax (gp, Memc[title], Memc[xlabel], Memc[ylabel])
+	    do i = 1, 4 {
+		if (!IS_INDEF(Memr[ydata+(i-1)*npts])) { 
+		    call gseti (gp, G_PLTYPE, i)
+		    call gseti (gp, G_PLCOLOR, i)
+		    call gpline (gp, Memr[xdata], Memr[ydata+(i-1)*npts], ndata)
+		}
+	    }
+
+	    if (interactive) {
+		call printf (
+		    "Type 'q' to quit graphs or any other key to continue")
+		i = clgcur ("gcur", a, b, i, j, Memc[str], SZ_LINE)
+		if (j == 'q')
+		    call gclose (gp)
+	    }
+	    if (gp != NULL)
+		call gdeactivate (gp, 0)
+	}
+
+	# Output list.
+	if (fd != NULL && !IS_INDEF(Memr[ydata])) {
+	    j = 0
+	    do i = 0, ARB {
+		if (Memc[title+i] == EOS || Memc[title+i] == '\n') {
+		    if (j != 0) {
+			Memc[str+j] = EOS
+			call fprintf (fd, "# %s\n")
+			    call pargstr (Memc[str])
+		    }
+		    if (Memc[title+i] == EOS)
+			break
+		    j = 0
+		} else {
+		    Memc[str+j] = Memc[title+i]
+		    j = j + 1
+		}
+	    }
+	    call fprintf (fd, "# Column 1: %s\n")
+		call pargstr (Memc[xlabel])
+	    do j = 1, 4 {
+		if (IS_INDEF(Memr[ydata+(j-1)*npts]))
+		    next
+		call fprintf (fd, "# Column %d: %s\n")
+		    call pargi (j+1)
+		    call pargstr (Memc[id[j]])
+	    }
+	    do i = 1, ndata {
+		call fprintf (fd, "%12.8g")
+		    call pargr (Memr[xdata+i-1])
+		do j = 1, 4 {
+		    if (IS_INDEF(Memr[ydata+(j-1)*npts]))
+			next
+		    call fprintf (fd, "  %12.8g")
+			call pargr (Memr[ydata+(j-1)*npts+i-1])
+		}
+		call fprintf (fd, "\n")
+	    }
+	    call fprintf (fd, "\n")
+	}
+
+	call sfree (sp)
+end
+
+
+# CCM -- Compute CCM Extinction Law
+
+real procedure ccm (wavelength, rv) 
+
+real	wavelength		# Wavelength in Angstroms
+real	rv			# A(V) / E(B-V)
+
+real	x, y, a, b
+
+begin
+	# Convert to inverse microns
+	x = 10000. / wavelength
+	x = max (0.3, min (10., x))
+
+	# Compute a(x) and b(x)
+	if (x < 0.3) {
+	    call error (1, "Wavelength out of range of extinction function")
+
+	} else if (x < 1.1) {
+	    y = x ** 1.61
+	    a = 0.574 * y
+	    b = -0.527 * y
+
+	} else if (x < 3.3) {
+	    y = x - 1.82
+	    a = 1 + y * (0.17699 + y * (-0.50447 + y * (-0.02427 +
+		y * (0.72085 + y * (0.01979 + y * (-0.77530 + y * 0.32999))))))
+	    b = y * (1.41338 + y * (2.28305 + y * (1.07233 + y * (-5.38434 +
+		y * (-0.62251 + y * (5.30260 + y * (-2.09002)))))))
+
+	} else if (x < 5.9) {
+	    y = (x - 4.67) ** 2
+	    a = 1.752 - 0.316 * x - 0.104 / (y + 0.341)
+	    b = -3.090 + 1.825 * x + 1.206 / (y + 0.263)
+
+	} else if (x < 8.0) {
+	    y = (x - 4.67) ** 2
+	    a = 1.752 - 0.316 * x - 0.104 / (y + 0.341)
+	    b = -3.090 + 1.825 * x + 1.206 / (y + 0.263)
+
+	    y = x - 5.9
+	    a = a - 0.04473 * y**2 - 0.009779 * y**3
+	    b = b + 0.2130 * y**2 + 0.1207 * y**3
+
+	} else if (x <= 10.0) {
+	    y = x - 8
+	    a = -1.072 - 0.628 * y + 0.137 * y**2 - 0.070 * y**3
+	    b = 13.670 + 4.257 * y - 0.420 * y**2 + 0.374 * y**3
+
+	} else {
+	    call error (1, "Wavelength out of range of extinction function")
+	    
+	}
+
+	# Compute A(lambda)/A(V)
+	y = a + b / rv
+	return (y)
+end
+
+
+# STGETR -- Get real parameter.
+# Returns INDEFR if parameter is not defined.
+
+real procedure stgetr (st, param, table, default)
+
+pointer st		#I SPECTIME structure
+char	param[ARB]	#I Parameter name
+char	table[ARB]	#I Name of table
+real	default		#I Default value
+real	val		#O Returned value
+
+real	clgetr(), tabgetr()
+errchk	tabgetr
+
+begin
+	# Get parameter from CL.
+	val = clgetr (param)
+
+	# If the value is INDEF get the value from the table.
+	if (IS_INDEFR(val)) {
+	    iferr (val = tabgetr (ST_TAB(st), table, "spectrograph", param))
+		val = INDEFR
+	}
+
+	# If the value is INDEF set default.
+	if (IS_INDEFR(val))
+	    val = default
+
+	return (val)
+end
+
+
+# STGETI -- Get integer parameter.
+# Returns INDEFI if parameter is not defined.
+
+int procedure stgeti (st, param, table, default)
+
+pointer st		#I SPECTIME structure
+char	param[ARB]	#I Parameter name
+char	table[ARB]	#I Name of table
+int	default		#I Default value
+int	val		#O Returned value
+
+int	clgeti(), tabgeti()
+errchk	tabgeti
+
+begin
+	# Get parameter from CL.
+	val = clgeti (param)
+
+	# If the value is INDEF get the value from the table.
+	if (IS_INDEFI(val)) {
+	    iferr (val = tabgeti (ST_TAB(st), table, "spectrograph", param))
+		val = INDEFI
+	}
+
+	# If the value is INDEF set the default.
+	if (IS_INDEFI(val))
+	    val = default
+
+	return (val)
+end
+
+
+# STGSTR -- Get string parameter.
+# Returns null string if parameter is not defined.
+
+procedure stgstr (st, param, table, default, val, maxchar)
+
+pointer st		#I SPECTIME structure
+char	param[ARB]	#I Parameter name
+char	table[ARB]	#I Name of table
+char	default[ARB]	#I Default value
+char	val[ARB]	#O Returned value
+int	maxchar		#I Maximum string length
+
+char	tmp[10]
+int	nowhite()
+errchk	tabgste
+
+begin
+	# Get parameter from CL.
+	call clgstr (param, val, maxchar)
+
+	# If the value is a null string get the value from a table.
+	if (nowhite (val, tmp, 10) == 0) {
+	    iferr (call tabgstr (ST_TAB(st), table, "spectrograph", param,
+		val, maxchar))
+		val[1] = EOS
+	}
+
+	# If the value is null set the default value.
+	if (val[1] == EOS)
+	    call strcpy (default, val, maxchar)
+end
diff --git a/noao/obsutil/src/sptime/tabinterp.x b/noao/obsutil/src/sptime/tabinterp.x
new file mode 100644
index 00000000..518f7b20
--- /dev/null
+++ b/noao/obsutil/src/sptime/tabinterp.x
@@ -0,0 +1,698 @@
+include	<error.h>
+include	<mach.h>
+include	<math/iminterp.h>
+
+# Table structure.
+define	TAB_DIM		2			# Maximum dimension of table
+define	TAB_SZFNAME	99			# Size of file name
+define	TAB_SZPARAMS	(10*SZ_LINE)		# Size of parameter string
+define	TAB_SIZE	(55+2*TAB_DIM)		# Size of table structure
+
+define	TAB_FNAME	Memc[P2C($1)]		# File name
+define	TAB_VALUE	Memr[P2R($1+50)]	# Constant table value
+define	TAB_PARAMS	Memi[$1+51]		# Pointer to parameters
+define	TAB_NDIM	Memi[$1+52]		# Dimension of table
+define	TAB_INTERP	Memi[$1+53]		# Interpolation pointer
+define	TAB_NEXTRAP	Memi[$1+54]		# Number of extrapolations
+define	TAB_LEN		Memi[$1+54+$2]		# Length of axes in table
+define	TAB_COORD	Memi[$1+54+$2+TAB_DIM]	# Pointer to axes coordinates
+
+
+procedure tabtest ()
+
+char	table[SZ_FNAME], param[SZ_FNAME], str[SZ_FNAME]
+int	clglpr()
+real	x, y, z, tabinterp1(), tabinterp2(), tabgetr()
+pointer	tab, tabopen()
+errchk	tabopen, tabinterp1, tabinterp2, tabgetr, tabgstr
+
+begin
+	tab = tabopen ()
+
+	call clgstr ("table", table, SZ_FNAME)
+
+	call clgstr ("param", param, SZ_FNAME)
+	z = tabgetr (tab, table, "", param)
+	call tabgstr (tab, table, "", param, str, SZ_FNAME)
+	call printf ("%s = %g = %s\n")
+	    call pargstr (param)
+	    call pargr (z)
+	    call pargstr (str)
+
+	while (clglpr ("x", x) != EOF) {
+	    iferr {
+		z = tabinterp1 (tab, table, x)
+		call printf ("%g %g\n")
+		    call pargr (x)
+		    call pargr (z)
+	    } then {
+		if (clglpr ("y", y) == EOF)
+		    break
+		z = tabinterp2 (tab, table, x, y)
+		call printf ("%g %g %g\n")
+		    call pargr (x)
+		    call pargr (y)
+		    call pargr (z)
+	    }
+	}
+
+	call tabclose (tab)
+end
+
+
+# TABOPEN -- Open table interpolation package.
+
+pointer procedure tabopen ()
+
+pointer	stp, stopen()
+
+begin
+	stp = stopen ("tables", 10, 1000, 1000)
+	return (stp)
+end
+
+
+# TABCLOSE -- Close table interpolation package.
+
+procedure tabclose (stp)
+
+pointer	stp		#I Symbol table pointer
+
+pointer	sym, sthead(), stnext()
+
+begin
+	for (sym = sthead(stp); sym != NULL; sym = stnext(stp, sym))
+	    call tabfree (sym)
+	call stclose (stp)
+end
+
+
+procedure tabfree (sym)
+
+pointer	sym		#I Table structure
+
+int	i
+
+begin
+	call mfree (TAB_PARAMS(sym), TY_CHAR)
+	if (TAB_INTERP(sym) != NULL) {
+	    if (TAB_LEN(sym,1) > 1 && TAB_LEN(sym,2) > 1)
+		call msifree (TAB_INTERP(sym))
+	    else
+		call asifree (TAB_INTERP(sym))
+	    do i = 1, TAB_NDIM(sym)
+		call mfree (TAB_COORD(sym,i), TY_REAL)
+	}
+end
+	
+
+
+# TABLOAD -- Load a table in the symbol table.
+
+procedure tabload (stp, name, fname)
+
+pointer	stp		# Symbol table pointer
+char	name[ARB]	# Name of table
+char	fname[ARB]	# File name of table
+
+int	i, fd, ndim, npts, len[2], open(), errget(), nowhite(), ctor(), strlen()
+real	value
+pointer	sp, str, sym, params, data, coords[2], stfind(), stenter()
+bool	streq()
+errchk	open, tabread
+
+begin
+	call smark (sp)
+	call salloc (str, SZ_LINE, TY_CHAR)
+
+	# If no value is specified then don't enter into symbol table.
+	if (nowhite (fname, Memc[str], SZ_LINE) == 0) {
+	    call sfree (sp)
+	    return
+	}
+
+	# The special string "none" is equivalent to no table.
+	if (streq (Memc[str], "none")) {
+	    call sfree (sp)
+	    return
+	}
+
+	# Check if table has already been loaded.
+	sym = stfind (stp, name)
+	if (sym != NULL) {
+	    if (streq (fname, TAB_FNAME(sym)))
+		return
+	}
+	    
+	# Check if constant is specified.
+	i = 1
+	if (ctor (Memc[str], i, value) == strlen (Memc[str])) {
+	    sym = stenter (stp, name, TAB_SIZE)
+	    call strcpy (fname, TAB_FNAME(sym), TAB_SZFNAME)
+	    TAB_VALUE(sym) = value
+	    TAB_NDIM(sym) = -1
+	    TAB_PARAMS(sym) = NULL
+	    TAB_INTERP(sym) = NULL
+
+	    call sfree (sp)
+	    return
+	}
+
+	# Read the table.
+	fd = open (Memc[str], READ_ONLY, TEXT_FILE)
+	iferr (call tabread (fd, params, data, npts, len, coords, ndim)) {
+	    ndim = errget (Memc[str], SZ_LINE)
+	    call strcat (" (", Memc[str], SZ_LINE)
+	    call strcat (name, Memc[str], SZ_LINE)
+	    call strcat (")", Memc[str], SZ_LINE)
+	    call error (1, Memc[str])
+	}
+	call close (fd)
+
+	if (sym == NULL)
+	    sym = stenter (stp, name, TAB_SIZE)
+	else
+	    call tabfree (sym)
+
+	if (data != NULL) {
+	    if (len[1] > 1 && len[2] > 1) {
+		call msiinit (TAB_INTERP(sym), II_BILINEAR)
+		call msifit (TAB_INTERP(sym), Memr[data], len[1], len[2],
+		    len[1])
+	    } else if (len[2] == 1) {
+		if (len[1] == 1)
+		    call asiinit (TAB_INTERP(sym), II_NEAREST)
+		else
+		    call asiinit (TAB_INTERP(sym), II_LINEAR)
+		call asifit (TAB_INTERP(sym), Memr[data], len[1])
+	    } else {
+		call asiinit (TAB_INTERP(sym), II_LINEAR)
+		call asifit (TAB_INTERP(sym), Memr[data], len[2])
+	    }
+	} else
+	    TAB_INTERP(sym) = NULL
+
+	call strcpy (fname, TAB_FNAME(sym), TAB_SZFNAME)
+	TAB_PARAMS(sym) = params
+	TAB_NDIM(sym) = ndim
+	TAB_NEXTRAP(sym) = 0
+	call amovi (len, TAB_LEN(sym,1), 2)
+	call amovi (coords, TAB_COORD(sym,1), 2)
+	call mfree (data, TY_REAL)
+	call sfree (sp)
+end
+
+
+# TABREAD -- Read data from a table.
+
+procedure tabread (fd, params, data, npts, len, coords, ndim)
+
+int	fd		#I File descriptor
+pointer	params		#O Pointer to parameters
+pointer	data		#O Pointer to data 
+int	npts		#O Number of data points
+int	len[ARB]	#O Number of points along each dimension
+pointer	coords[ARB]	#O Pointers to coordinates along each dimension
+int	ndim		#O Dimension of table
+
+int	i, j, nread, fdparams, fscan(), nscan(), stropen(), ctor()
+real	coord[4], scale
+pointer	sp, cmt, key, eq, val
+bool	streq()
+errchk	stropen()
+
+begin
+	iferr {
+	    call smark (sp)
+	    call salloc (cmt, 2, TY_CHAR)
+	    call salloc (key, SZ_FNAME, TY_CHAR)
+	    call salloc (eq, 1, TY_CHAR)
+	    call salloc (val, SZ_LINE, TY_CHAR)
+
+	    npts = 0
+	    ndim = 0
+	    params = NULL
+	    data = NULL
+	    scale = INDEF
+	    call aclri (len, 2)
+	    call aclri (coords, 2)
+	    while (fscan (fd) != EOF) {
+		call gargr (coord[1])
+		call gargr (coord[2])
+		call gargr (coord[3])
+		call gargr (coord[4])
+		nread = nscan()
+
+		if (nread == 0) {	# Check for parameters.
+		    call reset_scan()
+		    call gargwrd (Memc[cmt], 2)
+		    call gargwrd (Memc[key], SZ_LINE)
+		    call gargwrd (Memc[eq], 1)
+		    call gargwrd (Memc[val], SZ_LINE)
+		    if (nscan() != 4 || Memc[cmt] != '#' || Memc[eq] != '=' ||
+			Memc[cmt+1] != EOS)
+			    next
+		    if (streq (Memc[key], "tablescale")) {
+			i = 1
+			if (ctor (Memc[val], i, scale) == 0)
+			    call error (1, "Syntax error in table scale factor")
+		    }
+		    if (params == NULL) {
+			call malloc (params, TAB_SZPARAMS, TY_CHAR)
+			fdparams = stropen (Memc[params], TAB_SZPARAMS,
+			    WRITE_ONLY)
+		    }
+		    call fprintf (fdparams, "%s %s\n")
+			call pargstr (Memc[key])
+			call pargstr (Memc[val])
+		    next
+		} else if (nread == 1)
+		    next
+
+		if (ndim == 0) {
+		    ndim = nread - 1
+		    if (ndim > 2)
+			call error (1, "Table dimension is too high")
+		    do i = ndim+1, 2
+			len[i] = 1
+		}
+		if (nread-1 != ndim)
+		    call error (2, "Table has variable number of columns")
+
+		do i = 1, ndim {
+		    if (len[i] == 0) {
+			call malloc (coords[i], 100, TY_REAL)
+			Memr[coords[i]] = coord[i]
+			len[i] = len[i] + 1
+		    } else {
+			do j = 0, len[i] - 1
+			    if (coord[i] == Memr[coords[i]+j])
+				break
+			if (j >= len[i]) {
+			    if (mod (len[i], 100) == 0)
+				call realloc (coords[i], len[i]+100, TY_REAL)
+			    Memr[coords[i]+len[i]] = coord[i]
+			    len[i] = len[i] + 1
+			}
+		    }
+		}
+		
+		if (npts == 0)
+		    call malloc (data, 100, TY_REAL)
+		else if (mod (npts, 100) == 0)
+		    call realloc (data, npts+100, TY_REAL)
+
+		Memr[data+npts] = coord[nread]
+		npts = npts + 1
+	    }
+
+	    if (npts > 0) {
+		j = 1
+		do i = 1, ndim
+		    j = j * len[i]
+		if (j != npts)
+		    call error (4, "Table is not regular")
+	    }
+
+	    if (!IS_INDEF(scale))
+		call amulkr (Memr[data], scale, Memr[data], npts)
+
+	    call close (fdparams)
+	    call sfree (sp)
+	} then {
+	    if (params != NULL) {
+		call close (fdparams)
+		call mfree (params, TY_CHAR)
+	    }
+	    do i = 1, 2
+		call mfree (coords[i], TY_REAL)
+	    call mfree (data, TY_REAL)
+	    call sfree (sp)
+	    call erract (EA_ERROR)
+	}
+end
+
+
+# TABEXISTS -- Determine if table exists.
+
+bool procedure tabexists (stp, name)
+
+pointer	stp		#I Symbol table pointer
+char	name[ARB]	#I Name of table
+
+pointer	stfind()
+
+begin
+	return (stfind (stp, name) != NULL)
+end
+
+
+# TABGETR -- Get real parameter from table.
+
+real procedure tabgetr (stp, name, alt, param)
+
+pointer	stp		#I Symbol table pointer
+char	name[ARB]	#I Name of table
+char	alt[ARB]	#I Name of alternate table
+char	param[ARB]	#I Parameter name
+real	val		#O Returned value
+
+real	rval
+int	i, fd, strncmp(), strdic(), stropen(), fscan(), nscan()
+bool	streq()
+pointer	sp, key, sym[2], stfind()
+errchk	stfind, stropen
+
+begin
+	# Return if no table.
+	if (name[1] == EOS && alt[1] == EOS)
+	    return (INDEFR)
+
+	call smark (sp)
+	call salloc (key, SZ_FNAME, TY_CHAR)
+
+	# Find tables.
+	sym[1] = stfind (stp, name)
+	if (alt[1] != EOS)
+	    sym[2] = stfind (stp, alt)
+	else
+	    sym[2] = NULL
+
+	# Return an error if there is no table.
+	if (sym[1] == NULL && sym[2] == NULL) {
+	    call sprintf (Memc[key], SZ_FNAME, "Table `%s' not found")
+		call pargstr (name)
+	    call error (1, Memc[key])
+	}
+
+	# Get the parameter value.
+	val = INDEFR
+	do i = 1, 2 {
+	    if (sym[i] == NULL)
+		next
+	    if (strncmp (param, "table.", 6) == 0) {
+		switch (strdic (param[7], Memc[key], SZ_FNAME,
+		    "|ndim|xmin|xmax|ymin|ymax|nextrap|")) {
+		case 1:
+		    val = TAB_NDIM(sym[i])
+		case 2:
+		    if (TAB_NDIM(sym[i]) >= 1)
+			val = Memr[TAB_COORD(sym[i],1)]
+		    else if (TAB_NDIM(sym[i]) == -1)
+			val = -MAX_REAL
+		case 3:
+		    if (TAB_NDIM(sym[i]) >= 1)
+			val = Memr[TAB_COORD(sym[i],1)+TAB_LEN(sym[i],1)-1]
+		    else if (TAB_NDIM(sym[i]) == -1)
+			val = MAX_REAL
+		case 4:
+		    if (TAB_NDIM(sym[i]) >= 2)
+			val = Memr[TAB_COORD(sym[i],2)]
+		    else if (TAB_NDIM(sym[i]) == -1)
+			val = -MAX_REAL
+		case 5:
+		    if (TAB_NDIM(sym[i]) >= 2)
+			val = Memr[TAB_COORD(sym[i],2)+TAB_LEN(sym[i],1)-1]
+		    else if (TAB_NDIM(sym[i]) == -1)
+			val = MAX_REAL
+		case 6:
+		    val = TAB_NEXTRAP(sym[i])
+		}
+		break
+
+	    } else if (TAB_PARAMS(sym[i]) != NULL) {
+		fd = stropen (Memc[TAB_PARAMS(sym[i])], TAB_SZPARAMS, READ_ONLY)
+		while (fscan (fd) != EOF) {
+		    call gargwrd (Memc[key], SZ_FNAME)
+		    call gargr (rval)
+		    if (nscan() != 2)
+			next
+		    if (streq (Memc[key], param)) {
+			val = rval
+			break
+		    }
+		}
+		call close (fd)
+	    }
+
+	    if (!IS_INDEF(val))
+		break
+	}
+
+	# Return error if no value was found.
+	if (IS_INDEF(val)) {
+	    call sprintf (Memc[key], SZ_FNAME,
+		"Table parameter `%s' not found (%s)")
+		call pargstr (param)
+		call pargstr (name)
+	    call error (1, Memc[key])
+	}
+
+	call sfree (sp)
+	return (val)
+
+end
+
+
+# TABGETI -- Get integer paraemter from table.
+
+int procedure tabgeti (stp, name, alt, param)
+
+pointer	stp		#I Symbol table pointer
+char	name[ARB]	#I Name of table
+char	alt[ARB]	#I Name of alternate table
+char	param[ARB]	#I Parameter name
+
+real	val, tabgetr()
+errchk	tabgetr
+
+begin
+	val = tabgetr (stp, name, alt, param)
+	if (IS_INDEFR(val))
+	    return (INDEFI)
+
+	return (nint(val))
+end
+
+
+# TABGSTR -- Get string parameter from table.
+
+procedure tabgstr (stp, name, alt, param, val, maxchar)
+
+pointer	stp		#I Symbol table pointer
+char	name[ARB]	#I Name of table
+char	alt[ARB]	#I Name of alternate table
+char	param[ARB]	#I Parameter name
+char	val[ARB]	#O Returned value
+int	maxchar		#I Maximum string length
+
+int	i, fd, strncmp(), strdic(), stropen(), fscan(), nscan()
+bool	streq()
+pointer	sp, key, str, sym[2], stfind()
+errchk	stfind, stropen()
+
+begin
+	# Return if no table.
+	if (name[1] == EOS && alt[1] == EOS) {
+	    val[1] = EOS
+	    return
+	}
+
+	call smark (sp)
+	call salloc (key, SZ_FNAME, TY_CHAR)
+	call salloc (str, maxchar, TY_CHAR)
+
+	# Find tables.
+	sym[1] = stfind (stp, name)
+	if (alt[1] != EOS)
+	    sym[2] = stfind (stp, alt)
+	else
+	    sym[2] = NULL
+
+	# Return an error if there is no table.
+	if (sym[1] == NULL && sym[2] == NULL) {
+	    call sprintf (Memc[key], SZ_FNAME, "Table `%s' not found")
+		call pargstr (name)
+	    call error (1, Memc[key])
+	}
+
+	# Get the parameter value.
+	val[1] = EOS
+	do i = 1, 2 {
+	    if (sym[i] == NULL)
+		next
+	    if (strncmp (param, "table.", 6) == 0) {
+		switch (strdic (param[7], Memc[key], SZ_FNAME, "|filename|")) {
+		case 1:
+		    call strcpy (TAB_FNAME(sym[i]), val, maxchar)
+		}
+		break
+
+	    } else if (TAB_PARAMS(sym[i]) != NULL) {
+		fd = stropen (Memc[TAB_PARAMS(sym[i])], TAB_SZPARAMS, READ_ONLY)
+		while (fscan (fd) != EOF) {
+		    call gargwrd (Memc[key], SZ_FNAME)
+		    call gargstr (Memc[str], SZ_LINE)
+		    if (nscan() != 2)
+			next
+		    if (streq (Memc[key], param)) {
+			if (val[1] == EOS)
+			    call strcpy (Memc[str+1], val, maxchar)
+			else {
+			    call strcat ("\n", val, maxchar)
+			    call strcat (Memc[str+1], val, maxchar)
+			}
+		    }
+		}
+		call close (fd)
+
+		if (val[1] != EOS)
+		    break
+	    }
+	}
+
+	# Return error if no value was found.
+	if (val[1] == EOS) {
+	    call sprintf (Memc[key], SZ_FNAME,
+		"Table parameter `%s' not found (%s)")
+		call pargstr (param)
+		call pargstr (name)
+	    call error (1, Memc[key])
+	}
+
+	call sfree (sp)
+end
+
+
+# TABINTERP1 -- Interpolate a named 1D table.
+
+real procedure tabinterp1 (stp, name, x)
+
+pointer	stp		# Symbol table pointer
+char	name[ARB]	# Name of table
+real	x		# Interpolation coordinate
+
+char	err[SZ_FNAME]
+int	i, nx
+real	xi, y, asieval()
+pointer	sym, xp, stfind()
+errchk	stfind
+
+begin
+	# Find the table.
+	sym = stfind (stp, name)
+	if (sym == NULL) {
+	    call sprintf (err, SZ_FNAME, "Table `%s' not found")
+		call pargstr (name)
+	    call error (1, err)
+	}
+
+	# If a constant table return the value.
+	if (TAB_NDIM(sym) == -1)
+	    return (TAB_VALUE(sym))
+
+	# Check if the table is of the proper dimensionality.
+	if (TAB_NDIM(sym) != 1) {
+	    call sprintf (err, SZ_FNAME, "Table is not one dimensional (%s)")
+	       call pargstr (name)
+	    call error (1, err)
+	}
+	
+	nx = TAB_LEN(sym,1)
+	xp = TAB_COORD(sym,1)
+	if (x < Memr[xp] || x > Memr[xp+nx-1]) 
+	    TAB_NEXTRAP(sym) = TAB_NEXTRAP(sym) + 1
+
+	if (nx == 1)
+	    xi = 1
+	else {
+	    do i = 1, nx-2
+		if (x < Memr[xp+i])
+		    break
+
+	    xi = i + (x - Memr[xp+i-1]) / (Memr[xp+i] - Memr[xp+i-1])
+	}
+	xi = max (1., min (real(nx), xi))
+	y = asieval (TAB_INTERP(sym), xi)
+
+
+	return (y)
+end
+
+
+# TABINTERP2 -- Interpolate a named 2D table.
+
+real procedure tabinterp2 (stp, name, x, y)
+
+pointer	stp		# Symbol table pointer
+char	name[ARB]	# Name of table
+real	x, y		# Interpolation coordinate
+
+char	err[SZ_FNAME]
+int	i, nx, ny
+real	xi, yi, z, asieval(), msieval()
+pointer	sym, xp, yp, stfind()
+errchk	stfind
+
+begin
+	# Find the table.
+	sym = stfind (stp, name)
+	if (sym == NULL) {
+	    call sprintf (err, SZ_FNAME, "Table `%s' not found")
+		call pargstr (name)
+	    call error (1, err)
+	}
+
+	# If a constant table return the value.
+	if (TAB_NDIM(sym) == -1)
+	    return (TAB_VALUE(sym))
+
+	# Check if the table is of the proper dimensionality.
+	if (TAB_NDIM(sym) != 2) {
+	    call sprintf (err, SZ_FNAME, "Table is not two dimensional (%s)")
+	       call pargstr (name)
+	    call error (1, err)
+	}
+	
+	nx = TAB_LEN(sym,1)
+	ny = TAB_LEN(sym,2)
+	if (nx > 1 && ny > 1) {		# 2D interpolation
+	    xp = TAB_COORD(sym,1)
+	    do i = 1, nx-2
+		if (x < Memr[xp+i])
+		    break
+	    xi = i + (x - Memr[xp+i-1]) / (Memr[xp+i] - Memr[xp+i-1])
+	    xi = max (1., min (real(nx), xi))
+	    yp = TAB_COORD(sym,2)
+	    do i = 1, ny-2
+		if (y < Memr[yp+i])
+		    break
+	    yi = i + (y - Memr[yp+i-1]) / (Memr[yp+i] - Memr[yp+i-1])
+	    yi = max (1., min (real(nx), yi))
+	    z = msieval (TAB_INTERP(sym), xi, yi)
+	} else if (ny == 1) {		# 1D interpolation in x
+	    if (nx == 1)
+		xi = 1
+	    else {
+		xp = TAB_COORD(sym,1)
+		do i = 1, nx-2
+		    if (x < Memr[xp+i])
+			break
+
+		xi = i + (x - Memr[xp+i-1]) / (Memr[xp+i] - Memr[xp+i-1])
+	    }
+	    xi = max (1., min (real(nx), xi))
+	    z = asieval (TAB_INTERP(sym), xi)
+	} else {			# 1D interpolation in y
+	    yp = TAB_COORD(sym,2)
+	    do i = 1, ny-2
+		if (y < Memr[yp+i])
+		    break
+
+	    yi = i + (y - Memr[yp+i-1]) / (Memr[yp+i] - Memr[yp+i-1])
+	    yi = max (1., min (real(ny), yi))
+	    z = asieval (TAB_INTERP(sym), yi)
+	}
+
+	return (z)
+end
diff --git a/noao/obsutil/src/sptime/x_spectime.x b/noao/obsutil/src/sptime/x_spectime.x
new file mode 100644
index 00000000..216aaa66
--- /dev/null
+++ b/noao/obsutil/src/sptime/x_spectime.x
@@ -0,0 +1,2 @@
+task	sptime = t_sptime,
+	cgiparse = t_cgiparse
diff --git a/noao/obsutil/src/starfocus/Revisions b/noao/obsutil/src/starfocus/Revisions
new file mode 100644
index 00000000..d3f93e90
--- /dev/null
+++ b/noao/obsutil/src/starfocus/Revisions
@@ -0,0 +1,162 @@
+.help revisions Nov01 obsutil
+.nf
+t_starfocus.x
+starfocus.par
+psfmeasure.par
+starfocus.hlp
+psfmeasure.hlp
+    Added a "wcs" parameter to allow specifying the coordinate system type
+    for cursor input.  (10/7/98, Valdes)
+
+stfprofile.x
+    The logic in STF_FIT for determining the points to fit and the point
+    to use for the initial width estimate was faulty allowing some bad
+    cases to get through.  (7/31/98, Valdes)
+
+t_starfocus.x
+    There was an error in the changes to allow focus sequences to go
+    up or down such that simple PSF measurement failed.
+    (6/11/97, Valdes)
+
+stfmeasure.x
+stfprofile.x
+    Changes were need to better deal with error conditions.
+    (6/11/97, Valdes)
+
+stfmeasure.x
+    Changes to deal with error conditions.
+    (6/11/97, Valdes)
+
+t_starfocus.x
+    Fixed a typo error in an earlier change which left out the pointer
+    variable in a macro.  (5/8/97, Valdes)
+
+t_starfocus.x
+    1.  Added a minimum radius of 3 to the input and to interative setting.
+    2.  The estimate for the next focus position is not based on the previous
+	center plus the step.
+    3.  Added commented out code to allow setting the selected star to always
+	be the top or bottom, etc.
+    (2/7/97, Valdes)
+
+stfprofile.x
+    1.  Added a minimum radius of 3 to stf_find.
+    2.  Added a error return if sum2 <= 0 in stf_find
+    3.  Added errchks in stf_widths for called procedures.
+    4.  Added error returns in stf_fit for bad profile or parameters.
+    (2/6/97, Valdes)
+
+t_starfocus.x
+    The parabola fitting routine would fail if the independent variable
+    (the focus values) became too large because a) use of real and b)
+    unscaled variables.  The routine was revised for both these problems.
+    (10/24/96, Valdes)
+
+stfprofile.x
+stfmeasure.x
+    Fixed bug in evaluation of enclosed flux profile in which the scaled
+    radius was used for the gaussian subtraction stage instead of pixels.
+    This does not currently affect IMEXAM because the scale is fixed
+    at 1.  (8/29/96, Valdes)
+
+stfmeasure.x
+stfprofile.x
+    Fixed incorrect datatype declaration "real np" -> "int np" in various
+    related places.  (4/9/96, Valdes)
+
+stfmeasure.x -
+    1. Restricted the peak pixel to be within the specified radius.
+    2. Renamed file and procedures to avoid library conflict.
+    (3/14/96, Valdes)
+
+stfprofile.x
+    Minor bug fix that does not affect anything.  (3/14/96, Valdes)
+
+kpnofocus.cl
+starfocus.par
+psfmeasure.par
+    Changed the defaults for radius=5, sbuffer=5, swidth=5 to try and make
+    IMEXAMINE and the PSF tasks measure the same thing by default.
+    (3/13/96, Valdes)
+
+stfprofile.x
+    Changed the centering routine to only use the data in the specified
+    radius rather than the extended region including the sky.  (11/7/95, Valdes)
+
+stfmeasure.x
+mkpkg
+    Added a routine which can be called separately to compute the
+    enclosed flux width or radius and the direct FWHM.  (11/6/95, Valdes)
+
+stfprofile.x
+starfocus.h
+    Added a computation of the direct FWHM.   (11/6/95, Valdes)
+
+t_starfocus.x
+    Make a change to avoid reloading the image display when the specified
+    image name and the image name in the display are same apart from
+    the image extension.  (6/26/95, Valdes)
+
+stfprofile.h
+t_starfocus.x
+stfprofile.x
+starfocus.par
+psfmeasure.par
+kpnofocus.cl
+starfocus.par
+psfmeasure.par
+kpnofocus.cl
+    Added saturation and ignore_sat parameters to allow flagging measurements
+    with saturated pixels and either ignoring them or including them but
+    showing them in the output log.  (10/28/94, Valdes)
+
+t_starfocus.x
+    Fixed bug in interpreting the focus parameter.  (9/15/94, Valdes)
+
+starfocus.h
+t_starfocus.x
+stfprofile.x
+stfgraph.x
+psfmeasure.par
+starfocus.par
+kpnofocus.cl
+psfmeasure.hlp
+starfocus.hlp
+kpnofocus.hlp
+    Added an "iteration" parameter that, if greater than 1, uses the
+    previous FWHM estimate to adjust the "radius" parameter.  (8/5/94, Valdes)
+
+psfmeasure.hlp
+starfocus.hlp
+    Clarified the description of the imagecur parameter.  (2/1/94, Valdes)
+
+t_starfocus.x
+starfocus.h
+starfocus.par
+psfmeasure.par
+kpnofocus.cl	+
+starfocus.hlp
+psfmeasure.hlp
+kpnofocus.hlp
+    1.  A new parameter, fstep, was added to STARFOCUS to allow specifying
+	the focus sequence as a starting value, by the focus parameters,
+	and a step.
+    2.  STARFOCUS was modified to allow specification of header keywords
+	for the focus (this was true previously), the focus step,
+	the number of exposures, and the multiple exposure shift.
+	This allows multiple exposure images to be completely header
+	drivien if the appropriate keywords are present.
+    3.  A new task KPNOFOCUS was added.  This is a script calling
+	STARFOCUS with parameters set specifically for Kitt Peak
+	headers containing the focus parameters in the header.
+	Many of the parameters are fixed in the script and the task
+	parameters are then simpler.
+    4.  STARFOCUS/PSFMEASURE were modified to search all display frames
+	for the requested image rather than just frame 1.
+    5.  A new parameters, frame, was added to STARFOCUS/PSFMEASURE
+	to specify the display frame to load if necessary.  Previously
+	it was always frame 1.
+    7.  In STARFOCUS the default number of steps was changed to 7 and
+	the default step size to 30.
+    (11/13/93, Valdes)
+.endhelp
diff --git a/noao/obsutil/src/starfocus/mkpkg b/noao/obsutil/src/starfocus/mkpkg
new file mode 100644
index 00000000..3feffc76
--- /dev/null
+++ b/noao/obsutil/src/starfocus/mkpkg
@@ -0,0 +1,22 @@
+# Make the STARFOCUS tasks.
+
+$checkout libpkg.a ../
+$update   libpkg.a
+$checkin  libpkg.a ../
+$exit
+
+standalone:
+	$update	libpkg.a
+	$omake	x_starfocus.x
+	$link	x_starfocus.o libpkg.a -lxtools -lnlfit -liminterp -lgsurfit\
+	    -lds -o xx_starfocus.e
+	;
+
+libpkg.a:
+	stfgraph.x	starfocus.h <error.h> <gset.h> <mach.h>
+	stfmeasure.x	starfocus.h <error.h> <imhdr.h> <imset.h>\
+			<math/nlfit.h>
+	stfprofile.x	starfocus.h <imhdr.h> <mach.h> <math.h>\
+			<math/iminterp.h> <math/nlfit.h>
+	t_starfocus.x	starfocus.h <error.h> <imhdr.h> <imset.h> <mach.h>
+	;
diff --git a/noao/obsutil/src/starfocus/psfhelp.key b/noao/obsutil/src/starfocus/psfhelp.key
new file mode 100644
index 00000000..9e617a62
--- /dev/null
+++ b/noao/obsutil/src/starfocus/psfhelp.key
@@ -0,0 +1,60 @@
+			PSFMEASURE COMMAND OPTIONS
+
+				SUMMARY
+
+? Help              m Magnitude         r Redraw            z Zoom
+a Spatial           n Normalize         s Mag symbols       <space> Next
+d Delete            o Offset            t Field radius      
+e Enclosed flux     p Radial profile    u Undelete          
+i Info              q Quit              x Delete            
+
+:level <val>        :radius <val>       :show <file>        :xcenter <val>
+:overplot <y|n>     :scale <val>        :size <type>        :ycenter <val>
+
+
+				CURSOR COMMANDS
+
+All plots may not be available depending on the number of stars.
+
+?	Page this help information
+a	Spatial plot
+d	Delete star nearest to cursor
+e	Enclosed flux for all stars
+i	Information about star nearest the cursor
+m	Size and ellipticity vs relative magnitude
+n	Normalize enclosed flux at x cursor position
+o	Offset enclosed flux to x,y cursor position by adjusting background
+p	Radial profiles for all stars
+          Profiles are determined from the derivatives of the enclosed flux
+q	Quit
+r	Redraw
+s	Toggle magnitude symbols in spatial plot
+t	Size and ellipticity vs radius from field center
+u	Undelete all deleted points
+x	Delete nearest point or star (selected by query)
+z	Zoom to a single measurement showing enclosed flux and radial profile
+<space> Step through different stars in some plots
+
+
+			COLON COMMANDS
+
+A command without a value generally shows the current value of the
+parameter while with a value it sets the value of the parameter.
+
+:level <val>	Level at which the size parameter is evaluated
+:overplot <y|n> Overplot the profiles from the narrowest profile?
+:radius <val>   Change profile radius(*)
+:show <file>	Page all information for the current set of objects
+:size <type>	Size type (Radius|FWHM|GFWHM|MFWHM) (**)
+:scale <val>	Pixel scale for size values
+:xcenter <val>	X field center for radius from field center plots
+:ycenter <val>	Y field center for radius from field center plots
+
+(*) The profile radius may not exceed the initial value set by the task
+    parameter.
+
+(**)
+Radius = radius enclosing the fraction of the flux specified by "level"
+FWHM   = Full-width at half-maximum based on the radially smoothed profile
+GFWHM  = Full-width at half-maximum of Gaussian function fit to enclosed flux
+MFWHM  = Full-width at half-maximum of Moffat function fit to enclosed flux
diff --git a/noao/obsutil/src/starfocus/psfmeasure.par b/noao/obsutil/src/starfocus/psfmeasure.par
new file mode 100644
index 00000000..16dea3e9
--- /dev/null
+++ b/noao/obsutil/src/starfocus/psfmeasure.par
@@ -0,0 +1,24 @@
+# PSFMEASURE -- Measure PSF.
+
+images,s,a,,,,"List of images"
+coords,s,h,"markall","center|mark1|markall",,"Object coordinates"
+wcs,s,h,"logical","logical|physical|world",,"Coordinate system"
+display,b,h,yes,,,"Display images?"
+frame,i,h,1,1,,"Display frame to use
+"
+level,r,h,0.5,,,"Measurement level (fraction or percent)"
+size,s,h,"FWHM","Radius|FWHM|GFWHM|MFWHM",,"Size to display"
+beta,r,h,INDEF,2.1,,Moffat beta parameter
+scale,r,h,1.,,,"Pixel scale"
+radius,r,h,5.,,,"Measurement radius (pixels)"
+sbuffer,r,h,5.,,,"Sky buffer (pixels)"
+swidth,r,h,5.,,,"Sky width (pixels)"
+saturation,r,h,INDEF,,,"Saturation level"
+ignore_sat,b,h,no,,,"Ignore objects with saturated pixels?"
+iterations,i,h,2,1,,"Number of radius adjustment iterations"
+xcenter,r,h,INDEF,,,X field center (pixels)
+ycenter,r,h,INDEF,,,X field center (pixels)
+logfile,s,h,"logfile",,,"Logfile
+"
+imagecur,*imcur,h,"",,,"Image cursor input"
+graphcur,*gcur,h,"",,,"Graphics cursor input"
diff --git a/noao/obsutil/src/starfocus/starfocus.h b/noao/obsutil/src/starfocus/starfocus.h
new file mode 100644
index 00000000..871e8c98
--- /dev/null
+++ b/noao/obsutil/src/starfocus/starfocus.h
@@ -0,0 +1,140 @@
+# STARFOCUS
+
+# Types of coordinates
+define	SF_TYPES	"|center|mark1|markall|"
+define	SF_CENTER	1		# Star at center of image
+define	SF_MARK1	2		# Mark stars in first image
+define	SF_MARKALL	3		# Mark stars in all images
+
+# Task type
+define	STARFOCUS	1
+define	PSFMEASURE	2
+
+# Radius types
+define	SF_WTYPES	"|Radius|FWHM|GFWHM|MFWHM|"
+
+define	SF_RMIN		16		# Minimum centering search radius
+define	MAX_FRAMES	8		# Maximum number of display frames
+
+# Data structures for STARFOCUS
+
+define	NBNDRYPIX	100		# Number of boundary pixels
+define	TYBNDRY		BT_REFLECT	# Type of boundary extension
+define	SAMPLE		.2		# Subpixel sampling size
+define	SF_SZFNAME	79		# Length of file names
+define	SF_SZWTYPE	7		# Length of width type string
+
+# Main data structure
+define	SF		40
+define	SF_TASK		Memi[$1]	# Task type
+define	SF_WTYPE	Memc[P2C($1+1)]	# Width type string
+define	SF_WCODE	Memi[$1+5]	# Width code
+define	SF_BETA		Memr[P2R($1+6)]	# Moffat beta
+define	SF_SCALE	Memr[P2R($1+7)]	# Pixel scale
+define	SF_LEVEL	Memr[P2R($1+8)]	# Profile measurement level
+define	SF_RADIUS	Memr[P2R($1+9)]	# Profile radius
+define	SF_SBUF		Memr[P2R($1+10)]# Sky region buffer
+define	SF_SWIDTH	Memr[P2R($1+11)]# Sky region width
+define	SF_SAT		Memr[P2R($1+12)]# Saturation
+define	SF_NIT		Memi[$1+13]	# Number of iterations for radius
+define	SF_OVRPLT	Memi[$1+14]	# Overplot the best profile?
+define	SF_NCOLS	Memi[$1+15]	# Number of image columns
+define	SF_NLINES	Memi[$1+16]	# Number of image lines
+define	SF_XF		Memr[P2R($1+17)]# X field center
+define	SF_YF		Memr[P2R($1+18)]# Y field center
+define	SF_GP		Memi[$1+19]	# GIO pointer
+define	SF_F		Memr[P2R($1+20)]# Best focus
+define	SF_W		Memr[P2R($1+21)]# Width at best focus
+define	SF_M		Memr[P2R($1+22)]# Brightest star magnitude
+define	SF_XP1		Memr[P2R($1+23)]# First derivative point to plot
+define	SF_XP2		Memr[P2R($1+24)]# Last derivative point to plot
+define	SF_YP1		Memr[P2R($1+25)]# Minimum of derivative profile
+define	SF_YP2		Memr[P2R($1+26)]# Maximum of derivative profile
+define	SF_N		Memi[$1+27]	# Number of points not deleted
+define	SF_NSFD		Memi[$1+28]	# Number of data points
+define	SF_SFDS		Memi[$1+29]	# Pointer to data structures
+define	SF_NS		Memi[$1+30]	# Number of stars not deleted
+define	SF_NSTARS	Memi[$1+31]	# Number of stars
+define	SF_STARS	Memi[$1+32]	# Pointer to star groups
+define	SF_NF		Memi[$1+33]	# Number of focuses not deleted
+define	SF_NFOCUS	Memi[$1+34]	# Number of different focus values
+define	SF_FOCUS	Memi[$1+35]	# Pointer to focus groups
+define	SF_NI		Memi[$1+36]	# Number of images not deleted
+define	SF_NIMAGES	Memi[$1+37]	# Number of images
+define	SF_IMAGES	Memi[$1+38]	# Pointer to image groups
+define	SF_BEST		Memi[$1+39]	# Pointer to best focus star
+
+define	SF_SFD		Memi[SF_SFDS($1)+$2-1]
+define	SF_SFS		Memi[SF_STARS($1)+$2-1]
+define	SF_SFF		Memi[SF_FOCUS($1)+$2-1]
+define	SF_SFI		Memi[SF_IMAGES($1)+$2-1]
+
+# Basic data structure.
+define	SFD		94
+define	SFD_IMAGE	Memc[P2C($1)]	# Image name
+define	SFD_DATA	Memi[$1+40]	# Pointer to real image raster
+define	SFD_RADIUS	Memr[P2R($1+41)]# Profile radius
+define	SFD_NP		Memi[$1+42]	# Number of profile points
+define	SFD_NPMAX	Memi[$1+43]	# Maximum number of profile points
+define	SFD_X1		Memi[$1+44]	# Image raster limits
+define	SFD_X2		Memi[$1+45]
+define	SFD_Y1		Memi[$1+46]
+define	SFD_Y2		Memi[$1+47]
+define	SFD_ID		Memi[$1+48]	# Star ID
+define	SFD_X		Memr[P2R($1+49)]# Star X position
+define	SFD_Y		Memr[P2R($1+50)]# Star Y position
+define	SFD_F		Memr[P2R($1+51)]# Focus
+define	SFD_W		Memr[P2R($1+52)]# Width to use
+define	SFD_M		Memr[P2R($1+53)]# Magnitude
+define	SFD_E		Memr[P2R($1+54)]# Ellipticity
+define	SFD_PA		Memr[P2R($1+55)]# Position angle
+define	SFD_R		Memr[P2R($1+56)]# Radius at given level
+define	SFD_DFWHM	Memr[P2R($1+57)]# Direct FWHM
+define	SFD_GFWHM	Memr[P2R($1+58)]# Gaussian FWHM
+define	SFD_MFWHM	Memr[P2R($1+59)]# Moffat FWHM
+define	SFD_ASI1	Memi[$1+60]	# Pointer to enclosed flux profile
+define	SFD_ASI2	Memi[$1+61]	# Pointer to derivative profile
+define	SFD_YP1		Memr[P2R($1+62)]# Minimum of derivative profile
+define	SFD_YP2		Memr[P2R($1+63)]# Maximum of derivative profile
+define	SFD_FWHM	Memr[P2R($1+$2+63)]	# FWHM vs level=0.5*i (i=1-19)
+define	SFD_BKGD	Memr[P2R($1+83)]# Background value
+define	SFD_BKGD1	Memr[P2R($1+84)]# Original background value
+define	SFD_MISO	Memr[P2R($1+85)]# Moment isophote
+define	SFD_SIGMA	Memr[P2R($1+86)]# Moffat alpha
+define	SFD_ALPHA	Memr[P2R($1+87)]# Moffat alpha
+define	SFD_BETA	Memr[P2R($1+88)]# Moffat beta
+define	SFD_STATUS	Memi[$1+89]	# Status
+define	SFD_NSAT	Memi[$1+90]	# Number of saturated pixels
+define	SFD_SFS		Memi[$1+91]	# Pointer to star group
+define	SFD_SFF		Memi[$1+92]	# Pointer to focus group
+define	SFD_SFI		Memi[$1+93]	# Pointer to image group
+
+
+# Structure grouping data by star.
+define	SFS		($1+7)
+define	SFS_ID		Memi[$1]	# Star ID
+define	SFS_F		Memr[P2R($1+1)]	# Best focus
+define	SFS_W		Memr[P2R($1+2)]	# Best width
+define	SFS_M		Memr[P2R($1+3)]	# Average magnitude
+define	SFS_N		Memi[$1+4]	# Number of points used
+define	SFS_NF		Memi[$1+5]	# Number of focuses
+define	SFS_NSFD	Memi[$1+6]	# Number of data points
+define	SFS_SFD		Memi[$1+$2+6]	# Array of data structures
+
+
+# Structure grouping stars by focus values.
+define	SFF		($1+5)
+define	SFF_F		Memr[P2R($1)]	# Focus
+define	SFF_W		Memr[P2R($1+1)]	# Average width
+define	SFF_N		Memi[$1+2]	# Number in average
+define	SFF_NI		Memi[$1+3]	# Number of images
+define	SFF_NSFD	Memi[$1+4]	# Number of data points
+define	SFF_SFD		Memi[$1+$2+4]	# Array of data structures
+
+
+# Structure grouping stars by image.
+define	SFI		($1+42)
+define	SFI_IMAGE	Memc[P2C($1)]	# Image
+define	SFI_N		Memi[$1+40]	# Number in imagE
+define	SFI_NSFD	Memi[$1+41]	# Number of data points
+define	SFI_SFD		Memi[$1+$2+41]	# Array of data structures
diff --git a/noao/obsutil/src/starfocus/starfocus.key b/noao/obsutil/src/starfocus/starfocus.key
new file mode 100644
index 00000000..119e74a6
--- /dev/null
+++ b/noao/obsutil/src/starfocus/starfocus.key
@@ -0,0 +1,15 @@
+			COMMAND OPTIONS
+
+?	Page this help information.
+g	Measure object and graph the results.
+m	Measure object.
+q	Quit object marking and go to next image.
+	At the end of all images go to analysis of all measurements.
+
+:show	Show the current results.
+
+When an object is measured the center and enclosed flux profile is determined.
+When using the "mark1" option typing 'q' will measure all remaining images
+at the same cursor positions while the "markall" option goes to the
+next image until the image list is finished.  If measuring only one
+object with the 'g' key then a 'q' will exit the program.
diff --git a/noao/obsutil/src/starfocus/starfocus.par b/noao/obsutil/src/starfocus/starfocus.par
new file mode 100644
index 00000000..b1b1d5b0
--- /dev/null
+++ b/noao/obsutil/src/starfocus/starfocus.par
@@ -0,0 +1,32 @@
+# STARFOCUS -- Determine best star focus.
+
+images,s,a,,,,"List of images"
+focus,s,h,"1x1",,,"Focus values"
+fstep,s,h,"",,,"Focus step
+"
+nexposures,s,h,"1",,,"Number of exposures"
+step,s,h,"30",,,"Step in pixels"
+direction,s,h,"-line","-line|+line|-column|+column",,"Step direction"
+gap,s,h,"end","none|beginning|end",,"Double step gap
+"
+coords,s,h,"mark1","center|mark1|markall",,"Object coordinates"
+wcs,s,h,"logical","logical|physical|world",,"Coordinate system"
+display,b,h,yes,,,"Display images?"
+frame,i,h,1,1,,"Display frame to use
+"
+level,r,h,0.5,,,"Measurement level (fraction or percent)"
+size,s,h,"FWHM","Radius|FWHM|GFWHM|MFWHM",,"Size to display"
+beta,r,h,INDEF,2.1,,Moffat beta parameter
+scale,r,h,1.,,,"Pixel scale"
+radius,r,h,5.,,,"Measurement radius (pixels)"
+sbuffer,r,h,5,,,"Sky buffer (pixels)"
+swidth,r,h,5.,,,"Sky width (pixels)"
+saturation,r,h,INDEF,,,"Saturation level"
+ignore_sat,b,h,no,,,"Ignore objects with saturated pixels?"
+iterations,i,h,2,1,,"Number of radius adjustment iterations"
+xcenter,r,h,INDEF,,,X field center (pixels)
+ycenter,r,h,INDEF,,,Y field center (pixels)
+logfile,s,h,"logfile",,,"Logfile
+"
+imagecur,*imcur,h,"",,,"Image cursor input"
+graphcur,*gcur,h,"",,,"Graphics cursor input"
diff --git a/noao/obsutil/src/starfocus/stfgraph.x b/noao/obsutil/src/starfocus/stfgraph.x
new file mode 100644
index 00000000..890dfc81
--- /dev/null
+++ b/noao/obsutil/src/starfocus/stfgraph.x
@@ -0,0 +1,2682 @@
+include	<error.h>
+include	<gset.h>
+include	<mach.h>
+include	"starfocus.h"
+
+# Interactive help files.  There is one for STARFOCUS and one for PSFMEASUE.
+define	STFHELP		"starfocus$stfhelp.key"
+define	PSFHELP		"starfocus$psfhelp.key"
+define	PROMPT		"Options"
+
+# View ports for all plots.
+define	VX1	.15			# Minimum X viewport for left graph
+define	VX2	.47			# Maximum X viewport for left graph
+define	VX3	.63			# Minimum X viewport for right graph
+define	VX4	.95			# Maximum X viewport for right graph
+define	VY1	.10			# Minimum Y viewport for bottom graph
+define	VY2	.44			# Minimum Y viewport for bottom graph
+define	VY3	.54			# Minimum Y viewport for top graph
+define	VY4	.88			# Maximum Y viewport for top graph
+
+# Miscellaneous graphics parameters.
+define	NMAX	5			# Maximum number of samples for labeling
+define	HLCOLOR	2			# Highlight color
+define	HLWIDTH	4.			# Highlight width
+define	GM_MARK	GM_CROSS		# Point marker
+define	GM_MAG	GM_PLUS+GM_CROSS	# Magnitude marker
+
+
+# STF_GRAPH -- Interactive graphing of results.
+
+procedure stf_graph (sf)
+
+pointer	sf			#I Starfocus structure
+
+real	wx, wy, x, y, r2, r2min, fa[8]
+int	i, j, ix, iy, nx, ny, wcs, key, pkey, skey, redraw, clgcur()
+pointer	sp, sysidstr, title, cmd, gp, gopen()
+pointer	sfd, sfs, sff, current, nearest
+
+data	fa/0.,1.,1.,0.,0.,0.,1.,1./
+
+begin
+	call smark (sp)
+	call salloc (sysidstr, SZ_LINE, TY_CHAR)
+	call salloc (title, SZ_LINE, TY_CHAR)
+	call salloc (cmd, SZ_LINE, TY_CHAR)
+
+	# Set system id label
+	call sysid (Memc[sysidstr], SZ_LINE)
+
+	# Open graphics and enter interactive graphics loop
+	SF_GP(sf) = gopen ("stdgraph", NEW_FILE, STDGRAPH)
+	gp = SF_GP(sf)
+	wcs = 0
+	if (SF_NF(sf) > 1)
+	    key = 'f'
+	else if (SF_NS(sf) > 1)
+	    key = 'a'
+	else
+	    key = 'z'
+	pkey = 0
+	skey = 1
+	current = SF_BEST(sf)
+	repeat {
+	    switch (key) {
+	    case 'q':	# Quit
+		break
+	    case '?':	# Help
+		if (SF_TASK(sf) == PSFMEASURE)
+		    call gpagefile (gp, PSFHELP, PROMPT)
+		else
+		    call gpagefile (gp, STFHELP, PROMPT)
+		next
+	    case ':':	# Colon commands
+		iferr (call stf_colon (sf, Memc[cmd], redraw))
+		    redraw = NO
+		if (redraw == NO)
+		    next
+	    case 'a', 'b', 'e', 'f', 'g', 'm', 'p', 't', 'z':	# Plots
+		# When there is not enough data for the requested plot
+		# map the key to another one.  This is done mostly to
+		# avoid redrawing the same graph when different keys
+		# map to the same pkey.  The 'e', 'g', and 'p' key may
+		# select a different object so the check for the same
+		# plot is deferred.
+
+		if (SF_NS(sf) > 1 && SF_NF(sf) > 1) {
+		    ;
+		} else if (SF_NS(sf) > 1) {
+		    if (key == 'b')
+			key = 'a'
+		    if (key == 'f')
+			key = 'm'
+		} else if (SF_NF(sf) > 1) {
+		    if (key == 'a' || key == 'b' || key == 'm' || key == 't')
+			key = 'f'
+		} else {
+		    key = 'z'
+		}
+
+		switch (key) {
+		case 'e', 'g', 'p':
+		    ;
+		default:
+		    if (key == pkey)
+			next
+		}
+	    case 's':	# Toggle plotting of magnitude symbols
+		if (pkey != 'a' && pkey != 'b')
+		    next
+		skey = mod (skey+1, 2)
+	    case 'u':	# Undelete all
+		j = 0
+		do i = 1, SF_NSFD(sf) {
+		    sfd = SF_SFD(sf,i)
+		    if (SFD_STATUS(sfd) != 0) {
+			SFD_STATUS(sfd) = 0
+			j = j + 1
+		    }
+		}
+		if (j == 0)
+		    next
+		call stf_fitfocus (sf)
+	    case 'd', 'n', 'o', 'r', 'x', 'i', ' ':	# Misc
+	        ;
+	    default:	# Unknown
+		call printf ("\007")
+		next
+	    }
+
+	    # Find the nearest or next object if needed.
+	    switch (key) {
+	    case 'r', 's', 'u', ':':	# Redraw last graph
+		pkey = pkey
+		nearest = current
+	    case 'n', 'o':		# Renormalize enclosed flux profile
+		if (wcs != 7 || pkey == 'p')
+		    next
+		pkey = pkey
+		nearest = current
+		if (key == 'n')
+		    call stf_norm (sf, nearest, wx, INDEF)
+		else
+		    call stf_norm (sf, nearest, wx, wy)
+		call stf_widths (sf, nearest)
+		call stf_fwhms (sf, nearest)
+		call stf_fitfocus (sf)
+	    case ' ':			# Select next focus or star
+		switch (pkey) {
+		case 'a', 'm', 't':
+		    sff = SFD_SFF(current)
+		    for (i=1; SF_SFF(sf,i)!=sff; i=i+1)
+			;
+		    j = SF_NFOCUS(sf)
+		    i = mod (i, j) + 1
+		    for (; SFF_N(SF_SFF(sf,i))==0; i=mod(i,j)+1)
+			;
+		    if (SF_SFF(sf,i) == sff)
+			next
+		    sff = SF_SFF(sf,i)
+		    do i = 1, SFF_NSFD(sff) {
+			nearest = SFF_SFD(sff,i)
+			if (SFD_STATUS(nearest) == 0)
+			    break
+		    }
+		case 'e', 'g', 'p', 'z':
+		    switch (wcs) {
+		    case 7, 8, 11:
+			for (i=1; SF_SFD(sf,i)!=current; i=i+1)
+			    ;
+			j = SF_NSFD(sf)
+			i = mod (i, j) + 1
+			for (; SFD_STATUS(SF_SFD(sf,i))!=0; i=mod(i,j)+1)
+			    ;
+			nearest = SF_SFD(sf,i)
+		    case 9:
+			sfs = SFD_SFS(current)
+			for (i=1; SFS_SFD(sfs,i)!=current; i=i+1)
+			    ;
+			j = SFS_NSFD(sfs)
+			i = mod (i, j) + 1
+			for (; SFD_STATUS(SFS_SFD(sfs,i))!=0; i=mod(i,j)+1)
+			    ;
+			nearest = SFS_SFD(sfs,i)
+			if (nearest == current)
+			    next
+		    case 10:
+			sff = SFD_SFF(current)
+			for (i=1; SFF_SFD(sff,i)!=current; i=i+1)
+			    ;
+			j = SFF_NSFD(sff)
+			i = mod (i, j) + 1
+			for (; SFD_STATUS(SFF_SFD(sff,i))!=0; i=mod(i,j)+1)
+			    ;
+			nearest = SFF_SFD(sff,i)
+			if (nearest == current)
+			    next
+		    }
+		default:
+		    next
+		}
+	    default:			# Select nearest to cursor
+		switch (pkey) {
+		case 'a':
+		    r2min = MAX_REAL
+		    call gctran (gp, wx, wy, wx, wy, wcs, 0)
+		    sff = SFD_SFF(current)
+		    do i = 1, SFF_NSFD(sff) {
+			sfd = SFF_SFD(sff,i)
+			if (SFD_STATUS(sfd) != 0)
+			    next
+			switch (wcs) {
+			case 1:
+			    x = SFD_X(sfd)
+			    y = SFD_Y(sfd)
+			case 2:
+			    x = SFD_X(sfd)
+			    y = SFD_W(sfd)
+			case 3:
+			    x = SFD_W(sfd)
+			    y = SFD_Y(sfd)
+			case 4:
+			    x = SFD_X(sfd)
+			    y = SFD_E(sfd)
+			case 5:
+			    x = SFD_E(sfd)
+			    y = SFD_Y(sfd)
+			}
+			call gctran (gp, x, y, x, y, wcs, 0)
+			r2 = (x-wx)**2 + (y-wy)**2
+			if (r2 < r2min) {
+			    r2min = r2
+			    nearest = sfd
+			}
+		    }
+		case 'b': 
+		    r2min = MAX_REAL
+		    call gctran (gp, wx, wy, wx, wy, wcs, 0)
+		    do i = 1, SF_NSTARS(sf) {
+			sfs = SF_SFS(sf,i)
+			if (SFS_N(sfs) == 0)
+			    next
+			switch (wcs) {
+			case 1:
+			    x = SFD_X(SFS_SFD(sfs,1))
+			    y = SFD_Y(SFS_SFD(sfs,1))
+			case 2:
+			    x = SFD_X(SFS_SFD(sfs,1))
+			    y = SFS_W(sfs)
+			case 3:
+			    x = SFS_W(sfs)
+			    y = SFD_Y(SFS_SFD(sfs,1))
+			case 4:
+			    x = SFD_X(SFS_SFD(sfs,1))
+			    y = SFS_F(sfs)
+			case 5:
+			    x = SFS_F(sfs)
+			    y = SFD_Y(SFS_SFD(sfs,1))
+			}
+			call gctran (gp, x, y, x, y, wcs, 0)
+			r2 = (x-wx)**2 + (y-wy)**2
+			if (r2 < r2min) {
+			    r2min = r2
+			    nearest = sfs
+			}
+		    }
+		    sfs = nearest
+		    r2min = MAX_REAL
+		    do i = 1, SFS_NSFD(sfs) {
+			sfd = SFS_SFD(sfs,i)
+			if (SFD_STATUS(sfd) != 0)
+			    next
+			r2 = SFD_W(sfd)
+			if (r2 < r2min) {
+			    r2min = r2
+			    nearest = sfd
+			}
+		    }
+		case 'e', 'g', 'p':
+		    switch (wcs) {
+		    case 9:
+			sfs = SFD_SFS(current)
+			i = SFS_N(sfs)
+			if (i < 4) {
+			    nx = i
+			    ny = 1
+			} else {
+			    nx = nint (sqrt (real (i)))
+			    if (mod (i-1, nx+1) >= mod (i-1, nx))
+				nx = nx + 1
+			    ny = (i - 1) / nx + 1
+			}
+			ix = max (1, min (nx, nint(wx)))
+			iy = max (1, min (ny, nint(wy)))
+
+			j = 0
+			do i = 1, SFS_NSFD(sfs) {
+			    sfd = SFS_SFD(sfs, i)
+			    if (SFD_STATUS(sfd) != 0)
+				next
+			    if (ix == 1 + mod (j, nx) && iy == 1 + j / nx) {
+				nearest = sfd
+				break
+			    }
+			    j = j + 1
+			}
+		    case 10:
+			sff = SFD_SFF(current)
+			i = SFF_N(sff)
+			if (i < 4) {
+			    nx = i
+			    ny = 1
+			} else {
+			    nx = nint (sqrt (real (i)))
+			    if (mod (i-1, nx+1) >= mod (i-1, nx))
+				nx = nx + 1
+			    ny = (i - 1) / nx + 1
+			}
+			ix = max (1, min (nx, nint(wx)))
+			iy = max (1, min (ny, nint(wy)))
+
+			j = 0
+			do i = 1, SFF_NSFD(sff) {
+			    sfd = SFF_SFD(sff, i)
+			    if (SFD_STATUS(sfd) != 0)
+				next
+			    if (ix == 1 + mod (j, nx) && iy == 1 + j / nx) {
+				nearest = sfd
+				break
+			    }
+			    j = j + 1
+			}
+		    }
+		    if (key == pkey && nearest == current)
+			next
+		default:
+		    switch (wcs) {
+		    case 1, 2:
+			r2min = MAX_REAL
+			call gctran (gp, wx, wy, wx, wy, wcs, 0)
+			do i = 1, SF_NSFD(sf) {
+			    sfd = SF_SFD(sf,i)
+			    if (SFD_STATUS(sfd) != 0)
+				next
+			    switch (wcs) {
+			    case 1:
+				x = SFD_F(sfd)
+				y = SFD_W(sfd)
+			    case 2:
+				x = SFD_F(sfd)
+				y = SFD_E(sfd)
+			    }
+			    call gctran (gp, x, y, x, y, wcs, 0)
+			    r2 = (x-wx)**2 + (y-wy)**2
+			    if (r2 < r2min) {
+				r2min = r2
+				nearest = sfd
+			    }
+			}
+		    case 3, 4, 5, 6:
+			r2min = MAX_REAL
+			call gctran (gp, wx, wy, wx, wy, wcs, 0)
+			sff = SFD_SFF(current)
+			do i = 1, SFF_NSFD(sff) {
+			    sfd = SFF_SFD(sff,i)
+			    if (SFD_STATUS(sfd) != 0)
+				next
+			    switch (wcs) {
+			    case 3:
+				x = -2.5 * log10 (SFS_M(SFD_SFS(sfd))/SF_M(sf))
+				y = SFD_W(sfd)
+			    case 4:
+				x = -2.5 * log10 (SFS_M(SFD_SFS(sfd))/SF_M(sf))
+				y = SFD_E(sfd)
+			    case 5:
+				x = sqrt ((SFD_X(sfd) - SF_XF(sf)) ** 2 +
+				    (SFD_Y(sfd) - SF_YF(sf)) ** 2)
+				y = SFD_W(sfd)
+			    case 6:
+				x = sqrt ((SFD_X(sfd) - SF_XF(sf)) ** 2 +
+				    (SFD_Y(sfd) - SF_YF(sf)) ** 2)
+				y = SFD_E(sfd)
+			    }
+			    call gctran (gp, x, y, x, y, wcs, 0)
+			    r2 = (x-wx)**2 + (y-wy)**2
+			    if (r2 < r2min) {
+				r2min = r2
+				nearest = sfd
+			    }
+			}
+		    default:
+			nearest = current
+		    }
+		}
+
+		# Act on selection for delete or info.
+		switch (key) {
+		case 'd':
+		    if (SF_NS(sf) > 1) {
+			sfs = SFD_SFS(nearest)
+			do i = 1, SFS_NSFD(sfs)
+			    SFD_STATUS(SFS_SFD(sfs,i)) = 1
+		    } else
+			SFD_STATUS(nearest) = 1
+		    call stf_fitfocus (sf)
+		case 'x':
+		    repeat {
+			switch (key) {
+			case 'f':
+			    sff = SFD_SFF(nearest)
+			    do i = 1, SFF_NSFD(sff)
+				SFD_STATUS(SFF_SFD(sff,i)) = 1
+			case 'i':
+			    sfd = SFD_SFI(nearest)
+			    do i = 1, SFI_NSFD(sfd)
+				SFD_STATUS(SFI_SFD(sfd,i)) = 1
+			case 'p':
+			    SFD_STATUS(nearest) = 1
+			case 's':
+			    sfs = SFD_SFS(nearest)
+			    do i = 1, SFS_NSFD(sfs)
+				SFD_STATUS(SFS_SFD(sfs,i)) = 1
+			default:
+			    call printf (
+			    "Delete image, star, focus, or point? (i|s|f|p)")
+			    next
+			}
+			call stf_fitfocus (sf)
+			break
+		    } until (clgcur ("graphcur",
+			wx, wy, wcs, key, Memc[cmd], SZ_LINE) == EOF)
+		case 'i':
+		    switch (pkey) {
+		    case 'b':
+			sfs = SFD_SFS(nearest)
+			call stf_title (sf, NULL, sfs, NULL,
+			    Memc[title], SZ_LINE)
+		    default:
+			call stf_title (sf, nearest, NULL, NULL,
+			    Memc[title], SZ_LINE)
+		    }
+		    call printf ("%s\n")
+			call pargstr (Memc[title])
+		    next
+		default:
+		    pkey = key
+		}
+	    }
+
+	    # If current object has been deleted select another.
+	    if (SFD_STATUS(nearest) == 0)
+		current = nearest
+	    else
+		current = SF_BEST(sf)
+
+	    # Make the graphs.  The graph depends on the number of stars
+	    # and number of focus values.  Note that the pkey has already
+	    # been mapped but all the keys are shown for clarity.
+
+	    call gclear (gp)
+	    call gseti (gp, G_FACOLOR, 0)
+
+	    if (SF_NS(sf) > 1 && SF_NF(sf) > 1) {
+		switch (pkey) {
+		case 'a':
+		    sff = SFD_SFF(current)
+		    call stf_title (sf, NULL, NULL, sff, Memc[title], SZ_LINE)
+		    call gseti (gp, G_WCS, 1)
+		    call gsview (gp, VX1, VX4, VY1, VY4)
+		    call stf_g11 (sf, current, skey, Memc[title])
+		case 'b':
+		    call sprintf (Memc[title], SZ_LINE,
+			"Best focus estimates for each star")
+		    call gseti (gp, G_WCS, 1)
+		    call gsview (gp, VX1, VX4, VY1, VY4)
+		    call stf_g12 (sf, current, skey, Memc[title])
+		case 'e':
+		    sfs = SFD_SFS(current)
+		    call sprintf (Memc[title], SZ_LINE,
+			"Star: x=%.2f, y=%.2f, m=%.2f")
+			call pargr (SFD_X(current))
+			call pargr (SFD_Y(current))
+			call pargr (-2.5 * log10 (SFS_M(sfs) / SF_M(sf)))
+		    call gseti (gp, G_WCS, 9)
+		    call gsview (gp, VX1, VX4, VY3, VY4)
+		    call stf_g2 (sf, current, Memc[title])
+		    sff = SFD_SFF(current)
+		    call stf_title (sf, NULL, NULL, sff, Memc[title], SZ_LINE)
+		    call gseti (gp, G_WCS, 10)
+		    call gsview (gp, VX1, VX4, VY1, VY2)
+		    call stf_g3 (sf, current, Memc[title])
+		case 'f':
+		    call gseti (gp, G_WCS, 1)
+		    call gsview (gp, VX1, VX4, VY3, VY4)
+		    call stf_g1 (sf, current, 'f', 'r', "", "", SF_WTYPE(sf))
+		    call gseti (gp, G_WCS, 2)
+		    call gsview (gp, VX1, VX4, VY1, VY2)
+		    call gfill (gp, fa, fa[5], 4, GF_SOLID)
+		    call stf_g1 (sf, current, 'f', 'e', "", "Focus",
+			"Ellipticity")
+		case 'g':
+		    sfs = SFD_SFS(current)
+		    call sprintf (Memc[title], SZ_LINE,
+			"Star: x=%.2f, y=%.2f, m=%.2f")
+			call pargr (SFD_X(current))
+			call pargr (SFD_Y(current))
+			call pargr (-2.5 * log10 (SFS_M(sfs) / SF_M(sf)))
+		    call gseti (gp, G_WCS, 9)
+		    call gsview (gp, VX1, VX4, VY3, VY4)
+		    call stf_g9 (sf, current, Memc[title])
+		    sff = SFD_SFF(current)
+		    call stf_title (sf, NULL, NULL, sff, Memc[title], SZ_LINE)
+		    call gseti (gp, G_WCS, 10)
+		    call gsview (gp, VX1, VX4, VY1, VY2)
+		    call stf_g10 (sf, current, Memc[title])
+		case 'm':
+		    sff = SFD_SFF(current)
+		    call stf_title (sf, NULL, NULL, sff, Memc[title], SZ_LINE)
+		    call gseti (gp, G_WCS, 3)
+		    call gsview (gp, VX1, VX4, VY3, VY4)
+		    call stf_g1 (sf, current, 'm', 'r', Memc[title],
+			"", SF_WTYPE(sf))
+		    call gseti (gp, G_WCS, 4)
+		    call gsview (gp, VX1, VX4, VY1, VY2)
+		    call gfill (gp, fa, fa[5], 4, GF_SOLID)
+		    call stf_g1 (sf, current, 'm', 'e', "", "Magnitude",
+			"Ellipticity")
+		case 'p':
+		    sfs = SFD_SFS(current)
+		    call sprintf (Memc[title], SZ_LINE,
+			"Star: x=%.2f, y=%.2f, m=%.2f")
+			call pargr (SFD_X(current))
+			call pargr (SFD_Y(current))
+			call pargr (-2.5 * log10 (SFS_M(sfs) / SF_M(sf)))
+		    call gseti (gp, G_WCS, 9)
+		    call gsview (gp, VX1, VX4, VY3, VY4)
+		    call stf_g4 (sf, current, Memc[title])
+		    sff = SFD_SFF(current)
+		    call stf_title (sf, NULL, NULL, sff, Memc[title], SZ_LINE)
+		    call gseti (gp, G_WCS, 10)
+		    call gsview (gp, VX1, VX4, VY1, VY2)
+		    call stf_g5 (sf, current, Memc[title])
+		case 't':
+		    sff = SFD_SFF(current)
+		    call stf_title (sf, NULL, NULL, sff, Memc[title], SZ_LINE)
+		    call gseti (gp, G_WCS, 5)
+		    call gsview (gp, VX1, VX4, VY3, VY4)
+		    call stf_g1 (sf, current, 't', 'r', Memc[title],
+			"", SF_WTYPE(sf))
+		    call gseti (gp, G_WCS, 6)
+		    call gsview (gp, VX1, VX4, VY1, VY2)
+		    call gfill (gp, fa, fa[5], 4, GF_SOLID)
+		    call stf_g1 (sf, current, 't', 'e', "", "Field radius",
+			"Ellipticity")
+		case 'z':
+		    call gseti (gp, G_WCS, 7)
+		    call gsview (gp, VX1, VX2, VY3, VY4)
+		    call stf_g6 (sf, current, "", "", "Enclosed flux")
+		    call gseti (gp, G_WCS, 8)
+		    call gsview (gp, VX1, VX2, VY1, VY2)
+		    call gfill (gp, fa, fa[5], 4, GF_SOLID)
+		    call stf_g7 (sf, current, "", "Radius", "Profile")
+		    call gseti (gp, G_WCS, 11)
+		    call gsview (gp, VX3, VX4, VY3, VY4)
+		    call gfill (gp, fa, fa[5], 4, GF_SOLID)
+		    call stf_g8 (sf, current, "", "Enclosed flux", "FWHM")
+
+		    call stf_title (sf, current, NULL, NULL, Memc[title],
+			SZ_LINE)
+		    call gseti (gp, G_WCS, 0)
+		    call gsetr (gp, G_PLWIDTH, 2.0)
+		    call gline (gp, 0., 0., 0., 0.)
+		    call gtext (gp, 0.5, 0.93, Memc[title], "h=c,v=t")
+		}
+	    } else if (SF_NS(sf) > 1) {
+		switch (pkey) {
+		case 'a', 'b':
+		    sff = SFD_SFF(current)
+		    call stf_title (sf, NULL, NULL, sff, Memc[title], SZ_LINE)
+		    call gseti (gp, G_WCS, 1)
+		    call gsview (gp, VX1, VX4, VY1, VY4)
+		    call stf_g11 (sf, current, skey, Memc[title])
+		case 'e':
+		    sff = SFD_SFF(current)
+		    call stf_title (sf, NULL, NULL, sff, Memc[title], SZ_LINE)
+		    call gseti (gp, G_WCS, 10)
+		    call gsview (gp, VX1, VX4, VY3, VY4)
+		    call stf_g3 (sf, current, Memc[title])
+		    call stf_title (sf, current, NULL, NULL, Memc[title],
+			SZ_LINE)
+		    call gseti (gp, G_WCS, 7)
+		    call gsview (gp, VX1, VX4, VY1, VY2)
+		    call gfill (gp, fa, fa[5], 4, GF_SOLID)
+		    call stf_g6 (sf, current, Memc[title], "Radius",
+			"Enclosed flux")
+		case 'f', 'm':
+		    sff = SFD_SFF(current)
+		    call stf_title (sf, NULL, NULL, sff, Memc[title], SZ_LINE)
+		    call gseti (gp, G_WCS, 3)
+		    call gsview (gp, VX1, VX4, VY3, VY4)
+		    call stf_g1 (sf, current, 'm', 'r', Memc[title], "",
+			SF_WTYPE(sf))
+		    call gseti (gp, G_WCS, 4)
+		    call gsview (gp, VX1, VX4, VY1, VY2)
+		    call gfill (gp, fa, fa[5], 4, GF_SOLID)
+		    call stf_g1 (sf, current, 'm', 'e', "", "Magnitude",
+			"Ellipticity")
+		case 'g':
+		    sff = SFD_SFF(current)
+		    call stf_title (sf, NULL, NULL, sff, Memc[title], SZ_LINE)
+		    call gseti (gp, G_WCS, 10)
+		    call gsview (gp, VX1, VX4, VY3, VY4)
+		    call stf_g10 (sf, current, Memc[title])
+		    call stf_title (sf, current, NULL, NULL, Memc[title],
+			SZ_LINE)
+		    call gseti (gp, G_WCS, 11)
+		    call gsview (gp, VX1, VX4, VY1, VY2)
+		    call gfill (gp, fa, fa[5], 4, GF_SOLID)
+		    call stf_g8 (sf, current, Memc[title], "Enclosed flux",
+			"FWHM")
+		case 'p':
+		    sff = SFD_SFF(current)
+		    call stf_title (sf, NULL, NULL, sff, Memc[title], SZ_LINE)
+		    call gseti (gp, G_WCS, 10)
+		    call gsview (gp, VX1, VX4, VY3, VY4)
+		    call stf_g5 (sf, current, Memc[title])
+		    call stf_title (sf, current, NULL, NULL, Memc[title],
+			SZ_LINE)
+		    call gseti (gp, G_WCS, 7)
+		    call gsview (gp, VX1, VX4, VY1, VY2)
+		    call gfill (gp, fa, fa[5], 4, GF_SOLID)
+		    call stf_g7 (sf, current, Memc[title], "Radius", "Profile")
+		case 't':
+		    sff = SFD_SFF(current)
+		    call stf_title (sf, NULL, NULL, sff, Memc[title], SZ_LINE)
+		    call gseti (gp, G_WCS, 5)
+		    call gsview (gp, VX1, VX4, VY3, VY4)
+		    call stf_g1 (sf, current, 't', 'r', Memc[title], "",
+			SF_WTYPE(sf))
+		    call gseti (gp, G_WCS, 6)
+		    call gsview (gp, VX1, VX4, VY1, VY2)
+		    call gfill (gp, fa, fa[5], 4, GF_SOLID)
+		    call stf_g1 (sf, current, 't', 'e', "", "Field radius",
+			"Ellipticity")
+		case 'z':
+		    call gseti (gp, G_WCS, 7)
+		    call gsview (gp, VX1, VX2, VY3, VY4)
+		    call stf_g6 (sf, current, "", "", "Enclosed flux")
+		    call gseti (gp, G_WCS, 8)
+		    call gsview (gp, VX1, VX2, VY1, VY2)
+		    call gfill (gp, fa, fa[5], 4, GF_SOLID)
+		    call stf_g7 (sf, current, "", "Radius", "Profile")
+		    call gseti (gp, G_WCS, 11)
+		    call gsview (gp, VX3, VX4, VY3, VY4)
+		    call gfill (gp, fa, fa[5], 4, GF_SOLID)
+		    call stf_g8 (sf, current, "", "Enclosed flux", "FWHM")
+
+		    call stf_title (sf, current, NULL, NULL, Memc[title],
+			SZ_LINE)
+		    call gseti (gp, G_WCS, 0)
+		    call gsetr (gp, G_PLWIDTH, 2.0)
+		    call gline (gp, 0., 0., 0., 0.)
+		    call gtext (gp, 0.5, 0.93, Memc[title], "h=c,v=t")
+		}
+	    } else if (SF_NF(sf) > 1) {
+		switch (pkey) {
+		case 'a', 'b', 'f', 'm', 't':
+		    call gseti (gp, G_WCS, 1)
+		    call gsview (gp, VX1, VX4, VY3, VY4)
+		    call stf_g1 (sf, current, 'f', 'r', "", "", SF_WTYPE(sf))
+		    call gseti (gp, G_WCS, 2)
+		    call gsview (gp, VX1, VX4, VY1, VY2)
+		    call gfill (gp, fa, fa[5], 4, GF_SOLID)
+		    call stf_g1 (sf, current, 'f', 'e', "", "Focus",
+			"Ellipticity")
+		case 'e':
+		    sfs = SFD_SFS(current)
+		    call sprintf (Memc[title], SZ_LINE,
+			"Star: x=%.2f, y=%.2f, m=%.2f")
+			call pargr (SFD_X(current))
+			call pargr (SFD_Y(current))
+			call pargr (-2.5 * log10 (SFS_M(sfs) / SF_M(sf)))
+		    call gseti (gp, G_WCS, 9)
+		    call gsview (gp, VX1, VX4, VY3, VY4)
+		    call stf_g2 (sf, current, Memc[title])
+		    call stf_title (sf, current, NULL, NULL, Memc[title],
+			SZ_LINE)
+		    call gseti (gp, G_WCS, 7)
+		    call gsview (gp, VX1, VX4, VY1, VY2)
+		    call gfill (gp, fa, fa[5], 4, GF_SOLID)
+		    call stf_g6 (sf, current, Memc[title], "Radius",
+			"Enclosed flux")
+		case 'g':
+		    sfs = SFD_SFS(current)
+		    call sprintf (Memc[title], SZ_LINE,
+			"Star: x=%.2f, y=%.2f, m=%.2f")
+			call pargr (SFD_X(current))
+			call pargr (SFD_Y(current))
+			call pargr (-2.5 * log10 (SFS_M(sfs) / SF_M(sf)))
+		    call gseti (gp, G_WCS, 9)
+		    call gsview (gp, VX1, VX4, VY3, VY4)
+		    call stf_g9 (sf, current, Memc[title])
+		    call stf_title (sf, current, NULL, NULL, Memc[title],
+			SZ_LINE)
+		    call gseti (gp, G_WCS, 11)
+		    call gsview (gp, VX1, VX4, VY1, VY2)
+		    call gfill (gp, fa, fa[5], 4, GF_SOLID)
+		    call stf_g8 (sf, current, Memc[title], "Enclosed flux",
+			"FWHM")
+		case 'p':
+		    sfs = SFD_SFS(current)
+		    call sprintf (Memc[title], SZ_LINE,
+			"Star: x=%.2f, y=%.2f, m=%.2f")
+			call pargr (SFD_X(current))
+			call pargr (SFD_Y(current))
+			call pargr (-2.5 * log10 (SFS_M(sfs) / SF_M(sf)))
+		    call gseti (gp, G_WCS, 9)
+		    call gsview (gp, VX1, VX4, VY3, VY4)
+		    call stf_g4 (sf, current, Memc[title])
+		    call stf_title (sf, current, NULL, NULL, Memc[title],
+			SZ_LINE)
+		    call gseti (gp, G_WCS, 7)
+		    call gsview (gp, VX1, VX4, VY1, VY2)
+		    call gfill (gp, fa, fa[5], 4, GF_SOLID)
+		    call stf_g7 (sf, current, Memc[title], "Radius",
+			"profile")
+		case 'z':
+		    call gseti (gp, G_WCS, 7)
+		    call gsview (gp, VX1, VX2, VY3, VY4)
+		    call stf_g6 (sf, current, "", "", "Enclosed flux")
+		    call gseti (gp, G_WCS, 8)
+		    call gsview (gp, VX1, VX2, VY1, VY2)
+		    call gfill (gp, fa, fa[5], 4, GF_SOLID)
+		    call stf_g7 (sf, current, "", "Radius", "Profile")
+		    call gseti (gp, G_WCS, 11)
+		    call gsview (gp, VX3, VX4, VY3, VY4)
+		    call gfill (gp, fa, fa[5], 4, GF_SOLID)
+		    call stf_g8 (sf, current, "", "Enclosed flux", "FWHM")
+
+		    call stf_title (sf, current, NULL, NULL, Memc[title],
+			SZ_LINE)
+		    call gseti (gp, G_WCS, 0)
+		    call gsetr (gp, G_PLWIDTH, 2.0)
+		    call gline (gp, 0., 0., 0., 0.)
+		    call gtext (gp, 0.5, 0.93, Memc[title], "h=c,v=t")
+		}
+	    } else {
+		switch (pkey) {
+		case 'a', 'b', 'f', 'm', 'p', 'z', 'e', 't':
+		    call gseti (gp, G_WCS, 7)
+		    call gsview (gp, VX1, VX2, VY3, VY4)
+		    call stf_g6 (sf, current, "", "", "Enclosed flux")
+		    call gseti (gp, G_WCS, 8)
+		    call gsview (gp, VX1, VX2, VY1, VY2)
+		    call gfill (gp, fa, fa[5], 4, GF_SOLID)
+		    call stf_g7 (sf, current, "", "Radius", "Profile")
+		    call gseti (gp, G_WCS, 11)
+		    call gsview (gp, VX3, VX4, VY3, VY4)
+		    call gfill (gp, fa, fa[5], 4, GF_SOLID)
+		    call stf_g8 (sf, current, "", "Enclosed flux", "FWHM")
+
+		    call stf_title (sf, current, NULL, NULL, Memc[title],
+			SZ_LINE)
+		    call gseti (gp, G_WCS, 0)
+		    call gsetr (gp, G_PLWIDTH, 2.0)
+		    call gline (gp, 0., 0., 0., 0.)
+		    call gtext (gp, 0.5, 0.93, Memc[title], "h=c,v=t")
+		}
+	    }
+
+	    # Add banner title.
+	    call stf_title (sf, NULL, NULL, NULL, Memc[title], SZ_LINE)
+	    call gseti (gp, G_WCS, 0)
+	    call gsetr (gp, G_PLWIDTH, 2.0)
+	    call gline (gp, 0., 0., 0., 0.)
+	    call gtext (gp, 0.5, 0.99, Memc[sysidstr], "h=c,v=t")
+	    call gtext (gp, 0.5, 0.96, Memc[title], "h=c,v=t")
+
+	    if (SF_NSFD(sf) == 1)
+		break
+
+	} until (clgcur ("graphcur", wx, wy, wcs, key, Memc[cmd], SZ_LINE)==EOF)
+
+	call gclose (gp)
+	call sfree (sp)
+end
+
+
+# List of colon commands.
+define	CMDS		"|show|level|size|scale|radius|xcenter|ycenter\
+			|overplot|beta|"
+define	SHOW		1	# Show current results
+define	LEVEL		2	# Measurement level
+define	SIZE		3	# Size type
+define	SCALE		4	# Pixel scale
+define	RADIUS		5	# Maximum radius
+define	XCENTER		6	# X field center
+define	YCENTER		7	# Y field center
+define	OVERPLOT	8	# Overplot best profile
+define	BETA		9	# Beta value for Moffat function
+
+# STF_COLON -- Respond to colon command.
+
+procedure stf_colon (sf, cmd, redraw)
+
+pointer	sf			#I Starfocus pointer
+char	cmd[ARB]		#I Colon command
+int	redraw			#O Redraw?
+
+bool	bval
+real	rval, stf_r2i()
+int	i, j, ncmd, nscan(), strdic(), open(), btoi()
+pointer	sp, str, sfd
+errchk	open, delete, stf_log, stf_norm, stf_radius, stf_fitfocus
+
+begin
+	call smark (sp)
+	call salloc (str, SZ_FNAME, TY_CHAR)
+
+	# Scan the command string and get the first word.
+	call sscan (cmd)
+	call gargwrd (Memc[str], SZ_FNAME)
+	ncmd = strdic (Memc[str], Memc[str], SZ_FNAME, CMDS)
+
+	switch (ncmd) {
+	case SHOW:
+	    call gargwrd (Memc[str], SZ_FNAME)
+	    iferr {
+		if (nscan() == 1) {
+		    call mktemp ("tmp$iraf", Memc[str], SZ_FNAME)
+		    i = open (Memc[str], APPEND, TEXT_FILE)
+		    call stf_log (sf, i)
+		    call close (i)
+		    call gpagefile (SF_GP(sf), Memc[str], "starfocus")
+		    call delete (Memc[str])
+		} else {
+		    i = open (Memc[str], APPEND, TEXT_FILE)
+		    call stf_log (sf, i)
+		    call close (i)
+		}
+	    } then
+		call erract (EA_WARN)
+	    redraw = NO
+	case LEVEL:
+	    call gargr (rval)
+	    if (nscan() == 2) {
+		if (rval > 1.)
+		    rval = rval / 100.
+		SF_LEVEL(sf) = max (0.05, min (0.95, rval))
+		do i = 1, SF_NSFD(sf) {
+		    sfd = SF_SFD(sf,i)
+		    call stf_radius (sf, sfd, SF_LEVEL(sf), SFD_R(sfd))
+		}
+		if (SF_WCODE(sf) == 1)
+		    call stf_fitfocus (sf) 
+		redraw = YES
+	    } else {
+		call printf ("level %g\n")
+		    call pargr (SF_LEVEL(sf))
+		redraw = NO
+	    }
+	case SIZE:
+	    call gargwrd (Memc[str], SZ_FNAME)
+	    if (nscan() == 2) {
+		ncmd = strdic (Memc[str], Memc[str], SZ_FNAME, SF_WTYPES)
+		if (ncmd == 0) {
+		    call eprintf ("Invalid size type\n")
+		    redraw = NO
+		} else {
+		    call strcpy (Memc[str], SF_WTYPE(sf), SF_SZWTYPE)
+		    SF_WCODE(sf) = ncmd
+		    do i = 1, SF_NSFD(sf) {
+			sfd = SF_SFD(sf,i)
+			switch (SF_WCODE(sf)) {
+			case 1:
+			    SFD_W(sfd) = SFD_R(sfd)
+			case 2:
+			    SFD_W(sfd) = SFD_DFWHM(sfd)
+			case 3:
+			    SFD_W(sfd) = SFD_GFWHM(sfd)
+			case 4:
+			    SFD_W(sfd) = SFD_MFWHM(sfd)
+			}
+			call stf_fwhms (sf, sfd)
+		    }
+		    call stf_fitfocus (sf) 
+		    redraw = YES
+		}
+	    } else {
+		call printf ("size %s\n")
+		    call pargstr (SF_WTYPE(sf))
+		redraw = NO
+	    }
+	case SCALE:
+	    call gargr (rval)
+	    if (nscan() == 2) {
+		rval = rval / SF_SCALE(sf)
+		SF_SCALE(sf) = SF_SCALE(sf) * rval
+		do i = 1, SF_NSFD(sf) {
+		    sfd = SF_SFD(sf,i)
+		    switch (SF_WCODE(sf)) {
+		    case 1:
+			SFD_R(sfd) = SFD_R(sfd) * rval
+			SFD_W(sfd) = SFD_R(sfd)
+		    case 2:
+			SFD_DFWHM(sfd) = SFD_DFWHM(sfd) * rval
+			SFD_W(sfd) = SFD_DFWHM(sfd)
+		    case 3:
+			SFD_SIGMA(sfd) = SFD_SIGMA(sfd) * rval
+			SFD_GFWHM(sfd) = SFD_GFWHM(sfd) * rval
+			SFD_W(sfd) = SFD_GFWHM(sfd)
+		    case 4:
+			SFD_ALPHA(sfd) = SFD_ALPHA(sfd) * rval
+			SFD_MFWHM(sfd) = SFD_MFWHM(sfd) * rval
+			SFD_W(sfd) = SFD_MFWHM(sfd)
+		    }
+		    do j = 1, 19
+			SFD_FWHM(sfd,j) = SFD_FWHM(sfd,j) * rval
+		}
+		do i = 1, SF_NSTARS(sf) {
+		    sfd = SF_SFS(sf,i)
+		    SFS_W(sfd) = SFS_W(sfd) * rval
+		}
+		do i = 1, SF_NFOCUS(sf) {
+		    sfd = SF_SFF(sf,i)
+		    SFF_W(sfd) = SFF_W(sfd) * rval
+		}
+		SF_W(sf) = SF_W(sf) * rval
+		redraw = YES
+	    } else {
+		call printf ("scale %g\n")
+		    call pargr (SF_SCALE(sf))
+		redraw = NO
+	    }
+	case RADIUS:
+	    call gargr (rval)
+	    if (nscan() == 2) {
+		j = stf_r2i (rval) + 1
+		SF_RADIUS(sf) = rval
+		do i = 1, SF_NSFD(sf) {
+		    sfd = SF_SFD(sf,i)
+		    if (j > SFD_NPMAX(sfd))
+			next
+		    SFD_NP(sfd) = j
+		    SFD_RADIUS(sf) = SF_RADIUS(sf)
+		    call stf_norm (sf, sfd, INDEF, INDEF)
+		    call stf_widths (sf, sfd)
+		    call stf_fwhms (sf, sfd)
+		}
+		call stf_fitfocus (sf)
+		redraw = YES
+	    } else {
+		call printf ("radius %g\n")
+		    call pargr (SF_RADIUS(sf))
+		redraw = NO
+	    }
+	case XCENTER:
+	    call gargr (rval)
+	    if (nscan() == 2) {
+		if (IS_INDEF(rval))
+		    SF_XF(sf) = (SF_NCOLS(sf) + 1) / 2.
+		else
+		    SF_XF(sf) = rval
+		redraw = NO
+	    } else {
+		call printf ("xcenter %g\n")
+		    call pargr (SF_XF(sf))
+		redraw = NO
+	    }
+	case YCENTER:
+	    call gargr (rval)
+	    if (nscan() == 2) {
+		if (IS_INDEF(rval))
+		    SF_YF(sf) = (SF_NLINES(sf) + 1) / 2.
+		else
+		    SF_YF(sf) = rval
+		redraw = NO
+	    } else {
+		call printf ("ycenter %g\n")
+		    call pargr (SF_YF(sf))
+		redraw = NO
+	    }
+	case OVERPLOT:
+	    call gargb (bval)
+	    if (nscan() == 2) {
+		SF_OVRPLT(sf) = btoi (bval)
+		redraw = YES
+	    } else {
+		call printf ("overplot %b\n")
+		    call pargi (SF_OVRPLT(sf))
+		redraw = NO
+	    }
+	case BETA:
+	    call gargr (rval)
+	    if (nscan() == 2) {
+		SF_BETA(sf) = rval
+		do i = 1, SF_NSFD(sf) {
+		    sfd = SF_SFD(sf,i)
+		    call stf_widths (sf, sfd)
+		    switch (SF_WCODE(sf)) {
+		    case 1:
+			SFD_W(sfd) = SFD_R(sfd)
+		    case 2:
+			SFD_W(sfd) = SFD_DFWHM(sfd)
+		    case 3:
+			SFD_W(sfd) = SFD_GFWHM(sfd)
+		    case 4:
+			SFD_W(sfd) = SFD_MFWHM(sfd)
+		    }
+		    call stf_fwhms (sf, sfd)
+		}
+		call stf_fitfocus (sf) 
+		redraw = YES
+	    } else {
+		call printf ("beta %g\n")
+		    call pargr (SF_BETA(sf))
+		redraw = NO
+	    }
+	default:
+	    call printf ("Unrecognized or ambiguous command\007")
+	    redraw = NO
+	}
+
+	call sfree (sp)
+end
+
+
+# STF_G1 -- Plot of size/ellip vs. focus/mag/radius.
+
+procedure stf_g1 (sf, current, xkey, ykey, title, xlabel, ylabel)
+
+pointer	sf			#I Starfocus pointer
+pointer	current			#I Current sfd pointer
+int	xkey			#I X axis key
+int	ykey			#I Y axis key
+char	title[ARB]		#I Title
+char	xlabel[ARB]		#I X label
+char	ylabel[ARB]		#I Y label
+
+int	i, j
+bool	hl
+real	x, x1, x2, dx, y, y1, y2, dy
+pointer	gp, sff, sfd
+
+begin
+	# Determine data range
+	x1 = MAX_REAL
+	x2 = -MAX_REAL
+	switch (ykey) {
+	case 'r':
+	    y1 = SF_W(sf)
+	    y2 = 1.5 * SF_W(sf)
+	case 'e':
+	    y1 = 0
+	    y2 = 1
+	}
+	do j = 1, SF_NFOCUS(sf) {
+	    sff = SF_SFF(sf,j)
+	    if (xkey != 'f' && sff != SFD_SFF(current))
+		next
+	    do i = 1, SFF_NSFD(sff) {
+		sfd = SFF_SFD(sff,i)
+		if (SFD_STATUS(sfd) == 0) {
+		    switch (xkey) {
+		    case 'f':
+			x = SFD_F(sfd)
+		    case 'm':
+			x = -2.5 * log10 (SFS_M(SFD_SFS(sfd)) / SF_M(sf))
+		    case 't':
+			x = sqrt ((SFD_X(sfd) - SF_XF(sf)) ** 2 +
+			    (SFD_Y(sfd) - SF_YF(sf)) ** 2)
+		    }
+		    switch (ykey) {
+		    case 'r':
+			y = SFD_W(sfd)
+		    case 'e':
+			y = SFD_E(sfd)
+		    }
+		    x1 = min (x1, x)
+		    x2 = max (x2, x)
+		    y1 = min (y1, y)
+		    y2 = max (y2, y)
+		}
+	    }
+	}
+
+	dx = (x2 - x1)
+	dy = (y2 - y1)
+	x1 = x1 - dx * 0.05
+	x2 = x2 + dx * 0.05
+	y1 = y1 - dy * 0.05
+	y2 = y2 + dy * 0.05
+	gp = SF_GP (sf)
+	call gswind (gp, x1, x2, y1, y2)
+	call glabax (gp, title, xlabel, ylabel)
+
+	do j = 1, SF_NFOCUS(sf) {
+	    sff = SF_SFF(sf,j)
+	    if (xkey != 'f' && sff != SFD_SFF(current))
+		next
+	    do i = 1, SFF_NSFD(sff) {
+		sfd = SFF_SFD(sff,i)
+		if (SFD_STATUS(sfd) == 0) {
+		    hl = false
+		    switch (xkey) {
+		    case 'f':
+			x = SFD_F(sfd)
+			#hl = (SFD_SFS(sfd) == SFD_SFS(current))
+		    case 'm':
+			x = -2.5 * log10 (SFS_M(SFD_SFS(sfd)) / SF_M(sf))
+			#hl = (SFD_SFF(sfd) != SFD_SFF(current))
+		    case 't':
+			x = sqrt ((SFD_X(sfd) - SF_XF(sf)) ** 2 +
+			    (SFD_Y(sfd) - SF_YF(sf)) ** 2)
+			#hl = (SFD_SFF(sfd) != SFD_SFF(current))
+		    }
+		    switch (ykey) {
+		    case 'r':
+			y = SFD_W(sfd)
+		    case 'e':
+			y = SFD_E(sfd)
+		    }
+		    if (hl) {
+			call gseti (gp, G_PLCOLOR, HLCOLOR)
+			if (sfd == current)
+			    call gmark (gp, x, y, GM_BOX, 3., 3.)
+			call gmark (gp, x, y, GM_PLUS, 3., 3.)
+			call gseti (gp, G_PLCOLOR, 1)
+		    } else
+			call gmark (gp, x, y, GM_MARK, 2., 2.)
+		}
+	    }
+	}
+
+	call gseti (gp, G_PLTYPE, 2)
+	if (xkey == 'f')
+	    call gline (gp, SF_F(sf), y1, SF_F(sf), y2)
+	if (ykey == 'r')
+	    call gline (gp, x1, SF_W(sf), x2, SF_W(sf))
+	call gseti (gp, G_PLTYPE, 1)
+end
+
+
+# STF_G2 -- Enclosed flux profiles for a given star.
+
+procedure stf_g2 (sf, current, title)
+
+pointer	sf			#I Starfocus pointer
+pointer	current			#I Current sfd pointer
+char	title[ARB]		#I Title
+
+int	i, j, np, np1, nx, ny, ix, iy
+real	vx, dvx, vy, dvy, x1, x2, y1, y2, z, z1, r, r1, r2, dr, fa[10]
+pointer	sp, str, gp, sfs, sfd, asi
+real	stf_i2r(), stf_r2i(), asieval()
+
+begin
+	call smark (sp)
+	call salloc (str, SZ_LINE, TY_CHAR)
+
+	gp = SF_GP(sf)
+	sfs = SFD_SFS(current)
+	np = SFD_NP(current)
+
+	# Set grid layout
+	i = SFS_N(sfs)
+	if (i < 4) {
+	    nx = i
+	    ny = 1
+	} else {
+	    nx = nint (sqrt (real (i)))
+	    if (mod (i-1, nx+1) >= mod (i-1, nx))
+		nx = nx + 1
+	    ny = (i - 1) / nx + 1
+	}
+
+        # Set subview port parameters
+        call ggview (gp, vx, dvx, vy, dvy)
+        dvx = (dvx - vx) / nx
+        dvy = (dvy - vy) / ny
+
+	# Set data window parameters
+	x1 = -0.05
+	x2 = 1.05
+	y1 = -0.15
+	y2 = 1.05
+	call gswind (gp, x1, x2, y1, y2)
+
+	# Set fill area
+        fa[1] = x1; fa[6] = y1
+        fa[2] = x2; fa[7] = y1
+        fa[3] = x2; fa[8] = y2
+        fa[4] = x1; fa[9] = y2
+        fa[5] = x1; fa[10] = y1
+
+	# Draw profiles.
+	j = 0
+	do i = 1, SFS_NSFD(sfs) {
+	    sfd = SFS_SFD(sfs, i)
+	    if (SFD_STATUS(sfd) != 0)
+		next
+	    np1 = SFD_NP(sfd)
+	    ix = 1 + mod (j, nx)
+	    iy = 1 + j / nx
+	    j = j + 1
+	    call gsview (gp, vx+dvx*(ix-1), vx+dvx*ix,
+		vy+dvy*(ny-iy), vy+(ny-iy+1)*dvy)
+	    call gfill (gp, fa, fa[6], 4, GF_SOLID)
+	    call gseti (gp, G_DRAWTICKS, NO)
+	    call glabax (gp, "", "", "")
+	    if (sfd == current) {
+		call gsview (gp, vx+dvx*(ix-1)+.005, vx+dvx*ix-.005,
+		    vy+dvy*(ny-iy)+.005, vy+(ny-iy+1)*dvy-.005)
+		call gsetr (gp, G_PLWIDTH, HLWIDTH)
+		call gseti (gp, G_PLCOLOR, HLCOLOR)
+		call gpline (gp, fa, fa[6], 5)
+		call gsetr (gp, G_PLWIDTH, 1.)
+		call gseti (gp, G_PLCOLOR, 1)
+		call gsview (gp, vx+dvx*(ix-1), vx+dvx*ix,
+		    vy+dvy*(ny-iy), vy+(ny-iy+1)*dvy)
+	    }
+
+	    asi = SFD_ASI1(sfd)
+	    r2 = stf_i2r (real(np))
+	    call gamove (gp, 0., 0.)
+	    for (z = 1.; z <= np1; z = z + 0.1)
+		call gadraw (gp, stf_i2r(z)/r2, asieval(asi,z))
+	    if (SF_OVRPLT(sf) == YES && sfd != SF_BEST(sf)) {
+		call gseti (gp, G_PLCOLOR, HLCOLOR)
+		np1 = SFD_NP(SF_BEST(sf))
+		asi = SFD_ASI1(SF_BEST(sf))
+		r1 = stf_i2r (1.)
+		r2 = stf_i2r (real(np))
+		dr = 0.05 * (r2 - r1)
+		for (r = r1; r <= r2; r = r + dr) {
+		    z = stf_r2i (r)
+		    z1 = stf_r2i (r+0.7*dr)
+		    if (z > 1. && z1 <= np1)
+			call gline (gp, r/r2, asieval(asi,z),
+			    (r+0.7*dr)/r2, asieval(asi,z1))
+		}
+		call gseti (gp, G_PLCOLOR, 1)
+	    }
+
+	    call sprintf (Memc[str], SZ_LINE, "%.3g")
+		call pargr (SFD_W(sfd))
+	    call gtext (gp, 0.95, -0.1, Memc[str], "h=r;v=b")
+	    if (nx < NMAX && ny < NMAX) {
+		call sprintf (Memc[str], SZ_LINE, "%.4g")
+		    call pargr (SFD_F(sfd))
+		call gtext (gp, 0.05, -0.1, Memc[str], "h=l;v=b")
+	    }
+	}
+
+	call gsview (gp, vx, vx+nx*dvx, vy, vy+ny*dvy)
+	call gswind (gp, 0.5, 0.5+nx, 0.5+ny, 0.5)
+	call gamove (gp, 1., 1.)
+
+        # Draw label
+        call gseti (gp, G_DRAWAXES, 0)
+        call glabax (gp, title, "", "")
+        call gseti (gp, G_DRAWAXES, 3)
+
+	call sfree (sp)
+end
+
+
+# STF_G3 -- Enclosed flux profiles for a given focus.
+
+procedure stf_g3 (sf, current, title)
+
+pointer	sf			#I Starfocus pointer
+pointer	current			#I Current sfd pointer
+char	title[ARB]		#I Title
+
+int	i, j, np, np1, nx, ny, ix, iy
+real	vx, dvx, vy, dvy, x1, x2, y1, y2, z, z1, r, r1, r2, dr, fa[10]
+pointer	sp, str, gp, sff, sfd, asi
+real	stf_i2r(), stf_r2i(), asieval()
+
+begin
+	call smark (sp)
+	call salloc (str, SZ_LINE, TY_CHAR)
+
+	gp = SF_GP(sf)
+	sff = SFD_SFF(current)
+	np = SFD_NP(current)
+
+	# Set grid layout
+	i = SFF_N(sff)
+	if (i < 4) {
+	    nx = i
+	    ny = 1
+	} else {
+	    nx = nint (sqrt (real (i)))
+	    if (mod (i-1, nx+1) >= mod (i-1, nx))
+		nx = nx + 1
+	    ny = (i - 1) / nx + 1
+	}
+
+        # Set subview port parameters
+        call ggview (gp, vx, dvx, vy, dvy)
+        dvx = (dvx - vx) / nx
+        dvy = (dvy - vy) / ny
+
+	# Set data window parameters
+	x1 = -0.05
+	x2 = 1.05
+	y1 = -0.2
+	y2 = 1.05
+	call gswind (gp, x1, x2, y1, y2)
+
+	# Set fill area
+        fa[1] = x1; fa[6] = y1
+        fa[2] = x2; fa[7] = y1
+        fa[3] = x2; fa[8] = y2
+        fa[4] = x1; fa[9] = y2
+        fa[5] = x1; fa[10] = y1
+
+	# Draw profiles.
+	j = 0
+	do i = 1, SFF_NSFD(sff) {
+	    sfd = SFF_SFD(sff, i)
+	    if (SFD_STATUS(sfd) != 0)
+		next
+	    np1 = SFD_NP(sfd)
+	    ix = 1 + mod (j, nx)
+	    iy = 1 + j / nx
+	    j = j + 1
+	    call gsview (gp, vx+dvx*(ix-1), vx+dvx*ix,
+		vy+dvy*(ny-iy), vy+(ny-iy+1)*dvy)
+	    call gfill (gp, fa, fa[6], 4, GF_SOLID)
+	    call gseti (gp, G_DRAWTICKS, NO)
+	    call glabax (gp, "", "", "")
+	    if (sfd == current) {
+		call gsview (gp, vx+dvx*(ix-1)+.005, vx+dvx*ix-.005,
+		    vy+dvy*(ny-iy)+.005, vy+(ny-iy+1)*dvy-.005)
+		call gsetr (gp, G_PLWIDTH, HLWIDTH)
+		call gseti (gp, G_PLCOLOR, HLCOLOR)
+		call gpline (gp, fa, fa[6], 5)
+		call gsetr (gp, G_PLWIDTH, 1.)
+		call gseti (gp, G_PLCOLOR, 1)
+		call gsview (gp, vx+dvx*(ix-1), vx+dvx*ix,
+		    vy+dvy*(ny-iy), vy+(ny-iy+1)*dvy)
+	    }
+
+	    asi = SFD_ASI1(sfd)
+	    r2 = stf_i2r (real(np))
+	    call gamove (gp, 0., 0.)
+	    for (z = 1.; z <= np1; z = z + 0.1)
+		call gadraw (gp, stf_i2r(z)/r2, asieval(asi,z))
+	    if (SF_OVRPLT(sf) == YES && sfd != SF_BEST(sf)) {
+		call gseti (gp, G_PLCOLOR, HLCOLOR)
+		np1 = SFD_NP(SF_BEST(sf))
+		asi = SFD_ASI1(SF_BEST(sf))
+		r1 = stf_i2r (1.)
+		r2 = stf_i2r (real(np))
+		dr = 0.05 * (r2 - r1)
+		for (r = r1; r <= r2; r = r + dr) {
+		    z = stf_r2i (r)
+		    z1 = stf_r2i (r+0.7*dr)
+		    if (z > 1. && z1 <= np1)
+			call gline (gp, r/r2, asieval(asi,z),
+			    (r+0.7*dr)/r2, asieval(asi,z1))
+		}
+		call gseti (gp, G_PLCOLOR, 1)
+	    }
+
+	    call sprintf (Memc[str], SZ_LINE, "%.3g")
+		call pargr (SFD_W(sfd))
+	    call gtext (gp, 0.95, -.1, Memc[str], "h=r;v=b")
+	    if (nx < NMAX && ny < NMAX) {
+		call sprintf (Memc[str], SZ_LINE, "%d %d")
+		    call pargr (SFD_X(sfd))
+		    call pargr (SFD_Y(sfd))
+		call gtext (gp, 0.05, -.1, Memc[str], "h=l;v=b")
+	    }
+	}
+
+	call gsview (gp, vx, vx+nx*dvx, vy, vy+ny*dvy)
+	call gswind (gp, 0.5, 0.5+nx, 0.5+ny, 0.5)
+	call gamove (gp, 1., 1.)
+
+        # Draw label
+        call gseti (gp, G_DRAWAXES, 0)
+        call glabax (gp, title, "", "")
+        call gseti (gp, G_DRAWAXES, 3)
+
+	call sfree (sp)
+end
+
+
+# STF_G4 -- Radial profiles (derivative of enclosed flux) for a given star.
+
+procedure stf_g4 (sf, current, title)
+
+pointer	sf			#I Starfocus pointer
+pointer	current			#I Current sfd pointer
+char	title[ARB]		#I Title
+
+int	i, j, np, np1, nx, ny, ix, iy
+real	vx, dvx, vy, dvy, x1, x2, y1, y2, z, z1, r, r1, r2, dr, rmax, fa[10]
+pointer	sp, str, gp, sfs, sfd, asi
+real	stf_i2r(), stf_r2i(), asieval()
+
+begin
+	call smark (sp)
+	call salloc (str, SZ_LINE, TY_CHAR)
+
+	gp = SF_GP(sf)
+	sfs = SFD_SFS(current)
+	np = SFD_NP(current)
+
+	# Set grid layout
+	i = SFS_N(sfs)
+	if (i < 4) {
+	    nx = i
+	    ny = 1
+	} else {
+	    nx = nint (sqrt (real (i)))
+	    if (mod (i-1, nx+1) >= mod (i-1, nx))
+		nx = nx + 1
+	    ny = (i - 1) / nx + 1
+	}
+
+        # Set subview port parameters
+        call ggview (gp, vx, dvx, vy, dvy)
+        dvx = (dvx - vx) / nx
+        dvy = (dvy - vy) / ny
+
+	# Set data window parameters
+	x1 = -0.05
+	x2 = 1.05
+	z = SF_YP2(sf) - SF_YP1(sf)
+	y1 = SF_YP1(sf) - 0.05 * z
+	y2 = SF_YP2(sf) + 0.15 * z
+
+	# Set fill area
+        fa[1] = x1; fa[6] = y1
+        fa[2] = x2; fa[7] = y1
+        fa[3] = x2; fa[8] = y2
+        fa[4] = x1; fa[9] = y2
+        fa[5] = x1; fa[10] = y1
+
+	# Draw profiles.
+	j = 0
+	do i = 1, SFS_NSFD(sfs) {
+	    sfd = SFS_SFD(sfs, i)
+	    if (SFD_STATUS(sfd) != 0)
+		next
+	    np1 = SFD_NP(sfd)
+	    ix = 1 + mod (j, nx)
+	    iy = 1 + j / nx
+	    j = j + 1
+	    call gsview (gp, vx+dvx*(ix-1), vx+dvx*ix,
+		vy+dvy*(ny-iy), vy+(ny-iy+1)*dvy)
+	    call gswind (gp, x1, x2, y1, y2)
+	    call gfill (gp, fa, fa[6], 4, GF_SOLID)
+	    call gseti (gp, G_DRAWTICKS, NO)
+	    call glabax (gp, "", "", "")
+	    if (sfd == current) {
+		call gsview (gp, vx+dvx*(ix-1)+.005, vx+dvx*ix-.005,
+		    vy+dvy*(ny-iy)+.005, vy+(ny-iy+1)*dvy-.005)
+		call gsetr (gp, G_PLWIDTH, HLWIDTH)
+		call gseti (gp, G_PLCOLOR, HLCOLOR)
+		call gpline (gp, fa, fa[6], 5)
+		call gsetr (gp, G_PLWIDTH, 1.)
+		call gseti (gp, G_PLCOLOR, 1)
+		call gsview (gp, vx+dvx*(ix-1), vx+dvx*ix,
+		    vy+dvy*(ny-iy), vy+(ny-iy+1)*dvy)
+	    }
+
+	    asi = SFD_ASI2(sfd)
+	    rmax = stf_i2r (real(np))
+	    z = SF_XP1(sf)
+	    call gamove (gp, stf_i2r(z)/rmax, asieval(asi,z))
+	    for (; z <= SF_XP2(sf); z = z + 0.1)
+		call gadraw (gp, stf_i2r(z)/rmax, asieval(asi,z))
+	    if (SF_OVRPLT(sf) == YES && sfd != SF_BEST(sf)) {
+		call gseti (gp, G_PLCOLOR, HLCOLOR)
+		np1 = SFD_NP(SF_BEST(sf))
+		asi = SFD_ASI2(SF_BEST(sf))
+		rmax = stf_i2r (real(np))
+		r1 = stf_i2r (SF_XP1(sf))
+		r2 = stf_i2r (SF_XP2(sf))
+		dr = 0.05 * (rmax - stf_i2r(1.))
+		for (r = r1; r <= r2; r = r + dr) {
+		    z = stf_r2i (r)
+		    z1 = stf_r2i (r+0.7*dr)
+		    if (z > 1. && z1 <= np1)
+			call gline (gp, r/rmax, asieval(asi,z),
+			    (r+0.7*dr)/rmax, asieval(asi,z1))
+		}
+		call gseti (gp, G_PLCOLOR, 1)
+	    }
+
+	    call gswind (gp, 0., 1., 0., 1.)
+	    call sprintf (Memc[str], SZ_LINE, "%.3g")
+		call pargr (SFD_W(sfd))
+	    call gtext (gp, 0.95, 0.98, Memc[str], "h=r;v=t")
+	    if (nx < NMAX && ny < NMAX) {
+		call sprintf (Memc[str], SZ_LINE, "%.4g")
+		    call pargr (SFD_F(sfd))
+		call gtext (gp, 0.05, 0.98, Memc[str], "h=l;v=t")
+	    }
+	}
+
+	call gsview (gp, vx, vx+nx*dvx, vy, vy+ny*dvy)
+	call gswind (gp, 0.5, 0.5+nx, 0.5+ny, 0.5)
+	call gamove (gp, 1., 1.)
+
+        # Draw label
+        call gseti (gp, G_DRAWAXES, 0)
+        call glabax (gp, title, "", "")
+        call gseti (gp, G_DRAWAXES, 3)
+
+	call sfree (sp)
+end
+
+
+# STF_G5 -- Radial profiles (derivative of enclosed flux) for a given focus.
+
+procedure stf_g5 (sf, current, title)
+
+pointer	sf			#I Starfocus pointer
+pointer	current			#I Current sfd pointer
+char	title[ARB]		#I Title
+
+int	i, j, np, np1, nx, ny, ix, iy
+real	vx, dvx, vy, dvy, x1, x2, y1, y2, z, z1, r, r1, r2, dr, rmax, fa[10]
+pointer	sp, str, gp, sff, sfd, asi
+real	stf_i2r(), stf_r2i(), asieval()
+
+begin
+	call smark (sp)
+	call salloc (str, SZ_LINE, TY_CHAR)
+
+	gp = SF_GP(sf)
+	sff = SFD_SFF(current)
+	np = SFD_NP(current)
+
+	# Set grid layout
+	i = SFF_N(sff)
+	if (i < 4) {
+	    nx = i
+	    ny = 1
+	} else {
+	    nx = nint (sqrt (real (i)))
+	    if (mod (i-1, nx+1) >= mod (i-1, nx))
+		nx = nx + 1
+	    ny = (i - 1) / nx + 1
+	}
+
+        # Set subview port parameters
+        call ggview (gp, vx, dvx, vy, dvy)
+        dvx = (dvx - vx) / nx
+        dvy = (dvy - vy) / ny
+
+	# Set data window parameters
+	x1 = -0.05
+	x2 = 1.05
+	z = SF_YP2(sf) - SF_YP1(sf)
+	y1 = SF_YP1(sf) - 0.05 * z
+	y2 = SF_YP2(sf) + 0.15 * z
+
+	# Set fill area
+        fa[1] = x1; fa[6] = y1
+        fa[2] = x2; fa[7] = y1
+        fa[3] = x2; fa[8] = y2
+        fa[4] = x1; fa[9] = y2
+        fa[5] = x1; fa[10] = y1
+
+	# Draw profiles.
+	j = 0
+	do i = 1, SFF_NSFD(sff) {
+	    sfd = SFF_SFD(sff, i)
+	    if (SFD_STATUS(sfd) != 0)
+		next
+	    np1 = SFD_NP(sfd)
+	    ix = 1 + mod (j, nx)
+	    iy = 1 + j / nx
+	    j = j + 1
+	    call gsview (gp, vx+dvx*(ix-1), vx+dvx*ix,
+		vy+dvy*(ny-iy), vy+(ny-iy+1)*dvy)
+	    call gswind (gp, x1, x2, y1, y2)
+	    call gfill (gp, fa, fa[6], 4, GF_SOLID)
+	    call gseti (gp, G_DRAWTICKS, NO)
+	    call glabax (gp, "", "", "")
+	    if (sfd == current) {
+		call gsview (gp, vx+dvx*(ix-1)+.005, vx+dvx*ix-.005,
+		    vy+dvy*(ny-iy)+.005, vy+(ny-iy+1)*dvy-.005)
+		call gsetr (gp, G_PLWIDTH, HLWIDTH)
+		call gseti (gp, G_PLCOLOR, HLCOLOR)
+		call gpline (gp, fa, fa[6], 5)
+		call gsetr (gp, G_PLWIDTH, 1.)
+		call gseti (gp, G_PLCOLOR, 1)
+		call gsview (gp, vx+dvx*(ix-1), vx+dvx*ix,
+		    vy+dvy*(ny-iy), vy+(ny-iy+1)*dvy)
+	    }
+
+	    asi = SFD_ASI2(sfd)
+	    rmax = stf_i2r (real(np))
+	    z = SF_XP1(sf)
+	    call gamove (gp, stf_i2r(z)/rmax, asieval(asi,z))
+	    for (; z <= SF_XP2(sf); z = z + 0.1)
+		call gadraw (gp, stf_i2r(z)/rmax, asieval(asi,z))
+	    if (SF_OVRPLT(sf) == YES && sfd != SF_BEST(sf)) {
+		call gseti (gp, G_PLCOLOR, HLCOLOR)
+		np1 = SFD_NP(SF_BEST(sf))
+		asi = SFD_ASI2(SF_BEST(sf))
+		rmax = stf_i2r (real(np))
+		r1 = stf_i2r (SF_XP1(sf))
+		r2 = stf_i2r (SF_XP2(sf))
+		dr = 0.05 * (rmax - stf_i2r (1.))
+		for (r = r1; r <= r2; r = r + dr) {
+		    z = stf_r2i (r)
+		    z1 = stf_r2i (r+0.7*dr)
+		    if (z > 1. && z1 <= np1)
+			call gline (gp, r/rmax, asieval(asi,z),
+			    (r+0.7*dr)/rmax, asieval(asi,z1))
+		}
+		call gseti (gp, G_PLCOLOR, 1)
+	    }
+
+	    call gswind (gp, 0., 1., 0., 1.)
+	    call sprintf (Memc[str], SZ_LINE, "%.3g")
+		call pargr (SFD_W(sfd))
+	    call gtext (gp, 0.95, 0.98, Memc[str], "h=r;v=t")
+	    if (nx < NMAX && ny < NMAX) {
+		call sprintf (Memc[str], SZ_LINE, "%d %d")
+		    call pargr (SFD_X(sfd))
+		    call pargr (SFD_Y(sfd))
+		call gtext (gp, 0.05, 0.98, Memc[str], "h=l;v=t")
+	    }
+	}
+
+	call gsview (gp, vx, vx+nx*dvx, vy, vy+ny*dvy)
+	call gswind (gp, 0.5, 0.5+nx, 0.5+ny, 0.5)
+	call gamove (gp, 1., 1.)
+
+        # Draw label
+        call gseti (gp, G_DRAWAXES, 0)
+        call glabax (gp, title, "", "")
+        call gseti (gp, G_DRAWAXES, 3)
+
+	call sfree (sp)
+end
+
+
+# STF_G6 -- Enclosed flux profile of a star.
+
+procedure stf_g6 (sf, current, title, xlabel, ylabel)
+
+pointer	sf			#I Starfocus pointer
+pointer	current			#I Star pointer
+char	title[ARB]		#I Title
+char	xlabel[ARB]		#I X label
+char	ylabel[ARB]		#I Y label
+
+int	np, np1
+real	scale, level, radius, flux, profile
+pointer	gp, asi
+
+real	x1, x2, y1, y2, z, z1, r, r1, r2, dr
+real	stf_i2r(), stf_r2i(), asieval()
+
+begin
+	gp = SF_GP(sf)
+	level = SF_LEVEL(sf)
+	scale = SF_SCALE(sf)
+	np = SFD_NP(current)
+	asi = SFD_ASI1(current)
+
+	x1 = -0.5 * scale
+	x2 = (stf_i2r (real(np)) + 0.5) * scale
+	y1 = -0.05
+	y2 = 1.05
+	call gswind (gp, x1, x2, y1, y2)
+
+        call gseti (gp, G_DRAWTICKS, YES)
+	call gseti (gp, G_XNMAJOR, 6)
+	call gseti (gp, G_XNMINOR, 4)
+	call gseti (gp, G_YNMAJOR, 6)
+	call gseti (gp, G_YNMINOR, 4)
+	call glabax (gp, title, xlabel, ylabel)
+
+	# Draw profiles.
+	if (SFD_STATUS(current) == 0) {
+	    call gseti (gp, G_PLCOLOR, 1)
+	    for (z = 1.; z <= np; z = z + 1)
+		call gmark (gp, stf_i2r(z)*scale, asieval(asi,z),
+		    GM_PLUS, 2., 2.)
+	    call gamove (gp, 0., 0.)
+	    for (z = 1.; z <= np; z = z + 0.1)
+		call gadraw (gp, stf_i2r(z)*scale, asieval(asi,z))
+	    switch (SF_WCODE(sf)) {
+	    case 1:
+		radius = SFD_W(current)
+		call gseti (gp, G_PLTYPE, 2)
+		call gline (gp, x1, level, radius, level)
+		call gline (gp, radius, level, radius, y1)
+		call gseti (gp, G_PLTYPE, 1)
+	    default:
+		radius = SFD_W(current) / 2.
+		call gseti (gp, G_PLTYPE, 2)
+		call gline (gp, radius, y1, radius, y2)
+		call gseti (gp, G_PLTYPE, 1)
+	    }
+
+	    call gseti (gp, G_PLCOLOR, HLCOLOR)
+	    call stf_model (sf, current, 0., profile, flux)
+	    call gamove (gp, 0., flux)
+	    for (z = 1.; z <= np; z = z + 0.1) {
+		r = stf_i2r(z) * scale
+		call stf_model (sf, current, r, profile, flux)
+		call gadraw (gp, r, flux)
+	    }
+	    call gseti (gp, G_PLCOLOR, 1)
+	    if (SF_OVRPLT(sf) == YES && current != SF_BEST(sf)) {
+		call gseti (gp, G_PLCOLOR, HLCOLOR)
+		np1 = SFD_NP(SF_BEST(sf))
+		asi = SFD_ASI1(SF_BEST(sf))
+		r1 = stf_i2r(1.)
+		r2 = stf_i2r (real(np))
+		dr = 0.05 * (r2 - r1)
+		for (r = r1; r <= r2; r = r + dr) {
+		    z = stf_r2i (r)
+		    z1 = stf_r2i (r+0.7*dr)
+		    if (z > 1. && z1 <= np1)
+			call gline (gp, r*scale, asieval(asi,z),
+			    (r+0.7*dr)*scale, asieval(asi,z1))
+		}
+		call gseti (gp, G_PLCOLOR, 1)
+	    }
+	}
+end
+
+
+# STF_G7 -- Radial profile (derivative of enclosed flux) for a star.
+
+procedure stf_g7 (sf, current, title, xlabel, ylabel)
+
+pointer	sf			#I Starfocus pointer
+pointer	current			#I Star pointer
+char	title[ARB]		#I Title
+char	xlabel[ARB]		#I X label
+char	ylabel[ARB]		#I Y label
+
+int	np, np1
+real	scale, level, radius, profile, flux
+pointer	gp, asi
+
+real	x1, x2, y1, y2, z, z1, r, r1, r2, dr
+real	stf_i2r(), stf_r2i(), asieval()
+
+begin
+	gp = SF_GP(sf)
+	level = SF_LEVEL(sf)
+	scale = SF_SCALE(sf)
+	np = SFD_NP(current)
+	asi = SFD_ASI2(current)
+
+	x1 = -0.5 * scale
+	x2 = (stf_i2r (real(np)) + 0.5) * scale
+	z = SFD_YP2(current) - SFD_YP1(current)
+	y1 = SFD_YP1(current) - 0.05 * z
+	y2 = SFD_YP2(current) + 0.05 * z
+	call gswind (gp, x1, x2, y1, y2)
+
+        call gseti (gp, G_XDRAWTICKS, YES)
+        call gseti (gp, G_YDRAWTICKS, NO)
+	call gseti (gp, G_XNMAJOR, 6)
+	call gseti (gp, G_XNMINOR, 4)
+	call gseti (gp, G_YNMAJOR, 6)
+	call gseti (gp, G_YNMINOR, 4)
+	call glabax (gp, title, xlabel, ylabel)
+
+	# Draw profile
+	call gseti (gp, G_PLCOLOR, 1)
+	for (z = SF_XP1(sf); z <= SF_XP2(sf); z = z + 1)
+	    call gmark (gp, stf_i2r(z)*scale, asieval(asi,z),
+		GM_PLUS, 2., 2.)
+	z = SF_XP1(sf)
+	call gamove (gp, stf_i2r(z)*scale, asieval(asi,z))
+	for (; z <= SF_XP2(sf); z = z + 0.1)
+	    call gadraw (gp, stf_i2r (z)*scale, asieval(asi,z))
+
+	switch (SF_WCODE(sf)) {
+	case 1:
+	    radius = SFD_W(current)
+	default:
+	    radius = SFD_W(current) / 2.
+	}
+	call gseti (gp, G_PLTYPE, 2)
+	call gline (gp, radius, y1, radius, y2)
+	call gseti (gp, G_PLTYPE, 1)
+
+	call gseti (gp, G_PLCOLOR, HLCOLOR)
+	z = SF_XP1(sf)
+	r = stf_i2r(z) * scale
+	call stf_model (sf, current, r, profile, flux)
+	call gamove (gp, r, profile)
+	for (; z <= np; z = z + 0.1) {
+	    r = stf_i2r(z) * scale
+	    call stf_model (sf, current, r, profile, flux)
+	    call gadraw (gp, r, profile)
+	}
+	call gseti (gp, G_PLCOLOR, 1)
+	if (SF_OVRPLT(sf) == YES && current != SF_BEST(sf)) {
+	    call gseti (gp, G_PLCOLOR, HLCOLOR)
+	    np1 = SFD_NP(SF_BEST(sf))
+	    asi = SFD_ASI2(SF_BEST(sf))
+	    r1 = stf_i2r (SF_XP1(sf))
+	    r2 = stf_i2r (SF_XP2(sf))
+	    dr = 0.05 * (r2 - r1)
+	    for (r = r1; r <= r2; r = r + dr) {
+		z = stf_r2i (r)
+		z1 = stf_r2i (r+0.7*dr)
+		if (z > 1. && z1 <= np1)
+		    call gline (gp, r*scale, asieval(asi,z),
+			(r+0.7*dr)*scale, asieval(asi,z1))
+	    }
+	    call gseti (gp, G_PLCOLOR, 1)
+	}
+end
+
+
+# STF_G8 -- FWHM vs level.
+
+procedure stf_g8 (sf, current, title, xlabel, ylabel)
+
+pointer	sf			#I Starfocus pointer
+pointer	current			#I Star pointer
+char	title[ARB]		#I Title
+char	xlabel[ARB]		#I X label
+char	ylabel[ARB]		#I Y label
+
+real	y1, y2, level, fwhm
+pointer	gp
+
+begin
+	level = SF_LEVEL(sf)
+	if (SF_WCODE(sf) == 1)
+	    fwhm = SFD_MFWHM(current)
+	else
+	    fwhm = SFD_W(current)
+
+	call alimr (SFD_FWHM(current,2), 17, y1, y2)
+	y2 = y2 - y1
+	y1 = y1 - 0.05 * y2
+	y2 = y1 + 1.10 * y2
+	y1 = min (y1, 0.9 * fwhm)
+	y2 = max (y2, 1.1 * fwhm)
+
+	gp = SF_GP(sf)
+        call gseti (gp, G_DRAWTICKS, YES)
+	call gseti (gp, G_XNMAJOR, 6)
+	call gseti (gp, G_XNMINOR, 4)
+	call gseti (gp, G_YNMAJOR, 6)
+	call gseti (gp, G_YNMINOR, 4)
+	call gswind (gp, 0., 1., y1, y2)
+	call glabax (gp, title, xlabel, ylabel)
+	call gvline (gp, SFD_FWHM(current,2), 17, 0.1, 0.9)
+	call gvmark (gp, SFD_FWHM(current,2), 17, 0.1, 0.9, GM_PLUS, 2., 2.)
+
+	switch (SF_WCODE(sf)) {
+	case 1:
+	    call gseti (gp, G_PLTYPE, 2)
+	    call gline (gp, 0., fwhm, level, fwhm)
+	    call gline (gp, level, y1, level, fwhm)
+	    call gseti (gp, G_PLTYPE, 1)
+	default:
+	    call gseti (gp, G_PLTYPE, 2)
+	    call gline (gp, 0., fwhm, 1., fwhm)
+	    call gseti (gp, G_PLTYPE, 1)
+	}
+end
+
+
+# STF_G9 -- FWHM vs level for a given star.
+
+procedure stf_g9 (sf, current, title)
+
+pointer	sf			#I Starfocus pointer
+pointer	current			#I Current sfd pointer
+char	title[ARB]		#I Title
+
+int	i, j, nx, ny, ix, iy
+real	level, fwhm, vx, dvx, vy, dvy, x1, x2, y1, y2, fa[10]
+pointer	sp, str, gp, sfs, sfd
+
+begin
+	call smark (sp)
+	call salloc (str, SZ_LINE, TY_CHAR)
+
+	gp = SF_GP(sf)
+	sfs = SFD_SFS(current)
+	level = SF_LEVEL(sf)
+	if (SF_WCODE(sf) == 1)
+	    fwhm = SFD_MFWHM(current)
+	else
+	    fwhm = SFD_W(current)
+
+	# Set grid layout
+	i = SFS_N(sfs)
+	if (i < 4) {
+	    nx = i
+	    ny = 1
+	} else {
+	    nx = nint (sqrt (real (i)))
+	    if (mod (i-1, nx+1) >= mod (i-1, nx))
+		nx = nx + 1
+	    ny = (i - 1) / nx + 1
+	}
+
+        # Set subview port parameters
+        call ggview (gp, vx, dvx, vy, dvy)
+        dvx = (dvx - vx) / nx
+        dvy = (dvy - vy) / ny
+
+	# Set data window parameters
+	y1 = 0.9 * fwhm
+	y2 = 1.1 * fwhm
+	do i = 1, SFS_NSFD(sfs) {
+	    sfd = SFS_SFD(sfs,i)
+	    if (SFD_STATUS(sfd) != 0)
+		next
+	    call alimr (SFD_FWHM(sfd,2), 17, x1, x2)
+	    x2 = x2 - x1
+	    x1 = x1 - 0.05 * x2
+	    x2 = x1 + 1.10 * x2
+	    y1 = min (x1, y1)
+	    y2 = max (x2, y2)
+	}
+	x2 = y2 - y1
+	y1 = min (y1, fwhm - 0.2 * x2)
+	y2 = max (y2, fwhm + 0.2 * x2)
+	x1 = 0.
+	x2 = 1.
+	call gswind (gp, x1, x2, y1, y2)
+
+	# Set fill area
+        fa[1] = x1; fa[6] = y1
+        fa[2] = x2; fa[7] = y1
+        fa[3] = x2; fa[8] = y2
+        fa[4] = x1; fa[9] = y2
+        fa[5] = x1; fa[10] = y1
+
+	# Draw profiles.
+	j = 0
+	do i = 1, SFS_NSFD(sfs) {
+	    sfd = SFS_SFD(sfs, i)
+	    if (SFD_STATUS(sfd) != 0)
+		next
+	    ix = 1 + mod (j, nx)
+	    iy = 1 + j / nx
+	    j = j + 1
+	    call gsview (gp, vx+dvx*(ix-1), vx+dvx*ix,
+		vy+dvy*(ny-iy), vy+(ny-iy+1)*dvy)
+	    call gfill (gp, fa, fa[6], 4, GF_SOLID)
+	    call gseti (gp, G_DRAWTICKS, NO)
+	    call glabax (gp, "", "", "")
+	    if (sfd == current) {
+		call gsview (gp, vx+dvx*(ix-1)+.005, vx+dvx*ix-.005,
+		    vy+dvy*(ny-iy)+.005, vy+(ny-iy+1)*dvy-.005)
+		call gsetr (gp, G_PLWIDTH, HLWIDTH)
+		call gseti (gp, G_PLCOLOR, HLCOLOR)
+		call gpline (gp, fa, fa[6], 5)
+		call gsetr (gp, G_PLWIDTH, 1.)
+		call gseti (gp, G_PLCOLOR, 1)
+		call gsview (gp, vx+dvx*(ix-1), vx+dvx*ix,
+		    vy+dvy*(ny-iy), vy+(ny-iy+1)*dvy)
+	    }
+
+	    call gvline (gp, SFD_FWHM(sfd,2), 17, 0.1, 0.9)
+	    #call gseti (gp, G_PLTYPE, 2)
+	    #call gline (gp, x1, fwhm, x2, fwhm)
+	    #call gseti (gp, G_PLTYPE, 1)
+
+	    call sprintf (Memc[str], SZ_LINE, "%.3g")
+		call pargr (SFD_W(sfd))
+	    call gtext (gp, 0.95, 0.95*y2+0.05*y1, Memc[str], "h=r;v=t")
+	    if (nx < NMAX && ny < NMAX) {
+		call sprintf (Memc[str], SZ_LINE, "%.4g")
+		    call pargr (SFD_F(sfd))
+		call gtext (gp, 0.05, 0.95*y2+0.05*y1, Memc[str], "h=l;v=t")
+	    }
+	}
+
+	call gsview (gp, vx, vx+nx*dvx, vy, vy+ny*dvy)
+	call gswind (gp, 0.5, 0.5+nx, 0.5+ny, 0.5)
+	call gamove (gp, 1., 1.)
+
+        # Draw label
+        call gseti (gp, G_DRAWAXES, 0)
+        call glabax (gp, title, "", "")
+        call gseti (gp, G_DRAWAXES, 3)
+
+	call sfree (sp)
+end
+
+
+# STF_G10 -- FWHM vs level for a given focus.
+
+procedure stf_g10 (sf, current, title)
+
+pointer	sf			#I Starfocus pointer
+pointer	current			#I Current sfd pointer
+char	title[ARB]		#I Title
+
+int	i, j, nx, ny, ix, iy
+real	level, fwhm, vx, dvx, vy, dvy, x1, x2, y1, y2, fa[10]
+pointer	sp, str, gp, sff, sfd
+
+begin
+	call smark (sp)
+	call salloc (str, SZ_LINE, TY_CHAR)
+
+	gp = SF_GP(sf)
+	sff = SFD_SFF(current)
+	level = SF_LEVEL(sf)
+	if (SF_WCODE(sf) == 1)
+	    fwhm = SFD_MFWHM(current)
+	else
+	    fwhm = SFD_W(current)
+
+	# Set grid layout
+	i = SFF_N(sff)
+	if (i < 4) {
+	    nx = i
+	    ny = 1
+	} else {
+	    nx = nint (sqrt (real (i)))
+	    if (mod (i-1, nx+1) >= mod (i-1, nx))
+		nx = nx + 1
+	    ny = (i - 1) / nx + 1
+	}
+
+        # Set subview port parameters
+        call ggview (gp, vx, dvx, vy, dvy)
+        dvx = (dvx - vx) / nx
+        dvy = (dvy - vy) / ny
+
+	# Set data window parameters
+	y1 = 0.9 * fwhm
+	y2 = 1.1 * fwhm
+	do i = 1, SFF_NSFD(sff) {
+	    sfd = SFF_SFD(sff,i)
+	    if (SFD_STATUS(sfd) != 0)
+		next
+	    call alimr (SFD_FWHM(sfd,2), 17, x1, x2)
+	    x2 = x2 - x1
+	    x1 = x1 - 0.05 * x2
+	    x2 = x1 + 1.10 * x2
+	    y1 = min (x1, y1)
+	    y2 = max (x2, y2)
+	}
+	x2 = y2 - y1
+	y1 = min (y1, fwhm - 0.2 * x2)
+	y2 = max (y2, fwhm + 0.2 * x2)
+	x1 = 0.
+	x2 = 1.
+	call gswind (gp, x1, x2, y1, y2)
+
+	# Set fill area
+        fa[1] = x1; fa[6] = y1
+        fa[2] = x2; fa[7] = y1
+        fa[3] = x2; fa[8] = y2
+        fa[4] = x1; fa[9] = y2
+        fa[5] = x1; fa[10] = y1
+
+	# Draw plots.
+	j = 0
+	do i = 1, SFF_NSFD(sff) {
+	    sfd = SFF_SFD(sff, i)
+	    if (SFD_STATUS(sfd) != 0)
+		next
+	    ix = 1 + mod (j, nx)
+	    iy = 1 + j / nx
+	    j = j + 1
+	    call gsview (gp, vx+dvx*(ix-1), vx+dvx*ix,
+		vy+dvy*(ny-iy), vy+(ny-iy+1)*dvy)
+	    call gfill (gp, fa, fa[6], 4, GF_SOLID)
+	    call gseti (gp, G_DRAWTICKS, NO)
+	    call glabax (gp, "", "", "")
+	    if (sfd == current) {
+		call gsview (gp, vx+dvx*(ix-1)+.005, vx+dvx*ix-.005,
+		    vy+dvy*(ny-iy)+.005, vy+(ny-iy+1)*dvy-.005)
+		call gsetr (gp, G_PLWIDTH, HLWIDTH)
+		call gseti (gp, G_PLCOLOR, HLCOLOR)
+		call gpline (gp, fa, fa[6], 5)
+		call gsetr (gp, G_PLWIDTH, 1.)
+		call gseti (gp, G_PLCOLOR, 1)
+		call gsview (gp, vx+dvx*(ix-1), vx+dvx*ix,
+		    vy+dvy*(ny-iy), vy+(ny-iy+1)*dvy)
+	    }
+
+	    call gvline (gp, SFD_FWHM(sfd,2), 17, 0.1, 0.9)
+	    #call gseti (gp, G_PLTYPE, 2)
+	    #call gline (gp, x1, fwhm, x2, fwhm)
+	    #call gseti (gp, G_PLTYPE, 1)
+
+	    call sprintf (Memc[str], SZ_LINE, "%.3g")
+		call pargr (SFD_W(sfd))
+	    call gtext (gp, 0.95, 0.95*y2+0.05*y1, Memc[str], "h=r;v=t")
+	    if (nx < NMAX && ny < NMAX) {
+		call sprintf (Memc[str], SZ_LINE, "%d %d")
+		    call pargr (SFD_X(sfd))
+		    call pargr (SFD_Y(sfd))
+		call gtext (gp, 0.05, 0.95*y2+0.05*y1, Memc[str], "h=l;v=t")
+	    }
+	}
+
+	call gsview (gp, vx, vx+nx*dvx, vy, vy+ny*dvy)
+	call gswind (gp, 0.5, 0.5+nx, 0.5+ny, 0.5)
+	call gamove (gp, 1., 1.)
+
+        # Draw label
+        call gseti (gp, G_DRAWAXES, 0)
+        call glabax (gp, title, "", "")
+        call gseti (gp, G_DRAWAXES, 3)
+
+	call sfree (sp)
+end
+
+
+# STF_G11 -- Spatial plot at one focus.
+
+procedure stf_g11 (sf, current, key, title)
+
+pointer	sf			#I Starfocus pointer
+pointer	current			#I Current sfd pointer
+int	key			#I Plot magnitude symbol?
+char	title[ARB]		#I Title
+
+int	i
+real	x, y, z, x1, x2, y1, y2, rbest, rmin, rmax, emin, emax
+real	vx[3,2], vy[3,2], dvx, dvy, fa[8]
+pointer	gp, sfd, sff
+
+data	fa/0.,1.,1.,0.,0.,0.,1.,1./
+
+begin
+	gp = SF_GP(sf)
+	sff = SFD_SFF(current)
+
+	# Range of X, Y, R, E.
+	x1 = 1.
+	y1 = 1.
+	x2 = SF_NCOLS(sf)
+	y2 = SF_NLINES(sf)
+
+	rbest = SFD_W(SF_BEST(sf))
+	rmin = SF_W(sf)
+	rmax = 1.5 * SF_W(sf)
+	emin = 0
+	emax = 1
+	do i = 1, SFF_NSFD(sff) {
+	    sfd = SFF_SFD(sff,i)
+	    if (SFD_STATUS(sfd) != 0)
+		next
+	    rmin = min (rmin, SFD_W(sfd))
+	    rmax = max (rmax, SFD_W(sfd))
+	    emin = min (emin, SFD_E(sfd))
+	    emax = max (emax, SFD_E(sfd))
+	}
+	z = rmax - rmin
+	rmin = rmin - 0.1 * z
+	rmax = rmax + 0.1 * z
+
+	# Set view ports
+	call ggview (gp, vx[1,1], vx[3,2], vy[1,1], vy[3,2])
+	dvx = vx[3,2] - vx[1,1]
+	dvy = vy[3,2] - vy[1,1]
+	vx[1,1] = vx[1,1] + 0.00 * dvx
+	vx[1,2] = vx[1,1] + 0.20 * dvx
+	vx[2,1] = vx[1,1] + 0.25 * dvx
+	vx[2,2] = vx[1,1] + 0.75 * dvx
+	vx[3,1] = vx[1,1] + 0.80 * dvx
+	vx[3,2] = vx[1,1] + 1.00 * dvx
+	vy[1,1] = vy[1,1] + 0.00 * dvy
+	vy[1,2] = vy[1,1] + 0.20 * dvy
+	vy[2,1] = vy[1,1] + 0.25 * dvy
+	vy[2,2] = vy[1,1] + 0.75 * dvy
+	vy[3,1] = vy[1,1] + 0.80 * dvy
+	vy[3,2] = vy[1,1] + 1.00 * dvy
+
+	# (X,R)
+	call gseti (gp, G_WCS, 2)
+	call gseti (gp, G_DRAWAXES, 3)
+	call gseti (gp, G_XLABELTICKS, YES)
+	call gseti (gp, G_YLABELTICKS, YES)
+	call gseti (gp, G_XNMAJOR, 6)
+	call gseti (gp, G_XNMINOR, 4)
+	call gseti (gp, G_YNMAJOR, 4)
+	call gseti (gp, G_YNMINOR, 0)
+	call gsview (gp, vx[2,1], vx[2,2], vy[1,1], vy[1,2])
+	call gswind (gp, 0., 1., 0., 1.)
+	call gfill (gp, fa, fa[5], 4, GF_SOLID)
+
+	call gswind (gp, x1, x2, rmin, rmax)
+	call glabax (gp, "", "Column", "")
+
+	do i = 1, SFF_NSFD(sff) {
+	    sfd = SFF_SFD(sff,i)
+	    if (SFD_STATUS(sfd) != 0)
+		next
+	    x = SFD_X(sfd)
+	    y = SFD_W(sfd)
+	    if (key == 1) {
+		z = sqrt (SFS_M(SFD_SFS(sfd)) / SF_M(sf))
+		z = max (0.005, 0.03 * z)
+		call gmark (gp, x, y, GM_MAG, z, z)
+	    }
+	    if (SFD_W(sfd) < SF_W(sf))
+		call gseti (gp, G_PLCOLOR, 2)
+	    else
+		call gseti (gp, G_PLCOLOR, 3)
+	    z = min (2., SFD_W(sfd) / rbest)
+	    z = 0.010 * (1 + (z - 1) * 5)
+	    call gmark (gp, x, y, GM_CIRCLE, z, z)
+	    call gseti (gp, G_PLCOLOR, 1)
+	}
+
+	call gseti (gp, G_PLTYPE, 2)
+	call gline (gp, x1, SF_W(sf), x2, SF_W(sf))
+	call gseti (gp, G_PLTYPE, 1)
+
+	# (R,Y)
+	call gseti (gp, G_WCS, 3)
+	call gseti (gp, G_XLABELTICKS, YES)
+	call gseti (gp, G_YLABELTICKS, YES)
+	call gseti (gp, G_XNMAJOR, 4)
+	call gseti (gp, G_XNMINOR, 0)
+	call gseti (gp, G_YNMAJOR, 6)
+	call gseti (gp, G_YNMINOR, 4)
+	call gsview (gp, vx[1,1], vx[1,2], vy[2,1], vy[2,2])
+	call gswind (gp, 0., 1., 0., 1.)
+	call gfill (gp, fa, fa[5], 4, GF_SOLID)
+
+	call gswind (gp, rmin, rmax, y1, y2)
+	call glabax (gp, "", SF_WTYPE(sf), "Line")
+
+	do i = 1, SFF_NSFD(sff) {
+	    sfd = SFF_SFD(sff,i)
+	    if (SFD_STATUS(sfd) != 0)
+		next
+	    x = SFD_W(sfd)
+	    y = SFD_Y(sfd)
+	    if (key == 1) {
+		z = sqrt (SFS_M(SFD_SFS(sfd)) / SF_M(sf))
+		z = max (0.005, 0.03 * z)
+		call gmark (gp, x, y, GM_MAG, z, z)
+	    }
+	    if (SFD_W(sfd) < SF_W(sf))
+		call gseti (gp, G_PLCOLOR, 2)
+	    else
+		call gseti (gp, G_PLCOLOR, 3)
+	    z = min (2., SFD_W(sfd) / rbest)
+	    z = 0.010 * (1 + (z - 1) * 5)
+	    call gmark (gp, x, y, GM_CIRCLE, z, z)
+	    call gseti (gp, G_PLCOLOR, 1)
+	}
+
+	call gseti (gp, G_PLTYPE, 2)
+	call gline (gp, SF_W(sf), y1, SF_W(sf), y2)
+	call gseti (gp, G_PLTYPE, 1)
+
+	# (E,R)
+	call gseti (gp, G_WCS, 4)
+	call gseti (gp, G_DRAWAXES, 3)
+	call gseti (gp, G_XLABELTICKS, NO)
+	call gseti (gp, G_YLABELTICKS, YES)
+	call gseti (gp, G_XNMAJOR, 6)
+	call gseti (gp, G_XNMINOR, 4)
+	call gseti (gp, G_YNMAJOR, 4)
+	call gseti (gp, G_YNMINOR, 0)
+	call gsview (gp, vx[2,1], vx[2,2], vy[3,1], vy[3,2])
+	call gswind (gp, 0., 1., 0., 1.)
+	call gfill (gp, fa, fa[5], 4, GF_SOLID)
+
+	call gswind (gp, x1, x2, emin, emax)
+	call glabax (gp, "", "", "Ellip")
+
+	do i = 1, SFF_NSFD(sff) {
+	    sfd = SFF_SFD(sff,i)
+	    if (SFD_STATUS(sfd) != 0)
+		next
+	    x = SFD_X(sfd)
+	    y = SFD_E(sfd)
+	    if (key == 1) {
+		z = sqrt (SFS_M(SFD_SFS(sfd)) / SF_M(sf))
+		z = max (0.005, 0.03 * z)
+		call gmark (gp, x, y, GM_MAG, z, z)
+	    }
+	    if (SFD_W(sfd) < SF_W(sf))
+		call gseti (gp, G_PLCOLOR, 2)
+	    else
+		call gseti (gp, G_PLCOLOR, 3)
+	    z = min (2., SFD_W(sfd) / rbest)
+	    z = 0.010 * (1 + (z - 1) * 5)
+	    call gmark (gp, x, y, GM_CIRCLE, z, z)
+	    call gseti (gp, G_PLCOLOR, 1)
+	}
+
+	# (E,Y)
+	call gseti (gp, G_WCS, 5)
+	call gseti (gp, G_XLABELTICKS, YES)
+	call gseti (gp, G_YLABELTICKS, NO)
+	call gseti (gp, G_XNMAJOR, 4)
+	call gseti (gp, G_XNMINOR, 0)
+	call gseti (gp, G_YNMAJOR, 6)
+	call gseti (gp, G_YNMINOR, 4)
+	call gsview (gp, vx[3,1], vx[3,2], vy[2,1], vy[2,2])
+	call gswind (gp, 0., 1., 0., 1.)
+	call gfill (gp, fa, fa[5], 4, GF_SOLID)
+
+	call gswind (gp, emin, emax, y1, y2)
+	call glabax (gp, "", "Ellip", "")
+
+	do i = 1, SFF_NSFD(sff) {
+	    sfd = SFF_SFD(sff,i)
+	    if (SFD_STATUS(sfd) != 0)
+		next
+	    x = SFD_E(sfd)
+	    y = SFD_Y(sfd)
+	    if (key == 1) {
+		z = sqrt (SFS_M(SFD_SFS(sfd)) / SF_M(sf))
+		z = max (0.005, 0.03 * z)
+		call gmark (gp, x, y, GM_MAG, z, z)
+	    }
+	    if (SFD_W(sfd) < SF_W(sf))
+		call gseti (gp, G_PLCOLOR, 2)
+	    else
+		call gseti (gp, G_PLCOLOR, 3)
+	    z = min (2., SFD_W(sfd) / rbest)
+	    z = 0.010 * (1 + (z - 1) * 5)
+	    call gmark (gp, x, y, GM_CIRCLE, z, z)
+	    call gseti (gp, G_PLCOLOR, 1)
+	}
+
+	# Label window.
+	call gseti (gp, G_WCS, 1)
+	call gseti (gp, G_DRAWAXES, 0)
+	call gsview (gp, vx[1,1], vx[3,2], vy[1,1], vy[3,2])
+	call glabax (gp, title, "", "")
+
+	# (X,Y)
+	call gseti (gp, G_DRAWAXES, 3)
+	call gseti (gp, G_LABELTICKS, NO)
+	call gseti (gp, G_XNMAJOR, 6)
+	call gseti (gp, G_XNMINOR, 4)
+	call gseti (gp, G_YNMAJOR, 6)
+	call gseti (gp, G_YNMINOR, 4)
+	call gsview (gp, vx[2,1], vx[2,2], vy[2,1], vy[2,2])
+	call gswind (gp, 0., 1., 0., 1.)
+	call gfill (gp, fa, fa[5], 4, GF_SOLID)
+
+	call gswind (gp, x1, x2, y1, y2)
+	call glabax (gp, "", "", "")
+
+	do i = 1, SFF_NSFD(sff) {
+	    sfd = SFF_SFD(sff,i)
+	    if (SFD_STATUS(sfd) != 0)
+		next
+	    x = SFD_X(sfd)
+	    y = SFD_Y(sfd)
+	    if (key == 1) {
+		z = sqrt (SFS_M(SFD_SFS(sfd)) / SF_M(sf))
+		z = max (0.005, 0.03 * z)
+		call gmark (gp, x, y, GM_MAG, z, z)
+	    }
+	    if (SFD_W(sfd) < SF_W(sf))
+		call gseti (gp, G_PLCOLOR, 2)
+	    else
+		call gseti (gp, G_PLCOLOR, 3)
+	    z = min (2., SFD_W(sfd) / rbest)
+	    z = 0.010 * (1 + (z - 1) * 5)
+	    call gmark (gp, x, y, GM_CIRCLE, z, z)
+	    call gseti (gp, G_PLCOLOR, 1)
+	}
+end
+
+
+# STF_G9 -- Spatial plots at best focus.
+
+procedure stf_g12 (sf, current, key, title)
+
+pointer	sf			#I Starfocus pointer
+pointer	current			#I Current sfd pointer
+int	key			#I Plot magnitude symbol?
+char	title[ARB]		#I Title
+
+int	i
+real	x, y, z, x1, x2, y1, y2, fmin, fmax, rbest, rmin, rmax
+real	vx[3,2], vy[3,2], dvx, dvy, fa[8]
+pointer	gp, sfs, sfd
+
+data	fa/0.,1.,1.,0.,0.,0.,1.,1./
+
+begin
+	gp = SF_GP(sf)
+
+	# Range of X, Y, R, F.
+	x1 = 1.
+	y1 = 1.
+	x2 = SF_NCOLS(sf)
+	y2 = SF_NLINES(sf)
+
+	rbest = SFD_W(SF_BEST(sf))
+	fmin = MAX_REAL
+	fmax = -MAX_REAL
+	rmin = SF_W(sf)
+	rmax = 1.5 * SF_W(sf)
+	do i = 1, SF_NSTARS(sf) {
+	    sfs = SF_SFS(sf,i)
+	    if (SFS_N(sfs) == 0)
+		next
+	    fmin = min (fmin, SFS_F(sfs))
+	    fmax = max (fmax, SFS_F(sfs))
+	    rmin = min (rmin, SFS_W(sfs))
+	    rmax = max (rmax, SFS_W(sfs))
+	}
+	z = fmax - fmin
+	fmin = fmin - 0.1 * z
+	fmax = fmax + 0.1 * z
+	z = rmax - rmin
+	rmin = rmin - 0.1 * z
+	rmax = rmax + 0.1 * z
+
+	# Set view ports
+	call ggview (gp, vx[1,1], vx[3,2], vy[1,1], vy[3,2])
+	dvx = vx[3,2] - vx[1,1]
+	dvy = vy[3,2] - vy[1,1]
+	vx[1,1] = vx[1,1] + 0.00 * dvx
+	vx[1,2] = vx[1,1] + 0.20 * dvx
+	vx[2,1] = vx[1,1] + 0.25 * dvx
+	if (SF_NF(sf) > 1) {
+	    vx[2,2] = vx[1,1] + 0.75 * dvx
+	    vx[3,1] = vx[1,1] + 0.80 * dvx
+	    vx[3,2] = vx[1,1] + 1.00 * dvx
+	} else {
+	    vx[2,2] = vx[1,1] + 1.00 * dvx
+	    vx[3,1] = vx[1,1] + 1.00 * dvx
+	    vx[3,2] = vx[1,1] + 1.00 * dvx
+	}
+	vy[1,1] = vy[1,1] + 0.00 * dvy
+	vy[1,2] = vy[1,1] + 0.20 * dvy
+	vy[2,1] = vy[1,1] + 0.25 * dvy
+	if (SF_NF(sf) > 1) {
+	    vy[2,2] = vy[1,1] + 0.75 * dvy
+	    vy[3,1] = vy[1,1] + 0.80 * dvy
+	    vy[3,2] = vy[1,1] + 1.00 * dvy
+	} else {
+	    vy[2,2] = vy[1,1] + 1.00 * dvy
+	    vy[3,1] = vy[1,1] + 1.00 * dvy
+	    vy[3,2] = vy[1,1] + 1.00 * dvy
+	}
+
+	dvx = vx[2,1] - vx[2,2]
+	dvy = vy[1,1] - vy[1,2]
+	if (abs (dvx) > 0.01 && abs (dvy) > 0.01) {
+	    # (X,R)
+	    call gseti (gp, G_WCS, 2)
+	    call gseti (gp, G_DRAWAXES, 3)
+	    call gseti (gp, G_XLABELTICKS, YES)
+	    call gseti (gp, G_YLABELTICKS, YES)
+	    call gseti (gp, G_XNMAJOR, 6)
+	    call gseti (gp, G_XNMINOR, 4)
+	    call gseti (gp, G_YNMAJOR, 4)
+	    call gseti (gp, G_YNMINOR, 0)
+	    call gsview (gp, vx[2,1], vx[2,2], vy[1,1], vy[1,2])
+	    call gswind (gp, 0., 1., 0., 1.)
+	    call gfill (gp, fa, fa[5], 4, GF_SOLID)
+
+	    call gswind (gp, x1, x2, rmin, rmax)
+	    call glabax (gp, "", "Column", "")
+
+	    do i = 1, SF_NSTARS(sf) {
+		sfs = SF_SFS(sf,i)
+		if (SFS_N(sfs) == 0)
+		    next
+		x = SFD_X(SFS_SFD(sfs,1))
+		y = SFS_W(sfs)
+		if (key == 1) {
+		    z = sqrt (SFS_M(sfs) / SF_M(sf))
+		    z = max (0.005, 0.03 * z)
+		    call gmark (gp, x, y, GM_MAG, z, z)
+		}
+		if (SFS_F(sfs) < SF_F(sf))
+		    call gseti (gp, G_PLCOLOR, 2)
+		else
+		    call gseti (gp, G_PLCOLOR, 3)
+		z = min (2., SFS_W(sfs) / rbest)
+		z = 0.010 * (1 + (z - 1) * 5)
+		call gmark (gp, x, y, GM_CIRCLE, z, z)
+		call gseti (gp, G_PLCOLOR, 1)
+	    }
+
+	    call gseti (gp, G_PLTYPE, 2)
+	    call gline (gp, x1, SF_W(sf), x2, SF_W(sf))
+	    call gseti (gp, G_PLTYPE, 1)
+	}
+
+	dvx = vx[1,1] - vx[1,2]
+	dvy = vy[2,1] - vy[2,2]
+	if (abs (dvx) > 0.01 && abs (dvy) > 0.01) {
+	    # (R,Y)
+	    call gseti (gp, G_WCS, 3)
+	    call gseti (gp, G_XLABELTICKS, YES)
+	    call gseti (gp, G_YLABELTICKS, YES)
+	    call gseti (gp, G_XNMAJOR, 4)
+	    call gseti (gp, G_XNMINOR, 0)
+	    call gseti (gp, G_YNMAJOR, 6)
+	    call gseti (gp, G_YNMINOR, 4)
+	    call gsview (gp, vx[1,1], vx[1,2], vy[2,1], vy[2,2])
+	    call gswind (gp, 0., 1., 0., 1.)
+	    call gfill (gp, fa, fa[5], 4, GF_SOLID)
+
+	    call gswind (gp, rmin, rmax, y1, y2)
+	    call glabax (gp, "", SF_WTYPE(sf), "Line")
+
+	    do i = 1, SF_NSTARS(sf) {
+		sfs = SF_SFS(sf,i)
+		if (SFS_N(sfs) == 0)
+		    next
+		x = SFS_W(sfs)
+		y = SFD_Y(SFS_SFD(sfs,1))
+		if (key == 1) {
+		    z = sqrt (SFS_M(sfs) / SF_M(sf))
+		    z = max (0.005, 0.03 * z)
+		    call gmark (gp, x, y, GM_MAG, z, z)
+		}
+		if (SFS_F(sfs) < SF_F(sf))
+		    call gseti (gp, G_PLCOLOR, 2)
+		else
+		    call gseti (gp, G_PLCOLOR, 3)
+		z = min (2., SFS_W(sfs) / rbest)
+		z = 0.010 * (1 + (z - 1) * 5)
+		call gmark (gp, x, y, GM_CIRCLE, z, z)
+		call gseti (gp, G_PLCOLOR, 1)
+	    }
+
+	    call gseti (gp, G_PLTYPE, 2)
+	    call gline (gp, SF_W(sf), y1, SF_W(sf), y2)
+	    call gseti (gp, G_PLTYPE, 1)
+	}
+
+	dvx = vx[2,1] - vx[2,2]
+	dvy = vy[3,1] - vy[3,2]
+	if (abs (dvx) > 0.01 && abs (dvy) > 0.01) {
+	    # (X,F)
+	    call gseti (gp, G_WCS, 4)
+	    call gseti (gp, G_XLABELTICKS, NO)
+	    call gseti (gp, G_YLABELTICKS, YES)
+	    call gseti (gp, G_XNMAJOR, 6)
+	    call gseti (gp, G_XNMINOR, 4)
+	    call gseti (gp, G_YNMAJOR, 4)
+	    call gseti (gp, G_YNMINOR, 0)
+	    call gsview (gp, vx[2,1], vx[2,2], vy[3,1], vy[3,2])
+	    call gswind (gp, 0., 1., 0., 1.)
+	    call gfill (gp, fa, fa[5], 4, GF_SOLID)
+
+	    call gswind (gp, x1, x2, fmin, fmax)
+	    call glabax (gp, "", "", "Focus")
+
+	    do i = 1, SF_NSTARS(sf) {
+		sfs = SF_SFS(sf,i)
+		if (SFS_N(sfs) == 0)
+		    next
+		x = SFD_X(SFS_SFD(sfs,1))
+		y = SFS_F(sfs)
+		if (key == 1) {
+		    z = sqrt (SFS_M(sfs) / SF_M(sf))
+		    z = max (0.005, 0.03 * z)
+		    call gmark (gp, x, y, GM_MAG, z, z)
+		}
+		if (SFS_F(sfs) < SF_F(sf))
+		    call gseti (gp, G_PLCOLOR, 2)
+		else
+		    call gseti (gp, G_PLCOLOR, 3)
+		z = min (2., SFS_W(sfs) / rbest)
+		z = 0.010 * (1 + (z - 1) * 5)
+		call gmark (gp, x, y, GM_CIRCLE, z, z)
+		call gseti (gp, G_PLCOLOR, 1)
+	    }
+
+	    call gseti (gp, G_PLTYPE, 2)
+	    call gline (gp, x1, SF_F(sf), x2, SF_F(sf))
+	    call gseti (gp, G_PLTYPE, 1)
+	}
+
+	dvx = vx[3,1] - vx[3,2]
+	dvy = vy[2,1] - vy[2,2]
+	if (abs (dvx) > 0.01 && abs (dvy) > 0.01) {
+	    # (F,Y)
+	    call gseti (gp, G_WCS, 5)
+	    call gseti (gp, G_XLABELTICKS, YES)
+	    call gseti (gp, G_YLABELTICKS, NO)
+	    call gseti (gp, G_XNMAJOR, 4)
+	    call gseti (gp, G_XNMINOR, 0)
+	    call gseti (gp, G_YNMAJOR, 6)
+	    call gseti (gp, G_YNMINOR, 4)
+	    call gsview (gp, vx[3,1], vx[3,2], vy[2,1], vy[2,2])
+	    call gswind (gp, 0., 1., 0., 1.)
+	    call gfill (gp, fa, fa[5], 4, GF_SOLID)
+
+	    call gswind (gp, fmin, fmax, y1, y2)
+	    call glabax (gp, "", "Focus", "")
+
+	    do i = 1, SF_NSTARS(sf) {
+		sfs = SF_SFS(sf,i)
+		if (SFS_N(sfs) == 0)
+		    next
+		x = SFS_F(sfs)
+		y = SFD_Y(SFS_SFD(sfs,1))
+		if (key == 1) {
+		    z = sqrt (SFS_M(sfs) / SF_M(sf))
+		    z = max (0.005, 0.03 * z)
+		    call gmark (gp, x, y, GM_MAG, z, z)
+		}
+		if (SFS_F(sfs) < SF_F(sf))
+		    call gseti (gp, G_PLCOLOR, 2)
+		else
+		    call gseti (gp, G_PLCOLOR, 3)
+		z = min (2., SFS_W(sfs) / rbest)
+		z = 0.010 * (1 + (z - 1) * 5)
+		call gmark (gp, x, y, GM_CIRCLE, z, z)
+		call gseti (gp, G_PLCOLOR, 1)
+	    }
+
+	    call gseti (gp, G_PLTYPE, 2)
+	    call gline (gp, SF_F(sf), y1, SF_F(sf), y2)
+	    call gseti (gp, G_PLTYPE, 1)
+	}
+
+	# Label window.
+	call gseti (gp, G_WCS, 1)
+	call gseti (gp, G_DRAWAXES, 0)
+	call gsview (gp, vx[1,1], vx[3,2], vy[1,1], vy[3,2])
+	call glabax (gp, title, "", "")
+
+	dvx = vx[2,1] - vx[2,2]
+	dvy = vy[2,1] - vy[2,2]
+	if (abs (dvx) > 0.01 && abs (dvy) > 0.01) {
+	    # (X,Y)
+	    call gseti (gp, G_DRAWAXES, 3)
+	    call gseti (gp, G_LABELTICKS, NO)
+	    call gseti (gp, G_XNMAJOR, 6)
+	    call gseti (gp, G_XNMINOR, 4)
+	    call gseti (gp, G_YNMAJOR, 6)
+	    call gseti (gp, G_YNMINOR, 4)
+	    call gsview (gp, vx[2,1], vx[2,2], vy[2,1], vy[2,2])
+	    call gswind (gp, 0., 1., 0., 1.)
+	    call gfill (gp, fa, fa[5], 4, GF_SOLID)
+
+	    call gswind (gp, x1, x2, y1, y2)
+	    call glabax (gp, "", "", "")
+
+	    do i = 1, SF_NSTARS(sf) {
+		sfs = SF_SFS(sf,i)
+		if (SFS_N(sfs) == 0)
+		    next
+		sfd = SFS_SFD(sfs,1)
+		x = SFD_X(sfd)
+		y = SFD_Y(sfd)
+		if (key == 1) {
+		    z = sqrt (SFS_M(sfs) / SF_M(sf))
+		    z = max (0.005, 0.03 * z)
+		    call gmark (gp, x, y, GM_MAG, z, z)
+		}
+		if (SFS_F(sfs) < SF_F(sf))
+		    call gseti (gp, G_PLCOLOR, 2)
+		else
+		    call gseti (gp, G_PLCOLOR, 3)
+		z = min (2., SFS_W(sfs) / rbest)
+		z = 0.010 * (1 + (z - 1) * 5)
+		call gmark (gp, x, y, GM_CIRCLE, z, z)
+		call gseti (gp, G_PLCOLOR, 1)
+	    }
+	}
+end
diff --git a/noao/obsutil/src/starfocus/stfhelp.key b/noao/obsutil/src/starfocus/stfhelp.key
new file mode 100644
index 00000000..948bb9b7
--- /dev/null
+++ b/noao/obsutil/src/starfocus/stfhelp.key
@@ -0,0 +1,63 @@
+			STARFOCUS COMMAND OPTIONS
+
+				SUMMARY
+
+? Help              f Focus             p Radial profile    u Undelete
+a Spatial           i Info              q Quit              x Delete        
+b Best              m Magnitude         r Redraw            z Zoom
+d Delete            n Normalize         s Mag symbols       <space> Next
+e Enclosed flux     o Offset            t Field radius      
+
+:level <val>        :radius <val>       :show <file>        :xcenter <val>
+:overplot <y|n>     :scale <val>        :size <type>        :ycenter <val>
+
+
+				CURSOR COMMANDS
+
+All plots may not be available depending on the number of focus values and
+the number of stars.
+
+?	Page this help information
+a	Spatial plot at a single focus
+b	Spatial plot of best focus values
+d	Delete star nearest to cursor
+e	Enclosed flux for all stars at one focus and all focus for one star
+f	Size and ellipticity vs focus for all data
+i	Information about point nearest the cursor
+m	Size and ellipticity vs relative magnitude at one focus
+n	Normalize enclosed flux at x cursor position
+o	Offset enclosed flux to x,y cursor position by adjusting background
+p	Radial profiles for all stars at one focus and all focus for one star
+          The profiles are determined from the derivatives of the enclosed flux
+q	Quit
+r	Redraw
+s	Toggle magnitude symbols in spatial plots
+t	Size and ellipticity vs radius from field center at one focus
+u	Undelete all deleted points
+x	Delete nearest point, star, or focus (selected by query)
+z	Zoom to a single measurement showing enclosed flux and radial profile
+<space> Step through different focus or stars in current plot type
+
+
+			COLON COMMANDS
+
+A command without a value generally shows the current value of the
+parameter while with a value it sets the value of the parameter.
+
+:level <val>	Level at which the size parameter is evaluated
+:overplot <y|n> Overplot the profiles from the narrowest profile?
+:radius <val>   Change profile radius(*)
+:show <file>	Page all information for the current set of objects
+:size <type>	Size type (Radius|FWHM|GFWHM|MFWHM) (**)
+:scale <val>	Pixel scale for size values
+:xcenter <val>	X field center for radius from field center plots
+:ycenter <val>	Y field center for radius from field center plots
+
+(*) The profile radius may not exceed the initial value set by the task
+    parameter.
+
+(**)
+Radius = radius enclosing the fraction of the flux specified by "level"
+FWHM   = Full-width at half-maximum based on the radially smoothed profile
+GFWHM  = Full-width at half-maximum of Gaussian function fit to enclosed flux
+MFWHM  = Full-width at half-maximum of Moffat function fit to enclosed flux
diff --git a/noao/obsutil/src/starfocus/stfmeasure.x b/noao/obsutil/src/starfocus/stfmeasure.x
new file mode 100644
index 00000000..808b6058
--- /dev/null
+++ b/noao/obsutil/src/starfocus/stfmeasure.x
@@ -0,0 +1,134 @@
+include	<error.h>
+include	<imhdr.h>
+include	<imset.h>
+include	<math/nlfit.h>
+include	"starfocus.h"
+
+
+# STF_MEASURE -- PSF measuring routine.
+# This is a stand-alone routine that can be called to return the FWHM.
+# It is a greatly abbreviated version of starfocus.
+
+procedure stf_measure (im, xc, yc, beta, level, radius, nit,
+	sbuffer, swidth, saturation, gp, logfd,
+	bkg, renclosed, dfwhm, gfwhm, mfwhm)
+
+pointer	im		#I Image pointer
+real	xc		#I Initial X center
+real	yc		#I Initial Y center
+real	beta		#I Moffat beta
+real	level		#I Measurement level
+real	radius		#U Profile radius
+int	nit		#I Number of iterations on radius
+real	sbuffer		#I Sky buffer (pixels)
+real	swidth		#I Sky width (pixels)
+real	saturation	#I Saturation
+pointer	gp		#I Graphics output if not NULL
+int	logfd		#I Log output if not NULL
+real	bkg		#O Background used
+real	renclosed	#O Enclosed flux radius
+real	dfwhm		#O Direct FWHM
+real	gfwhm		#O Gaussian FWHM
+real	mfwhm		#O Moffat FWHM
+
+int	i
+bool	ignore_sat
+pointer	sp, str, sf, sfd, sfds
+
+int	strdic()
+real	stf_r2i()
+errchk	stf_find, stf_bkgd, stf_profile, stf_widths, stf_fwhms, stf_organize
+
+begin
+	call smark (sp)
+	call salloc (str, SZ_FNAME, TY_CHAR)
+	call salloc (sf, SF, TY_STRUCT)
+	call salloc (sfd, SFD, TY_STRUCT)
+	call salloc (sfds, 1, TY_POINTER)
+	call aclri (Memi[sf], SF)
+	call aclri (Memi[sfd], SFD)
+	Memi[sfds] = sfd
+
+	# Initialize parameters.
+	SF_TASK(sf) = PSFMEASURE
+	SF_WCODE(sf) = strdic ("FWHM", SF_WTYPE(sf), SF_SZWTYPE, SF_WTYPES)
+	SF_SCALE(sf) = 1.
+	SF_LEVEL(sf) = level
+	SF_BETA(sf) = beta
+	SF_RADIUS(sf) = radius
+	SF_SBUF(sf) = sbuffer
+	SF_SWIDTH(sf) = swidth
+	SF_SAT(sf) = saturation
+	SF_NIT(sf) = nit
+	SF_OVRPLT(sf) = NO
+	SF_NCOLS(sf) = IM_LEN(im,1)
+	SF_NLINES(sf) = IM_LEN(im,2)
+	SF_XF(sf) = (IM_LEN(im,1) + 1) / 2.
+	SF_YF(sf) = (IM_LEN(im,2) + 1) / 2.
+	ignore_sat = false
+
+	call imstats (im, IM_IMAGENAME, SFD_IMAGE(sfd), SF_SZFNAME)
+	SFD_ID(sfd) = 1
+	SFD_X(sfd) = xc
+	SFD_Y(sfd) = yc
+	SFD_F(sfd) = INDEF
+	SFD_STATUS(sfd) = 0
+	SFD_SFS(sfd) = NULL
+	SFD_SFF(sfd) = NULL
+	SFD_SFI(sfd) = NULL
+
+	if (SF_LEVEL(sf) > 1.)
+	    SF_LEVEL(sf) = SF_LEVEL(sf) / 100.
+	SF_LEVEL(sf) = max (0.05, min (0.95, SF_LEVEL(sf)))
+
+	# Evaluate PSF data.
+	iferr {
+	    do i = 1, SF_NIT(sf) {
+		if (i == 1)
+		    SFD_RADIUS(sfd) = SF_RADIUS(sf)
+		else
+		    SFD_RADIUS(sfd) = 3. * SFD_DFWHM(sfd)
+		SFD_NPMAX(sfd) = stf_r2i (SFD_RADIUS(sfd)) + 1
+		SFD_NP(sfd) = SFD_NPMAX(sfd)
+		call stf_find (sf, sfd, im)
+		call stf_bkgd (sf, sfd)
+		if (SFD_NSAT(sfd) > 0 && i == 1) {
+		    if (ignore_sat)
+			call error (0,
+			"Saturated pixels found - ignoring object")
+		    else
+			call eprintf (
+			    "WARNING: Saturated pixels found.\n")
+		}
+		call stf_profile (sf, sfd)
+		call stf_widths (sf, sfd)
+		call stf_fwhms (sf, sfd)
+	    }
+
+	    # Set output results.
+	    radius = SFD_RADIUS(sfd)
+	    bkg = SFD_BKGD(sfd)
+	    renclosed = SFD_R(sfd)
+	    dfwhm = SFD_DFWHM(sfd)
+	    mfwhm = SFD_MFWHM(sfd)
+	    gfwhm = SFD_GFWHM(sfd)
+
+	    # Optional graph and log output.  Note that the gp pointer is only
+	    # used to indicate whether to make a graph.  The stf_graph
+	    # procedure opens its own graphics stream.
+
+	    call stf_organize (sf, sfds, 1)
+	    if (gp != NULL)
+		call stf_graph (sf)
+	    if (logfd != NULL)
+		call stf_log (sf, logfd)
+
+	    call asifree (SFD_ASI1(sfd))
+	    call asifree (SFD_ASI2(sfd))
+	} then
+	    call erract (EA_WARN)
+
+	# Finish up
+	call stf_free (sf)
+	call sfree (sp)
+end
diff --git a/noao/obsutil/src/starfocus/stfprofile.x b/noao/obsutil/src/starfocus/stfprofile.x
new file mode 100644
index 00000000..d26c085d
--- /dev/null
+++ b/noao/obsutil/src/starfocus/stfprofile.x
@@ -0,0 +1,1189 @@
+include	<imhdr.h>
+include	<mach.h>
+include	<math.h>
+include	<math/iminterp.h>
+include	<math/nlfit.h>
+include	"starfocus.h"
+
+
+# STF_FIND      -- Find the object and return the data raster and object center.
+# STF_BKGD      -- Compute the background.
+# STF_PROFILE   -- Compute enclosed flux profile, derivative, and moments.
+# STF_NORM      -- Renormalized enclosed flux profile
+# STF_WIDTHS    -- Set widths.
+# STF_I2R       -- Radius from sample index.
+# STF_R2I       -- Sample index from radius.
+# STF_R2N       -- Number of subsamples from radius.
+# STF_MODEL     -- Return model values.
+# STF_DFWHM     -- Direct FWHM from profile.
+# STF_FWHMS     -- Measure FWHM vs level.
+# STF_RADIUS    -- Measure the radius at the specified level.
+# STF_FIT       -- Fit model.
+# STF_GAUSS1    -- Gaussian function used in NLFIT.
+# STF_GAUSS2    -- Gaussian function and derivatives used in NLFIT.
+# STF_MOFFAT1   -- Moffat function used in NLFIT.
+# STF_MOFFAT2   -- Moffat function and derivatives used in NLFIT.
+
+
+# STF_FIND -- Find the object and return the data raster and object center.
+# Centering uses centroid of marginal distributions of data above the mean.
+
+procedure stf_find (sf, sfd, im)
+
+pointer	sf			#I Starfocus pointer
+pointer	sfd			#I Object pointer
+pointer	im			#I Image pointer
+
+long	lseed
+int	i, j, k, x1, x2, y1, y2, nx, ny, npts
+real	radius, buffer, width, xc, yc, xlast, ylast, r1, r2
+real	mean, sum, sum1, sum2, sum3, asumr(), urand()
+pointer	data, ptr, imgs2r()
+errchk	imgs2r
+
+begin
+	radius = max (3., SFD_RADIUS(sfd))
+	buffer = SF_SBUF(sf)
+	width = SF_SWIDTH(sf)
+
+	xc = SFD_X(sfd)
+	yc = SFD_Y(sfd)
+	r1 = radius + buffer + width
+	r2 = radius
+
+	# Iterate on the center finding.
+	do k = 1, 3 {
+
+	    # Extract region around current center.
+	    xlast = xc
+	    ylast = yc
+
+	    x1 = max (1-NBNDRYPIX, nint (xc - r2))
+	    x2 = min (IM_LEN(im,1)+NBNDRYPIX, nint (xc + r2))
+	    nx = x2 - x1 + 1
+	    y1 = max (1-NBNDRYPIX, nint (yc - r2))
+	    y2 = min (IM_LEN(im,2)+NBNDRYPIX, nint (yc + r2))
+	    ny = y2 - y1 + 1
+	    npts = nx * ny
+	    data = imgs2r (im, x1, x2, y1, y2)
+
+	    # Find center of gravity of marginal distributions above mean.
+	    npts = nx * ny
+	    sum = asumr (Memr[data], npts)
+	    mean = sum / nx
+	    sum1 = 0.
+	    sum2 = 0.
+
+	    do i = x1, x2 {
+		ptr = data + i - x1
+		sum3 = 0.
+		do j = y1, y2 {
+		    sum3 = sum3 + Memr[ptr]
+		    ptr = ptr + nx
+		}
+		sum3 = sum3 - mean
+		if (sum3 > 0.) {
+		    sum1 = sum1 + i * sum3
+		    sum2 = sum2 + sum3
+		}
+	    }
+	    if (sum2 <= 0)
+		call error (1, "Centering failed to converge")
+	    xc = sum1 / sum2
+	    if (xlast - xc > 0.2 * nx)
+		xc = xlast - 0.2 * nx
+	    if (xc - xlast > 0.2 * nx)
+		xc = xlast + 0.2 * nx
+
+	    ptr = data
+	    mean = sum / ny
+	    sum1 = 0.
+	    sum2 = 0.
+	    do j = y1, y2 {
+		sum3 = 0.
+		do i = x1, x2 {
+		    sum3 = sum3 + Memr[ptr]
+		    ptr = ptr + 1
+		}
+		sum3 = sum3 - mean
+		if (sum3 > 0.) {
+		    sum1 = sum1 + j * sum3
+		    sum2 = sum2 + sum3
+		}
+	    }
+	    if (sum2 <= 0)
+		call error (1, "Centering failed to converge")
+	    yc = sum1 / sum2
+	    if (ylast - yc > 0.2 * ny)
+		yc = ylast - 0.2 * ny
+	    if (yc - ylast > 0.2 * ny)
+		yc = ylast + 0.2 * ny
+
+	    if (nint(xc) == nint(xlast) && nint(yc) == nint(ylast))
+		break
+	}
+
+	# Get a new centered raster if necessary.
+	if (nint(xc) != nint(xlast) || nint(yc) != nint(ylast) || r2 < r1) {
+	    x1 = max (1-NBNDRYPIX, nint (xc - r1))
+	    x2 = min (IM_LEN(im,1)+NBNDRYPIX, nint (xc + r1))
+	    nx = x2 - x1 + 1
+	    y1 = max (1-NBNDRYPIX, nint (yc - r1))
+	    y2 = min (IM_LEN(im,2)+NBNDRYPIX, nint (yc + r1))
+	    ny = y2 - y1 + 1
+	    npts = nx * ny
+	    data = imgs2r (im, x1, x2, y1, y2)
+	}
+
+	# Add a dither for integer data.  The random numbers are always
+	# the same to provide reproducibility.
+
+	i = IM_PIXTYPE(im)
+	if (i == TY_SHORT || i == TY_INT || i == TY_LONG) {
+	    lseed = 1
+	    do i = 0, npts-1
+		Memr[data+i] = Memr[data+i] + urand(lseed) - 0.5
+	}
+
+	SFD_DATA(sfd) = data
+	SFD_X1(sfd) = x1
+	SFD_X2(sfd) = x2
+	SFD_Y1(sfd) = y1
+	SFD_Y2(sfd) = y2
+	SFD_X(sfd) = xc
+	SFD_Y(sfd) = yc
+end
+
+
+# STF_BKGD -- Compute the background.
+# A mode is estimated from the minimum slope in the sorted background pixels
+# with a bin width of 5%.
+
+procedure stf_bkgd (sf, sfd)
+
+pointer	sf			#I Parameter structure
+pointer	sfd			#I Star structure
+
+int	i, j, x1, x2, y1, y2, xc, yc, nx, ny, npts, ns, nsat
+real	sat, bkgd, miso
+real	r, r1, r2, r3, dx, dy, dz
+pointer	sp, data, bdata, ptr
+
+begin
+	data = SFD_DATA(sfd)
+	x1 = SFD_X1(sfd)
+	x2 = SFD_X2(sfd)
+	y1 = SFD_Y1(sfd)
+	y2 = SFD_Y2(sfd)
+	xc = SFD_X(sfd)
+	yc = SFD_Y(sfd)
+
+	nx = x2 - x1 + 1
+	ny = y2 - y1 + 1
+	npts = nx * ny
+
+	ns = 0
+	nsat = 0
+	r1 = SFD_RADIUS(sfd) ** 2
+	r2 = (SFD_RADIUS(sfd) + SF_SBUF(sf)) ** 2
+	r3 = (SFD_RADIUS(sfd) + SF_SBUF(sf) + SF_SWIDTH(sf)) ** 2
+	sat = SF_SAT(sf)
+	if (IS_INDEF(sat))
+	    sat = MAX_REAL
+
+	call smark (sp)
+	call salloc (bdata, npts, TY_REAL)
+
+	ptr = data
+	do j = y1, y2 {
+	    dy = (yc - j) ** 2
+	    do i = x1, x2 {
+		dx = (xc - i) ** 2
+		r = dx + dy
+		if (r <= r1) {
+		    if (Memr[ptr] >= sat)
+			nsat = nsat + 1
+		} else if (r >= r2 && r <= r3) {
+		    Memr[bdata+ns] = Memr[ptr]
+		    ns = ns + 1
+		}
+		ptr = ptr + 1
+	    }
+	}
+
+	if (ns > 9) {
+	    call asrtr (Memr[bdata], Memr[bdata], ns)
+	    r = Memr[bdata+ns-1] - Memr[bdata]
+	    bkgd = Memr[bdata] + r / 2
+	    miso = r / 2
+
+	    j = 1 + 0.50 * ns
+	    do i = 0, ns - j {
+		dz = Memr[bdata+i+j-1] - Memr[bdata+i]
+		if (dz < r) {
+		    r = dz
+		    bkgd = Memr[bdata+i] + dz / 2
+		    miso = dz / 2
+		}
+	    }
+	} else {
+	    bkgd = 0.
+	    miso = 0.
+	}
+
+	SFD_BKGD1(sfd) = bkgd
+	SFD_BKGD(sfd) = bkgd
+	SFD_MISO(sfd) = miso
+	SFD_NSAT(sfd) = nsat
+
+	call sfree (sp)
+end
+
+
+# STF_PROFILE -- Compute enclosed flux profile, derivative, direct FWHM, and
+# profile moments..
+# 1.  The flux profile is normalized at the maximum value.
+# 2.  The radial profile is computed from the numerical derivative of the
+#     enclose flux profile.
+
+procedure stf_profile (sf, sfd)
+
+pointer	sf			#I Parameter structure
+pointer	sfd			#I Star structure
+
+int	np
+real	radius, xc, yc
+
+int	i, j, k, l, m, ns, nx, ny, x1, x2, y1, y2
+real	bkgd, miso, sigma, peak
+real	r, r1, r2, r3, dx, dy, dx1, dx2, dy1, dy2, dz, xx, yy, xy, ds, da
+pointer	sp, data, profile, ptr, asi, msi, gs
+int	stf_r2n()
+real	asieval(), msieval(), gseval(), stf_i2r(), stf_r2i()
+errchk	asiinit, asifit, msiinit, msifit, gsrestore
+
+real	gsdata[24]
+data	gsdata/ 1., 4., 4., 1., 0., 0.6726812, 1., 2., 1.630641, 0.088787,
+		0.00389378, -0.001457133, 0.3932125, -0.1267456, -0.004864541,
+		0.00249941, 0.03078612, 0.02731274, -4.875850E-4, 2.307464E-4,
+		-0.002134843, 0.007603908, -0.002552385, -8.010564E-4/
+
+begin
+	data = SFD_DATA(sfd)
+	x1 = SFD_X1(sfd)
+	x2 = SFD_X2(sfd)
+	y1 = SFD_Y1(sfd)
+	y2 = SFD_Y2(sfd)
+	xc = SFD_X(sfd)
+	yc = SFD_Y(sfd)
+	bkgd = SFD_BKGD(sfd)
+	miso = SFD_MISO(sfd)
+	radius = SFD_RADIUS(sfd)
+	np = SFD_NP(sfd)
+
+	nx = x2 - x1 + 1
+	ny = y2 - y1 + 1
+
+	# Use an image interpolator fit to the data.
+	call msiinit (msi, II_BISPLINE3)
+	call msifit (msi, Memr[data], nx, ny, nx)
+
+	# To avoid trying to interpolate outside the center of the
+	# edge pixels, a requirement of the interpolator functions,
+	# we reset the data limits.
+	x1 = x1 + 1
+	x2 = x2 - 1
+	y1 = y1 + 1
+	y2 = y2 - 1
+
+	# Compute the enclosed flux profile, its derivative, and moments.
+	call smark (sp)
+	call salloc (profile, np, TY_REAL)
+	call aclrr (Memr[profile], np)
+
+	xx = 0.
+	yy = 0.
+	xy = 0.
+	do j = y1, y2 {
+	    ptr = data + (j-y1+1)*nx + 1
+	    dy = j - yc
+	    do i = x1, x2 {
+		dx = i - xc
+
+		# Set the subpixel sampling which may be a function of radius.
+		r = sqrt (dx * dx + dy * dy)
+		ns = stf_r2n (r)
+		ds = 1. / ns
+		da = ds * ds
+		dz = 0.5 + 0.5 * ds
+
+		# Sum the interpolator values over the subpixels and compute
+		# an offset to give the correct total for the pixel.
+
+		r2 = 0.
+		dy1 = dy - dz
+		do l = 1, ns {
+		    dy1 = dy1 + ds
+		    dy2 = dy1 * dy1
+		    dx1 = dx - dz
+		    do k = 1, ns {
+			dx1 = dx1 + ds
+			dx2 = dx1 * dx1
+			r1 = msieval (msi, dx1+xc-x1+2, dy1+yc-y1+2)
+			r2 = r2 + r1
+		    }
+		}
+
+		r1 = Memr[ptr] - bkgd
+		ptr = ptr + 1
+		r2 = r1 - r2 * da
+
+		# Accumulate the enclosed flux over the sub pixels.
+		dy1 = dy - dz
+		do l = 1, ns {
+		    dy1 = dy1 + ds
+		    dy2 = dy1 * dy1
+		    dx1 = dx - dz
+		    do k = 1, ns {
+			dx1 = dx1 + ds
+			dx2 = dx1 * dx1
+			r = max (0., sqrt (dx2 + dy2) - ds / 2)
+			if (r < radius) {
+			    r1 = da * (msieval (msi, dx1+xc-x1+2, dy1+yc-y1+2) +
+				r2)
+
+			    # Use approximation for fractions of a subpixel.
+			    for (m=stf_r2i(r)+1; m<=np; m=m+1) {
+				r3 = (stf_i2r (real(m)) - r) / ds
+				if (r3 >= 1.)
+				    break
+				Memr[profile+m-1] = Memr[profile+m-1] + r3 * r1
+			    }
+
+			    # The subpixel is completely within these radii.
+			    for (; m<=np; m=m+1)
+				Memr[profile+m-1] = Memr[profile+m-1] + r1
+
+			    # Accumulate the moments above an isophote.
+			    if (r1 > miso) {
+				xx = xx + dx2 * r1
+				yy = yy + dy2 * r1
+				xy = xy + dx1 * dy1 * r1
+			    }
+			}
+		    }
+		}
+	    }
+	}
+
+	call msifree (msi)
+
+	# Compute the ellipticity and position angle from the moments.
+	r = (xx + yy)
+	if (r > 0.) {
+	    r1 = (xx - yy) / r
+	    r2 = 2 * xy / r
+	    SFD_E(sfd) = sqrt (r1**2 + r2**2)
+	    SFD_PA(sfd) = RADTODEG (atan2 (r2, r1) / 2.)
+	} else {
+	    SFD_E(sfd) = 0.
+	    SFD_PA(sfd) = 0.
+	}
+
+	# The magnitude and profile normalization is from the max enclosed flux.
+	call alimr (Memr[profile], np, r, SFD_M(sfd))
+	if (SFD_M(sfd) <= 0.)
+	    call error (1, "Invalid flux profile")
+	call adivkr (Memr[profile], SFD_M(sfd), Memr[profile], np)
+
+	# Fit interpolator to the enclosed flux profile.
+	call asiinit (asi, II_SPLINE3)
+	call asifit (asi, Memr[profile], np)
+	SFD_ASI1(sfd) = asi
+
+	# Estimate a gaussian sigma (actually sqrt(2)*sigma) and if it is
+	# it is small subtract the gaussian so that the image interpolator
+	# can more accurately estimate subpixel values.
+
+	#call stf_radius (sf, sfd, SF_LEVEL(sf), r)
+	#sigma = r / sqrt (log (1/(1-SF_LEVEL(sf))))
+	call stf_radius (sf, sfd, 0.8, r)
+	r = r / SF_SCALE(sf)
+	sigma = 2 * r * sqrt (log(2.) / log (1/(1-0.8)))
+	if (sigma < 5.) {
+	    if (sigma <= 2.) {
+		call gsrestore (gs, gsdata)
+		dx = xc - nint (xc)
+		dy = yc - nint (yc)
+		r = sqrt (dx * dx + dy * dy)
+		dx = 1.
+		ds = abs (sigma - gseval (gs, r, dx))
+		for (da = 1.; da <= 2.; da = da + .01) {
+		    dz = abs (sigma - gseval (gs, r, da))
+		    if (dz < ds) {
+			ds = dz
+			dx = da
+		    }
+		}
+		sigma = dx
+		call gsfree (gs)
+	    }
+
+	    sigma = sigma / (2 * sqrt (log(2.)))
+	    sigma = sigma * sigma
+
+	    # Compute the peak that gives the correct central pixel value.
+	    i = nint (xc)
+	    j = nint (yc)
+	    dx = i - xc
+	    dy = j - yc
+	    r = sqrt (dx * dx + dy * dy)
+	    ns = stf_r2n (r)
+	    ds = 1. / ns
+	    da = ds * ds
+	    dz = 0.5 + 0.5 * ds
+
+	    r1 = 0.
+	    dy1 = dy - dz
+	    do l = 1, ns {
+		dy1 = dy1 + ds
+		dy2 = dy1 * dy1
+		dx1 = dx - dz
+		do k = 1, ns {
+		    dx1 = dx1 + ds
+		    dx2 = dx1 * dx1
+		    r2 = (dx2 + dy2) / sigma
+		    if (r2 < 25.)
+			r1 = r1 + exp (-r2)
+		}
+	    }
+	    ptr = data + (j - y1 + 1) * nx + (i - x1 + 1)
+	    peak = (Memr[ptr] - bkgd) / (r1 * da)
+
+	    # Subtract the gaussian from the data.
+	    do j = y1, y2 {
+		ptr = data + (j - y1 + 1) * nx + 1
+		dy = j - yc
+		do i = x1, x2 {
+		    dx = i - xc
+		    r = sqrt (dx * dx + dy * dy)
+		    ns = stf_r2n (r)
+		    ds = 1. / ns
+		    da = ds * ds
+		    dz = 0.5 + 0.5 * ds
+
+		    r1 = 0.
+		    dy1 = dy - dz
+		    do l = 1, ns {
+			dy1 = dy1 + ds
+			dy2 = dy1 * dy1
+			dx1 = dx - dz
+			do k = 1, ns {
+			    dx1 = dx1 + ds
+			    dx2 = dx1 * dx1
+			    r2 = (dx2 + dy2) / sigma
+			    if (r2 < 25.)
+				r1 = r1 + peak * exp (-r2)
+			}
+		    }
+		    Memr[ptr] = Memr[ptr] - r1 * da
+		    ptr = ptr + 1
+		}
+	    }
+
+	    # Fit the image interpolator to the residual data.
+	    call msiinit (msi, II_BISPLINE3)
+	    call msifit (msi, Memr[data], nx, ny, nx)
+
+	    # Recompute the enclosed flux profile and moments
+	    # using the gaussian plus image interpolator fit to the residuals.
+
+	    call aclrr (Memr[profile], np)
+
+	    xx = 0.
+	    yy = 0.
+	    xy = 0.
+	    do j = y1, y2 {
+		ptr = data + (j - y1 + 1) * nx + 1
+		dy = j - yc
+		do i = x1, x2 {
+		    dx = i - xc
+		    r = sqrt (dx * dx + dy * dy)
+		    ns = stf_r2n (r)
+		    ds = 1. / ns
+		    da = ds * ds
+		    dz = 0.5 + 0.5 * ds
+
+		    # Compute interpolator correction.
+		    r2 = 0.
+		    dy1 = dy - dz
+		    do l = 1, ns {
+			dy1 = dy1 + ds
+			dx1 = dx - dz
+			do k = 1, ns {
+			    dx1 = dx1 + ds
+			    r1 = msieval (msi, dx1+xc-x1+2, dy1+yc-y1+2)
+			    r2 = r2 + r1
+			}
+		    }
+
+		    r1 = Memr[ptr] - bkgd
+		    ptr = ptr + 1
+		    r2 = r1 - r2 * da
+
+		    # Accumulate the enclosed flux and moments.
+		    dy1 = dy - dz
+		    do l = 1, ns {
+			dy1 = dy1 + ds
+			dy2 = dy1 * dy1
+			dx1 = dx - dz
+			do k = 1, ns {
+			    dx1 = dx1 + ds
+			    dx2 = dx1 * dx1
+			    r3 = (dx2 + dy2) / sigma
+			    if (r3 < 25.)
+				r3 = peak * exp (-r3)
+			    else
+				r3 = 0.
+			    r = max (0., sqrt (dx2 + dy2) - ds / 2)
+			    if (r < radius) {
+				r1 = msieval (msi, dx1+xc-x1+2, dy1+yc-y1+2)
+				r1 = da * (r1 + r2 + r3)
+
+				for (m=stf_r2i(r)+1; m<=np; m=m+1) {
+				    r3 = (stf_i2r (real(m)) - r) / ds
+				    if (r3 >= 1.)
+					break
+				    Memr[profile+m-1] = Memr[profile+m-1] +
+					r3 * r1
+				}
+				for (; m<=np; m=m+1)
+				    Memr[profile+m-1] = Memr[profile+m-1] + r1
+
+				if (r1 > miso) {
+				    xx = xx + dx2 * r1
+				    yy = yy + dy2 * r1
+				    xy = xy + dx1 * dy1 * r1
+				}
+			    }
+			}
+		    }
+		}
+	    }
+
+	    call msifree (msi)
+
+	    # Recompute the moments, magnitude, normalized flux, and interp.
+	    r = (xx + yy)
+	    if (r > 0.) {
+		r1 = (xx - yy) / r
+		r2 = 2 * xy / r
+		SFD_E(sfd) = sqrt (r1**2 + r2**2)
+		SFD_PA(sfd) = RADTODEG (atan2 (r2, r1) / 2.)
+	    } else {
+		SFD_E(sfd) = 0.
+		SFD_PA(sfd) = 0.
+	    }
+
+	    call alimr (Memr[profile], np, r, SFD_M(sfd))
+	    if (SFD_M(sfd) <= 0.)
+		call error (1, "Invalid flux profile")
+	    call adivkr (Memr[profile], SFD_M(sfd), Memr[profile], np)
+
+	    call asifit (asi, Memr[profile], np)
+	    SFD_ASI1(sfd) = asi
+	}
+
+	# Compute derivative of enclosed flux profile and fit an image
+	# interpolator.
+
+	dx = 0.25
+	Memr[profile] = 0.
+	ns = 0
+	do i = 1, np {
+	    r = stf_i2r (real(i))
+	    r2 = stf_r2i (r + dx)
+	    if (r2 > np) {
+		k = i
+		break
+	    }
+	    r1 = stf_r2i (r - dx)
+	    if (r1 < 1) {
+		if (i > 1) {
+		    dy = asieval (asi, real(i)) / r**2
+		    Memr[profile] = (ns * Memr[profile] + dy) / (ns + 1)
+		    ns = ns + 1
+		}
+		j = i
+	    } else {
+		dy = (asieval (asi, r2) - asieval (asi, r1)) /
+		    (4 * r * dx)
+		Memr[profile+i-1] = dy
+	    }
+	}
+	do i = 2, j
+	    Memr[profile+i-1] = (Memr[profile+j] - Memr[profile]) / j *
+		(i - 1) + Memr[profile]
+	do i = k, np
+	    Memr[profile+i-1] = Memr[profile+k-2]
+
+	call adivkr (Memr[profile], SF_SCALE(sf)**2, Memr[profile], np)
+	call alimr (Memr[profile], np, SFD_YP1(sfd), SFD_YP2(sfd))
+	call asiinit (asi, II_SPLINE3)
+	call asifit (asi, Memr[profile], np)
+	SFD_ASI2(sfd) = asi
+	#SF_XP1(sf) = j+1
+	SF_XP1(sf) = 1
+	SF_XP2(sf) = k-1
+
+	call sfree (sp)
+end
+
+
+# STF_NORM -- Renormalize the enclosed flux profile.
+
+procedure stf_norm (sf, sfd, x, y)
+
+pointer	sf			#I Parameter structure
+pointer	sfd			#I Star structure
+real	x			#I Radius
+real	y			#I Flux
+
+int	npmax, np
+pointer	asi
+
+int	i, j, k
+real	r, r1, r2, dx, dy
+pointer	sp, profile
+real	asieval(), stf_i2r(), stf_r2i()
+errchk	asifit
+
+begin
+	npmax = SFD_NPMAX(sfd)
+	np = SFD_NP(sfd)
+	asi = SFD_ASI1(sfd)
+
+	call smark (sp)
+	call salloc (profile, npmax, TY_REAL)
+
+	# Renormalize the enclosed flux profile.
+	if (IS_INDEF(x) || x <= 0.) {
+	    dy = SFD_BKGD(sfd) - SFD_BKGD1(sfd)
+	    SFD_BKGD(sfd) = SFD_BKGD(sfd) - dy
+	    do i = 1, npmax
+		Memr[profile+i-1] = asieval (asi, real(i)) +
+		    dy * stf_i2r(real(i)) ** 2
+	    call alimr (Memr[profile], np, r1, r2)
+	    call adivkr (Memr[profile], r2, Memr[profile], npmax)
+	} else if (IS_INDEF(y)) {
+	    r = max (1., min (real(np), stf_r2i (x)))
+	    r2 = asieval (asi, r)
+	    if (r2 <= 0.)
+		return
+	    do i = 1, npmax
+		Memr[profile+i-1] = asieval (asi, real(i))
+	    call adivkr (Memr[profile], r2, Memr[profile], npmax)
+	} else {
+	    r = max (1., min (real(np), stf_r2i (x)))
+	    r1 = asieval (asi, r)
+	    dy = (y - r1) / x ** 2
+	    SFD_BKGD(sfd) = SFD_BKGD(sfd) - dy
+	    do i = 1, npmax
+		Memr[profile+i-1] = asieval (asi, real(i)) +
+		    dy * stf_i2r(real(i)) ** 2
+	}
+
+	call asifit (asi, Memr[profile], npmax)
+	SFD_ASI1(sfd) = asi
+
+	# Compute derivative of enclosed flux profile and fit an image
+	# interpolator.
+
+	dx = 0.25
+	do i = 1, npmax {
+	    r = stf_i2r (real(i))
+	    r2 = stf_r2i (r + dx)
+	    if (r2 > np) {
+		k = i
+		break
+	    }
+	    r1 = stf_r2i (r - dx)
+	    if (r1 < 1) {
+		if (i > 1) {
+		    dy = asieval (asi, real(i)) / r**2
+		    Memr[profile] = dy
+		}
+		j = i
+	    } else {
+		dy = (asieval (asi, r2) - asieval (asi, r1)) /
+		    (4 * r * dx)
+		Memr[profile+i-1] = dy
+	    }
+	}
+	do i = 2, j
+	    Memr[profile+i-1] = (Memr[profile+j] - Memr[profile]) / j *
+		(i - 1) + Memr[profile]
+	do i = k, npmax
+	    Memr[profile+i-1] = Memr[profile+k-2]
+
+	call adivkr (Memr[profile], SF_SCALE(sf)**2, Memr[profile], np)
+	call alimr (Memr[profile], np, SFD_YP1(sfd), SFD_YP2(sfd))
+	asi = SFD_ASI2(sfd)
+	call asifit (asi, Memr[profile], np)
+	SFD_ASI2(sfd) = asi
+	#SF_XP1(sf) = min (j+1, np)
+	SF_XP1(sf) = 1
+	SF_XP2(sf) = min (k-1, np)
+
+	call sfree (sp)
+end
+
+
+# STF_WIDTHS -- Set the widhts.
+
+procedure stf_widths (sf, sfd)
+
+pointer	sf			#I Main data structure
+pointer	sfd			#I Star data structure
+
+errchk	stf_radius, stf_dfwhm, stf_fit
+
+begin
+	call stf_radius (sf, sfd, SF_LEVEL(sf), SFD_R(sfd))
+	call stf_dfwhm (sf, sfd)
+	call stf_fit (sf, sfd)
+
+	switch (SF_WCODE(sf)) {
+	case 1:
+	    SFD_W(sfd) = SFD_R(sfd)
+	case 2:
+	    SFD_W(sfd) = SFD_DFWHM(sfd)
+	case 3:
+	    SFD_W(sfd) = SFD_GFWHM(sfd)
+	case 4:
+	    SFD_W(sfd) = SFD_MFWHM(sfd)
+	}
+end
+
+
+# STF_I2R -- Compute radius from sample index.
+
+real procedure stf_i2r (i)
+
+real	i			#I Index
+real	r			#O Radius
+
+begin
+	if (i < 20)
+	    r = 0.05 * i
+	else if (i < 30)
+	    r = 0.1 * i - 1
+	else if (i < 40)
+	    r = 0.2 * i - 4
+	else if (i < 50)
+	    r = 0.5 * i - 16
+	else
+	    r = i - 41
+	return (r)
+end
+
+
+# STF_R2I -- Compute sample index from radius.
+
+real procedure stf_r2i (r)
+
+real	r			#I Radius
+real	i			#O Index
+
+begin
+	if (r < 1)
+	    i = 20 * r
+	else if (r < 2)
+	    i = 10 * (r + 1)
+	else if (r < 4)
+	    i = 5 * (r + 4)
+	else if (r < 9)
+	    i = 2 * (r + 16)
+	else
+	    i = r + 41
+	return (i)
+end
+
+
+# STF_R2N -- Compute number of subsamples from radius.
+
+int procedure stf_r2n (r)
+
+real	r			#I Radius
+int	n			#O Number of subsamples
+
+begin
+	if (r < 1)
+	    n = 20
+	else if (r < 2)
+	    n = 10
+	else if (r < 4)
+	    n = 5
+	else if (r < 9)
+	    n = 2
+	else
+	    n = 1
+	return (n)
+end
+
+
+# STF_MODEL -- Return model value.
+
+procedure stf_model (sf, sfd, r, profile, flux)
+
+pointer	sf			#I Main data structure
+pointer	sfd			#I Star data structure
+real	r			#I Radius at level
+real	profile			#I Profile value
+real	flux			#I Enclosed flux value
+
+real	x, x1, x2, r1, r2, dr
+
+begin
+	dr = 0.25 * SF_SCALE(sf)
+	r1 = r - dr
+	r2 = r + dr
+	if (r1 < 0.) {
+	    r1 = dr
+	    r2 = r1 + dr
+	}
+
+	switch (SF_WCODE(sf)) {
+	case 3:
+	    x = r**2 / (2. * SFD_SIGMA(sfd)**2)
+	    if (x < 20.)
+		flux = 1 - exp (-x)
+	    else
+		flux = 0.
+
+	    x1 = r1**2 / (2. * SFD_SIGMA(sfd)**2)
+	    x2 = r2**2 / (2. * SFD_SIGMA(sfd)**2)
+	    if (x2 < 20.) {
+		x1 = 1 - exp (-x1)
+		x2 = 1 - exp (-x2)
+	    } else {
+		x1 = 1.
+		x2 = 1.
+	    }
+	    if (r <= dr) {
+		x1 = x1 / dr ** 2
+		x2 = x2 / (4 * dr ** 2)
+		profile = (x2 - x1) / dr * r + x1
+	    } else {
+		profile = (x2 - x1) / (4 * r * dr)
+	    }
+	default:
+	    x = 1 + (r / SFD_ALPHA(sfd)) ** 2
+	    flux = 1 - x ** (1 - SFD_BETA(sfd))
+
+	    x1 = 1 + (r1 / SFD_ALPHA(sfd)) ** 2
+	    x2 = 1 + (r2 / SFD_ALPHA(sfd)) ** 2
+	    x1 = 1 - x1 ** (1 - SFD_BETA(sfd))
+	    x2 = 1 - x2 ** (1 - SFD_BETA(sfd))
+	    if (r <= dr) {
+		x1 = x1 / dr ** 2
+		x2 = x2 / (4 * dr ** 2)
+		profile = (x2 - x1) / dr * r + x1
+	    } else {
+		profile = (x2 - x1) / (4 * r * dr)
+	    }
+	}
+end
+
+
+# STF_DFWHM -- Direct FWHM from profile.
+
+procedure stf_dfwhm (sf, sfd)
+
+pointer	sf			#I Main data structure
+pointer	sfd			#I Star data structure
+
+int	np
+real	r, rpeak, profile, peak, asieval(), stf_i2r()
+pointer	asi
+
+begin
+	asi = SFD_ASI2(sfd)
+	np = SFD_NP(sfd)
+
+	rpeak = 1.
+	peak = 0.
+	for (r=1.; r <= np; r = r + 0.01) {
+	    profile = asieval (asi, r)
+	    if (profile > peak) {
+		rpeak = r
+		peak = profile
+	    }
+	}
+	
+	peak = peak / 2.
+	for (r=rpeak; r <= np && asieval (asi, r) > peak; r = r + 0.01)
+	    ;
+
+	SFD_DFWHM(sfd) = 2 * stf_i2r (r) * SF_SCALE(sf)
+end
+
+
+# STF_FWHMS -- Measure FWHM vs level.
+
+procedure stf_fwhms (sf, sfd)
+
+pointer	sf			#I Main data structure
+pointer	sfd			#I Star data structure
+
+int	i
+real	level, r
+
+begin
+	do i = 1, 19 {
+	    level = i * 0.05
+	    call stf_radius (sf, sfd, level, r)
+	    switch (SF_WCODE(sf)) {
+	    case 3:
+		SFD_FWHM(sfd,i) = 2 * r * sqrt (log (2.) / log (1/(1-level)))
+	    default:
+		r = r / sqrt ((1.-level)**(1./(1.-SFD_BETA(sfd))) - 1.)
+		SFD_FWHM(sfd,i) = 2 * r * sqrt (2.**(1./SFD_BETA(sfd))-1.)
+	    }
+	}
+end
+
+
+# STF_RADIUS -- Measure the radius at the specified level.
+
+procedure stf_radius (sf, sfd, level, r)
+
+pointer	sf			#I Main data structure
+pointer	sfd			#I Star data structure
+real	level			#I Level to measure
+real	r			#O Radius
+
+int	np
+pointer	asi
+real	f, fmax, rmax, asieval(), stf_i2r()
+
+begin
+	np = SFD_NP(sfd)
+	asi = SFD_ASI1(sfd)
+
+	for (r=1; r <= np && asieval (asi, r) < level; r = r + 0.01)
+	    ;
+	if (r > np) {
+	    fmax = 0.
+	    rmax = 0.
+	    for (r=1; r <= np; r = r + 0.01) {
+		f = asieval (asi, r)
+		if (f > fmax) {
+		    fmax = f
+		    rmax = r
+		}
+	    }
+	    r = rmax
+	}
+	r = stf_i2r (r) * SF_SCALE(sf)
+end
+
+
+# STF_FIT -- Fit models to enclosed flux.
+
+procedure stf_fit (sf, sfd)
+
+pointer	sf			#I Main data structure
+pointer	sfd			#I Star data structure
+
+int	i, j, n, np, pfit[2]
+real	beta, z, params[3]
+pointer	asi, nl
+pointer	sp, x, y, w
+
+int	locpr()
+real	asieval(), stf_i2r()
+extern	stf_gauss1(), stf_gauss2(), stf_moffat1(), stf_moffat2()
+errchk	nlinitr, nlfitr
+
+data	pfit/2,3/
+
+begin
+	np = SFD_NP(sfd)
+	asi = SFD_ASI1(sfd)
+
+	call smark (sp)
+	call salloc (x, np, TY_REAL)
+	call salloc (y, np, TY_REAL)
+	call salloc (w, np, TY_REAL)
+
+	n = 0
+	j = 0
+	do i = 1, np {
+	    z = 1. - max (0., asieval (asi, real(i)))
+	    if (n > np/3 && z < 0.5)
+		break
+	    if ((n < np/3 && z > 0.01) || z > 0.5)
+		j = n
+
+	    Memr[x+n] = stf_i2r (real(i)) * SF_SCALE(sf)
+	    Memr[y+n] = z
+	    Memr[w+n] = 1.
+	    n = n + 1
+	}
+
+	# Gaussian.
+	np = 1
+	params[2] = Memr[x+j] / sqrt (2. * log (1./min(0.99,Memr[y+j])))
+	params[1] = 1
+	call nlinitr (nl, locpr (stf_gauss1), locpr (stf_gauss2),
+	    params, params, 2, pfit, np, .001, 100)
+	call nlfitr (nl, Memr[x], Memr[y], Memr[w], n, 1, WTS_USER, i)
+	if (i != SINGULAR && i != NO_DEG_FREEDOM) {
+	    call nlpgetr (nl, params, i)
+	    if (params[2] < 0.)
+		params[2] = Memr[x+j] / sqrt (2. * log (1./min(0.99,Memr[y+j])))
+	}
+	SFD_SIGMA(sfd) = params[2]
+	SFD_GFWHM(sfd) = 2 * SFD_SIGMA(sfd) * sqrt (2. * log (2.))
+
+	# Moffat.
+	if (SF_BETA(sf) < 1.1) {
+	    call nlfreer (nl)
+	    call sfree (sp)
+	    call error (1, "Cannot measure FWHM - Moffat beta too small")
+	}
+
+	beta = SF_BETA(sf)
+	if (IS_INDEFR(beta)) {
+	    beta = 2.5
+	    np = 2
+	} else {
+	    np = 1
+	}
+	params[3] = 1 - beta
+	params[2] = Memr[x+j] / sqrt (min(0.99,Memr[y+j])**(1./params[3]) - 1.)
+	params[1] = 1
+	call nlinitr (nl, locpr (stf_moffat1), locpr (stf_moffat2),
+	    params, params, 3, pfit, np, .001, 100)
+	call nlfitr (nl, Memr[x], Memr[y], Memr[w], n, 1, WTS_USER, i)
+	if (i != SINGULAR && i != NO_DEG_FREEDOM) {
+	    call nlpgetr (nl, params, i)
+	    if (params[2] < 0.) {
+		params[3] = 1. - beta
+		params[2] = Memr[x+j] /
+		    sqrt (min(0.99,Memr[y+j])**(1./params[3]) - 1.)
+	    }
+	}
+	SFD_ALPHA(sfd) = params[2]
+	SFD_BETA(sfd) = 1 - params[3]
+	SFD_MFWHM(sfd) = 2 * SFD_ALPHA(sfd) * sqrt (2.**(1./SFD_BETA(sfd))-1.)
+
+	call nlfreer (nl)
+	call sfree (sp)
+end
+
+
+# STF_GAUSS1 -- Gaussian function used in NLFIT.  The parameters are the
+# amplitude and sigma and the input variable is the radius.
+
+procedure stf_gauss1 (x, nvars, p, np, z)
+
+real	x[nvars]		#I Input variables
+int	nvars			#I Number of variables
+real	p[np]			#I Parameter vector
+int	np			#I Number of parameters
+real	z			#O Function return
+
+real	r2
+
+begin
+	r2 = x[1]**2 / (2 * p[2]**2)
+	if (abs (r2) > 20.)
+	    z = 0.
+	else
+	    z = p[1] * exp (-r2)
+end
+
+
+# STF_GAUSS2 -- Gaussian function and derivatives used in NLFIT.  The parameters
+# are the amplitude and sigma and the input variable is the radius.
+
+procedure stf_gauss2 (x, nvars, p, dp, np, z, der)
+
+real	x[nvars]		#I Input variables
+int	nvars			#I Number of variables
+real	p[np]			#I Parameter vector
+real	dp[np]			#I Dummy array of parameters increments
+int	np			#I Number of parameters
+real	z			#O Function return
+real	der[np]			#O Derivatives
+
+real	r2
+
+begin
+	r2 = x[1]**2 / (2 * p[2]**2)
+	if (abs (r2) > 20.) {
+	    z = 0.
+	    der[1] = 0.
+	    der[2] = 0.
+	} else {
+	    der[1] = exp (-r2)
+	    z = p[1] * der[1]
+	    der[2] = z * 2 * r2 / p[2]
+	}
+end
+
+
+# STF_MOFFAT1 -- Moffat function used in NLFIT.  The parameters are the
+# amplitude, alpha squared, and beta and the input variable is the radius.
+
+procedure stf_moffat1 (x, nvars, p, np, z)
+
+real	x[nvars]		#I Input variables
+int	nvars			#I Number of variables
+real	p[np]			#I Parameter vector
+int	np			#I Number of parameters
+real	z			#O Function return
+
+real	y
+
+begin
+	y = 1 + (x[1] / p[2]) ** 2
+	if (abs (y) > 20.)
+	    z = 0.
+	else
+	    z = p[1] * y ** p[3]
+end
+
+
+# STF_MOFFAT2 -- Moffat function and derivatives used in NLFIT.  The
+# parameters are the amplitude, alpha squared, and beta and the input
+# variable is the radius.
+
+procedure stf_moffat2 (x, nvars, p, dp, np, z, der)
+
+real	x[nvars]		#I Input variables
+int	nvars			#I Number of variables
+real	p[np]			#I Parameter vector
+real	dp[np]			#I Dummy array of parameters increments
+int	np			#I Number of parameters
+real	z			#O Function return
+real	der[np]			#O Derivatives
+
+real	y
+
+begin
+	y = 1 + (x[1] / p[2]) ** 2
+	if (abs (y) > 20.) {
+	    z = 0.
+	    der[1] = 0.
+	    der[2] = 0.
+	    der[3] = 0.
+	} else {
+	    der[1] = y ** p[3]
+	    z = p[1] * der[1]
+	    der[2] = -2 * z / y * p[3] / p[2] * (x[1] / p[2]) ** 2
+	    der[3] = z * log (y)
+	}
+end
diff --git a/noao/obsutil/src/starfocus/t_starfocus.x b/noao/obsutil/src/starfocus/t_starfocus.x
new file mode 100644
index 00000000..2c3213e9
--- /dev/null
+++ b/noao/obsutil/src/starfocus/t_starfocus.x
@@ -0,0 +1,1240 @@
+include	<error.h>
+include	<imhdr.h>
+include	<imset.h>
+include	<mach.h>
+include	"starfocus.h"
+
+define	HELP		"nmisc$src/starfocus.key"
+define	PROMPT		"Options"
+
+
+# T_STARFOCUS -- Stellar focusing task.
+
+procedure t_starfocus ()
+
+begin
+	call starfocus (STARFOCUS)
+end
+
+
+# T_PSFMEASURE -- PSF measuring task.
+
+procedure t_psfmeasure ()
+
+begin
+	call starfocus (PSFMEASURE)
+end
+
+
+# STARFOCUS -- Stellar focusing and PSF measuring main routine.
+
+procedure starfocus (type)
+
+int	type		#I Task type
+
+int	list		# List of images
+pointer	fvals		# Focus values
+pointer	fstep		# Focus step
+pointer	nexposures	# Number of exposures
+pointer	step		# step in pixels
+int	direction	# Step direction
+int	gap		# Double step gap
+int	coords		# Type of image data
+bool	display		# Display images?
+int	frame		# Display frame
+int	logfd		# Log file descriptor
+bool	ignore_sat	# Ignore saturation?
+
+real	wx, wy, f, df, xstep, ystep
+int	i, i1, i2, i3, j, k, l, ip, wcs, key, id, ncols, nlines
+int	nexp, nsfd, nimages, nstars, ngraph, nmark
+pointer	sp, sf, image, system, cmd, rg, mark, im, mw, ct
+pointer	sfds, sfd
+
+bool	clgetb(), streq()
+real	clgetr(), imgetr(), stf_r2i()
+int	clgeti(), clgwrd(), clgcur(), imtopenp(), imtgetim(), imgeti()
+int	nowhite(), open(), rng_index(), strdic(), ctoi(), ctor()
+pointer	rng_open(), immap(), mw_openim(), mw_sctran()
+errchk	immap, open, imgetr, imgeti, mw_openim, mw_sctran
+errchk	stf_find, stf_bkgd, stf_profile, stf_widths, stf_fwhms, stf_radius
+errchk	stf_organize, stf_graph, stf_display
+
+begin
+	call smark (sp)
+	call salloc (sf, SF, TY_STRUCT)
+	call salloc (image, SZ_FNAME, TY_CHAR)
+	call salloc (fvals, SZ_LINE, TY_CHAR)
+	call salloc (fstep, SZ_LINE, TY_CHAR)
+	call salloc (nexposures, SZ_LINE, TY_CHAR)
+	call salloc (step, SZ_LINE, TY_CHAR)
+	call salloc (system, SZ_LINE, TY_CHAR)
+	call salloc (cmd, SZ_LINE, TY_CHAR)
+
+	call aclri (Memi[sf], SF)
+	SF_TASK(sf) = type
+
+	# Set task parameters.
+	switch (type) {
+	case STARFOCUS:
+	    call clgstr ("focus", Memc[fvals], SZ_LINE)
+	    call clgstr ("fstep", Memc[fstep], SZ_LINE)
+	    call clgstr ("nexposures", Memc[nexposures], SZ_LINE)
+	    call clgstr ("step", Memc[step], SZ_LINE)
+
+	    direction = clgwrd ("direction", Memc[cmd], SZ_LINE,
+		"|-line|+line+|-column|+column|")
+	    gap = clgwrd ("gap", Memc[cmd], SZ_LINE, "|none|beginning|end|") 
+
+	    if (nowhite (Memc[fvals], Memc[fvals], SZ_LINE) != 0) {
+		iferr (rg = rng_open (Memc[fvals], -MAX_REAL, MAX_REAL, 1.))
+		    rg = NULL
+	    } else
+		rg = NULL
+	case PSFMEASURE:
+	    Memc[fvals] = EOS
+	    rg = NULL
+	    nexp = 1
+	}
+
+	list = imtopenp ("images")
+	display = clgetb ("display")
+	frame = clgeti ("frame")
+	coords = clgwrd ("coords", Memc[cmd], SZ_LINE, SF_TYPES)
+	call clgstr ("wcs", Memc[system], SZ_LINE)
+
+	SF_XF(sf) = clgetr ("xcenter")
+	SF_YF(sf) = clgetr ("ycenter")
+	SF_LEVEL(sf) = clgetr ("level")
+	SF_WCODE(sf) = clgwrd ("size", SF_WTYPE(sf), SF_SZWTYPE, SF_WTYPES)
+	SF_BETA(sf) = clgetr ("beta")
+	SF_SCALE(sf) = clgetr ("scale")
+	SF_RADIUS(sf) = max (3., clgetr ("radius"))
+	SF_NIT(sf) = clgeti ("iterations")
+	SF_SBUF(sf) = clgetr ("sbuffer")
+	SF_SWIDTH(sf) = clgetr ("swidth")
+	SF_SAT(sf) = clgetr ("saturation")
+	ignore_sat = clgetb ("ignore_sat")
+	SF_OVRPLT(sf) = NO
+
+	if (SF_LEVEL(sf) > 1.)
+	    SF_LEVEL(sf) = SF_LEVEL(sf) / 100.
+	SF_LEVEL(sf) = max (0.05, min (0.95, SF_LEVEL(sf)))
+
+	# Accumulate the psf/focus data.
+	key = 'm'
+	mark = NULL
+	nstars = 0
+	nmark = 0
+	ngraph = 0
+	nimages = 0
+	nsfd = 0
+	while (imtgetim (list, Memc[image], SZ_FNAME) != EOF) {
+	    im = immap (Memc[image], READ_ONLY, 0)
+	    call imseti (im, IM_TYBNDRY, TYBNDRY)
+	    call imseti (im, IM_NBNDRYPIX, NBNDRYPIX)
+	    if (streq (Memc[system], "logical")) {
+		mw = NULL
+		ct = NULL
+	    } else {
+		mw = mw_openim (im)
+		ct = mw_sctran (mw, Memc[system], "logical", 03)
+	    }
+	    ncols = IM_LEN(im,1)
+	    nlines = IM_LEN(im,2)
+	    nimages = nimages + 1
+	    if (nimages == 1) {
+		SF_NCOLS(sf) = ncols
+		SF_NLINES(sf) = nlines
+		if (IS_INDEF(SF_XF(sf)))
+		    SF_XF(sf) = (SF_NCOLS(sf) + 1) / 2.
+		if (IS_INDEF(SF_YF(sf)))
+		    SF_YF(sf) = (SF_NLINES(sf) + 1) / 2.
+	    } else if (ncols!=SF_NCOLS(sf)||nlines!=SF_NLINES(sf))
+		call eprintf ("WARNING: Images have different sizes\n")
+
+	    # Display the image if needed.
+	    if (display) {
+		switch (coords) {
+		case SF_MARK1:
+		    if (nimages == 1)
+			call stf_display (Memc[image], frame)
+		case SF_MARKALL:
+		    call stf_display (Memc[image], frame)
+		}
+		if (nimages == 1) {
+		    call printf (
+		 "** Select stars to measure with 'm' and finish with 'q'.\n")
+		    call printf (
+		 "** Additional options are '?', 'g', and :show.\n")
+		call flush (STDOUT)
+		}
+	    }
+
+	    # Accumulate objects.
+	    repeat {
+		switch (coords) {
+		case SF_CENTER:
+		    if (nstars == nimages)
+			break
+		    if (rg == NULL && Memc[fvals] == EOS)
+			id = nstars
+		    else
+			id = 0
+		    wx = 1 + (ncols - 1) / 2.
+		    wy = 1 + (nlines - 1) / 2.
+		    key = 0
+		case SF_MARK1:
+		    if (nimages == 1) {
+			if (clgcur ("imagecur", wx, wy, wcs, key,
+			    Memc[cmd], SZ_LINE) == EOF)
+			    break
+			switch (key) {
+			case '?':
+			    call pagefile (HELP, PROMPT)
+			    next
+			case ':':
+			    if (strdic (Memc[cmd], Memc[cmd], SZ_LINE,
+				"|show|") == 1) {
+				if (nsfd > 0) {
+				    call stf_organize (sf, sfds, nsfd)
+				    call mktemp ("tmp$iraf", Memc[cmd], SZ_LINE)
+				    logfd = open (Memc[cmd], APPEND, TEXT_FILE)
+				    call stf_log (sf, logfd)
+				    call close (logfd)
+				    call pagefile (Memc[cmd], "starfocus")
+				    call delete (Memc[cmd])
+				}
+			    }
+			    next
+			case 'q':
+			    break
+			}
+			id = nstars
+			if (mark == NULL)
+			    call malloc (mark, 3*10, TY_REAL)
+			else if (mod (nmark, 10) == 0)
+			    call realloc (mark, 3*(nmark+10), TY_REAL)
+			Memr[mark+3*nmark] = id
+			Memr[mark+3*nmark+1] = wx
+			Memr[mark+3*nmark+2] = wy
+			nmark = nmark+1
+		    } else {
+			if (nmark == 0)
+			    break
+			if (nstars / nmark == nimages)
+			    break
+			i = mod (nstars, nmark)
+			id = Memr[mark+3*i]
+			wx = Memr[mark+3*i+1]
+			wy = Memr[mark+3*i+2]
+			key = 0
+		    }
+		    if (ct != NULL)
+			call mw_c2tranr (ct, wx, wy, wx, wy)
+		case SF_MARKALL:
+		    if (clgcur ("imagecur", wx, wy, wcs, key,
+			Memc[cmd], SZ_LINE) == EOF)
+			break
+		    switch (key) {
+		    case '?':
+			call pagefile (HELP, PROMPT)
+			next
+		    case ':':
+			if (strdic(Memc[cmd],Memc[cmd],SZ_LINE,"|show|")==1) {
+			    if (nsfd > 0) {
+				call stf_organize (sf, sfds, nsfd)
+				call mktemp ("tmp$iraf", Memc[cmd], SZ_LINE)
+				logfd = open (Memc[cmd], APPEND, TEXT_FILE)
+				call stf_log (sf, logfd)
+				call close (logfd)
+				call pagefile (Memc[cmd], "starfocus")
+				call delete (Memc[cmd])
+			    }
+			}
+			next
+		    case 'q':
+			break
+		    }
+		    id = nstars
+		    if (ct != NULL)
+			call mw_c2tranr (ct, wx, wy, wx, wy)
+		}
+
+		if (type == STARFOCUS) {
+		    ip = 1
+		    if (ctoi (Memc[nexposures], ip, nexp) == 0)
+			nexp = imgeti (im, Memc[nexposures])
+		    ip = 1
+		    if (ctor (Memc[step], ip, f) == 0)
+			f = imgetr (im, Memc[step])
+
+		    xstep = 0.
+		    ystep = 0.
+		    switch (direction) {
+		    case 1:
+			ystep = -f
+		    case 2:
+			ystep = f
+		    case 3:
+			xstep = -f
+		    case 4:
+			xstep = f
+		    }
+
+		    # Set the steps and order of evaluation.
+		    # This depends on which star in the sequence is marked.
+		    # Below we assume the minimum x or maximum y is marked.
+
+		    i1 = 1; i2 = nexp; i3 = 1
+#		    if (xstep < 0.) {
+#			i1 = nexp; i2 = 1; i3 = -1; xstep = -xstep
+#		    }
+#		    if (ystep > 0.) {
+#			i1 = nexp; i2 = 1; i3 = -1; ystep = -ystep
+#		    }
+		} else {
+		    i1 = 1; i2 = 1; i3 = 1
+		}
+
+		k = nsfd
+		do i = i1, i2, i3 {
+		    if (i > 1) {
+			wx = wx + xstep
+			wy = wy + ystep
+			switch (gap) {
+			case 2:
+			    if ((i==2 && i3==1) || (i==1 && i3==-1)) {
+				wx = wx + xstep
+				wy = wy + ystep
+			    }
+			case 3:
+			    if ((i==nexp && i3==1) || (i==nexp-1 && i3==-1)) {
+				wx = wx + xstep
+				wy = wy + ystep
+			    }
+			}
+		    }
+				
+		    if (wx < SF_RADIUS(sf)-NBNDRYPIX ||
+			wx > IM_LEN(im,1)-SF_RADIUS(sf)+NBNDRYPIX ||
+		        wy < SF_RADIUS(sf)-NBNDRYPIX ||
+			wy > IM_LEN(im,2)-SF_RADIUS(sf)+NBNDRYPIX)
+			next
+		    if (nexp == 1)
+			j = nimages
+		    else
+			j = i
+		    if (nsfd == 0)
+			call malloc (sfds, 10, TY_POINTER)
+		    else if (mod (nsfd, 10) == 0)
+			call realloc (sfds, nsfd+10, TY_POINTER)
+		    call malloc (sfd, SFD, TY_STRUCT)
+		    call strcpy (Memc[image], SFD_IMAGE(sfd), SF_SZFNAME)
+		    SFD_ID(sfd) = id
+		    SFD_X(sfd) = wx
+		    SFD_Y(sfd) = wy
+		    if (Memc[fvals] == EOS)
+			f = INDEF
+		    else if (Memc[fstep] != EOS) {
+			ip = 1
+			if (ctor (Memc[fvals], ip, f) == 0)
+			    f = imgetr (im, Memc[fvals])
+			ip = 1
+			if (ctor (Memc[fstep], ip, df) == 0)
+			    df = imgetr (im, Memc[fstep])
+			f = f + (i - 1) * df
+		    } else if (rg != NULL) {
+			if (rng_index (rg, j, f) == EOF)
+			    call error (1, "Focus list ended prematurely")
+		    } else
+			f = imgetr (im, Memc[fvals])
+		    SFD_F(sfd) = f
+		    SFD_STATUS(sfd) = 0
+		    SFD_SFS(sfd) = NULL
+		    SFD_SFF(sfd) = NULL
+		    SFD_SFI(sfd) = NULL
+
+		    iferr {
+			do l = 1, SF_NIT(sf) {
+			    if (l == 1)
+				SFD_RADIUS(sfd) = max (3., SF_RADIUS(sf))
+			    else
+				SFD_RADIUS(sfd) = max (3., 3. * SFD_DFWHM(sfd))
+			    SFD_NPMAX(sfd) = stf_r2i (SFD_RADIUS(sfd)) + 1
+			    SFD_NP(sfd) = SFD_NPMAX(sfd)
+			    call stf_find (sf, sfd, im)
+			    call stf_bkgd (sf, sfd)
+			    if (SFD_NSAT(sfd) > 0 && l == 1) {
+				if (ignore_sat)
+				    call error (0,
+				    "Saturated pixels found - ignoring object")
+				else
+				    call eprintf (
+					"WARNING: Saturated pixels found.\n")
+			    }
+			    call stf_profile (sf, sfd)
+			    call stf_widths (sf, sfd)
+			    call stf_fwhms (sf, sfd)
+			}
+			Memi[sfds+nsfd] = sfd
+			nsfd = nsfd + 1
+			wx = SFD_X(sfd)
+			wy = SFD_Y(sfd)
+		    } then {
+			call erract (EA_WARN)
+			call mfree (sfd, TY_STRUCT)
+		    }
+		}
+		if (nsfd > k) {
+		    nstars = nstars + 1
+		    if (key == 'g') {
+			if (nsfd - k > 0) {
+			    call stf_organize (sf, sfds+k, nsfd-k)
+			    call stf_graph (sf)
+			    ngraph = ngraph + 1
+			}
+		    }
+		}
+	    }
+	    if (mw != NULL)
+		call mw_close (mw)
+	    call imunmap (im)
+	}
+
+	if (nsfd == 0)
+	    call error (1, "No input data")
+
+	# Organize the objects, graph the data, and log the results.
+	if (nstars > 1 || ngraph != nstars) {
+	    call stf_organize (sf, sfds, nsfd)
+	    call stf_graph (sf)
+	}
+	call stf_log (sf, STDOUT)
+	call clgstr ("logfile", Memc[image], SZ_FNAME)
+	ifnoerr (logfd = open (Memc[image], APPEND, TEXT_FILE)) {
+	    call stf_log (sf, logfd)
+	    call close (logfd)
+	}
+
+	# Finish up
+	call rng_close (rg)
+	call imtclose (list)
+	call stf_free (sf)
+	do i = 1, SF_NSFD(sf) {
+	    sfd = SF_SFD(sf,i)
+	    call asifree (SFD_ASI1(sfd))
+	    call asifree (SFD_ASI2(sfd))
+	    call mfree (sfd, TY_STRUCT)
+	}
+	call mfree (SF_SFDS(sf), TY_POINTER)
+	call mfree (mark, TY_REAL)
+	call sfree (sp)
+end
+
+
+# STF_FREE -- Free the starfocus data structures.
+
+procedure stf_free (sf)
+
+pointer	sf			#I Starfocus structure
+int	i
+
+begin
+	do i = 1, SF_NSTARS(sf)
+	    call mfree (SF_SFS(sf,i), TY_STRUCT)
+	do i = 1, SF_NFOCUS(sf)
+	    call mfree (SF_SFF(sf,i), TY_STRUCT)
+	do i = 1, SF_NIMAGES(sf)
+	    call mfree (SF_SFI(sf,i), TY_STRUCT)
+	call mfree (SF_STARS(sf), TY_POINTER)
+	call mfree (SF_FOCUS(sf), TY_POINTER)
+	call mfree (SF_IMAGES(sf), TY_POINTER)
+	SF_NSTARS(sf) = 0
+	SF_NFOCUS(sf) = 0
+	SF_NIMAGES(sf) = 0
+end
+
+
+# STF_ORGANIZE -- Organize the individual object structures by star, focus,
+# and image.  Compute focus, radius, and magnitude by group and over all
+# data.
+
+procedure stf_organize (sf, sfds, nsfd)
+
+pointer	sf			#I Starfocus structure
+pointer	sfds			#I Pointer to array of object structures
+int	nsfd			#I Number of object structures
+
+int	i, j, k, nstars, nfocus, nimages, key
+real	f
+pointer	stars, focus, images, sfd, sfs, sff, sfi
+pointer	sp, image
+bool	streq()
+errchk	malloc
+
+int	stf_focsort(), stf_magsort()
+extern	stf_focsort, stf_magsort
+
+begin
+	call smark (sp)
+	call salloc (image, SZ_FNAME, TY_CHAR)
+
+	# Free previous structures.
+	call stf_free (sf)
+
+	# Organize sfds by star.
+	nstars = 0
+	for (i = 0; i < nsfd; i = i + 1) {
+	    key = SFD_ID(Memi[sfds+i])
+	    for (j = 0; SFD_ID(Memi[sfds+j]) != key; j = j + 1)
+		;
+	    if (j == i)
+		nstars = nstars + 1
+	}
+	call malloc (stars, nstars, TY_POINTER)
+
+	nstars = 0
+	for (i = 0; i < nsfd; i = i + 1) {
+	    key = SFD_ID(Memi[sfds+i])
+	    for (j = 0; j < nstars; j = j + 1)
+		if (SFS_ID(Memi[stars+j]) == key)
+		    break
+	    if (j == nstars) {
+		k = 0
+		for (j = i; j < nsfd; j = j + 1)
+		    if (SFD_ID(Memi[sfds+j]) == key)
+			k = k + 1
+		call malloc (sfs, SFS(k), TY_STRUCT)
+		SFS_ID(sfs) = key
+		SFS_NSFD(sfs) = k
+		k = 0
+		for (j = i; j < nsfd; j = j + 1) {
+		    sfd = Memi[sfds+j]
+		    if (SFD_ID(sfd) == key) {
+			k = k + 1
+			SFD_SFS(sfd) = sfs
+			SFS_SFD(sfs,k) = sfd
+		    }
+		}
+		Memi[stars+nstars] = sfs
+		nstars = nstars + 1
+	    }
+	}
+
+	# Organize sfds by focus values.  Sort by magnitude.
+	nfocus = 0
+	for (i = 0; i < nsfd; i = i + 1) {
+	    f = SFD_F(Memi[sfds+i])
+	    for (j = 0; SFD_F(Memi[sfds+j]) != f; j = j + 1)
+		;
+	    if (j == i)
+		nfocus = nfocus + 1
+	}
+	call malloc (focus, nfocus, TY_POINTER)
+
+	nfocus = 0
+	for (i = 0; i < nsfd; i = i + 1) {
+	    f = SFD_F(Memi[sfds+i])
+	    for (j = 0; j < nfocus; j = j + 1)
+		if (SFF_F(Memi[focus+j]) == f)
+		    break
+	    if (j == nfocus) {
+		k = 0
+		for (j = i; j < nsfd; j = j + 1)
+		    if (SFD_F(Memi[sfds+j]) == f)
+			k = k + 1
+		call malloc (sff, SFF(k), TY_STRUCT)
+		SFF_F(sff) = f
+		SFF_NSFD(sff) = k
+		k = 0
+		for (j = i; j < nsfd; j = j + 1) {
+		    sfd = Memi[sfds+j]
+		    if (SFD_F(sfd) == f) {
+			k = k + 1
+			SFD_SFF(sfd) = sff
+			SFF_SFD(sff,k) = sfd
+		    }
+		}
+		Memi[focus+nfocus] = sff
+		nfocus = nfocus + 1
+	    }
+	}
+
+	# Organize sfds by image.
+	nimages = 0
+	for (i = 0; i < nsfd; i = i + 1) {
+	    call strcpy (SFD_IMAGE(Memi[sfds+i]), Memc[image], SZ_FNAME)
+	    for (j = 0; !streq (SFD_IMAGE(Memi[sfds+j]), Memc[image]); j = j+1)
+		;
+	    if (j == i)
+		nimages = nimages + 1
+	}
+	call malloc (images, nimages, TY_POINTER)
+
+	nimages = 0
+	for (i = 0; i < nsfd; i = i + 1) {
+	    call strcpy (SFD_IMAGE(Memi[sfds+i]), Memc[image], SZ_FNAME)
+	    for (j = 0; j < nimages; j = j + 1)
+		if (streq (SFI_IMAGE(Memi[images+j]), Memc[image]))
+		    break
+	    if (j == nimages) {
+		k = 0
+		for (j = i; j < nsfd; j = j + 1)
+		    if (streq (SFD_IMAGE(Memi[sfds+j]), Memc[image]))
+			k = k + 1
+		call malloc (sfi, SFI(k), TY_STRUCT)
+		call strcpy (Memc[image], SFI_IMAGE(sfi), SF_SZFNAME)
+		SFI_NSFD(sfi) = k
+		k = 0
+		for (j = i; j < nsfd; j = j + 1) {
+		    sfd = Memi[sfds+j]
+		    if (streq (SFD_IMAGE(sfd), Memc[image])) {
+			k = k + 1
+			SFD_SFI(sfd) = sfi
+			SFI_SFD(sfi,k) = sfd
+		    }
+		}
+		Memi[images+nimages] = sfi
+		nimages = nimages + 1
+	    }
+	}
+		    
+	SF_NSFD(sf) = nsfd
+	SF_SFDS(sf) = sfds
+	SF_NSTARS(sf) = nstars
+	SF_STARS(sf) = stars
+	SF_NFOCUS(sf) = nfocus
+	SF_FOCUS(sf) = focus
+	SF_NIMAGES(sf) = nimages
+	SF_IMAGES(sf) = images
+
+	# Find the average and best focus values.  Sort the focus groups
+	# by magnitude and the star groups by focus.
+
+	call stf_fitfocus (sf)
+	do i = 1, SF_NFOCUS(sf) {
+	    sff = SF_SFF(sf,i)
+	    call qsort (SFF_SFD(sff,1), SFF_NSFD(sff), stf_magsort)
+	}
+	do i = 1, SF_NSTARS(sf) {
+	    sfs = SF_SFS(sf,i)
+	    call qsort (SFS_SFD(sfs,1), SFS_NSFD(sfs), stf_focsort)
+	}
+
+	call sfree (sp)
+end
+
+
+# STF_LOG -- Print log of results
+
+procedure stf_log (sf, fd)
+
+pointer	sf			#I Main data structure
+int	fd			#I File descriptor
+
+int	i, j, n
+pointer	sp, str, sfd, sfs, sff, sfi
+
+begin
+	call smark (sp)
+	call salloc (str, SZ_LINE, TY_CHAR)
+
+	# Print banner and overall result.
+	call sysid (Memc[str], SZ_LINE)
+	call fprintf (fd, "%s\n\n")
+	    call pargstr (Memc[str])
+
+	# Print each individual object organized by image.
+	call fprintf (fd, "%15.15s %7s %7s %7s")
+	    call pargstr ("Image")
+	    call pargstr ("Column")
+	    call pargstr ("Line")
+	    call pargstr ("Mag")
+	if (IS_INDEF(SF_F(sf))) {
+	    call fprintf (fd, " %7s")
+		call pargstr (SF_WTYPE(sf))
+	} else {
+	    call fprintf (fd, " %7s %7s")
+		call pargstr ("Focus")
+		call pargstr (SF_WTYPE(sf))
+	}
+	if (SF_WCODE(sf) == 4) {
+	    call fprintf (fd, " %4s")
+		call pargstr ("Beta")
+	}
+	call fprintf (fd, " %7s %7s %3s\n")
+	    call pargstr ("Ellip")
+	    call pargstr ("PA")
+	    call pargstr ("SAT")
+
+	do i = 1, SF_NIMAGES(sf) {
+	    sfi = SF_SFI(sf,i)
+	    n = 0
+	    do j = 1, SFI_NSFD(sfi) {
+		sfd = SFI_SFD(sfi,j)
+		if (SFD_STATUS(sfd) != 0)
+		    next
+		if (n == 0) {
+		    call fprintf (fd, "%15.15s")
+			call pargstr (SFD_IMAGE(sfd))
+		} else
+		    call fprintf (fd, "%15w")
+		call fprintf (fd, " %7.2f %7.2f %7.2f")
+		    call pargr (SFD_X(sfd))
+		    call pargr (SFD_Y(sfd))
+		    call pargr (-2.5*log10 (SFD_M(sfd) / SF_M(sf)))
+		if (IS_INDEF(SFD_F(sfd))) {
+		    call fprintf (fd,
+			" %7.3f")
+			call pargr (SFD_W(sfd))
+		} else {
+		    call fprintf (fd, " %7.6g %7.3f")
+			call pargr (SFD_F(sfd))
+			call pargr (SFD_W(sfd))
+		}
+		if (SF_WCODE(sf) == 4) {
+		    call fprintf (fd, " %4.1f")
+			call pargr (SFD_BETA(sfd))
+		}
+		call fprintf (fd, " %7.2f %7d")
+		    call pargr (SFD_E(sfd))
+		    call pargr (SFD_PA(sfd))
+		if (SFD_NSAT(sfd) == 0)
+		    call fprintf (fd, "\n")
+		else
+		    call fprintf (fd, "  *\n")
+		n = n + 1
+	    }
+	}
+	if (n > 0)
+	    call fprintf (fd, "\n")
+
+	# Print best values by star.
+	if (SF_NS(sf) > 1) {
+	    n = 0
+	    do i = 1, SF_NSTARS(sf) {
+		sfs = SF_SFS(sf,i)
+		if (SFS_NF(sfs) > 1 || SFS_N(sfs) > 1) {
+		    call stf_title (sf, NULL, sfs, NULL, Memc[str], SZ_LINE)
+		    call fprintf (fd, "  %s\n")
+			call pargstr (Memc[str])
+		    n = n + 1
+		}
+	    }
+	    if (n > 0)
+		call fprintf (fd, "\n")
+	}
+
+	# Print averages at each focus.
+	if (SF_NF(sf) > 1) {
+	    n = 0
+	    do i = 1, SF_NFOCUS(sf) {
+		sff = SF_SFF(sf,i)
+		if (SFF_N(sff) > 1) {
+		    call stf_title (sf, NULL, NULL, sff, Memc[str], SZ_LINE)
+		    call fprintf (fd, "  %s\n")
+			call pargstr (Memc[str])
+		    n = n + 1
+		}
+	    }
+	    if (n > 0)
+		call fprintf (fd, "\n")
+	}
+
+	call stf_title (sf, NULL, NULL, NULL, Memc[str], SZ_LINE)
+	call fprintf (fd, "%s\n")
+	    call pargstr (Memc[str])
+end
+
+
+# STF_TITLE -- Return result title string.
+# The title is dependent on whether an overall title, a title for a star
+# group, for a focus group, or for an indivdual object is desired.
+# The title also is adjusted for the select size type and the number
+# of objects in a group.
+
+procedure stf_title (sf, sfd, sfs, sff, title, sz_title)
+
+pointer	sf			#I Starfocus pointer
+pointer	sfd			#I Data pointer
+pointer	sfs			#I Star pointer
+pointer	sff			#I Focus pointer
+char	title[sz_title]		#O Title string 
+int	sz_title		#I Size of title string 
+
+pointer	ptr
+int	i, fd, stropen()
+errchk	stropen
+
+begin
+	fd = stropen (title, sz_title, WRITE_ONLY)
+
+	if (sfd != NULL) {
+	    call fprintf (fd, "%s @ (%.2f, %.2f):")
+		call pargstr (SFD_IMAGE(sfd))
+		call pargr (SFD_X(sfd))
+		call pargr (SFD_Y(sfd))
+	    switch (SF_WCODE(sf)) {
+	    case 4:
+		call fprintf (fd, " %s=%.2f (%3.1f), e=%.2f, pa=%d")
+		    call pargstr (SF_WTYPE(sf))
+		    call pargr (SFD_W(sfd))
+		    call pargr (SFD_BETA(sfd))
+		    call pargr (SFD_E(sfd))
+		    call pargr (SFD_PA(sfd))
+	    default:
+		call fprintf (fd, " %s=%.2f, e=%.2f, pa=%d")
+		    call pargstr (SF_WTYPE(sf))
+		    call pargr (SFD_W(sfd))
+		    call pargr (SFD_E(sfd))
+		    call pargr (SFD_PA(sfd))
+	    }
+	    if (SFD_SFS(sfd) != NULL) {
+		if (SFS_M(SFD_SFS(sfd)) != SF_M(sf)) {
+		    call fprintf (fd, " , m=%.2f")
+			call pargr (-2.5*log10 (SFS_M(SFD_SFS(sfd)) / SF_M(sf)))
+		}
+	    }
+	    if (!IS_INDEF(SFD_F(sfd))) {
+		call fprintf (fd, ", f=%.4g")
+		    call pargr (SFD_F(sfd))
+	    }
+	} else if (sfs != NULL) {
+	    ptr = SFS_SFD(sfs,1)
+	    call fprintf (fd, "%s")
+	    if (SFS_NF(sfs) > 1)
+		call pargstr ("Best focus estimate")
+	    else if (SFS_N(sfs) > 1)
+		call pargstr ("Average star")
+	    else {
+		for (i=1; SFD_STATUS(SFS_SFD(sfs,i))!=0; i=i+1)
+		    ;
+		call pargstr (SFD_IMAGE(SFS_SFD(sfs,i)))
+	    }
+	    call fprintf (fd, " @ (%.2f, %.2f): %s=%.2f")
+		    call pargr (SFD_X(ptr))
+		    call pargr (SFD_Y(ptr))
+		    call pargstr (SF_WTYPE(sf))
+		    call pargr (SFS_W(sfs))
+	    #if (SFS_M(sfs) != SF_M(sf)) {
+		call fprintf (fd, ", m=%.2f")
+		    call pargr (-2.5 * log10 (SFS_M(sfs) / SF_M(sf)))
+	    #}
+	    if (!IS_INDEF(SFS_F(sfs))) {
+		call fprintf (fd, ", f=%.4g")
+		    call pargr (SFS_F(sfs))
+	    }
+	} else if (sff != NULL) {
+	    if (SFF_NI(sff) == 1) {
+		for (i=1; SFD_STATUS(SFF_SFD(sff,i))!=0; i=i+1)
+		    ;
+		call fprintf (fd, "%s")
+		    call pargstr (SFD_IMAGE(SFF_SFD(sff,i)))
+		if (!IS_INDEF(SFF_F(sff))) {
+		    call fprintf (fd, " at focus %.4g")
+			call pargr (SFF_F(sff))
+		}
+		call fprintf (fd, " with average")
+	    } else {
+		if (IS_INDEF(SFF_F(sff)))
+		    call fprintf (fd, "Average")
+		else {
+		    call fprintf (fd, "Focus %.4g with average")
+			call pargr (SFF_F(sff))
+		}
+	    }
+	    call fprintf (fd, " %s of %.2f")
+		call pargstr (SF_WTYPE(sf))
+		call pargr (SFF_W(sff))
+	} else {
+	    if (IS_INDEF(SF_F(sf))) {
+		if (SF_WCODE(sf) == 1) {
+		    call fprintf (fd, "  %s%d%% enclosed flux radius of ")
+			if (SF_N(sf) > 1)
+			    call pargstr ("Average ")
+			else
+			    call pargstr ("")
+			call pargr (100 * SF_LEVEL(sf))
+		} else {
+		    if (SF_N(sf) > 1)
+			call fprintf (fd,
+			    "  Average full width at half maximum (%s) of ")
+		    else
+			call fprintf (fd,
+			    "  Full width at half maximum (%s) of ")
+		    call pargstr (SF_WTYPE(sf))
+		}
+		call fprintf (fd, "%.4f")
+		    call pargr (SF_W(sf))
+	    } else {
+		call fprintf (fd, "  %s of %.6g with ")
+		    if (SF_NS(sf) > 1) {
+			if (SF_NF(sf) > 1)
+			    call pargstr ("Average best focus")
+			else
+			    call pargstr ("Average focus")
+		    } else {
+			if (SF_NF(sf) > 1)
+			    call pargstr ("Best focus")
+			else
+			    call pargstr ("Focus")
+		    }
+		    call pargr (SF_F(sf))
+		if (SF_WCODE(sf) == 1) {
+		    call fprintf (fd, "%d%% enclosed flux radius of ")
+			call pargr (100 * SF_LEVEL(sf))
+		} else {
+		    call fprintf (fd, "%s of ")
+			call pargstr (SF_WTYPE(sf))
+		}
+		call fprintf (fd, "%.2f")
+		    call pargr (SF_W(sf))
+	    }
+	}
+
+	call strclose (fd)
+end
+
+
+# STF_FITFOCUS -- Find the best focus.
+
+procedure stf_fitfocus (sf)
+
+pointer	sf			#I Starfocus pointer
+
+int	i, j, k, n, jmin
+pointer	x, y, sfd, sfs, sff, sfi
+real	f, r, m, wr, wf
+bool	fp_equalr()
+
+begin
+	# Set number of valid points, stars, focuses, images.
+	SF_N(sf) = 0
+	SF_YP1(sf) = 0
+	SF_YP2(sf) = 0
+	do i = 1, SF_NSFD(sf) {
+	    sfd = SF_SFD(sf,i)
+	    if (SFD_STATUS(sfd) == 0) {
+		SF_N(sf) = SF_N(sf) + 1
+		SF_YP1(sf) = min (SF_YP1(sf), SFD_YP1(sfd))
+		SF_YP2(sf) = max (SF_YP2(sf), SFD_YP2(sfd))
+	    }
+	}
+	SF_NS(sf) = 0
+	do i = 1, SF_NSTARS(sf) {
+	    sfs = SF_SFS(sf,i)
+	    SFS_N(sfs) = 0
+	    SFS_M(sfs) = 0.
+	    SFS_NF(sfs) = 0
+	    do j = 1, SFS_NSFD(sfs) {
+		sfd = SFS_SFD(sfs,j)
+		if (SFD_STATUS(SFS_SFD(sfs,j)) != 0)
+		    next
+		SFS_N(sfs) = SFS_N(sfs) + 1
+		SFS_M(sfs) = SFS_M(sfs) + SFD_M(sfd)
+		sff = SFD_SFF(sfd)
+		for (k = 1; SFD_SFF(SFS_SFD(sfs,k)) != sff; k = k + 1)
+		    ;
+		if (k == j)
+		    SFS_NF(sfs) = SFS_NF(sfs) + 1
+	    }
+	    if (SFS_N(sfs) > 0) {
+		SFS_M(sfs) = SFS_M(sfs) / SFS_N(sfs)
+		SF_NS(sf) = SF_NS(sf) + 1
+	    }
+	}
+	SF_NF(sf) = 0
+	do i = 1, SF_NFOCUS(sf) {
+	    sff = SF_SFF(sf,i)
+	    SFF_W(sff) = 0.
+	    SFF_N(sff) = 0
+	    SFF_NI(sff) = 0
+	    wr = 0
+	    do j = 1, SFF_NSFD(sff) {
+		sfd = SFF_SFD(sff,j)
+		if (SFD_STATUS(sfd) != 0)
+		    next
+		m = SFS_M(SFD_SFS(sfd))
+		wr = wr + m
+		SFF_W(sff) = SFF_W(sff) + m * SFD_W(sfd)
+		SFF_N(sff) = SFF_N(sff) + 1
+		sfi = SFD_SFI(sfd)
+		for (k = 1; SFD_SFI(SFF_SFD(sff,k)) != sfi; k = k + 1)
+		    ;
+		if (k == j)
+		    SFF_NI(sff) = SFF_NI(sff) + 1
+	    }
+	    if (SFF_N(sff) > 0) {
+		SFF_W(sff) = SFF_W(sff) / wr
+		SF_NF(sf) = SF_NF(sf) + 1
+	    }
+	}
+	SF_NI(sf) = 0
+	do i = 1, SF_NIMAGES(sf) {
+	    sfi = SF_SFI(sf,i)
+	    SFI_N(sfi) = 0
+	    do j = 1, SFI_NSFD(sfi)
+		if (SFD_STATUS(SFI_SFD(sfi,j)) == 0)
+		    SFI_N(sfi) = SFI_N(sfi) + 1
+	    if (SFI_N(sfi) > 0)
+		SF_NI(sf) = SF_NI(sf) + 1
+	}
+
+	# Find the average magnitude, best focus, and radius for each star.
+	# Find the brightest magnitude and average best focus and radius
+	# over all stars.
+
+	SF_BEST(sf) = SF_SFD(sf,1)
+	SF_F(sf) = 0.
+	SF_W(sf) = 0.
+	SF_M(sf) = 0.
+	SF_NS(sf) = 0
+	wr = 0.
+	wf = 0.
+	do i = 1, SF_NSTARS(sf) {
+	    sfs = SF_SFS(sf,i)
+	    call malloc (x, SFS_NSFD(sfs), TY_REAL)
+	    call malloc (y, SFS_NSFD(sfs), TY_REAL)
+	    k = 0
+	    n = 0
+	    do j = 1, SFS_NSFD(sfs) {
+		sfd = SFS_SFD(sfs,j)
+		if (SFD_STATUS(sfd) != 0)
+		    next
+		r = SFD_W(sfd)
+		f = SFD_F(sfd)
+		if (!IS_INDEF(f))
+		    k = k + 1
+		Memr[x+n] = f
+		Memr[y+n] = r
+		n = n + 1
+		if (r < SFD_W(SF_BEST(sf)))
+		    SF_BEST(sf) = sfd
+	    }
+
+	    # Find the best focus and radius.
+	    if (n == 0) {
+		SFS_F(sfs) = INDEF
+		SFS_W(sfs) = INDEF
+		SFS_M(sfs) = INDEF
+		SFS_N(sfs) = 0
+	    } else if (k == 0) {
+		call alimr (Memr[y], n, f, r)
+		f = INDEF
+		m = SFS_M(sfs)
+		wr = wr + m
+		SFS_F(sfs) = f
+		SFS_W(sfs) = r
+		SFS_M(sfs) = m
+		SFS_N(sfs) = n
+		SF_W(sf) = SF_W(sf) + m * r
+		SF_M(sf) = max (SF_M(sf), m)
+		SF_NS(sf) = SF_NS(sf) + 1
+	    } else {
+		SFS_N(sfs) = n
+		if (k < n) {
+		    k = 0
+		    do j = 0, n-1 {
+			if (!IS_INDEF(Memr[x+j])) {
+			    Memr[x+k] = Memr[x+j]
+			    Memr[y+k] = Memr[y+j]
+			    k = k + 1
+			}
+		    }
+		}
+		call xt_sort2 (Memr[x], Memr[y], k)
+		n = 0
+		do j = 1, k-1 {
+		    if (fp_equalr (Memr[x+j], Memr[x+n])) {
+			if (Memr[y+j] < Memr[y+n])
+			    Memr[y+n] = Memr[y+j]
+		    } else {
+			n = n + 1
+			Memr[x+n] = Memr[x+j]
+			Memr[y+n] = Memr[y+j]
+		    }
+		}
+		n = n + 1
+
+		# Find the minimum radius
+		jmin = 0
+		do j = 0, n-1
+		    if (Memr[y+j] < Memr[y+jmin])
+			jmin = j
+
+		# Use parabolic interpolation to find the best focus
+		if (jmin == 0 || jmin == n-1) {
+		    f = Memr[x+jmin]
+		    r = Memr[y+jmin]
+		} else
+		    call stf_parab (Memr[x+jmin-1], Memr[y+jmin-1], f, r)
+
+		m = SFS_M(sfs)
+		wr = wr + m
+		wf = wf + m
+		SFS_F(sfs) = f
+		SFS_W(sfs) = r
+		SFS_M(sfs) = m
+		SF_F(sf) = SF_F(sf) + m * f
+		SF_W(sf) = SF_W(sf) + m * r
+		SF_M(sf) = max (SF_M(sf), m)
+		SF_NS(sf) = SF_NS(sf) + 1
+	    }
+	    call mfree (x, TY_REAL)
+	    call mfree (y, TY_REAL)
+	}
+
+	if (wr > 0.)
+	    SF_W(sf) = SF_W(sf) / wr
+	else {
+	    SF_W(sf) = INDEF
+	    SF_M(sf) = INDEF
+	}
+	if (wf > 0.)
+	    SF_F(sf) = SF_F(sf) / wf
+	else
+	    SF_F(sf) = INDEF
+end
+
+
+# STF_PARAB -- Find the minimum of a parabolic fit to three points.
+
+procedure stf_parab (x, y, xmin, ymin)
+
+real	x[3]
+real	y[3]
+real	xmin
+real	ymin
+
+double	x12, x13, x23, x213, x223, y13, y23, a, b, c
+
+begin
+	x12 = x[1] - x[2]
+	x13 = x[1] - x[3]
+	x23 = x[2] - x[3]
+	x213 = x13 * x13
+	x223 = x23 * x23
+	y13 = y[1] - y[3]
+	y23 = y[2] - y[3]
+	c = (y13 - y23 * x13 / x23) / (x213 - x223 * x13 / x23)
+	b = (y23 - c * x223) / x23
+	a = y[3]
+	xmin = -b / (2 * c)
+	ymin = a + b * xmin + c * xmin * xmin
+	xmin = xmin + x[3]
+end
+
+
+# STF_MAGSORT -- Compare two star structures by average magnitude.
+
+int procedure stf_magsort (sfd1, sfd2)
+
+pointer	sfd1, sfd2		# Structures to compare
+pointer	sfs1, sfs2		# Star structures for magnitudes
+
+begin
+	sfs1 = SFD_SFS(sfd1)
+	sfs2 = SFD_SFS(sfd2)
+	if (SFS_M(sfs1) > SFS_M(sfs2))
+	    return (-1)
+	else if (SFS_M(sfs1) < SFS_M(sfs2))
+	    return (1)
+	else
+	    return (0)
+end
+
+
+# STF_FOCSORT -- Compare two star structures by focus.
+
+int procedure stf_focsort (sfd1, sfd2)
+
+pointer	sfd1, sfd2		# Structures to compare
+
+begin
+	if (SFD_F(sfd1) < SFD_F(sfd2))
+	    return (-1)
+	else if (SFD_F(sfd1) > SFD_F(sfd2))
+	    return (1)
+	else
+	    return (0)
+end
+
+
+# STF_DISPLAY -- Display image if necessary.
+# The user is required to display the first image separately.
+
+procedure stf_display (image, frame)
+
+char	image[ARB]		#I Image to display
+int	frame			#I Display frame to use
+
+int	i, status
+pointer	sp, dname, ds, iw, imd_mapframe(), iw_open()
+bool	xt_imnameeq()
+errchk	clcmdw
+
+begin
+	call smark (sp)
+	call salloc (dname, SZ_LINE, TY_CHAR)
+
+	ds = imd_mapframe (1, READ_WRITE, NO)
+	do i = 1, MAX_FRAMES {
+	    iferr (iw = iw_open (ds, i, Memc[dname], SZ_LINE, status))
+		next
+	    call iw_close (iw)
+	    if (xt_imnameeq (image, Memc[dname]))
+		break
+	}
+	call imunmap (ds)
+
+	if (!xt_imnameeq (image, Memc[dname])) {
+	    call sprintf (Memc[dname], SZ_LINE, "display %s frame=%d fill=yes")
+		call pargstr (image)
+		call pargi (frame)
+	    call clcmdw (Memc[dname])
+	}
+
+	call sfree (sp)
+end
+
+
+# STFCUR -- Debugging routine.
+# Replace calls to clgcur with stfcur so that an text file containing the
+# cursor coordinates may be specified when running standalone (such as
+# under a debugger).
+
+int procedure stfcur (cur, wx, wy, wcs, key, cmd, sz_cmd)
+
+char	cur[ARB]		# Cursor name
+real	wx, wy			# Cursor coordinate
+int	wcs			# WCS
+int	key			# Key
+char	cmd[sz_cmd]		# Command
+int	sz_cmd			# Size of command
+
+int	fd, stat, open(), fscan()
+pointer	fname
+errchk	open
+
+begin
+	if (fd == NULL) {
+	    call malloc (fname, SZ_FNAME, TY_CHAR) 
+	    call clgstr (cur, Memc[fname], SZ_FNAME)
+	    fd = open (Memc[fname], READ_ONLY, TEXT_FILE)
+	    call mfree (fname, TY_CHAR)
+	}
+
+	stat = fscan (fd)
+	if (stat == EOF) {
+	    call close (fd)
+	    return (stat)
+	}
+
+	call gargr (wx)
+	call gargr (wy)
+	call gargi (wcs)
+	call gargi (key)
+
+	return (stat)
+end
diff --git a/noao/obsutil/src/starfocus/x_starfocus.x b/noao/obsutil/src/starfocus/x_starfocus.x
new file mode 100644
index 00000000..a3642bae
--- /dev/null
+++ b/noao/obsutil/src/starfocus/x_starfocus.x
@@ -0,0 +1,2 @@
+task    psfmeasure	= t_psfmeasure,
+	starfocus	= t_starfocus
diff --git a/noao/obsutil/src/t_bitcount.x b/noao/obsutil/src/t_bitcount.x
new file mode 100644
index 00000000..30fa21a8
--- /dev/null
+++ b/noao/obsutil/src/t_bitcount.x
@@ -0,0 +1,202 @@
+include	<error.h>
+include	<imhdr.h>
+include	<mach.h>
+
+# T_BITCOUNT -- The pixel bits for each image are counted and reported.
+
+procedure t_bitcount ()
+
+pointer	imname, imlist, im, typename, sp
+bool	grand, leftzeroes, verbose, clear_counters, first_time, pixtype_err
+int	zeroes[NBITS_INT], ones[NBITS_INT], zeroes_tot, ones_tot, ntotal
+int	nimages, npixels, maxbit, bit, nim, pixtype
+
+pointer	imtopenp(), immap()
+int	imtgetim(), imtlen(), bitcount()
+bool	clgetb()
+
+errchk	immap
+
+begin
+	call smark (sp)
+	call salloc (imname, SZ_FNAME, TY_CHAR)
+	call salloc (typename, SZ_FNAME, TY_CHAR)
+
+	imlist = imtopenp ("images")
+	nimages = imtlen (imlist)
+	if (nimages <= 0) {
+	    call sfree (sp)
+	    call error (0, "no images in list")
+	}
+
+	grand = clgetb ("grandtotal")
+	leftzeroes = clgetb ("leftzeroes")
+	verbose = clgetb ("verbose")
+
+	if (grand && verbose)
+	    call printf ("\nGrand totals for:\n\n")
+
+	clear_counters = true
+	pixtype_err = false
+	first_time = true
+
+	for (nim=1; imtgetim (imlist, Memc[imname], SZ_FNAME) != EOF; nim=nim+1)
+	    iferr (im = immap (Memc[imname], READ_ONLY, 0)) {
+		call erract (EA_WARN)
+	    } else {
+		if (first_time) {
+		    pixtype = IM_PIXTYPE(im)
+		    first_time = false
+		} else if (IM_PIXTYPE(im) != pixtype) {
+		    pixtype_err = true
+		}
+
+		if (clear_counters) {
+		    call aclri (zeroes, NBITS_INT)
+		    call aclri (ones, NBITS_INT)
+		    zeroes_tot = 0
+		    ones_tot = 0
+		    ntotal = 0
+		    clear_counters = ! grand
+		}
+
+		npixels = bitcount (im, leftzeroes, zeroes, ones, maxbit)
+
+		ntotal = ntotal + npixels
+
+		if (verbose) {
+		    call dtstring (IM_PIXTYPE(im), Memc[typename], SZ_FNAME)
+
+		    call printf ("%s[%d,%d][%s], npix=%d:\n")
+			call pargstr (Memc[imname])
+			call pargi (IM_LEN(im,1))
+			call pargi (IM_LEN(im,2))
+			call pargstr (Memc[typename])
+			call pargi (npixels)
+		}
+
+		if (grand && nim != nimages)
+		    next
+
+		if (verbose)
+		    call printf ("\n")
+
+		if (grand && pixtype_err) {
+		    call eprintf ("Warning: image data types vary!\n\n")
+		    call flush (STDOUT)
+		    call flush (STDERR)
+		}
+
+		if (verbose) {
+		    do bit = 1, maxbit {
+			zeroes_tot = zeroes_tot + zeroes[bit]
+			ones_tot = ones_tot + ones[bit]
+		    }
+
+		    call printf ("  bit     0's       1's     %%0's    %%1's\n")
+		    call printf ("  ---     ---       ---     ----    ----\n")
+
+		    do bit = 1, maxbit {
+			call printf ("  %2d  %8d  %8d   %5.1f   %5.1f")
+			    call pargi (bit-1)
+			    call pargi (zeroes[bit])
+			    call pargi (ones[bit])
+			    call pargr (100.*zeroes[bit]/ntotal)
+			    call pargr (100.*ones[bit]/ntotal)
+
+			if (bit==maxbit && IM_PIXTYPE(im)!=TY_USHORT)
+			    call printf ("  (sign bit)\n")
+			else
+			    call printf ("\n")
+		    }
+
+		    call printf ("       -------   -------    ----    ----\n")
+		    call printf ("    %10d%10d   %5.1f   %5.1f\n\n\n")
+			call pargi (zeroes_tot)
+			call pargi (ones_tot)
+			call pargr (100.*zeroes_tot/(ntotal*maxbit))
+			call pargr (100.*ones_tot/(ntotal*maxbit))
+
+		} else
+		    do bit = 1, maxbit {
+			call printf ("%d\t%d\n")
+			    call pargi (zeroes[bit])
+			    call pargi (ones[bit])
+		    }
+
+		call imunmap (im)
+		call flush (STDOUT)
+	    }
+
+	call imtclose (imlist)
+	call sfree (sp)
+end
+
+
+# BITCOUNT -- Accumulate the bit statistics for an image and return
+# the number of pixels.  The calling routine is responsible for
+# zeroing the arrays.
+
+int procedure bitcount (im, leftzeroes, zeroes, ones, maxbit)
+
+pointer	im			#I image descriptor
+bool	leftzeroes		#I are leftmost zeroes significant?
+int	zeroes[ARB]		#O array to count zeroes / bit
+int	ones[ARB]		#O array to count ones / bit
+int	maxbit			#O number of bits/pixel
+
+int	bit, npixels, nrows, ncols, ival, i
+long	v[IM_MAXDIM]
+pointer	buf
+
+int	imgnli()
+
+errchk	imgnli
+
+begin
+	ncols = IM_LEN(im,1)
+	nrows = IM_LEN(im,2)
+	npixels = nrows * ncols
+
+	# this will break on machines with 64 bit integers
+	switch (IM_PIXTYPE(im)) {
+	case TY_SHORT, TY_USHORT:
+	    maxbit = NBITS_SHORT
+	case TY_INT, TY_LONG:
+	    maxbit = NBITS_INT
+	default:
+	    call error (0, "image pixels aren't integers")
+	}
+
+	call amovkl (long(1), v, IM_MAXDIM)
+
+	while (imgnli (im, buf, v) != EOF)
+	    do i = 1, ncols {
+		ival = Memi[buf+i-1]
+
+		# special handling for the high order bit
+		if (ival < 0) {
+		    # convert to 2's complement and tally the sign bit
+		    ival = 2**maxbit - abs(ival)
+		    ones[maxbit] = ones[maxbit] + 1
+		} else if ((IM_PIXTYPE(im) == TY_USHORT) && (ival > 32767))
+		    ones[maxbit] = ones[maxbit] + 1
+		else if (leftzeroes)
+		    zeroes[maxbit] = zeroes[maxbit] + 1
+
+		for (bit=1; bit<maxbit && ival!=0; bit=bit+1) {
+		    if (mod (ival, 2) == 0)
+			zeroes[bit] = zeroes[bit] + 1
+		    else
+			ones[bit] = ones[bit] + 1
+
+		    ival = ival / 2
+		}
+
+		if (leftzeroes)
+		    do bit = bit, maxbit-1
+			zeroes[bit] = zeroes[bit] + 1
+	    }
+
+	return (npixels)
+end
diff --git a/noao/obsutil/src/x_obsutil.x b/noao/obsutil/src/x_obsutil.x
new file mode 100644
index 00000000..30f7baff
--- /dev/null
+++ b/noao/obsutil/src/x_obsutil.x
@@ -0,0 +1,8 @@
+task    bitcount	= t_bitcount,
+	ccdtime		= t_ccdtime,
+	cgiparse	= t_cgiparse,
+	pairmass	= t_pairmass,
+	psfmeasure	= t_psfmeasure,
+	specfocus	= t_specfocus,
+	sptime		= t_sptime,
+	starfocus	= t_starfocus