Initial commit

84 files changed, 17829 insertions, 0 deletions

diff --git a/noao/artdata/Notes b/noao/artdata/Notes
new file mode 100644
index 00000000..3f8d90c2
--- /dev/null
+++ b/noao/artdata/Notes
@@ -0,0 +1,11 @@
+Ideas for additional tasks:
+
+o Given a list of (x,y) or (x,y,z) make/add a 1D or 2D image
+	o Fit using curfit/gsurfit?
+	o Some other way of fitting?
+
+o Script tasks to make certain classes of data.
+
+o Demo
+
+o Do stuff for making various PLIO masks
diff --git a/noao/artdata/Revisions b/noao/artdata/Revisions
new file mode 100644
index 00000000..beaa9e4c
--- /dev/null
+++ b/noao/artdata/Revisions
@@ -0,0 +1,537 @@
+.help revisions Jan90 noao.artdata
+.nf
+
+mktemplates.x
+doc/mkobjects.hlp
+    Added Sersic model profiles.  This was done using only the model
+    name to avoid any additional parameters.  (2/24/11, Valdes)
+
+=======
+V2.15.2
+=======
+
+=======
+V2.12.2
+=======
+
+mkheader.x
+    The routine was not putting an EOS for lines longer than IDB_RECLEN
+    resulting in cards longer than the FITS standard.
+    (1/29/04, Valdes)
+
+mktemplates.x
+    Pointer procedure mkt_object() could return w/out value (12/29/03, MJF)
+
+mkheader.x
+    Added checks and warning messages for overflowing the user header
+    area.  (11/10/03, Valdes)
+
+t_mknoise.x
+t_mkobjects.x
+t_mk1dspec.x
+t_mkechelle.x
+lists/t_starlist.x
+lists/t_gallist.x
+    The behavior of the random number seed used when specified as INDEF
+    was changed to avoid the 1 second grandularity.  See buglog 528.
+    (8/7/03, Valdes)
+
+t_mknoise.x
+    The string for the header file name was increased in length from
+    LEN_COMMENT to SZ_FNAME.  (6/27/03, Valdes)
+
+=======
+V2.12.1
+=======
+=====
+V2.12
+=====
+
+t_mkobjects.x
+doc/mkobjects.hlp
+    The star templates are now created only once when there is a list
+    of input images.  There was also a bug in matching the objects
+    list to the input list which didn't work and also did not agree with
+    the help.  Now there must be a matching list.  (12/14/01, Valdes)
+
+stdheader.dat
+    The DATE-OBS had a syntax error, a ':' instead of 'T' separating the
+    date and time.  (2/11/00, Valdes)
+
+=========
+V2.11.3p1
+=========
+
+stdheader.dat
+mkexamples/archdr.dat
+mkexamples/objhdr.dat
+    Changed DATE-OBS to new FITS format.  (5/19/99, Valdes)
+    
+
+doc/mkobjects.hlp
+doc/mkpattern.hlp
+doc/mkechelle.hlp
+    Fixed minor formating problems.  (4/22/99, Valdes)
+
+doc/mkechelle.hlp
+    Modified to indicate the input list is not exactly the same as MK1DSPEC
+    since that task was modified to support different profile types.
+    (3/16/98, Valdes)
+
+=====
+V2.11
+=====
+
+t_mk1dspec.x
+t_mknoise.x
+t_mkobjects.x
+lists/t_starlist.x
+lists/t_gallist.x
+doc/mk1dspec.hlp
+doc/mknoise.hlp
+doc/mkobjects.hlp
+doc/starlist.hlp
+doc/gallist.hlp
+    If the random number seed is specified as INDEF then the task will
+    use the clock time (seconds since 1980) as the seed.  This allows
+    users to get different random numbers for each execution.
+    (9/23/97, Valdes)
+
+t_mk1dspec.x
+    If the dispersion was negative the task would fail to make the lines.
+    (6/2/97, Valdes)
+
+doc/mk1dspec.hlp
+    Fixed minor typo.  (6/2/97, Valdes)
+
+doc/mkpattern.hlp
+    Updated for changes.  (4/22/97, Valdes)
+
+artdata.par
+doc/mknoise.hlp
+doc/mkobjects.hlp
+    Changed the default for "ranbuf" to zero.  (1/29/97, Valdes)
+
+lists/stdbio.x
+    The parameter information in the output now begins with #.
+    (12/30/96, Valdes)
+
+t_mknoise.x
+t_mk1dspec.x
+t_mk2dspec.x
+t_mkechelle.x
+t_mkobjects.x
+t_mkpattern.x
+    Changed logic to work around the fact that IMACCESS does not always
+    work.  This became a problem with the FITS kernel.  (11/11/96, Valdes)
+
+t_mkpattern.x
+mkpattern.par
+doc/mkpattern.hlp
+    Added "ushort" and "complex" data types.  (11/8/96, Valdes)
+
+numrecipes.x
+    Modified the Poisson deviate routine to return zero for input
+    values less than or equal to zero.  (10/1/96, Valdes)
+
+lists/stdbio.x
+    Modified the list formatting code to print the x and y centers of
+    the objects to 3 decimal places of precision. (8/27/96, Davis)
+
+mkpattern.par
+    An ndim of zero is now allowed.  (8/15/96, Valdes)
+
+mkobjects.par
+doc/mkobjects.hlp
+    Modified the prompt for "background" and the help page to indicate
+    that the value is in data numbers.  (6/27/96, Valdes)
+
+t_mkechelle.x
+    The DC-FLAG was not being set correctly for raw extracted spectra.
+    (4/26/96, Valdes)
+
+doc/mk1dspec.hlp
+    Minor clarification of how the peak parameter is used if a line
+    list is given but there is not peak value.  (10/12/95, Valdes)
+
+gallist.par
+    Changed the "ar" parameter to a default value of 0.3 corresponding
+    to the range E0 to E7.  (10/10/95, Valdes)
+
+voigt.x			+
+mk1dspec.par
+t_mk1dspec.x
+mkpkg
+mkexamples/henear.cl
+mkexamples/heneardc.cl
+mkexamples/longslit.cl
+mkexamples/multifiber.cl
+mkexamples/spectrum.cl
+doc/mk1dspec.hlp
+    1.	MK1DSPEC now includes gaussian, lorentzian, and voigt line profiles.
+	There were parameter changes and changes to the input/output
+	line lists.
+    2.  The example scripts calling MK1DSPEC were modified for the changes
+	to task though they still use only gaussian lines.  The spectra
+	will not be exactly the same because the order of the random
+	numbers has changed.
+    (7/28/95, Valdes)
+
+=======
+V2.10.4
+=======
+
+artdata$t_mk1dspec.x
+    Fixed two type mismatches in min/max calls.  (12/31/94, Valdes)
+
+artdata$lists/stmix.x
+    The calculation of absorption in spiral models was not working and
+    so no absorption effect was being added as described in the help.
+    This has been fixed.  (10/29/94, Valdes)
+
+xtools$numrecipes.x
+    The POIDEV routine can still have a problem in that the tan function
+    can return a very large number triggering either an overflow in
+    the evaluation of em or in the int truncation of em as addressed
+    below.  A test is now made on the value of the tan function.
+    (9/14/94, Valdes)
+
+artdata$mknoise.par
+artdata$doc/mknoise.hlp
+    The help was inconsistent with the task in that any background specified
+    is added to both new and existing images.  The discussion of subtracting
+    the background in existing images was wrong.  The "background" parameter
+    was moved in the par file from the NEW IMAGE section.
+    (7/1/94, Valdes)
+
+artdata$mktemplates.x
+    The structure parameter MKT_SCALE was incorrectly defined as an
+    integer resulting in the output scales of the "expdisk" and "devauc"
+    objects to be incorrect (see bug log 226).  (9/17/93, Valdes)
+
+artdata$t_mkpattern.x
+    Fixed bug in indexing.  This bug was most noticible with the checkerboard
+    and a larger size which showed the first square was too small by 1.
+    (9/2/93, Valdes)
+
+artdata$mkexamples/longslit.cl
+artdata$mkexamples/lsgal.cl +
+artdata$twodspec.men
+     Added an example,lsgal, of an extended longslit galaxy spectrum.
+     (8/21/93, Valdes)
+
+artdata$numrecipes.x
+    The POIDEV routine from Numerical Recipes can try to coerce a large
+    floating point number to an integer which can cause an exception.
+    If the value is 100 or greater a Gaussian deviate is now returned.
+    (8/11/93, Valdes)
+
+=============
+V2.10.3. beta
+=============
+
+artdata$t_mkobjects.x
+artdata$t_mknoise.x
+    The min/max data values are computed and set in the output image.
+    (4/16/93, Valdes)
+
+artdata$mkexamples
+    1.  The MKEXAMPLES task now provides multiple menus.
+    2.  The spectrum examples have been organized by type.
+    3.  New spectrum examples have been added.
+    4.  The echelle and onedspec examples use the oseed to set the number
+	of orders/apertures.
+    (3/17/93, Valdes)
+
+artdata$t_mkechelle.x
+artdata$t_mk1dspec.x
+artdata$mk1dspec.par
+artdata$doc/t_mk1dspec.hlp
+mkpkg
+    1.  Modified to use SMW WCS routines.
+    2.  The mk1dspec.format parameter was eliminated.
+    (3/17/93, Valdes)
+
+artdata$mkheader.x
+    Added a double type to mkh_comment1.  (3/17/93, Valdes)
+
+artdata$mkobjects.x
+artdata$doc/mkobjects.hlp
+    Changed the behavior of xoffset and yoffset to be the offset after
+    distance scaling to allow having a fixed origin.  (3/16/93, Valdes)
+
+artdata$lists/stplot.x
+    When there is only one object or when all objects have the same value
+    then the symbol size scaling with amapr gave a floating operand error.
+    A check has been added for this.  (3/16/93, Valdes)
+
+artdata$t_mkechelle.x
+    The method of generating random lines was incorrect.  This showed up
+    when trying to make the same set of random lines with a different
+    velocity.  (3/1/93, Valdes)
+
+ardata$t_mkobjects.x
+ardata$t_mknoise.x
+ardata$t_mkechelle.x
+ardata$t_mk2dspec.x
+ardata$t_mk1dspec.x
+ardata$mkheader.x
+    Replaced use of '\t' in the comment with spaces. (11/12/92, Valdes)
+
+artdata$mktemplates.x
+    In mkt_binprof there was no check that the central subpixels were
+    within the profile.  For very small objects this could lead to
+    out of bounds references in the prof array.  A check on this was
+    added.  (10/30/92, Valdes)
+
+artdata$t_mk2dspec.x
+artdata$t_mkechelle.x
+    Add a limit check to prevent integration of a pixel outside the profile
+    interpolation function.   (8/14/92, Valdes)
+
+artdata$t_mkechelle.x
+    Changed a "** 1.5" to a combination of square root and an integer
+    third power.  (8/10/92, Valdes)
+
+=======
+V2.10.2
+=======
+=======
+=======
+V2.10.1
+=======
+=======
+V2.10.0
+=======
+
+artdata$t_mkechelle.x
+    "min (tt" --> "min (tt[i]" and  "max (tt" --> "max (tt[i]"
+    (6/23/92, Valdes)
+
+=====
+V2.10
+=====
+
+artdata$mkexamples/*
+artdata$doc/mkexamples.hlp
+    Added parameter to control whether comments are generated in the
+    examples.  (1/31/92, Valdes)
+
+artdata$mktemplate.x
+    Made substantial changes to how the user and analytic profiles are
+    handled.  Primarily, the prefered form for both user supplied and
+    analytic profiles is as intensity profiles rather than cumulative
+    flux profiles.  Cumulative profiles may still be input and they are
+    identified by having a zero initial element.  (12/13/91, Valdes)
+
+artdata$mktemplates.x
+    Very large gaussians showed an dip in the center due to problems with
+    mkt_fixprof.  A better algorithm was instituted.  (12/11/91, Valdes)
+
+artdata$lists/stmix.x
+    1.  The random component of the size distribution for the Schecter function
+    was incorrect.  It was giving a 100% random factor and was reducing
+    the size by 40%.  The fix is 0.2 + 0.4 * urand() ==> 0.8 + 0.4 * urand().
+    2.  The roundness distribution for ellipical galaxies was done incorrectly.
+    (11/26/91, Valdes)
+
+artdata$lists/stdbio.x
+    Instead of putting out beta in the log for the schecter function changed
+    to put out mstar.  (11/26/91, Valdes)
+
+artdata$t_mk1dspec.x
+artdata$t_mkechelle.x
+    Fixed minor bugs found by SPPLINT.  (11/21/91, Valdes)
+
+artdata$mktemplates2.x
+artdata$lists/stlumold.x
+    Delete old versions.  (11/21/91, Valdes)
+
+artdata$doc/t_mkpattern.x
+    Fixed an error in mkpattern:
+	max (1, (line-1))  -->  max (1, line)
+    (10/15/91, Valdes)
+
+artdata$doc/mk1dspec.hlp
+    Need to indicate that the blackbody flux is per unit wavelength.
+    (10/9/91, Valdes)
+
+artdata$t_mkpattern.x
+    For 1D images the pattern made corresponded to line 0 instead of line 1.
+    (7/26/91, Valdes)
+
+artdata$mktemplates.x
+    The PSF position angle was not being converted to radians from degrees
+    with the result that the input was interpreted as radians.  The
+    conversion with DEGTORAD was added.  (6/10/91, Valdes)
+
+artdata$t_mkechelle.x
+artdata$mkechelle.par
+artdata$doc/mkechelle.hlp
+artdata$t_mk1dspec.x
+artdata$x_artdata.x
+artdata$artdata.cl
+artdata$artdata.men
+artdata$artdata.hd
+artdata$mkpkg
+artdata$mkexamples/ecarc2d.cl
+artdata$mkexamples/ecobj2d.cl
+artdata$mkexamples/ecarc1d.cl
+artdata$mkexamples/ecarcdc.cl
+artdata$mkexamples/ecthorium.dat
+artdata$mkexamples/mkexamples.men
+    1.  Added new artificial echelle task.
+    2.  Added echelle examples.
+    3.  Fixed minor bug in MK1DSPEC concerning header format of wend parameter.
+    (3/20/91, Valdes)
+
+artdata$
+  mkheader.x +
+  mkpkg
+  t_mkobjects.x, mkobjects.par, doc/mkobjects.hlp
+  t_mkpattern.x, mkpattern.par, doc/mkpattern.hlp
+  t_mknoise.x,   mknoise.par,   doc/mknoise.hlp
+  t_mk2dspec.x,  mk2dspec.par,  doc/mk2dspec.hlp
+  t_mk1dspec.x,  mk1dspec.par,  doc/mk1dspec.hlp
+  t_mkheader.x,  mkheader.par,  doc/mkheader.hlp
+  artdata.men
+  stdheader.dat
+    1.  Separated out header stuff into separate file.
+    2.  Changed format of header keyword file to be FITS-like including
+	understanding the output of IMHEADER.  The default file
+	stdheader.dat was changed appropriately.
+    3.  Added capability to copy an image header when creating a new
+	image.
+    4.  MKHEADER can append or replace a header from an image or
+	a header keyword file.  The clobber parameter was changed
+	to append.  The verbose parameter now lists only the image
+	and source of header changes rather than individual keywords.
+    (1/16/91, Valdes)
+
+artdata$mktemplates.x
+    Fixed bug preventing template memory stored in the symbol table
+    from being freed.  (12/4/90, Valdes)
+
+artdata$mktemplates.x
+    Changed seeing sampling from 40% to 80% for image template psfs.
+    (11/13/90, Valdes)
+
+artdata$t_mk1dspec.x
+artdata$t_mk2dspec.x
+artdata$t_mkobjects.x
+artdata$t_mknoise.x
+artdata$mk1dspec.par
+artdata$mk2dspec.par
+artdata$mkobjects.par
+artdata$mknoise.par
+artdata$doc/mk1dspec.hlp
+artdata$doc/mk2dspec.hlp
+artdata$doc/mkobjects.hlp
+artdata$doc/mknoise.hlp
+artdata$mkexamples/
+    1. MK1DSPEC now can create multispec/echelle format images.
+    2. Added switch to turn off comments.
+    (11/7/90, Valdes)
+
+artdata$t_mkobjects.x
+    1. Added object list file name to the header comments.
+    2. Fixed bug which caused objects which went off the edge and were
+       exactly at a half pixel boundry (i.e. 32.5) to end up off by one
+       pixel.
+    (10/23/90, Valdes)
+
+artdata$mktemplates.x
+    Replaced use of i as the function value returned by immap and open
+    with im and fd respectively.  For unknown reasons the HPUX compiler
+    left the value of i at 0 after the function call.  (10/10/90, Valdes)
+
+artdata$artdata.cl
+artdata$artdata.hd
+artdata$artdata.men
+artdata$doc/mkexamples.hlp +
+artdata$mkexamples/	+
+artdata$mkexamples/mkexamples.cl +
+artdata$mkexamples/mkexamples.men +
+artdata$mkexamples/globular.cl +
+artdata$mkexamples/multifiber.cl +
+artdata$mkexamples/longslit.cl +
+artdata$mkexamples/galcluster.cl +
+artdata$mkexamples/galfield.cl +
+artdata$mkexamples/starfield.cl +
+    1.  A new task, MKEXAMPLES, has been added to make some standard examples
+	for demonstrations and task scripts in this and other packages.
+    2.  The task is driven by simple script files located in the logical
+	directory mkexamples$.
+
+artdata$artdata.cl
+artdata$artdata.hd
+artdata$artdata.men
+artdata$artdata.par
+artdata$x_artdata.x
+artdata$mkheader.par +
+artdata$mk1dspec.par
+artdata$mk2dspec.par
+artdata$mknoise.par
+artdata$mkobjects.par
+artdata$stdheader.dat +
+artdata$mkpkg
+artdata$t_mkheader.x +
+artdata$t_mk1dspec.x
+artdata$t_mk2dspec.x
+artdata$t_mknoise.x
+artdata$t_mkobjects.x
+artdata$doc/mkheader.hlp +
+artdata$doc/mkobjects.hlp
+artdata$doc/mknoise.hlp
+artdata$doc/mk1dspec.hlp
+artdata$doc/mk2dspec.hlp
+    1.  A new task, MKHEADER, has been added to add or modify image headers
+	using a header keyword data file.
+    2.  The tasks MKOBJECTS, MKNOISE, MK1DSPEC, and MK2DSPEC have a new
+	parameter, header, which allows specifying a header keyword data
+	file.  A standard header data file is used as the default.
+    3.  The tasks MKOBJECTS, MKNOISE, MK1DSPEC, and MK2DSPEC add some
+	some header parameters such as gain, rdnoise, and exptime as
+	well as extensively comment task and data file parameters.
+    4.  The package version number was incremented.
+
+artdata$mktemplates.x
+    1.  The logic for discriminating between an image template and profile
+	file doesn't work because IMACCESS does not check if the file is
+	an image.  Modified to use an error check on IMMAP.
+    2.  The ACCESS call to test for access to a profile file had a missing
+	third argument causing a segmentation error on at least Sun3.
+    3.  For the star profile input an initialization of nxm was missing
+	and a malloc used nxm instead of j resulting in an alloc of 0 length.
+    Basically the profile file input was not working.  (8/9/90, Valdes)
+
+artdata$mktemplates.x
+    The gaussian radius was being treated as a full width resulting in
+    stars which are half that expected.  (7/19/90, Valdes)
+
+artdata$t_mkobjects
+    A rounding error for objects which go off the
+    lower edges was causing the objects to appear one pixel offset to larger
+    numbers.  Replaced rounding done by adding 0.5 by nint.  (7/2/90, Valdes)
+
+artdata$t_mk1dspec.x
+artdata$mk1dspec.par
+artdata$doc/mk1dspec.hlp
+    Added redshifting capability.  (5/18/90, Valdes)
+
+====
+V2.9
+====
+
+artdata$t_mkpattern.x
+    The COORDINATES pattern was off by 1.  (3/12/90, Valdes)
+
+artdata$
+    Davis, Feb 19, 1990
+    1. The STARLIST and GALLIST tasks for making artificial star and
+    galaxies fields were added to the artdata package.
+
+artdata$* +
+    First version of the artificial data package installed.  (2/1/90, Valdes)
+
+.endhelp
diff --git a/noao/artdata/artdata.cl b/noao/artdata/artdata.cl
new file mode 100644
index 00000000..4aa3c59b
--- /dev/null
+++ b/noao/artdata/artdata.cl
@@ -0,0 +1,18 @@
+#{ ARTDATA - Artificial data package
+
+package artdata
+
+task	gallist,
+	mk1dspec,
+	mk2dspec,
+	mkechelle,
+	mkheader,
+	mknoise,
+	mkobjects,
+	mkpattern,
+	starlist	= "artdata$x_artdata.e"
+
+set	mkexamples	= "artdata$mkexamples/"
+task	mkexamples	= "mkexamples$mkexamples.cl"
+
+clbye()
diff --git a/noao/artdata/artdata.hd b/noao/artdata/artdata.hd
new file mode 100644
index 00000000..3ecf368b
--- /dev/null
+++ b/noao/artdata/artdata.hd
@@ -0,0 +1,19 @@
+# Help directory for the ARTDATA package.
+
+$defdir		= "noao$artdata/"
+$doc		= "noao$artdata/doc/"
+$lists		= "noao$artdata/lists/"
+$mkexamples	= "noao$artdata/mkexamples/"
+
+gallist		hlp=doc$gallist.hlp,    src=lists$t_gallist.x
+mk1dspec	hlp=doc$mk1dspec.hlp,	src=t_mk1dspec.x
+mk2dspec	hlp=doc$mk2dspec.hlp,	src=t_mk2dspec.x
+mkechelle	hlp=doc$mkechelle.hlp,	src=t_mkechelle.x
+mkexamples	hlp=doc$mkexamples.hlp,	src=mkexamples$mkexamples.cl
+mkheader	hlp=doc$mkheader.hlp,	src=t_mkheader.x
+mknoise		hlp=doc$mknoise.hlp,	src=t_mknoise.x
+mkobjects	hlp=doc$mkobjects.hlp,	src=t_mkobjects.x
+mkpattern	hlp=doc$mkpattern.hlp,	src=t_mkpattern.x
+starlist	hlp=doc$starlist.hlp,   src=lists$t_starlist.x
+
+revisions	sys=Revisions
diff --git a/noao/artdata/artdata.men b/noao/artdata/artdata.men
new file mode 100644
index 00000000..5d4459f4
--- /dev/null
+++ b/noao/artdata/artdata.men
@@ -0,0 +1,10 @@
+        gallist - Make an artificial galaxies list
+       mk1dspec - Make/add artificial 1D spectra
+       mk2dspec - Make/add artificial 2D spectra using 1D spectra templates
+      mkechelle - Make artificial 1D and 2D echelle spectra
+     mkexamples - Make artificial data examples
+       mkheader - Append/replace header parameters
+        mknoise - Make/add noise and cosmic rays to 1D/2D images
+      mkobjects - Make/add artificial stars and galaxies to 2D images
+      mkpattern - Make/add patterns to images
+       starlist - Make an artificial star list
diff --git a/noao/artdata/artdata.par b/noao/artdata/artdata.par
new file mode 100644
index 00000000..1cae6c77
--- /dev/null
+++ b/noao/artdata/artdata.par
@@ -0,0 +1,14 @@
+# ARTDATA - Artificial data package
+
+nxc,i,h,5,1,,Number of PSF centers per pixel in X
+nyc,i,h,5,1,,Number of PSF centers per pixel in Y
+nxsub,i,h,10,1,,Number of pixel subsamples in X
+nysub,i,h,10,1,,Number of pixel subsamples in Y
+nxgsub,i,h,5,1,,Number of galaxy pixel subsamples in X
+nygsub,i,h,5,1,,Number of galaxy pixel subsamples in Y
+dynrange,r,h,100000.,2.,,Profile intensity dynamic range
+psfrange,r,h,10.,2.,,PSF convolution dynamic range
+ranbuf,i,h,0,0,,"Random number buffer size
+"
+version,s,h,"V1.1: August 1990"
+mode,s,h,ql
diff --git a/noao/artdata/doc/gallist.hlp b/noao/artdata/doc/gallist.hlp
new file mode 100644
index 00000000..e1f87623
--- /dev/null
+++ b/noao/artdata/doc/gallist.hlp
@@ -0,0 +1,488 @@
+.help gallist Feb90 noao.artdata
+.ih
+TASK
+gallist -- make an artificial galaxies list
+.ih
+USAGE
+gallist gallist ngals
+.ih
+PARAMETERS
+.ls gallist
+The name of the output text file for the x and y coordinates,
+magnitudes, profile types, half-flux radii, axial ratios, and position
+angles of the artificial galaxies.  Output will be appended to this
+file if it exists.
+.le
+.ls ngals = 100
+The number of galaxies in the output galaxies list.
+.le
+.ls interactive = no
+Examine plots and change the parameters of the spatial, luminosity, and
+morphology distributions interactively.
+.le
+
+			SPATIAL DISTRIBUTION
+.ls spatial = "uniform"
+Type of spatial distribution for the galaxies.  The types are:
+.ls uniform
+The galaxies are uniformly distributed between \fIxmin\fR, \fIxmax\fR,
+\fIymin\fR, and \fIymax\fR.
+.le
+.ls hubble
+The galaxies are distributed around the center of symmetry \fIxcenter\fR and
+\fIycenter\fR according to a Hubble density law of core radius
+\fIcore_radius\fR and background density \fIbase\fR.
+.le
+.ls file
+The radial density function is contained in the text file \fIsfile\fR.
+.le
+.le
+.ls xmin = 1., xmax = 512., ymin = 1., ymax = 512.
+The range of the output coordinates in pixels.
+.le
+.ls xcenter = INDEF, ycenter = INDEF
+The coordinate of the center of symmetry for the "hubble"
+and "file" radial density functions. The default is the
+midpoint of the coordinate limits.
+.le
+.ls core_radius = 50
+The core radius of the Hubble density distribution in pixels.
+.le
+.ls base = 0.0
+The background density relative to the central density of the Hubble
+density distribution.
+.le
+.ls sseed = 2
+The initial value supplied to the random number generator used to
+generate the output x and y coordinates.
+If a value of "INDEF" is given then the clock
+time (integer seconds since 1980) is used as the seed yielding
+different random numbers for each execution.
+.le
+
+			MAGNITUDE DISTRIBUTION
+.ls luminosity = "powlaw"
+Type of luminosity distribution for the galaxies.  The types are:
+.ls uniform
+The galaxies are uniformly distributed between \fIminmag\fR and
+\fImaxmag\fR.
+.le
+.ls powlaw
+The galaxies are distributed according to a power law with coefficient
+\fIpower\fR.
+.le
+.ls schecter
+The galaxies are distributed according to a Schecter luminosity
+function with characteristic magnitude \fImstar\fR and power law exponent
+\fIalpha\fR between \fIminmag\fR and \fImaxmag\fR.
+.le
+.ls file
+The luminosity function is contained in the text file \fIlfile\fR.
+.le
+.le
+.ls minmag = -7., maxmag = 0.
+The range of output relative magnitudes.
+.le
+.ls mzero = 15.
+Magnitude zero point for Schecter luminosity function.
+.le
+.ls power = 0.6
+Coefficient for the power law magnitude distribution The default value
+of 0.6 is the Euclidean value.
+.le
+.ls alpha = -1.24
+The power law exponent of the Schecter luminosity function.
+The default value is that determined by Schecter from nearby galaxies.
+.le
+.ls mstar = -21.41
+The characteristic magnitude of the Schecter luminosity function.
+.le
+.ls lseed = 2
+The initial value supplied to the random number generator used to
+generate the output magnitudes.
+If a value of "INDEF" is given then the clock
+time (integer seconds since 1980) is used as the seed yielding
+different random numbers for each execution.
+.le
+
+			MORPHOLOGY DISTRIBUTION
+.ls egalmix = 0.4
+The fraction of the galaxies that are "ellipticals" represented
+by a de Vaucouleurs surface brightness law as opposed to "spirals"
+represented by an exponential disk surface brightness law.
+.le
+.ls ar = 0.3
+Minimum elliptical galaxy axial ratio (major/minor ratio).
+.le
+.ls eradius = 20.0
+The maximum elliptical galaxy half-flux semi-major scale radius.  This is
+the radius of an elliptical galaxy with magnitude \fIminmag\fR
+before a random factor is added.  Spiral galaxies and fainter galaxies
+are scaled from this value.
+.le
+.ls sradius = 1.0
+Ratio between half-flux scale radii of spiral and elliptical models at the
+same magnitude.  For example an elliptical galaxy with magnitude
+\fIminmag\fR will have radius \fIeradius\fR while a spiral galaxy
+of the same magnitude with have radius \fIsradius\fR * \fIeradius\fR.
+.le
+.ls absorption = 1.2
+Absorption correction for edge on spirals in magnitudes.
+.le
+.ls z = 0.05
+Minimum redshift for power law distributed galaxies.  This is the
+redshift assigned galaxies of magnitude \fIminmag\fR.  The redshifts
+are assumed proportional to the square root of the apparent luminosity;
+i.e the luminosity distance proportional to redshift.  The redshift is used
+for computing the mean apparent sizes of the galaxies
+according to (1+z)**2 / z.
+.le
+
+			USER FUNCTIONS
+.ls sfile = ""
+The name of the input text file containing the sampled spatial radial
+density
+function, one sample point per line, with the radius and relative probability
+in columns one and two respectively. The sample points need not be
+uniformly spaced or normalized.
+.le
+.ls nssample = 100
+The number of points at which the spatial density function is 
+sampled. If the spatial density function is analytic or approximated
+analytically (the "hubble" option) the function is sampled
+directly. If the function is read from a file  (the "file" option) an
+initial smoothing step is performed before sampling.
+.le
+.ls sorder = 10
+The order of the spline fits used to evaluate the integrated spatial
+density function.
+.le
+.ls lfile = ""
+The name of the input text file containing the sampled luminosity
+function, one sample point per line, with the magnitude and relative
+probability in columns one and two respectively. The sample points need
+not be uniformly spaced or normalized.
+.le
+.ls nlsample = 100
+The number of points at which the luminosity function is 
+sampled. If the luminosity function is analytic or approximated
+analytically (the "uniform", "powlaw" and "schecter" options) the
+function is sampled directly.  If it is read from a file
+(the "file" option) an initial smoothing step is performed before sampling.
+.le
+.ls lorder = 10
+The order of the spline fits used to evaluate the integrated
+luminosity function.
+.le
+
+			INTERACTIVE PARAMETERS
+.ls rbinsize = 10.
+The bin size in pixels of the plotted histogram of the radial density
+distribution.
+.le
+.ls mbinsize = 0.5
+The bin size in magnitudes of the plotted histogram of the luminosity function.
+.le
+.ls dbinsize = 0.5
+The bin size in pixels of the plotted histogram of the half-power semi-major
+axis distribution.
+.le
+.ls ebinsize = 0.1
+The bin size of the plotted histogram of the axial ratio distribution.
+.le
+.ls pbinsize = 20.
+The bin size in degrees of the plotted histogram of the position angle
+distribution.
+.le
+.ls graphics = stdgraph
+The default graphics device.
+.le
+.ls cursor = ""
+The graphics cursor.
+.le
+.ih
+DESCRIPTION
+\fBGallist\fR generates a list of x and y coordinates, magnitudes,
+morphological types, half-power radii, axial ratios, and position
+angles for a sample of \fIngals\fR galaxies based on a user selected
+spatial density function \fIspatial\fR  and luminosity function
+\fIluminosity\fR and writes (appends) the results to the text file
+\fIgallist\fR. If the \fIinteractive\fR parameter is "yes" the user can
+interactively examine plots of the spatial density function, the
+radial density function,  the luminosity function, radii, axial ratios,
+and position angle distributions and alter the parameters of the task
+until a satisfactory artificial field is generated.
+
+The spatial density function generates x and y values around a center
+of symmetry defined by \fIxcenter\fR and \fIycenter\fR within the x and
+y limits \fIxmin\fR, \fIxmax\fR, \fIymin\fR and \fIymax\fR according to
+the spatial density function specified by \fIspatial\fR.  The three
+supported spatial density functions are listed below where R is the
+radial distance in pixels, P is the relative spatial density, C is a
+constant, and f is the best fitting cubic spline function to the spatial
+density function R(user), P(user) supplied by the user in the text file
+\fIsfile\fR.
+
+.nf
+  uniform:  P = C
+  hubble:   P = 1.0 / (1 + R / core_radius) ** 2 + base
+  file:     P = f (R(user), P(user))
+.fi
+
+The Hubble and user spatial density functions are sampled at
+\fInssample\fR equally spaced points, and integrated to give the
+spatial density probability function at each sampled point. The
+integrated probability function is normalized and approximated by a
+cubic spline of order \fIsorder\fR.  The x and y coordinates are
+computed by randomly sampling the integrated probability function until
+\fIngals\fR galaxies which satisfy the x and y coordinate limits
+\fIxmin\fR, \fIxmax\fR, \fIymin\fR and \fIymax\fR are generated.
+
+The luminosity function generates relative magnitude values between
+\fIminmag\fR and \fImaxmag\fR (before absorption effects are added)
+according to the luminosity function specified by \fIluminosity\fR.
+The four supported luminosity functions are listed below where M is the
+magnitude, P is the relative luminosity function, C is a constant and f
+is the best fitting cubic spline function to the luminosity function
+M(user), P(user) supplied by the user in the text file \fIlfile\fR.
+
+.nf
+  uniform:   P = C
+  powlaw:    P = C * 10. ** (power * M)
+  schecter:  P = C * 10. ** (alpha * dM) * exp (-10. ** dM)
+  file:      P = f (M(user), P(user))
+
+  where      dM = 0.4 * (mstar - M + mzero)
+.fi
+
+The uniform distribution is not very physical but may be useful for
+testing.  The power law distribution is that expected for a homogeneous
+and isotropic distribution of galaxies.  The default value of 0.6 is
+that which can be calculated simply from Euclidean geometry.  Observations
+of faint galaxies generally show a smaller value.  The Schecter
+function provides a good approximation to a galaxy cluster when
+used in conjunction with the Hubble spatial distribution (though there
+is no mass segregation applied).  The "best fit" values for the
+parameters \fImstar\fR and \fIalpha\fR are taken from the paper by
+Schecter (Ap.J 203, 297, 1976).  The \fImzero\fR parameter is used
+to convert to absolute magnitudes.  Note that it is equivalent to
+set \fImzero\fR to zero and adjust the characteristic magnitude
+to the same relative magnitude scale or to use absolute magnitudes
+directly.
+
+The Schecter and user file distributions are sampled at \fInlsample\fR
+equally spaced points, and integrated to give the luminosity
+probability function at each sampled point. The probability function is
+normalized and approximated by a cubic spline of order \fIlorder\fR.
+The magnitudes are computed by randomly sampling the integrated
+probability function until \fIngals\fR objects which satisfy the
+magnitude limits \fIminmag\fR and \fImaxmag\fR are generated.
+
+The artificial galaxies have one of two morphological types,
+"ellipticals" with a de Vaucouleurs surface brightness law and
+"spirals" with an exponential surface brightness law. The fraction
+of elliptical galaxies is set by the parameter \fIegalmix\fR.  The
+position angles of the major axis are distributed uniformly between 0.0
+and 360.0 degrees.  The axial ratio (major to minor) of the elliptical
+models is allowed to range uniformly between 1 and \fIar\fR
+(that is E0 - E7).
+
+The spiral models have inclinations, i, ranging uniformly between 0 and
+90 degrees.  The axial ratio is then given by
+
+	a/b = sqrt (sin(i)**2 * .99 + .01)
+
+which is taken from Holmberg in Galaxies and the Universe (which
+references the work of Hubble).  Note the axial ratio is limited to
+0.1 by this formula.  An internal absorption correction is then
+made based on the inclination using the relation
+
+	dM = A * (min (10, cosecant (i)) - 1) / 9
+
+where is the absorption of an edge on galaxy relative to face on and
+the cosecant is limited to 10.  Note that this correction changes
+allows galaxies with magnitudes less than \fImaxmag\fR and alters
+the luminosity function somewhat.  Or in other words, the luminosity
+function is based on absorption corrected magnitudes.
+
+The sizes of the galaxy images are scaled from the maximum half-flux
+radius of an elliptical galaxy given by the parameter \fIeradius\fR.
+This is the radius given to an elliptical galaxy of magnitude
+\fIminmag\fR (prior to adding a random factor described below).  The
+ratio between the half-flux radii of the exponential disk and de
+Vaucouleurs models at a given total magnitude is set by the parameter
+\fIsradius\fR (note this is a fraction of \fIeradius\fR and not an
+actual radius).  This allows adjusting the relative surface brightness
+of elliptical and spiral models.
+
+The distribution of sizes is based on the apparent
+magnitude of the galaxies.  For the power law magnitude distribution
+the cosmological redshift factor for angular diameters is used.  The
+redshift/magnitude relation is assumed to be such that the redshift is
+proportional to the luminosity distance (the square root of the
+apparent luminosity).  Thus,
+
+
+.nf
+                Z = z * 10. ** (0.2 * (M - minmag))
+                Zfactor = ((1+Z)**2 / Z) / ((1+z)**2 / z)
+  ellipticals:  r = eradisus * Zfactor
+  spirals:      r = sradius * eradius * Zfactor
+.fi
+
+where z is the reference redshift at the minimum magnitude, and Z is the
+redshift at magnitude M.  For very small z the size varies as the
+luminosity distance but at larger z the images appear more extended with
+lower surface brightness.  For very deep simulations a pure luminosity
+distance relation gives faint galaxies which are too small and compact
+compared to actual observations.
+
+For the other magnitude distributions, the Schecter cluster function
+in particular where all galaxies are at the same distance, the scale radius
+obeys the following relation.
+
+.nf
+  ellipticals:  r = eradius * 10. ** ((minmag - M) / 6)
+  spirals:      r = sradius * eradius * 10. ** ((minmag - M) / 6)
+.fi
+
+This relation gives the size decreasing slightly less rapidly than that
+giving a constant surface brightness.  This relation is taken from
+Holmberg (Galaxies and the Universe).
+
+A uniform random factor of 50% is added to the sizes computed for
+the power law magnitude distribution and 20% for the other distributions.
+
+The interactive spatial plot shows the positions of the galaxies, the
+galaxy type (circles are de Vaucouleurs profiles and other types are
+diamonds), and rough size.
+.ih
+CURSORS
+The following interactive keystroke commands are available from within the
+GALLIST task.
+
+.nf
+	Gallist Keystroke Commands
+
+?	Print options
+f	Fit one or more of following 
+	    Spatial density function (SDF)
+            Luminosity  function (LF)
+	    Distribution of morphological type
+	    Diameter distribution
+	    Roundness distribution
+	    Position angle distribution 
+x	Plot the x-y spatial density function
+r	Plot the histogram of the radial density function
+m	Plot the histogram of the luminosity function
+d	Plot the histogram of the diameter values
+e	Plot the histogram of the roundness values 
+p	Plot the histogram of the position angle values
+:	Colon escape commands (see below)
+q	Exit program
+.fi
+
+The following parameters can be shown or set from within the GALLIST task.
+
+.nf
+		Gallist Colon Commands
+
+:show			Show gallist parameters
+:ngal       [value]	Number of galaxies
+
+:spatial    [string]	Spatial density function (SDF) (uniform|hubble|file) 
+:xmin       [value]	Minimum X value
+:xmax       [value]	Maximum X value
+:ymin       [value]	Minimum Y value
+:ymax       [value]	Maximum Y value
+:xcenter    [value]	X center for SDF
+:ycenter    [value]	Y center for SDF
+:core       [value]	Core radius for Hubble density function
+:base       [value]	Background density for Hubble density function
+
+:luminosity [string]	Luminosity function (LF)
+			(uniform|powlaw|schecter|file)
+:minmag     [value]	Minimum magnitude
+:maxmag     [value]	Maximum magnitude
+:mzero      [value]	Magnitude zero-point of schecter LF
+:power      [value]     Power law coefficient for powlaw LF
+:alpha      [value]	Schecter parameter
+:mstar      [value]	Characteristic mag for Schecter LF
+
+:egalmix    [value]	Elliptical/Spiral galaxy ratio
+:ar         [value]     Minimum elliptical galaxy axial ratio
+:eradius    [value]     Maximum elliptical half flux radius
+:sradius    [value]     Spiral/elliptical radius at same magnitude
+:z          [value]     Minimum redshift
+:absorption [value]     Absorption correction for spirals
+
+:lfile      [string]    Name of the LF file
+:sfile	    [string]    Name of the SDF file
+:nlsample   [value]	Number of LF sample points 
+:lorder	    [value]	Order of spline approximation to the integrated LF
+:nssample   [value]	Number of SDF sample points
+:sorder	    [value]	Order of spline approximation to the integrated SDF
+
+:rbinsize   [value]	Resolution of radial SDF histogram in pixels
+:mbinsize   [value]	Resolution of magnitude histogram in magnitudes
+:dbinsize   [value]	Resolution of diameter histogram in pixels
+:ebinsize   [value]	Resolution of roundness histogram in pixels
+:pbinsize   [value]     Resolution of position angle histogram in degrees
+.fi
+.ih
+EXAMPLES
+1. Create a galaxy cluster with a power law distribution of field galaxies
+and stars as background/foreground.
+
+.nf
+    ar> gallist galaxies.dat 100 spatial=hubble lum=schecter egal=.8
+    ar> gallist galaxies.dat 500
+    ar> starlist galaxies.dat 100
+    ar> mkobjects galaxies obj=galaxies.dat gain=3 rdnoise=10 poisson+
+.fi
+
+Note that the objects are appended to the same file.  Actually making
+the image with \fBmkobjects\fR takes about 5 minutes (2.5 min cpu) on a
+SPARCstation 1.
+
+2. Examine the distributions for a uniform spatial distribution
+and power law magnitude distribution using 1000 galaxies without
+creating a data file.
+
+.nf
+    ar> gallist dev$null 1000 inter+
+	    ... an x-y plot will appear on the screen
+	    ... type r to examine the radial density function
+	    ... type m to examine the luminosity function
+	    ... type d to examine the half-flux radii distribution
+	    ... type e to examine the axial ratio distribution
+	    ... type = to make a copy of any of the plots
+	    ... type q to quit
+.fi
+.ih
+REVISIONS
+.ls GALLIST V2.11+
+The random number seeds can be set from the clock time by using the value
+"INDEF" to yield different random numbers for each execution.
+.le
+.ls GALLIST V2.11
+The default value for the minimum elliptical galaxy axial ratio was
+change to 0.3 to cover the range E0-E7 uniformly.
+.le
+.ih
+BUGS
+This is a first version and is not intended to produce a full model
+of galaxy fields.  Some of the relations used are empirical and
+simple minded with the aim being to produce reasonably realistic images.
+
+The spline approximation to the spatial density and luminosity
+probability functions can cause wiggles in the output spatial density
+and luminosity functions. Users can examine the results interactively
+and experiment with the spline order and number of sample points if
+they are not satisfied with the results of GALLIST. The default setup
+of 10 sample points per spline piece is generally satisfactory for the
+spatial density and luminosity functions supplied here.
+.ih
+SEE ALSO
+starlist mkobjects
+.endhelp
diff --git a/noao/artdata/doc/mk1dspec.hlp b/noao/artdata/doc/mk1dspec.hlp
new file mode 100644
index 00000000..b96684a8
--- /dev/null
+++ b/noao/artdata/doc/mk1dspec.hlp
@@ -0,0 +1,355 @@
+.help mk1dspec Jul95 noao.artdata
+.ih
+NAME
+mk1dspec -- Make/add artificial 1D spectra
+.ih
+USAGE
+mk1dspec input
+.ih
+PARAMETERS
+.ls input
+Spectra to create or modify.
+.le
+.ls output = ""
+Output spectra when modifying input spectra.  If no output spectra are
+given then existing spectra in the input list are modified directly.
+If an output list is given then it must match in number the input list.
+.le
+.ls ap = 1
+Image line to be created or modified in images of dimension greater than 1.
+.le
+.ls rv = 0.
+Radial velocity (km/s) or redshift, as selected by the parameter \fIz\fR,
+applied to line positions and continuum.  Velocities are converted to
+redshift using the relativistic relation 1+z = sqrt ((1+rv/c)/(1-rv/c)).
+Note the shift is not a shift in the dispersion parameters but in the
+underlying artificial spectrum.
+.le
+.ls z = no
+Is the velocity parameter a radial velocity or a redshift?
+.le
+
+WHEN CREATING NEW SPECTRA
+.ls title = ""
+Image title to be given to the spectra.  Maximum of 79 characters.
+.le
+.ls ncols = 512
+Number of columns.
+.le
+.ls naps = 1
+Number of lines or apertures.
+.le
+.ls header = "artdata$stdheader.dat"
+Image or header keyword data file.  If an image is given then the image header
+is copied.  If a file is given then the FITS format cards are copied.
+This only applies to new images.   The data file consists of lines
+in FITS format with leading whitespace ignored.  A FITS card must begin
+with an uppercase/numeric keyword.  Lines not beginning with a FITS
+keyword such as comments or lower case are ignored.  The user keyword
+output of \fBimheader\fR is an acceptable data file.  See \fBmkheader\fR
+for further information.
+.le
+.ls wstart = 4000., wend = 8000.
+Starting and ending wavelengths in Angstroms.  The dispersion is
+determined by these values and the number of columns.
+.le
+
+CONTINUUM PARAMETERS
+.ls continuum = 1000., slope = 0.
+Continuum of the starting wavelength at rest and the slope of the continuum.
+.le
+.ls temperature = 5700.
+Blackbody continuum temperature in Kelvin.  A value of 0 is used if
+no blackbody continuum is desired.  The intensity level is set by
+scaling to the continuum level of the starting wavelength at rest.
+.le
+.ls fnu = no
+Compute the continuum as flux per unit frequency (F-nu) if yes or flux per
+unit wavelength (F-lambda) if no.
+.le
+
+
+LINE PARAMETERS
+.ls lines = ""
+List of spectral line files.  Spectral line files contain lines of rest
+wavelength, peak, profile type, and widths (see the DESCRIPTION
+section).  The latter parameters may be missing or INDEF in which case they
+default to the task \fIpeak\fR, \fIprofile\fR, \fIgfwhm\fR, and \fIlfwhm\fR
+parameters (note that the \fIpeak\fR parameter is not a constant but the
+random number scaling).  If no file or a new (nonexistent) file is
+specified then a number of random lines given by the parameter \fInlines\fR
+is generated.  If a new file name is specified then the lines generated are
+recorded in the file.  If the list of spectral line files is shorter than
+the list of input spectra, the last spectral line list file is reused.
+.le
+.ls nlines = 0
+If no spectral line file or a new file is specified then the task will
+generate this number of random spectral lines.  The rest wavelengths are
+uniformly random within the limits of the spectrum, the peaks are uniformly
+random between zero and the value of the \fIpeak\fR parameter, the profile
+type is given by \fIprofile\fR, and the widths are fixed at the values of
+the \fIgfhwm\fR ad \fIlfwhm\fR parameters.  If a redshift is applied the
+rest wavelengths are shifted and repeated periodically.
+.le
+.ls profile = "gaussian" (gaussian|lorentzian|voigt)
+The default profile type for random lines or when not specified in the
+spectral line file.  The profile types are:
+
+.nf
+      gaussian - Gaussian profile
+    lorentzian - Lorentzian profile
+         voigt - Voigt profile
+.fi
+.le
+.ls peak = -0.5
+The maximum spectral line peak value when generating random lines or
+when the peak is missing from the spectral line file.
+This value is relative to the continuum unless the continuum is zero.
+Negative values are absorption lines and positive values are emission lines.
+.le
+.ls gfwhm = 20., lfwhm = 20.
+The default gaussian and lorentzian full widths at half maximum (FWHM), in
+Angstroms, used when generating random lines or when the widths are missing
+from the spectral line file.
+.le
+.ls seed = 1
+Random number seed.  If a value of "INDEF" is given then the clock
+time (integer seconds since 1980) is used as the seed yielding
+different random numbers for each execution.
+.le
+
+.ls comments = yes
+Include comments recording task parameters in the image header?
+.le
+
+PACKAGE PARAMETERS
+.ls nxsub = 10
+Number of pixel subsamples used in computing the gaussian spectral line
+profiles.
+.le
+.ls dynrange = 100000.
+The gaussian line profiles extend to infinity so a dynamic range, the ratio
+of the peak intensity to the cutoff intensity, is imposed to cutoff
+the profiles.
+.le
+.ih
+DESCRIPTION
+This task creates or modifies one dimensional spectra.  with a combination
+of blackbody and linear sloped continuum and emission and absorption
+spectral lines.  The spectral lines may be gaussian, lorentzian, or voigt
+profiles.  A velocity shift may be applied to the underlying artificial
+spectrum which is shifted into the specified observed wavelength region.
+No noise is included but may be added with the task \fBmknoise\fR.  New
+spectra are created with the specified number of pixels, wavelength range,
+and real datatype.  When \fInlines\fR is greater than 1 then an image with
+the specified number of lines is created though only the line given by the
+\fIap\fR is will have a spectrum.  Existing spectra may be modified in
+place or new spectra output.  Spectra are modified by adding the continuum
+and lines defined by the parameters.
+
+For new images a set of header keywords may be added by specifying an image
+or data file with the \fIheader\fR parameter (see also \fBmkheader\fR).  If
+a data file is specified lines beginning with FITS keywords are entered in
+the image header.  Leading whitespace is ignored and any lines beginning
+with words having lowercase and nonvalid FITS keyword characters are
+ignored.  In addition to this optional header, parameters for the
+wavelength coordinates are defined.  Finally, comments may be added to the
+image header recording the task parameters and any information from the
+line file which are not line definitions.
+
+Initially all spectra are created without a dispersion function; i.e.
+pixel coordinates.  For multiple spectra in an image this task must be
+executed for each image line to set the dispersion function and add data.
+When an image line is selected if it has a defined dispersion function that
+is used otherwise the task wavelength parameters are used.
+
+A continuum is defined by the value at the starting wavelength at rest, a
+slope, and a blackbody function of a given temperature.  The blackbody
+function is scaled to have the specified continuum value at the starting
+wavelength at rest.  The blackbody flux units are per unit wavelength
+(F-lambda).  A zero continuum value or a zero temperature will not produce a
+blackbody continuum.
+
+Spectral lines are modeled by gaussian, lorentzian, or voigt profiles of
+specified wavelength, peak, and widths.  The lines are defined in a
+spectral line file or generated randomly.  A spectral line file consists of
+text lines giving rest wavelength, peak, profile type, gaussian full width
+at half maximum and/or lorentzian full width at half maximum.  Only the
+wavelength is required and subsequent fields may be missing or given as
+INDEF.  The following table shows the possible formats where wavelength,
+peak,  gfwhm, and lfwhm are values of wavelength, peak, gaussian FWHM, and
+lorentzian FWHM.  The profile types are as shown though they may be
+abbreviated to one character.
+
+.nf
+	wavelength
+	wavelength peak
+	wavelength peak gaussian
+	wavelength peak gaussian gfwhm
+	wavelength peak gaussian gfwhm
+	wavelength peak lorentzian
+	wavelength peak lorentzian lfwhm
+	wavelength peak lorentzian lfwhm
+	wavelength peak voigt
+	wavelength peak voigt gfwhm
+	wavelength peak voigt gfwhm lfwhm
+	wavelength peak voigt gfwhm lfwhm
+.fi
+
+When a field is missing or INDEF the values given by the parameters
+\fIpeak\fR, \fIprofile\fR, \fIgfwhm\fR, and \fIlfwhm\fR are used.  If a
+peak value is missing, random values between zero and the \fIpeak\fR value
+are generated.  Note that to get random line intensities with some
+specified profile type and widths the value INDEF would be used for
+the peak field.
+
+If no spectral line file is specified or a new (nonexistent) file is named
+then the number of random lines given by the parameter \fInlines\fR is
+generated.  The rest wavelengths are uniformly random within the wavelength
+range of the spectrum and extend periodically outside this range in the
+case of an applied velocity shift, the peaks are uniformly random between
+zero and the \fIpeak\fR parameter, and the profile type and widths are
+given by the \fIprofile\fR, \fIgfwhm\fR, and \fIlfwhm\fR parameters.  If a
+new file is named then the parameters of the generated lines will be
+output.
+
+The peak values are taken relative to a positive continuum.  In other
+words the generated line profile is multiplied by the continuum (with a
+minimum of zero for fully saturated absorption lines).  If the
+continuum is less than or equal to zero, as in the case of an
+artificial arc spectrum or pure emission line spectrum, then the peak
+values are absolute intensities.  Positive peak values produce emission
+lines and negative values produce absorption lines.  Odd results will
+occur if the continuum has both positive and zero or negative values.
+
+The underlying rest spectrum may be shifted.  This is used primarily for
+testing radial velocity measuring algorithms and is not intended as a
+complete model of redshift effects.  The starting and ending wavelengths
+are not changed by redshifting; these are the instrumental observed
+wavelengths.  Input line wavelengths are specified at rest and then
+shifted into or out of the final spectrum.  To be realistic the line
+list should include wavelengths over a great enough range to cover
+all desired redshifts.  The peaks and widths are also appropriately
+modified by a redshift.  As an example, if the redshift is 1 the
+lines will appear broader by a factor of 2 and the peaks will be down
+by a factor of 2 in order to maintain the same flux.
+
+The random line generation is difficult in that one wants to have the
+same set of lines (for a given seed) observed at different redshifts.
+What is done is that the specified number of random lines is generated
+within the observed wavelength interval taken at rest.  This set is
+then repeated periodical over all wavelengths.  A redshift will then
+shift these rest lines in to or out of the observed spectrum.  If the
+lines are output, they are given at rest.  \fBNote that this
+periodicity may be important in interpreting cross correlation redshift
+tests for large shifts between template and object spectra.\fR
+
+The definitions of the continuum are also affected by a redshift.
+The reference point for the continuum level, slope, and blackbody
+continuum is the starting wavelength taken at rest.  Shifts will then
+modify the continuum level at the first pixel appropriately.  In
+particular a large redshift will shift the blackbody in such a way that
+the flux is still given by the \fIcontinuum\fR parameter at the starting
+wavelength at rest.
+.ih
+EXAMPLES
+1. Create a simple blackbody continuum between the default wavelengths.
+
+.nf
+	cl> mk1dspec bb title=Blackbody
+.fi
+
+2. Create a random absorption spectrum on a blackbody continuum without
+saving the line list.
+
+.nf
+	cl> mk1dspec bbab title=Absorption nlines=100
+.fi
+
+3. Create a random absorption spectrum with noise and cosmic rays.
+
+.nf
+	cl> mk1dspec bbab title=Absorption nlines=100
+	cl> mknoise bbab rdnoise=10 poisson+ ncos=5 energy=1000
+.fi
+
+4. Create a random emission spectrum on a blackbody continuum and save
+the line list.
+
+.nf
+	cl> mk1dspec bbem title=Emission nl=30 peak=0.6 lines=bbem.dat
+.fi
+
+5. Create an artificial random arc line spectrum.
+
+.nf
+	cl> mk1dspec arc title="Arc lines" cont=0 peak=500 nl=30
+.fi
+
+6. Create a test spectrum with a line list.
+
+.nf
+	cl> type linelist
+	4100 -.1 g 20
+	4200 -2. g 20
+	4300 -.3 g 20
+	5100 -.9 g 2
+	5200 -.9 g 4
+	5300 -.9 g 8
+	6700 .9 g 8
+	6800 .9 g 2
+	6900 .9 g 4
+	7700 .3 g 20
+	7800 .2 g 20
+	7900 .1 g 20
+	cl> mk1dspec testspec title=Test cont=500 temp=0 lines=linelist
+.fi
+
+7. Add absorption lines to a spectrum.
+
+.nf
+	cl> mk1dspec bb out=artspec cont=0 lines=STDIN
+	4300 -60
+	5000 -200
+	[EOF]
+.fi
+
+Normally the input spectrum would be a real spectrum.
+
+8. Make two spectra taken from the same set of random lines but differing
+in redshift.
+
+.nf
+	cl> mk1dspec restspec nl=30
+	cl> mk1dspec redspec rv=3000 nl=30
+	cl> mk1dspec bluespec rv=-.01 z+ nl=30
+.fi
+
+9. Make a multispec image with 5 apertures and a range of redshifts.
+
+.nf
+	cl> mk1dspec spec.ms ap=1 nl=30 rv=0 naps=5
+	cl> mk1dspec spec.ms ap=2 nl=30 rv=1000
+	cl> mk1dspec spec.ms ap=3 nl=30 rv=2000
+	cl> mk1dspec spec.ms ap=4 nl=30 rv=3000
+	cl> mk1dspec spec.ms ap=5 nl=30 rv=4000
+.fi
+.ih
+REVISIONS
+.ls MK1DSPEC V2.11+
+The random number seed can be set from the clock time by using the value
+"INDEF" to yield different random numbers for each execution.
+.le
+.ls MK1DSPEC V2.11
+Lorentzian and Voigt profiles were added and the parameters and input
+line list format were changed.  The widths are now FWHM instead of
+gaussian sigmas.
+.le
+.ls MK1DSPEC V2.10.3
+The format parameter was eliminated and the task updated to produce the
+current coordinate system format.
+.le
+.ih
+SEE ALSO
+mknoise, mk2dspec, mkheader, onedspec.sinterp
+.endhelp
diff --git a/noao/artdata/doc/mk2dspec.hlp b/noao/artdata/doc/mk2dspec.hlp
new file mode 100644
index 00000000..44336400
--- /dev/null
+++ b/noao/artdata/doc/mk2dspec.hlp
@@ -0,0 +1,207 @@
+.help mk2dspec Aug90 noao.artdata
+.ih
+NAME
+mk2dspec -- Make/add 2D spectra using 1D spectra templates
+.ih
+USAGE
+mk2dspec input
+.ih
+PARAMETERS
+.ls input
+Spectra to create or modify.
+.le
+.ls output = ""
+Output spectra when modifying input spectra.  If no output spectra are
+given then existing spectra in the input list are modified directly.
+If an output list is given then it must match in number the input list.
+.le
+.ls models = ""
+List of model parameter files.  If the list of model files is shorter than the
+list of input images then the last model file is reused.  The model
+parameter files contain lines giving one dimensional spectrum template
+name, intensity scale, type of cross dispersion profile, profile
+width in the center line, change of width per line, profile position
+in the center line, and change of position per line (see the DESCRIPTION
+section).
+.le
+.ls comments = yes
+Include comments recording task parameters in the image header?
+.le
+
+WHEN CREATING NEW SPECTRA
+.ls title = ""
+Image title to be given to the spectra.  Maximum of 79 characters.
+.le
+.ls ncols = 100, nlines = 512
+Number of columns and lines.
+.le
+.ls header = "artdata$stdheader.dat"
+Image or header keyword data file.  If an image is given then the image header
+is copied.  If a file is given then the FITS format cards are copied.
+This only applies to new images.   The data file consists of lines
+in FITS format with leading whitespace ignored.  A FITS card must begin
+with an uppercase/numeric keyword.  Lines not beginning with a FITS
+keyword such as comments or lower case are ignored.  The user keyword
+output of \fBimheader\fR is an acceptable data file.  See \fBmkheader\fR
+for further information.
+.le
+.ih
+DESCRIPTION
+This task creates or modifies two dimensional spectra by taking one
+dimensional spectra, convolving them with a spatial profile across the
+dispersion, and adding them into two dimensional images.  The one
+dimensional spectra may be real data or artificial data created with
+the task \fBmk1dspec\fR.  No noise is included but may be added with
+the task \fBmknoise\fR.  The spatial profile is fully subsampled and
+may vary in width and position along the dispersion axis.  The spatial
+axis is along the first dimension and the dispersion is along the
+second dimension.
+
+For new images a set of header keywords may be added by specifying an
+image or data file with the \fIheader\fR parameter (see also \fBmkheader\fR).
+If a data file is specified lines beginning with FITS keywords are
+entered in the image header.  Leading whitespace is ignored and any
+lines beginning with words having lowercase and nonvalid FITS keyword
+characters are ignored.  In addition, comments may be added to
+the image header recording the model file name and the contents of the
+model file.
+
+The spatial profile models are specified in one or more model parameter
+files.  These files contain lines giving a one dimensional spectrum template
+name, intensity scale, type of cross dispersion profile, profile
+width in the center line, change of width per line, profile position
+in the center line, and change of position per line.  More specifically:
+
+.ls <template name>
+The one dimensional spectrum template is any one dimensional IRAF image.
+If the spectrum template length is less than the two dimensional spectrum,
+the profile extends only over that number of lines and, if it is longer,
+then only the first part of the spectrum is used.
+.le
+.ls scale
+The template spectrum is scaled by this parameter to define the
+total flux for the two dimensional profile.
+.le
+.ls <profile type>
+The spatial profiles are identified by two keywords, "gaussian"
+or "slit".  The profiles are defined by the following formulae,
+
+.nf
+    gaussian:   I(x) = exp (-ln(2) * (2*(x-xc)/fwhm)**2)
+        slit:   I(x) = exp (-ln(2) * (2*(x-xc)/fwhm)**10)
+.fi
+
+where x is the column coordinate, xc is the profile center, and
+fwhm is the full width at half maximum.  The "gaussian" profile
+is the usual gaussian specified in terms of a FWHM.  The "slit"
+profile is one which is relatively flat and then rapidly drops
+to zero.  The profile is normalized to unit integral so that
+the total flux across the profile is given by the scaled
+1D spectrum flux.
+.le
+.ls fwhm, dfwhm
+The full width at half maximum and derivative with line number.  The fwhm is
+defined for the middle of the image.  The FWHM as a function
+of line, l, is,
+
+	fwhm + (l - nlines/2) * dfwhm
+.le
+.ls center, dcenter
+The profile center and derivative with line number.  The center is
+defined for the middle of the image.  The center as a function
+of line, l, is,
+
+	center + (l - nlines/2) * dcenter
+.le
+
+The provision for having the spectra tilted relative to the columns is
+useful for understanding undersampling effects.  However, note that the
+spectral lines are not perpendicular to the dispersion but are always
+aligned with the image lines.
+.ih
+EXAMPLES
+1. Create an artificial multifiber spectrum:
+
+.nf
+	cl> type multifiber.dat
+	arc 4 gauss 3 0 20 .01
+	spec1 .5 gauss 3 0 30 .01
+	spec2 .4 gauss 3 0 40 .01
+	spec3 .9 gauss 3 0 50 .01
+	spec4 .2 gauss 3 0 60 .01
+	spec5 .6 gauss 3 0 70 .01
+	spec6 1 gauss 3 0 80 .01
+	spec7 1 gauss 3 0 90 .01
+	cl> mk1dspec arc cont=0 peak=500 nl=30
+	cl> mk1dspec spec1 nlines=99 seed=1
+	cl> mk1dspec spec2 nlines=80 seed=2
+	cl> mk1dspec spec3 nlines=45 seed=3
+	cl> mk1dspec spec4 nlines=95 seed=4
+	cl> mk1dspec spec5 nlines=66 seed=5
+	cl> mk1dspec spec6 nlines=90 seed=6
+	cl> mk1dspec spec7 nlines=85 seed=7
+	cl> mk2dspec multifiber model=multifiber.dat
+.fi
+
+In this example artificial one dimensional spectra are generated with
+\fBmk1dspec\fR.
+
+2. Create an artificial multislit spectrum:
+
+.nf
+	cl> type multislit.dat
+	arc 10 slit 18 0 120 .01
+	sky 2.5 slit 18 0 140 .01
+	sky 2.5 slit 18 0 160 .01
+	sky 2.5 slit 18 0 180 .01
+	sky 2.5 slit 18 0 200 .01
+	sky 2.5 slit 18 0 220 .01
+
+	spec1 .05 gauss 3 0 140 .01
+	spec2 .2 gauss 4 0 161 .01
+	spec3 .1 gauss 3 0 179 .01
+	spec4 .1 gauss 3 0 200 .01
+	spec5 .15 gauss 4 0 220 .01
+	cl> mk1dspec sky peak=1 nl=100
+	cl> mk2dspec multislit model=multislit.dat nc=400
+.fi
+
+Note how two spectra are overlaid to provide a sky spectrum with a
+narrower object spectrum.
+
+3. Create an artificial long slit spectrum:
+
+.nf
+	cl> type longslit.dat
+	sky 22 slit 160 0 220 .01 
+	spec5 .05 gauss 3 0 140 .01
+	spec1 .05 gauss 3 0 190 .01
+	spec4 .5 gauss 3 0 220 .01
+	spec2 2 gauss 40 0 220 .01
+	spec5 .1 gauss 3 0 240 .01
+	spec1 .02 gauss 3 0 290 .01
+	cl> mk2dspec longslit model=longslit.dat nc=400
+.fi
+
+Note how objects are overlaid on a long slit sky spectrum.  The width
+of the spec2 spectrum is wider simulating a galaxy spectrum.
+
+4. To include noise use the task \fBmknoise\fR:
+
+.nf
+	cl> mk2dspec longslit model=longslit.dat nc=400
+	cl> mknoise longslit rdnoise=10 gain=2 poisson+ ncos=100
+.fi
+
+5. Use a real long slit spectrum and add an object with an artificial spectrum:
+
+.nf
+	cl> mk1dspec artspec1d nlines=50
+	cl> mk2dspec ls005 out=ls005new model=STDIN
+	artspec1d 1 gauss 5 0 125 0
+	[EOF]
+.fi
+.ih
+SEE ALSO
+mk1dspec, mknoise, mkheader
+.endhelp
diff --git a/noao/artdata/doc/mkechelle.hlp b/noao/artdata/doc/mkechelle.hlp
new file mode 100644
index 00000000..34e022c5
--- /dev/null
+++ b/noao/artdata/doc/mkechelle.hlp
@@ -0,0 +1,585 @@
+.help mkechelle Mar93 noao.artdata
+.ih
+NAME
+mkechelle -- Make artificial echelle spectra
+.ih
+USAGE
+mkechelle images [clobber]
+.ih
+PARAMETERS
+.ls images
+List of echelle spectra to create or modify.
+.le
+.ls clobber (query)
+If an existing image is specified the clobber query parameter is used.
+Normally the parameter is not specified on the command line so that
+a query will be made for each image which exists.  Putting a value
+on the command line permanently overrides the query.  This should be
+done if the task is run in the background.
+.le
+.ls ncols = 512, nlines = 512, norders = 23
+For two dimensional spectra these parameters define the number of columns
+and lines in the final image and the maximum number of orders (there may be
+orders falling outside the image).  The dispersion is along the columns
+which is the second or line axis (dispersion axis is 2) so the number of
+columns is the number of pixels across the dispersion and the number of
+lines is the number of pixels along the dispersion per order.
+
+The extracted format turns the number of lines into the number columns
+and the number of orders is the number of lines; i.e the image
+has the specified number of extracted orders, one per image line,
+with the number of pixels along the dispersion specified by the
+\fInlines\fR parameter.  This is equivalent to what the \fBapextract\fR
+package would  produces for an extracted echelle format with an original
+dispersion axis of 2.  There is no check in this case for orders
+which might fall outside the two dimensional format; i.e. exactly
+the number of orders are created.
+.le
+.ls title = "Artificial Echelle Spectrum"
+Image title to be given to the spectra.  Maximum of 79 characters.
+.le
+.ls header = "artdata$stdheader.dat"
+Image or header keyword data file.  If an image is given then the image
+header is copied.  If a file is given then the FITS format cards are
+copied.  The data file consists of lines in FITS format with leading
+whitespace ignored.  A FITS card must begin with an uppercase/numeric
+keyword.  Lines not beginning with a FITS keyword such as comments or lower
+case are ignored.  The user keyword output of \fBimheader\fR is an
+acceptable data file.  See \fBmkheader\fR for further information.
+.le
+.ls list = no
+List the grating/instrument parameters?
+.le
+.ls make = yes
+Make the artificial spectra?  This is set to no if only the grating
+parameter listing is desired.
+.le
+.ls comments = yes
+Include comments recording task parameters in the image header?
+.le
+
+.ce
+FORMAT PARAMETERS
+.ls xc = INDEF, yc = INDEF
+The column and line position of the blaze peak in the reference order (see
+\fIorder\fR parameter.  If INDEF then the middle of the dimension is used.
+This allows setting the image center relative to the center of the echelle
+pattern.  As with the number of lines and columns the interpretation of
+these numbers relative to the image created depends on whether the format
+is extracted or not.
+.le
+.ls pixsize = 0.027
+Pixel size in millimeters.  This is used to convert the focal length
+and dispersion to pixels.  If INDEF then these parameters are
+assumed to be in pixels.
+.le
+.ls profile = "gaussian" (extracted|gaussian|slit)
+The order profile across the dispersion.  If the value is "extracted"
+then an extracted echelle format spectrum is produced.  Otherwise a
+two dimensional format with a gaussian or slit profile is produced.
+See \fBmk2dspec\fR for a discussion of the profile functions.
+.le
+.ls width = 5.
+If two dimensional echelle images are selected this parameter specifies
+the order profile full width at half maximum in pixels.  See \fBmk2dspec\fR
+for a fuller discussion.
+.le
+.ls scattered = 0.
+Scattered light peak flux per pixel.  A simple scattered light component
+may be included in the two dimensional format.  The scattered light has the
+blaze function shape of the central order along the dispersion and the
+crossdisperser blaze function shape across the dispersion with the peak
+value given by this parameter.  A value of zero indicates no scattered
+light component.
+.le
+
+.ce
+GRATING PARAMETERS
+
+Any of the following parameters may be specified as INDEF.  The missing
+values are resolved using the grating equations described in the
+DESCRIPTION section.  If it is not possible to resolve all the grating
+parameters but the order, wavelength, and dispersion are specified
+then a linear dispersion function is used.  Also in this case the
+extracted format will include dispersion information.
+.ls f = 590., cf = 590.
+Echelle and crossdisperser focal lengths in millimeters (if \fIpixsize\fR
+is given) or pixels.  Technically it is defined by the equation x = f * tan
+(theta) where x is distance from the optical axis on the detector and theta
+is the diffraction angle; i.e. it converts angular measures to millimeters
+or pixels on the detector.  If the focal length is specified as INDEF  it
+may be computed from the dispersion, which is required in this case, and
+the other parameters.
+.le
+.ls gmm = 31.6, cgmm = 226.
+Echelle and crossdisperser grating grooves per millimeter.  If specified as
+INDEF it may be computed from the order, which is required in this case,
+and the other parameters.
+.le
+.ls blaze = 63., cblaze = 4.53
+Echelle and crossdisperser blaze angles in degrees.  It is always specified or printed as a positive
+angle relative to the grating normal.  If specified as INDEF it is
+computed from the other parameters.
+.le
+.ls theta = 69., ctheta = -11.97
+Echelle and crossdisperser angles of incidence in degrees.  The angle of
+incidence must be in the plane perpendicular to face of the grating.  The
+angle of incidence may be specified relative to the grating normal or the
+blaze angle though it is always printed relative to the grating normal.  To
+specify it relative to the blaze angle add 360 degrees; for example to have
+an angle of 15 degrees less than the blaze angle specify 360 - 15 = 345.
+If the angle of incidence is specified as INDEF it is computed from the
+other parameters.
+.le
+.ls order = 112
+The central or reference echelle order for which the wavelength and
+dispersion are specified.  If specified as INDEF it will be computed from
+the grooves per mm, which is required in this case, and the other
+parameters.  In combination with the number of orders this defines the
+first and last orders.  The highest order is the central order plus
+the integer part of one half the number of orders.  However, the
+lowest order is constrained to be at least 1.  The
+reference order is also used in the definitions of \fIxc\fR and \fIyc\fR.
+.le
+.ls corder = 1
+The crossdisperser order for which the crossdisperser blaze wavelength and
+dispersion are specified.  If specified as INDEF it will be computed from
+the grooves per mm, which is required in this case, and the other
+parameters.
+
+If the order is zero then the other grating parameters are ignored and a
+prism-like dispersion is used with the property that the order spacing is
+constant.  Specifically the dispersion varies as the inverse of the
+wavelength with the \fIcwavelength\fR and \fIcdispersion\fR defining the
+function.
+.le
+.ls wavelength = 5007.49 cwavelength = 6700.
+Echelle and crossdisperser blaze wavelengths in Angstroms at the reference
+orders.  If specified as INDEF it will be computed from the other parameters.
+.le
+.ls dispersion = 2.61 cdispersion = 70.
+Echelle and crossdisperser blaze dispersions in Angstroms per millimeter
+(if \fIpixsize\fR is specified) or pixels.
+If specified as INDEF it will be computed from the focal length, which is
+required in this case, and the other parameters.
+.le
+
+.ce
+SPECTRA PARAMETERS
+.ls rv = 0.
+Radial velocity (km/s) or redshift, as selected by the parameter \fIz\fR,
+applied to line positions and continuum.  Velocities are converted to
+redshift using the relativistic relation 1+z = sqrt ((1+rv/c)/(1-rv/c)).
+Note the shift is not a shift in the dispersion parameters but in the
+underlying artificial spectrum.
+.le
+.ls z = no
+Is the velocity parameter a radial velocity or a redshift?
+.le
+.ls continuum = 1000.
+Continuum at the echelle blaze peak in the reference order.
+.le
+.ls temperature = 5700.
+Blackbody continuum temperature in Kelvin.  A value of 0 is used if
+no blackbody continuum is desired.  The intensity level is set by
+scaling to the continuum level at blaze peak reference point.
+.le
+
+.ls lines = ""
+List of spectral line files.  Spectral line files contain lines of rest
+wavelength, peak, and widths (see the DESCRIPTION section).
+The latter two parameters may be missing in which case they default to
+the task \fIpeak\fR and \fIsigma\fR parameters.  If no file or a new
+(nonexistent) file is specified then a number of random lines given by the
+parameter \fInlines\fR is generated.  If a new file name is specified then
+the lines generated are recorded in the file.  If the list of spectral
+line files is shorter than the list of input spectra, the last
+spectral line list file is reused.
+.le
+.ls nlines = 0
+If no spectral line file or a new file is specified then the task will
+generate this number of random spectral lines.  The rest wavelengths are
+uniformly random within the limits of the spectrum, the peaks are
+uniformly random between zero and the value of the \fIpeak\fR parameter
+and the width is fixed at the value of the \fIsigma\fR parameter.
+If a redshift is applied the rest wavelengths are shifted and repeated
+periodically.
+.le
+.ls peak = -0.5
+The maximum spectral line peak value when generating random lines or
+when the peak is missing from the spectral line file.
+This value is relative to the continuum unless the continuum is zero.
+Negative values are absorption lines and positive values are emission lines.
+.le
+.ls sigma = 1.
+The default line width as a gaussian sigma in Angstroms when generating
+random lines or when the width is missing from the spectral line file.
+.le
+.ls seed = 1
+Random number seed.
+.le
+
+PACKAGE PARAMETERS
+.ls nxsub = 10
+Number of pixel subsamples used in computing the gaussian spectral line
+profiles.
+.le
+.ls dynrange = 100000.
+The gaussian line profiles extend to infinity so a dynamic range, the ratio
+of the peak intensity to the cutoff intensity, is imposed to cutoff the
+profiles.
+.le
+.ih
+DESCRIPTION
+This task creates or adds to artificial extracted (one dimensional
+"echelle" format) or two dimensional echelle spectra.  The input spectrum
+(before modification by the spectrograph model) may be a combination of
+doppler shifted blackbody or constant continuum and emission and absorption
+gaussian profile spectral lines.  The lines may have randomly selected
+parameters or be taken from an input file.  Note that the parameters and
+method is similar to the task \fBmk1dspec\fR except that the input line list
+cannot specify a profile type and only Gaussian profiles are currently
+allowed.  The input spectrum is then
+separated out into echelle orders and either recorded as extracted one
+dimensional orders or convolved with a spatial profile and crossdispersed
+into a two dimensional image.  The properties of the echelle grating,
+crossdisperser, and instrumental configuration are modeled described
+later.
+
+If an existing image is specified the \fIclobber\fR parameter is used
+to determine whether to add the generated artificial echelle spectrum
+to the image.  Generally the clobber parameter is not specified on the
+command line to cause a query with the image name to be made for
+each image which already exists.  However, it is possible to put
+the clobber parameter on the command line to eliminate the query.
+This is appropriate for running the task in the background.
+
+There is \fIno\fR checking for consistency with an existing image;
+i.e. that it is an echelle image, whether it is an extracted format
+or a two dimensional spectrum, and what it's wavelength and order
+coverage is.  The only thing that happens is that the \fIncols\fR,
+\fInlines\fR, and \fInorders\fR parameters are replaced by the appropriate
+dimensions of the image with the choice between \fInlines\fR and
+\fInorders\fR made by the \fIprofile\fR parameter (as discussed below)
+and not by the format of the image.
+
+The created spectra are two dimensional, real datatype, images.  A title
+may be given and a set of header keywords be added by specifying an image
+or data file with the \fIheader\fR parameter (see also \fBmkheader\fR).  If
+a data file is specified lines beginning with FITS keywords are entered in
+the image header.  Leading whitespace is ignored and any lines beginning
+with words having lowercase and nonvalid FITS keyword characters are
+ignored.  In addition to this optional header, various parameters which
+occur during reduction of real echelle spectra, such a wavelength
+coordinates for extracted and dispersion corrected spectra, are added.
+Finally, comments may be added to the image header recording the task
+parameters and any information from the line file which are not line
+definitions.
+
+The creation of an artificial echelle spectra has three stages.  First a
+true spectrum is generated; i.e. the spectrum which arrives at the
+spectrograph.  The spectrum is then separated into orders and the
+dispersion and  blaze functions of the echelle and crossdisperser gratings
+(or crossdisperser prism) are applied.  Finally, if a two dimensional
+format is desired it is convolved by an spatial profile (either a gaussian
+or a broader slit-like profile) and the orders are placed as required by
+the crossdispersion relation.
+
+Generation of the model spectrum has three parts; defining a continuum,
+adding emission and absorption lines, and applying a doppler shift.  The
+continuum has two parameters; an intensity scale set by the \fIcontinuum\fR
+parameter and a shape set by the \fItemperature\fR parameter.  The
+intensity scale is set by defining the total, final, extracted intensity in
+a pixel at the blaze peak (rest) wavelength in the reference order; i.e. at
+the wavelength set by the \fIwavelength\fR parameter.  Note this means that
+the efficiency of the gratings at that wavelength is included.  The shape
+of the continuum may be either a blackbody if a positive temperature is
+specified or constant.
+
+Spectral lines are modeled by gaussian profiles of specified wavelength,
+peak, and sigma.  The lines are defined in a spectral line file or
+generated randomly.  A spectral line file consists of text lines giving
+rest wavelength, peak, and sigma.  The sigma or the sigma and peak may be
+absent in which case the parameters \fIsigma\fR and \fIpeak\fR will be
+used.  If peak values are missing random values between zero and the
+\fIpeak\fR value are generated.  Thus, a simple list of wavelengths or a
+list of wavelengths and peaks may be used.
+
+If no spectral line file is specified or a new (nonexistent) file is named
+then the number of random lines given by the parameter \fInlines\fR is
+generated.  The rest wavelengths are uniformly random within the wavelength
+range of the spectrum and extend periodically outside this range in the
+case of an applied velocity shift, the peaks are uniformly random between
+zero and the \fIpeak\fR parameter, and the widths are given by the
+\fIsigma\fR parameter.  If a new file is named then the parameters of the
+generated lines will be output.
+
+The peak values are taken relative to a positive continuum.  In other words
+the generated line profile is multiplied by the continuum (with a minimum
+of zero for fully saturated absorption lines).  If the continuum is less
+than or equal to zero, as in the case of an artificial arc spectrum or pure
+emission line spectrum, then the peak values are interpreted as absolute
+intensities.  Positive peak values produce emission lines and negative
+values produce absorption lines.  Odd results will occur if the continuum
+has both positive and zero or negative values.
+
+The width values are gaussian sigmas given in Angstroms.
+
+The underlying rest spectrum may be shifted.  This is used primarily for
+testing radial velocity measuring algorithms and is not intended as a
+complete model of redshift effects.  The observed wavelength coverage as
+defined by the grating parameters and number of orders is not changed by
+redshifting.  Input line wavelengths are specified at rest and then shifted
+into or out of the final spectrum.  To be realistic the line list should
+include wavelengths over a great enough range to cover all desired
+redshifts.  The peaks and sigma are also appropriately modified by a
+redshift.  As an example, if the redshift is 1 the lines will appear
+broader by a factor of 2 and the peaks will be down by a factor of 2 in
+order to maintain the same flux.
+
+The random line generation is complicated because one wants to have the
+same set of lines (for a given seed) observed at different redshifts.  What
+is done is that the specified number of random lines is generated within
+the observed wavelength interval taken at rest.  This set is then repeated
+periodical over all wavelengths.  A redshift will then shift these rest
+lines in to or out of the observed spectrum.  If the lines are output to a
+line file, they are given at rest.  \fBNote that this periodicity may be
+important in interpreting cross-correlation redshift tests for large shifts
+between template and object spectra.\fR
+
+The definitions of the continuum are also affected by a redshift.  The
+reference point for the continuum level and blackbody shape is the starting
+wavelength taken at rest.  Shifts will then modify the continuum level at
+the reference pixel appropriately.  In particular a large redshift will
+shift the blackbody in such a way that the flux is still given by the
+\fIcontinuum\fR parameter at the reference wavelength at rest.
+
+Once the input spectrum is defined it is modified by the effects of an
+echelle grating and crossdispersion.  This includes the dispersion relation
+between pixel and wavelength, the blaze response function of the gratings,
+and separation into orders.
+
+The primary reference for the model of the echelle grating (a
+crossdisperser grating also obeys this model) used in this task is "Echelle
+efficiencies: theory and experiment" by Schroeder and Hilliard in Applied
+Optics, Vol. 19, No. 16, 1980, p. 2833.  (The nomenclature below is similar
+to that paper except we use theta for alpha, their theta is theta - blaze,
+the reciprocal of the groove spacing which is the grooves per millimeter,
+and the dispersion per linear distance at the detector rather than per
+radian).  This task only treats the case where the incident beam is in the
+plane perpendicular to the grating face (gamma=0).  In this case the basic
+equation is
+
+.nf
+(1)	m * lambda = (sin(theta) + sin(beta)) / g
+.fi
+
+where m is the order, lambda the wavelength, g the grooves per wavelength
+unit, theta the angle of incidence to the grating normal, and beta the
+angle of diffraction to the normal.  The diffraction angle relative to that
+of the blaze maximum, psi, is given by
+
+.nf
+(2)	beta = psi + 2 * blaze - theta
+.fi
+
+where blaze is the blaze angle.  The diffraction angle psi is related to
+position on the detector, again measured from the blaze peak, by
+
+.nf
+(3)	x = f / pixsize * tan(psi)
+.fi
+
+where f is the effective focal length (as defined by this equation) and
+pixsize is the pixel size in millimeters that converts the detector
+positions to pixels.  If a pixel size is not specified then f will be
+taken as being in pixels.
+
+The second basic equation is the diffraction pattern or blaze response
+given by
+
+.nf
+(5)	I = I0 * (sin(delta) / delta) ** 2
+(6)	delta = 2 * pi / lambda * (cos(theta) / g) / cos(epsilon) *
+		sin(psi/2) * cos(epsilon-psi/2)
+(7)	epsilon = theta - blaze
+.fi
+
+where epsilon is the angle between the blaze angle and the angle of
+incidence (the theta of  Shroeder and Hilliard).  When theta = blaze, (6)
+simplifies to
+
+.nf
+(6a)	delta = pi / lambda * (cos (blaze) / g) * sin (psi)
+.fi
+
+As discussed by Schroeder and Hilliard, the relative intensity at the blaze
+peak, I0, must be reduced by the fraction of light at the same wavelength
+as the blaze peak which is diffracted into other orders.  Furthermore at
+some diffraction angles the light is reflected off the second face of the
+grating giving a different effective diffraction angle to be used in (6).
+This computation is done by the task giving a variation in relative blaze
+response with order and reproducing the calculations of Schroeder and
+Hilliard.  The absolute normalization, including the crossdisperser blaze
+function if any, is such that the response at the blaze peak of the
+reference order is unity.  This insures that specified continuum level at
+the reference wavelength is produced.
+
+At the blaze maximum psi = x = 0 and the wavelength and dispersion per
+millimeter on the detector are given by (1) and the derivative of (1) with
+respect to x:
+
+.nf
+(8)	wavelength = 1E7*(sin(theta)+sin(2*blaze-theta))/(gmm*order)
+(9)	dispersion = 1E7*cos(2*blaze-theta)/(gmm*order*f/pixsize)
+.fi
+
+The variable names are the same as the parameters in this task.   In
+particular, gmm is the echelle grooves per millimeter with the factors of
+1E7 (10 to the seventh power) to convert to Angstroms, the factor of f /
+pixsize to convert the dispersion to per pixel, and order is the reference
+order for the wavelength and dispersion.
+
+The \fBmkechelle\fR task provides different ways to define the parameters.
+If there is insufficient information to determine all the grating
+parameters but the wavelength, dispersion, order are specified then
+a simplified grating equation is used which is linear with pixel
+position.  The approximation is that tan(psi) = sin(psi) = psi so
+that
+
+.nf
+(9)	lambda = (order * wavelength + dispersion * x) / m
+               = (a + b * x) / m
+(10)	delta  = pi * order * dispersion / lambda * x
+               =  c / lambda * x
+.fi
+
+Also in this case the extracted format (described later) includes
+wavelength information in the header so that the spectra appear as fully
+dispersion corrected.
+
+If there are at least five of the seven grating parameters specified
+then equations (8) and (9) are used to determine
+unspecified parameters or to override parameters if the equations are
+overspecified.  For example, suppose the grooves per millimeter is known
+but not the blaze angle or focal length.  Then the wavelength and
+dispersion at the reference order are used to compute these quantities.
+
+The full set of grating parameters derived and used to create the spectra
+are documented in the image header if the \fIcomments\fR parameter is
+specified.  Also the \fIlist\fR parameter may be set to print the grating
+parameters and the \fImake\fR parameter may be set to no to check the
+grating parameters without making the spectra.
+
+The crossdisperser grating parameters are treated exactly as above except,
+since only one order is used, the relative blaze efficiency is not
+computed.
+
+There is a variant on the crossdispersion to allow a prism-like separation
+of the echelle orders.  If the crossdispersion grating order, \fIcorder\fR
+is set to zero then the other grating parameters are ignored and a
+prism-like dispersion is used with the property that the order spacing is
+constant.  Specifically the dispersion varies as the inverse of the
+wavelength with the \fIcwavelength\fR and \fIcdispersion\fR defining the
+function.  There is no crossdisperser blaze function in this case either;
+i.e. the relative intensities between orders is solely due to the echelle
+grating blaze response.
+
+There is an interesting effect which follows from the above equations but
+which is not obvious at first glance.  When the full grating equation is
+used the dispersion varies with wavelength.  This means the size of a pixel
+in wavelength varies and so the flux in a pixel changes.  The effect is
+such that the order intensity maximum shifts to the blue from the blaze peak
+because the pixel width in Angstroms increases to the blue faster, for a
+while, than the blaze response decreases.
+
+Once the spectrum has been separated into orders, modified by the
+grating blaze functions, and sampled into pixels in the dispersion
+direction it may be output as an extracted "echelle" format spectrum.
+This occurs when the spatial profile is specified as "extracted".
+The keywords added by the \fBapextract\fR package are included in
+the image header.  If the dispersion model is linear
+the keywords are the same as those produced by the dispersion
+correction task \fBecdispcor\fR.
+
+If the spatial profile is specified as "gaussian" or "slit" then the
+orders are convolved by the profile function and the crossdispersion
+relation is used to determine where the order falls at each wavelength.
+The spatial profiles are defined by the formulas:
+
+.nf
+    gaussian:   I(x) = exp (-ln(2) * (2*(x-xc(w))/width)**2)
+        slit:   I(x) = exp (-ln(2) * (2*(x-xc(w))/width)**10)
+.fi
+
+where x is the spatial coordinate, xc(w) is the order center at
+wavelength w, and width is the full width at half maximum specified by
+the parameter of that name.  The "gaussian" profile
+is the usual gaussian specified in terms of a FWHM.  The "slit"
+profile is one which is relatively flat and then rapidly drops
+to zero.  The profile is normalized to unit integral so that
+the total flux across the profile is given by the scaled
+1D spectrum flux.  The profile is fully sampled and then binned to
+the pixel size to correctly include sampling effects as a function
+of where in a pixel the order center falls.
+
+Note that in this model the orders are always tilted with respect
+to the columns and constant wavelength is exactly aligned with the
+image lines.
+.ih
+EXAMPLES
+1. Create an absorption spectrum with blackbody continuum and scattered
+light using the default grating parameters then add noise.
+
+.nf
+	cl> mkechelle ex1 nrand=100 scat=100.
+	cl> mknoise ex1 gain=2 rdnoise=5 poisson+
+.fi
+
+2. Create an arc spectrum using the line list noao$lib/onedstds/thorium.dat.
+
+.nf
+	cl> mkechelle ex2 cont=10 temp=0 \
+	lines=noao$lib/onedstds/thorium.dat peak=1000 sigma=.05
+.fi
+
+Note that the line intensities are random and not realistic.  The peak
+intensities range from 0 to 1000 times the continuum or 10000.
+
+3. Create an extracted version of example1.
+
+.nf
+	cl> mkechelle ex1.ec prof=extracted nrand=100 scat=100.
+	cl> mknoise ex1.ec gain=2 rdnoise=5 poisson+
+.fi
+
+Note that the noise is different and greater than would be the case with
+extracting the orders of example 1 because the noise is not summed
+over the order profile but is added after the fact.
+
+4. Create an extracted and dispersion corrected version of example1.
+
+.nf
+	cl> mkechelle ex1.ec prof=extracted nrand=100 scat=100. \
+	gmm=INDEF blaze=INDEF theta=INDEF
+	Echelle grating: Using linear dispersion
+	Warning: Insufficient information to resolve grating parameters
+	cl> mknoise ex1.ec gain=2 rdnoise=5 poisson+
+.fi
+
+The warning is expected.  By not specifying all the parameters needed to
+fully model an echelle grating the default action is to use a linear
+dispersion in each order and to set the image header dispersion
+information.  When a complete grating model is specified, as in example 3,
+the extracted spectrum is not given dispersion information so that the
+nonlinear behavior of the dispersion can be applied by \fBecidentify\fR and
+\fBdispcor\fR.  As with example 3, the noise is different since it is added
+after extraction and dispersion correction.
+.ih
+REVISIONS
+.ls MKECHELLE V2.10.3
+The task was updated to produce the current coordinate system format.
+.le
+.ih
+SEE ALSO mknoise, mk1dspec, mk2dspec, mkheader, astutil.gratings
+.endhelp
diff --git a/noao/artdata/doc/mkexamples.hlp b/noao/artdata/doc/mkexamples.hlp
new file mode 100644
index 00000000..b3b012a0
--- /dev/null
+++ b/noao/artdata/doc/mkexamples.hlp
@@ -0,0 +1,167 @@
+.help mkexamples Mar93 noao.artdata
+.ih
+NAME
+mkexamples - Make artificial data example images
+.ih
+USAGE
+mkexamples name image
+.ih
+PARAMETERS
+.ls name
+Example name (abbreviations are not allowed):
+
+.nf
+     galcluster - Galaxy cluster
+       globular - Globular cluster
+       galfield - Galaxy field
+      starfield - Starfield
+
+         henear - Helium-neon-argon spectrum (uncalibrated)
+       heneardc - Helium-neon-argon spectrum (calibrated)
+
+          ecarc - Echelle thorium-argon spectrum (uncalibrated)
+        ecarcdc - Echelle thorium-argon spectrum (calibrated)
+
+       spectrum - Absorption spectrum (calibrated)
+        echelle - Echelle absorption spectrum (calibrated)
+
+        ecarc2d - Echelle thorium-argon slit spectrum
+        ecobj2d - Echelle object slit spectrum
+
+          lsarc - Long slit helium-neon-argon spectrum
+	  lsobj - Long slit object spectrum
+
+     multifiber - Multifiber spectrum
+.fi
+.le
+.ls image
+Output image name.
+.le
+.ls oseed = 1
+Random number seed affecting object generation.  Different object seeds
+will produces different examples of objects or spectral lines or number
+of apertures/orders.  This
+usually modifies the seed parameters in \fBstarlist\fR, \fBgallist\fR,
+and \fBmk1dspec\fR.
+.le
+.ls nseed = 1
+Random number noise seed.  Different noise seeds will produce examples
+with different noise, generally of the same level but simply having
+a different pattern.  This is usually the seed parameter in
+\fBmkobjects\fR or \fBmknoise\fR.
+.le
+.ls comments = no
+Add comments to the image header describing various artificial data
+parameters?
+.le
+.ls verbose = yes
+Print message indicating image being created?
+.le
+.ls errors = yes
+Print messages if the image already exists, bad example name, or other
+errors?
+.le
+.ls list = no
+List script used to generate the example rather than create an image?
+.le
+.ih
+DESCRIPTION
+The task is intended to generate a few artificial images of various types to
+be used as examples of the artificial data package and in various
+demonstrations and test procedures for other packages.  The examples are not 
+exhaustive.  The only adjustable parameters are variations of the
+random number seeds.  Varying the noise seed allows several observations
+of the same example while varying the object seed allows several observations
+of different "fields", spectral lines, or number of apertures/orders.
+
+If the example name is not given on the command line a menu of example
+names is first printed and then a prompt for the name is given.
+The name may be a submenu or an example.  The
+names may not be abbreviated.  If desired the simple command
+script used to generate the example may be paged.  Otherwise the
+specified image will be generated.  Keep in mind that some of the
+examples (particularly those generating galaxy images) may take a
+significant amount of time.  On a SPARCstation the examples all run in
+under five minutes.  A check is made to see if the image already
+exists.  If the image exists then the task exits.  If the \fIerrors\fR
+parameter is specified an error message is printed.
+
+A reason for the error output to be turned off is in test scripts and
+demonstrations where the image will be created the first time and reused
+in further tests or demonstrations.  In such cases the verbose option is
+generally set so that the user is aware that an image is being created
+and some delay is to be expected.
+
+This task is a procedure script which selects and lists or executes
+any file in the mkexamples$ logical directory with the example name and the
+extension ".cl".  Thus, to add additional examples create a simple
+command script (not a procedure script) and place it in the mkexamples
+directory along with an entry in the menu file mkexamples$mkexamples.men.
+.ih
+EXAMPLES
+1. Create a globular cluster example.
+
+.nf
+    ar> mkexample
+	    		MKEXAMPLE Menu
+
+     galcluster - Galaxy cluster
+       globular - Globular cluster
+       galfield - Galaxy field
+      starfield - Starfield
+
+       onedspec - Menu of one dimensional spectra
+       twodspec - Menu of two dimensional spectra
+     threedspec - Menu of three dimensional spectra
+    Example name: globular
+    Image name: globular
+    Creating example globular in image globular ...
+.fi
+
+2.  Try and create the same example again.
+
+.nf
+    ar> mkexample globular globular
+    ERROR: Image globular already exists
+.fi
+
+3.  List the script which creates the globular example.
+
+.nf
+    ar> mkexample globular list+
+    # GLOBULAR - Globular cluster
+
+    file	image, dat
+
+    image = s1
+    dat = mktemp ("art")
+
+    starlist (dat, 5000, "", "", interactive=no, spatial="hubble",
+	xmin=1., xmax=512., ymin=1., ymax=512., xcenter=INDEF,
+	ycenter=INDEF, core_radius=30., base=0., sseed=i,
+	luminosity="bands", minmag=-7., maxmag=0., mzero=-4., power=0.6,
+	alpha=0.74, beta=0.04, delta=0.294, mstar=1.28, lseed=i,
+	nssample=100, sorder=10, nlsample=100, lorder=10,
+	rbinsize=10., mbinsize=0.5, graphics="stdgraph", cursor="")
+
+    mkobjects (image, output="", ncols=512, nlines=512,
+	title="Example artificial globular cluster",
+	header="artdata$stdheader.dat", background=1000., objects=dat,
+	xoffset=0., yoffset=0., star="moffat", radius=1.0, beta=2.5,
+	ar=1., pa=0., distance=1., exptime=1., magzero=7.,
+	gain=3., rdnoise=10., poisson=yes, seed=j)
+
+    delete (dat, verify=no)
+.fi
+.ih
+REVISIONS
+.ls MKEXAMPLES V2.10.3
+The examples have been expanded to include submenus.  The submenus organize
+the various types of spectra.  Additional spectral examples have been
+added.  The oseed parameter selects the number of apertures in the
+onedspec spectra and the number of orders in the echelle examples.
+.le
+.ih
+SEE ALSO
+mkobjects, mknoise, mk1dspec, mk2dspec, mkechelle
+.endhelp
diff --git a/noao/artdata/doc/mkheader.hlp b/noao/artdata/doc/mkheader.hlp
new file mode 100644
index 00000000..43b37895
--- /dev/null
+++ b/noao/artdata/doc/mkheader.hlp
@@ -0,0 +1,84 @@
+.help mkheader Aug90 noao.artdata
+.ih
+NAME
+mkheader - Append/replace image header
+.ih
+USAGE
+mkheader images headers
+.ih
+PARAMETERS
+.ls images
+List of images in which header information is to be added or modified.
+.le
+.ls header = "artdata$stdheader.dat"
+List of images or header keyword data files.  If the list is shorter
+than the input image list then the last entry is repeated.
+If an image is given then the image header
+is copied.  If a file is given then the FITS format cards are copied.
+This only applies to new images.   The data file consists of lines
+in FITS format with leading whitespace ignored.  A FITS card must begin
+with an uppercase/numeric keyword.  Lines not beginning with a FITS
+keyword such as comments or lower case are ignored.  The user keyword
+output of \fBimheader\fR is an acceptable data file.
+.le
+.ls append = yes
+Append to existing keywords?  If no then the existing header is replaced.
+.le
+.ls verbose = no
+Verbose output?
+.le
+.ih
+DESCRIPTION
+The image headers in the list of input images may be replaced or appended
+with information from images or data files specified by the \fIheader\fR
+parameter list.  If the header list is shorter than the list of images
+to be modified the last header file is repeated.  Depending on the
+value of the \fIappend\fR parameter, new parameters will be appended
+or replace the existing image header parameters.
+
+A header keyword data file consists of lines of FITS format cards.
+Leading whitespace is ignored.  Lines not recognized as FITS cards
+are ignored.  A valid FITS card is defined as beginning with a keyword
+of up to 8 uppercase, digit, hyphen, or underscore characters.  If
+less than 8 characters the remaining characters are blanks.  The
+ninth character may be an equal sign but must be immediately followed
+by a blank.  Such value cards should be in FITS format though no
+attempt is made to enforce this.  Any other ninth character is also
+acceptable and the line will be treated as a comment.  Note that this
+way of recognizing FITS parameters excludes the case of comments
+in which the first 8 characters are blank.  The reason for allowing
+leading whitespace and eliminating the blank keyword case is so that
+the long output of \fBimheader\fR may be used directly as input.
+
+Header files are also used by several of the tasks in the artificial
+data package with a standard default file "artdata$stdheader.dat".
+To edit image headers also see \fBhedit\fR.
+.ih
+EXAMPLES
+1. Add some standard keywords from a file to an image.
+
+.nf
+    ar> type myheader
+    # MY header list
+    INSTRUME= 'bspec mark II'		/ B Spectrograph
+    LENS    =                  3	/ Lens number
+    FOCRATIO=                5.2        / Focal ratio
+    ar> mkheader *.imh myheader
+.fi
+
+2. Copy an image header.
+
+    ar> mkheader new dev$pix append-
+
+3. Edit the image header with a text editor and replace the old header
+with the edited header.
+
+.nf
+    ar> imheader myimage l+ > temp
+    ar> edit temp
+    ar> mkheader myimage temp append-
+.fi
+.ih
+SEE ALSO
+hedit, mkobjects, mknoise, mk1dspec, mk2dspec
+.endhelp
diff --git a/noao/artdata/doc/mknoise.hlp b/noao/artdata/doc/mknoise.hlp
new file mode 100644
index 00000000..cab14d42
--- /dev/null
+++ b/noao/artdata/doc/mknoise.hlp
@@ -0,0 +1,245 @@
+.help mknoise Aug90 noao.artdata
+.ih
+NAME
+mknoise - Make/add noise and cosmic rays to 1D/2D images
+.ih
+PARAMETERS
+.ls input
+Images to create or modify.
+.le
+.ls output = ""
+Output images when modifying input images.  If no output images are
+given then existing images in the input list are modified directly.
+If an output image list is given then it must match in number the
+input list.
+.le
+
+WHEN CREATING NEW IMAGES
+.ls title = ""
+Image title to be given to the images.  Maximum of 79 characters.
+.le
+.ls ncols = 512, nlines = 512
+Number of columns and lines.
+.le
+.ls header = "artdata$stdheader.dat"
+Image or header keyword data file.  If an image is given then the image header
+is copied.  If a file is given then the FITS format cards are copied.
+This only applies to new images.   The data file consists of lines
+in FITS format with leading whitespace ignored.  A FITS card must begin
+with an uppercase/numeric keyword.  Lines not beginning with a FITS
+keyword such as comments or lower case are ignored.  The user keyword
+output of \fBimheader\fR is an acceptable data file.  See \fBmkheader\fR
+for further information.
+.le
+
+NOISE PARAMETERS
+.ls background = 0.
+Background to add to images before computing Poisson noise.
+.le
+.ls gain = 1.
+Gain in electrons per data number.  The gain is used for scaling the
+read noise parameter and in computing poisson noise.
+.le
+.ls rdnoise = 0.
+Gaussian read noise in electrons.
+.le
+.ls poisson = no
+Add poisson noise?  Note that any specified background is added to new
+or existing images before computing the Poisson noise.
+.le
+.ls seed = 1
+Random number seed.  If a value of "INDEF" is given then the clock
+time (integer seconds since 1980) is used as the seed yielding
+different random numbers for each execution.
+.le
+
+COSMIC RAYS
+.ls cosrays = ""
+List of cosmic ray files.  Cosmic ray files contain lines of cosmic ray
+coordinates and energy (see DESCRIPTION section).  If no
+file or a new (nonexistent) file is specified then a number of random
+cosmic rays given by the parameter \fIncosrays\fR is generated.  If a
+new file name is specified then the events generated are recorded in the
+file.  If the list of cosmic ray files is shorter than the list of
+input images then the last cosmic ray file is reused.
+.le
+.ls ncosrays = 0
+If no cosmic ray file or a new file is specified then the task will
+generate this number of random cosmic rays.  The positions are
+uniformly random within the limits of the image and the energy is
+uniformly random between zero and a maximum.
+.le
+.ls energy = 30000.
+When generating random events the cosmic rays will have a uniform energy
+distribution (in electrons) between zero and this maximum.
+.le
+.ls radius = 0.5
+The half-intensity radius of gaussian profile cosmic rays in pixels
+along the major axis.
+.le
+.ls ar = 1.
+Minor to major axial ratio for cosmic rays.
+.le
+.ls pa = 0.
+Position angle in degrees measured counterclockwise from the X axis for
+cosmic rays.
+.le
+
+.ls comments = yes
+Include comments recording task parameters in the image header?
+.le
+
+PACKAGE PARAMETERS
+
+These parameters define certain computational shortcuts which greatly
+affect the computational speed.  They should be adjusted with care.
+.ls nxc = 5, nyc = 5
+Number of cosmic ray centers per pixel in X and Y.  Rather than evaluate
+cosmic rays precisely at each subpixel coordinate, a set of templates
+with a grid of subpixel centers is computed and then the nearest template to
+the desired position is chosen.  The larger the number the more memory
+and startup time required.
+.le
+.ls nxsub = 10, nysub = 10
+Number of pixel subsamples in X and Y used in computing the cosmic
+ray profiles.  This is the subsampling in the central
+pixel and the number of subsamples decreases linearly from the center.
+This affects the time required to compute the cosmic ray templates.
+.le
+.ls dynrange = 100000.
+The intensity profile of the gaussian cosmic rays extends to infinity so
+a dynamic range, the ratio of the peak intensity to the cutoff
+intensity, is imposed.  Because the cosmic rays are small this parameter
+is not critical.
+.le
+.ls ranbuf = 0
+Random number buffer size.  When generating readout and poisson noise,
+evaluation of new random values has an affect on the execution time.
+If truly (or computationally truly) random numbers are not needed
+then this number of random values is stored and a simple
+uniform random number is used to select from the stored values.
+To force evaluation of new random values for every pixel set the
+value of this parameter to zero.
+.le
+.ih
+DESCRIPTION
+This task creates or modifies images with readout noise, poisson noise,
+and cosmic ray events.  New images are created with the specified
+dimensions and real datatype.  Existing images may be modified in place
+or new images may be created.
+
+If a new image is created it is has the mean level given by the parameter
+\fIbackground\fR.  With no noise and no cosmic rays this task can be used to
+create images of constant background value.  For existing images the
+background is added before computing any noise.  To add noise to an
+existing image without modifying the mean counts set the background
+to zero.
+
+For new images a set of header keywords may be added by specifying an
+image or data file with the \fIheader\fR parameter (see also \fBmkheader\fR).
+If a data file is specified lines beginning with FITS keywords are
+entered in the image header.  Leading whitespace is ignored and any
+lines beginning with words having lowercase and nonvalid FITS keyword
+characters are ignored.  In addition to this optional header,
+keywords, parameters for the gain and read noise are defined.
+Finally, comments may be added to the image header recording the task
+parameters and any information from the cosmic ray file which are not
+cosmic ray definitions.
+
+Poisson photon noise is generated by setting the \fIpoisson\fR parameter.
+For new images the input data value is the background while for
+existing images the input data value is added to the background value.
+The data value is then multiplied by the gain, a poisson deviate is
+generated, and divided by the gain.  Expressed as a formula:
+
+.nf
+      New images: out = P(background * gain) / gain
+ Existing images: out = P((in+background)*gain) / gain
+.fi
+
+where P(x) is a poisson deviate with mean x, in and out are the input
+and final pixel values, and background and gain are the parameter
+values of the same name.
+
+Readout or gaussian noise is generated by specifying a gaussian sigma with
+the parameter \fIrdnoise\fR.  The sigma is divided by the specified gain
+to convert to image data units.  Gaussian random numbers of mean zero are
+then generated for each pixel and added to the image, or background
+value for new images, after the photon noise is computed.
+
+Generating gaussian and poisson random numbers computationally is
+the main determinant of the execution time in this task.
+Two things are done to speed up the task.
+First, the gaussian approximation is used for data values greater
+than 20 (after applying the background and gain).  The square root
+of the data value is used as the gaussian sigma about the data
+value.  For values less than 20 a true poisson deviate is generated.
+The second speed up is to allow storing a number of normalized gaussian
+values given by the package parameter \fIranbuf\fR as they are generated.  If
+more values than this are desired then a uniform random number is used
+to select one of these stored values.  This applies to both the read noise
+and poisson noise gaussian approximation though not the true poisson
+evaluation.  For most purposes this approximation is good and one would
+need to look very hard to detect the nonrandomness in the noise.
+However, if one wants to take the extra computational time then
+by setting the \fIranbuf\fR parameter to zero each gaussian
+random number will be generated independently.
+
+The cosmic ray model is an elliptical gaussian of specified
+half-intensity radius, axial ratio, and position angle.  Normally the
+radius will be small (smaller than the point spread function) and the
+axial ratio will be 1.  The cosmic rays are subsampled and can have the
+number of centers given by the \fInxc/nyc\fR package parameters.  The method
+of generating the cosmic rays is that described for the task
+\fBmkobjects\fR.  Specifically it is the same as adding gaussian
+profile stars.
+
+The total flux (not the peak) of the cosmic ray is given by the energy
+in electrons so that the value is divided by the gain to produce the
+total flux in the image.  Note that this task can be used to add cosmic
+ray spikes to one dimensional images such as spectra but the strengths
+will appear low because of the part of the event which falls outside
+the single line.
+
+The positions and energies of the cosmic rays can be specified in a
+file or the task can generate random events.  Specific cosmic rays are
+specified by a file containing lines of x and y positions and energy.
+Positions outside the limits of the image are ignored.  If no cosmic
+ray file is given or if a new, nonexistent file is named then the
+number of cosmic rays given by the \fIncosrays\fR parameter is
+generated with uniform spatial distribution within the image and
+uniform energy distribution between zero and that given by the
+\fIenergy\fR parameter.  By giving a new file name the randomly
+generated cosmic rays will be recorded for reuse or to allow
+identifying the events while testing tasks and algorithms.
+.ih
+EXAMPLES
+1. Create a new image with a background of 1000, a read noise
+of 10 electrons, a gain of 2, and 50 random cosmic rays.  Don't keep a
+record of the cosmic rays.
+
+.nf
+	cl> mknoise testim back=1000 rd=10 gain=2 poisson+ ncos=50
+.fi
+
+2. Add cosmic rays to an image and create a new output image.
+
+.nf
+	cl> head cosfile
+	20.3 50.1 1000
+	325.6 99.6 250
+	cl> mknoise dev$pix out=newpix cos=cosfile
+.fi
+.ih
+REVISIONS
+.ls MKNOISE V2.11+
+The random number seed can be set from the clock time by using the value
+"INDEF" to yield different random numbers for each execution.
+.le
+.ls MKNOISE V2.11
+The default value of "ranbuf" was changed to zero.
+.le
+.ih
+SEE ALSO
+mkobjects, mkheader
+.endhelp
diff --git a/noao/artdata/doc/mkobjects.hlp b/noao/artdata/doc/mkobjects.hlp
new file mode 100644
index 00000000..e641635a
--- /dev/null
+++ b/noao/artdata/doc/mkobjects.hlp
@@ -0,0 +1,636 @@
+.help mkobjects Jan92 noao.artdata
+.ih
+NAME
+mkobjects - Make/add artificial stars and galaxies to 2D images
+.ih
+USAGE
+mkobjects input
+.ih
+PARAMETERS
+.ls input
+Images to create or modify.
+.le
+.ls output = ""
+Output images when modifying input images.  If no output images are
+given then existing images in the input list are modified directly.
+If an output image list is given then it must match in number the
+input list.
+.le
+
+WHEN CREATING NEW IMAGES
+.ls title = ""
+Image title to be given to the images.  Maximum of 79 characters.
+.le
+.ls ncols = 512, nlines = 512
+Number of columns and lines.
+.le
+.ls header = "artdata$stdheader.dat"
+Image or header keyword data file.  If an image is given then the image header
+is copied.  If a file is given then the FITS format cards are copied.
+This only applies to new images.   The data file consists of lines
+in FITS format with leading whitespace ignored.  A FITS card must begin
+with an uppercase/numeric keyword.  Lines not beginning with a FITS
+keyword such as comments or lower case are ignored.  The user keyword
+output of \fBimheader\fR is an acceptable data file.  See \fBmkheader\fR
+for further information.
+.le
+.ls background = 1000.
+Default background and poisson noise background.  This is in data numbers
+with the conversion to photons determined by the \fIgain\fR parameter.
+.le
+
+OBJECT PARAMETERS
+.ls objects = ""
+List of object files.  The number of object files must match the number of
+input images.  The object files contain lines of object coordinates,
+magnitudes, and shape parameters (see the DESCRIPTION section).
+.le
+.ls xoffset = 0.,  yoffset = 0.
+X and Y coordinate offset to be added to the object list coordinates.
+.le
+.ls star = "moffat"
+Type of star and point spread function.  The choices are:
+.ls gaussian
+An elliptical Gaussian profile with major axis half-intensity radius
+given by the parameter \fIradius\fR, axial ratio given by the parameter
+\fIar\fR, and position angle given by the parameter \fIpa\fR.
+.le
+.ls moffat
+An elliptical Moffat profile with major axis half-intensity radius
+given by the parameter \fIradius\fR, model parameter \fIbeta\fR,
+axial ratio given by the parameter \fIar\fR, and position angle given
+by the parameter \fIpa\fR.
+.le
+.ls <image>
+If not one of the profiles above, an image of the specified name is
+sought.  If found the center of the template image is assumed to be the
+center of the star/psf and the image template is scaled so that the
+radius of the template along the first axis is given by the \fIradius\fR
+parameter.  The axial ratio and position angle define an
+elliptical sampling of the template.
+.le
+.ls <profile file>
+If not one of the above, a text file is sought giving either an intensity
+per unit area profile or a cumulative flux profile from the center to the
+edge.  The two are differentiated by whether the first profile point is 0
+for a cumulative profile or nonzero for an intensity profile.  An intensity
+profile is recommended.  If found the profile defines an elliptical star/psf
+with the major axis radius to the last profile point given by the parameter
+\fIradius\fR, axial ratio given by the parameter \fIar\fR, and position
+angle given by the parameter \fIpa\fR.
+.le
+.le
+.ls radius = 1.
+Seeing radius/scale in pixels along the major axis.  For the "gaussian"
+and "moffat" profiles this is the half-intensity radius of the major
+axis, for image templates this is the template radius along the x dimension,
+specifically one half the number of columns, and for arbitrary user profiles
+this is the radius to the last profile point.
+.le
+.ls beta = 2.5
+Moffat model parameter.  See the DESCRIPTION for a definition of the
+Moffat profile.
+.le
+.ls ar = 1.
+Minor to major axial ratio for the star/psf.
+.le
+.ls pa = 0.
+Position angle in degrees measured counterclockwise from the X axis
+for the star/psf.
+.le
+.ls distance = 1.
+Relative distance to be applied to the object list coordinates,
+magnitudes, and scale sizes.  This factor is divided into the
+object coordinates, after adding the offset factors, to allow expanding
+or contracting about any origin.  The magnitudes scale as the
+square of the distance and the sizes of the galaxies scale
+linearly.  This parameter allows changing image sizes and fluxes
+at a given seeing and sampling with one value.
+.le
+.ls exptime = 1.
+Relative exposure time.  The object magnitudes and background
+level are scaled by this parameter.  This is comparable to changing the
+magnitude zero point except that it includes changing the background.
+.le
+.ls magzero = 7.
+Magnitude zero point defining the conversion from magnitudes in the
+object list to instrumental/image fluxes.
+.le
+
+NOISE PARAMETERS
+.ls gain = 1.
+Gain in electrons per data number.  The gain is used for scaling the
+read noise parameter, the background, and in computing poisson noise.
+.le
+.ls rdnoise = 0.
+Gaussian read noise in electrons.  For new images this applies to the
+entire image while for existing images this is added only to the objects.
+.le
+.ls poisson = no
+Add poisson photon noise?  For new images this applies to the entire image
+while for existing images this is only applied to the objects.  Note
+that in the latter case the background parameter is added before
+computing the new value and then subtracted again.
+.le
+.ls seed = 1
+Random number seed.  If a value of "INDEF" is given then the clock
+time (integer seconds since 1980) is used as the seed yielding
+different random numbers for each execution.
+.le
+
+.ls comments = yes
+Include comments recording task parameters in the image header?
+.le
+
+PACKAGE PARAMETERS
+
+These parameters define certain computational shortcuts which greatly
+affect the computational speed.  They should be adjusted with care.
+.ls nxc = 5, nyc = 5
+Number of star and psf centers per pixel in X and Y.  Rather than evaluate
+stars and the psf convolution functions precisely at each subpixel
+coordinate, a set of templates with a grid of subpixel centers is
+computed and then the nearest template to the desired position is chosen.
+The larger the number the more memory and startup time required.
+.le
+.ls nxsub = 10, nysub = 10
+Number of pixel subsamples in X and Y used in computing the star and
+psf.  This is the subsampling in the central
+pixel and the number of subsamples decreases linearly from the center.
+The larger the numbers the longer it takes to compute the star and psf
+convolution templates.
+.le
+.ls nxgsub = 5, nygsub = 5
+Number of pixel subsamples in X and Y used in computing galaxy images.
+This is the subsampling in the central pixel and the number of
+subsamples decreases linearly from the center.  Because galaxy images
+are extended and each subsample is convolved by the psf convolution it
+need not be as finely sampled as the stars.  This is a critical
+parameter in the execution time if galaxies are being modeled.
+The larger the numbers the longer the execution time.
+.le
+.ls dynrange = 100000., psfrange = 10.
+The intensity profiles of the analytic functions extend to infinity so
+a dynamic range, the ratio of the peak intensity to the cutoff
+intensity, is imposed to cutoff the profiles.  The \fIdynrange\fR
+parameter applies to the stellar templates and to the galaxy profiles.
+The larger this parameter the further the profile extends.
+When modeling galaxies this has a fairly
+strong affect on the time (larger numbers means larger images and more
+execution time).  Only for very high signal-to-noise
+objects will the cutoff be noticeable.  A correction is made to
+the object magnitudes to reflect light lost by this cutoff.
+
+The psf convolution, used on galaxies, is generally not
+evaluated over as large a dynamic range, given by the parameter
+\fIpsfrange\fR, especially since it has a very strong affect on the
+execution time.  The convolution is normalized to unit weight over the
+specified dynamic range.
+.le
+.ls ranbuf = 0
+Random number buffer size.  When generating readout and poisson noise,
+evaluation of new random values has an affect on the execution time.
+If truly (or computationally truly) random numbers are not needed
+then this number of random values is stored and a simple
+uniform random number is used to select from the stored values.
+To force evaluation of new random values for every pixel set the
+value of this parameter to zero.
+.le
+.ih
+DESCRIPTION
+This task creates or modifies images by adding models of astronomical
+objects, stars and galaxies, as specified in object lists.  New images are
+created with the specified dimensions, background, title, and real datatype.
+Existing images may be modified in place or new images output.  The
+task includes the effects of image scale, pixel sampling, atmospheric
+seeing, and noise.  The object models may be analytic one dimensional
+profiles, user defined one dimensional profiles, and user defined image
+templates.  The profiles and templates are given elliptical shapes by
+specifying a scale radius for the major axis, a minor axis to major
+axis axial ratio, and a position angle.
+
+For new images a set of header keywords may be added by specifying an
+image or data file with the \fIheader\fR parameter (see also \fBmkheader\fR).
+If a data file is specified lines beginning with FITS keywords are
+entered in the image header.  Leading whitespace is ignored and any
+lines beginning with words having lowercase and nonvalid FITS keyword
+characters are ignored.  In addition to this optional header,
+keywords, parameters for the gain, read noise, and exposure time are
+defined.  Finally, comments may be added to the image header recording the task
+parameters and any information from the objects file which are not
+object definitions; in particular, the \fBstarlist\fR and
+\fBgallist\fR parameters are recorded.
+
+A completely accurate simulation of the effects of pixel sampling,
+atmospheric seeing, object appearance, luminosity functions, and noise
+can require a large amount of computer time even on
+supercomputers.  This task is intended to allow generation of large
+numbers of objects and images over large image sizes representative of
+current deep optical astronomical images.  All this is to be done
+on typical workstations.  Thus, there are many approximations and
+subtle algorithms used to make this possible to as high a degree of
+accuracy as practical.  The discussion will try to describe these in
+sufficient detail for the user to judge the accuracy of the artificial
+data generated and understand the trade offs with many of the
+parameters.
+
+New images are created with the specified dimensions, title, and real
+datatype.  The images have a constant background value given by the
+\fIbackground\fR parameter (in data numbers) before adding objects and
+noise.  Noise consists of gaussian and poisson components.  For existing
+images, noise is only added to the objects and the background parameter is
+used in the calculation of the poisson noise: specifically, a poisson
+random value with mean given by the sum of the object and the background is
+generated and then the background is subtracted.  For more on how the noise
+is computed and approximations used see \fBmknoise\fR.
+
+Objects are specified by a position, magnitude, model, scale, axial
+ratio, and position angle.  Since the point spread function (PSF)
+is assumed constant over the image the star model, size, axial ratio,
+and position angle are specified by the task parameters \fIstar\fR,
+\fIradius\fR, \fIar\fR, and \fIpa\fR.  For galaxies, where the
+intrinsic shapes vary from object to object, these parameters are
+specified as part of the object lists.  For both types of objects the
+positions and magnitudes are specified in the object lists.
+
+There is a great deal of flexibility in defining the object models.
+The models are defined either in terms of a one dimensional radial
+intensity or cumulative flux profile
+or an image template.  The flux profiles may be
+analytic functions or a user defined profile given as an equally spaced
+set of values in a text file.  The first point is zero at the center
+for a cumulative profile
+and increases monotonically to the edge.  Note that intensity profiles
+are to be preferred to avoid artifacts in the conversion from cumulative
+flux.  In particular, cumulative flux profiles may give a spike at the
+center.  In either case, the profile should be specified fairly finely,
+many points, to avoid interpolation effects.
+
+The functional form of the analytic profiles the user profiles, and
+image template are given below.
+
+.nf
+      gaussian:  I = exp (-ln (2) * (R/radius)**2)
+        moffat:  I = (1 + (2**(1/beta)-1) * (R/radius)**2) ** -beta
+     sersic<n>:  I = exp (-b * (R/radius)**1/n)
+       expdisk:  I = exp (-1.6783 * R/radius)
+        devauc:  I = exp (-7.67 * (R/radius)**1/4)
+  flux profile:  I = intensity (nprofile * R/radius)
+  flux profile:  F = flux (nprofile * R/radius)
+image template:  I = image (nc/2+nc/2*dX/radius, nl/2+nc/2*dY/radius)
+.fi
+
+where R, dX, and dY are defined below, \fIradius\fR is the scale parameter
+and \fIbeta\fR is the Moffat parameter specified by the user,
+nprofile is the number of profile points in the user profile, and nc and nl
+are the image template column and line dimensions.  The Gaussian, "gaussian",
+and Moffat, "moffat", profiles are used for stars and the point spread
+function, while the Sersic (sersic),  exponential disk (expdisk), and
+De Vaucouleurs (devauc) profiles are common models for spiral and elliptical
+galaxies.  The image templates are intended to model images with
+some complex structure.  The usual case is to have a very well sampled
+and high signal-to-noise image be reduced in scale (a more distant
+example), convolved with seeing (loss of detail), and noise (degraded
+signal-to-noise).  This also allows for more complex point spread
+functions.
+
+The radial profiles are mapped into two dimensional objects by an elliptical
+transformation.  The image templates are also mapped by an elliptical
+transformation to rotate and stretch them.  If the output image
+coordinates are given by (x, y), and the specified object center
+coordinates are given by (xc, yc) then the transformation is defined
+as shown below.
+
+.nf
+	dx = x - xc
+	dy = y - yc
+	dX = dx * cos(pa) + dy * sin(pa)
+	dY = (-dx * sin(pa) + dy * cos(pa)) / ar
+	R = sqrt (dX ** 2 + dY ** 2)
+.fi
+
+where dx and dy are the object coordinates relative to the object
+center,  dX and dY are the object coordinates in the transformed
+circular coordinates, and R is the circularly symmetric radius.
+The transformation parameters are the axial ratio \fIar\fR
+defined as the ratio of the minor axis to the major axis,
+and the position angle \fIpa\fR defined counterclockwise from
+the x axis.
+
+The \fIradius\fR parameter defines the size, in pixels, of the model
+object (before seeing for the galaxies) in the output image.  It
+consistently refers to the major axis of the object but its meaning
+does depend on the model.  For the gaussian and moffat profiles it is
+defined as the half-intensity radius.  For the sersic, expdisk, and devauc
+profiles it is defined as the half-flux radius.  For the user specified
+profiles it is the radius of the last profile point.  And for the image
+templates it is the radius of the image along the first or x axis given
+by one-half of the image dimension; i.e. nc/2.
+
+The profiles of the analytic functions extend to infinity so a dynamic
+range, the ratio of the peak intensity to the cutoff intensity, is imposed
+to cutoff the profiles.  The \fIdynrange\fR package parameter applies to
+the stellar and galaxy analytic profiles.  The larger this parameter the
+further the profile extends, particularly for the large index Sersic and De
+Vaucouleurs models.  When modeling large galaxies this has a fairly strong
+affect on the execution time because the overall extent of the images
+becomes rapidly greater.  Only for very high signal-to-noise objects will
+the cutoff be noticeable.  A correction is made to account for lost light
+(light beyond the modeled dynamic range) so that an aperture magnitude
+will give the correct value for an object of the specified total magnitude.
+This can become quite significant for larger index Sersic profiles and
+for the default dynamic range.
+
+The object models are integrated over the size of the image pixels.  This
+is done by subsampling, dividing up a pixel into smaller pieces called
+subpixels.  For the image templates a bilinear surface interpolation
+function is used and integrated analytically over the extent of the
+subpixels.  The user cumulative one dimensional profiles are first
+converted to intensity profiles.  The various intensity profiles are then
+binned into pixel fluxes per subpixel on a grid much finer than the
+subpixel spacing.  Then for any particular radius and object center the
+appropriate subpixel flux can be determined quickly and accurately.
+
+The number of subpixels per image pixel is determined by the package
+parameters \fInxsub\fR, \fInysub\fR, \fInxgsub\fR, and \fInygsub\fR.  The
+first two apply to the stars and the PSF and the latter two apply to the
+galaxies.  Typically the subsampling will be the same in each dimension.
+The galaxies are generally  subsampled less since they will have less
+rapidly changing profiles and are convolved by the PSF.  Also, the stars
+are computed only a few times and then scaled and moved, as described
+below, while each galaxy needs to be computed separately.  Therefore, one
+can afford greater precision in the stars than in the galaxies.
+
+Given an image of several hundred pixels subsampled by a factor of 100
+(10 x 10) this will be a very large number of computations.  A
+shortcut to reduce this number of operations is allow the number
+of subpixels to change as a function of distance from the
+profile center.  Since the profile center is where the intensity
+changes most rapidly with position, the greatest subsampling is needed for
+the pixel nearest the center.  Further from the object center the intensity
+changes more slowly and the number of subpixels may be reduced.
+Thus, the number of subpixels in each dimension in each pixel is
+decreased linearly with distance from the profile center.  For example,
+a pixel which is 3.2 pixels from the profile center will have
+\fInxsub\fR - 3 subpixels in the x dimension.  There is, of course, a
+minimum of one subpixel per pixel or, in other words, no subsampling
+for the outer parts of the objects.  By adjusting the subsampling
+parameters one can set the degree of accuracy desired at the trade off of
+greatly different execution times.
+
+The star shapes are assumed constant over the images and only their
+position and magnitude change.  Thus, rather than compute each desired
+star from the model profile or image template, a normalized star
+template is computed once, using the spatial transformation and
+subsampling operations described above, and simply scaled each time to
+achieve the desired magnitude and added at the requested position.
+However, the apparent star shape does vary depending on where its
+center lies within an image pixel.  To handle this a set of
+normalized star templates is precomputed over a grid of centers
+relative to the center of a pixel.  Then the template with center
+nearest to that requested, relative to a pixel center, is used.  The
+number of such templates is set by the package parameters \fInxc\fR and
+\fInyc\fR where the two axis typically have the same values.  The
+larger the number of centers the more memory and startup time required
+but the better the representation of this sampling effect.  The choice
+also depends on the scale of the stars since the larger the star
+profile compared to a pixel the smaller the subcentering effect is.
+This technique allows generating images with many stars, such as a
+globular cluster or a low galactic latitude field, quite
+efficiently.
+
+Unlike the stars, the galaxies will each have different profiles,
+ellipticities, and position angles and so templates cannot be used (except
+for special test cases as mentioned later).  Another difference is that the
+galaxy models need to be convolved by the PSF; i.e. the shapes are defined
+prior to seeing.  The PSF convolution must also be subsampled and the
+convolution operation requires as many operations as the number of pixels
+in the PSF for each galaxy subpixel.  Thus, computing seeing convolved,
+well subsampled, large galaxy images is the most demanding task of all,
+requiring all the shortcuts described above (larger and variable
+subsampling and the subpixel flux approximation) as well as further ones.
+
+The PSF used for convolving galaxies is truncated at a lower dynamic
+range than the stars according to the package parameter
+\fIpsfrange\fR.  This reduces the number of elements in the convolution
+dramatically at the expense of losing only a small amount of the flux
+in the wings.  Like the stars, the PSF is precomputed on a grid of
+pixel subcenters and the appropriate PSF template is used for each
+galaxy subpixel convolution.  Unlike the stars, the truncated PSF is
+normalized to unit flux in order to conserve the total flux in the
+galaxies.  For the extended galaxies this approximation has only a very
+small effect.  As with the other approximations one may increase the
+dynamic range of the PSF at the expense of an increase in execution
+time.
+
+There is an exception to using the truncated PSF.  If the size of the
+galaxy because very small, 0.01 pixel, then a stellar image is substituted.
+
+
+OBJECT FILES
+
+The object files contain lines defining stars and galaxies.  Stars
+are defined by three numbers and galaxies by seven or eight as
+represented symbolically below.
+
+.nf
+           stars:  xc yc magnitude
+        galaxies:  xc yc magnitude model radius ar pa <save>
+.fi
+
+.ls 6 xc, yc:
+Object center coordinates.  These coordinates are transformed to image
+coordinates as follows.
+
+.nf
+	xc in image = xoffset + xc / distance
+	yc in image = yoffset + yc / distance
+.fi
+
+where \fIxoffset\fR and \fIyoffset\fR are the task offset parameters.
+Objects whose image centers fall outside the image dimensions are ignored.
+.le
+.ls magnitude:
+Object magnitude.  This is converted to instrumental fluxes as follows.
+
+.nf
+	flux = exptime/distance**2 * 10**(-0.4*(magnitude-magzero))
+.fi
+
+where \fIexptime\fR, \fIdistance\fR, and \fImagzero\fR are task parameters.
+For the analytic star and galaxy models a correction
+is made for lost light due to the finite extent of the image in the
+sense that the flux added to the image will never quite be that
+requested.
+.le
+.ls model:
+The types of galaxy models are as follows:
+.ls 4 sersic<n>
+A Sersic model of index n.  The index may real but the value will be rounded
+to the nearest multiple of 0.5 or, equivalently, two times the index value will
+be rounded to an integer.  The index must be between 0.5 and 10.  The Sersic
+model defined as
+
+.nf
+	I = exp (-b * (R/radius)**1/n)
+.fi
+
+where radius is the major axis scale length corresponding to half of the
+total flux.  The value of b is computed using the formula of Ciotti and
+Bertin (AA v352, p447, 1999);
+
+.nf
+	b = 2n - 1/3 + 4/(405n) + 46 / (25515n^2)
+.fi
+.le
+.ls 4 expdisk
+An exponential disk model defined as
+
+.nf
+	I = exp (-b * R/radius)
+.fi
+
+where radius is the major axis scale length corresponding to half of the total
+flux and b is computed as with the Sersic model for n=1.  In fact, the
+algorithm is identical with that for the Sersic model using n=1.  Note that
+because of this there will be slight differences with the earlier versions.
+.le
+.ls devauc
+A De Vaucouleurs profile defined as
+
+.nf
+	I = exp (-b * (R/radius)**1/4)
+.fi
+
+where radius is the major axis scale length corresponding to half of the total
+flux and b is computed as with the Sersic model for n=4.  In fact, the
+algorithm is identical with that for the Sersic model using n=4.  Note that
+because of this there will be slight differences with the earlier versions.
+.le
+.ls <image>
+If not one of the profiles above an image of the specified name is
+sought.  If found the center of the template image is assumed to be the
+center of the object and the image template is scaled so that the
+radius of the template is given by the major axis scale radius parameter.
+.le
+.ls <profile file>
+If not one of the above a text file giving a cumulative flux profile from
+the center to the edge is sought.  If found the profile defines
+a model galaxy of extent to the last profile point given by
+the major axis scale radius parameter.
+.le
+.le
+.ls 6 radius:
+Major axis scale radius parameter in pixels as defined above for the different
+galaxy models.  The actual image radius is modified as follows.
+
+	radius in image = radius / distance
+.le
+.ls ar:
+Minor to major axis axial ratio.
+.le
+.ls pa:
+Major axis position angle in degrees measured counterclockwise from the X axis.
+.le
+.ls save:
+If a large number of identically shaped galaxies (size, axial ratio,
+and position angle) located at the same subpixel (the same x and y
+fractional part) but with varying magnitudes is desired then by
+putting the word "yes" as the eighth field the model will be saved
+the first time and reused subsequent times.  This speeds up the execution.
+There may certain algorithm testing situations where this might be useful. 
+.le
+.ih
+EXAMPLES
+1. Create a galaxy cluster with a power law distribution of field galaxies
+and stars as background/foreground.
+
+.nf
+    ar> gallist galaxies.dat 100 spatial=hubble lum=schecter egal=.8
+    ar> gallist galaxies.dat 500
+    ar> starlist galaxies.dat 100
+    ar> mkobjects galaxies obj=galaxies.dat gain=3 rdnoise=10 poisson+
+.fi
+
+Making the image takes about 5 minutes (2.5 min cpu) on a SPARCstation 1.
+
+2. Create a uniform artificial starfield of 5000 stars for a 512 square image.
+
+.nf
+    ar> starlist starfield.dat 5000
+    ar> mkobjects starfield obj=starfield.dat gain=2 rdnoise=10 poisson+
+.fi
+
+This example takes about a minute on a SPARCstation 1.
+
+3. Create a globular cluster field of 5000 stars for a 512 square image.
+
+.nf
+    ar> starlist gc.dat 5000 spat=hubble lum=bands
+    ar> mkobjects gc obj=gc.dat gain=2 rdnoise=10 poisson+
+.fi
+
+This example takes about a minute on a SPARCstation 1.
+
+4. Add stars to an existing image for test purposes.
+
+.nf
+    ar> mkobjects starfield obj=STDIN gain=2 pois+ magzero=30
+    100 100 20
+    100 200 21
+    200 100 22
+    200 200 23
+    [EOF]
+.fi
+
+5. Look at the center of the globular cluster with no noise and very
+good seeing.
+
+.nf
+	cl> mkobjects gc1 obj=gc.dat nc=400 nl=400 distance=.5 \
+	>>> xo=-313 yo=-313 radius=.1
+.fi
+
+The offset parameters are used to recenter the cluster from
+(256,256) in the data file to (200,200) in the expanded field.
+This example takes 30 sec (5 sec CPU) on a SPARCstation 1.  To expand
+and contract about a fixed point define the object list to have an
+origin at zero.
+
+.nf
+    ar> starlist gc.dat 5000 spat=hubble lum=bands xmin=-256 xmax=256 \
+    >>> ymin=-256 ymax=256
+    ar> mkobjects gc obj=gc.dat xo=257 yo=257 gain=2 rdnoise=10 poisson+
+    ar> mkobjects gc1 obj=gc.dat xo=257 yo=257 gain=2 \
+    >>> distance=.5 rdnoise=10 poisson+
+.fi
+
+6. Make an image of dev$pix at various distances and orientation.  First we
+must subtract the background.
+
+.nf
+	cl> imarith dev$pix - 38 pix
+	cl> mkobjects pix1 obj=STDIN nc=200 nl=200 back=1000 \
+	>>> magzero=30 rd=10 poi+
+	50 50 15.0 pix 40 1 0
+	150 50 15.6 pix 30 .8 45
+	50 150 16.5 pix 20 .6 90
+	150 150 17.1 pix 15 .4 135
+	[EOF]
+.fi
+
+It would be somewhat more efficient to first block average the
+template since the oversampling in this case is very large.
+.ih
+REVISIONS
+.ls MKOBJECTS V2.11+
+The random number seed can be set from the clock time by using the value
+"INDEF" to yield different random numbers for each execution.
+.le
+.ls MKOBJECTS V2.11
+The default value of "ranbuf" was changed to zero.
+.le
+.ih
+SEE ALSO
+gallist, starlist, mknoise, mkheader
+.endhelp
diff --git a/noao/artdata/doc/mkpattern.hlp b/noao/artdata/doc/mkpattern.hlp
new file mode 100644
index 00000000..61bfae09
--- /dev/null
+++ b/noao/artdata/doc/mkpattern.hlp
@@ -0,0 +1,180 @@
+.help mkpattern Jan90 noao.artdata
+.ih
+NAME
+mkpattern - Make/add patterns in images
+.ih
+USAGE
+mkpattern input
+.ih
+PARAMETERS
+.ls input
+Images to create or modify.  Image sections are allowed to apply a pattern
+to a portion of an image.
+.le
+.ls output = ""
+Output images when modifying input images.  If no output images are
+given then existing images in the input list are modified directly.
+If an output image list is given then it must match in number the
+input list.
+.le
+.ls pattern = "constant"
+Pattern to be used.  The patterns are:
+.ls constant
+Constant value v1.
+.le
+.ls grid
+A grid starting with the first pixel and going in steps of the
+pattern size with value v2.  Pixels between the grid have value v1.
+A minimum grid size of 2 is enforced.
+.le
+.ls checker
+A checkerboard with squares of the pattern size alternating between values v1
+and v2 starting with v1.
+.le
+.ls coordinates
+Each pixel is numbered sequentially starting with 1 with the column
+dimension varying fastest.
+.le
+.ls slope
+A sloped plane starting with value v1 for the first pixel and value v2 for
+the last pixel in one or two dimensions.
+.le
+.ls square
+A checkerboard pattern in which the size of the squares begin with
+the pattern size and grow as the square of the coordinate.
+.le
+.le
+.ls option = "replace"
+Editing option when modifying existing images.  Often this is used
+in conjunction with image sections to modify a part of an image.
+The options are:
+
+.nf
+ replace - Replace the image with the pattern.
+     add - Add the pattern to the image.
+multiply - Multiply the pattern with the image values.
+.fi
+.le
+.ls v1 = 0., v2 = 1.
+Pattern values used as described for each pattern.
+.le
+.ls size = 1
+Pattern size used as described for each pattern.
+.le
+
+WHEN CREATING NEW IMAGES
+.ls title = ""
+Image title to be given to the images.  Maximum of 79 characters.
+.le
+.ls pixtype = "real"
+Pixel datatype of new images; one of ushort, short, integer, real, double,
+or complex.
+.le
+.ls ndim = 2
+Number of dimensions between 0 and 7.
+.le
+.ls ncols = 512, nlines = 512
+Number of columns (first dimension) and lines (second dimension).
+.le
+.ls n3 = 1, n4 = 1, n5 = 1, n6 = 1, n7 = 1
+Number of pixels in 3rd-7th  dimensions
+.le
+.ls header = "artdata$stdheader.dat"
+Image or header keyword data file.  If an image is given then the image header
+is copied.  If a file is given then the FITS format cards are copied.
+This only applies to new images.   The data file consists of lines
+in FITS format with leading whitespace ignored.  A FITS card must begin
+with an uppercase/numeric keyword.  Lines not beginning with a FITS
+keyword such as comments or lower case are ignored.  The user keyword
+output of \fBimheader\fR is an acceptable data file.  See \fBmkheader\fR
+for further information.
+.le
+.ih
+DESCRIPTION
+This task creates or modifies images with a choice of patterns.  New images
+are created with the specified dimensions, datatype, and pattern.
+Existing images may have the pattern replace, add, or multiply the
+pixel values.  Existing images may be modified in place or new images may be
+created and image sections are allowed.
+
+For new images a set of header keywords may be added by specifying an
+image or data file with the \fIheader\fR parameter (see also \fBmkheader\fR).
+If a data file is specified lines beginning with FITS keywords are
+entered in the image header.  Leading whitespace is ignored and any
+lines beginning with words having lowercase and nonvalid FITS keyword
+characters are ignored.
+
+This task is the simplest one for creating empty images to be used for
+mosaicing with \fBimcopy\fR and making patterns for testing display and
+image operators.  The replace option is generally used with image sections
+to place constant values in regions.  The multiply option is useful
+for making masks of the given pattern when the values are 0 and 1.
+
+Though the patterns make sense extending to higher dimensions they
+are only defined in two dimensions.  One dimensional images may be
+thought of as the first line of the two dimensional pattern.  Images
+with dimensions greater than 2 simply repeat the two dimensional
+pattern into the higher dimensions.  The reason for stopping at
+two dimensions is simplicity.
+
+The patterns have the following precise definitions where P(i,j) is the
+pixel value at column i and line j, v1 and v2 are the pattern
+values, size is the pattern size, ncols and nlines are the number of
+columns and lines in the image, int is the integer function, mod is the
+modulus function, and sqrt is the square root function.
+
+.nf
+                k = int ((i-1)/size), l = int ((j-1)/size)
+                ksr = int (sqrt (k)), lsr = int (sqrt (l))
+                slope = (v2-v1) / ((ncols+nlines-2)/size)
+
+    constant:   P(i,j) = v1
+
+        grid:   P(i,j) = v2   when mod(i,size)=1 or mod(j,size)=1
+                P(i,j) = v1   otherwise
+
+ coordinates:   P(i,j) = i + j * ncols
+
+     checker:   P(i,j) = v1   when mod(k,2)=0 and mod(l,2)=0
+                P(i,j) = v2   when mod(k,2)=1 and mod(l,2)=0
+                P(i,j) = v2   when mod(k,2)=0 and mod(l,2)=1
+                P(i,j) = v1   when mod(k,2)=1 and mod(l,2)=1
+
+       slope:   P(i,j) = v1 + slope * (k + l) 
+
+      square:   P(i,j) = v1   when mod(ksr,2)=0 and mod(lsr,2)=0
+                P(i,j) = v2   when mod(ksr,2)=1 and mod(lsr,2)=0
+                P(i,j) = v2   when mod(ksr,2)=0 and mod(lsr,2)=1
+                P(i,j) = v1   when mod(ksr,2)=1 and mod(lsr,2)=1
+.fi
+
+.ih
+EXAMPLES
+1. Create an empty (constant value of zero) three dimensional image.
+
+.nf
+	cl> mkpattern cube ndim=3 nc=100 nl=100 n3=100
+.fi
+
+2. Replace a square region of an image with the value -1000.
+
+.nf
+	cl> mkpat alpha[201:250,1:50] v1=-1000
+.fi
+
+3. Put a grid pattern on an image to create a new image.
+
+.nf
+	cl> mkpat dev$pix out=gridpix pat=grid op=mul v1=1 v2=0
+.fi
+.ih
+REVISIONS
+.ls MKPATTERN V2.11
+Now allows ndim=0 to create dataless header.
+
+Now allows type ushort pixel type.
+.le
+.ih
+SEE ALSO
+imcopy, imreplace
+.endhelp
diff --git a/noao/artdata/doc/starlist.hlp b/noao/artdata/doc/starlist.hlp
new file mode 100644
index 00000000..de3eb8b8
--- /dev/null
+++ b/noao/artdata/doc/starlist.hlp
@@ -0,0 +1,355 @@
+.help starlist Feb90 noao.artdata
+.ih
+TASK
+starlist -- make an artificial star list
+.ih
+USAGE
+starlist starlist nstars
+.ih
+PARAMETERS
+.ls starlist
+The name of the output text file for the x and y coordinates
+and magnitudes of the artificial stars.  Output will be appended to this
+file is it exists.
+.le
+.ls nstars = 5000
+The number of stars in the output star list.
+.le
+.ls interactive = no
+Examine plots and change the parameters of the spatial luminosity
+distributions interactively.
+.le
+
+			SPATIAL DISTRIBUTION
+.ls spatial = "uniform"
+Type of spatial distribution.  The types are:
+.ls uniform
+The stars are uniformly distributed between \fIxmin\fR, \fIxmax\fR, \fIymin\fR,
+and \fIymax\fR.
+.le
+.ls hubble
+The stars are distributed around the center of symmetry \fIxcenter\fR and
+\fIycenter\fR according to a Hubble density law of core radius
+\fIcore_radius\fR and background density \fIbase\fR.
+.le
+.ls file
+The radial density function is contained in the text file \fIsfile\fR.
+.le
+.le
+.ls xmin = 1., xmax = 512., ymin = 1., ymax = 512.
+The range of output coordinates in x and y.
+.le
+.ls xcenter = INDEF, ycenter = INDEF
+The coordinate of the center of symmetry for the "hubble"
+and "file" radial density functions. The default is the
+midpoint of the coordinate limits.
+.le
+.ls core_radius = 30
+The core radius of the Hubble spatial distribution in pixels.
+.le
+.ls base = 0.0
+The background density relative to the central density of the Hubble
+density distribution.
+.le
+.ls sseed = 1
+The initial value supplied to the random number generator used to
+generate the output x and y coordinates.
+If a value of "INDEF" is given then the clock
+time (integer seconds since 1980) is used as the seed yielding
+different random numbers for each execution.
+.le
+
+			MAGNITUDE DISTRIBUTION
+.ls luminosity = "powlaw"
+Type of luminosity distribution.  The types are:
+.ls uniform
+The stars are uniformly distributed between \fIminmag\fR and \fImaxmag\fR.
+.le
+.ls powlaw
+The stars are distributed according to a power law with coefficient
+\fIpower\fR.
+.le
+.ls salpeter
+The stars are distributed with a Salpeter luminosity function between
+\fIminmag\fR and \fImaxmag\fR.
+.le
+.ls bands
+The stars are distributed with a Bahcall and Soneira luminosity function
+between \fIminmag\fR and \fImaxmag\fR.  The function is described
+by the parameters \fIalpha\fR, \fIbeta\fR, \fIdelta\fR and \fImstar\fR
+whose default values give a best fit to the observed main sequence in several
+nearby globular clusters.
+.le
+.ls file
+The luminosity function is contained in the text file \fIlfile\fR.
+.le
+.le
+.ls minmag = -7., maxmag = 0.
+The range of output magnitudes.  The "salpeter" luminosity function
+imposes limits of -4 and 16 and the "bands" luminosity function
+imposes limits of -7 and 17 relative to the zero point given by
+\fImzero\fR.
+.le
+.ls mzero = -4.
+The zero point for converting the output relative magnitudes
+to absolute magnitudes for the Salpeter and Bahcall and Soneira
+luminosity functions.  For example the default values give an
+absolute magnitude range of -3 to +4.
+.le
+.ls power = 0.6
+Coefficient for the power law magnitude distribution.
+The default value of 0.6 is the value for a homogeneous
+and isotropic distribution with no cutoff in distance.
+.le
+.ls alpha = 0.74, beta = 0.04, delta = 0.294, mstar = 1.28
+The parameters of the Bahcall and Soneira luminosity function.
+.le
+.ls lseed = 1
+The initial value supplied to the random number generator used to
+generate the output magnitudes.
+If a value of "INDEF" is given then the clock
+time (integer seconds since 1980) is used as the seed yielding
+different random numbers for each execution.
+.le
+
+			USER FUNCTIONS
+.ls sfile
+The name of the input text file containing the sampled spatial radial
+density
+function, one sample point per line, with the radius and relative probability
+in columns one and two respectively. The sample points need not be
+uniformly spaced or normalized.
+.le
+.ls nssample = 100
+The number of points at which the \fIspatial\fR density function is 
+sampled. If the \fIspatial\fR density function is analytic or approximated
+analytically (the "uniform" and "hubble" options) the function is sampled
+directly. If the function is read from a file  (the "file" option) an
+initial smoothing step is performed before sampling.
+.le
+.ls sorder = 10
+The order of the spline fits used to evaluate the integrated spatial
+density function.
+.le
+.ls lfile
+The name of the input text file containing the sampled luminosity
+function, one sample point per line, with the magnitude and relative probability
+in columns one and two respectively. The sample points need not be
+uniformly spaced or normalized.
+.le
+.ls nlsample = 100
+The number of points at which the luminosity function is sampled. If
+the luminosity function is analytic or approximated analytically (the
+"salpeter" and "bands" options) the function is sampled directly.  If
+it is read from a file  (the "file" option) an initial smoothing step
+is performed before sampling.
+.le
+.ls lorder = 10
+The order of the spline fits used to evaluate the integrated
+\fIluminosity\fR function.
+.le
+
+			INTERACTIVE PARAMETERS
+.ls rbinsize = 10.
+The bin size in pixels of the plotted histogram of the radial density
+distribution.
+.le
+.ls mbinsize = 0.5
+The bin size in magnitudes of the plotted histogram of the luminosity function.
+.le
+.ls graphics = stdgraph
+The default graphics device.
+.le
+.ls cursor = ""
+The graphics cursor.
+.le
+.ih
+DESCRIPTION
+\fBStarlist\fR generates a list of x and y coordinates and magnitudes
+for a sample of \fInstars\fR stars based on a user selected spatial
+density function \fIspatial\fR  and luminosity function
+\fIluminosity\fR and writes (appends) the results to the text file
+\fIstarlist\fR. If the \fIinteractive\fR parameter is "yes" the user
+can interactively examine plots of the spatial density function,
+the radial density function, and the luminosity function, and alter the
+parameters of the task until a satisfactory artificial field is
+generated.
+
+The spatial density function generates x and y values around a center
+of symmetry defined by \fIxcenter\fR and \fIycenter\fR within the x and
+y limits \fIxmin\fR, \fIxmax\fR, \fIymin\fR and \fIymax\fR according to
+the spatial density function specified by \fIspatial\fR.  The three
+supported spatial density functions are listed below where R is the
+radial distance in pixels, P is the relative spatial density, C is a
+constant and f is the best fitting cubic spline function to the spatial
+density function R(user), P(user) supplied by the user in the text file
+\fIsfile\fR.
+
+.nf
+    uniform:  P = C
+    hubble:   P = 1.0 / (1 + R / core_radius) ** 2 + base
+    file:     P = f (R(user), P(user))
+.fi
+
+The Hubble and user file spatial density function are sampled at
+\fInssample\fR equally spaced points, and integrated to give the
+spatial density probability function at each sampled point. The
+integrated probability function is normalized and approximated by a
+cubic spline of order \fIsorder\fR.  The x and y coordinates are
+computed by randomly sampling the integrated probability function until
+\fInstars\fR stars which satisfy the x and y coordinate limits
+\fIxmin\fR, \fIxmax\fR, \fIymin\fR and \fIymax\fR are generated.
+
+The luminosity function generates relative magnitude values between
+\fIminmag\fR and \fImaxmag\fR according to the luminosity function
+specified by \fIluminosity\fR.  The four supported luminosity functions
+are defined below where M is the magnitude, P is the relative luminosity
+function, C is a constant and f is the best fitting cubic spline
+function to the luminosity function M(user), P(user) supplied by the
+in the text file \fIlfile\fR.
+
+.nf
+  uniform:  P = C
+
+  powlaw:   P = C * 10. ** (power * M)
+
+  salpeter: P = C * 10. ** (-3.158 + 1.551e-1*dM - 5.194e-3*dM**2)
+
+            dM = M - mzero
+
+                             C * 10. ** (beta * dM)
+  bands:   P =  --------------------------------------------------
+               (1. + 10. ** ((beta-alpha)*delta*dM))) ** 1. /delta
+
+           dM = M - mstar - mzero
+
+  file:    P = f (M(user), P(user))
+.fi
+
+The Salpeter and "bands" functions are defined in terms of absolute
+magnitudes so the parameter \fImzero\fR is used to convert from
+relative magnitudes.  Equivalently, one could use absolute magnitudes
+for the magnitude limits while setting the zero point to 0.
+
+The luminosity function is sampled at \fInlsample\fR equally spaced
+points, and integrated to give the luminosity probability function at
+each sampled point. The probablity function is normalized and
+approximated by a cubic spline of order \fIlorder\fR. The magnitudes
+are computed by randomly sampling the integrated probability function
+until \fInstars\fR objects which satisfy the magnitude limits
+\fIminmag\fR and \fImaxmag\fR are generated.  The Salpeter luminosity
+is a best fit function to the data of McCuskey (McCuskey, 1966, Vistas
+Astr. 7, 141). The Bahcall and Soneira function and the default values
+of the parameters are discussed by Bahcall and Soneira (Ap.J.  Supp. 44, 73).
+.ih
+CURSORS
+The following interactive keystroke commands are available from within the
+STARLIST task.
+
+.nf
+	Starlist Keystroke Commands
+
+?	Print options
+f	Fit  one or more of the following
+	    Spatial density function (SDF)
+	    Luminosity functions (LF)
+x	Plot the x-y spatial density function
+r	Plot the histogram of the radial density function
+m	Plot the histogram of the luminosity function
+:	Colon escape commands (see below)
+q	Exit program
+.fi
+
+The following parameters can be shown or set from within the STARLIST task.
+
+
+.nf
+		Starlist Colon Commands
+
+:show			Show starlist parameters
+:nstars     [value]	Number of stars
+
+:spatial    [string]	Spatial density function (SDF)
+			(uniform|hubble|file) 
+:xmin       [value]	Minimum X value
+:xmax       [value]	Maximum X value
+:ymin       [value]	Minimum Y value
+:ymax       [value]	Maximum Y value
+:xcenter    [value]	X center for SDF
+:ycenter    [value]	Y center for SDF
+:core       [value]	Core radius for Hubble density function
+:base       [value]	Background density for Hubble density function
+
+:luminosity [string]	Luminosity function (LF)
+			(uniform|powlaw|salpeter|bands|file)
+:minmag     [value]	Minimum magnitude
+:maxmag     [value]	Maximum magnitude
+:mzero	    [value]	Magnitude zero-point for salpeter and bands LF
+:power	    [value]	Exponent for powlaw LF
+:alpha      [value]	Alpha parameter for bands LF
+:beta       [value]	Beta parameter for bands LF
+:delta      [value]	Delta parameter for bands LF
+:mstar      [value]	Mstar parameter for bands LF
+
+:sfile	    [string]    File containing the user SDF
+:nssample   [value]	Number of SDF sample points
+:sorder	    [value]	Order of spline fit to integrated SDF
+:lfile	    [string]    File containing the user LF
+:nlsample   [value]	Number of LF sample points 
+:lorder	    [value]	Order of spline fit to the integrated LF
+
+:rbinsize   [value]	Resolution of radial profile histogram (pixels)
+:mbinsize   [value]	Resolution of magnitude histogram (mag)
+.fi
+
+.ih
+EXAMPLES
+1. Create a uniform artificial starfield of 5000 stars for a 512 square image.
+
+.nf
+    ar> starlist starfield.dat 5000
+    ar> mkobjects starfield obj=starfield.dat gain=2 rdnoise=10 poisson+
+.fi
+
+This example takes about a minute on a SPARCstation 1.
+
+2. Create a globular cluster field of 5000 stars for a 512 square image.
+
+.nf
+    ar> starlist gc.dat 5000 spat=hubble lum=bands
+    ar> mkobjects starfield obj=gc.dat gain=2 rdnoise=10 poisson+
+.fi
+
+This example takes about a minute on a SPARCstation 1.
+
+3. Examine the distributions for a Hubble spatial distribution
+and Salpeter magnitude distribution using 1000 stars without
+creating a data file.
+
+.nf
+    ar> starlist dev$null 1000 inter+ spat=hubble lum=salpeter
+	    ... an x-y plot will appear on the screen
+	    ... type r to examine the radial density function
+	    ... type m to examine the luminosity function
+	    ... type = to make a copy of any of the plots
+	    ... type q to quit
+.fi
+.ih
+REVISIONS
+.ls STARLIST V2.11+
+The random number seeds can be set from the clock time by using the value
+"INDEF" to yield different random numbers for each execution.
+.le
+.ih
+BUGS
+The spline approximation to the spatial density and luminosity
+probability functions can  cause wiggles in the output spatial density
+and luminosity functions. Users can examine the results interactively
+and experiment with the spline order and number of sample points if
+they are not satisfied with the results of STARLIST. The default setup
+of 10 sample points per spline piece is generally satisfactory for the
+spatial density and luminosity functions supplied here.
+.ih
+SEE ALSO
+gallist mkobjects
+.endhelp
diff --git a/noao/artdata/doc/version1.1 b/noao/artdata/doc/version1.1
new file mode 100644
index 00000000..b16c4df1
--- /dev/null
+++ b/noao/artdata/doc/version1.1
@@ -0,0 +1,49 @@
+		Changes to the ARTDATA Package: Version 1.1
+
+Since the first release of the ARTDATA package with V2.9 there have been
+several bugs found and documented, as is natural, and some new features
+and tasks have been added.  This note summarizes these changes.
+
+The bugs (log numbers 127, 130, 131, and 135) are all in the main task
+MKOBJECTS.  Two of these concern the size of the PSF as specified by
+the "radius" parameter.  The radius parameter for the gaussian PSF
+is interpreted as a FWHM instead of the intended HWHM (radius at half
+maximum).  This leads to very narrow stars until one compensates for the
+error.  The size of the moffat PSF are off by a small factor (~10%)
+depending on the beta parameter.  Another bug causes objects near the edge
+to be off by 1 pixel from the specified coordinates.  The last bug
+prevents use of a user supplied profile function for the PSF.  A
+distributed patch for the above problems is planned.  Thanks go to
+Lindsey Davis and Steven Perry for the careful studies which identified
+the first three bugs.
+
+The artificial one dimensional spectra produced by MK1DSPEC have new
+parameters allowing addition of a velocity shift specified either as
+a velocity or redshift.  This is a useful addition for tests of radial
+velocity programs.
+
+The initial version of the package provided minimal headers; mostly
+just the wavelengths for 1D spectra and the dispersion axis for 2D
+spectra.  People then need to HEDIT keywords to make the images
+work well with some packages.  Four things have been done to
+make useful headers for the artificial data.  First, a detailed
+log of parameters used to generate the images is included as COMMENT
+cards.  This includes task parameters and information from data files
+such as those in the star and galaxy list files produced by
+STARLIST and GALLIST.  Second, the gain, read noise, exposure
+time, and dispersion correction flag have been added to the header
+when appropriate.  Third, each task has a new parameter for specifying
+a header keyword data file containing a list of keywords and values
+to be automatically added.  A default file is supplied but any set
+for a particular type of data may be substituted.  Finally, a new
+task called MKHEADER has been added which applies header keyword
+data files to images.
+
+A new task called MKEXAMPLES has been added.  Given the name of an
+example from a menu an image is created.  This task is intended to
+provide examples for the ARTDATA package as well as test and
+demonstration images for the various packages.  The initial menu
+includes long slit and multifiber spectra, a globular cluster,
+a star field, a galaxy field, and a galaxy cluster.  Additional
+examples will be added as demonstrations and test procedures are
+developed for various packages.
diff --git a/noao/artdata/gallist.par b/noao/artdata/gallist.par
new file mode 100644
index 00000000..e0df91f2
--- /dev/null
+++ b/noao/artdata/gallist.par
@@ -0,0 +1,52 @@
+# GALLIST Parameter File
+
+gallist,f,a,,,,"Output galaxies list file"
+ngals,i,a,100,,,"Number of galaxies in the output list"
+interactive,b,h,no,,,"Interactive mode?
+
+SPATIAL DISTRIBUTION"
+spatial,s,h,"uniform","uniform|hubble|file",,"Spatial density function (uniform|hubble|file)"
+xmin,r,h,1.,,,"Minimum x coordinate value"
+xmax,r,h,512.,,,"Maximum x coordinate value"
+ymin,r,h,1.,,,"Minimum y coordinate value"
+ymax,r,h,512.,,,"Maximum y coordinate value"
+xcenter,r,h,INDEF,,,"X coordinate of center of Hubble distribution"
+ycenter,r,h,INDEF,,,"Y coordinate of center of Hubble distribution"
+core_radius,r,h,50.,,,"Core radius of Hubble distribution"
+base,r,h,0.,,,"Relative background density of the Hubble distribution"
+sseed,i,h,2,,,"Seed for sampling the spatial probability function
+
+MAGNITUDE DISTRIBUTION"
+luminosity,s,h,"powlaw","uniform|powlaw|schecter|file",,"Luminosity function (uniform|powlaw|schecter|file)"
+minmag,r,h,-7.,,,"Minimum magnitude"
+maxmag,r,h,0.,,,"Maximum magnitude"
+mzero,r,h,15.,,,"Magnitude zero point"
+power,r,h,0.6,,,"Power law magnitude distribution coefficient"
+alpha,r,h,-1.24,,,"Schecter luminosity function coefficient"
+mstar,r,h,-21.41,,,"Schecter luminosity function charactersitic mangitude"
+lseed,i,h,2,,,"Seed for sampling the luminosity probability function
+
+MORPHOLOGY DISTRIBUTION"
+egalmix,r,h,0.4,,,"Percentage of elliptical galaxies"
+ar,r,h,0.3,0.3,1.,"Minimum elliptical galaxy axial ratio"
+eradius,r,h,20.,,,"Maximum elliptical half flux radius"
+sradius,r,h,1.,,,"Spiral/ellipical radius at same magnitude"
+absorption,r,h,1.2,,,"Absorption in edge on spirals (mag)"
+z,r,h,0.05,0.0001,,"Minimum redshift
+
+USER FUNCTIONS"
+sfile,f,h,"",,,"File containing spatial density function"
+nssample,i,h,100,,,"Number of spatial density function sampling points"
+sorder,i,h,10,,,"Number of spline pieces for spatial function"
+lfile,f,h,"",,,"File containing luminosity function"
+nlsample,i,h,100,,,"Number of luminosity function sampling points"
+lorder,i,h,10,,,"Number of spline pieces for luminosity probability function
+
+INTERACTIVE PARAMETERS"
+rbinsize,r,h,10.,,,"Bin size of radial density function histogram in pixels"
+mbinsize,r,h,0.5,,,"Bin size of luminosity function in magnitudes"
+dbinsize,r,h,0.5,,,"Bin size of diameter distribution function in pixels"
+ebinsize,r,h,0.1,,,"Bin size of roundness distribution function"
+pbinsize,r,h,20.,,,"Bin size of position angle distribution function in degrees"
+graphics,s,h,stdgraph,,,"Standard graphics device"
+cursor,*gcur,h,"",,,"Graphics cursor"
diff --git a/noao/artdata/lists/gallist.key b/noao/artdata/lists/gallist.key
new file mode 100644
index 00000000..aa9d1822
--- /dev/null
+++ b/noao/artdata/lists/gallist.key
@@ -0,0 +1,63 @@
+	Gallist Keystroke Commands
+
+?	Print options
+f	Fit one or more of following 
+	    Spatial density function (SDF)
+            Luminosity  function (LF)
+	    Distribution of morphological type
+	    Diameter distribution
+	    Roundness distribution
+	    Position angle distribution 
+x	Plot the x-y spatial density function
+r	Plot the histogram of the radial density function
+m	Plot the histogram of the luminosity function
+d	Plot the histogram of the diameter values
+e	Plot the histogram of the roundness values 
+p	Plot the histogram of the position angle values
+:	Colon escape commands (see below)
+q	Exit program
+
+
+	Gallist Colon Commands
+
+:show			Show gallist parameters
+:ngal       [value]	Number of galaxies
+
+:spatial    [string]	Spatial density function (SDF) (uniform|hubble|file) 
+:xmin       [value]	Minimum X value
+:xmax       [value]	Maximum X value
+:ymin       [value]	Minimum Y value
+:ymax       [value]	Maximum Y value
+:xcenter    [value]	X center for radial density function
+:ycenter    [value]	Y center for radial density function
+:core       [value]	Core radius for Hubble density function
+:base       [value]	Background density for Hubble density function
+
+:luminosity [string]	Luminosity function (LF)
+			(uniform|powlaw|shcecter|file)
+:minmag     [value]	Minimum magnitude
+:maxmag     [value]	Maximum magnitude
+:power      [value]     Power law coefficient
+:mzero	    [value]     Zero point for Schecter luminosity function
+:alpha      [value]	Schecter parameter
+:mstar      [value]	Characteristic mag for Schecter function
+
+:egalmix    [value]	Elliptical/Spiral galaxy ratio
+:ar         [value]     Minimum elliptical galaxy axial ratio
+:eradius    [value]     Maximum elliptical half flux radius
+:sradius    [value]     Spiral/elliptical radius at same magnitude
+:absorption [value]	Absorption correction for edge-on spirals
+:z          [value]     Minimum redshift
+
+:lfile      [string]    Name of the luminosity function file
+:sfile	    [string]    Name of the spatial density function file
+:nlsample   [value]	Number of LF sample points 
+:lorder	    [value]	Order of spline approximation to the integrated LF
+:nssample   [value]	Number of SDF sample points
+:sorder	    [value]	Order of spline approximation to the integrated SDF
+
+:rbinsize   [value]	Resolution of radial SDF histogram in pixels
+:mbinsize   [value]	Resolution of magnitude histogram in magnitudes
+:dbinsize   [value]	Resolution of diameter histogram in pixels
+:ebinsize   [value]	Resolution of roundness histogram in pixels
+:pbinsize   [value]     Resolution of position angle histogram in degrees
diff --git a/noao/artdata/lists/mkpkg b/noao/artdata/lists/mkpkg
new file mode 100644
index 00000000..d8281097
--- /dev/null
+++ b/noao/artdata/lists/mkpkg
@@ -0,0 +1,18 @@
+# ARTDATA STARLIST and GALLIST task libraries
+
+$checkout libpkg.a ../
+$update libpkg.a
+$checkin libpkg.a ../
+$exit
+
+libpkg.a:
+	stcolon.x	starlist.h <error.h>
+	stdbio.x	starlist.h <pkg/dttext.h>
+	stlum.x		<mach.h> <math.h> <math/curfit.h> <math/iminterp.h>
+	stmix.x		<math.h> starlist.h
+	stplot.x	starlist.h <gset.h> <mach.h> <math.h> <pkg/gtools.h>
+	stshow.x	starlist.h
+	stspatial.x	<math.h> <math/curfit.h> <math/iminterp.h>
+	t_gallist.x	starlist.h <fset.h>
+	t_starlist.x	starlist.h <fset.h>
+	;
diff --git a/noao/artdata/lists/starlist.h b/noao/artdata/lists/starlist.h
new file mode 100644
index 00000000..01498222
--- /dev/null
+++ b/noao/artdata/lists/starlist.h
@@ -0,0 +1,136 @@
+# STARLIST/GALLIST task definitions file
+
+define	ST_STARS		1		# Make star list
+define	ST_GALAXIES		2		# Make galaxies list
+
+# Spatial distribution functions
+
+define	ST_UNIFORM		1		# Uniform spatial distribution
+define	ST_HUBBLE		2		# Hubble law
+define	ST_SPFILE		3		# User input
+
+# Luminosity distribution function
+
+define	ST_UNIFORM		1		# Uniform luminosity function
+define	ST_SALPETER		2		# Salpeter luminosity function
+define	ST_BANDS		3		# Bahcall and Soneira
+define	ST_LFFILE		4		# User input
+define	ST_POWLAW		5		# Power law
+define	ST_SCHECTER		6		# Schecter luminosity function
+
+# Galaxies types
+
+define	ST_DEVAUC		1		# Ellipticals
+define	ST_EXP			2		# Spirals
+
+define LEN_STSTRUCT		(45 + 4 * SZ_FNAME + 4)
+
+define	ST_TYPE			Memi[$1]	# Stars or galaxies
+define	ST_SPATIAL		Memi[$1+1]	# Spatial function
+define	ST_XC			Memr[P2R($1+2)]	# X center
+define	ST_YC			Memr[P2R($1+3)]	# Y center
+define	ST_CORE			Memr[P2R($1+4)]	# Hubble core radius
+define	ST_BASE			Memr[P2R($1+5)]	# Hubble baseline probability
+define	ST_XMIN			Memr[P2R($1+6)]	# Minimum x value
+define	ST_XMAX			Memr[P2R($1+7)]	# Maximum x value
+define	ST_YMIN			Memr[P2R($1+8)]	# Minimum y value
+define	ST_YMAX			Memr[P2R($1+9)]	# Maximum y value
+
+define	ST_LUMINOSITY		Memi[$1+10]	# Luminosity function
+define	ST_POWER		Memr[P2R($1+11)]# Power law
+define	ST_MZERO		Memr[P2R($1+12)]# Zero point of magnitudes
+define	ST_ALPHA		Memr[P2R($1+13)]# Bands function alpha
+define	ST_BETA			Memr[P2R($1+14)]# Bands function beta
+define	ST_DELTA		Memr[P2R($1+15)]# Bands function delta
+define	ST_MSTAR		Memr[P2R($1+16)]# Bands function mstar
+define	ST_MINMAG		Memr[P2R($1+17)]# Minimum magnitude
+define	ST_MAXMAG		Memr[P2R($1+18)]# Maximum magnitude
+
+define	ST_Z			Memr[P2R($1+19)]# Minimum redshift
+define	ST_AR			Memr[P2R($1+20)]# Minimum roundness
+define	ST_ERADIUS		Memr[P2R($1+21)]# Maximum elliptical radius
+define	ST_SRADIUS		Memr[P2R($1+22)]# Maximum spiral radius
+define	ST_EGALMIX		Memr[P2R($1+23)]# Egal fraction
+define	ST_ABSORPTION		Memr[P2R($1+24)]# Absorption
+
+define	ST_SSEED		Meml[$1+25]	# Spatial function seed
+define	ST_LSEED		Meml[$1+26]	# Luminosity function seed
+define	ST_NSSAMPLE		Memi[$1+27]	# Spatial function sampling
+define	ST_NLSAMPLE		Memi[$1+28]	# Luminosity function sampling
+define	ST_SORDER		Memi[$1+29]	# Spatial spline order
+define	ST_LORDER		Memi[$1+30]	# Luminosity spline order
+define	ST_NSTARS		Memi[$1+31]	# Number of stars
+
+define	ST_RBINSIZE		Memr[P2R($1+32)]# Radial histogram resolution
+define	ST_MBINSIZE		Memr[P2R($1+33)]# Magnitude histogram resolution
+define	ST_DBINSIZE		Memr[P2R($1+34)]# Diameter histogram resolution
+define	ST_EBINSIZE		Memr[P2R($1+35)]# Roundness histogram resolution
+define	ST_PBINSIZE		Memr[P2R($1+36)]# Posang histogram resolution
+
+define	ST_SPSTRING		Memc[P2C($1+37)]
+define	ST_LFSTRING		Memc[P2C($1+37+SZ_FNAME+1)]
+define	ST_SFILE		Memc[P2C($1+37+2*SZ_FNAME+2)]
+define	ST_LFILE		Memc[P2C($1+37+3*SZ_FNAME+3)]
+
+define	STCMDS "|show|nstars|spatial|xcenter|ycenter|core|base|xmin|xmax|\
+ymin|ymax|luminosity|power|alpha|beta|delta|mstar|minmag|maxmag|||nssample|\
+nlsample|sorder|lorder|sfile|lfile|rbinsize|mbinsize|ar|z|eradius|sradius|\
+egalmix|dbinsize|ebinsize|pbinsize|ngals|mzero|absorption|"
+
+define	SPFUNCS		"|uniform|hubble|file|"
+define	LUMFUNCS	"|uniform|salpeter|bands|file|powlaw|"
+define	GLUMFUNCS	"|uniform|||file|powlaw|schecter|"
+
+define	STCMD_SHOW		1
+define	STCMD_NSTARS		2
+define	STCMD_SPATIAL		3
+define	STCMD_XCENTER		4
+define	STCMD_YCENTER		5
+define	STCMD_CORE		6
+define	STCMD_BASE		7
+define	STCMD_XMIN		8
+define	STCMD_XMAX		9
+define	STCMD_YMIN		10
+define	STCMD_YMAX		11
+define	STCMD_LUMINOSITY	12
+define	STCMD_POWER		13
+define	STCMD_ALPHA		14
+define	STCMD_BETA		15
+define	STCMD_DELTA		16
+define	STCMD_MSTAR		17
+define	STCMD_MINMAG		18
+define	STCMD_MAXMAG		19
+define	STCMD_SSEED		20
+define	STCMD_LSEED		21
+define	STCMD_NSSAMPLE		22
+define	STCMD_NLSAMPLE		23
+define	STCMD_SORDER		24
+define	STCMD_LORDER		25
+define	STCMD_SFILE		26
+define	STCMD_LFILE		27
+define	STCMD_RBINSIZE		28
+define	STCMD_MBINSIZE		29
+define	STCMD_AR		30
+define	STCMD_Z			31
+define	STCMD_ERADIUS		32
+define	STCMD_SRADIUS		33
+define	STCMD_EGALMIX		34
+define	STCMD_DBINSIZE		35
+define	STCMD_EBINSIZE		36
+define	STCMD_PBINSIZE		37
+define	STCMD_NGALS		38
+define	STCMD_MZERO		39
+define	STCMD_ABSORPTION	40
+
+# Miscellaneous default values
+
+define	DEF_CORE		20.0
+define	DEF_BASE		0.00
+
+define	DEF_ALPHA		0.74
+define	DEF_BETA		0.04
+define	DEF_DELTA		0.294
+define	DEF_MSTAR		1.28
+
+define	DEF_GMSTAR		-20.6
+define	DEF_GALPHA		-1.25
diff --git a/noao/artdata/lists/starlist.key b/noao/artdata/lists/starlist.key
new file mode 100644
index 00000000..45f6c1fc
--- /dev/null
+++ b/noao/artdata/lists/starlist.key
@@ -0,0 +1,47 @@
+	Starlist Keystroke Commands
+
+?	Print options
+f	Fit  one or more of the following
+	    Spatial density function (SDF)
+	    Luminosity functions (LF)
+x	Plot the x-y spatial density function
+r	Plot the histogram of the radial density function
+m	Plot the histogram of the luminosity function
+:	Colon escape commands (see below)
+q	Exit program
+
+
+	Starlist Colon Commands
+
+:show			Show starlist parameters
+:nstars     [value]	Number of stars
+
+:spatial    [string]	Spatial density function (uniform|hubble|file) 
+:xmin       [value]	Minimum X value
+:xmax       [value]	Maximum X value
+:ymin       [value]	Minimum Y value
+:ymax       [value]	Maximum Y value
+:xcenter    [value]	X center for radial density function
+:ycenter    [value]	Y center for radial density function
+:core       [value]	Core radius for Hubble density function
+:base       [value]	Background density for Hubble density function
+
+:luminosity [string]	Luminosity function (uniform|powlaw|salpeter|bands|file)
+:minmag     [value]	Minimum magnitude
+:maxmag     [value]	Maximum magnitude
+:power	    [value]     Coefficent for powlaw magnitude distribution
+:mzero	    [value]	Magnitude zero point for salpeter and bands functions
+:alpha      [value]	Alpha parameter for bands luminosity function
+:beta       [value]	Beta parameter for bands luminosity function
+:delta      [value]	Delta parameter for bands luminosity function
+:mstar      [value]	Mstar parameter for bands luminosity function
+
+:sfile	    [string]    File containing the user spatial function
+:nssample   [value]	Number of SDF sample points
+:sorder	    [value]	Order of spline fit to spatial function
+:lfile	    [string]    File containing the user luminosity function
+:nlsample   [value]	Number of LF sample points 
+:lorder	    [value]	Order of spline fit to the integrated LF
+
+:rbinsize   [value]	Resolution of radial profile histogram (pixels)
+:mbinsize   [value]	Resolution of magnitude histogram (mag)
diff --git a/noao/artdata/lists/stcolon.x b/noao/artdata/lists/stcolon.x
new file mode 100644
index 00000000..9aadd578
--- /dev/null
+++ b/noao/artdata/lists/stcolon.x
@@ -0,0 +1,835 @@
+include <error.h>
+include "starlist.h"
+
+# ST_COLON -- Process colon commands for the STARLIST task.
+
+procedure st_colon (gd, st, sf, lf, cmdstr, newspace, newlum, newplot)
+
+pointer	gd		# pointer to the graphics stream
+pointer	st		# pointer to starlist structure
+int	sf		# spatial density function file descriptor
+int	lf		# luminosity function file descriptor
+char	cmdstr[ARB]	# input command string
+int	newspace	# new spatial distribution function
+int	newlum		# new luminosity function
+int	newplot		# new plot
+
+int	ival, ncmd, stat
+pointer	sp, cmd, str
+long	lval
+real	rval
+bool	streq()
+int	strdic(), nscan(), open()
+
+string	lumfuncs LUMFUNCS
+
+begin
+	# Allocate temporary space.
+	call smark (sp)
+	call salloc (cmd, SZ_LINE, TY_CHAR)
+	call salloc (str, SZ_FNAME, TY_CHAR)
+
+	# Get the command.
+	call sscan (cmdstr)
+	call gargwrd (Memc[cmd], SZ_LINE)
+	if (Memc[cmd] == EOS)
+	    return
+
+	# Process the command.
+	ncmd = strdic (Memc[cmd], Memc[cmd], SZ_LINE, STCMDS)
+	switch (ncmd) {
+
+	case STCMD_SHOW:
+	    call gdeactivate (gd, 0)
+	    call st_show (st)
+	    call greactivate (gd, 0)
+
+	case STCMD_SPATIAL:
+	    call gargwrd (Memc[cmd], SZ_LINE)
+	    if (nscan () == 1) {
+	        call printf ("spatial = %s\n")
+		    call pargstr (ST_SPSTRING(st))
+	    } else {
+		stat = strdic (Memc[cmd], Memc[cmd], SZ_LINE, SPFUNCS)
+		if (stat > 0) {
+		    ST_SPATIAL(st) = stat
+		    call strcpy (Memc[cmd], ST_SPSTRING(st), SZ_FNAME)
+		}
+		newspace = YES
+	    }
+
+	case STCMD_XCENTER:
+	    call gargr (rval)
+	    if (nscan() == 1) {
+		call printf ("xcenter = %g pixels\n")
+		    call pargr (ST_XC(st))
+	    } else {
+		ST_XC(st) = rval
+		newspace = YES
+	    }
+
+	case STCMD_YCENTER:
+	    call gargr (rval)
+	    if (nscan() == 1) {
+		call printf ("ycenter = %g pixels\n")
+		    call pargr (ST_YC(st))
+	    } else {
+		ST_YC(st) = rval
+		newspace = YES
+	    }
+
+	case STCMD_CORE:
+	    call gargr (rval)
+	    if (nscan() == 1) {
+		call printf ("core = %g pixels\n")
+		    call pargr (ST_CORE(st))
+	    } else {
+		ST_CORE(st) = rval
+		newspace = YES
+	    }
+
+	case STCMD_BASE:
+	    call gargr (rval)
+	    if (nscan() == 1) {
+		call printf ("base = %g pixels\n")
+		    call pargr (ST_BASE(st))
+	    } else {
+		ST_BASE(st) = rval
+		newspace = YES
+	    }
+
+	case STCMD_XMIN:
+	    call gargr (rval)
+	    if (nscan() == 1) {
+		call printf ("xmin = %g pixels\n")
+		    call pargr (ST_XMIN(st))
+	    } else {
+		ST_XMIN(st) = rval
+		newspace = YES
+	    }
+
+	case STCMD_XMAX:
+	    call gargr (rval)
+	    if (nscan() == 1) {
+		call printf ("xmax = %g pixels\n")
+		    call pargr (ST_XMAX(st))
+	    } else {
+		ST_XMAX(st) = rval
+		newspace = YES
+	    }
+
+	case STCMD_YMIN:
+	    call gargr (rval)
+	    if (nscan() == 1) {
+		call printf ("ymin = %g pixels\n")
+		    call pargr (ST_YMIN(st))
+	    } else {
+		ST_YMIN(st) = rval
+		newspace = YES
+	    }
+
+	case STCMD_YMAX:
+	    call gargr (rval)
+	    if (nscan() == 1) {
+		call printf ("ymax = %g pixels\n")
+		    call pargr (ST_YMAX(st))
+	    } else {
+		ST_YMAX(st) = rval
+		newspace = YES
+	    }
+
+	case STCMD_SFILE:
+	    call gargwrd (Memc[cmd], SZ_LINE)
+	    if (Memc[cmd] == EOS || streq (Memc[cmd], ST_SFILE(st))) {
+		call printf ("sfile: %s\n")
+		    call pargstr (ST_SFILE(st))
+	    } else {
+		if (sf != NULL) {
+		    call close (sf)
+		    sf = NULL
+		}
+		iferr {
+		    sf = open (Memc[cmd], READ_ONLY, TEXT_FILE)
+		} then {
+		    sf = NULL
+		    call erract (EA_WARN)
+		    call strcpy ("", ST_SFILE(st), SZ_FNAME)
+		    call printf (
+		        "Spatial distribution function file is undefined.\n")
+		} else {
+		    call strcpy (Memc[cmd], ST_SFILE(st), SZ_FNAME)
+		    newspace = YES
+		}
+	    }
+
+	case STCMD_LUMINOSITY:
+	    call gargwrd (Memc[cmd], SZ_LINE)
+	    if (nscan () == 1) {
+	        call printf ("luminosity = %s\n")
+		    call pargstr (ST_LFSTRING(st))
+	    } else {
+		stat = strdic (Memc[cmd], Memc[cmd], SZ_LINE, LUMFUNCS)
+		if (stat > 0) {
+		    ST_LUMINOSITY (st) = stat
+		    call strcpy (Memc[cmd], ST_LFSTRING(st), SZ_FNAME)
+		}
+		newlum = YES
+	    }
+
+	case  STCMD_POWER:
+	    call gargr (rval)
+	    if (nscan() == 1) {
+		call printf ("power = %g\n")
+		    call pargr (ST_POWER(st))
+	    } else {
+		ST_POWER(st) = rval
+		newlum = YES
+	    }
+
+	case  STCMD_MZERO:
+	    call gargr (rval)
+	    if (nscan() == 1) {
+		call printf ("mzero = %g\n")
+		    call pargr (ST_MZERO(st))
+	    } else {
+		ST_MZERO(st) = rval
+		newlum = YES
+	    }
+
+	case  STCMD_ALPHA:
+	    call gargr (rval)
+	    if (nscan() == 1) {
+		call printf ("alpha = %g\n")
+		    call pargr (ST_ALPHA(st))
+	    } else {
+		ST_ALPHA(st) = rval
+		newlum = YES
+	    }
+
+	case  STCMD_BETA:
+	    call gargr (rval)
+	    if (nscan() == 1) {
+	        call printf ("beta = %g\n")
+		    call pargr (ST_BETA(st))
+	    } else {
+		ST_BETA(st) = rval
+		newlum = YES
+	    }
+
+	case STCMD_DELTA:
+	    call gargr (rval)
+	    if (nscan() == 1) {
+		call printf ("delta = %g\n")
+		    call pargr (ST_DELTA(st))
+	    } else {
+		ST_DELTA(st) = rval
+		newlum = YES
+	    }
+
+	case STCMD_MSTAR:
+	    call gargr (rval)
+	    if (nscan() == 1) {
+		call printf ("mstar = %g\n")
+		    call pargr (ST_MSTAR(st))
+	    } else {
+		ST_MSTAR(st) = rval
+		newlum = YES
+	    }
+
+	case STCMD_MINMAG:
+	    call gargr (rval)
+	    if (nscan() == 1) {
+		call printf ("minmag = %g\n")
+		    call pargr (ST_MINMAG(st))
+	    } else {
+		ST_MINMAG(st) = rval
+		newlum = YES
+	    }
+
+	case STCMD_MAXMAG:
+	    call gargr (rval)
+	    if (nscan() == 1) {
+		call printf ("maxmag = %g\n")
+		    call pargr (ST_MAXMAG(st))
+	    } else {
+		ST_MAXMAG(st) = rval
+		newlum = YES
+	    }
+
+	case STCMD_LFILE:
+	    call gargwrd (Memc[cmd], SZ_LINE)
+	    if (Memc[cmd] == EOS || streq (Memc[cmd], ST_LFILE(st))) {
+		call printf ("lfile: %s\n")
+		    call pargstr (ST_LFILE(st))
+	    } else {
+		if (lf != NULL) {
+		    call close (lf)
+		    lf = NULL
+		}
+		iferr {
+		    lf = open (Memc[cmd], READ_ONLY, TEXT_FILE)
+		} then {
+		    lf = NULL
+		    call erract (EA_WARN)
+		    call strcpy ("", ST_LFILE(st), SZ_FNAME)
+		    call printf (
+		        "Luminosity function file is undefined.\n")
+		} else {
+		    call strcpy (Memc[cmd], ST_LFILE(st), SZ_FNAME)
+		    newlum = YES
+		}
+	    }
+
+	case STCMD_NSTARS:
+	    call gargi (ival)
+	    if (nscan() == 1) {
+		call printf ("nstars = %d\n")
+		    call pargi (ST_NSTARS(st))
+	    } else {
+		ST_NSTARS(st) = ival
+		newlum = YES
+		newspace = YES
+	    }
+
+	case STCMD_NSSAMPLE:
+	    call gargi (ival)
+	    if (nscan() == 1) {
+		call printf ("nssample = %d\n")
+		    call pargi (ST_NSSAMPLE(st))
+	    } else {
+		ST_NSSAMPLE(st) = ival
+		newspace = YES
+	    }
+
+	case STCMD_SORDER:
+	    call gargl (lval)
+	    if (nscan() == 1) {
+		call printf ("sorder = %d\n")
+		    call pargl (ST_SORDER(st))
+	    } else {
+		ST_SORDER(st) = lval
+		newspace = YES
+	    }
+
+	case STCMD_SSEED:
+	    call gargl (lval)
+	    if (nscan() == 1) {
+		call printf ("sseed = %d\n")
+		    call pargl (ST_SSEED(st))
+	    } else {
+		ST_SSEED(st) = lval
+		newspace = YES
+	    }
+
+	case STCMD_NLSAMPLE:
+	    call gargi (ival)
+	    if (nscan() == 1) {
+		call printf ("nlsample = %d\n")
+		    call pargi (ST_NLSAMPLE(st))
+	    } else {
+		ST_NLSAMPLE(st) = ival
+		newlum = YES
+	    }
+
+	case STCMD_LORDER:
+	    call gargl (lval)
+	    if (nscan() == 1) {
+		call printf ("lorder = %d\n")
+		    call pargl (ST_LORDER(st))
+	    } else {
+		ST_LORDER(st) = lval
+		newlum = YES
+	    }
+
+	case STCMD_LSEED:
+	    call gargl (lval)
+	    if (nscan() == 1) {
+		call printf ("lseed = %d\n")
+		    call pargl (ST_LSEED(st))
+	    } else {
+		ST_LSEED(st) = lval
+		newlum = YES
+	    }
+
+	case STCMD_RBINSIZE:
+	    call gargr (rval)
+	    if (nscan() == 1) {
+		call printf ("rbinsize = %g\n")
+		    call pargr (ST_RBINSIZE(st))
+	    } else {
+		ST_RBINSIZE(st) = rval
+		newplot = YES
+	    }
+
+	case STCMD_MBINSIZE:
+	    call gargr (rval)
+	    if (nscan() == 1) {
+		call printf ("mbinsize = %g\n")
+		    call pargr (ST_MBINSIZE(st))
+	    } else {
+		ST_MBINSIZE(st) = rval
+		newplot = YES
+	    }
+
+	default:
+	    call printf ("\7\n")
+	}
+
+	call sfree (sp)
+end
+
+
+# ST_GCOLON -- Process colon commands for the GALAXIES task.
+
+procedure st_gcolon (gd, st, sf, lf, cmdstr, newspace, newlum, newmix, newaxis,
+	newround, newphi, newplot)
+
+pointer	gd		# pointer to the graphics stream
+pointer	st		# pointer to starlist structure
+int	sf		# spatial distribution function file descriptor
+int	lf		# luminosity function file descriptor
+char	cmdstr[ARB]	# command string
+int	newspace	# new spatial distribution function
+int	newlum		# new luminosity function
+int	newmix		# new E/S galaxy mixture
+int	newaxis		# new axis parameter
+int	newround	# compute new roundness parameters
+int	newphi		# compute new position angles
+int	newplot		# make a newplot
+
+int	ival, ncmd, stat
+pointer	sp, cmd, str
+long	lval
+real	rval
+bool	streq()
+int	strdic(), nscan(), open()
+
+string	lumfuncs LUMFUNCS
+
+begin
+	call smark (sp)
+	call salloc (cmd, SZ_LINE, TY_CHAR)
+	call salloc (str, SZ_FNAME, TY_CHAR)
+
+	# Get the command.
+	call sscan (cmdstr)
+	call gargwrd (Memc[cmd], SZ_LINE)
+	if (Memc[cmd] == EOS)
+	    return
+
+	# Process the command.
+	ncmd = strdic (Memc[cmd], Memc[cmd], SZ_LINE, STCMDS)
+	switch (ncmd) {
+	case STCMD_SHOW:
+	    call gdeactivate (gd, 0)
+	    call st_gshow (st)
+	    call greactivate (gd, 0)
+
+	case STCMD_SPATIAL:
+	    call gargwrd (Memc[cmd], SZ_LINE)
+	    if (nscan () == 1) {
+	        call printf ("spatial = %s\n")
+		    call pargstr (ST_SPSTRING(st))
+	    } else {
+		stat = strdic (Memc[cmd], Memc[cmd], SZ_LINE, SPFUNCS)
+		if (stat > 0) {
+		    ST_SPATIAL(st) = stat
+		    call strcpy (Memc[cmd], ST_SPSTRING(st), SZ_FNAME)
+		}
+		newspace = YES
+	    }
+
+	case STCMD_XCENTER:
+	    call gargr (rval)
+	    if (nscan() == 1) {
+		call printf ("xcenter = %g pixels\n")
+		    call pargr (ST_XC(st))
+	    } else {
+		ST_XC(st) = rval
+		newspace = YES
+	    }
+
+	case STCMD_YCENTER:
+	    call gargr (rval)
+	    if (nscan() == 1) {
+		call printf ("ycenter = %g pixels\n")
+		    call pargr (ST_YC(st))
+	    } else {
+		ST_YC(st) = rval
+		newspace = YES
+	    }
+
+	case STCMD_CORE:
+	    call gargr (rval)
+	    if (nscan() == 1) {
+		call printf ("core = %g pixels\n")
+		    call pargr (ST_CORE(st))
+	    } else {
+		ST_CORE(st) = rval
+		newspace = YES
+	    }
+
+	case STCMD_BASE:
+	    call gargr (rval)
+	    if (nscan() == 1) {
+		call printf ("base = %g pixels\n")
+		    call pargr (ST_BASE(st))
+	    } else {
+		ST_BASE(st) = rval
+		newspace = YES
+	    }
+
+	case STCMD_XMIN:
+	    call gargr (rval)
+	    if (nscan() == 1) {
+		call printf ("xmin = %g pixels\n")
+		    call pargr (ST_XMIN(st))
+	    } else {
+		ST_XMIN(st) = rval
+		newspace = YES
+	    }
+
+	case STCMD_XMAX:
+	    call gargr (rval)
+	    if (nscan() == 1) {
+		call printf ("xmax = %g pixels\n")
+		    call pargr (ST_XMAX(st))
+	    } else {
+		ST_XMAX(st) = rval
+		newspace = YES
+	    }
+
+	case STCMD_YMIN:
+	    call gargr (rval)
+	    if (nscan() == 1) {
+		call printf ("ymin = %g pixels\n")
+		    call pargr (ST_YMIN(st))
+	    } else {
+		ST_YMIN(st) = rval
+		newspace = YES
+	    }
+
+	case STCMD_YMAX:
+	    call gargr (rval)
+	    if (nscan() == 1) {
+		call printf ("ymax = %g pixels\n")
+		    call pargr (ST_YMAX(st))
+	    } else {
+		ST_YMAX(st) = rval
+		newspace = YES
+	    }
+
+	case STCMD_SFILE:
+	    call gargwrd (Memc[cmd], SZ_LINE)
+	    if (Memc[cmd] == EOS || streq (Memc[cmd], ST_SFILE(st))) {
+		call printf ("sfile: %s\n")
+		    call pargstr (ST_SFILE(st))
+	    } else {
+		if (sf != NULL) {
+		    call close (sf)
+		    sf = NULL
+		}
+		iferr {
+		    sf = open (Memc[cmd], READ_ONLY, TEXT_FILE)
+		} then {
+		    sf = NULL
+		    call erract (EA_WARN)
+		    call strcpy ("", ST_SFILE(st), SZ_FNAME)
+		    call printf (
+		        "Spatial distribution function file is undefined.\n")
+		} else {
+		    call strcpy (Memc[cmd], ST_SFILE(st), SZ_FNAME)
+		    newspace = YES
+		}
+	    }
+
+	case STCMD_LUMINOSITY:
+	    call gargwrd (Memc[cmd], SZ_LINE)
+	    if (nscan () == 1) {
+	        call printf ("luminosity = %s\n")
+		    call pargstr (ST_LFSTRING(st))
+	    } else {
+		stat = strdic (Memc[cmd], Memc[cmd], SZ_LINE, GLUMFUNCS)
+		if (stat > 0) {
+		    ST_LUMINOSITY (st) = stat
+		    call strcpy (Memc[cmd], ST_LFSTRING(st), SZ_FNAME)
+		}
+		newlum = YES
+	    }
+
+	case  STCMD_POWER:
+	    call gargr (rval)
+	    if (nscan() == 1) {
+		call printf ("power = %g\n")
+		    call pargr (ST_POWER(st))
+	    } else {
+		ST_POWER(st) = rval
+		newlum = YES
+	    }
+
+	case  STCMD_MZERO:
+	    call gargr (rval)
+	    if (nscan() == 1) {
+		call printf ("mzero = %g\n")
+		    call pargr (ST_MZERO(st))
+	    } else {
+		ST_MZERO(st) = rval
+		newlum = YES
+	    }
+
+	case  STCMD_ALPHA:
+	    call gargr (rval)
+	    if (nscan() == 1) {
+		call printf ("alpha = %g\n")
+		    call pargr (ST_ALPHA(st))
+	    } else {
+		ST_ALPHA(st) = rval
+		newlum = YES
+	    }
+
+	case STCMD_MSTAR:
+	    call gargr (rval)
+	    if (nscan() == 1) {
+		call printf ("mstar = %g\n")
+		    call pargr (ST_MSTAR(st))
+	    } else {
+		ST_MSTAR(st) = rval
+		newlum = YES
+	    }
+
+	case STCMD_MINMAG:
+	    call gargr (rval)
+	    if (nscan() == 1) {
+		call printf ("minmag = %g\n")
+		    call pargr (ST_MINMAG(st))
+	    } else {
+		ST_MINMAG(st) = rval
+		newlum = YES
+	    }
+
+	case STCMD_MAXMAG:
+	    call gargr (rval)
+	    if (nscan() == 1) {
+		call printf ("maxmag = %g\n")
+		    call pargr (ST_MAXMAG(st))
+	    } else {
+		ST_MAXMAG(st) = rval
+		newlum = YES
+	    }
+
+	case STCMD_LFILE:
+	    call gargwrd (Memc[cmd], SZ_LINE)
+	    if (Memc[cmd] == EOS || streq (Memc[cmd], ST_LFILE(st))) {
+		call printf ("lfile: %s\n")
+		    call pargstr (ST_LFILE(st))
+	    } else {
+		if (lf != NULL) {
+		    call close (lf)
+		    lf = NULL
+		}
+		iferr {
+		    lf = open (Memc[cmd], READ_ONLY, TEXT_FILE)
+		} then {
+		    lf = NULL
+		    call erract (EA_WARN)
+		    call strcpy ("", ST_LFILE(st), SZ_FNAME)
+		    call printf (
+		        "Luminosity function file is undefined.\n")
+		} else {
+		    call strcpy (Memc[cmd], ST_LFILE(st), SZ_FNAME)
+		    newlum = YES
+		}
+	    }
+
+
+	case STCMD_EGALMIX:
+	    call gargr (rval)
+	    if (nscan() == 1) {
+		call printf ("egalmix = %g\n")
+		    call pargr (ST_EGALMIX(st))
+	    } else {
+		ST_EGALMIX(st) = rval
+		newmix = YES
+	    }
+
+	case STCMD_ERADIUS:
+	    call gargr (rval)
+	    if (nscan() == 1) {
+		call printf ("eradius = %g\n")
+		    call pargr (ST_ERADIUS(st))
+	    } else {
+		ST_ERADIUS(st) = rval
+		newaxis = YES
+	    }
+
+	case STCMD_SRADIUS:
+	    call gargr (rval)
+	    if (nscan() == 1) {
+		call printf ("sradius = %g\n")
+		    call pargr (ST_SRADIUS(st))
+	    } else {
+		ST_SRADIUS(st) = rval
+		newaxis = YES
+	    }
+
+	case STCMD_AR:
+	    call gargr (rval)
+	    if (nscan() == 1) {
+		call printf ("ar = %g\n")
+		    call pargr (ST_AR(st))
+	    } else {
+		ST_AR(st) = rval
+		newround = YES
+	    }
+
+	case STCMD_Z:
+	    call gargr (rval)
+	    if (nscan() == 1) {
+		call printf ("z = %g\n")
+		    call pargr (ST_Z(st))
+	    } else {
+		ST_Z(st) = rval
+		newaxis = YES
+	    }
+
+	case STCMD_ABSORPTION:
+	    call gargr (rval)
+	    if (nscan() == 1) {
+		call printf ("absorption = %g\n")
+		    call pargr (ST_ABSORPTION(st))
+	    } else {
+		ST_ABSORPTION(st) = rval
+		newround = YES
+	    }
+
+	case STCMD_NGALS:
+	    call gargi (ival)
+	    if (nscan() == 1) {
+		call printf ("ngals = %d\n")
+		    call pargi (ST_NSTARS(st))
+	    } else {
+		ST_NSTARS(st) = ival
+		newlum = YES
+		newspace = YES
+		newmix = YES
+		newaxis = YES
+		newround = YES
+		newphi = YES
+	    }
+
+	case STCMD_NSSAMPLE:
+	    call gargi (ival)
+	    if (nscan() == 1) {
+		call printf ("nssample = %d\n")
+		    call pargi (ST_NSSAMPLE(st))
+	    } else {
+		ST_NSSAMPLE(st) = ival
+		newspace = YES
+	    }
+
+	case STCMD_SORDER:
+	    call gargl (lval)
+	    if (nscan() == 1) {
+		call printf ("sorder = %d\n")
+		    call pargl (ST_SORDER(st))
+	    } else {
+		ST_SORDER(st) = lval
+		newspace = YES
+	    }
+
+	case STCMD_SSEED:
+	    call gargl (lval)
+	    if (nscan() == 1) {
+		call printf ("sseed = %d\n")
+		    call pargl (ST_SSEED(st))
+	    } else {
+		ST_SSEED(st) = lval
+		newspace = YES
+	    }
+
+	case STCMD_NLSAMPLE:
+	    call gargi (ival)
+	    if (nscan() == 1) {
+		call printf ("nlsample = %d\n")
+		    call pargi (ST_NLSAMPLE(st))
+	    } else {
+		ST_NLSAMPLE(st) = ival
+		newlum = YES
+	    }
+
+	case STCMD_LORDER:
+	    call gargl (lval)
+	    if (nscan() == 1) {
+		call printf ("lorder = %d\n")
+		    call pargl (ST_LORDER(st))
+	    } else {
+		ST_LORDER(st) = lval
+		newlum = YES
+	    }
+
+	case STCMD_LSEED:
+	    call gargl (lval)
+	    if (nscan() == 1) {
+		call printf ("lseed = %d\n")
+		    call pargl (ST_LSEED(st))
+	    } else {
+		ST_LSEED(st) = lval
+		newlum = YES
+	    }
+
+	case STCMD_RBINSIZE:
+	    call gargr (rval)
+	    if (nscan() == 1) {
+		call printf ("rbinsize = %g\n")
+		    call pargr (ST_RBINSIZE(st))
+	    } else {
+		ST_RBINSIZE(st) = rval
+		newplot = YES
+	    }
+
+	case STCMD_MBINSIZE:
+	    call gargr (rval)
+	    if (nscan() == 1) {
+		call printf ("mbinsize = %g\n")
+		    call pargr (ST_MBINSIZE(st))
+	    } else {
+		ST_MBINSIZE(st) = rval
+		newplot = YES
+	    }
+
+	case STCMD_DBINSIZE:
+	    call gargr (rval)
+	    if (nscan() == 1) {
+		call printf ("dbinsize = %g\n")
+		    call pargr (ST_DBINSIZE(st))
+	    } else {
+		ST_DBINSIZE(st) = rval
+		newplot = YES
+	    }
+
+	case STCMD_EBINSIZE:
+	    call gargr (rval)
+	    if (nscan() == 1) {
+		call printf ("ebinsize = %g\n")
+		    call pargr (ST_EBINSIZE(st))
+	    } else {
+		ST_EBINSIZE(st) = rval
+		newplot = YES
+	    }
+
+	case STCMD_PBINSIZE:
+	    call gargr (rval)
+	    if (nscan() == 1) {
+		call printf ("pbinsize = %g\n")
+		    call pargr (ST_PBINSIZE(st))
+	    } else {
+		ST_PBINSIZE(st) = rval
+		newplot = YES
+	    }
+
+	default:
+	    call printf ("\7\n")
+	}
+
+	call sfree (sp)
+end
diff --git a/noao/artdata/lists/stdbio.x b/noao/artdata/lists/stdbio.x
new file mode 100644
index 00000000..1ec411b8
--- /dev/null
+++ b/noao/artdata/lists/stdbio.x
@@ -0,0 +1,350 @@
+include <pkg/dttext.h>
+include "starlist.h"
+
+# ST_DTINIT -- Write the header to the database.
+
+procedure st_dtinit (dt, st, starlist, sseed, lseed)
+
+pointer	dt				# pointer to output database
+pointer	st				# pointer to structure
+char	starlist[ARB]			# name of output text file
+long	sseed				# spatial function seed
+long	lseed				# luminsosity function seed
+
+begin
+	call dtptime (dt)
+	call dtput (dt, "# begin\t%s\n")
+	    call pargstr (starlist)
+
+	# Write out the spatial density function parameters.
+	call dtput (dt, "#\tspatial\t\t%s\n")
+	switch (ST_SPATIAL(st)) {
+	case ST_UNIFORM:
+	    call pargstr ("uniform")
+	case ST_HUBBLE:
+	    call pargstr ("hubble")
+	    call dtput (dt, "#\txcenter\t\t%g\n")
+		call pargr (ST_XC(st))
+	    call dtput (dt, "#\tycenter\t\t%g\n")
+		call pargr (ST_YC(st))
+	    call dtput (dt, "#\tcoreradius\t%g\n")
+		call pargr (ST_CORE(st))
+	    call dtput (dt, "#\tbaseline\t%g\n")
+		call pargr (ST_BASE(st))
+	case ST_SPFILE:
+	    call pargstr (ST_SFILE(st))
+	    call dtput (dt, "#\txcenter\t\t%g\n")
+		call pargr (ST_XC(st))
+	    call dtput (dt, "#\tycenter\t\t%g\n")
+		call pargr (ST_YC(st))
+	}
+	call dtput (dt, "#\txmin\t\t%g\n")
+	    call pargr (ST_XMIN(st))
+	call dtput (dt, "#\txmax\t\t%g\n")
+	    call pargr (ST_XMAX(st))
+	call dtput (dt, "#\tymin\t\t%g\n")
+	    call pargr (ST_YMIN(st))
+	call dtput (dt, "#\tymax\t\t%g\n")
+	    call pargr (ST_YMAX(st))
+
+	# Write out the luminsosity function parameters.
+	call dtput (dt, "#\tluminosity\t%s\n")
+	switch (ST_LUMINOSITY(st)) {
+	case ST_UNIFORM:
+	    call pargstr ("uniform")
+	case ST_POWLAW:
+	    call pargstr ("powlaw")
+	    call dtput (dt, "#\tpower\t\t%g\n")
+	        call pargr (ST_POWER(st))
+	case ST_SALPETER:
+	    call pargstr ("salpeter")
+	    call dtput (dt, "#\tmzero\t\t%g\n")
+	        call pargr (ST_MZERO(st))
+	case ST_BANDS:
+	    call pargstr ("bands")
+	    call dtput (dt, "#\tmzero\t\t%g\n")
+	        call pargr (ST_MZERO(st))
+	    call dtput (dt, "#\talpha\t\t%g\n")
+	        call pargr (ST_ALPHA(st))
+	    call dtput (dt, "#\tbeta\t\t%g\n")
+	        call pargr (ST_BETA(st))
+	    call dtput (dt, "#\tdelta\t\t%g\n")
+	        call pargr (ST_DELTA(st))
+	    call dtput (dt, "#\tmstar\t\t%g\n")
+	        call pargr (ST_MSTAR(st))
+	case ST_LFFILE:
+	    call pargstr (ST_LFILE(st))
+	}
+	call dtput (dt, "#\tminmag\t\t%g\n")
+	    call pargr (ST_MINMAG(st))
+	call dtput (dt, "#\tmaxmag\t\t%g\n")
+	    call pargr (ST_MAXMAG(st))
+
+	# Save the spatial density function fitting parameters.
+	call dtput (dt, "#\tnssample\t%d\n")
+	    call pargi (ST_NSSAMPLE(st))
+	call dtput (dt, "#\tsorder\t\t%d\n")
+	    call pargi (ST_SORDER(st))
+	call dtput (dt, "#\tsseed\t\t%d\n")
+	    call pargl (sseed)
+
+	# Save the luminosity function fitting parameters.
+	call dtput (dt, "#\tnlsample\t%d\n")
+	    call pargi (ST_NLSAMPLE(st))
+	call dtput (dt, "#\tlorder\t\t%d\n")
+	    call pargi (ST_LORDER(st))
+	call dtput (dt, "#\tlseed\t\t%d\n")
+	    call pargl (lseed)
+
+	# Save the number of stars.
+	call dtput (dt, "#\tnstars\t\t%d\n")
+	    call pargi (ST_NSTARS(st))
+end
+
+
+# ST_DTGINIT -- Write the GALLIST header to the database.
+
+procedure st_dtginit (dt, st, galaxies, sseed, lseed)
+
+pointer	dt				# pointer to database
+pointer	st				# pointer to starlist structure
+char	galaxies[ARB]			# name of output text file
+long	sseed				# spatial function seed
+long	lseed				# luminsosity function seed
+
+begin
+	call dtptime (dt)
+	call dtput (dt, "# begin\t%s\n")
+	    call pargstr (galaxies)
+
+	# Save the spatial distribution function parameters.
+	call dtput (dt, "#\tspatial\t\t%s\n")
+	switch (ST_SPATIAL(st)) {
+	case ST_UNIFORM:
+	    call pargstr ("uniform")
+	case ST_HUBBLE:
+	    call pargstr ("hubble")
+	    call dtput (dt, "#\txcenter\t\t%g\n")
+		call pargr (ST_XC(st))
+	    call dtput (dt, "#\tycenter\t\t%g\n")
+		call pargr (ST_YC(st))
+	    call dtput (dt, "#\tcoreradius\t%g\n")
+		call pargr (ST_CORE(st))
+	    call dtput (dt, "#\tbaseline\t%g\n")
+		call pargr (ST_BASE(st))
+	case ST_SPFILE:
+	    call pargstr (ST_SFILE(st))
+	    call dtput (dt, "#\txcenter\t\t%g\n")
+		call pargr (ST_XC(st))
+	    call dtput (dt, "#\tycenter\t\t%g\n")
+		call pargr (ST_YC(st))
+	}
+	call dtput (dt, "#\txmin\t\t%g\n")
+	    call pargr (ST_XMIN(st))
+	call dtput (dt, "#\txmax\t\t%g\n")
+	    call pargr (ST_XMAX(st))
+	call dtput (dt, "#\tymin\t\t%g\n")
+	    call pargr (ST_YMIN(st))
+	call dtput (dt, "#\tymax\t\t%g\n")
+	    call pargr (ST_YMAX(st))
+
+	# Save the luminsosity function parameters.
+	call dtput (dt, "#\tluminosity\t%s\n")
+	switch (ST_LUMINOSITY(st)) {
+	case ST_UNIFORM:
+	    call pargstr ("uniform")
+	case ST_POWLAW:
+	    call pargstr ("powlaw")
+	    call dtput (dt, "#\tpower\t\t%g\n")
+		call pargr (ST_POWER(st))
+	case ST_SCHECTER:
+	    call pargstr ("shechter")
+	    call dtput (dt, "#\tmzero\t\t%g\n")
+	        call pargr (ST_MZERO(st))
+	    call dtput (dt, "#\talpha\t\t%g\n")
+		call pargr (ST_ALPHA(st))
+	    call dtput (dt, "#\tmstar\t\t%g\n")
+		call pargr (ST_MSTAR(st))
+	case ST_LFFILE:
+	    call pargstr (ST_LFILE(st))
+	}
+	call dtput (dt, "#\tminmag\t\t%g\n")
+	    call pargr (ST_MINMAG(st))
+	call dtput (dt, "#\tmaxmag\t\t%g\n")
+	    call pargr (ST_MAXMAG(st))
+	call dtput (dt, "#\teradius\t\t%g\n")
+	    call pargr (ST_ERADIUS(st))
+	call dtput (dt, "#\tsradius\t\t%g\n")
+	    call pargr (ST_SRADIUS(st))
+
+	call dtput (dt, "#\tegalmix\t\t%g\n")
+	    call pargr (ST_EGALMIX(st))
+	call dtput (dt, "#\tar\t\t%g\n")
+	    call pargr (ST_AR(st))
+	call dtput (dt, "#\tabsorption\t%g\n")
+	    call pargr (ST_ABSORPTION(st))
+	call dtput (dt, "#\tz\t\t%g\n")
+	    call pargr (ST_Z(st))
+
+	# Save the spatial distribution fitting parameters.
+	call dtput (dt, "#\tnssample\t%d\n")
+	    call pargi (ST_NSSAMPLE(st))
+	call dtput (dt, "#\tsorder\t\t%d\n")
+	    call pargi (ST_SORDER(st))
+	call dtput (dt, "#\tsseed\t\t%d\n")
+	    call pargl (sseed)
+
+	# Save the spatial function fitting parameters.
+	call dtput (dt, "#\tnlsample\t%d\n")
+	    call pargi (ST_NLSAMPLE(st))
+	call dtput (dt, "#\tlorder\t\t%d\n")
+	    call pargi (ST_LORDER(st))
+	call dtput (dt, "#\tlseed\t\t%d\n")
+	    call pargl (lseed)
+
+	# Save the number of stars.
+	call dtput (dt, "#\tngals\t\t%d\n")
+	    call pargi (ST_NSTARS(st))
+end
+
+
+# ST_DTWRITE -- Write the starlist to the database.
+
+procedure st_dtwrite (dt, x, y, mag, nstars)
+
+pointer	dt		# pointer to the output database
+real	x[ARB]		# array of x coordinates
+real	y[ARB]		# array of y coordinates
+real	mag[ARB]	# array of magnitude values
+int	nstars		# number of stars
+
+int	i, j
+pointer	sp, index
+
+begin
+	call smark (sp)
+	call salloc (index, nstars, TY_INT)
+	call st_qsort (y, Memi[index], Memi[index], nstars)
+
+	do i = 1, nstars {
+	    j = Memi[index+i-1]
+	    call dtput (dt, "\t%8.3f  %8.3f  %7.3f\n")
+		call pargr (x[j])
+		call pargr (y[j])
+		call pargr (mag[j])
+	}
+
+	call sfree (sp)
+end
+
+
+# ST_DTGWRITE -- Procedure to write the galaxy list to the database
+
+procedure st_dtgwrite (dt, x, y, mag, egal, axis, round, phi, nstars)
+
+pointer	dt		# pointer to database
+real	x[ARB]		# x values
+real	y[ARB]		# y values
+real	mag[ARB]	# magnitude values
+int	egal[ARB]	# galaxy types
+real	axis[ARB]	# galaxy diameters
+real	round[ARB]	# galaxy roundness
+real	phi[ARB]	# galaxy position angles
+int	nstars		# number of stars
+
+int	i, j
+pointer	sp, index
+
+begin
+	call smark (sp)
+	call salloc (index, nstars, TY_INT)
+	call st_qsort (y, Memi[index], Memi[index], nstars)
+
+	do i = 1, nstars {
+	    j = Memi[index+i-1]
+	    call dtput (dt,
+	        "\t%8.3f  %8.3f  %7.3f  %7s  %7.2f  %5.3f  %5.1f\n")
+		call pargr (x[j])
+		call pargr (y[j])
+		call pargr (mag[j])
+		if (egal[j] == ST_DEVAUC)
+		    call pargstr ("devauc")
+		else
+		    call pargstr ("expdisk")
+		call pargr (axis[j])
+		call pargr (round[j])
+		call pargr (phi[j])
+	}
+
+	call sfree (sp)
+end
+
+
+# ST_QSORT -- Vector Quicksort. In this version the index array is
+# sorted.
+
+define	LOGPTR		20			# log2(maxpts) (1e6)
+
+procedure st_qsort (data, a, b, npix)
+
+real	data[ARB]		# data array
+int	a[ARB], b[ARB]		# index array
+int	npix			# number of pixels
+
+int	i, j, lv[LOGPTR], p, uv[LOGPTR], temp
+real	pivot
+
+begin
+	# Initialize the indices for an inplace sort.
+	do i = 1, npix
+	    a[i] = i
+	call amovi (a, b, npix)
+
+	# Initialize.
+	p = 1
+	lv[1] = 1
+	uv[1] = npix
+
+	# Sort.
+	while (p > 0) {
+
+	    # If only one elem in subset pop stack otherwise pivot line.
+	    if (lv[p] >= uv[p])
+		p = p - 1
+	    else {
+		i = lv[p] - 1
+		j = uv[p]
+		pivot = data[b[j]]
+
+		while (i < j) {
+		    for (i=i+1;  data[b[i]] < pivot;  i=i+1)
+			;
+		    for (j=j-1;  j > i;  j=j-1)
+			if (data[b[j]] <= pivot)
+			    break
+		    if (i < j) {		# Out of order pair
+			temp = b[j]		# Interchange elements
+			b[j] = b[i]
+			b[i] = temp
+		    }
+		}
+
+		j = uv[p]			# Move pivot to position i
+		temp = b[j]			# Interchange elements
+		b[j] = b[i]
+		b[i] = temp
+
+		if (i-lv[p] < uv[p] - i) {	# Stack so shorter done first
+		    lv[p+1] = lv[p]
+		    uv[p+1] = i - 1
+		    lv[p] = i + 1
+		} else {
+		    lv[p+1] = i + 1
+		    uv[p+1] = uv[p]
+		    uv[p] = i - 1
+		}
+
+		p = p + 1			# Push onto stack
+	    }
+	}
+end
diff --git a/noao/artdata/lists/stlum.x b/noao/artdata/lists/stlum.x
new file mode 100644
index 00000000..0abe9e1e
--- /dev/null
+++ b/noao/artdata/lists/stlum.x
@@ -0,0 +1,342 @@
+include <mach.h>
+include <math.h>
+include <math/curfit.h>
+include <math/iminterp.h>
+
+
+# ST_MAGUNIFORM -- Compute a set of magnitude values which are uniformly
+# distributed between minmag and maxmag.
+
+procedure st_maguniform (mag, nstars, minmag, maxmag, seed)
+
+real	mag[ARB]	# output array of magnitudes
+int	nstars		# number of stars
+real	minmag, maxmag	# minimum and maximum magnitude values
+long	seed		# seed for random number generator
+
+int	i
+real	urand()
+
+begin
+	# Get values between 0 and 1.
+	do i = 1, nstars
+	    mag[i] = urand (seed)
+
+	# Map values into data range.
+	call amapr (mag, mag, nstars, 0.0, 1.0, minmag, maxmag)
+end
+
+
+# ST_POWER -- Compute a set of magnitude values which are power law
+# distributed between minmag and maxmag.
+
+procedure st_power (mag, nstars, power, minmag, maxmag, seed)
+
+real	mag[ARB]	# output array of magnitudes
+int	nstars		# number of stars
+real	power		# power law exponent
+real	minmag, maxmag	# minimum and maximum magnitude values
+long	seed		# seed for random number generator
+
+int	i
+real	a, urand()
+
+begin
+	# Get values between 0 and 1.
+	a = 10. ** (power * (maxmag - minmag)) - 1
+	do i = 1, nstars
+	    mag[i] = minmag + log10 (a * urand (seed) + 1) / power
+end
+
+
+define	MIN_BANDS	-6.
+define	MAX_BANDS	19.
+define	MID_BANDS	15.
+
+# ST_BANDS -- Compute the Bahcall and Soneira luminosity function.
+
+procedure st_bands (mag, nstars, alpha, beta, delta, mstar, minmag, maxmag,
+	mzero, nsample, order, seed)
+
+real	mag[ARB]		# array of output magnitudes
+int	nstars			# number of stars
+real	alpha, beta		# Bahcall and Soneira parameters
+real	delta, mstar		# Bahcall and Soneira parameters
+real	minmag, maxmag		# minimum and maximum magnitude values
+real	mzero			# zero point between relative and absolute mags.
+int	nsample			# number of points in sampling function
+int	order			# order of the spline fit
+long	seed			# value of the seed
+
+int	i, ier
+pointer	sp, m, iprob, w, cv, asi
+real	dmag, magval, mtemp, temp1, temp2, imin, imax
+real	cveval(), asigrl(), urand()
+
+begin
+	# Allocate temporary space.
+	call smark (sp)
+	call salloc (m, nsample, TY_REAL)
+	call salloc (iprob, nsample, TY_REAL)
+	call salloc (w, nsample, TY_REAL)
+
+	# Compute the probability function.
+	magval = max (minmag - mzero, MIN_BANDS)
+	dmag = (min (maxmag - mzero, MAX_BANDS) - magval) / (nsample - 1)
+	do i = 1, nsample {
+	    Memr[m+i-1] = magval
+	    if (magval > MID_BANDS)
+		mtemp = MID_BANDS
+	    else
+	        mtemp = magval - mstar
+	    temp1 = 10.0 ** (beta * mtemp)
+	    temp2 = (1.0 + 10.0 ** ((beta - alpha) * delta * mtemp)) **
+	            (1.0 / delta)
+	    Memr[iprob+i-1] = temp1 / temp2
+	    magval = magval + dmag
+	}
+
+	# Integrate the probablity function.
+	call asiinit (asi, II_SPLINE3)
+	call asifit (asi, Memr[iprob], nsample)
+	Memr[iprob] = 0.0
+	do i = 2, nsample
+	    Memr[iprob+i-1] = Memr[iprob+i-2] + asigrl (asi, real (i-1),
+	        real (i))
+	call alimr (Memr[iprob], nsample, imin, imax)
+	call amapr (Memr[iprob], Memr[iprob], nsample, imin, imax, 0.0, 1.0)
+	call asifree (asi)
+
+	# Fit the inverse of the integral of the probability function.
+	call cvinit (cv, SPLINE3, order, 0.0, 1.0)
+	call cvfit (cv, Memr[iprob], Memr[m], Memr[w], nsample, WTS_UNIFORM,
+	    ier)
+
+	# Compute the magnitudes.
+	if (ier == OK) {
+	    do i = 1, nstars
+	        mag[i] = cveval (cv, urand (seed)) + mzero
+	} else {
+	    call printf ("Error computing the bands luminosity function.\n")
+	    call amovkr ((minmag + maxmag) / 2.0, mag, nstars)
+	}
+	call cvfree (cv)
+
+	# Free space.
+	call sfree (sp)
+end
+
+
+define	MIN_SALPETER	-4.0
+define	MAX_SALPETER	16.0
+
+# ST_SALPETER  -- Compute the Salpter luminosity function.
+
+procedure st_salpeter (mag, nstars, minmag, maxmag, mzero, nsample, order, seed)
+
+real	mag[ARB]		# array of output magnitudes
+int	nstars			# number of stars
+real	minmag, maxmag		# minimum and maximum magnitude values
+real	mzero			# zero point between relative and absolute mags.
+int	nsample			# number of points in sampling function
+int	order			# order of the spline fit
+long	seed			# value of the seed
+
+int	i, ier
+pointer	sp, m, iprob, w, cv, asi
+real	dmag, magval, imin, imax
+real	cveval(), asigrl(), urand()
+
+begin
+	# Allocate temporary space.
+	call smark (sp)
+	call salloc (m, nsample, TY_REAL)
+	call salloc (iprob, nsample, TY_REAL)
+	call salloc (w, nsample, TY_REAL)
+
+	# Compute the probability function.
+	magval = max (minmag - mzero, MIN_SALPETER)
+	dmag = (min (maxmag - mzero, MAX_SALPETER) - magval) / (nsample - 1)
+	do i = 1, nsample {
+	    Memr[m+i-1] = magval
+	    Memr[iprob+i-1] = 10.0 ** (-3.158375 + 1.550629e-1 * magval -
+	        5.19388e-3 * magval ** 2)
+	    magval = magval + dmag
+	}
+
+	# Integrate the probablity function.
+	call asiinit (asi, II_SPLINE3)
+	call asifit (asi, Memr[iprob], nsample)
+	Memr[iprob] = 0.0
+	do i = 2, nsample
+	    Memr[iprob+i-1] = Memr[iprob+i-2] + asigrl (asi, real (i-1),
+	        real (i))
+	call alimr (Memr[iprob], nsample, imin, imax)
+	call amapr (Memr[iprob], Memr[iprob], nsample, imin, imax, 0.0, 1.0)
+	call asifree (asi)
+
+	# Fit the inverse of the integral of the probability function.
+	call cvinit (cv, SPLINE3, order, 0.0, 1.0)
+	call cvfit (cv, Memr[iprob], Memr[m], Memr[w], nsample, WTS_UNIFORM,
+	    ier)
+
+	# Compute the magnitudes.
+	if (ier == OK) {
+	    do i = 1, nstars
+	        mag[i] = cveval (cv, urand (seed)) + mzero
+	} else {
+	    call printf ("Error computing the Salpeter luminosity function.\n")
+	    call amovkr ((minmag + maxmag) / 2.0, mag, nstars)
+	}
+	call cvfree (cv)
+
+	# Free space.
+	call sfree (sp)
+end
+
+
+# ST_SCHECTER -- Compute the Schecter luminosity function.
+
+procedure st_schecter (mag, nstars, alpha, mstar, minmag, maxmag, mzero,
+	nsample, order, seed)
+
+real	mag[ARB]		# array of output magnitudes
+int	nstars			# number of stars
+real	alpha, mstar		# Schecter luminosity function parameters
+real	minmag, maxmag		# minimum and maximum magnitude values
+real	mzero			# zero point between relative and absolute mags.
+int	nsample			# number of points in the sampling function
+int	order			# order of the spline fit
+long	seed			# value of the seed
+
+int	i, ier
+pointer	sp, m, iprob, w, cv, asi
+real	dmag, magval, temp, imin, imax
+real	cveval(), asigrl(), urand()
+
+begin
+	# Allocate space for fitting.
+	call smark (sp)
+	call salloc (m, nsample, TY_REAL)
+	call salloc (iprob, nsample, TY_REAL)
+	call salloc (w, nsample, TY_REAL)
+
+	# Sample the luminosity function.
+	magval = minmag - mzero
+	dmag = (maxmag - minmag) / (nsample - 1)
+	do i = 1, nsample {
+	    Memr[m+i-1] = magval
+	    temp = 0.4 * (mstar - magval)
+	    Memr[iprob+i-1] = 10.0 ** ((alpha + 1) * temp) *
+	        exp (- 10.0 ** temp)
+	    magval = magval + dmag
+	}
+
+	# Integrate the sampling function.
+	call asiinit (asi, II_SPLINE3)
+	call asifit (asi, Memr[iprob], nsample)
+	Memr[iprob] = 0.0
+	do i = 2, nsample
+	    Memr[iprob+i-1] = Memr[iprob+i-2] + asigrl (asi, real (i-1),
+	        real(i))
+	call alimr (Memr[iprob],nsample, imin, imax)
+	call amapr (Memr[iprob], Memr[iprob], nsample, imin, imax, 0.0, 1.0)
+	call asifree (asi)
+
+	# Fit the inverse of the integral of the probability function.
+	call cvinit (cv, SPLINE3, order, 0.0, 1.0)
+	call cvfit (cv, Memr[iprob], Memr[m], Memr[w], nsample, WTS_UNIFORM,
+	    ier)
+	if (ier == OK) {
+	    do i = 1, nstars
+	        mag[i] = cveval (cv, urand (seed)) + mzero
+	} else {
+	    call printf ("Error fitting the Schecter luminosity function.\n")
+	    call amovkr ((minmag + maxmag) / 2.0, mag, nstars)
+	}
+	call cvfree (cv)
+
+	# Free space.
+	call sfree (sp)
+end
+
+
+# ST_LFSAMPLE -- Compute the luminosity function using a user supplied
+# function.
+
+procedure st_lfsample (smag, mprob, nlf, mag, nstars, minmag, maxmag, nsample,
+	order, seed)
+
+real	smag[ARB]		# input array of magnitudes
+real	mprob[ARB]		# input array of relative probabilities
+int	nlf			# number of input points
+real	mag[ARB]		# output magnitude array
+int	nstars			# number of stars
+real	minmag, maxmag		# minimum and maximum magnitude values
+int	nsample			# number of sample points
+int	order			# order of the spline fit
+long	seed			# value of the seed
+
+int	npts, i, ier
+pointer	sp, m, w, iprob, cv, asi
+real	mval, dm, sfmin, sfmax, imin, imax
+real	cveval(), asigrl(), urand()
+
+begin
+	# Allocate space for fitting.
+	npts = max (nlf, nsample)
+	call smark (sp)
+	call salloc (m, nsample, TY_REAL)
+	call salloc (iprob, nsample, TY_REAL)
+	call salloc (w, npts, TY_REAL)
+
+	# Smooth the relative probability function.
+	call alimr (smag, nlf, sfmin, sfmax)
+	call cvinit (cv, SPLINE3, max (1, nlf / 4), sfmin, sfmax)
+	call cvfit (cv, smag, mprob, Memr[w], nlf, WTS_UNIFORM, ier) 
+
+	# Evaluate the smoothed function at equal intervals in r.
+	if (ier == OK) {
+	    mval = max (minmag, sfmin)
+	    dm = (min (maxmag, sfmax) - mval) / (nsample - 1)
+	    do i = 1, nsample {
+		Memr[m+i-1] = mval
+	        Memr[iprob+i-1] = cveval (cv, mval)
+	        mval = mval + dm
+	    }
+	    call cvfree (cv)
+	} else {
+	    call printf ("Error smoothing user luminosity function.\n")
+	    call amovkr ((minmag + maxmag) / 2.0, mag, nstars)
+	    call cvfree (cv)
+	    call sfree (sp)
+	}
+
+	# Evaluate the integral.
+	call asiinit (asi, II_SPLINE3)
+	call asifit (asi, Memr[iprob], nsample)
+	Memr[iprob] = 0.0
+	do i = 2, nsample
+	    Memr[iprob+i-1] = Memr[iprob+i-2] + asigrl (asi, real(i-1), real(i))
+	call alimr (Memr[iprob], nsample, imin, imax)
+	call amapr (Memr[iprob], Memr[iprob], nsample, imin, imax, 0.0, 1.0)
+	call asifree (asi)
+
+	# Fit the inverse of the integral of the probability function.
+	call cvinit (cv, SPLINE3, order, 0.0, 1.0)
+	call cvfit (cv, Memr[iprob], Memr[m], Memr[w], nsample, WTS_UNIFORM,
+	    ier)
+
+	# Sample the computed function.
+	if (ier == OK) {
+	    do i = 1, nstars
+	        mag[i] = cveval (cv, urand (seed))
+	} else {
+	    call printf ("Error computing the user luminosity function.\n")
+	    call amovkr ((minmag + maxmag) / 2.0, mag, nstars)
+	}
+	call cvfree (cv)
+
+	# Free space.
+	call sfree (sp)
+end
diff --git a/noao/artdata/lists/stmix.x b/noao/artdata/lists/stmix.x
new file mode 100644
index 00000000..4254e8eb
--- /dev/null
+++ b/noao/artdata/lists/stmix.x
@@ -0,0 +1,144 @@
+include	<math.h>
+include "starlist.h"
+
+# ST_ESMIX -- Compute the percentage of elliptical galaxies.
+
+procedure st_esmix (egal, nstar, esmix, seed)
+
+int	egal[ARB]		# array of types
+int	nstar			# number of objects
+real	esmix			# fraction of elliptical galaxies
+long	seed			# seed for random number generator
+
+int	i
+real	fraction
+real	urand()
+
+begin
+	do i = 1, nstar {
+	    fraction = urand (seed)
+	    if (fraction <= esmix)
+	        egal[i] = ST_DEVAUC
+	    else
+	        egal[i] = ST_EXP
+	}
+end
+
+
+# ST_ROUND -- Compute an array of roundness parameters.
+# For ellipical models use a uniform distribution of axial ratios.
+# For spiral models use a uniform inclination distribution.  Compute
+# the axial ratio with a .1 flatness parameter from Holmberg (Stars
+# and Stellar Systems).  Then add cosecant absorption factor to the
+# the magnitudes with a limit of 10 in the cosecant.
+
+procedure st_round (egal, mag, round, nstars, ar, alpha, seed)
+
+int	egal[ARB]		# array of galaxy types
+real	mag[ARB]		# magnitudes
+real	round[ARB]		# array of roundness values
+int	nstars			# number of stars
+real	ar			# minimum roundness value
+real	alpha			# absorption coefficent
+long	seed			# seed for the random number generator
+
+int	i
+real	dr, s, urand()
+
+begin
+	dr = (1. - ar)
+	do i = 1, nstars {
+	    if (egal[i] == ST_DEVAUC)
+	        round[i] = ar + dr * urand (seed)
+	    else {
+		s = sin (HALFPI * urand (seed))
+		round[i] = sqrt (s**2 * .99 + .01)
+		mag[i] = mag[i] + alpha * (1 / max (0.1, s) - 1) / 9.
+	    }
+	}
+
+end
+
+
+# ST_PHI -- Compute an array of position angles.
+
+procedure st_phi (phi, nstars, seed)
+
+real	phi[ARB]		# array of position angles
+int	nstars			# number of stars
+long	seed			# seed for random number generator
+
+int	i
+real	urand()
+
+begin
+	do i = 1, nstars
+	    phi[i] = urand (seed)
+	call amapr (phi, phi, nstars, 0.0, 1.0, 0.0, 360.0)
+end
+
+
+# ST_DIAMETERS -- Compute the effective diameters of the galaxies based
+# on their magnitudes.  The relation used is from Holmberg (Stars and
+# Stellar Systems).  A uniform dispersion of 20% is added.
+
+procedure st_diameters (mag, egal, axis, nstars, minmag, maxmag, eradius,
+	sradius, seed)
+
+real	mag[ARB]		# input array of magnitudes
+int	egal[ARB]		# array of galaxy types
+real	axis[ARB]		# output array of diameters
+int	nstars			# number of stars
+real	minmag			# minimum magnitude
+real	maxmag			# maximum magnitude
+real	eradius			# maximum elliptical radius
+real	sradius			# maximum spiral radius
+long	seed			# seed for random number generator
+
+int	i
+real	urand()
+
+begin
+	do i = 1, nstars {
+	    if (egal[i] == ST_DEVAUC)
+	        axis[i] = eradius * 10.0 ** ((minmag - mag[i]) / 6.)
+	    else
+	        axis[i] = sradius * eradius * 10.0 ** ((minmag - mag[i]) / 6.)
+	    axis[i] = axis[i] * (0.8 + 0.4 * urand (seed))
+	}
+end
+
+
+# ST_ZDIAMETERS -- Compute the effective diameters of the galaxies based
+# on their magnitudes and redshift. The relation used is that the redshift
+# is proportional to the luminousity and the diameters include the
+# factor of (1+z)**2.  A uniform dispersion of 50% is added.
+
+procedure st_zdiameters (mag, egal, axis, nstars, minmag, maxmag,
+	z, eradius, sradius, seed)
+
+real	mag[ARB]		# input array of magnitudes
+int	egal[ARB]		# array of galaxy types
+real	axis[ARB]		# output array of diameters
+int	nstars			# number of stars
+real	minmag			# minimum magnitude
+real	maxmag			# maximum magnitude
+real	z			# minumum redshift
+real	eradius			# maximum elliptical radius
+real	sradius			# maximum spiral radius
+long	seed			# seed for random number generator
+
+int	i
+real	z0, z1, urand()
+
+begin
+	z0 = z / (1 + z) ** 2
+	do i = 1, nstars {
+	    z1 = z * 10.0 ** (-0.2 * (minmag - mag[i]))
+	    if (egal[i] == ST_DEVAUC)
+	        axis[i] = eradius * z0 * (1 + z1) ** 2 / z1
+	    else
+	        axis[i] = sradius * eradius * z0 * (1 + z1) ** 2 / z1
+	    axis[i] = axis[i] * (0.5 + urand (seed))
+	}
+end
diff --git a/noao/artdata/lists/stplot.x b/noao/artdata/lists/stplot.x
new file mode 100644
index 00000000..2e79b6c1
--- /dev/null
+++ b/noao/artdata/lists/stplot.x
@@ -0,0 +1,1102 @@
+include <mach.h>
+include <math.h>
+include <gset.h>
+include <pkg/gtools.h>
+include "starlist.h"
+
+define	HELPFILE1  "artdata$lists/starlist.key"
+
+# ST_PLOTS -- Interactively examine the spatial density and luminosity
+# functions.
+
+procedure st_plots (sf, lf, gd, st, x, y, mag)
+
+int	sf			# spatial density file descriptor
+int	lf			# luminsosity function file descriptor
+pointer	gd			# graphics stream pointer
+pointer	st			# pointer to starlist structure
+pointer	x			# pointer to x array
+pointer	y			# pointer to y array
+pointer mag			# pointer to mag array
+
+int	wcs, key, plottype, newplot, newspace, newlum
+pointer	sp, cmd, gt1, gt2, gt3
+real	wx, wy
+int	gt_gcur()
+pointer	gt_init()
+
+begin
+	# Allocate temporary space.
+	call smark (sp)
+	call salloc (cmd, SZ_LINE, TY_CHAR)
+
+	# Intialize the plots.
+	gt1 = gt_init()
+	gt2 = gt_init()
+	gt3 = gt_init()
+
+	newspace = NO
+	newlum = NO
+	newplot = NO
+	plottype = 1
+
+	# Draw the first plot.
+	call st_pfield (gd, gt1, st, Memr[x], Memr[y], Memr[mag], ST_NSTARS(st))
+
+	while (gt_gcur ("cursor", wx, wy, wcs, key, Memc[cmd], SZ_LINE) !=
+	    EOF) {
+	    switch (key) {
+
+	    case '?':
+		call gpagefile (gd, HELPFILE1, "")
+
+	    case ':':
+		call st_colon (gd, st, sf, lf, Memc[cmd], newspace, newlum,
+		    newplot)
+		switch (plottype) {
+		case 1:
+		    call gt_colon (Memc[cmd], gd, gt1, newplot)
+		case 2:
+		    call gt_colon (Memc[cmd], gd, gt2, newplot)
+		case 3:
+		    call gt_colon (Memc[cmd], gd, gt3, newplot)
+		}
+
+	    case 'q':
+		break
+
+	    case 'f':
+
+		if (newspace == YES) {
+		    call st_mkspatial (sf, st, x, y, mag)
+		    newspace = NO
+		    newplot = YES
+		}
+
+		if (newlum == YES) {
+		    call st_mklum (lf, st, x, y, mag)
+		    newlum = NO
+		    newplot = YES
+		}
+
+		if (newplot == YES) {
+		    switch (plottype) {
+		    case 1:
+			call st_pfield (gd, gt1, st, Memr[x], Memr[y],
+			    Memr[mag], ST_NSTARS(st))
+		    case 2:
+		        call st_prhist (gd, gt2, st, Memr[x], Memr[y],
+		            ST_NSTARS(st))
+		    case 3:
+			call st_pmhist (gd, gt3, st, Memr[mag], ST_NSTARS(st))
+		    default:
+			call st_pfield (gd, gt1, st, Memr[x], Memr[y],
+			    Memr[mag], ST_NSTARS(st))
+		    }
+		    newplot = NO
+		}
+
+	    case 'x':
+		if (newspace == YES || newlum == YES)
+		    call printf ("Type the f key to remake the star list\n")
+		else if (plottype != 1 || newplot == YES) {
+		    call st_pfield (gd, gt1, st, Memr[x], Memr[y], Memr[mag],
+		        ST_NSTARS(st))
+		    plottype = 1
+		    newplot = NO
+		}
+
+	    case 'r':
+		if (newspace == YES)
+		    call printf ("Type the f key to remake the star list\n")
+		else if (plottype != 2 || newplot == YES) {
+		    call st_prhist (gd, gt2, st, Memr[x], Memr[y],
+		        ST_NSTARS(st))
+		    plottype = 2
+		    newplot = NO
+		}
+
+	    case 'm':
+		if (newlum == YES)
+		    call printf ("Type the f key to remake the star list\n")
+		else if (plottype != 3 || newplot == YES) {
+		    call st_pmhist (gd, gt3, st, Memr[mag], ST_NSTARS(st))
+		    plottype = 3
+		    newplot = NO
+		}
+
+	    default:
+	    }
+	}
+
+	# Recompute the results if necessary.
+	if (newspace == YES)
+	    call st_mkspatial (sf, st, x, y, mag)
+	if (newlum == YES)
+	    call st_mklum (lf, st, x, y, mag)
+
+	# Free space for the plots.
+	call gt_free (gt1)
+	call gt_free (gt2)
+	call gt_free (gt3)
+
+	call sfree (sp)
+end
+
+
+define	HELPFILE2  "artdata$lists/gallist.key"
+
+# ST_GPLOTS -- Fit the luminosity function and make plots.
+
+procedure st_gplots (sf, lf, gd, st, x, y, mag, egal, axis, round, phi)
+
+int	sf			# spatial distribution file descriptor
+int	lf			# luminsosity distribution file descriptor
+pointer	gd			# graphics stream pointer
+pointer	st			# pointer to starlist structure
+pointer	x			# pointer to x array
+pointer	y			# pointer to y array
+pointer mag			# pointer to mag array
+pointer	egal			# pointer to type array
+pointer axis			# pointer to the diameters array
+pointer	round			# pointer to the roundness array
+pointer	phi			# pointer to the position angle array
+
+int	wcs, key, plottype
+int	newplot, newspace, newlum, newmix, newaxis, newround, newphi
+pointer	sp, cmd, gt1, gt2, gt3, gt4, gt5, gt6
+real	wx, wy
+int	gt_gcur()
+pointer	gt_init()
+
+begin
+	call smark (sp)
+	call salloc (cmd, SZ_LINE, TY_CHAR)
+
+	# Intialize the plots.
+	gt1 = gt_init()
+	gt2 = gt_init()
+	gt3 = gt_init()
+	gt4 = gt_init()
+	gt5 = gt_init()
+	gt6 = gt_init()
+
+	newspace = NO
+	newlum = NO
+	newmix = NO
+	newaxis = NO
+	newround = NO
+	newplot = NO
+	newphi = NO
+	plottype = 1
+
+	# Draw the first plot.
+	call st_pgfield (gd, gt1, st, Memr[x], Memr[y], Memr[mag], Memi[egal],
+	    Memr[axis], Memr[round], ST_NSTARS(st))
+
+	while (gt_gcur ("cursor", wx, wy, wcs, key, Memc[cmd], SZ_LINE) !=
+	    EOF) {
+	    switch (key) {
+
+	    case '?':
+		call gpagefile (gd, HELPFILE2, "")
+
+	    case ':':
+		call st_gcolon (gd, st, sf, lf, Memc[cmd], newspace, newlum,
+		    newmix, newaxis, newround, newphi, newplot)
+		switch (plottype) {
+		case 1:
+		    call gt_colon (Memc[cmd], gd, gt1, newplot)
+		case 2:
+		    call gt_colon (Memc[cmd], gd, gt2, newplot)
+		case 3:
+		    call gt_colon (Memc[cmd], gd, gt3, newplot)
+		case 4:
+		    call gt_colon (Memc[cmd], gd, gt4, newplot)
+		case 5:
+		    call gt_colon (Memc[cmd], gd, gt5, newplot)
+		case 6:
+		    call gt_colon (Memc[cmd], gd, gt6, newplot)
+		}
+
+	    case 'q':
+		break
+
+	    case 'f':
+
+
+		if (newphi == YES) {
+		    call st_gmkphi (st, x, y, mag, egal, axis, round, phi)
+		    newphi = NO
+		    newplot = YES
+		}
+
+		if (newspace == YES) {
+		    call st_gmkspatial (sf, st, x, y, mag, egal, axis, round,
+			phi)
+		    newspace = NO
+		    newplot = YES
+		}
+
+		if (newmix == YES) {
+		    call st_gmkmix (st, x, y, mag, egal, axis, round, phi)
+		    newmix = NO
+		    newplot = YES
+		}
+
+		if (newlum == YES) {
+		    call st_gmklum (lf, st, x, y, mag, egal, axis, round, phi)
+		    call st_gmkround (st, x, y, mag, egal, axis, round, phi)
+		    call st_gmkaxis (st, x, y, mag, egal, axis, round, phi)
+		    newlum = NO
+		    newaxis = NO
+		    newround = NO
+		    newplot = YES
+		}
+
+		if (newround == YES) {
+		    call st_gmkround (st, x, y, mag, egal, axis, round, phi)
+		    newround = NO
+		    newplot = YES
+		}
+
+		if (newaxis == YES) {
+		    call st_gmkaxis (st, x, y, mag, egal, axis, round, phi)
+		    newaxis = NO
+		    newplot = YES
+		}
+
+		if (newplot == YES) {
+		    switch (plottype) {
+		    case 1:
+			call st_pgfield (gd, gt1, st, Memr[x], Memr[y],
+			    Memr[mag], Memi[egal], Memr[axis], Memr[round],
+			    ST_NSTARS(st))
+		    case 2:
+		        call st_prhist (gd, gt2, st, Memr[x], Memr[y],
+		            ST_NSTARS(st))
+		    case 3:
+			call st_pmhist (gd, gt3, st, Memr[mag], ST_NSTARS(st))
+		    case 4:
+			call st_pdhist (gd, gt4, st, Memr[axis], ST_NSTARS(st))
+		    case 5:
+			call st_pehist (gd, gt5, st, Memr[round], ST_NSTARS(st))
+		    case 6:
+			call st_pphist (gd, gt6, st, Memr[phi], ST_NSTARS(st))
+		    default:
+			call st_pgfield (gd, gt1, st, Memr[x], Memr[y],
+			    Memr[mag], Memi[egal], Memr[axis], Memr[round],
+			    ST_NSTARS(st))
+		    }
+		    newplot = NO
+		}
+
+	    case 'x':
+		if (newspace == YES || newlum == YES || newmix == YES ||
+		    newround == YES)
+		    call printf ("Type the f key to refit the galaxies list\n")
+		else if (plottype != 1 || newplot == YES) {
+		    call st_pgfield (gd, gt1, st, Memr[x], Memr[y], Memr[mag],
+		        Memi[egal], Memr[axis], Memr[round], ST_NSTARS(st))
+		    plottype = 1
+		    newplot = NO
+		}
+
+	    case 'r':
+		if (newspace == YES)
+		    call printf ("Type the f key to refit the galaxies list\n")
+		else if (plottype != 2 || newplot == YES) {
+		    call st_prhist (gd, gt2, st, Memr[x], Memr[y],
+		        ST_NSTARS(st))
+		    plottype = 2
+		    newplot = NO
+		}
+
+	    case 'm':
+		if (newlum == YES)
+		    call printf ("Type the f key to refit the galaxies list\n")
+		else if (plottype != 3 || newplot == YES) {
+		    call st_pmhist (gd, gt3, st, Memr[mag], ST_NSTARS(st))
+		    plottype = 3
+		    newplot = NO
+		}
+
+	    case 'd':
+		if (newlum == YES)
+		    call printf ("Type the f key to refit the galaxies list\n")
+		else if (plottype != 4 || newplot == YES) {
+		    call st_pdhist (gd, gt4, st, Memr[axis], ST_NSTARS(st))
+		    plottype = 4
+		    newplot = NO
+		}
+
+	    case 'e':
+		if (newround == YES)
+		    call printf ("Type the f key to refit the galaxies list\n")
+		else if (plottype != 5 || newplot == YES) {
+		    call st_pehist (gd, gt5, st, Memr[round], ST_NSTARS(st))
+		    plottype = 5
+		    newplot = NO
+		}
+
+	    case 'p':
+		if (newphi == YES)
+		    call printf ("Type the f key to refit the galaxies list\n")
+		else if (plottype != 6 || newplot == YES) {
+		    call st_pphist (gd, gt6, st, Memr[phi], ST_NSTARS(st))
+		    plottype = 6
+		    newplot = NO
+		}
+
+	    default:
+	    }
+	}
+
+	# Recompute the functions if necessary.
+	if (newphi == YES)
+	    call st_gmkphi (st, x, y, mag, egal, axis, round, phi)
+	if (newspace == YES)
+	    call st_gmkspatial (sf, st, x, y, mag, egal, axis, round, phi)
+	if (newmix == YES)
+	    call st_gmkmix (st, x, y, mag, egal, axis, round, phi)
+	if (newlum == YES) {
+	    call st_gmklum (lf, st, x, y, mag, egal, axis, round, phi)
+	    call st_gmkaxis (st, x, y, mag, egal, axis, round, phi)
+	    call st_gmkround (st, x, y, mag, egal, axis, round, phi)
+	} else {
+	    if (newaxis == YES)
+	        call st_gmkaxis (st, x, y, mag, egal, axis, round, phi)
+	    if (newround == YES)
+	        call st_gmkround (st, x, y, mag, egal, axis, round, phi)
+	}
+
+	# Free space for the plots.
+	call gt_free (gt1)
+	call gt_free (gt2)
+	call gt_free (gt3)
+	call gt_free (gt4)
+	call gt_free (gt5)
+	call gt_free (gt6)
+
+	call sfree (sp)
+end
+
+
+# ST_PFIELD -- Plot distribution of stars in the x-y plane.
+
+procedure st_pfield (gd, gt, st, x, y, mag, npts)
+
+pointer	gd		# pointer to graphics stream
+pointer	gt		# pointer to graphics descriptor
+pointer	st		# pointer to starlist structure
+real	x[ARB]		# x coords
+real	y[ARB]		# y coords
+real	mag[ARB]	# magnitudes
+int	npts		# number of points
+
+int	i
+pointer	sp, sizes, par1, par2, title
+bool	fp_equalr()
+
+begin
+	call smark (sp)
+	call salloc (sizes, npts, TY_REAL)
+	call salloc (par1, SZ_LINE, TY_CHAR)
+	call salloc (par2, SZ_LINE, TY_CHAR)
+	call salloc (title, 3 * SZ_LINE, TY_CHAR)
+
+	# Clear screen.
+	call gclear (gd)
+
+	# Set the labels.
+	call gt_sets (gt, GTXLABEL, "X coordinate")
+	call gt_sets (gt, GTYLABEL, "Y coordinate")
+
+	# Set the title.
+	call sprintf (Memc[par1], SZ_LINE,
+	    "Nstars: %d  Spatial model: %s  Luminosity model: %s\n")
+	    call pargi (ST_NSTARS(st))
+	    if (ST_SPATIAL(st) == ST_SPFILE)
+		call pargstr (ST_SFILE(st))
+	    else
+		call pargstr (ST_SPSTRING(st))
+	    if (ST_LUMINOSITY(st) == ST_LFFILE)
+		call pargstr (ST_LFILE(st))
+	    else
+		call pargstr (ST_LFSTRING(st))
+	call sprintf (Memc[par2], SZ_LINE,
+	    "X range: %g to %g  Yrange: %g to %g  Mag range: %g to %g\n") 
+	    call pargr (ST_XMIN(st))
+	    call pargr (ST_XMAX(st))
+	    call pargr (ST_YMIN(st))
+	    call pargr (ST_YMAX(st))
+	    call pargr (ST_MINMAG(st))
+	    call pargr (ST_MAXMAG(st))
+	call sprintf (Memc[title], 3 * SZ_LINE, "%s%s%s")
+	    call pargstr ("MAP OF STARLIST\n")
+	    call pargstr (Memc[par1])
+	    call pargstr (Memc[par2])
+	call gt_sets (gt, GTTITLE, Memc[title])
+
+	# Set the plot axes min and max values.
+	call gt_setr (gt, GTXMIN, ST_XMIN(st))
+	call gt_setr (gt, GTXMAX, ST_XMAX(st))
+	call gt_setr (gt, GTYMIN, ST_YMIN(st))
+	call gt_setr (gt, GTYMAX, ST_YMAX(st))
+
+	# Set the window and labels.
+	call gt_swind (gd, gt)
+	call gt_labax (gd, gt)
+
+	# Plot.
+	if (fp_equalr (ST_MAXMAG(st), ST_MINMAG(st)))
+	    call amovkr (2.0, Memr[sizes], npts)
+	else
+	    call amapr (mag, Memr[sizes], npts, ST_MAXMAG(st), ST_MINMAG(st),
+		1.0, 4.0)
+	call gt_sets (gt, GTTYPE, "mark")
+	call gt_sets (gt, GTMARK, "box")
+	do i = 1, npts
+	    call gmark (gd, x[i], y[i], GM_BOX, Memr[sizes+i-1],
+		Memr[sizes+i-1])
+
+	call sfree (sp)
+end
+
+
+# ST_PGFIELD -- Plot distribution of stars in the x-y plane.
+
+procedure st_pgfield (gd, gt, st, x, y, mag, egal, axis, round, npts)
+
+pointer	gd		# pointer to graphics stream
+pointer	gt		# pointer to plot descriptor
+pointer	st		# pointer to starlist structure
+real	x[ARB]		# array of x coordinates
+real	y[ARB]		# array of y coordinates
+real	mag[ARB]	# array of magnitudes
+int	egal[ARB]	# array of galaxy types
+real	axis[ARB]	# array of diameters
+real	round[ARB]	# array of roundness values
+int	npts		# number of points
+
+int	i
+pointer	sp, par1, par2, title, xsizes
+real	amin, amax
+bool	fp_equalr()
+
+begin
+	call smark (sp)
+	call salloc (par1, SZ_LINE, TY_CHAR)
+	call salloc (par2, SZ_LINE, TY_CHAR)
+	call salloc (title, 3 * SZ_LINE, TY_CHAR)
+	call salloc (xsizes, npts, TY_REAL)
+
+	# Clear screen.
+	call gclear (gd)
+
+	# Set the labels.
+	call gt_sets (gt, GTXLABEL, "X coordinate")
+	call gt_sets (gt, GTYLABEL, "Y coordinate")
+
+	# Set the title.
+	call sprintf (Memc[par1], SZ_LINE,
+	    "Ngals: %d  Spatial model: %s  Luminosity model: %s\n")
+	    call pargi (ST_NSTARS(st))
+	    if (ST_SPATIAL(st) == ST_SPFILE)
+		call pargstr (ST_SFILE(st))
+	    else
+		call pargstr (ST_SPSTRING(st))
+	    if (ST_LUMINOSITY(st) == ST_LFFILE)
+		call pargstr (ST_LFILE(st))
+	    else
+		call pargstr (ST_LFSTRING(st))
+	call sprintf (Memc[par2], SZ_LINE,
+	    "X range: %g to %g  Yrange: %g to %g  Mag range: %g to %g\n") 
+	    call pargr (ST_XMIN(st))
+	    call pargr (ST_XMAX(st))
+	    call pargr (ST_YMIN(st))
+	    call pargr (ST_YMAX(st))
+	    call pargr (ST_MINMAG(st))
+	    call pargr (ST_MAXMAG(st))
+	call sprintf (Memc[title], 3 * SZ_LINE, "%s%s%s")
+	    call pargstr ("MAP OF GALLIST\n")
+	    call pargstr (Memc[par1])
+	    call pargstr (Memc[par2])
+	call gt_sets (gt, GTTITLE, Memc[title])
+
+	# Set the x and y axis minimums and maximums.
+	call gt_setr (gt, GTXMIN, ST_XMIN(st))
+	call gt_setr (gt, GTXMAX, ST_XMAX(st))
+	call gt_setr (gt, GTYMIN, ST_YMIN(st))
+	call gt_setr (gt, GTYMAX, ST_YMAX(st))
+
+	# Set the window and labels.
+	call gt_swind (gd, gt)
+	call gt_labax (gd, gt)
+
+	# Compute the marksizes.
+	call alimr (axis, npts, amin, amax)
+	if (fp_equalr (amin, amax))
+	    call amovkr (2.0, Memr[xsizes], npts)
+	else
+	    call amapr (axis, Memr[xsizes], npts, amin, amax, 1.0, 4.0)
+
+	#call amulr (axis, round, Memr[ysizes], npts)
+	#call alimr (Memr[ysizes], npts, amin, amax)
+	#call amapr (Memr[ysizes], Memr[ysizes], npts, amin, amax, 1.0, 4.0)
+
+	# Plot.
+	call gt_sets (gt, GTTYPE, "mark")
+	do i = 1, npts {
+	    if (egal[i] == ST_DEVAUC)
+	        call gmark (gd, x[i], y[i], GM_CIRCLE, Memr[xsizes+i-1],
+		    Memr[xsizes+i-1])
+	    else
+	        call gmark (gd, x[i], y[i], GM_DIAMOND, Memr[xsizes+i-1],
+		    Memr[xsizes+i-1])
+	}
+
+	call sfree (sp)
+end
+
+
+# ST_PMHIST -- Plot luminosity function of the stars or galaxies.
+
+procedure st_pmhist (gd, gt, st, mag, npts)
+
+pointer	gd		# pointer to graphics stream
+pointer	gt		# pointer to the plot descriptor
+pointer	st		# pointer to starlist structure
+real	mag[ARB]	# array of magnitudes
+int	npts		# number of points
+
+int	i, nbins
+pointer	sp, par, title, hx, hgm
+real	mval, mmin, mmax, dm, hmin, hmax
+
+begin
+	# Compute the parameters of the histogram to be plotted.
+	mmin = ST_MINMAG(st)
+	if (ST_MBINSIZE(st) <= 0.0) {
+	    nbins = 1
+	    mmax = ST_MAXMAG(st)
+	    dm = mmax - mmin
+	} else {
+	    dm = ST_MBINSIZE(st)
+	    mval = (ST_MAXMAG(st) - mmin) / dm
+	    i =  int (mval)
+	    if (abs (mval -i ) <= 100.0 * EPSILONR) {
+		nbins = i + 1
+		mmax = ST_MAXMAG(st)
+	    } else {
+		mmax = mmin + (i + 1) * dm
+		nbins = i + 2
+	    }
+	}
+
+	# Allocate temporary space.
+	call smark (sp)
+	call salloc (par, SZ_LINE, TY_CHAR)
+	call salloc (title, 2 * SZ_LINE, TY_CHAR)
+	call salloc (hx, nbins, TY_REAL)
+	call salloc (hgm, nbins, TY_REAL)
+
+	# Make the histogram.
+	call aclrr (Memr[hgm], nbins)
+	call st_hgmr (mag, npts, Memr[hgm], nbins, mmin, mmax)
+	call alimr (Memr[hgm], nbins, hmin, hmax)
+
+	# Make the histogram x scale.
+	mval = mmin + dm / 2.0
+	do i = 1, nbins {
+	    Memr[hx+i-1] = mval
+	    mval = mval + dm
+	}
+	mval = mmin + nbins * dm
+
+	# Clear the screen.
+	call gclear (gd)
+
+	# Set the labels.
+	call gt_sets (gt, GTXLABEL, "Magnitude")
+	call gt_sets (gt, GTYLABEL, "N(M)")
+
+	# Set the title.
+	call sprintf (Memc[par], SZ_LINE,
+	    "%s: %d  Model: %s\nMag: %g to %g in steps of %g\n")
+	    if (ST_TYPE(st) == ST_STARS)
+		call pargstr ("Nstars")
+	    else
+		call pargstr ("Ngals")
+	    call pargi (ST_NSTARS(st))
+	    if (ST_LUMINOSITY(st) == ST_LFFILE)
+		call pargstr (ST_LFILE(st))
+	    else
+		call pargstr (ST_LFSTRING(st))
+	    call pargr (mmin)
+	    call pargr (mmax)
+	    call pargr (dm)
+	call sprintf (Memc[title], 2 * SZ_LINE, "%s%s")
+	    call pargstr ("LUMINOSITY FUNCTION\n")
+	    call pargstr (Memc[par])
+	call gt_sets (gt, GTTITLE, Memc[title])
+
+	# Set the mins and maxs.
+	call gt_setr (gt, GTXMIN, mmin)
+	call gt_setr (gt, GTXMAX, mval)
+	call gt_setr (gt, GTYMIN, 0.0)
+	call gt_setr (gt, GTYMAX, hmax)
+
+	# Set the window.
+	call gt_swind (gd, gt)
+	call gt_labax (gd, gt)
+
+	# Plot.
+	call gt_sets (gt, GTTYPE, "histogram")
+	call gt_plot (gd, gt, Memr[hx], Memr[hgm], nbins)
+	call gline (gd, mmin, Memr[hgm], Memr[hx], Memr[hgm])
+	call gline (gd, Memr[hx+nbins-1], Memr[hgm+nbins-1], mval,
+	    Memr[hgm+nbins-1])
+
+	call sfree (sp)
+end
+
+
+# ST_PRHIST -- Plot radial density distribution of the stars.
+
+procedure st_prhist (gd, gt, st, x, y, npts)
+
+pointer	gd		# pointer to graphics stream
+pointer	gt		# pointer to plot descriptor
+pointer	st		# pointer to starlist structure
+real	x[ARB]		# array of x values
+real	y[ARB]		# array of y values
+int	npts		# number of points
+
+int	i, nbins
+pointer	sp, par, title, r, hx, hgm
+real	rval, rmin, rmax, dr, hmin, hmax
+
+begin
+	# Allocate temporary space.
+	call smark (sp)
+	call salloc (r, npts, TY_REAL)
+	call salloc (par, SZ_LINE, TY_CHAR)
+	call salloc (title, 2 * SZ_LINE, TY_CHAR)
+
+	# Compute the radial coordinate values.
+	do i = 1, npts {
+	    Memr[r+i-1]  = sqrt ((x[i] - ST_XC(st)) ** 2 +
+	        (y[i] - ST_YC(st)) ** 2)
+	}
+	call alimr (Memr[r], npts, rmin, rmax)
+
+	# Compute the size of the histogram.
+	rmin = 0.0
+	if (ST_RBINSIZE(st) <= 0) {
+	    nbins = 1
+	    dr = rmax - rmin
+	} else {
+	    dr = ST_RBINSIZE(st)
+	    rval = (rmax - rmin) / dr
+	    i = int (rval)
+	    if (abs (rval - i) <= 100.0 * EPSILONR)
+		nbins = i + 1
+	    else {
+		rmax = rmin + (i + 1) * dr
+		nbins = i + 2
+	    }
+	}
+
+	# Make the histogram and normalize by area.
+	call salloc (hx, nbins, TY_REAL)
+	call salloc (hgm, nbins, TY_REAL)
+	call aclrr (Memr[hgm], nbins)
+	call st_hgmr (Memr[r], npts, Memr[hgm], nbins, rmin, rmax)
+	rval = rmin
+	do i = 1, nbins {
+	    Memr[hgm+i-1] = Memr[hgm+i-1] / ( PI * dr * (2.0 * rval + dr))
+	    rval = rval + dr
+	}
+	call alimr (Memr[hgm], nbins, hmin, hmax)
+
+	# Make the histogram x scale.
+	rval = rmin + dr / 2.0
+	do i = 1, nbins {
+	    Memr[hx+i-1] = rval
+	    rval = rval + dr
+	}
+	rval = rmin + nbins * dr
+
+	# Clear the screen.
+	call gclear (gd)
+
+	# Set the labels.
+	call gt_sets (gt, GTXLABEL, "Radial Distance")
+	call gt_sets (gt, GTYLABEL, "N(R) / Area")
+
+	# Set the title.
+	call sprintf (Memc[par], SZ_LINE,
+	    "Model: %s  %s: %d\nRadius: %g to %g in steps of %g\n")
+	    if (ST_SPATIAL(st) == ST_SPFILE)
+		call pargstr (ST_SFILE(st))
+	    else
+		call pargstr (ST_SPSTRING(st))
+	    if (ST_TYPE(st) == ST_STARS)
+		call pargstr ("Nstars")
+	    else
+		call pargstr ("Ngals")
+	    call pargi (ST_NSTARS(st))
+	    call pargr (rmin)
+	    call pargr (rmax)
+	    call pargr (dr)
+	call sprintf (Memc[title], 2 * SZ_LINE, "%s%s")
+	    call pargstr ("RADIAL DENSITY FUNCTION\n")
+	    call pargstr (Memc[par])
+	call gt_sets (gt, GTTITLE, Memc[title])
+
+	# Set the x and y axes minimum and maximum values.
+	call gt_setr (gt, GTXMIN, rmin) 
+	call gt_setr (gt, GTXMAX, rval)
+	call gt_setr (gt, GTYMIN, 0.0)
+	call gt_setr (gt, GTYMAX, hmax)
+
+	# Set the window.
+	call gt_swind (gd, gt)
+	call gt_labax (gd, gt)
+
+	# Plot.
+	call gt_sets (gt, GTTYPE, "histogram")
+	call gt_plot (gd, gt, Memr[hx], Memr[hgm], nbins)
+	call gline (gd, rmin, Memr[hgm], Memr[hx], Memr[hgm])
+	call gline (gd, Memr[hx+nbins-1], Memr[hgm+nbins-1], rval,
+	    Memr[hgm+nbins-1])
+
+	call sfree (sp)
+end
+
+
+# ST_PDHIST -- Plot the distribution of galaxy diameters.
+
+procedure st_pdhist (gd, gt, st, axis, npts)
+
+pointer	gd		# pointer to graphics stream
+pointer	gt		# pointer to plot descriptor
+pointer	st		# pointer to starlist structure
+real	axis[ARB]	# array of diameters
+int	npts		# number of points
+
+int	i, nbins
+pointer	sp, par, title, hx, hgm
+real	aval, amin, amax, da, hmin, hmax
+
+begin
+
+	# Allocate space for the histogram.
+	call alimr (axis, npts, amin, amax)
+	amax = max (ST_ERADIUS(st), ST_SRADIUS(st))
+	if (ST_DBINSIZE(st) <= 0) {
+	    nbins = 1
+	    da = amax - amin
+	} else {
+	    da = ST_DBINSIZE(st)
+	    aval = (amax - amin) / da
+	    i = int (aval)
+	    if (abs (aval - i) <= 100.0 * EPSILONR)
+		nbins = i + 1
+	    else {
+		amin = amax - (i + 1) * da
+		nbins = i + 2
+	    }
+	}
+
+	# Allocate temporary space.
+	call smark (sp)
+	call salloc (par, SZ_LINE, TY_CHAR)
+	call salloc (title, 2 * SZ_LINE, TY_CHAR)
+	call salloc (hx, nbins, TY_REAL)
+	call salloc (hgm, nbins, TY_REAL)
+
+	# Make the histogram.
+	call aclrr (Memr[hgm], nbins)
+	call st_hgmr (axis, npts, Memr[hgm], nbins, amin, amax)
+	call alimr (Memr[hgm], nbins, hmin, hmax)
+
+	# Make the histogram x scale.
+	aval = amin + da / 2.0
+	do i = 1, nbins {
+	    Memr[hx+i-1] = aval
+	    aval = aval + da
+	}
+	aval = amin + nbins * da
+
+	# Clear the screen.
+	call gclear (gd)
+
+	# Set the labels.
+	call gt_sets (gt, GTXLABEL, "Half-Flux Radius")
+	call gt_sets (gt, GTYLABEL, "N(radius)")
+
+	# Set the title.
+	call sprintf (Memc[par], SZ_LINE,
+     "Luminosity function: %s  Ngals: %d\nDiameter: %g to %g in steps of %g\n")
+	    if (ST_LUMINOSITY(st) == ST_LFFILE)
+		call pargstr (ST_LFILE(st))
+	    else
+		call pargstr (ST_LFSTRING(st))
+	    call pargi (ST_NSTARS(st))
+	    call pargr (amin)
+	    call pargr (amax)
+	    call pargr (da)
+	call sprintf (Memc[title], 2 * SZ_LINE, "%s%s")
+	    call pargstr ("HALF-FLUX RADIUS DISTRIBUTION\n")
+	    call pargstr (Memc[par])
+	call gt_sets (gt, GTTITLE, Memc[title])
+
+	# Set the mins and maxs.
+	call gt_setr (gt, GTXMIN, amin)
+	call gt_setr (gt, GTXMAX, aval)
+	call gt_setr (gt, GTYMIN, 0.0)
+	call gt_setr (gt, GTYMAX, hmax)
+
+	# Set the window.
+	call gt_swind (gd, gt)
+	call gt_labax (gd, gt)
+
+	# Plot.
+	call gt_sets (gt, GTTYPE, "histogram")
+	call gt_plot (gd, gt, Memr[hx], Memr[hgm], nbins)
+	call gline (gd, amin, Memr[hgm], Memr[hx], Memr[hgm])
+	call gline (gd, Memr[hx+nbins-1], Memr[hgm+nbins-1], aval,
+	    Memr[hgm+nbins-1])
+
+	call sfree (sp)
+end
+
+
+# ST_PEHIST -- Plot the distribution of galaxy diameters.
+
+procedure st_pehist (gd, gt, st, round, npts)
+
+pointer	gd		# pointer to graphics stream
+pointer	gt		# pointer to plot descriptor
+pointer	st		# pointer to starlist structure
+real	round[ARB]	# array of roundness values
+int	npts		# number of points
+
+int	i, nbins
+pointer	sp, par, title, hx, hgm
+real	eval, emin, emax, de, hmin, hmax
+
+begin
+	# Compute the size of the histogram.
+	emin = .1
+	if (ST_EBINSIZE(st) <= 0) {
+	    nbins = 1
+	    emax = 1.
+	    de = emax - emin
+	} else {
+	    de = ST_EBINSIZE(st)
+	    eval = (1. - emin) / de
+	    i = int (eval)
+	    if (abs (eval - i) <= 100.0 * EPSILONR) {
+		nbins = i + 1
+		emax = 1.
+	    } else {
+		nbins = i + 2
+		emax = emin + (i + 1) * de
+	    }
+	}
+
+	# Allocate temporary space.
+	call smark (sp)
+	call salloc (par, SZ_LINE, TY_CHAR)
+	call salloc (title, 2 * SZ_LINE, TY_CHAR)
+	call salloc (hx, nbins, TY_REAL)
+	call salloc (hgm, nbins, TY_REAL)
+
+	# Make the histogram and normalize by area.
+	call aclrr (Memr[hgm], nbins)
+	call st_hgmr (round, npts, Memr[hgm], nbins, emin, emax)
+	call alimr (Memr[hgm], nbins, hmin, hmax)
+
+	# Make the histogram x scale.
+	eval = emin + de / 2.0
+	do i = 1, nbins {
+	    Memr[hx+i-1] = eval
+	    eval = eval + de
+	}
+	eval = emin + nbins * de
+
+	# Clear the screen.
+	call gclear (gd)
+
+	# Set the labels.
+	call gt_sets (gt, GTXLABEL, "Axial Ratio")
+	call gt_sets (gt, GTYLABEL, "N(Axial Ratio)")
+
+	# Set the title.
+	call sprintf (Memc[par], SZ_LINE,
+	    "Ngals: %d\nRoundness: %g to %g in steps of %g\n")
+	    call pargi (ST_NSTARS(st))
+	    call pargr (emin)
+	    call pargr (emax)
+	    call pargr (de)
+	call sprintf (Memc[title], 2 * SZ_LINE, "%s%s")
+	    call pargstr ("AXIAL RATIO DISTRIBUTION\n")
+	    call pargstr (Memc[par])
+	call gt_sets (gt, GTTITLE, Memc[title])
+
+	# Set the mins and maxs.
+	call gt_setr (gt, GTXMIN, emin)
+	call gt_setr (gt, GTXMAX, eval)
+	call gt_setr (gt, GTYMIN, 0.0)
+	call gt_setr (gt, GTYMAX, hmax)
+
+	# Set the window.
+	call gt_swind (gd, gt)
+	call gt_labax (gd, gt)
+
+	# Plot.
+	call gt_sets (gt, GTTYPE, "histogram")
+	call gt_plot (gd, gt, Memr[hx], Memr[hgm], nbins)
+	call gline (gd, emin, Memr[hgm], Memr[hx], Memr[hgm])
+	call gline (gd, Memr[hx+nbins-1], Memr[hgm+nbins-1], eval,
+	    Memr[hgm+nbins-1])
+
+	call sfree (sp)
+end
+
+
+define	MIN_ANGLE	0.0
+define	MAX_ANGLE	360.0
+
+# ST_PPHIST -- Plot the distribution of galaxy diameters.
+
+procedure st_pphist (gd, gt, st, phi, npts)
+
+pointer	gd		# pointer to graphics stream
+pointer	gt		# pointer to plot descriptor
+pointer	st		# pointer to starlist structure
+real	phi[ARB]	# array of position angle values
+int	npts		# number of points
+
+int	i, nbins
+pointer	sp, par, title, hx, hgm
+real	pval, pmin, pmax, dp, hmin, hmax
+
+begin
+	# Compute the size of the histogram.
+	pmin = MIN_ANGLE
+	if (ST_PBINSIZE(st) <= 0) {
+	    nbins = 1
+	    pmax = MAX_ANGLE
+	    dp = pmax - pmin
+	} else {
+	    dp = ST_PBINSIZE(st)
+	    pval = (MAX_ANGLE - pmin) / dp
+	    i = int (pval)
+	    if (abs (pval - i) <= 100.0 * EPSILONR) {
+		nbins = i + 1
+		pmax = MAX_ANGLE
+	    } else {
+	        pmax = MIN_ANGLE + (i + 1) * dp
+		nbins = i + 2
+	    }
+	}
+
+	# Allocate temporary space.
+	call smark (sp)
+	call salloc (par, SZ_LINE, TY_CHAR)
+	call salloc (title, 2 * SZ_LINE, TY_CHAR)
+	call salloc (hx, nbins, TY_REAL)
+	call salloc (hgm, nbins, TY_REAL)
+
+	# Make the histogram.
+	call aclrr (Memr[hgm], nbins)
+	call st_hgmr (phi, npts, Memr[hgm], nbins, pmin, pmax)
+	call alimr (Memr[hgm], nbins, hmin, hmax)
+
+
+	# Make the histogram x scale.
+	pval = dp / 2.0
+	do i = 1, nbins {
+	    Memr[hx+i-1] = pval
+	    pval = pval + dp
+	}
+	pval = pmin + nbins * dp
+
+	# Clear the screen.
+	call gclear (gd)
+
+	# Set the axis labels.
+	call gt_sets (gt, GTXLABEL, "Position Angle")
+	call gt_sets (gt, GTYLABEL, "N(Position Angle)")
+
+	# Set the title.
+	call sprintf (Memc[par], SZ_LINE,
+	    "Ngals: %d\nPosition angle: %g to %g in steps of %g\n")
+	    call pargi (ST_NSTARS(st))
+	    call pargr (pmin)
+	    call pargr (pmax)
+	    call pargr (dp)
+	call sprintf (Memc[title], 2 * SZ_LINE, "%s%s")
+	    call pargstr ("POSITION ANGLE DISTRIBUTION\n")
+	    call pargstr (Memc[par])
+	call gt_sets (gt, GTTITLE, Memc[title])
+
+	# Set the axis mins and maxs.
+	call gt_setr (gt, GTXMIN, pmin)
+	call gt_setr (gt, GTXMAX, pval)
+	call gt_setr (gt, GTYMIN, 0.0)
+	call gt_setr (gt, GTYMAX, hmax)
+
+	# Set the window.
+	call gt_swind (gd, gt)
+	call gt_labax (gd, gt)
+
+	# Plot.
+	call gt_sets (gt, GTTYPE, "histogram")
+	call gt_plot (gd, gt, Memr[hx], Memr[hgm], nbins)
+	call gline (gd, pmin, Memr[hgm], Memr[hx], Memr[hgm])
+	call gline (gd, Memr[hx+nbins-1], Memr[hgm+nbins-1], pval,
+	    Memr[hgm+nbins-1])
+
+	call sfree (sp)
+end
+
+
+# ST_HGMR -- Accumulate the histogram of the input vector.  The output vector
+# hmg (the histogram) should be cleared prior to the first call.
+
+procedure st_hgmr (data, npix, hgm, nbins, z1, z2)
+
+real 	data[ARB]		# data vector
+int	npix			# number of pixels
+real	hgm[ARB]		# output histogram
+int	nbins			# number of bins in histogram
+real	z1, z2			# greyscale values of first and last bins
+
+int	bin, i
+real	z, dz
+
+begin
+	dz = real (nbins - 1) / real (z2 - z1)
+	if (abs (dz - 1.0) < (EPSILONR * 2.0)) {
+	    do i = 1, npix {
+		z = data[i]
+	        if (z < z1 || z > z2)
+		    next
+	        bin = int (z - z1) + 1
+	        hgm[bin] = hgm[bin] + 1.0
+	    }
+	} else {
+	    do i = 1, npix {
+		z = data[i]
+	        if (z < z1 || z > z2)
+		    next
+	        bin = int ((z - z1) * dz) + 1
+	        hgm[bin] = hgm[bin] + 1.0
+	    }
+	}
+end
diff --git a/noao/artdata/lists/stshow.x b/noao/artdata/lists/stshow.x
new file mode 100644
index 00000000..4aa8d853
--- /dev/null
+++ b/noao/artdata/lists/stshow.x
@@ -0,0 +1,142 @@
+include "starlist.h"
+
+procedure st_show (st)
+
+pointer st		# pointer to starlist structure
+
+begin
+	call printf ("nstars = %d\n")
+	    call pargi (ST_NSTARS(st))
+
+	call printf ("spatial: %s\n")
+	    call pargstr (ST_SPSTRING(st))
+	call printf ("    xmin = %g  xmax = %g\n")
+	    call pargr (ST_XMIN(st))
+	    call pargr (ST_XMAX(st))
+	call printf ("    ymin = %g  ymax = %g\n")
+	    call pargr (ST_YMIN(st))
+	    call pargr (ST_YMAX(st))
+	call printf ("    xc = %g  yc = %g\n")
+	    call pargr (ST_XC(st))
+	    call pargr (ST_YC(st))
+	if (ST_SPATIAL(st) == ST_HUBBLE) {
+	    call printf ("    core = %g  base = %g\n")
+	        call pargr (ST_CORE(st))
+	        call pargr (ST_BASE(st))
+	} else if (ST_SPATIAL(st) == ST_SPFILE) {
+	    call printf ("    file: %s\n")
+	        call pargstr (ST_SFILE(st))
+	}
+	call printf ("    nssample = %d  sorder = %d\n")
+	    call pargi (ST_NSSAMPLE(st))
+	    call pargi (ST_SORDER(st))
+	call printf ("    rbinsize = %d\n")
+	    call pargr (ST_RBINSIZE(st))
+
+	call printf ("luminosity = %s\n")
+	    call pargstr (ST_LFSTRING(st))
+	call printf ("    minmag = %g  maxmag = %g\n")
+	    call pargr (ST_MINMAG(st))
+	    call pargr (ST_MAXMAG(st))
+	if (ST_LUMINOSITY(st) == ST_BANDS) {
+	    call printf ( "    bands: alpha = %g  beta = %g\n") 
+	        call pargr (ST_ALPHA(st))
+	        call pargr (ST_BETA(st))
+	    call printf ("    delta = %g  mstar = %g  mzero = %g\n")
+	        call pargr (ST_DELTA(st))
+	        call pargr (ST_MSTAR(st))
+		call pargr (ST_MZERO(st))
+	} else if (ST_LUMINOSITY(st) == ST_SALPETER) {
+	    call printf ("    mzero = %g\n")
+		call pargr (ST_MZERO(st))
+	} else if (ST_LUMINOSITY(st) == ST_POWLAW) {
+	    call printf ("    power = %g\n")
+		call pargr (ST_POWER(st))
+	} else if (ST_LUMINOSITY(st) == ST_LFFILE) {
+	    call printf ("    file: %s\n")
+	        call pargstr (ST_LFILE(st))
+	}
+	call printf ( "    nlsample = %d  lorder = %d\n")
+	    call pargl (ST_NLSAMPLE(st))
+	    call pargi (ST_LORDER(st))
+	call printf ("    mbinsize = %g\n")
+	    call pargr (ST_MBINSIZE(st))
+end
+
+
+# ST_GSHOW -- Display the GALAXIES parameters.
+
+procedure st_gshow (st)
+
+pointer st		# pointer to starfield structure
+
+begin
+	call printf ("ngals = %d\n")
+	    call pargi (ST_NSTARS(st))
+
+	call printf ("spatial: %s\n")
+	    call pargstr (ST_SPSTRING(st))
+	call printf ("    xmin = %g  xmax = %g\n")
+	    call pargr (ST_XMIN(st))
+	    call pargr (ST_XMAX(st))
+	call printf ("    ymin = %g  ymax = %g\n")
+	    call pargr (ST_YMIN(st))
+	    call pargr (ST_YMAX(st))
+	call printf ("    xc = %g  yc = %g\n")
+	    call pargr (ST_XC(st))
+	    call pargr (ST_YC(st))
+	if (ST_SPATIAL(st) == ST_HUBBLE) {
+	    call printf ("    core = %g  base = %g\n")
+	        call pargr (ST_CORE(st))
+	        call pargr (ST_BASE(st))
+	} else if (ST_SPATIAL(st) == ST_SPFILE) {
+	    call printf ("    file: %s\n")
+	        call pargstr (ST_SFILE(st))
+	}
+	call printf ("    nssample = %d  sorder = %d\n")
+	    call pargi (ST_NSSAMPLE(st))
+	    call pargi (ST_SORDER(st))
+	call printf ("    rbinsize = %d\n")
+	    call pargr (ST_RBINSIZE(st))
+
+	call printf ("luminosity = %s\n")
+	    call pargstr (ST_LFSTRING(st))
+	call printf ("    minmag = %g  maxmag = %g\n")
+	    call pargr (ST_MINMAG(st))
+	    call pargr (ST_MAXMAG(st))
+	if (ST_LUMINOSITY(st) == ST_POWLAW) {
+	    call printf ( "    powlaw: power = %g\n") 
+	        call pargr (ST_POWER(st))
+	} else if (ST_LUMINOSITY(st) == ST_SCHECTER) {
+	    call printf ( "    schecter: alpha = %g  mstar = %g  mzero = %g\n") 
+	        call pargr (ST_ALPHA(st))
+	        call pargr (ST_MSTAR(st))
+		call pargr (ST_MZERO(st))
+	} else if (ST_LUMINOSITY(st) == ST_LFFILE) {
+	    call printf ("    file: %s\n")
+	        call pargstr (ST_LFILE(st))
+	}
+	call printf ("    nlsample = %d  lorder = %d\n")
+	    call pargi (ST_NLSAMPLE(st))
+	    call pargi (ST_LORDER(st))
+	call printf ("    mbinsize = %d\n")
+	    call pargr (ST_MBINSIZE(st))
+	call printf ("    eradius = %g  sradius = %g  dbinsize = %g\n")
+	    call pargr (ST_ERADIUS(st))
+	    call pargr (ST_SRADIUS(st))
+	    call pargr (ST_DBINSIZE(st))
+	call printf ("    z = %g\n")
+	    call pargr (ST_Z(st))
+	call printf ("    absorption = %g\n")
+	    call pargr (ST_ABSORPTION(st))
+
+	call eprintf ("egalmix = %g\n")
+	    call pargr (ST_EGALMIX(st))
+	call printf ("ar = %g\n")
+	    call pargr (ST_AR(st))
+	call printf ("    ebinsize = %g\n")
+	    call pargr (ST_EBINSIZE(st))
+	call printf ("posmin = 0.0  posmax = 360.0\n")
+	call printf ("    pbinsize = %g\n")
+	    call pargr (ST_PBINSIZE(st))
+end
diff --git a/noao/artdata/lists/stspatial.x b/noao/artdata/lists/stspatial.x
new file mode 100644
index 00000000..1171dfda
--- /dev/null
+++ b/noao/artdata/lists/stspatial.x
@@ -0,0 +1,264 @@
+include <math.h>
+include <math/curfit.h>
+include <math/iminterp.h>
+
+
+# ST_XYUNIFORM -- Compute a set of x and y values uniformly distributed in x and
+# y between xmin, xmax, ymin and ymax.
+
+procedure st_xyuniform (x, y, nstars, xmin, xmax, ymin, ymax, seed)
+
+real	x[ARB]		# output array of x values
+real	y[ARB]		# output array of y values
+int	nstars		# number of stars
+real	xmin, xmax	# x coordinate limits
+real	ymin, ymax	# y coordinate limits
+long	seed		# seed for random number generator
+
+int	i
+real	urand()
+
+begin
+	# Compute x and y values between 0 and 1.
+	do i = 1, nstars {
+	    x[i] = urand (seed)
+	    y[i] = urand (seed)
+	}
+
+	# Map these values into the data range.
+	call amapr (x, x, nstars, 0.0, 1.0, xmin, xmax)
+	call amapr (y, y, nstars, 0.0, 1.0, ymin, ymax)
+end
+
+
+# ST_HBSAMPLE -- Compute a set of x and y values with a Hubble density
+# distribution.
+
+procedure st_hbsample (x, y, nstars, core, base, xc, yc, xmin, xmax, ymin, ymax,
+        nsample, order, seed)
+
+real	x[ARB]			# output array of x values
+real	y[ARB]			# output array of y values
+int	nstars			# number of stars
+real	core			# Hubble core radius
+real	base			# baseline density
+real	xc, yc			# x and y center coordinates
+real	xmin, xmax		# x range
+real	ymin, ymax		# y range
+int	nsample			# number of sample points
+int	order			# order of spline fit
+long	seed			# seed for random number generator
+
+int	i, ier
+pointer	sp, rad, prob, w, cv
+real	r1, r2, r3, r4, rmin, rmax, rval, dr, theta
+real	urand(), cveval()
+
+begin
+	# Allocate space for the fits.
+	call smark (sp)
+	call salloc (rad, nsample, TY_REAL)
+	call salloc (prob, nsample, TY_REAL)
+	call salloc (w, nsample, TY_REAL)
+
+	# Compute the maximum radial distance from the center and
+	# the sampling interval.
+
+	r1 = (xmin - xc) ** 2 + (ymin - yc) ** 2
+	r2 = (xmax - xc) ** 2 + (ymin - yc) ** 2
+	r3 = (xmax - xc) ** 2 + (ymax - yc) ** 2
+	r4 = (xmin - xc) ** 2 + (ymax - yc) ** 2
+	if (xc >= xmin && xc <= xmax && yc >= ymin && yc <= ymax)
+	    rmin = 0.0
+	else if (yc >= ymin && yc <= ymax)
+	    rmin = min (abs (xmin - xc), abs (xmax - xc))
+	else if (xc >= xmin && xc <= xmax)
+	    rmin = min (abs (ymin - yc), abs (ymax - yc))
+	else
+	    rmin = sqrt (min (r1, r2, r3, r4))
+	rmax = sqrt (max (r1, r2, r3, r4))
+	dr = (rmax - rmin) / (nsample - 1)
+
+	# Compute the integral of the sampling function.
+	r1 = core ** 2
+	rval = rmin
+	do i = 1, nsample {
+	    Memr[rad+i-1] = rval
+	    r2 = (core + rval) / core
+	    Memr[prob+i-1] = r1 * (log (r2) + 1.0 / r2 - 1.0) +
+	        base * rval ** 2 / 2.0
+	    rval = rval + dr
+	}
+
+	# Normalize the probability function.
+	call alimr (Memr[prob], nsample, rmin, rmax)
+	call amapr (Memr[prob], Memr[prob], nsample, rmin, rmax, 0.0, 1.0)
+
+	# Fit the inverse of the integral of the probability function
+	call cvinit (cv, SPLINE3, order, 0.0, 1.0)
+	call cvfit (cv, Memr[prob], Memr[rad], Memr[w], nsample, WTS_UNIFORM,
+	    ier)
+
+	# Sample the computed function.
+	if (ier == OK) {
+	    i = 0
+	    repeat {
+	        rval = cveval (cv, urand (seed))
+	        theta = DEGTORAD (360.0 * urand (seed))
+	        x[i+1] = rval * cos (theta) + xc
+	        y[i+1] = rval * sin (theta) + yc
+	        if (x[i+1] >= xmin && x[i+1] <= xmax && y[i+1] >= ymin &&
+	            y[i+1] <= ymax)
+		    i = i + 1
+	    } until (i >= nstars)
+	} else {
+	    call amovkr ((xmin + xmax) / 2.0, x, nstars)
+	    call amovkr ((ymin + ymax) / 2.0, y, nstars)
+	    call printf ("Error computing the spatial probability function.\n")
+	}
+
+	# Free up the space.
+	call cvfree (cv)
+	call sfree (sp)
+end
+
+
+# ST_SFSAMPLE -- Compute a sample of x and y coordinate values based
+# on a user supplied spatial density function.
+
+procedure st_sfsample (r, rprob, nsf, x, y, nstars, nsample, order, xc, yc,
+	xmin, xmax, ymin, ymax, seed)
+
+real	r[ARB]			# input array of radii
+real	rprob[ARB]		# input array of relative probabilities
+int	nsf			# number of input points
+real	x[ARB]			# output x coordinate array
+real	y[ARB]			# output y coordinate array
+int	nstars			# number of stars
+int	nsample			# number of sample points
+int	order			# order of the spline fit
+real	xc, yc			# x and y center coordiantes
+real	xmin, xmax		# min and max x values
+real	ymin, ymax		# min and max y values
+long	seed			# value of the seed
+
+int	itemp, i, ier
+pointer	sp, w, rad, iprob, cv, asi
+real	rfmin, rfmax, dr, rval, theta, imin, imax
+real	cveval(), asigrl(), urand()
+
+begin
+	# Allocate space for fitting.
+	itemp = max (nsf, nsample)
+	call smark (sp)
+	call salloc (rad, nsample, TY_REAL)
+	call salloc (iprob, nsample, TY_REAL)
+	call salloc (w, itemp, TY_REAL)
+
+	# Smooth the relative probability function function.
+	call alimr (r, nsf, rfmin, rfmax)
+	itemp = min (order, max (1, nsf / 4))
+	call cvinit (cv, SPLINE3, itemp, rfmin, rfmax)
+	call cvfit (cv, r, rprob, Memr[w], nsf, WTS_UNIFORM, ier) 
+
+	# Evaluate the smoothed function at equal intervals in r,
+	# Multiplying by r to prepare for the area integration.
+	if (ier == OK) {
+	    rval = rfmin
+	    dr = (rfmax - rfmin) / (nsample - 1)
+	    do i = 1, nsample {
+		Memr[rad+i-1] = rval
+	        Memr[iprob+i-1] = rval * cveval (cv, rval)
+	        rval = rval + dr
+	    }
+	    call cvfree (cv)
+	} else {
+	    call printf ("Error smoothing the user spatial density function.\n")
+	    call amovkr ((xmin + xmax) / 2.0, x, nstars)
+	    call amovkr ((ymin + ymax) / 2.0, y, nstars)
+	    call cvfree (cv)
+	    call sfree (sp)
+	    return
+	}
+
+
+	# Evaluate the integral.
+	call asiinit (asi, II_SPLINE3)
+	call asifit (asi, Memr[iprob], nsample)
+	Memr[iprob] = 0.0
+	do i = 2, nsample
+	    Memr[iprob+i-1] = Memr[iprob+i-2] + asigrl (asi, real (i - 1),
+		real (i))
+	call alimr (Memr[iprob], nsample, imin, imax)
+	call amapr (Memr[iprob], Memr[iprob], nsample, imin, imax, 0.0, 1.0)
+	call asifree (asi)
+
+	# Fit the inverse of the integral of the probability function.
+	call cvinit (cv, SPLINE3, order, 0.0, 1.0)
+	call cvfit (cv, Memr[iprob], Memr[rad], Memr[w], nsample, WTS_UNIFORM,
+	    ier)
+
+	# Sample the computed function.
+	if (ier == OK) {
+	    i = 0
+	    repeat {
+	        rval = cveval (cv, urand (seed))
+	        theta = DEGTORAD (360.0 * urand (seed))
+	        x[i+1] = rval * cos (theta) + xc
+	        y[i+1] = rval * sin (theta) + yc
+	        if (x[i+1] >= xmin && x[i+1] <= xmax && y[i+1] >= ymin &&
+	            y[i+1] <= ymax)
+		    i = i + 1
+	    } until (i >= nstars)
+	} else {
+	    call printf (
+	    "Error fitting the spatial probability function.\n")
+	    call amovkr ((xmin + xmax) / 2.0, x, nstars)
+	    call amovkr ((ymin + ymax) / 2.0, y, nstars)
+	}
+	call cvfree (cv)
+
+	# Free space.
+	call sfree (sp)
+end
+
+
+define	BUFSIZE		200
+
+# ST_GFETCHXY -- Fetch two real values from a text file.
+
+int procedure st_gfetchxy (sf, x, y)
+
+int	sf			# input text file descriptor
+pointer	x			# pointer to the x array
+pointer	y			# pointer to the y array
+
+int	bufsize, npts
+int	fscan(), nscan()
+
+begin
+	call seek (sf, BOF)
+
+	call malloc (x, BUFSIZE, TY_REAL)
+	call malloc (y, BUFSIZE, TY_REAL)
+	bufsize = BUFSIZE
+
+	npts = 0
+	while (fscan (sf) != EOF) {
+	    call gargr (Memr[x+npts])
+	    call gargr (Memr[y+npts])
+	    if (nscan () != 2)
+		next
+	    npts = npts + 1
+	    if (npts < bufsize)
+		next
+	    bufsize = bufsize + BUFSIZE
+	    call realloc (x, bufsize, TY_REAL)
+	    call realloc (y, bufsize, TY_REAL)
+	}
+
+	call realloc (x, npts, TY_REAL)
+	call realloc (y, npts, TY_REAL)
+
+	return (npts)
+end
diff --git a/noao/artdata/lists/t_gallist.x b/noao/artdata/lists/t_gallist.x
new file mode 100644
index 00000000..48f1f333
--- /dev/null
+++ b/noao/artdata/lists/t_gallist.x
@@ -0,0 +1,453 @@
+include <fset.h>
+include "starlist.h"
+
+procedure t_gallist()
+
+pointer	galaxies		# pointer to the name of the output file
+pointer	graphics		# poionter to graphics device name
+
+int	sf, lf
+long	seed, sseed, lseed
+long	sseed1, lseed1
+pointer	sp, str, x, y, mag, egal, axis, round, phi, dt, st, gd
+
+bool	clgetb()
+int	clgeti(), clgwrd(), open()
+long	clgetl(), clktime()
+pointer	dtmap(), gopen()
+real	clgetr()
+
+begin
+	call fseti (STDOUT, F_FLUSHNL, YES)
+
+	# Allocate working space.
+	call smark (sp)
+	call salloc (galaxies, SZ_FNAME, TY_CHAR)
+	call salloc (graphics, SZ_FNAME, TY_CHAR)
+	call salloc (str, SZ_LINE, TY_CHAR)
+
+	# Allocate the starlist / galaxies structure.
+	call malloc (st, LEN_STSTRUCT, TY_STRUCT)
+	ST_TYPE(st) = ST_GALAXIES
+
+	# Get the parameters.
+	call clgstr ("gallist", Memc[galaxies], SZ_FNAME)
+	ST_NSTARS(st) = clgeti ("ngals")
+
+	# Get the parameters of the spatial density function.
+	ST_SPATIAL(st) = clgwrd ("spatial", ST_SPSTRING(st), SZ_FNAME, SPFUNCS)
+	ST_XMIN(st) = clgetr ("xmin")
+	ST_XMAX(st) = clgetr ("xmax")
+	ST_YMIN(st) = clgetr ("ymin")
+	ST_YMAX(st) = clgetr ("ymax")
+	ST_SFILE(st) = EOS
+	switch (ST_SPATIAL(st)) {
+	case ST_UNIFORM:
+	    sf = NULL
+	    ST_XC(st) = (ST_XMAX(st) + ST_XMIN(st)) / 2.0
+	    ST_YC(st) = (ST_YMAX(st) + ST_YMIN(st)) / 2.0
+	case ST_HUBBLE:
+	    sf = NULL
+	    ST_XC(st) = clgetr ("xcenter")
+	    if (IS_INDEFR(ST_XC(st)))
+	        ST_XC(st) = (ST_XMAX(st) + ST_XMIN(st)) / 2.0
+	    ST_YC(st) = clgetr ("ycenter")
+	    if (IS_INDEFR(ST_YC(st)))
+	        ST_YC(st) = (ST_YMAX(st) + ST_YMIN(st)) / 2.0
+	case ST_SPFILE:
+	    call clgstr ("sfile", ST_SFILE(st), SZ_FNAME)
+	    sf = open (ST_SFILE(st), READ_ONLY, TEXT_FILE)
+	    ST_XC(st) = clgetr ("xcenter")
+	    if (IS_INDEFR(ST_XC(st)))
+	        ST_XC(st) = (ST_XMAX(st) + ST_XMIN(st)) / 2.0
+	    ST_YC(st) = clgetr ("ycenter")
+	    if (IS_INDEFR(ST_YC(st)))
+	        ST_YC(st) = (ST_YMAX(st) + ST_YMIN(st)) / 2.0
+	}
+	ST_CORE(st) = clgetr ("core_radius")
+	ST_BASE(st) = clgetr ("base")
+
+
+	# Get the parameters of the luminosity function.
+	ST_LUMINOSITY(st) = clgwrd ("luminosity", ST_LFSTRING(st), SZ_FNAME,
+	    GLUMFUNCS)
+	ST_MINMAG(st) = clgetr ("minmag")
+	ST_MAXMAG(st) = clgetr ("maxmag")
+	ST_LFILE(st) = EOS
+	switch (ST_LUMINOSITY(st)) {
+	case ST_UNIFORM, ST_POWLAW, ST_SCHECTER:
+	    lf = NULL
+	case ST_LFFILE:
+	    call clgstr ("lfile", ST_LFILE(st), SZ_FNAME)
+	    lf = open (ST_LFILE(st), READ_ONLY, TEXT_FILE)
+	}
+	ST_POWER(st) = clgetr ("power")
+	ST_MZERO(st) = clgetr ("mzero")
+	ST_ALPHA(st) = clgetr ("alpha")
+	ST_MSTAR(st) = clgetr ("mstar")
+
+	# Get the remaining parameters.
+	ST_Z(st) = clgetr ("z")
+	ST_AR(st) = clgetr ("ar")
+	ST_ERADIUS(st) = clgetr ("eradius")
+	ST_SRADIUS(st) = clgetr ("sradius")
+	ST_EGALMIX(st) = clgetr ("egalmix")
+	ST_ABSORPTION(st) = clgetr ("absorption")
+
+	# Get the spatial density and luminosity function sampling parameters.
+	seed = clktime (long (0))
+	sseed1 = clgetl ("sseed")
+	if (IS_INDEFL(sseed1))
+	    sseed = sseed + seed
+	else
+	    sseed = sseed1
+	ST_SSEED(st) = sseed
+	lseed1 = clgetl ("lseed")
+	if (IS_INDEFL(lseed1))
+	    lseed = lseed + seed + 1
+	else
+	    lseed = lseed1
+	ST_LSEED(st) = lseed
+	ST_NSSAMPLE(st) = clgeti ("nssample")
+	ST_NLSAMPLE(st) = clgeti ("nlsample")
+	ST_SORDER(st) = clgeti ("sorder")
+	ST_LORDER(st) = clgeti ("lorder")
+	ST_RBINSIZE(st) = clgetr ("rbinsize")
+	ST_MBINSIZE(st) = clgetr ("mbinsize")
+	ST_DBINSIZE(st) = clgetr ("dbinsize")
+	ST_EBINSIZE(st) = clgetr ("ebinsize")
+	ST_PBINSIZE(st) = clgetr ("pbinsize")
+
+	x = NULL
+	y = NULL
+	mag = NULL
+	egal = NULL
+	axis = NULL
+	round = NULL
+	phi = NULL
+
+	#  Compute the spatial and luminosity functions.
+	call st_gmkspatial (sf, st, x, y, mag, egal, axis, round, phi)
+	call st_gmklum (lf, st, x, y, mag, egal, axis, round, phi)
+	call st_gmkmix (st, x, y, mag, egal, axis, round, phi)
+	call st_gmkaxis (st, x, y, mag, egal, axis, round, phi)
+	call st_gmkround (st, x, y, mag, egal, axis, round, phi)
+	call st_gmkphi (st, x, y, mag, egal, axis, round, phi)
+
+	# Plot the results.
+	if (clgetb ("interactive")) {
+	    call clgstr ("graphics", Memc[graphics], SZ_FNAME)
+	    if (Memc[graphics] != EOS) {
+	        gd = gopen (Memc[graphics], NEW_FILE, STDGRAPH)
+	        call st_gplots (sf, lf, gd, st, x, y, mag, egal, axis, round,
+		    phi)
+	        call gclose (gd)
+	    }
+	}
+
+	# Write the database.
+	dt = dtmap (Memc[galaxies], APPEND)
+	call st_dtginit (dt, st, Memc[galaxies], sseed, lseed)
+	call st_dtgwrite (dt, Memr[x], Memr[y], Memr[mag], Memi[egal],
+	    Memr[axis], Memr[round], Memr[phi], ST_NSTARS(st))
+	call dtunmap (dt)
+
+	# Free up memory.
+	if (x != NULL)
+	    call mfree (x, TY_REAL)
+	if (y != NULL)
+	    call mfree (y, TY_REAL)
+	if (mag != NULL)
+	    call mfree (mag, TY_REAL)
+	if (egal != NULL)
+	    call mfree (egal, TY_INT)
+	if (axis != NULL)
+	    call mfree (axis, TY_REAL)
+	if (round != NULL)
+	    call mfree (round, TY_REAL)
+	if (phi != NULL)
+	    call mfree (phi, TY_REAL)
+	call mfree (st, TY_STRUCT)
+
+	# Close files.
+	if (sf != NULL)
+	    call close (sf)
+	if (lf != NULL)
+	    call close (lf)
+
+	call sfree (sp)
+end
+
+
+# ST_GMKSPATIAL -- Compute the galactic spatial density function.
+
+procedure st_gmkspatial (sf, st, x, y, mag, egal, axis, round, phi)
+
+int	sf			# spatial density function file descriptor
+pointer	st			# pointer to the starlist strucuture
+pointer	x			# pointer to the x array
+pointer	y			# pointer to the y array
+pointer	mag			# pointer to the magnitude array
+pointer	egal			# pointer to the galaxy type array
+pointer	axis			# pointer to half-power diameter array
+pointer	round			# pointer to roundness array
+pointer	phi			# pointer to an array of position angles
+
+int	nsf
+pointer	r, rprob 
+int	st_gfetchxy()
+
+begin
+	# Check the sizes of the arrays.
+	call st_gmalloc (st, x, y, mag, egal, axis, round, phi)
+
+	# Compute the x and y values.
+	switch (ST_SPATIAL(st)) {
+	case ST_UNIFORM:
+	    call st_xyuniform (Memr[x], Memr[y], ST_NSTARS(st), ST_XMIN(st),
+	        ST_XMAX(st), ST_YMIN(st), ST_YMAX(st), ST_SSEED(st))
+
+	case ST_HUBBLE:
+	    call st_hbsample (Memr[x], Memr[y], ST_NSTARS(st), ST_CORE(st),
+	        ST_BASE(st), ST_XC(st), ST_YC(st), ST_XMIN(st), ST_XMAX(st),
+		ST_YMIN(st), ST_YMAX(st), ST_NSSAMPLE(st), ST_SORDER(st),
+		ST_SSEED(st)) 
+
+	case ST_SPFILE:
+	    if (sf == NULL) {
+		call printf ("The spatial density file is not open.\n")
+		call amovkr ((ST_XMIN(st) + ST_XMAX(st)) / 2.0, Memr[x],
+		    ST_NSTARS(st))
+		call amovkr ((ST_YMIN(st) + ST_YMAX(st)) / 2.0, Memr[y],
+		    ST_NSTARS(st))
+	    } else {
+	        nsf = st_gfetchxy (sf, r, rprob)
+	        if (nsf > 0) {
+	            call st_sfsample (Memr[r], Memr[rprob], nsf, Memr[x],
+		        Memr[y], ST_NSTARS(st), ST_NSSAMPLE(st), ST_SORDER(st),
+			ST_XC(st), ST_YC(st), ST_XMIN(st), ST_XMAX(st),
+			ST_YMIN(st), ST_YMAX(st), ST_SSEED(st))
+	        } else {
+		    call printf (
+		        "The spatial density function file is empty.\n")
+		    call amovkr ((ST_XMIN(st) + ST_XMAX(st)) / 2.0, Memr[x],
+		        ST_NSTARS(st))
+		    call amovkr ((ST_YMIN(st) + ST_YMAX(st)) / 2.0, Memr[y],
+		        ST_NSTARS(st))
+	        }
+	        call mfree (r, TY_REAL)
+	        call mfree (rprob, TY_REAL)
+	    }
+
+	default:
+	    call printf ("Unknown spatial density function.\n")
+	}
+end
+
+
+# ST_GMKLUM -- Compute the luminosity function and the diameter distribution
+# function.
+
+procedure st_gmklum (lf, st, x, y, mag, egal, axis, round, phi)
+
+int	lf		# luminsosity function file descriptor
+pointer	st		# pointer to starlist structure
+pointer	x		# pointer to the x array
+pointer	y		# pointer to the y array
+pointer	mag		# pointer to magnitude array
+pointer	egal		# pointer to the galaxy type array
+pointer	axis		# pointer to half-power diameter array
+pointer	round		# pointer to roundness array
+pointer	phi		# pointer to an array of position angles
+
+int	nlf
+pointer	m, mprob
+int	st_gfetchxy()
+
+begin
+	# Check the sizes of the arrays.
+	call st_gmalloc (st, x, y, mag, egal, axis, round, phi)
+
+	# Compute the luminosity  function.
+	switch (ST_LUMINOSITY(st)) {
+	case ST_UNIFORM:
+	    call st_maguniform (Memr[mag], ST_NSTARS(st), ST_MINMAG(st),
+	        ST_MAXMAG(st), ST_LSEED(st))
+
+	case ST_POWLAW:
+	    call st_power (Memr[mag], ST_NSTARS(st), ST_POWER(st),
+	        ST_MINMAG(st), ST_MAXMAG(st), ST_LSEED(st))
+
+	case ST_SCHECTER:
+	    call st_schecter (Memr[mag], ST_NSTARS(st), ST_ALPHA(st),
+	        ST_MSTAR(st), ST_MINMAG(st), ST_MAXMAG(st), ST_MZERO(st),
+		ST_NLSAMPLE(st), ST_LORDER(st), ST_LSEED(st))
+
+	case ST_LFFILE:
+	    if (lf == NULL) {
+		call printf ("The luminosity function file is not open.\n")
+		call amovkr ((ST_MINMAG(st) + ST_MAXMAG(st)) / 2.0, Memr[mag],
+		    ST_NSTARS(st))
+	    } else {
+	        nlf = st_gfetchxy (lf, m, mprob)
+	        if (nlf > 0) {
+	            call st_lfsample (Memr[m], Memr[mprob], nlf, Memr[mag],
+	                ST_NSTARS(st), ST_MINMAG(st), ST_MAXMAG(st),
+		        ST_NLSAMPLE(st), ST_LORDER(st), ST_LSEED(st))
+	        } else {
+		    call printf (
+		    "The luminosity function file is empty.\n")
+		    call amovkr ((ST_MINMAG(st) + ST_MAXMAG(st)) / 2.0,
+		        Memr[mag], ST_NSTARS(st))
+	        }
+	        call mfree (m, TY_REAL)
+	        call mfree (mprob, TY_REAL)
+	    }
+
+	default:
+	    call printf ("The luminosity function is unknown.\n")
+	}
+end
+
+
+# ST_GMKMIX -- Compute the percentage of elliptical versus spiral galaxies.
+
+procedure st_gmkmix (st, x, y, mag, egal, axis, round, phi)
+
+pointer	st		# pointer to the starlist structure
+pointer	x		# pointer to the x array
+pointer	y		# pointer to the y array
+pointer	mag		# pointer to magnitude array
+pointer	egal		# pointer to the galaxy type array
+pointer	axis		# pointer to half-power diameter array
+pointer	round		# pointer to roundness array
+pointer	phi		# pointer to an array of position angles
+
+begin
+	# Check the sizes of the arrays.
+	call st_gmalloc (st, x, y, mag, egal, axis, round, phi)
+
+	# Compute the elliptical / spiral galaxy mix.
+	call st_esmix (Memi[egal], ST_NSTARS(st), ST_EGALMIX(st), ST_SSEED(st))
+end
+
+
+# ST_GMKROUND -- Compute the roundness values.
+
+procedure st_gmkround (st, x, y, mag, egal, axis, round, phi)
+
+pointer	st		# pointer to the starlist structure
+pointer	x		# pointer to the x array
+pointer	y		# pointer to the y array
+pointer	mag		# pointer to magnitude array
+pointer	egal		# pointer to galaxy type array
+pointer	axis		# pointer to half-power diameter array
+pointer	round		# pointer to roundness array
+pointer	phi		# pointer to an array of position angles
+
+begin
+	# Check the sizes of the arrays.
+	call st_gmalloc (st, x, y, mag, egal, axis, round, phi)
+
+	# Compute the roundness values.
+	call st_round (Memi[egal], Memr[mag], Memr[round], ST_NSTARS(st),
+	    ST_AR(st), ST_ABSORPTION(st),  ST_SSEED(st))
+end
+
+
+# ST_GMKPHI -- Compute the position angles.
+
+procedure st_gmkphi (st, x, y, mag, egal, axis, round, phi)
+
+pointer	st		# pointer to the starlist structure
+pointer	x		# pointer to the x array
+pointer	y		# pointer to the y array
+pointer	mag		# pointer to mag array
+pointer	egal		# pointer to the  galaxy type array
+pointer	axis		# pointer to half-power diameter array
+pointer	round		# pointer to roundness array
+pointer	phi		# pointer to an array of position angles
+
+begin
+	# Check the sizes of the arrays.
+	call st_gmalloc (st, x, y, mag, egal, axis, round, phi)
+
+	# Compute the position angles.
+	call st_phi (Memr[phi], ST_NSTARS(st), ST_SSEED(st))
+end
+
+
+# ST_GMKAXIS -- Compute the semi-major axes.
+
+procedure st_gmkaxis (st, x, y, mag, egal, axis, round, phi)
+
+pointer	st		# pointer to the starlist structure
+pointer	x		# pointer to the x array
+pointer	y		# pointer to the y array
+pointer	mag		# pointer to magnitude array
+pointer	egal		# pointer to E or S galaxy array
+pointer	axis		# pointer to half-power diameter array
+pointer	round		# pointer to roundness array
+pointer	phi		# pointer to an array of position angles
+
+begin
+	# Check the sizes of the arrays.
+	call st_gmalloc (st, x, y, mag, egal, axis, round, phi)
+
+	# Make the effective diameters array.
+	switch (ST_LUMINOSITY(st)) {
+	case ST_POWLAW:
+	    call st_zdiameters (Memr[mag], Memi[egal], Memr[axis],
+		ST_NSTARS(st), ST_MINMAG(st), ST_MAXMAG(st), ST_Z(st),
+		ST_ERADIUS(st), ST_SRADIUS(st), ST_LSEED(st))
+	default:
+	    call st_diameters (Memr[mag], Memi[egal], Memr[axis],
+		ST_NSTARS(st), ST_MINMAG(st), ST_MAXMAG(st),
+		ST_ERADIUS(st), ST_SRADIUS(st), ST_LSEED(st))
+	}
+end
+
+
+# ST_GMALLOC -- Allocate array space for the gallist task.
+
+procedure st_gmalloc (st, x, y, mag, egal, axis, round, phi)
+
+pointer	st		# pointer to the starlist structure
+pointer	x		# pointer to the x array
+pointer	y		# pointer to the y array
+pointer	mag		# pointer to magnitude array
+pointer	egal		# pointer to galaxy type array
+pointer	axis		# pointer to half-power diameter array
+pointer	round		# pointer to roundness array
+pointer	phi		# pointer to an array of position angles
+
+begin
+	if (x == NULL)
+	    call malloc (x, ST_NSTARS(st), TY_REAL)
+	else
+	    call realloc (x, ST_NSTARS(st), TY_REAL)
+	if (y == NULL)
+	    call malloc (y, ST_NSTARS(st), TY_REAL)
+	else
+	    call realloc (y, ST_NSTARS(st), TY_REAL)
+	if (mag == NULL)
+	    call malloc (mag, ST_NSTARS(st), TY_REAL)
+	else
+	    call realloc (mag, ST_NSTARS(st), TY_REAL)
+	if (egal == NULL)
+	    call malloc (egal, ST_NSTARS(st), TY_INT)
+	else
+	    call realloc (egal, ST_NSTARS(st), TY_INT)
+	if (axis == NULL)
+	    call malloc (axis, ST_NSTARS(st), TY_REAL)
+	else
+	    call realloc (axis, ST_NSTARS(st), TY_REAL)
+	if (round == NULL)
+	    call malloc (round, ST_NSTARS(st), TY_REAL)
+	else
+	    call realloc (round, ST_NSTARS(st), TY_REAL)
+	if (phi == NULL)
+	    call malloc (phi, ST_NSTARS(st), TY_REAL)
+	else
+	    call realloc (phi, ST_NSTARS(st), TY_REAL)
+end
diff --git a/noao/artdata/lists/t_starlist.x b/noao/artdata/lists/t_starlist.x
new file mode 100644
index 00000000..f110a27c
--- /dev/null
+++ b/noao/artdata/lists/t_starlist.x
@@ -0,0 +1,303 @@
+include <fset.h>
+include "starlist.h"
+
+procedure t_starlist ()
+
+pointer	starlist		# pointer to the name of the output file
+pointer	graphics		# pointer to the graphics device name
+
+int	sf, lf
+long	seed, sseed, lseed
+long	sseed1, lseed1
+pointer	sp, str, x, y, mag, dt, st, gd
+
+bool	clgetb()
+int	clgeti(), clgwrd(), open()
+long	clgetl(), clktime()
+pointer	dtmap(), gopen()
+real	clgetr()
+
+begin
+	call fseti (STDOUT, F_FLUSHNL, YES)
+
+	# Allocate working space.
+	call smark (sp)
+	call salloc (starlist, SZ_FNAME, TY_CHAR)
+	call salloc (graphics, SZ_FNAME, TY_CHAR)
+	call salloc (str, SZ_LINE, TY_CHAR)
+
+	# Allocate the starlist structure.
+	call malloc (st, LEN_STSTRUCT, TY_STRUCT)
+	ST_TYPE(st) = ST_STARS
+
+	# Get the principal parameters.
+	call clgstr ("starlist", Memc[starlist], SZ_FNAME)
+	ST_NSTARS(st) = clgeti ("nstars")
+
+	# Get the charactersitics of the spatial density function.
+	ST_SPATIAL(st) = clgwrd ("spatial", ST_SPSTRING(st), SZ_FNAME, SPFUNCS)
+	ST_XMIN(st) = clgetr ("xmin")
+	ST_XMAX(st) = clgetr ("xmax")
+	ST_YMIN(st) = clgetr ("ymin")
+	ST_YMAX(st) = clgetr ("ymax")
+	ST_SFILE(st) = EOS
+	switch (ST_SPATIAL(st)) {
+	case ST_UNIFORM:
+	    sf = NULL
+	    ST_XC(st) = (ST_XMAX(st) + ST_XMIN(st)) / 2.0
+	    ST_YC(st) = (ST_YMAX(st) + ST_YMIN(st)) / 2.0
+	case ST_HUBBLE:
+	    sf = NULL
+	    ST_XC(st) = clgetr ("xcenter")
+	    if (IS_INDEFR(ST_XC(st)))
+	        ST_XC(st) = (ST_XMAX(st) + ST_XMIN(st)) / 2.0
+	    ST_YC(st) = clgetr ("ycenter")
+	    if (IS_INDEFR(ST_YC(st)))
+	        ST_YC(st) = (ST_YMAX(st) + ST_YMIN(st)) / 2.0
+	case ST_SPFILE:
+	    call clgstr ("sfile", ST_SFILE(st), SZ_FNAME)
+	    sf = open (ST_SFILE(st), READ_ONLY, TEXT_FILE)
+	    ST_XC(st) = clgetr ("xcenter")
+	    if (IS_INDEFR(ST_XC(st)))
+	        ST_XC(st) = (ST_XMAX(st) + ST_XMIN(st)) / 2.0
+	    ST_YC(st) = clgetr ("ycenter")
+	    if (IS_INDEFR(ST_YC(st)))
+	        ST_YC(st) = (ST_YMAX(st) + ST_YMIN(st)) / 2.0
+	}
+	ST_CORE(st) = clgetr ("core_radius")
+	ST_BASE(st) = clgetr ("base")
+
+
+	# Get the luminosity function parameters.
+	ST_LUMINOSITY(st) = clgwrd ("luminosity", ST_LFSTRING(st), SZ_FNAME,
+	    LUMFUNCS)
+	ST_MINMAG(st) = clgetr ("minmag")
+	ST_MAXMAG(st) = clgetr ("maxmag")
+	ST_LFILE(st) = EOS
+	switch (ST_LUMINOSITY(st)) {
+	case ST_UNIFORM, ST_SALPETER, ST_BANDS, ST_POWLAW:
+	    lf = NULL
+	case ST_LFFILE:
+	    call clgstr ("lfile", ST_LFILE(st), SZ_FNAME)
+	    lf = open (ST_LFILE(st), READ_ONLY, TEXT_FILE)
+	}
+	ST_POWER(st) = clgetr ("power")
+	ST_MZERO(st) = clgetr ("mzero")
+	ST_ALPHA(st) = clgetr ("alpha")
+	ST_BETA(st) = clgetr ("beta")
+	ST_DELTA(st) = clgetr ("delta")
+	ST_MSTAR(st) = clgetr ("mstar")
+
+	# Get the function sampling parameters.
+	seed = clktime (long (0))
+	sseed1 = clgetl ("sseed")
+	if (IS_INDEFL(sseed1))
+	    sseed = sseed + seed
+	else
+	    sseed = sseed1
+	ST_SSEED(st) = sseed
+	lseed1 = clgetl ("lseed")
+	if (IS_INDEFL(lseed1))
+	    lseed = lseed + seed + 1
+	else
+	    lseed = lseed1
+	ST_LSEED(st) = lseed
+	ST_NSSAMPLE(st) = clgeti ("nssample")
+	ST_NLSAMPLE(st) = clgeti ("nlsample")
+	ST_SORDER(st) = clgeti ("sorder")
+	ST_LORDER(st) = clgeti ("lorder")
+
+
+	#  Compute the initial spatial and luminosity functions.
+	x = NULL
+	y = NULL
+	mag = NULL
+	call st_mkspatial (sf, st, x, y, mag)
+	call st_mklum (lf, st, x, y, mag)
+
+	# Plot the results.
+	if (clgetb ("interactive")) {
+	    call clgstr ("graphics", Memc[graphics], SZ_FNAME)
+	    ST_RBINSIZE(st) = clgetr ("rbinsize")
+	    ST_MBINSIZE(st) = clgetr ("mbinsize")
+	    if (Memc[graphics] != EOS) {
+	        gd = gopen (Memc[graphics], NEW_FILE, STDGRAPH)
+	        call st_plots (sf, lf, gd, st, x, y, mag)
+	        call gclose (gd)
+	    }
+	}
+
+	# Write the database.
+	dt = dtmap (Memc[starlist], APPEND)
+	call st_dtinit (dt, st, Memc[starlist], sseed, lseed)
+	call st_dtwrite (dt, Memr[x], Memr[y], Memr[mag], ST_NSTARS(st))
+	call dtunmap (dt)
+
+	# Free up memory.
+	if (x != NULL)
+	    call mfree (x, TY_REAL)
+	if (y != NULL)
+	    call mfree (y, TY_REAL)
+	if (mag != NULL)
+	    call mfree (mag, TY_REAL)
+	call mfree (st, TY_STRUCT)
+
+	# Close files.
+	if (sf != NULL)
+	    call close (sf)
+	if (lf != NULL)
+	    call close (lf)
+
+	call sfree (sp)
+end
+
+
+# ST_MKSPATIAL -- Compute the spatial density function.
+
+procedure st_mkspatial (sf, st, x, y, mag)
+
+int	sf			# spatial function file descriptor
+pointer	st			# pointer to the starlist structure
+pointer	x			# pointer to the x coordinate array
+pointer	y			# pointer to the y coordinate array
+pointer	mag			# pointer to the magnitude array
+
+int	nsf
+pointer	r, rprob 
+int	st_gfetchxy()
+
+begin
+	# Dynamically reallocate the x, y and magnitude arrays.
+	if (x == NULL)
+	    call malloc (x, ST_NSTARS(st), TY_REAL)
+	else
+	    call realloc (x, ST_NSTARS(st), TY_REAL)
+	if (y == NULL)
+	    call malloc (y, ST_NSTARS(st), TY_REAL)
+	else
+	    call realloc (y, ST_NSTARS(st), TY_REAL)
+	if (mag == NULL)
+	    call malloc (mag, ST_NSTARS(st), TY_REAL)
+	else
+	    call realloc (mag, ST_NSTARS(st), TY_REAL)
+
+	# Compute the x and y values.
+	switch (ST_SPATIAL(st)) {
+	case ST_UNIFORM:
+	    call st_xyuniform (Memr[x], Memr[y], ST_NSTARS(st), ST_XMIN(st),
+	        ST_XMAX(st), ST_YMIN(st), ST_YMAX(st), ST_SSEED(st))
+
+	case ST_HUBBLE:
+	    call st_hbsample (Memr[x], Memr[y], ST_NSTARS(st), ST_CORE(st),
+	        ST_BASE(st), ST_XC(st), ST_YC(st), ST_XMIN(st), ST_XMAX(st),
+		ST_YMIN(st), ST_YMAX(st), ST_NSSAMPLE(st), ST_SORDER(st),
+		ST_SSEED(st)) 
+
+	case ST_SPFILE:
+	    if (sf == NULL) {
+		call printf ("The spatial density file is not open.\n")
+		call amovkr ((ST_XMIN(st) + ST_XMAX(st)) / 2.0, Memr[x],
+		    ST_NSTARS(st))
+		call amovkr ((ST_YMIN(st) + ST_YMAX(st)) / 2.0, Memr[y],
+		    ST_NSTARS(st))
+	    } else {
+	        nsf = st_gfetchxy (sf, r, rprob)
+	        if (nsf > 0) {
+	            call st_sfsample (Memr[r], Memr[rprob], nsf, Memr[x],
+		        Memr[y], ST_NSTARS(st), ST_NSSAMPLE(st), ST_SORDER(st),
+			ST_XC(st), ST_YC(st), ST_XMIN(st), ST_XMAX(st),
+			ST_YMIN(st), ST_YMAX(st), ST_SSEED(st))
+	        } else {
+		    call printf (
+		        "The spatial density function file is empty.\n")
+		    call amovkr ((ST_XMIN(st) + ST_XMAX(st)) / 2.0, Memr[x],
+		        ST_NSTARS(st))
+		    call amovkr ((ST_YMIN(st) + ST_YMAX(st)) / 2.0, Memr[y],
+		        ST_NSTARS(st))
+	        }
+	        call mfree (r, TY_REAL)
+	        call mfree (rprob, TY_REAL)
+	    }
+
+	default:
+	    call printf ("Unknown spatial density function.\n")
+	}
+end
+
+
+# ST_MKLUM -- Compute the luminosity function.
+
+procedure st_mklum (lf, st, x, y, mag)
+
+int	lf		# luminsosity function file descriptor
+pointer	st		# pointer to starlist structure
+pointer	x		# pointer to the x coordinate array
+pointer	y		# pointer to the y coordinate array
+pointer	mag		# pointer to the magnitude array
+
+int	nlf
+pointer	m, mprob
+int	st_gfetchxy()
+
+begin
+	# Dynamically reallocate the array space.
+	if (x == NULL)
+	    call malloc (x, ST_NSTARS(st), TY_REAL)
+	else
+	    call realloc (x, ST_NSTARS(st), TY_REAL)
+	if (y == NULL)
+	    call malloc (y, ST_NSTARS(st), TY_REAL)
+	else
+	    call realloc (y, ST_NSTARS(st), TY_REAL)
+	if (mag == NULL)
+	    call malloc (mag, ST_NSTARS(st), TY_REAL)
+	else
+	    call realloc (mag, ST_NSTARS(st), TY_REAL)
+
+	# Compute the magnitudes.
+	switch (ST_LUMINOSITY(st)) {
+	case ST_UNIFORM:
+	    call st_maguniform (Memr[mag], ST_NSTARS(st), ST_MINMAG(st),
+	        ST_MAXMAG(st), ST_LSEED(st))
+
+	case ST_POWLAW:
+	    call st_power (Memr[mag], ST_NSTARS(st), ST_POWER(st),
+	        ST_MINMAG(st), ST_MAXMAG(st), ST_LSEED(st))
+
+	case ST_SALPETER:
+	    call st_salpeter (Memr[mag], ST_NSTARS(st),
+	        ST_MINMAG(st), ST_MAXMAG(st), ST_MZERO(st),
+		ST_NLSAMPLE(st), ST_LORDER(st), ST_LSEED(st))
+
+	case ST_BANDS:
+	    call st_bands (Memr[mag], ST_NSTARS(st), ST_ALPHA(st),
+	        ST_BETA(st), ST_DELTA(st), ST_MSTAR(st),
+	        ST_MINMAG(st), ST_MAXMAG(st), ST_MZERO(st),
+		ST_NLSAMPLE(st), ST_LORDER(st), ST_LSEED(st))
+
+	case ST_LFFILE:
+	    if (lf == NULL) {
+		call printf ("The luminosity function file is not open.\n")
+		call amovkr ((ST_MINMAG(st) + ST_MAXMAG(st)) / 2.0, Memr[mag],
+		    ST_NSTARS(st))
+	    } else {
+	        nlf = st_gfetchxy (lf, m, mprob)
+	        if (nlf > 0) {
+	            call st_lfsample (Memr[m], Memr[mprob], nlf, Memr[mag],
+	                ST_NSTARS(st),
+			ST_MINMAG(st), ST_MAXMAG(st),
+		        ST_NLSAMPLE(st), ST_LORDER(st), ST_LSEED(st))
+	        } else {
+		    call printf (
+		    "The luminosity function file is empty.\n")
+		    call amovkr ((ST_MINMAG(st) + ST_MAXMAG(st)) / 2.0,
+		        Memr[mag], ST_NSTARS(st))
+	        }
+	        call mfree (m, TY_REAL)
+	        call mfree (mprob, TY_REAL)
+	    }
+
+	default:
+	    call printf ("The luminosity function is unknown.\n")
+	}
+end
diff --git a/noao/artdata/mk1dspec.par b/noao/artdata/mk1dspec.par
new file mode 100644
index 00000000..3faed74b
--- /dev/null
+++ b/noao/artdata/mk1dspec.par
@@ -0,0 +1,31 @@
+input,s,a,,,,"List of input spectra"
+output,s,h,"",,,"List of output spectra"
+ap,i,h,1,1,,"Image line"
+rv,r,h,0.,,,"Radial velocity (km/s) or redshift"
+z,b,h,no,,,"Is velocity a redshift?
+
+IF NEW SPECTRUM"
+title,s,h,"",,,"Title of spectrum"
+ncols,i,h,512,1,,"Number of columns"
+naps,i,h,1,1,,"Number of lines (apertures)"
+header,f,h,"artdata$stdheader.dat",,,"Image or header keyword file"
+wstart,r,h,4000.,,,"Starting wavelength (Angstroms)"
+wend,r,h,8000.,,,"Ending wavelength (Angstroms)
+
+CONTINUUM"
+continuum,r,h,1000.,,,"Continuum at first pixel"
+slope,r,h,0.,,,"Continuum slope per pixel"
+temperature,r,h,5700.,0.,,"Blackbody temperture (Kelvin)"
+fnu,b,h,no,,,"F-nu or F-lamda?
+
+LINES"
+lines,s,h,"",,,"List of files containing lines"
+nlines,i,h,0,0,,"Number of random lines (if new line list)"
+profile,s,h,"gaussian",|gaussian|lorentzian|voigt,,"Default profile type"
+peak,r,h,-0.5,,,"Default peak strength (relative to continuum)"
+gfwhm,r,h,20.,,,"Default Gaussian FWHM (Angstroms)"
+lfwhm,r,h,20.,,,"Default Lorentzian FWHM (Angstroms)"
+seed,i,h,1,,,"Random number seed
+"
+comments,b,h,yes,,,"Add comments to image?"
+mode,s,h,"ql",,,
diff --git a/noao/artdata/mk2dspec.par b/noao/artdata/mk2dspec.par
new file mode 100644
index 00000000..df78e38a
--- /dev/null
+++ b/noao/artdata/mk2dspec.par
@@ -0,0 +1,10 @@
+input,f,a,"",,,"Input image list"
+output,f,h,"",,,"Input image list"
+models,f,h,"",,,"List of model parameter files"
+comments,b,h,yes,,,"Add comments to image?
+
+IF NEW IMAGE"
+title,s,h,"",,,"Title of spectrum"
+ncols,i,h,100,1,,"Number of columns"
+nlines,i,h,512,1,,"Number of lines"
+header,f,h,"artdata$stdheader.dat",,,"Image or header keyword file"
diff --git a/noao/artdata/mkechelle.par b/noao/artdata/mkechelle.par
new file mode 100644
index 00000000..e312203c
--- /dev/null
+++ b/noao/artdata/mkechelle.par
@@ -0,0 +1,48 @@
+images,s,a,,,,"List of echelle spectra to be created"
+clobber,b,q,no,,,"Modify existing image?"
+ncols,i,h,512,1,,"Number of columns (across dispersion)"
+nlines,i,h,512,1,,"Number of lines (along dispersion)"
+norders,i,h,23,1,,"Number of orders"
+title,s,h,"Artificial Echelle Spectrum",,,"Title of spectrum"
+header,f,h,"artdata$stdheader.dat",,,"Image or header keyword file"
+list,b,h,no,,,"List grating parameters?"
+make,b,h,yes,,,"Make spectra?"
+comments,b,h,yes,,,"Add comments to image?
+
+FORMAT PARAMETERS"
+xc,r,h,INDEF,,,"Blaze peak column (pixel)"
+yc,r,h,INDEF,,,"Blaze peak line (pixel)"
+pixsize,r,h,0.027,,,"Pixel size (mm)"
+profile,s,h,"gaussian","extracted|gaussian|slit",,"Type of order profile"
+width,r,h,5.,0.,,"Width of orders (pixels)"
+scattered,r,h,0.,0.,,"Scattered light peak flux
+
+ECHELLE GRATING PARAMETERS"
+f,r,h,590.,,,"Focal length (mm|pixel)"
+gmm,r,h,31.6,,,"Grooves per mm"
+blaze,r,h,63.,,,"Blaze angle (degrees)"
+theta,r,h,69.,,,"Incidence angle (degrees)"
+order,i,h,112,,,"Reference order"
+wavelength,r,h,5007.49,,,"Blaze wavelength (Angstroms)"
+dispersion,r,h,2.61,,,"Blaze dispersion (Angstroms/(mm|pixel))
+
+CROSSDISPERSER PARAMETERS"
+cf,r,h,590.,,,"Focal length (mm|pixel)"
+cgmm,r,h,226.,,,"Grooves per mm"
+cblaze,r,h,4.53,,,"Blaze angle (degrees)"
+ctheta,r,h,-11.97,,,"Incidence angle (degrees)"
+corder,i,h,1,,,"Order (0 = prism)"
+cwavelength,r,h,6700.,,,"Blaze wavelength (Angstroms)"
+cdispersion,r,h,70.,,,"Blaze dispersion (Angstroms/(mm|pixel))
+
+SPECTRA PARAMETERS"
+rv,r,h,0.,,,"Radial velocity (km/s) or redshift"
+z,b,h,no,,,"Is velocity a redshift?"
+continuum,r,h,1000.,,,"Continuum at reference wavelength"
+temperature,r,h,5700,0.,,"Blackbody temperture (Kelvin)
+"
+lines,s,h,"",,,"List of files containing lines"
+nrandom,i,h,0,0,,"Number of random spectral lines"
+peak,r,h,-0.5,,,"Peak of lines (relative to continuum)"
+sigma,r,h,1.,,,"Sigma of lines (Angstroms)"
+seed,i,h,1,,,"Random number seed"
diff --git a/noao/artdata/mkexamples/archdr.dat b/noao/artdata/mkexamples/archdr.dat
new file mode 100644
index 00000000..b52dcc32
--- /dev/null
+++ b/noao/artdata/mkexamples/archdr.dat
@@ -0,0 +1,19 @@
+OBSERVER= 'IRAF              '  /  observers
+OBSERVAT= 'KPNO              '  /  observatory
+INSTRUME= 'IRAF ARTDATA      '  /  instrument
+TELESCOP= 'kpcdf             '  /  telescope name
+DETECTOR= 'te1k              '  /  detector
+EXPTIME =                  60.  /  actual integration time
+DARKTIME=                  60.  /  total elapsed time
+IMAGETYP= 'comp              '  /  object, dark, bias, etc.
+DATE-OBS= '1991-11-26T12:11:30.00' /  date (dd/mm/yy) of obs.
+UT      = '12:11:30.00       '  /  universal time
+ST      = '09:04:54.00       '  /  sidereal time
+RA      = '06:37:02.00       '  /  right ascension
+DEC     = '06:09:03.00       '  /  declination
+EPOCH   =               1991.9  /  epoch of ra and dec
+ZD      = '48.760            '  /  zenith distance
+AIRMASS =                   0.  /  airmass
+APERTURE= '250micron slit    '  /  aperture
+GRATPOS =               4624.3  /  grating position
+CCDPROC = 'Nov 26  5:44 CCD processing done'
diff --git a/noao/artdata/mkexamples/ecarc.cl b/noao/artdata/mkexamples/ecarc.cl
new file mode 100644
index 00000000..174eba2f
--- /dev/null
+++ b/noao/artdata/mkexamples/ecarc.cl
@@ -0,0 +1,20 @@
+# ecarc - Echelle extracted thorium arc (calibrated)
+
+file	out, hdr
+
+out = s1
+hdr = "mkexamples$archdr.dat"
+i = 10
+
+mkechelle (out, yes, ncols=512, nlines=512, norders=i,
+    title="Artificial Echelle Spectrum", header=hdr,
+    list=no, make=yes, comments=b1, xc=235.5, yc=INDEF, pixsize=0.027,
+    profile="extracted", width=20., scattered=0., f=590., gmm=31.6, blaze=63.,
+    theta=69., order=112, wavelength=5007.49, dispersion=2.61, cf=590.,
+    cgmm=226., cblaze=4.53, ctheta=-11.97, corder=1, cwavelength=6700.,
+    cdispersion=70., rv=0., z=no, continuum=20., temperature=0.,
+    lines="mkexamples$ecthorium.dat", sigma=0.05, >& "dev$null")
+
+mknoise (out, output="", ncols=512, nlines=512, title="", header="",
+    background=0., gain=1., rdnoise=10., poisson=yes, seed=j, cosrays="",
+    ncosrays=0, energy=30000., radius=0.5, ar=1., pa=0., comments=b1)
diff --git a/noao/artdata/mkexamples/ecarc2d.cl b/noao/artdata/mkexamples/ecarc2d.cl
new file mode 100644
index 00000000..8261e84a
--- /dev/null
+++ b/noao/artdata/mkexamples/ecarc2d.cl
@@ -0,0 +1,20 @@
+# ecarc2d - Echelle thorium-argon slit spectrum
+
+file	out, hdr
+
+out = s1
+hdr = "mkexamples$archdr.dat"
+i = 10
+
+mkechelle (out, yes, ncols=512, nlines=512, norders=i,
+    title="Artificial Echelle Spectrum", header=hdr,
+    list=no, make=yes, comments=b1, xc=235.5, yc=INDEF, pixsize=0.027,
+    profile="slit", width=20., scattered=10., f=590., gmm=31.6, blaze=63.,
+    theta=69., order=112, wavelength=5007.49, dispersion=2.61, cf=590.,
+    cgmm=226., cblaze=4.53, ctheta=-11.97, corder=1, cwavelength=6700.,
+    cdispersion=70., rv=0., z=no, continuum=20., temperature=0.,
+    lines="mkexamples$ecthorium.dat", sigma=0.05, >& "dev$null")
+
+mknoise (out, output="", ncols=512, nlines=512, title="", header="",
+    background=0., gain=1., rdnoise=10., poisson=yes, seed=j, cosrays="",
+    ncosrays=0, energy=30000., radius=0.5, ar=1., pa=0., comments=b1)
diff --git a/noao/artdata/mkexamples/ecarcdc.cl b/noao/artdata/mkexamples/ecarcdc.cl
new file mode 100644
index 00000000..d188d52f
--- /dev/null
+++ b/noao/artdata/mkexamples/ecarcdc.cl
@@ -0,0 +1,21 @@
+# ecarcdc - Echelle thorium-argon arc (calibrated)
+
+file	out, hdr
+
+out = s1
+hdr = "mkexamples$archdr.dat"
+i = 10
+
+mkechelle (out, yes, ncols=512, nlines=512, norders=i,
+    title="Artificial Echelle Spectrum", header=hdr,
+    list=no, make=yes, comments=b1, xc=235.5, yc=INDEF, pixsize=0.027,
+    profile="extracted", width=20., scattered=0., f=590., gmm=INDEF,
+    blaze=INDEF, theta=INDEF, order=112, wavelength=5007.49,
+    dispersion=2.61, cf=590., cgmm=226., cblaze=4.53, ctheta=-11.97,
+    corder=1, cwavelength=6700., cdispersion=70., rv=0., z=no,
+    continuum=20., temperature=0., lines="mkexamples$ecthorium.dat",
+    sigma=0.05, >& "dev$null")
+
+mknoise (out, output="", ncols=512, nlines=512, title="", header="",
+    background=0., gain=1., rdnoise=10., poisson=yes, seed=j, cosrays="",
+    ncosrays=0, energy=30000., radius=0.5, ar=1., pa=0., comments=b1)
diff --git a/noao/artdata/mkexamples/echelle.cl b/noao/artdata/mkexamples/echelle.cl
new file mode 100644
index 00000000..4e6dc197
--- /dev/null
+++ b/noao/artdata/mkexamples/echelle.cl
@@ -0,0 +1,22 @@
+# echelle - Echelle absorption spectrum (calibrated)
+
+file	out, hdr
+
+out = s1
+hdr = "mkexamples$objhdr.dat"
+i = 10
+k = 10 * i
+
+mkechelle (out, yes, ncols=512, nlines=512, norders=i,
+    title="Artificial Echelle Spectrum", header=hdr,
+    list=no, make=yes, comments=b1, xc=235.5, yc=INDEF, pixsize=0.027,
+    profile="extracted", width=20., scattered=0., f=590., gmm=INDEF,
+    blaze=INDEF, theta=INDEF, order=112, wavelength=5007.49,
+    dispersion=2.61, cf=590., cgmm=226., cblaze=4.53, ctheta=-11.97,
+    corder=1, cwavelength=6700., cdispersion=70., rv=0., z=no,
+    continuum=1000., temperature=5700., lines="", nrandom=k, peak=-0.5,
+    sigma=0.5, seed=i, >& "dev$null")
+
+mknoise (out, output="", ncols=512, nlines=512, title="", header="",
+    background=0., gain=1., rdnoise=10., poisson=yes, seed=j, cosrays="",
+    ncosrays=0, energy=30000., radius=0.5, ar=1., pa=0., comments=b1)
diff --git a/noao/artdata/mkexamples/ecobj2d.cl b/noao/artdata/mkexamples/ecobj2d.cl
new file mode 100644
index 00000000..303dbb69
--- /dev/null
+++ b/noao/artdata/mkexamples/ecobj2d.cl
@@ -0,0 +1,29 @@
+# ecobj2d - Echelle object slit spectrum
+
+file	out, hdr
+
+out = s1
+hdr = "mkexamples$objhdr.dat"
+i = 10
+
+mkechelle (out, yes, ncols=512, nlines=512, norders=i,
+    title="Artificial Echelle Spectrum", header=hdr,
+    list=no, make=yes, comments=b1, xc=235.5, yc=INDEF, pixsize=0.027,
+    profile="gaussian", width=4., scattered=25., f=590., gmm=31.6, blaze=63.,
+    theta=69., order=112, wavelength=5007.49, dispersion=2.61, cf=590.,
+    cgmm=226., cblaze=4.53, ctheta=-11.97, corder=1, cwavelength=6700.,
+    cdispersion=70., rv=0., z=no, continuum=500., temperature=7700.,
+    lines="", nrandom=500, peak=-0.5, sigma=0.5, seed=i, >& "dev$null")
+
+mkechelle (out, yes, ncols=512, nlines=512, norders=i,
+    title="Artificial Echelle Spectrum", header="",
+    list=no, make=yes, comments=b1, xc=235.5, yc=INDEF, pixsize=0.027,
+    profile="slit", width=20., scattered=10., f=590., gmm=31.6, blaze=63.,
+    theta=69., order=112, wavelength=5007.49, dispersion=2.61, cf=590.,
+    cgmm=226., cblaze=4.53, ctheta=-11.97, corder=1, cwavelength=6700.,
+    cdispersion=70., rv=0., z=no, continuum=200., temperature=5700.,
+    lines="", nrandom=20, peak=5.0, sigma=0.1, seed=i+1, >& "dev$null")
+
+mknoise (out, output="", ncols=512, nlines=512, title="", header="",
+    background=0., gain=1., rdnoise=10., poisson=yes, seed=j, cosrays="",
+    ncosrays=0, energy=30000., radius=0.5, ar=1., pa=0., comments=b1)
diff --git a/noao/artdata/mkexamples/ecthorium.dat b/noao/artdata/mkexamples/ecthorium.dat
new file mode 100644
index 00000000..2624bca7
--- /dev/null
+++ b/noao/artdata/mkexamples/ecthorium.dat
@@ -0,0 +1,655 @@
+4588.4273 65.5462
+4589.8978 784.211
+4592.666 56.8004
+4593.6437 4.85515
+4595.4206 222.271
+4596.0967 64.2832
+4596.3078 7.56086
+4598.7621 119.88
+4603.1444 15.7948
+4607.9347 11.4279
+4608.6218 11.6267
+4609.372 7.02327
+4609.5673 1221.28
+4611.2433 5.10087
+4612.5435 4.90891
+4613.6044 17.7617
+4615.024 10.0449
+4615.3351 17.7089
+4619.4794 6.41386
+4621.1629 18.3723
+4624.314 6.47323
+4627.2973 9.49829
+4628.1991 16.5995
+4628.4409 35.8668
+4631.6382 7.29758
+4633.7628 18.198
+4637.233 85.9085
+4637.629 3.94716
+4638.6849 26.9969
+4640.0462 6.61454
+4641.2418 8.27625
+4644.7072 4.26447
+4646.6861 10.9471
+4647.2546 26.3496
+4650.2343 17.455
+4650.9195 4.13841
+4651.9895 6.17074
+4655.2088 5.39692
+4657.9041 836.603
+4659.5698 5.48127
+4663.2026 61.9759
+4666.0027 16.1667
+4666.5155 40.8868
+4666.7985 47.1163
+4668.172 81.6867
+4669.9853 117.237
+4673.0535 5.4883
+4673.6621 545.703
+4676.0555 82.2877
+4676.133 4.29782
+4680.2377 5.75225
+4680.646 5.52363
+4683.353 30.5339
+4686.1946 153.856
+4689.2523 41.9807
+4690.6219 49.3453
+4691.3452 8.5765
+4691.6354 46.0446
+4694.0914 54.4282
+4694.9323 12.2334
+4695.0381 168.923
+4695.4542 13.1503
+4700.7837 4.93863
+4702.3161 93.1766
+4703.3581 10.2278
+4703.9898 817.83
+4705.7606 21.5926
+4706.2383 3.97915
+4708.294 31.0609
+4708.5366 9.58955
+4712.4814 53.4481
+4712.8408 15.1739
+4715.4308 4.88338
+4719.9888 4.53178
+4720.4586 13.3998
+4721.2765 33.1405
+4721.591 22.633
+4722.0886 44.4139
+4723.4398 734.51
+4723.784 64.7118
+4726.8705 1064.39
+4728.133 6.98479
+4729.1293 92.2413
+4729.8795 7.27099
+4730.6614 5.23277
+4732.0532 180.301
+4735.9079 506.782
+4739.6764 45.7522
+4740.5292 63.9671
+4740.9585 48.6428
+4741.2967 14.9477
+4742.1174 17.1227
+4742.5535 5.73107
+4743.6923 23.7768
+4745.3322 16.1008
+4746.8239 3.38238
+4748.04 4.84055
+4749.2002 121.145
+4749.7935 9.05726
+4749.9713 47.3657
+4752.4141 99.979
+4757.2196 10.6699
+4761.1101 8.57456
+4764.3463 78.5935
+4764.8646 2661.86
+4765.5959 28.4925
+4766.6006 135.507
+4768.6814 12.8589
+4773.241 13.2449
+4774.2607 35.9558
+4775.313 14.2325
+4775.794 17.3488
+4777.1933 14.2463
+4778.297 563.167
+4779.7306 15.7418
+4780.422 10.1095
+4780.7505 8.35713
+4781.526 6.25546
+4782.7608 11.4082
+4783.8617 23.7332
+4784.0396 9.64609
+4786.1434 3.9864
+4786.531 31.3448
+4787.1476 53.7384
+4789.3868 271.327
+4792.0819 9.75035
+4793.2446 20.983
+4795.9131 29.3319
+4800.1741 10.6862
+4805.6064 6.48416
+4806.0205 1231.64
+4808.1351 498.92
+4809.6161 150.796
+4812.3755 16.1879
+4813.0075 18.7566
+4813.7204 51.2083
+4813.8963 88.0909
+4817.0206 7.78436
+4818.6458 7.23017
+4819.193 19.4464
+4819.5674 3.51181
+4820.4649 13.8117
+4820.8847 93.4916
+4821.2631 4.19723
+4821.385 7.22092
+4821.5878 111.817
+4821.8592 4.93727
+4822.8548 294.935
+4823.1692 8.09662
+4823.6058 110.695
+4823.9967 56.2398
+4826.7004 149.96
+4829.7973 18.3661
+4831.1225 423.617
+4831.5975 126.894
+4832.8029 71.37
+4833.8317 4.28069
+4840.4744 26.8947
+4840.8492 521.946
+4843.9395 65.1344
+4844.1653 12.8414
+4845.1626 32.4845
+4847.3208 7.04908
+4847.8095 577.432
+4847.9985 17.7145
+4848.3646 300.478
+4849.1429 27.1511
+4849.8617 28.7808
+4850.4408 55.1639
+4852.8696 40.0447
+4858.3344 15.3578
+4861.2167 44.0273
+4861.7173 34.9526
+4863.1724 227.657
+4865.4775 441.647
+4865.91 91.5246
+4867.5558 12.5734
+4868.5254 4.98434
+4868.8814 47.874
+4871.289 48.0372
+4872.0309 6.36617
+4872.9169 292.235
+4874.3662 116.992
+4876.2611 46.5136
+4876.4923 19.5098
+4877.0035 8.01475
+4877.8121 13.1595
+4878.0106 127.864
+4878.7344 565.658
+4879.3501 9.17893
+4879.8635 2699.79
+4880.8509 7.95572
+4881.2046 54.3629
+4881.8531 10.9968
+4882.2455 36.8137
+4887.9516 42.1399
+4889.0422 412.134
+4889.4903 19.0889
+4890.4582 20.1678
+4892.7592 24.1195
+4893.4436 15.9623
+4894.6906 16.6734
+4894.957 1132.26
+4898.4563 4.74024
+4898.8044 4.04661
+4899.2441 20.2471
+4902.0556 68.2129
+4902.7943 19.836
+4904.7533 127.776
+4907.2093 6.81641
+4909.8328 4.27015
+4910.1576 51.7022
+4910.7929 26.4061
+4911.3787 23.3431
+4912.5293 30.4426
+4919.8157 381.301
+4920.0226 45.5284
+4921.6134 25.5825
+4922.938 7.03937
+4924.4223 10.6983
+4925.9501 11.3703
+4927.298 9.44349
+4927.7803 74.3743
+4929.086 12.2534
+4929.9754 5.72947
+4932.0473 11.9265
+4933.2136 214.685
+4933.8521 14.704
+4936.7746 57.1255
+4937.8295 95.4003
+4938.5071 19.9503
+4939.2703 6.0869
+4939.6422 301.318
+4941.416 5.25372
+4943.0642 168.915
+4945.4614 456.276
+4946.6637 44.9907
+4947.5751 22.4592
+4949.4037 4.26514
+4950.2513 13.8656
+4950.6264 33.1245
+4952.6953 11.0807
+4954.6546 11.0296
+4955.1204 7.72677
+4956.7647 15.5955
+4957.2963 8.85339
+4958.0988 9.11654
+4960.4279 14.3728
+4961.726 24.3599
+4963.1881 7.4831
+4963.7664 6.96135
+4964.1157 8.74783
+4964.2533 4.31933
+4965.0812 1356.08
+4965.7315 71.1095
+4968.7556 21.4262
+4970.0766 30.2119
+4972.1597 95.446
+4973.398 8.93496
+4975.9439 3.991
+4980.1859 57.2975
+4980.9513 11.0146
+4982.4875 99.3208
+4985.3725 251.563
+4985.9469 6.5111
+4987.1505 11.3022
+4987.5582 9.65165
+4989.3086 78.4742
+4989.9557 6.99063
+4992.1257 6.07045
+4992.6372 5.15659
+4993.7488 38.5607
+4994.1058 11.8688
+4997.7993 3.54205
+4999.9398 6.91979
+5000.2516 5.5321
+5002.0972 624.716
+5003.6785 99.5414
+5009.3344 351.003
+5009.9424 7.14161
+5010.9532 6.36927
+5011.4774 4.75069
+5015.8892 19.6963
+5016.5356 11.4415
+5017.1673 698.923
+5017.5084 36.3313
+5017.6235 10.7912
+5018.0568 8.5097
+5019.3336 8.20173
+5019.8062 151.717
+5020.5335 4.04989
+5021.2531 4.14241
+5022.0051 33.1907
+5022.1698 11.5854
+5023.7059 12.9307
+5026.9532 3.96646
+5028.6556 325.768
+5029.0102 9.39148
+5029.6295 5.87679
+5029.8916 84.2817
+5035.3516 2.98555
+5039.2303 360.229
+5039.5265 19.1678
+5040.5393 6.15313
+5040.6805 10.461
+5041.1224 18.8219
+5041.5971 6.75403
+5043.5131 9.80939
+5044.7195 678.079
+5045.2481 89.4546
+5046.3518 13.9731
+5046.6372 8.14425
+5047.0434 191.836
+5048.8139 30.8297
+5048.9354 35.1897
+5049.5543 8.69854
+5049.796 240.343
+5050.7842 203.828
+5051.8887 76.8459
+5054.1776 19.4488
+5055.3473 69.0541
+5056.5358 3.91915
+5057.9866 43.4318
+5059.8611 118.26
+5060.0871 36.3014
+5061.2199 9.60687
+5061.6562 41.2795
+5062.0395 408.861
+5062.9325 18.4902
+5063.5157 40.647
+5063.9988 33.0461
+5064.602 265.528
+5064.9463 369.346
+5066.1355 57.7505
+5066.7773 29.6794
+5067.1371 24.0714
+5067.9737 968.248
+5069.3384 10.6411
+5073.0746 9.28652
+5074.6637 4.94064
+5077.7903 221.971
+5081.4462 36.1646
+5084.6987 5.1124
+5084.9935 20.9643
+5087.1131 7.51694
+5090.0513 10.254
+5090.5148 191.383
+5095.0639 20.4182
+5096.4848 193.562
+5098.0432 32.5449
+5098.932 11.7805
+5100.6211 223.131
+5101.1299 43.7184
+5101.3395 2.88295
+5109.7207 5.92458
+5110.5493 7.00854
+5110.8709 7.06356
+5111.2781 56.3139
+5115.0477 467.92
+5116.3016 4.97391
+5117.2923 10.4614
+5118.205 18.4299
+5122.4995 18.2438
+5125.4895 15.4357
+5125.9502 109.096
+5126.279 6.87144
+5128.4906 54.4392
+5130.2338 4.79469
+5131.0699 7.36472
+5133.1051 6.47732
+5134.746 110.644
+5136.121 4.46243
+5137.4733 29.6407
+5140.7736 45.7047
+5141.7827 335.653
+5143.2673 55.4042
+5143.9165 128.674
+5145.3083 191.136
+5146.0544 8.24467
+5148.2087 18.9162
+5149.207 9.03956
+5150.7064 4.93751
+5151.612 422.456
+5151.858 9.02414
+5154.243 378.949
+5158.6059 1084.03
+5159.4574 5.80872
+5159.6246 14.2469
+5160.7163 83.4544
+5161.5396 95.0381
+5162.2892 207.227
+5162.7493 10.0091
+5163.4604 233.684
+5165.066 4.84967
+5165.7728 37.3169
+5166.6553 7.52561
+5168.9225 21.3244
+5170.2227 3.38792
+5173.0794 17.3811
+5173.6757 25.3887
+5174.2217 4.48851
+5174.7988 12.5656
+5175.3248 46.0539
+5175.9115 14.3605
+5176.2292 30.8526
+5176.4037 24.8192
+5176.961 228.93
+5177.6228 30.8468
+5178.4726 6.05432
+5180.7209 3.79134
+5182.5269 9.67873
+5183.0965 6.48001
+5183.9896 13.7039
+5184.4541 16.2505
+5186.4132 20.5776
+5187.1693 9.6076
+5187.3374 80.8798
+5187.4583 11.2173
+5187.7491 277.819
+5190.872 19.9127
+5191.3463 3.51862
+5193.8256 39.5266
+5193.9316 6.88467
+5194.4576 80.7526
+5197.2361 7.67376
+5198.7999 130.392
+5199.1637 605.975
+5201.9993 8.19701
+5203.8474 10.9719
+5205.1522 29.1488
+5206.6722 4.99346
+5207.8015 5.52073
+5209.7246 76.0411
+5210.492 6.73147
+5211.2343 435.898
+5213.3492 103.41
+5214.7867 14.0768
+5215.6977 18.0725
+5216.6014 42.831
+5218.5271 11.4526
+5219.1137 181.613
+5220.7068 11.6886
+5220.9301 24.6622
+5221.271 89.5286
+5221.8618 5.7256
+5228.2246 28.1778
+5228.9951 6.50876
+5231.1597 1030.95
+5233.2254 25.7881
+5234.1087 13.1727
+5238.8137 112.491
+5239.552 108.328
+5240.1968 32.4576
+5245.3797 5.56783
+5247.1977 20.5721
+5247.6548 133.966
+5250.8771 17.9253
+5254.2588 12.0692
+5254.4699 12.9062
+5258.3602 414.673
+5260.1041 61.1699
+5261.472 18.3194
+5264.7865 9.64064
+5266.7145 215.526
+5267.1597 5.01696
+5272.927 29.2593
+5273.1317 9.19802
+5274.1188 69.5206
+5277.1433 14.8433
+5277.5002 22.9387
+5278.1166 40.8362
+5280.3546 7.23929
+5281.069 53.1053
+5281.6257 8.22585
+5286.887 11.7575
+5289.8929 4.02498
+5294.3997 36.0776
+5295.7567 40.0391
+5296.2811 50.8073
+5297.7431 67.7718
+5298.2824 62.5283
+5300.5234 34.4504
+5301.3968 4.29366
+5303.4845 9.75274
+5305.699 10.4784
+5306.9963 9.24972
+5307.4632 10.0681
+5309.5983 4.18063
+5310.2665 23.0678
+5312.0063 273.93
+5312.5288 106.566
+5312.9045 58.8661
+5315.2278 5.62052
+5317.4983 42.7434
+5320.7757 8.43051
+5325.1438 10.8274
+5326.2774 26.3838
+5326.9756 139.316
+5329.3745 10.7514
+5329.7088 6.99339
+5330.0804 20.0113
+5340.4982 7.20135
+5343.5812 484.175
+5345.3079 4.87436
+5347.9714 27.1696
+5351.1294 27.9601
+5351.8297 7.16019
+5354.6016 10.7326
+5355.6465 8.3333
+5358.3826 13.1422
+5359.8269 8.53931
+5360.1501 53.6849
+5361.1593 12.9852
+5362.5751 24.8142
+5369.2819 22.9514
+5369.447 24.2969
+5370.7096 21.5016
+5372.7067 15.7941
+5373.4943 8.9765
+5374.8219 65.5878
+5375.3587 20.0024
+5375.7688 5.72737
+5376.1304 6.71117
+5376.7809 19.7164
+5378.8349 44.3788
+5379.1105 92.3125
+5382.9276 12.0274
+5384.0356 10.4107
+5384.3682 4.78892
+5386.6148 178.392
+5387.8266 3.94538
+5388.0507 10.9853
+5390.4375 108.219
+5392.5726 25.4667
+5393.6047 3.81093
+5393.9744 31.1239
+5394.7608 173.502
+5397.5144 13.2397
+5398.2047 5.77056
+5398.7015 46.0962
+5398.9219 28.3115
+5399.1745 46.9412
+5399.6218 7.48724
+5400.1455 6.34557
+5402.6048 15.4506
+5403.1993 8.38744
+5407.6535 119.875
+5410.4885 8.56801
+5410.7687 119.322
+5415.5226 45.915
+5417.4926 350.868
+5419.1234 4.06181
+5421.3517 35.6623
+5421.8359 8.0436
+5424.0079 60.1299
+5425.6783 33.8477
+5426.4141 11.7312
+5431.112 141.196
+5435.1229 4.50729
+5435.892 13.6085
+5437.3877 10.8337
+5438.1488 7.10681
+5439.9891 29.8005
+5440.6015 21.9521
+5442.2477 6.35966
+5443.2326 17.9646
+5443.6938 7.1111
+5447.1536 13.7033
+5449.4733 14.3251
+5451.652 105.803
+5452.2187 132.988
+5454.3015 13.2046
+5457.2985 12.3395
+5457.7973 5.71497
+5461.7402 6.77458
+5462.6057 6.94785
+5464.2123 83.3744
+5467.1465 7.21199
+5469.0844 4.43358
+5470.7591 40.2228
+5473.4541 14.1218
+5479.0751 15.313
+5484.1367 8.1378
+5488.6363 14.6626
+5488.9151 8.21965
+5489.0833 5.74745
+5490.1267 4.08873
+5492.3362 11.3461
+5493.2043 35.802
+5494.3327 41.7922
+5495.8738 274.697
+5496.1382 96.6002
+5498.175 9.52024
+5499.2567 644.75
+5499.6461 26.91
+5500.3125 4.43996
+5501.2784 15.8737
+5501.9367 7.14131
+5504.3018 114.524
+5506.1152 55.5132
+5506.9034 5.49701
+5507.5376 26.0302
+5507.7676 4.82248
+5508.5564 12.7312
+5509.9938 158.421
+5514.8721 102.678
+5518.9841 15.0484
+5519.2615 5.45086
+5524.5824 27.0831
+5524.957 24.5668
+5527.3022 13.4549
+5528.2376 12.4776
+5533.2452 8.99002
+5534.4989 7.95551
+5535.9572 5.60565
+5537.1194 5.84807
+5537.5563 15.7154
+5538.608 23.1786
+5539.2614 388.735
+5539.9104 65.4704
+5539.933 78.3845
+5541.1446 17.2482
+5541.5833 12.5174
+5541.94 3.13988
+5542.8911 66.4701
+5546.122 4.80963
+5548.1774 189.504
+5551.3701 12.0377
+5552.6221 14.6156
+5554.0219 29.5953
+5554.1319 6.26146
+5555.5278 8.09759
+5557.0459 149.272
+5558.3407 206.791
+5558.702 263.229
+5559.6677 11.9343
+5559.8912 48.3765
+5567.9986 17.0399
+5570.9235 11.7199
+5571.1937 136.006
+5572.4866 145.08
+5573.3535 302.095
+5576.2053 63.5346
+5577.689 25.2927
+5578.5506 4.47167
+5579.3594 168.85
+5580.0795 14.7368
+5580.7436 5.80429
+5581.8644 7.58005
+5582.8565 6.70252
+5583.7635 13.0022
+5587.026 752.61
+5588.7244 16.4156
+5593.2794 2.48508
+5593.6193 28.1029
diff --git a/noao/artdata/mkexamples/galcluster.cl b/noao/artdata/mkexamples/galcluster.cl
new file mode 100644
index 00000000..8a6e1e7f
--- /dev/null
+++ b/noao/artdata/mkexamples/galcluster.cl
@@ -0,0 +1,39 @@
+# GALCLUSTER - Galaxy cluster
+
+file	image, dat
+
+image = s1
+dat = mktemp ("art")
+
+gallist (dat, 100, interactive=no, spatial="hubble", xmin=1., xmax=512.,
+    ymin=1., ymax=512., xcenter=INDEF, ycenter=INDEF, core_radius=50.,
+    base=0., sseed=i+1, luminosity="schecter", minmag=-7., maxmag=0.,
+    mzero=15., power=0.6, alpha=-1.24, mstar=-21.41, lseed=i+1, egalmix=0.8,
+    ar=0.7, eradius=20., sradius=1., absorption=1.2, z=0.05, sfile="",
+    nssample=100, sorder=10, lfile="", nlsample=100, lorder=10,
+    rbinsize=10., mbinsize=0.5, dbinsize=0.5, ebinsize=0.1, pbinsize=20.,
+    graphics="stdgraph", cursor="")
+
+gallist (dat, 500, interactive=no, spatial="uniform", xmin=1.,
+    xmax=512., ymin=1., ymax=512., xcenter=INDEF, ycenter=INDEF,
+    core_radius=50., base=0., sseed=i+1, luminosity="powlaw", minmag=-7.,
+    maxmag=0., mzero=15., power=0.6, alpha=-1.24, mstar=-21.41, lseed=i+1,
+    egalmix=0.4, ar=0.7, eradius=20., sradius=1., absorption=1.2, z=0.05,
+    sfile="", nssample=100, sorder=10, lfile="", nlsample=100, lorder=10,
+    rbinsize=10., mbinsize=0.5, dbinsize=0.5, ebinsize=0.1, pbinsize=20.,
+    graphics="stdgraph", cursor="")
+
+starlist (dat, 100, "", "", interactive=no, spatial="uniform", xmin=1.,
+    xmax=512., ymin=1., ymax=512., xcenter=INDEF, ycenter=INDEF,
+    core_radius=30., base=0., sseed=i, luminosity="powlaw", minmag=-7.,
+    maxmag=0., mzero=-4., power=0.6, alpha=0.74, beta=0.04, delta=0.294,
+    mstar=1.28, lseed=i, nssample=100, sorder=10, nlsample=100, lorder=10,
+    rbinsize=10., mbinsize=0.5, graphics="stdgraph", cursor="")
+
+mkobjects (image, output="", ncols=512, nlines=512,
+    title="Example artificial galaxy cluster", header="artdata$stdheader.dat",
+    background=1000., objects=dat, xoffset=0., yoffset=0., star="moffat",
+    radius=1.0, beta=2.5, ar=1., pa=0., distance=1., exptime=1., magzero=7.,
+    gain=3., rdnoise=10., poisson=yes, seed=j, comments=b1)
+
+delete (dat, verify=no)
diff --git a/noao/artdata/mkexamples/galfield.cl b/noao/artdata/mkexamples/galfield.cl
new file mode 100644
index 00000000..168972fe
--- /dev/null
+++ b/noao/artdata/mkexamples/galfield.cl
@@ -0,0 +1,30 @@
+# GALFIELD - Uniform galaxy field
+
+file	image, dat
+
+image = s1
+dat = mktemp ("art")
+
+gallist (dat, 1000, interactive=no, spatial="uniform", xmin=1.,
+    xmax=512., ymin=1., ymax=512., xcenter=INDEF, ycenter=INDEF,
+    core_radius=50., base=0., sseed=i+1, luminosity="powlaw", minmag=-7.,
+    maxmag=0., mzero=15., power=0.45, alpha=-1.24, mstar=-21.41, lseed=i+1,
+    egalmix=0.4, ar=0.7, eradius=10., sradius=1., absorption=1.2, z=0.05,
+    sfile="", nssample=100, sorder=10, lfile="", nlsample=100, lorder=10,
+    rbinsize=10., mbinsize=0.5, dbinsize=0.5, ebinsize=0.1, pbinsize=20.,
+    graphics="stdgraph", cursor="")
+
+starlist (dat, 100, "", "", interactive=no, spatial="uniform", xmin=1.,
+    xmax=512., ymin=1., ymax=512., xcenter=INDEF, ycenter=INDEF,
+    core_radius=30., base=0., sseed=i, luminosity="powlaw", minmag=-7.,
+    maxmag=0., mzero=-4., power=0.6, alpha=0.74, beta=0.04, delta=0.294,
+    mstar=1.28, lseed=i, nssample=100, sorder=10, nlsample=100, lorder=10,
+    rbinsize=10., mbinsize=0.5, graphics="stdgraph", cursor="")
+
+mkobjects (image, output="", ncols=512, nlines=512,
+    title="Example artificial galaxy field", header="artdata$stdheader.dat",
+    background=400., objects=dat, xoffset=0., yoffset=0., star="moffat",
+    radius=1.0, beta=2.5, ar=1., pa=0., distance=1., exptime=1., magzero=5.5,
+    gain=5., rdnoise=10., poisson=yes, seed=j, comments=b1)
+
+delete (dat, verify=no)
diff --git a/noao/artdata/mkexamples/globular.cl b/noao/artdata/mkexamples/globular.cl
new file mode 100644
index 00000000..f70f3f1e
--- /dev/null
+++ b/noao/artdata/mkexamples/globular.cl
@@ -0,0 +1,23 @@
+# GLOBULAR - Globular cluster
+
+file	image, dat
+
+image = s1
+dat = mktemp ("art")
+
+starlist (dat, 5000, "", "", interactive=no, spatial="hubble",
+    xmin=1., xmax=512., ymin=1., ymax=512., xcenter=INDEF,
+    ycenter=INDEF, core_radius=30., base=0., sseed=i,
+    luminosity="bands", minmag=-7., maxmag=0., mzero=-4., power=0.6,
+    alpha=0.74, beta=0.04, delta=0.294, mstar=1.28, lseed=i,
+    nssample=100, sorder=10, nlsample=100, lorder=10,
+    rbinsize=10., mbinsize=0.5, graphics="stdgraph", cursor="")
+
+mkobjects (image, output="", ncols=512, nlines=512,
+    title="Example artificial globular cluster",
+    header="artdata$stdheader.dat", background=1000., objects=dat,
+    xoffset=0., yoffset=0., star="moffat", radius=1.0, beta=2.5,
+    ar=1., pa=0., distance=1., exptime=1., magzero=7.,
+    gain=3., rdnoise=10., poisson=yes, seed=j, comments=b1)
+
+delete (dat, verify=no)
diff --git a/noao/artdata/mkexamples/henear.cl b/noao/artdata/mkexamples/henear.cl
new file mode 100644
index 00000000..cec48b98
--- /dev/null
+++ b/noao/artdata/mkexamples/henear.cl
@@ -0,0 +1,20 @@
+# henear - Helium-Neon-Argon spectrum (uncalibrated)
+
+file	out, hdr
+
+out = s1
+hdr = "mkexamples$archdr.dat"
+
+for (k=1; k<=i; k+=1) {
+    mk1dspec (out, output="", ap=k, rv=0., z=no, ncols=512, naps=i,
+	wstart=4209.0+k, wend=7361.7+k, title="Helium-Neon-Argon Arc Example",
+	header="", continuum=0.5, slope=0., temperature=0.,
+	lines="mkexamples$henear2.dat", profile="gaussian", gfwhm=14,
+	comments=b1)
+}
+
+mkheader (out, hdr, append=no, verbose=no)
+
+mknoise (out, output="", ncols=512, nlines=512, title="", header="",
+    background=0., gain=1., rdnoise=10., poisson=yes, seed=j, cosrays="",
+    ncosrays=0, energy=30000., radius=0.5, ar=1., pa=0., comments=b1)
diff --git a/noao/artdata/mkexamples/henear1.dat b/noao/artdata/mkexamples/henear1.dat
new file mode 100644
index 00000000..6dfd4bdf
--- /dev/null
+++ b/noao/artdata/mkexamples/henear1.dat
@@ -0,0 +1,56 @@
+# HENEAR TRUE WAVELENGTHS
+4259.361 456.992 
+4300.4 151.516 
+4426.01 304.683 
+4471.477 808.484 
+4510.733 197.966 
+4545.08 371.968 
+4579.39 334.567 
+4657.94 269.339 
+4713.143 365.173 
+4764.89 628.846 
+4806.07 308.678 
+4879.9 418.101 
+4921.929 644.809 
+4965.12 234.898 
+5015.675 2573.67 
+5187.746 292.801 
+5221.27 193.722 
+5400.562 326.122 
+5495.872 454.027 
+5572.548 335.12 
+5606.732 326.878 
+5650.703 283.252 
+5748.299 224.797 
+5764.418 269.445 
+5852.4878 20334.6 
+5875.618 15259.1 
+5944.8342 2891.43 
+6029.9971 1970.72 
+6074.3377 2573.29 
+6096.163 4871.86 
+6143.0623 7662.59 
+6163.5939 2296.45 
+6217.2813 1579.43 
+6266.495 4593.41 
+6304.7892 1604.55 
+6334.4279 3425.67 
+6382.9914 6427.61 
+6402.246 10708.7 
+6506.5279 6053.5 
+6532.8824 2271.5 
+6598.9529 3574.04 
+6678.2 30911.1 
+6717.0428 4317.68 
+6752.832 3451.33 
+6871.29 2877.43 
+6929.468 5863.05 
+6965.43 35198.7 
+7032.4127 14128.7 
+7065.188 32334.6 
+7107.496 1037.61 
+7147.041 3887.49 
+7173.939 1277.6 
+7206.986 1433.43 
+7245.167 4155.93 
+7281.349 11982.2 
diff --git a/noao/artdata/mkexamples/henear1d.cl b/noao/artdata/mkexamples/henear1d.cl
new file mode 100644
index 00000000..2595ad6a
--- /dev/null
+++ b/noao/artdata/mkexamples/henear1d.cl
@@ -0,0 +1,4 @@
+# HENEAR1D - 1D Helium-Neon-Argon Arc Spectrum
+
+i = 1
+cl < "mkexamples$henear.cl"
diff --git a/noao/artdata/mkexamples/henear2.dat b/noao/artdata/mkexamples/henear2.dat
new file mode 100644
index 00000000..a8fb3236
--- /dev/null
+++ b/noao/artdata/mkexamples/henear2.dat
@@ -0,0 +1,56 @@
+# HENEAR WAVELENGTHS WITH 10A QUADRATIC DISPERSION FUNCTION
+4268.73 456.992 
+4309.26 151.516 
+4433.41 304.683 
+4478.38 808.484 
+4517.22 197.966 
+4551.22 371.968 
+4585.18 334.567 
+4662.99 269.339 
+4717.69 365.173 
+4769.00 628.846 
+4809.85 308.678 
+4883.11 418.101 
+4924.84 644.809 
+4967.74 234.898 
+5017.97 2573.67 
+5189.10 292.801 
+5222.47 193.722 
+5401.09 326.122 
+5496.16 454.027 
+5572.69 335.12 
+5606.83 326.878 
+5650.75 283.252 
+5748.30 224.797 
+5764.42 269.445 
+5852.53 20334.6 
+5875.68 15259.1 
+5944.98 2891.43 
+6030.31 1970.72 
+6074.76 2573.29 
+6096.65 4871.86 
+6143.69 7662.59 
+6164.29 2296.45 
+6218.17 1579.43 
+6267.58 4593.41 
+6306.05 1604.55 
+6335.83 3425.67 
+6384.63 6427.61 
+6403.99 10708.7 
+6508.88 6053.5 
+6535.40 2271.5 
+6601.92 3574.04 
+6681.75 30911.1 
+6720.90 4317.68 
+6756.98 3451.33 
+6876.49 2877.43 
+6935.22 5863.05 
+6971.54 35198.7 
+7039.22 14128.7 
+7072.35 32334.6 
+7115.13 1037.61 
+7155.13 3887.49 
+7182.34 1277.6 
+7215.79 1433.43 
+7254.44 4155.93 
+7291.07 11982.2 
diff --git a/noao/artdata/mkexamples/heneardc.cl b/noao/artdata/mkexamples/heneardc.cl
new file mode 100644
index 00000000..8e1ab75f
--- /dev/null
+++ b/noao/artdata/mkexamples/heneardc.cl
@@ -0,0 +1,18 @@
+# heneardc - Helium-Neon-Argon spectrum (calibrated)
+
+file	out, hdr
+
+out = s1
+hdr = "mkexamples$archdr.dat"
+
+for (k=1; k<=i; k+=1) {
+    mk1dspec (out, output="", ap=k, rv=0., z=no, ncols=512, naps=i,
+	wstart=4210.0, wend=7362.7, title="Helium-Neon-Argon Arc Example",
+	header=hdr, continuum=0.5, slope=0., temperature=0.,
+	lines="mkexamples$henear1.dat", profile="gaussian",
+	gfwhm=14, comments=b1)
+}
+
+mknoise (out, output="", ncols=512, nlines=512, title="", header="",
+    background=0., gain=1., rdnoise=10., poisson=yes, seed=j, cosrays="",
+    ncosrays=0, energy=30000., radius=0.5, ar=1., pa=0., comments=b1)
diff --git a/noao/artdata/mkexamples/longslit.cl b/noao/artdata/mkexamples/longslit.cl
new file mode 100644
index 00000000..5be43bcd
--- /dev/null
+++ b/noao/artdata/mkexamples/longslit.cl
@@ -0,0 +1,77 @@
+# LONGSLIT - Long slit example
+
+real	w1, w2
+file	out, obj, bkg, dat, hdr
+
+out = s1
+hdr = s2
+obj = mktemp ("art")
+bkg = mktemp ("art")
+dat = mktemp ("art")
+
+w1 = 4209 + i
+w2 = 7361 + i
+
+if (i == 2) {		# Featureless hot continuum + sky
+    mk1dspec (obj, output="", ap=1, rv=0., z=no, title="", header="",
+	ncols=512, naps=1, wstart=w1, wend=w2, continuum=1000., slope=0.,
+	temperature=10000., lines="", nlines=0, peak=-0.5, profile="gaussian",
+	gfwhm=23.5, seed=1, comments=b1)
+    mk1dspec (bkg, output="", ap=1, rv=0., z=no, title="", header="",
+	ncols=512, naps=1, wstart=w1, wend=w2, continuum=1000., slope=0.,
+	temperature=5800., lines="", nlines=20, peak=1., profile="gaussian",
+	gfwhm=12, seed=1, comments=b1)
+    print (obj, " 1 gauss 3 0 50 .002", > dat)
+    print (bkg, " 10 slit 90 0 50 0", >> dat)
+} else if (i == 3) {	# Sky only
+    mk1dspec (bkg, output="", ap=1, rv=0., z=no, title="", header="",
+	ncols=512, naps=1, wstart=w1, wend=w2, continuum=1000., slope=0.,
+	temperature=5800., lines="", nlines=20, peak=1., profile="gaussian",
+	gfwhm=12, seed=1, comments=b1)
+    print (bkg, " 10 slit 90 0 50 0", > dat)
+} else if (i == 4) {	# Flat field
+    mk1dspec (bkg, output="", ap=1, rv=0., z=no, title="", header="",
+	ncols=512, naps=1, wstart=w1, wend=w2, continuum=1000., slope=0.,
+	temperature=8000., lines="", nlines=0, peak=-0.5, profile="gaussian",
+	gfwhm=23.5, seed=1, comments=b1)
+    print (bkg, " 10 slit 90 0 50 0", > dat)
+} else if (i == 5) {	# HE-NE-AR
+    mk1dspec (bkg, output="", ap=1, rv=0., z=no, title="", header="",
+	ncols=512, naps=1, wstart=w1, wend=w2, continuum=0.5, slope=0.,
+	temperature=0., lines="mkexamples$henear2.dat", profile="gaussian",
+	gfwhm=14, comments=b1)
+    print (bkg, " 100 slit 90 0 50 0", > dat)
+} else if (i == 6) {	# Galaxy absorption line spectrum + sky
+    mk1dspec (obj, output="", ap=1, rv=0., z=no, title="", header="",
+	ncols=512, naps=1, wstart=w1, wend=w2, continuum=1000., slope=0.,
+	temperature=7000., lines="", nlines=50, peak=-0.5, profile="gaussian",
+	gfwhm=23.5, seed=i+1, comments=b1)
+    mk1dspec (bkg, output="", ap=1, rv=0., z=no, title="", header="",
+	ncols=512, naps=1, wstart=w1, wend=w2, continuum=1000., slope=0.,
+	temperature=5800., lines="", nlines=20, peak=1., profile="gaussian",
+	gfwhm=12, seed=1, comments=b1)
+    print (obj, " 10 gauss 30 0 50 .002", > dat)
+    print (bkg, " 10 slit 200 0 50 0", >> dat)
+} else {		# Star absorption line spectrum + sky
+    mk1dspec (obj, output="", ap=1, rv=0., z=no, title="", header="",
+	ncols=512, naps=1, wstart=w1, wend=w2, continuum=1000., slope=0.,
+	temperature=7000., lines="", nlines=50, peak=-0.5, profile="gaussian",
+	gfwhm=23.5, seed=i+1, comments=b1)
+    mk1dspec (bkg, output="", ap=1, rv=0., z=no, title="", header="",
+	ncols=512, naps=1, wstart=w1, wend=w2, continuum=1000., slope=0.,
+	temperature=5800., lines="", nlines=20, peak=1., profile="gaussian",
+	gfwhm=12, seed=1, comments=b1)
+    print (obj, " 1 gauss 3 0 50 .002", > dat)
+    print (bkg, " 10 slit 90 0 50 0", >> dat)
+}
+
+mk2dspec (out, output="", model=dat, comments=b1, ncols=100, nlines=512,
+    title="Example artificial long slit image",  header=hdr)
+
+mknoise (out, output="", ncols=512, nlines=512, title="", header="",
+    background=0., gain=1., rdnoise=3., poisson=yes, seed=j, cosrays="",
+    ncosrays=0, energy=30000., radius=0.5, ar=1., pa=0., comments=b1)
+
+imdelete (obj, verify=no, >& "dev$null")
+imdelete (bkg, verify=no, >& "dev$null")
+delete (dat, verify=no, >& "dev$null")
diff --git a/noao/artdata/mkexamples/lsarc.cl b/noao/artdata/mkexamples/lsarc.cl
new file mode 100644
index 00000000..2ca4afdc
--- /dev/null
+++ b/noao/artdata/mkexamples/lsarc.cl
@@ -0,0 +1,5 @@
+# LSARC - Longslit Helium-Neon-Argon Arc Spectrum
+
+i = 5
+s2 = "mkexamples$archdr.dat"
+cl < "mkexamples$longslit.cl"
diff --git a/noao/artdata/mkexamples/lsgal.cl b/noao/artdata/mkexamples/lsgal.cl
new file mode 100644
index 00000000..0c9aaad7
--- /dev/null
+++ b/noao/artdata/mkexamples/lsgal.cl
@@ -0,0 +1,5 @@
+# LSGAL - Long slit galaxy spectrum (uncalibrated)
+
+i = 6
+s2 = "mkexamples$objhdr.dat"
+cl < "mkexamples$longslit.cl"
diff --git a/noao/artdata/mkexamples/lsobj.cl b/noao/artdata/mkexamples/lsobj.cl
new file mode 100644
index 00000000..fe00bf9b
--- /dev/null
+++ b/noao/artdata/mkexamples/lsobj.cl
@@ -0,0 +1,5 @@
+# LSOBJ - Long slit object spectrum (uncalibrated)
+
+i = 1
+s2 = "mkexamples$objhdr.dat"
+cl < "mkexamples$longslit.cl"
diff --git a/noao/artdata/mkexamples/mkexamples.cl b/noao/artdata/mkexamples/mkexamples.cl
new file mode 100644
index 00000000..ed9150e4
--- /dev/null
+++ b/noao/artdata/mkexamples/mkexamples.cl
@@ -0,0 +1,68 @@
+# MKEXAMPLES -- Make ARTDATA examples.
+# The example script files use variable s1 to pass the image name,
+# variable s2 to pass the image header file, variable i to pass an object
+# seed, variable j to pass a noise seed, and variable b1 to pass the comment
+# flag.
+
+procedure mkexamples (name, image)
+
+string	name		{prompt="Example name"}
+string	image		{prompt="Image name"}
+
+int	oseed=1		{prompt="Object seed"}
+int	nseed=1		{prompt="Noise seed"}
+bool	comments=no	{prompt="Add comments to image?"}
+bool	verbose=yes	{prompt="Print operation?"}
+bool	errors=yes	{prompt="Report errors?"}
+bool	list=no		{prompt="List example script file only?"}
+
+begin
+	string	name1, name2, example
+
+
+	# Get and check parameters.
+	if ($nargs < 1 && mode != "h") {
+	    name1 = "mkexamples"
+	    name2 = ""
+	    while (name1 != name2) {
+		example = "mkexamples$" // name1 // ".men"
+		if (!access (example))
+		    break
+		type (example)
+		name2 = name1
+		name1 = name
+	    }
+	    if (name1 == name2)
+		return
+	} else
+	    name1 = name
+
+	example = "mkexamples$" // name1 // ".cl"
+	if (!access (example)) {
+	    if (errors)
+	        error (2, "Unknown example " // name1) 
+	    return
+	}
+
+	# Make or list the example.
+	if (list)
+	    page (example)
+	else {
+	    s1 = image 
+	    s2 = "artdata$stdheader.dat"
+	    i = oseed
+	    j = nseed
+	    b1 = comments
+	    if (s1 == "" || name1 == "")
+		return
+	    if ((access (s1) || access (s1//"."//envget("imtype")))) {
+		if (errors)
+		    error (1, "Image " // s1 // " already exists")
+		return
+	    }
+
+	    if (verbose)
+                print ("Creating example ", name1, " in image ", s1, " ...")
+	    cl (< example)
+	}
+end
diff --git a/noao/artdata/mkexamples/mkexamples.men b/noao/artdata/mkexamples/mkexamples.men
new file mode 100644
index 00000000..feb89380
--- /dev/null
+++ b/noao/artdata/mkexamples/mkexamples.men
@@ -0,0 +1,10 @@
+	    		MKEXAMPLE Menu
+
+     galcluster - Galaxy cluster
+       globular - Globular cluster
+       galfield - Galaxy field
+      starfield - Starfield
+
+       onedspec - Menu of one dimensional spectra
+       twodspec - Menu of two dimensional spectra
+     threedspec - Menu of three dimensional spectra
diff --git a/noao/artdata/mkexamples/multifiber.cl b/noao/artdata/mkexamples/multifiber.cl
new file mode 100644
index 00000000..af48c4e7
--- /dev/null
+++ b/noao/artdata/mkexamples/multifiber.cl
@@ -0,0 +1,31 @@
+# MULTIFIBER - Multifiber example
+
+file	out, obj, dat
+
+out = s1
+obj = mktemp ("art")
+dat = mktemp ("art")
+
+mk1dspec (obj, output="", ap=1, rv=0., z=no, title="", header="",
+    ncols=512, naps=1, wstart=4000., wend=8000., continuum=1000., slope=0.,
+    temperature=5700., lines="", nlines=50, peak=-0.5, profile="gaussian",
+    gfwhm=24, seed=i, comments=b1)
+
+print (obj, " .1 gauss 3 0 10.1 .002", > dat)
+print (obj, " .2 gauss 3 0 20.2 .002", >> dat)
+print (obj, " .3 gauss 3 0 30.3 .002", >> dat)
+print (obj, " .4 gauss 3 0 40.4 .002", >> dat)
+print (obj, " .5 gauss 3 0 50.5 .002", >> dat)
+print (obj, " .6 gauss 3 0 60.6 .002", >> dat)
+print (obj, " .7 gauss 3 0 70.7 .002", >> dat)
+print (obj, " .8 gauss 3 0 80.8 .002", >> dat)
+print (obj, " .9 gauss 3 0 90.9 .002", >> dat)
+mk2dspec (out, output="", model=dat, comments=b1, ncols=100, nlines=512,
+    title="Example artificial multifiber image", header="artdata$stdheader.dat")
+
+mknoise (out, output="", title="", header="", ncols=512, nlines=512,
+    background=0., gain=1., rdnoise=3., poisson=yes, seed=j, cosrays="",
+    ncosrays=0, energy=30000., radius=0.5, ar=1., pa=0., comments=b1)
+
+imdelete (obj, verify=no)
+delete (dat, verify=no)
diff --git a/noao/artdata/mkexamples/objhdr.dat b/noao/artdata/mkexamples/objhdr.dat
new file mode 100644
index 00000000..eabebc5f
--- /dev/null
+++ b/noao/artdata/mkexamples/objhdr.dat
@@ -0,0 +1,19 @@
+OBSERVER= 'IRAF              '  /  observers
+OBSERVAT= 'KPNO              '  /  observatory
+INSTRUME= 'IRAF ARTDATA      '  /  instrument
+TELESCOP= 'kpcdf             '  /  telescope name
+DETECTOR= 'te1k              '  /  detector
+EXPTIME =                1200.  /  actual integration time
+DARKTIME=                1200.  /  total elapsed time
+IMAGETYP= 'object            '  /  object, dark, bias, etc.
+DATE-OBS= '1991-11-26T12:19:55.00' /  date (dd/mm/yy) of obs.
+UT      = '12:19:55.00       '  /  universal time
+ST      = '09:13:15.00       '  /  sidereal time
+RA      = '06:37:02.00       '  /  right ascension
+DEC     = '06:08:52.00       '  /  declination
+EPOCH   =               1991.9  /  epoch of ra and dec
+ZD      = '44.580            '  /  zenith distance
+AIRMASS =                   0.  /  airmass
+APERTURE= '250micron slit    '  /  aperture
+GRATPOS =               4624.3  /  grating position
+CCDPROC = 'Nov 26  5:44 CCD processing done'
diff --git a/noao/artdata/mkexamples/onedspec.men b/noao/artdata/mkexamples/onedspec.men
new file mode 100644
index 00000000..903eb45a
--- /dev/null
+++ b/noao/artdata/mkexamples/onedspec.men
@@ -0,0 +1,10 @@
+	    		ONEDSPEC Menu
+
+         henear - Helium-neon-argon spectrum (uncalibrated)
+       heneardc - Helium-neon-argon spectrum (calibrated)
+
+          ecarc - Echelle thorium-argon spectrum (uncalibrated)
+        ecarcdc - Echelle thorium-argon spectrum (calibrated)
+
+       spectrum - Absorption spectrum (calibrated)
+        echelle - Echelle absorption spectrum (calibrated)
diff --git a/noao/artdata/mkexamples/spectrum.cl b/noao/artdata/mkexamples/spectrum.cl
new file mode 100644
index 00000000..a5045b8f
--- /dev/null
+++ b/noao/artdata/mkexamples/spectrum.cl
@@ -0,0 +1,19 @@
+# spectrum - Object spectrum (calibrated)
+
+file	out, hdr
+
+out = s1
+hdr = "mkexamples$objhdr.dat"
+
+for (k=1; k<=i; k+=1) {
+    x = k * 100.
+    mk1dspec (out, output="", ap=k, rv=0., z=no, ncols=512, naps=i,
+	wstart=4210.0, wend=7362.7, title="Artificial Spectrum",
+	header=hdr, continuum=x, slope=0., temperature=5700.,
+        lines="", nlines=50, peak=-0.5, profile="gaussian", gfwhm=24,
+	seed=i, comments=b1)
+}
+
+mknoise (out, output="", ncols=512, nlines=512, title="", header="",
+    background=0., gain=1., rdnoise=3., poisson=yes, seed=j, cosrays="",
+    ncosrays=0, energy=30000., radius=0.5, ar=1., pa=0., comments=b1)
diff --git a/noao/artdata/mkexamples/starfield.cl b/noao/artdata/mkexamples/starfield.cl
new file mode 100644
index 00000000..3e1c19b9
--- /dev/null
+++ b/noao/artdata/mkexamples/starfield.cl
@@ -0,0 +1,22 @@
+# STARFIELD - Uniform star field
+
+file	image, dat
+
+image = s1
+dat = mktemp ("art")
+
+starlist (dat, 1000, "", "", interactive=no, spatial="uniform", xmin=1.,
+    xmax=512., ymin=1., ymax=512., xcenter=INDEF, ycenter=INDEF,
+    core_radius=30., base=0., sseed=i, luminosity="powlaw", minmag=-7.,
+    maxmag=0., mzero=-4., power=0.6, alpha=0.74, beta=0.04, delta=0.294,
+    mstar=1.28, lseed=i, nssample=100, sorder=10, nlsample=100, lorder=10,
+    rbinsize=10., mbinsize=0.5, graphics="stdgraph", cursor="")
+
+mkobjects (image, output="", ncols=512, nlines=512,
+    title="Example artificial uniform star field",
+    header="artdata$stdheader.dat",
+    background=1000., objects=dat, xoffset=0., yoffset=0., star="moffat",
+    radius=1.0, beta=2.5, ar=1., pa=0., distance=1., exptime=1., magzero=7.,
+    gain=3., rdnoise=10., poisson=yes, seed=j, comments=b1)
+
+delete (dat, verify=no)
diff --git a/noao/artdata/mkexamples/threedspec.men b/noao/artdata/mkexamples/threedspec.men
new file mode 100644
index 00000000..8aba4892
--- /dev/null
+++ b/noao/artdata/mkexamples/threedspec.men
@@ -0,0 +1,3 @@
+	    		THREEDSPEC Menu
+
+	None available
diff --git a/noao/artdata/mkexamples/twodspec.men b/noao/artdata/mkexamples/twodspec.men
new file mode 100644
index 00000000..08ebff20
--- /dev/null
+++ b/noao/artdata/mkexamples/twodspec.men
@@ -0,0 +1,10 @@
+	    		TWODSPEC Menu
+
+        ecarc2d - Echelle thorium-argon slit spectrum
+        ecobj2d - Echelle object slit spectrum
+
+          lsarc - Long slit helium-neon-argon spectrum
+	  lsobj - Long slit object spectrum
+	  lsgal - Long slit galaxy spectrum
+
+     multifiber - Multifiber spectrum
diff --git a/noao/artdata/mkheader.par b/noao/artdata/mkheader.par
new file mode 100644
index 00000000..327d5ac8
--- /dev/null
+++ b/noao/artdata/mkheader.par
@@ -0,0 +1,4 @@
+images,s,a,,,,List of images to be modified
+headers,s,a,,,,List of images or header keyword files
+append,b,h,yes,,,Append to existing header?
+verbose,b,h,no,,,Verbose output?
diff --git a/noao/artdata/mkheader.x b/noao/artdata/mkheader.x
new file mode 100644
index 00000000..aeee042a
--- /dev/null
+++ b/noao/artdata/mkheader.x
@@ -0,0 +1,229 @@
+include	<error.h>
+include	<imhdr.h>
+include	<imio.h>
+include	<ctype.h>
+
+define	LEN_COMMENT	70			# Maximum comment length
+define	IDB_RECLEN	80			# Length of FITS record (card)
+define	COMMENT		"COMMENT"		# Comment key
+define	IS_FITS		(IS_DIGIT($1)||IS_UPPER($1)||($1=='-')||($1=='_'))
+
+# MKH_HEADER -- Append or substitute new image header from an image or file.
+# Only the legal FITS cards (ignoring leading whitespace) will be copied
+# from a file.
+
+procedure mkh_header (im, fname, append, verbose)
+
+pointer	im			# IMIO pointer
+char	fname[ARB]		# Image or data file name
+bool	append			# Append to existing header?
+bool	verbose			# Verbose?
+
+int	i, j, curlen, buflen, max_lenuserarea
+pointer	ua, fd, out
+pointer	sp, str
+
+int	open(), getline(), nowhite(), strlen(), stropen()
+pointer	immap()
+errchk	open, stropen
+
+begin
+	if (nowhite (fname, fname, SZ_FNAME) == 0)
+	    return
+
+        # Open the user area string for appending.  'buflen' is the malloc-ed
+        # buffer length in struct units; IMU is the struct offset to the user
+        # area, i.e., the size of that part of the image descriptor preceding
+        # the user area.  If the buffer fills we must allow one extra char for
+        # the EOS delimiter; since storage for the image descriptor was
+        # allocated in struct units the storage allocator will not have
+        # allocated space for the extra EOS char.
+
+	ua = IM_USERAREA(im)
+	if (!append)
+	    Memc[ua] = EOS
+	curlen = strlen (Memc[ua])
+	buflen = LEN_IMDES + IM_LENHDRMEM(im)
+	max_lenuserarea = (buflen - IMU) * SZ_STRUCT - 1
+
+	# Append from an image header.
+	ifnoerr (fd = immap (fname, READ_ONLY, 0)) {
+	    iferr {
+		i = strlen (Memc[IM_USERAREA(fd)]) + strlen (Memc[ua])
+		call strcat (Memc[IM_USERAREA(fd)], Memc[ua], max_lenuserarea)
+		if (i > max_lenuserarea)
+		    call error (1, "Possibly failed to add all the keywords")
+	    } then {
+		call erract (EA_WARN)
+
+		# Check for truncated card.
+		for (i=ua+max_lenuserarea-1;  i > ua;  i=i-1) {
+		    if (Memc[i] == '\n') {
+			Memc[i+1] = EOS
+			break
+		    }
+		}
+	    }
+	    call imunmap (fd)
+
+	# Append from a text file.
+	} else {
+	    fd = open (fname, READ_ONLY, TEXT_FILE)
+	    out = stropen (Memc[ua+curlen], max_lenuserarea - curlen, APPEND)
+
+	    call smark (sp)
+	    call salloc (str, SZ_LINE, TY_CHAR)
+
+	    iferr {
+		while (getline (fd, Memc[str]) != EOF) {
+		    for (i=str; IS_WHITE(Memc[i]); i=i+1)
+			;
+		    for (j=i; IS_FITS(Memc[j]); j=j+1)
+			;
+		    for (; j<i+8 && Memc[j]==' '; j=j+1)
+			;
+		    if (j<i+8 && (Memc[j] != EOS || Memc[j] != '\n'))
+			next
+		    if (Memc[j] == '=' && Memc[j+1] != ' ')
+			next
+		    for (; j<i+IDB_RECLEN && Memc[j] != EOS; j=j+1)
+			;
+		    if (Memc[j-1] == '\n')
+			Memc[j-1] = EOS
+		    if (j == i + IDB_RECLEN || Memc[j] == '\n')
+			Memc[j] = EOS
+		    if (strlen (Memc[ua]) + IDB_RECLEN >= max_lenuserarea)
+			call error (1,
+			    "Possibly failed to add all the keywords")
+		    call fprintf (out, "%s%*t\n")
+			call pargstr (Memc[i])
+			call pargi (IDB_RECLEN+1)
+		}
+	    } then {
+		call erract (EA_WARN)
+
+		# Check for truncated card.
+		call close (out)
+		for (i=ua+max_lenuserarea-1;  i > ua;  i=i-1) {
+		    if (Memc[i] == '\n') {
+			Memc[i+1] = EOS
+			break
+		    }
+		}
+	    }
+	    call close (out)
+	    call close (fd)
+	    call sfree (sp)
+	}
+	if (verbose) {
+	    if (append) {
+		call printf ("%s: Image header from %s appended\n")
+		    call pargstr (IM_HDRFILE(im))
+		    call pargstr (fname)
+	    } else {
+		call printf ("%s: Image header from %s substituted\n")
+		    call pargstr (IM_HDRFILE(im))
+		    call pargstr (fname)
+	    }
+	}
+end
+
+
+# MKH_COMMENT -- Add comment to header.
+# Remove any tab characters.
+
+procedure mkh_comment (im, comment)
+
+pointer	im			# image descriptor
+char	comment[ARB]		# comment
+
+begin
+	call imputh (im, COMMENT, comment)
+end
+
+## MKH_COMMENT -- Add comment to header.
+## Remove any tab characters.
+#
+#define	MAX_COMMENT	72
+#
+#procedure mkh_comment (im, comment)
+#
+#pointer	im			# image descriptor
+#char	comment[ARB]		# comment
+#
+#int	i, j, k, stridxs()
+#pointer	sp, cmmt
+#
+#begin
+#	if (stridxs ("\t", comment) == 0) {
+#	    call imputh (im, COMMENT, comment)
+#	    return
+#	}
+#
+#	call smark (sp)
+#	call salloc (cmmt, MAX_COMMENT, TY_CHAR)
+#	j = 0
+#	for (i=1; comment[i]!=EOS; i=i+1) {
+#	    if (comment[i] == '\t') {
+#		k = min (j + 8 - mod (j, 8), MAX_COMMENT)
+#		for (; j < k; j=j+1)
+#		    Memc[cmmt+j] = ' '
+#	    } else {
+#		Memc[cmmt+j] = comment[i]
+#		j = j + 1
+#	    }
+#	    if (j == MAX_COMMENT)
+#		break
+#	}
+#	Memc[cmmt+j] = EOS
+#	call imputh (im, COMMENT, Memc[cmmt])
+#	call sfree (sp)
+#end
+
+
+# MKH_COMMENT1 -- Make comment out of CL parameter.
+
+procedure mkh_comment1 (im, param, type)
+
+pointer	im			# image descriptor
+char	param[ARB]		# parameter name
+int	type			# datatype
+
+bool	clgetb()
+int	clgeti()
+real	clgetr()
+double	clgetd()
+pointer	sp, comment, str
+
+begin
+	call smark (sp)
+	call salloc (comment, LEN_COMMENT, TY_CHAR)
+
+	switch (type) {
+	case 'b':
+	    call sprintf (Memc[comment], LEN_COMMENT, "%9t%s%24t%b")
+		call pargstr (param)
+	    	call pargb (clgetb (param))
+	case 'i':
+	    call sprintf (Memc[comment], LEN_COMMENT, "%9t%s%24t%d")
+		call pargstr (param)
+	    	call pargi (clgeti (param))
+	case 'r':
+	    call sprintf (Memc[comment], LEN_COMMENT, "%9t%s%24t%g")
+		call pargstr (param)
+	    	call pargr (clgetr (param))
+	case 'd':
+	    call sprintf (Memc[comment], LEN_COMMENT, "%9t%s%24t%g")
+		call pargstr (param)
+	    	call pargd (clgetd (param))
+	case 's':
+	    call salloc (str, SZ_FNAME, TY_CHAR)
+	    call clgstr (param, Memc[str], SZ_FNAME)
+	    call sprintf (Memc[comment], LEN_COMMENT, "%9t%s%24t%s")
+		call pargstr (param)
+	    	call pargstr (Memc[str])
+	}
+
+	call mkh_comment (im, Memc[comment])
+	call sfree (sp)
+end
diff --git a/noao/artdata/mknoise.par b/noao/artdata/mknoise.par
new file mode 100644
index 00000000..f8c13ff3
--- /dev/null
+++ b/noao/artdata/mknoise.par
@@ -0,0 +1,25 @@
+input,s,a,"",,,"List of input images"
+output,s,h,"",,,"List of output images
+
+IF NEW IMAGE"
+title,s,h,"",,,"Title of image"
+ncols,i,h,512,1,,"Number of columns"
+nlines,i,h,512,1,,"Number of lines"
+header,f,h,"artdata$stdheader.dat",,,"Image or header keyword file
+
+NOISE PARAMETERS"
+background,r,h,0.,0.,,"Default background and Poisson background"
+gain,r,h,1.,1.e-9,,"Gain (electrons/DN)"
+rdnoise,r,h,0.,0.,,"Read noise (electrons)"
+poisson,b,h,no,,,"Add Poisson noise?"
+seed,i,h,1,,,"Random number seed
+
+COSMIC RAYS"
+cosrays,s,h,"",,,"List of cosmic ray files"
+ncosrays,i,h,0,0,,"Number of random events (if none in file)"
+energy,r,h,30000.,0.,,"Maximum random energy (electroms)"
+radius,r,h,0.5,0.,,"Radius of cosmic ray (pixels)"
+ar,r,h,1.,0.,1.,"Axial ratio (minor/major)"
+pa,r,h,0.,,,"Position angle (degrees)
+"
+comments,b,h,yes,,,"Add comments to image?"
diff --git a/noao/artdata/mkobjects.par b/noao/artdata/mkobjects.par
new file mode 100644
index 00000000..919a48d1
--- /dev/null
+++ b/noao/artdata/mkobjects.par
@@ -0,0 +1,30 @@
+input,s,a,"",,,"List of input images"
+output,s,h,"",,,"List of output images
+
+IF NEW IMAGE"
+title,s,h,"",,,"Image title"
+ncols,i,h,512,1,,"Number of columns"
+nlines,i,h,512,1,,"Number of lines"
+header,f,h,"artdata$stdheader.dat",,,"Image or header keyword file"
+background,r,h,1000.,0.,,"Default background (in ADU)
+
+OBJECT PARAMETERS"
+objects,s,h,"",,,"List of objects files"
+xoffset,r,h,0.,,,"X coordinate offset"
+yoffset,r,h,0.,,,"Y coordinate offset"
+star,s,h,"moffat",,,"Star"
+radius,r,h,1.,0.,,"Seeing radius/scale (pixels)"
+beta,r,h,2.5,1.01,,"Moffat parameter"
+ar,r,h,1.,0.,1.,"Axial ratio (minor/major)"
+pa,r,h,0.,,,"Position angle (degrees)"
+distance,r,h,1.,1e-6,,"Relative distance"
+exptime,r,h,1.,1e-6,,"Exposure time"
+magzero,r,h,7.,,,"Magnitude zero point
+
+NOISE PARAMETERS"
+gain,r,h,1.,1.e-9,,"Gain (electrons/ADU)"
+rdnoise,r,h,0.,0.,,"Read noise (electrons)"
+poisson,b,h,no,,,"Add Poisson noise?"
+seed,i,h,1,,,"Random number seed
+"
+comments,b,h,yes,,,"Add comments to image?"
diff --git a/noao/artdata/mkpattern.par b/noao/artdata/mkpattern.par
new file mode 100644
index 00000000..1577558c
--- /dev/null
+++ b/noao/artdata/mkpattern.par
@@ -0,0 +1,20 @@
+input,s,a,"",,,"Images to create or modify"
+output,s,h,"",,,"Output images"
+pattern,s,h,"constant","constant|grid|checker|coordinates|slope|square",,"Pattern"
+option,s,h,"replace","replace|add|multiply",,"Editing option"
+v1,r,h,0.,,,"Pattern value"
+v2,r,h,1.,,,"Pattern value"
+size,i,h,1,1,,"Pattern size
+
+IF NEW IMAGE"
+title,s,h,"",,,"Image title"
+pixtype,s,h,"real","ushort|short|integer|long|real|double|complex",,"Pixel datatype"
+ndim,i,h,2,0,7,"Number of dimensions"
+ncols,i,h,512,1,,"Number of columns"
+nlines,i,h,512,1,,"Number of lines"
+n3,i,h,1,1,,"Number of pixels in 3rd dimension"
+n4,i,h,1,1,,"Number of pixels in 4th dimension"
+n5,i,h,1,1,,"Number of pixels in 5th dimension"
+n6,i,h,1,1,,"Number of pixels in 6th dimension"
+n7,i,h,1,1,,"Number of pixels in 7th dimension"
+header,f,h,"",,,"Image or header keyword file"
diff --git a/noao/artdata/mkpkg b/noao/artdata/mkpkg
new file mode 100644
index 00000000..e1f8a640
--- /dev/null
+++ b/noao/artdata/mkpkg
@@ -0,0 +1,40 @@
+# ARTDATA
+
+$call	relink
+$exit
+
+update:
+	$call	relink
+	$call	install
+	;
+
+relink:
+	$update	libpkg.a
+	$call	artdata
+	;
+
+install:
+	$move	xx_artdata.e noaobin$x_artdata.e
+	;
+
+artdata:
+	$set LIBS = "-lsmw -lxtools -lcurfit -liminterp"
+	$omake	x_artdata.x
+	$link	x_artdata.o libpkg.a $(LIBS) -o xx_artdata.e
+	;
+
+libpkg.a:
+	@lists
+	mkheader.x	<ctype.h> <imhdr.h> <imio.h>
+	mktemplates.x	mktemplates.com <error.h> <imhdr.h> <math.h>\
+			<math/iminterp.h>
+	numrecipes.x	<math.h>
+	t_mk1dspec.x	<error.h> <imhdr.h>
+	t_mk2dspec.x	<error.h> <imhdr.h> <math/iminterp.h>
+	t_mkechelle.x	<error.h> <imhdr.h> <math.h>
+	t_mkheader.x	<ctype.h> <error.h> <imhdr.h>
+	t_mknoise.x	<error.h> <imhdr.h> <mach.h>
+	t_mkobjects.x	<error.h> <imhdr.h> <math.h> <mach.h>
+	t_mkpattern.x	<error.h> <imhdr.h>
+	voigt.x
+	;
diff --git a/noao/artdata/mktemplates.com b/noao/artdata/mktemplates.com
new file mode 100644
index 00000000..e2c18b19
--- /dev/null
+++ b/noao/artdata/mktemplates.com
@@ -0,0 +1,9 @@
+int	nxc, nyc		# Number of PSF centers
+int	nxssub, nyssub		# Number of star subsamples
+int	nxgsub, nygsub		# Number of galaxy subsamples
+real	dynrange		# Profile intensity dynamic range
+real	psfrange		# PSF convolution dynamic range
+pointer	stp, star, see
+
+common	/mktcom/ dynrange, psfrange, nxc, nyc, nxssub, nyssub, nxgsub, nygsub,
+		stp, star, see
diff --git a/noao/artdata/mktemplates.x b/noao/artdata/mktemplates.x
new file mode 100644
index 00000000..08fec295
--- /dev/null
+++ b/noao/artdata/mktemplates.x
@@ -0,0 +1,1390 @@
+include	<error.h>
+include	<imhdr.h>
+include	<math.h>
+include	<math/iminterp.h>
+
+# Template data structure
+define	LEN_MKT		18
+define	MKT_PROF	Memi[$1]	# Pointer to profile
+define	MKT_MSI		Memi[$1+1]	# MSI interpolation pointer
+define	MKT_NXM		Memi[$1+2]	# Number of X points in model
+define	MKT_NYM		Memi[$1+3]	# Number of Y points in model
+define	MKT_F		Memr[P2R($1+4)]	# Fraction of total flux in profile
+define	MKT_SCALE	Memr[P2R($1+5)]	# Radius scale
+
+define	MKT_NALLOC	Memi[$1+6]	# Allocated space for saved templates
+define	MKT_N		Memi[$1+7]	# Number of saved templates
+
+define	MKT_DATA	Memi[$1+8]	# Data pointer
+define	MKT_PTRS	Memi[$1+9]	# Data pointers
+define	MKT_NX		Memi[$1+10]	# Number of X pixels
+define	MKT_NY		Memi[$1+11]	# Number of Y pixels
+define	MKT_XC		Memi[$1+12]	# Subpixel X center
+define	MKT_YC		Memi[$1+13]	# Subpixel Y center
+define	MKT_FLUX	Memi[$1+14]	# Flux
+define	MKT_R		Memi[$1+15]	# Radius
+define	MKT_AR		Memi[$1+16]	# Axial ratio
+define	MKT_PA		Memi[$1+17]	# Position angle
+
+define	NALLOC	25		# Allocation block for saved templates
+define	NPROF	5001		# Profile length
+define	NY	11		# BINPROF binning parameter
+
+
+# MKT_INIT    -- Initialize template memory.
+# MKT_FREE    -- Free template memory.
+# MKT_SAVE    -- Save a template
+# MKT_GET     -- Get a template
+# MKT_STAR    -- Set star and seeing templates.
+# MKT_OBJECT  -- Set object profiles.
+# MKT_GOBJECT -- Get image raster.
+# MKT_BINPROF -- Bin intensity profile
+# MKT_GSTAR   -- Get the precomputed template with center nearest (x,y).
+# MKT_PROFILE -- Make template from profile.
+# MKT_MSI     -- Make template from image interpolation function.
+
+
+# MKT_INIT -- Initialize template memory.
+# The symbol table is used as a simple way to store the object types by name.
+
+procedure mkt_init ()
+
+int	clgeti()
+real	clgetr()
+
+pointer	stopen()
+include	"mktemplates.com"
+
+begin
+	nxc = clgeti ("nxc")
+	nyc = clgeti ("nyc")
+	nxssub = clgeti ("nxsub")
+	nyssub = clgeti ("nysub")
+	nxgsub = clgeti ("nxgsub")
+	nygsub = clgeti ("nygsub")
+	dynrange = clgetr ("dynrange")
+	psfrange = clgetr ("psfrange")
+	stp = stopen ("mkt", 10, 10, 10*SZ_FNAME)
+end
+
+
+# MKT_FREE -- Free template memory.
+
+procedure mkt_free ()
+
+int	i
+pointer sym, mkt, sthead(), stnext()
+include	"mktemplates.com"
+
+begin
+	# For each object type free the profile and image interpolator data,
+	# the last unsaved data buffer, all saved templates, and the object
+	# structure.  Finally free the symbol table.
+
+	for (sym = sthead (stp); sym != NULL; sym = stnext (stp, sym)) {
+	    mkt = Memi[sym]
+	    if (mkt != NULL) {
+	        call mfree (MKT_PROF(mkt), TY_REAL)
+		if (MKT_MSI(mkt) != NULL)
+		   call msifree (MKT_MSI(mkt))
+	        call mfree (MKT_DATA(mkt), TY_REAL)
+		if (MKT_NALLOC(mkt) > 0) {
+		    do i = 0, MKT_N(mkt)-1
+		        call mfree (Memi[MKT_PTRS(mkt)+i], TY_REAL)
+		    call mfree (MKT_PTRS(mkt), TY_POINTER)
+		    call mfree (MKT_NX(mkt), TY_INT)
+		    call mfree (MKT_NY(mkt), TY_INT)
+		    call mfree (MKT_XC(mkt), TY_REAL)
+		    call mfree (MKT_YC(mkt), TY_REAL)
+		    call mfree (MKT_FLUX(mkt), TY_REAL)
+		    call mfree (MKT_R(mkt), TY_REAL)
+		    call mfree (MKT_AR(mkt), TY_REAL)
+		    call mfree (MKT_PA(mkt), TY_REAL)
+		}
+	        call mfree (mkt, TY_STRUCT)
+	    }
+	}
+	call stclose (stp)
+end
+
+
+# MKT_SAVE -- Save a template
+# If a template may be used more than once it may be saved upon direction of
+# the user in the object list.  Otherwise the last unsaved template is
+# freed for the next object.
+
+procedure mkt_save (mkt, data, nx, ny, xc, yc, flux, r, ar, pa, save)
+
+pointer	mkt		#I MKT pointer
+pointer	data		#I Pointer to template data
+int	nx, ny		#I Size of template
+real	xc, yc		#I Subpixel center
+real	flux		#I Flux
+real	r		#I Effective radius
+real	ar		#I Axial ratio
+real	pa		#I Position angle
+int	save		#I Save data?
+
+int	i
+
+begin
+	if (save == NO) {
+	    MKT_DATA(mkt) = data
+	    return
+	}
+
+	if (MKT_NALLOC(mkt) == 0) {
+	    i = NALLOC
+	    call malloc (MKT_PTRS(mkt), i, TY_POINTER)
+	    call malloc (MKT_NX(mkt), i, TY_INT)
+	    call malloc (MKT_NY(mkt), i, TY_INT)
+	    call malloc (MKT_XC(mkt), i, TY_REAL)
+	    call malloc (MKT_YC(mkt), i, TY_REAL)
+	    call malloc (MKT_FLUX(mkt), i, TY_REAL)
+	    call malloc (MKT_R(mkt), i, TY_REAL)
+	    call malloc (MKT_AR(mkt), i, TY_REAL)
+	    call malloc (MKT_PA(mkt), i, TY_REAL)
+	    MKT_NALLOC(mkt) = i
+	} else if (MKT_N(mkt) == MKT_NALLOC(mkt)) {
+	    i = MKT_NALLOC(mkt) + NALLOC
+	    call realloc (MKT_PTRS(mkt), i, TY_POINTER)
+	    call realloc (MKT_NX(mkt), i, TY_INT)
+	    call realloc (MKT_NY(mkt), i, TY_INT)
+	    call realloc (MKT_XC(mkt), i, TY_REAL)
+	    call realloc (MKT_YC(mkt), i, TY_REAL)
+	    call realloc (MKT_FLUX(mkt), i, TY_REAL)
+	    call realloc (MKT_R(mkt), i, TY_REAL)
+	    call realloc (MKT_AR(mkt), i, TY_REAL)
+	    call realloc (MKT_PA(mkt), i, TY_REAL)
+	    MKT_NALLOC(mkt) = i
+	}
+	i = MKT_N(mkt)
+	Memi[MKT_PTRS(mkt)+i] = data
+	Memi[MKT_NX(mkt)+i] = nx
+	Memi[MKT_NY(mkt)+i] = ny
+	Memr[MKT_XC(mkt)+i] = xc
+	Memr[MKT_YC(mkt)+i] = yc
+	Memr[MKT_FLUX(mkt)+i] = flux
+	Memr[MKT_R(mkt)+i] = r
+	Memr[MKT_AR(mkt)+i] = ar
+	Memr[MKT_PA(mkt)+i] = pa
+	MKT_N(mkt) = i + 1
+end
+
+
+# MKT_GET -- Get a template
+# If not a saved template just free last unsaved template.
+# If saved search for match with position, size, axial ratio, and pa.
+# Return null if not found.
+
+procedure mkt_get (mkt, data, nx, ny, xc, yc, flux, r, ar, pa, save)
+
+pointer	mkt		#I MKT pointer
+pointer	data		#O Pointer to template data
+int	nx, ny		#O Size of template
+real	xc, yc		#I Subpixel center
+real	flux		#I Flux
+real	r		#I Effective radius
+real	ar		#I Axial ratio
+real	pa		#I Position angle
+int	save		#I Get saved template?
+
+int	i
+real	f
+
+begin
+	data = NULL
+	call mfree (MKT_DATA(mkt), TY_REAL)
+	if (save == NO)
+	    return
+
+	for (i=0; i<MKT_N(mkt); i=i+1) {
+	    if (xc != Memr[MKT_XC(mkt)+i])
+		next
+	    if (yc != Memr[MKT_YC(mkt)+i])
+		next
+	    if (r != Memr[MKT_R(mkt)+i])
+		next
+	    if (ar != Memr[MKT_AR(mkt)+i])
+		next
+	    if (pa != Memr[MKT_PA(mkt)+i])
+		next
+	    data = Memi[MKT_PTRS(mkt)+i]
+	    nx = Memi[MKT_NX(mkt)+i]
+	    ny = Memi[MKT_NY(mkt)+i]
+	    f = Memr[MKT_FLUX(mkt)+i]
+	    if (f != flux) {
+	        call amulkr (Memr[data], flux/f, Memr[data], nx*ny)
+	        Memr[MKT_FLUX(mkt)+i] = flux
+	    }
+	    return
+	}
+end
+
+
+# MKT_STAR -- Define star and seeing templates.
+# The seeing template has a smaller range for efficiency.
+# THe star templates are determined once over a grid of centers and
+# then not evaluated again.
+
+pointer procedure mkt_star (name)
+
+char	name[ARB]	# Profile name or file
+
+# Star and seeing parameters obatined through CLIO.
+real	r		# Major axis sigma (pixels)
+real	ar		# Axial ratio (minor / major)
+real	pa		# Position angle (radians)
+
+int	i, j, nxm, nym, nx, ny, fd
+real	dr, flux, radius, seeing, beta, xc, yc, dxc, dyc, der[2]
+pointer	sym, mkt1, mkt2, prof, prof1, asi, msi, data, im
+
+bool	streq()
+real	clgetr(), asieval()
+int	open(), fscan(), nscan()
+pointer	immap(), imgs2r(), stfind(), stenter()
+errchk	immap, open, imgs2r, asifit, asieval, asider
+
+include	"mktemplates.com"
+
+begin
+	# Check if previously defined.
+	sym = stfind (stp, "star")
+	if (sym != NULL)
+	    return (Memi[sym])
+
+	# Select type of star profile and set intensity profile array.
+	# Compute the fraction of the total flux in the profile.
+	# Insure that the profile subsamples a subpixel.
+
+	star = NULL
+	see = NULL
+	prof = NULL
+	msi = NULL
+	if (streq (name, "gaussian")) {
+	    r = clgetr ("radius") / sqrt (log (2.))
+	    radius = sqrt (log (dynrange))
+	    seeing = sqrt (log (psfrange))
+	    nxm = max (NPROF, 1 + nint (radius*r*nxssub*nyssub))
+	    call malloc (prof, nxm, TY_REAL)
+
+	    dr = radius / (nxm - 1)
+	    do i = 0, nxm - 1
+		Memr[prof+i] = exp (-(i * dr) ** 2)
+	    flux = 1 - Memr[prof+nxm-1]
+
+	    r = sqrt (log (2.))
+	    radius = radius / r
+	    seeing = seeing / r
+	} else if (streq (name, "moffat")) {
+	    beta = clgetr ("beta")
+	    r = clgetr ("radius") / sqrt (2. ** (1/beta) - 1.)
+	    radius = sqrt ((dynrange) ** (1/beta) - 1)
+	    seeing = sqrt ((psfrange) ** (1/beta) - 1)
+	    nxm = max (NPROF, 1 + nint (radius*r*nxssub*nyssub))
+	    call malloc (prof, nxm, TY_REAL)
+
+	    dr = radius / (nxm - 1)
+	    flux = 0
+	    do i = 0, nxm - 1 {
+		r = i * dr
+		Memr[prof+i] =  1. / ((1 + r**2) ** beta)
+		flux = flux + r * Memr[prof+i]
+	    }
+
+	    # Compute the fraction of the total flux in the profile.
+	    # The last part of the total flux below is computed by expanding
+	    # (1+r**2) --> r**2 under the approximation that r >> 1.
+	    # Note that it is possible to explicitly compute the total
+	    # flux  F(total) = beta / (2 * beta - 2) (CRC 53rd edition)
+	    # I found errors in other versions of CRC for this integral!
+
+	    r = r + dr / 2
+	    xc = 2 * beta - 2
+	    flux = flux / (flux + 1. / (xc * r ** xc))
+
+	    r = sqrt (2. ** (1/beta) - 1.)
+	    radius = radius / r
+	    seeing = seeing / r
+	} else ifnoerr (im = immap (name, READ_ONLY, 0)) {
+	    iferr {
+		nxm = IM_LEN(im,1)
+		nym = IM_LEN(im,2)
+		data = imgs2r (im, 1, nxm, 1, nym)
+		call msiinit (msi, II_BILINEAR)
+		call msifit (msi, Memr[data], nxm, nym, nxm)
+	    } then
+		call erract (EA_WARN)
+	    call imunmap (im)
+
+	    flux = 1.
+	    radius = 1
+	    seeing = 0.8
+	} else ifnoerr (fd = open (name, READ_ONLY, TEXT_FILE)) {
+	    nxm = NPROF
+	    call malloc (prof1, nxm, TY_REAL)
+
+	    j = 0
+	    while (fscan (fd) != EOF) {
+	 	call gargr (flux)
+		if (nscan() < 1)
+		    next
+		if (j == nxm) {
+		    nxm = nxm + NPROF
+		    call realloc (prof1, nxm, TY_REAL)
+		}
+		Memr[prof1+j] = flux
+		j = j + 1
+	    }
+	    call close (fd)
+	    if (j == 0) {
+		call mfree (prof1, TY_REAL)
+		call error (1, "PSF template not found")
+	    }
+
+	    r = clgetr ("radius")
+	    nxm = max (NPROF, 1 + nint (r*nxssub*nyssub))
+	    call malloc (prof, nxm, TY_REAL)
+	    dr = 1. / (nxm - 1)
+	    j = j - 1
+
+	    call asiinit (asi, II_SPLINE3)
+	    call asifit (asi, Memr[prof1], j)
+	    xc = Memr[prof1]
+	    call mfree (prof1, TY_REAL)
+
+	    if (xc == 0.) {
+		flux = 0.
+		do i = 1, nxm - 1 {
+		    r = i * dr
+		    call asider (asi, 1+j*r, der, 2)
+		    Memr[prof+i] = max (0., der[2] / r)
+		    flux = flux + r * Memr[prof+i]
+		}
+		Memr[prof] = max (0., 2 * Memr[prof+1] - Memr[prof+2])
+	    } else {
+		flux = 0.
+		do i = 0, nxm - 1 {
+		    r = i * dr
+		    Memr[prof+i] = asieval (asi, 1+j*r)
+		    flux = flux + r * Memr[prof+i]
+		}
+	    }
+	    call asifree (asi)
+
+	    xc = 0.9 * flux
+	    flux = 0.
+	    for (i=1; i<nxm && flux<xc; i=i+1)
+		flux = flux + i * dr * Memr[prof+i]
+
+	    flux = 1.
+	    radius = 1.
+	    seeing = (i - 1.) * dr
+	} else
+	    call error (1, "PSF template not found")
+
+	# Set size and orientation parameters.
+	r = clgetr ("radius")
+	ar = clgetr ("ar")
+	pa = DEGTORAD (clgetr ("pa"))
+	radius = r * radius
+	seeing = r * seeing
+
+	# Compute templates with subsampling  over a grid of centers.
+	# Do this for the full star profile and a smaller region for
+	# convolving extended objects.
+
+	# Seeing kernel.
+	sym = stenter (stp, "seeing", 1)
+	call calloc (Memi[sym], LEN_MKT, TY_STRUCT)
+	mkt1 = Memi[sym]
+
+	nx = 2 * nint (seeing) + 1
+	ny = nx
+	dxc = 1. / nxc
+	dyc = 1. / nyc
+	if (prof != NULL) {
+	    nym = 1 + nint (radius * nxssub * nyssub)
+	    call malloc (prof1, nym, TY_REAL)
+	    call mkt_binprof (Memr[prof], nxm, Memr[prof1], nym, radius, nxssub)
+	    for (yc = -0.5+dyc/2; yc < 0.5; yc = yc+dyc) {
+	        for (xc = -0.5+dxc/2; xc < 0.5; xc = xc+dxc) {
+		    call malloc (data, nx*ny, TY_REAL)
+		    call mkt_profile (data, nx, ny, xc, yc, 1., Memr[prof1],
+		        nym, radius, ar, pa, nxssub, nyssub)
+		    call mkt_save (mkt1, data, nx, ny, xc, yc, 1., 0., 0., 0.,
+			YES)
+	        }
+	    }
+	} else {
+	    for (yc = -0.5+dyc/2; yc < 0.5; yc = yc+dyc) {
+	        for (xc = -0.5+dxc/2; xc < 0.5; xc = xc+dxc) {
+		    call malloc (data, nx*ny, TY_REAL)
+		    call mkt_msi (data, nx, ny, xc, yc, 1., msi, nxm, nym,
+		        radius, ar, pa, nxssub, nyssub)
+		    call mkt_save (mkt1, data, nx, ny, xc, yc, 1., 0., 0., 0.,
+			YES)
+	        }
+	    }
+	}
+
+	# Full star templates.
+	sym = stenter (stp, "star", 1)
+	call calloc (Memi[sym], LEN_MKT, TY_STRUCT)
+	mkt2 = Memi[sym]
+
+	nx = 2 * nint (radius) + 1
+	ny = nx
+	dxc = 1. / nxc
+	dyc = 1. / nyc
+	if (prof != NULL) {
+	    for (yc = 0.5+dyc/2; yc < 1.5; yc = yc+dyc) {
+	        for (xc = 0.5+dxc/2; xc < 1.5; xc = xc+dxc) {
+		    call malloc (data, nx*ny, TY_REAL)
+		    call mkt_profile (data, nx, ny, xc, yc, flux, Memr[prof1],
+		        nym, radius, ar, pa, nxssub, nyssub)
+		    call mkt_save (mkt2, data, nx, ny, xc, yc, 1., 0., 0., 0.,
+			YES)
+	        }
+	    }
+	    call mfree (prof, TY_REAL)
+	    call mfree (prof1, TY_REAL)
+	} else {
+	    for (yc = 0.5+dyc/2; yc < 1.5; yc = yc+dyc) {
+	        for (xc = 0.5+dxc/2; xc < 1.5; xc = xc+dxc) {
+		    call malloc (data, nx*ny, TY_REAL)
+		    call mkt_msi (data, nx, ny, xc, yc, flux, msi, nxm, nym,
+		        radius, ar, pa, nxssub, nyssub)
+		    call mkt_save (mkt2, data, nx, ny, xc, yc, 1., 0., 0., 0.,
+			YES)
+	        }
+	    }
+	    call msifree (msi)
+	}
+
+	see = mkt1
+	star = mkt2
+	return (star)
+end
+
+
+# MKT_OBJECT -- Set object profiles.
+
+pointer procedure mkt_object (name)
+
+char	name[ARB]	# Profile name or file
+
+int	i, j, n, nxm, nym, fd
+real	radius, r, dr, s, b, flux, der[2]
+pointer	sym, mkt, prof, asi, msi, buf, im
+
+real	c3, c4, c5, c6, c7
+
+real	asieval()
+double	uigamma()
+int	open(), fscan(), nscan(), strncmp(), ctor()
+pointer	immap(), imgs2r(), stfind(), stenter()
+bool	streq()
+errchk	open, immap, asifit, asieval, asider
+
+include	"mktemplates.com"
+
+begin
+	# Check if previously defined.
+	sym = stfind (stp, name)
+	if (sym != NULL)
+	    return (Memi[sym])
+
+	# Select type of profile and set intensity profile array.
+	# Compute the fraction of the total flux in the profile.
+
+	prof = NULL
+	msi = NULL
+	if (strncmp (name, "sersic", 6) == 0) {
+	    i = 7
+	    if (ctor (name, i, s) == 0) {
+		call eprintf ("WARNING: Bad sersic profile syntax (%s).\n")
+		    call pargstr (name)
+		return (NULL)
+	    }
+	    n = nint (2 * (s + 0.01))
+	    s = n / 2.
+	    if (n < 1 || n > 20) {
+		call eprintf (
+		    "WARNING: Sersic index out of allowed range (%.1f).\n")
+		    call pargi (s)
+		return (NULL)
+	    }
+	    nxm = NPROF
+	    call malloc (prof, nxm, TY_REAL)
+	    radius = log (dynrange) ** s
+	    dr = radius / (nxm - 1)
+	    do i = 0, nxm - 1 {
+		r = (i * dr) ** (1/s)
+		Memr[prof+i] = exp (-r)
+	    }
+
+	    flux = 1 - uigamma (n, r)
+	    r = n - 1./3. + 4./(405.*s) + 46./(25515.*s*s)
+	    radius = radius / r ** s
+	} else if (streq (name, "expdisk")) {
+	    s = 1.
+	    n = nint (2 * s)
+
+	    nxm = NPROF
+	    call malloc (prof, nxm, TY_REAL)
+	    radius = log (dynrange) ** s
+	    dr = radius / (nxm - 1)
+	    do i = 0, nxm - 1 {
+		r = (i * dr) ** (1/s)
+		Memr[prof+i] = exp (-r)
+	    }
+
+	    flux = 1 - uigamma (n, r)
+	    r = n - 1./3. + 4./(405.*s) + 46./(25515.*s*s)
+	    radius = radius / r ** s
+	} else if (streq (name, "devauc")) {
+	    s = 4.
+	    n = nint (2 * s)
+	    nxm = NPROF
+	    call malloc (prof, nxm, TY_REAL)
+	    radius = log (dynrange) ** s
+	    dr = radius / (nxm - 1)
+	    do i = 0, nxm - 1 {
+		r = (i * dr) ** (1/s)
+		Memr[prof+i] = exp (-r)
+	    }
+
+	    flux = 1 - uigamma (n, r)
+	    r = n - 1./3. + 4./(405.*s) + 46./(25515.*s*s)
+	    radius = radius / r ** s
+	} else ifnoerr (im = immap (name, READ_ONLY, 0)) {
+	    iferr {
+		nxm = IM_LEN(im,1)
+		nym = IM_LEN(im,2)
+		buf = imgs2r (im, 1, nxm, 1, nym)
+		call msiinit (msi, II_BILINEAR)
+		call msifit (msi, Memr[buf], nxm, nym, nxm)
+	    } then
+		call erract (EA_WARN)
+	    call imunmap (im)
+
+	    flux = 1.
+	    radius = 1.
+	} else ifnoerr (fd = open (name, READ_ONLY, TEXT_FILE)) {
+	    nxm = NPROF
+	    call malloc (buf, nxm, TY_REAL)
+
+	    j = 0
+	    while (fscan (fd) != EOF) {
+	 	call gargr (flux)
+		if (nscan() < 1)
+		    next
+		if (j == nxm) {
+		    nxm = nxm + NPROF
+		    call realloc (buf, nxm, TY_REAL)
+		}
+		Memr[buf+j] = flux
+		j = j + 1
+	    }
+	    call close (fd)
+	    if (j == 0) {
+		call mfree (buf, TY_REAL)
+		nxm = 0
+		call error (1, "PSF template not found")
+	    }
+
+	    nxm = NPROF
+	    call malloc (prof, nxm, TY_REAL)
+	    dr = 1. / (nxm - 1)
+	    j = j - 1
+
+	    call asiinit (asi, II_SPLINE3)
+	    call asifit (asi, Memr[buf], j)
+	    s = Memr[buf]
+	    call mfree (buf, TY_REAL)
+
+	    if (s == 0.) {
+		do i = 1, nxm - 1 {
+		    r = i * dr
+		    call asider (asi, 1+j*r, der, 2)
+		    Memr[prof+i] = max (0., der[2] / r)
+		}
+		Memr[prof] = max (0., 2 * Memr[prof+1] - Memr[prof+2])
+	    } else {
+		do i = 0, nxm - 1 {
+		    r = i * dr
+		    Memr[prof+i] = asieval (asi, 1+j*r)
+		}
+	    }
+	    call asifree (asi)
+
+	    flux = 1.
+	    radius = 1.
+	} else {
+	    call eprintf ("WARNING: Object template %s not found.\n")
+		call pargstr (name)
+	    return (NULL)
+	}
+
+	# Create the template structure if a model is defined..
+	if (prof == NULL && msi == NULL)
+	    mkt = NULL
+	else {
+	    call calloc (mkt, LEN_MKT, TY_STRUCT)
+	    MKT_PROF(mkt) = prof
+	    MKT_MSI(mkt) = msi
+	    MKT_NXM(mkt) = nxm
+	    MKT_NYM(mkt) = nym
+	    MKT_F(mkt) = flux
+	    MKT_SCALE(mkt) = radius
+#call eprintf ("flux = %g, radius = %g\n")
+#call pargr (MKT_F(mkt))
+#call pargr (MKT_SCALE(mkt))
+#do i = 0, nxm {
+#call eprintf ("%d: %g\n")
+#call pargi (i)
+#call pargr (Memr[prof+i])
+#}
+	}
+
+	# Enter object model name in symbol table.
+	sym = stenter (stp, name, 1)
+	Memi[sym] = mkt
+	return (mkt)
+end
+
+
+# MKT_GOBJECT -- Get image raster.
+# The profile type is set by the template structure.
+
+procedure mkt_gobject (mkt, data, nx, ny, x, y, z, r, ar, pa, save)
+
+pointer	mkt		# Object template
+pointer	data		# Data
+int	nx, ny		# Size of returned data
+real	x, y		# Position of object
+real	z		# Flux of object
+real	r		# Major axis scale (pixels)
+real	ar		# Axial ratio (minor / major)
+real	pa		# Position angle (radians)
+int	save		# Use/save template?
+
+real	xc, yc, radius
+int	nprof
+pointer	prof
+
+include	"mktemplates.com"
+
+begin
+	data = NULL
+	if (mkt == NULL)
+	    return
+
+	# Stars are predefined.  Return the nearest template center.
+	# Other objects are computed with or without seeing.
+
+	if (mkt == star)
+	    call mkt_gstar (star, data, nx, ny, x, y, z)
+	else {
+	    xc = x + 0.5 - int (x + 0.5)
+	    yc = y + 0.5 - int (y + 0.5)
+	    call mkt_get (mkt, data, nx, ny, xc, yc, z, r, ar, pa, save)
+	    if (data != NULL)
+		return
+
+	    radius = r * MKT_SCALE(mkt)
+	    nx = max (3, 2 * nint (radius) + 1)
+	    ny = nx
+	    if (see != NULL) {
+	        nx = nx + Memi[MKT_NX(see)] / 2
+	        ny = ny + Memi[MKT_NY(see)] / 2
+	    }
+	    call malloc (data, nx * ny, TY_REAL)
+
+	    if (MKT_PROF(mkt) != 0) {
+	        nprof = 1 + nint (radius * nxgsub * nxgsub)
+	        call malloc (prof, nprof, TY_REAL)
+	        call mkt_binprof (Memr[MKT_PROF(mkt)], MKT_NXM(mkt),
+		    Memr[prof], nprof, radius, nxgsub)
+	        call mkt_profile (data, nx, ny, x, y, z*MKT_F(mkt), Memr[prof],
+		    nprof, radius, ar, pa, nxgsub, nygsub)
+	        call mfree (prof, TY_REAL)
+	    } else {
+	        call mkt_msi (data, nx, ny, x, y, z, MKT_MSI(mkt),
+		    MKT_NXM(mkt), MKT_NYM(mkt), radius, ar, pa,
+		    nxgsub, nygsub)
+	    }
+
+	    call mkt_save (mkt, data, nx, ny, xc, yc, z, r, ar, pa, save)
+	}
+end
+
+
+# MKT_BINPROF -- Bin intensity profile into subpixels
+
+procedure mkt_binprof (prof, nprof, prof1, nprof1, radius, nsub)
+
+real	prof[nprof]		# Input intensity profile
+int	nprof			# Number of input points
+real	prof1[nprof]		# Output binned intensity profile
+int	nprof1			# Number of output points
+real	radius			# Radius of profile
+int	nsub			# Maximum subsampling
+
+int	i, j, k, k1, k2, l, dx
+real	scale, dy, val
+
+int	debug, open()
+data	debug/0/
+
+begin
+	if (radius < 0.1) {
+	    call amovkr (1., prof1, nprof1)
+	    return
+	} else
+	    call aclrr (prof1, nprof1)
+
+	# Set binning parameters
+	scale = (nprof - 1.) / (nprof1 - 1.)
+	dx = nint ((nprof1 - 1.) / nsub / radius / 2.)
+	dy = dx / (NY - 1.)
+
+	# Bin central pixels
+	do i = -dx, 2*dx {
+	    k = abs (i)
+	    k1 = max (1, i - dx + 1) 
+	    k2 = i + dx + 1
+	    do j = 0, NY-1 {
+		if (j == 0)
+		    val = k
+		else if (k == 0)
+		    val = dy * j
+		else
+		    val = k * sqrt (1. + (dy * j / k) ** 2)
+		l = nint (scale * val + 1)
+		if (l > nprof)
+		    next
+		val = prof[l] / NY
+		do l = k1, k2
+		    prof1[l] = prof1[l] + val
+	    }
+	}
+
+	# Now bin remainder of pixels more crudely
+	do i = 2*dx+1, nprof1-1 {
+	    k1 = i - dx + 1
+	    k2 = min (nprof1, i + dx + 1)
+	    val = prof[nint (scale * i + 1)]
+	    do k = k1, k2
+		prof1[k] = prof1[k] + val
+	}
+
+	if (debug == YES) {
+	    j = open ("debug1.dat", APPEND, TEXT_FILE)
+	    do i = 1, nprof {
+		call fprintf (j, "%d %g\n")
+		    call pargi (i)
+		    call pargr (prof[i])
+	    }
+	    call close (j)
+
+	    j = open ("debug2.dat", APPEND, TEXT_FILE)
+	    do i = 1, nprof1 {
+		call fprintf (j, "%d %g\n")
+		    call pargi (i)
+		    call pargr (prof1[i])
+	    }
+	    call close (j)
+	}
+end
+
+
+# MKT_GSTAR -- Get the precomputed template with center nearest (x,y).
+
+procedure mkt_gstar (mkt, data, nx, ny, x, y, z)
+
+pointer	mkt		# Template
+pointer	data		# Data
+int	nx, ny		# Size of data
+real	x, y		# Position of object
+real	z		# Flux of object
+
+int	i, j
+real	f
+
+include	"mktemplates.com"
+
+begin
+	i = (x + 0.5 - int (x + 0.5)) * nxc
+	j = (y + 0.5 - int (y + 0.5)) * nyc
+	i = j * nxc + i
+	data = Memi[MKT_PTRS(mkt)+i]
+	nx = Memi[MKT_NX(mkt)+i]
+	ny = Memi[MKT_NY(mkt)+i]
+	f = Memr[MKT_FLUX(mkt)+i]
+	if (f != z) {
+	    call amulkr (Memr[data], z/f, Memr[data], nx*ny)
+	    Memr[MKT_FLUX(mkt)+i] = z
+	}
+end
+
+
+# MKT_PROFILE -- Make template from profile.
+
+procedure mkt_profile (data, nx, ny, xc, yc, flux, prof, npts, radius,
+	ar, pa, nxsub, nysub)
+
+pointer	data		# Pointer to data array
+int	nx, ny		# Size of template
+real	xc, yc		# Model center
+real	flux		# Model flux
+real	prof[npts]	# 1D profile
+int	npts		# Number of points in profile
+real	radius		# Major axis radius of profile (pixels)
+real	ar		# Axial ratio (minor / major)
+real	pa		# Position angle relative to major axis (radians)
+int	nxsub, nysub	# Number of subpixel samples
+
+int	i, n, nxs, nys, nxs2, nys2, xs1, xs2, ys1, ys2
+int	x, y, x2, y2
+real	a, b, c, r, s, t, z, sum, sum1, asumr()
+real	dx, dy, dsub, dsub2
+real	x1, y1, xc1, yc1
+pointer	ptr, ptr1, ptr2, see1, see2
+
+include	"mktemplates.com"
+
+define	see_	99
+
+begin
+	# Switch on the size of the seeing templates.
+	if (see != NULL)
+	    if (Memi[MKT_NX(see)] * Memi[MKT_NY(see)] > 1)
+	        goto see_
+
+# NO SEEING:
+
+	# If the radius is very small return delta function.
+	if (radius < 0.1) {
+	    call aclrr (Memr[data], nx*ny)
+	    Memr[data+(ny/2)*nx+(nx/2)] = flux
+	    return
+	}
+
+	# Compute elliptical scale factors for entry into profile array.
+	r = ((npts - 1) / radius) ** 2
+	t = ((npts - 1) / (ar * radius)) ** 2
+	c = cos (pa)
+	s = sin (pa)
+	a = r * c * c + t * s * s
+	b = 2 * (r - t) * c * s
+	c = r * s * s + t * c * c
+
+	# Subsample the profile and sum into each pixel.
+	n = nx * ny
+	xc1 = xc - int (xc + 0.5) + nx/2
+	yc1 = yc - int (yc + 0.5) + ny/2
+
+	sum1 = 0.
+	ptr = data
+	do y = 0, ny-1 {
+	    t = (y - yc1) ** 2
+	    do x = 0, nx-1 {
+		i = sqrt ((x - xc1) ** 2 + t)
+		dsub = 1. / max (1, nxsub - i)
+		sum = 0.
+		for (y1 = y-0.5+dsub/2; y1 < y+0.5; y1 = y1+dsub) {
+		    dy = (y1 - yc1)
+		    s = c * dy**2
+		    for (x1=x-0.5+dsub/2; x1<x+0.5; x1=x1+dsub) {
+			dx = (x1-xc1)
+			i = sqrt (a * dx**2 + b * dx * dy + s) + 1.5
+			if (i <= npts)
+			    sum = sum + prof[i]
+		    }
+		}
+		sum = sum * dsub ** 2
+		sum1 = sum1 + sum
+		Memr[ptr] = sum
+		ptr = ptr + 1
+	    }
+	}
+
+	# If the subsamples completely miss and signal is zero then return
+	# delta function otherwise scale to requested flux.
+
+	if (sum1 == 0.)
+	    Memr[data+(ny/2)*nx+(nx/2)] = flux
+	else
+	    call amulkr (Memr[data], flux/sum1, Memr[data], n)
+	return
+
+# WITH SEEING:
+
+see_	n = nx * ny
+	call aclrr (Memr[data], n)
+	sum = 0.
+
+	nxs = Memi[MKT_NX(see)]
+	nys = Memi[MKT_NY(see)]
+	nxs2 = nxs/2
+	nys2 = nys/2
+
+	# If the profile is very small return full star image rather than
+	# convolution with truncated seeing template.
+
+	if (radius > 0.01) {
+	    r = ((npts - 1) / radius) ** 2
+	    t = ((npts - 1) / (ar * radius)) ** 2
+	    c = cos (pa)
+	    s = sin (pa)
+	    a = r * c * c + t * s * s
+	    b = 2 * (r - t) * c * s
+	    c = r * s * s + t * c * c
+    
+	    xc1 = xc - int (xc + 0.5) + nx/2
+	    yc1 = yc - int (yc + 0.5) + ny/2
+	    ptr = data-nys2*nx-nxs2
+	    do y = 0, ny-1 {
+		t = (y - yc1) ** 2
+		ys1 = max (0, nys2 - y)
+		ys2 = min (nys-1, ny - y + nys2 - 1)
+		do x = 0, nx-1 {
+		    i = sqrt ((x - xc1) ** 2 + t)
+		    dsub = 1. / max (1, nxsub - i)
+		    dsub2 = dsub ** 2
+		    xs1 = max (0, nxs2 - x)
+		    xs2 = min (nxs-1, nx - x + nxs2 - 1)
+		    ptr1 = ptr + xs1
+		    for (y1=y-0.5+dsub/2; y1<y+0.5; y1=y1+dsub) {
+			dy = (y1 - yc1)
+			s = c * dy**2
+			for (x1=x-0.5+dsub/2; x1<x+0.5; x1=x1+dsub) {
+			    dx = (x1-xc1)
+			    i = sqrt (a * dx**2 + b * dx * dy + s) + 1.5
+			    if (i <= npts) {
+				z = prof[i] * dsub2
+				call mkt_gstar (see, see1, nxs, nys, x1, y1, 1.)
+				see1 = see1 + xs1
+				do y2 = ys1, ys2 {
+				   see2 = see1+y2*nxs
+				   ptr2 = ptr1+y2*nx
+				   do x2 = xs1, xs2 {
+				       Memr[ptr2] = Memr[ptr2] +
+					   z * Memr[see2]
+				       ptr2 = ptr2 + 1
+				       see2 = see2 + 1
+				    }
+				}
+			    }
+			}
+		    }
+		    ptr = ptr + 1
+		}
+	    }
+	    sum = asumr (Memr[data], n)
+	}
+
+	# If no flux is accumulated or radius is very small return star image.
+	# Otherwise scale to requested flux.
+
+	if (sum == 0.) {
+	    call mkt_gstar (star, see1, nxs, nys, xc, yc, flux)
+	    x = nx/2
+	    y = ny/2
+	    nxs2 = nxs / 2
+	    nys2 = nys / 2
+	    xs1 = max (0, nxs2 - x)
+	    xs2 = min (nxs-1, nx - x + nxs2 - 1)
+	    ys1 = max (0, nys2 - y)
+	    ys2 = min (nys-1, ny - y + nys2 - 1)
+	    ptr1 = data-nys2*nx-nxs2+(y*nx+x+xs1)
+	    see1 = see1 + xs1
+	    do y2 = ys1, ys2 {
+	       see2 = see1+y2*nxs
+	       ptr2 = ptr1+y2*nx
+	       do x2 = xs1, xs2 {
+		   Memr[ptr2] = Memr[ptr2] + Memr[see2]
+		   ptr2 = ptr2 + 1
+		   see2 = see2 + 1
+		}
+	    }
+	} else
+	    call amulkr (Memr[data], flux/sum, Memr[data], n)
+end
+
+
+# MKT_MSI -- Make template from image interpolation function.
+
+procedure mkt_msi (data, nx, ny, xc, yc, flux, model, nxm, nym, radius,
+	ar, pa, nxsub, nysub)
+
+pointer	data		# Pointer to data array
+int	nx, ny		# Size of template
+real	xc, yc		# Model center
+real	flux		# Model flux
+pointer	model		# Surface interpolation pointer for image template
+int	nxm, nym	# Number of points in image template
+real	radius		# Major axis radius of profile (pixels)
+real	ar		# Axial ratio (minor / major)
+real	pa		# Position angle relative to major axis (radians)
+int	nxsub, nysub	# Number of subpixel samples
+
+int	i, n, nxs, nys, nxs2, nys2, xs1, xs2, ys1, ys2, x, y, x2, y2
+real	a, b, c, s, xcm, ycm, x1, y1, xc1, yc1, dsub, sum, sum1
+real	ac, as, bc, bs, acdx1, acdx2, bsdx1, bsdx2, bcdy1, bcdy2, asdy1, asdy2
+real	val1, val2, val3, val4, minval, maxval, xm[5], ym[5]
+real	asumr(), msigrl(), msisqgrl()
+pointer	ptr, ptr1, ptr2, see1, see2
+
+include	"mktemplates.com"
+
+define	see_	99
+
+begin
+	# Switch on the size of the seeing templates.
+	if (see != NULL)
+	    if (Memi[MKT_NX(see)] * Memi[MKT_NY(see)] > 1)
+	        goto see_
+
+# NO SEEING:
+
+	# If the radius is very small return delta function.
+	if (radius < 0.1) {
+	    call aclrr (Memr[data], nx*ny)
+	    Memr[data+(ny/2)*nx+(nx/2)] = flux
+	    return
+	}
+
+	a = (nxm / 2.) / radius
+	b = (nym / 2.) / (ar * radius)
+	c = cos (pa)
+	s = sin (pa)
+	ac = a * c
+	as = a * s
+	bc = b * c
+	bs = b * s
+	a = nxm
+	b = nym
+	xcm = nxm / 2 + 1.
+	ycm = nym / 2 + 1.
+
+	# Subsample the profile and sum into each pixel.
+	n = nx * ny
+	xc1 = xc - int (xc + 0.5) + nx/2
+	yc1 = yc - int (yc + 0.5) + ny/2
+
+	sum1 = 0.
+	ptr = data
+	do y = 0, ny-1 {
+	    c = (y - yc1) ** 2
+	    do x = 0, nx-1 {
+		i = sqrt ((x - xc1) ** 2 + c)
+		dsub = 1. / max (1, nxsub - i)
+		sum = 0.
+		for (y1 = y-0.5; y1 < y+0.5-dsub/2; y1 = y1+dsub) {
+		    asdy1 = (y1 - yc1)
+		    asdy2 = asdy1 + dsub
+		    bcdy1 = bc * asdy1 + ycm
+		    bcdy2 = bc * asdy2 + ycm
+		    if (pa == 0.) {
+			val3 = max (1., bcdy1)
+			if (val3 >= nym)
+			    next
+			val4 = min (b, bcdy2)
+			if (val3 >= val4)
+			    next
+		    }
+		    asdy1 = as * asdy1
+		    asdy2 = as * asdy2
+		    for (x1=x-0.5; x1<x+0.5-dsub/2; x1=x1+dsub) {
+			bsdx1 = (x1-xc1)
+			bsdx2 = bsdx1 + dsub
+			acdx1 = ac * bsdx1 + xcm
+			acdx2 = ac * bsdx2 + xcm
+			if (pa == 0.) {
+			    val1 = max (1., acdx1)
+			    if (val1 >= nxm)
+				next
+			    val2 = min (a, acdx2)
+			    if (val1 >= val2)
+				next
+			    s = msisqgrl (model, val1, val2, val3, val4)
+			} else {
+			    bsdx1 = bs * bsdx1
+			    bsdx2 = bs * bsdx2
+
+			    val1 = acdx1 + asdy1
+			    val2 = acdx2 + asdy1
+			    val3 = acdx2 + asdy2
+			    val4 = acdx1 + asdy2
+			    minval = min (val1, val2, val3, val4)
+			    maxval = max (val1, val2, val3, val4)
+			    if (minval >= a || maxval <= 1.)
+				next
+			    xm[1] = max (1., min (a, val1))
+			    xm[2] = max (1., min (a, val2))
+			    xm[3] = max (1., min (a, val3))
+			    xm[4] = max (1., min (a, val4))
+			    xm[5] = xm[1]
+
+			    val1 = bcdy1 - bsdx1
+			    val2 = bcdy1 - bsdx2
+			    val3 = bcdy2 - bsdx2
+			    val4 = bcdy2 - bsdx1
+			    minval = min (val1, val2, val3, val4)
+			    maxval = max (val1, val2, val3, val4)
+			    if (minval >= b || maxval <= 1.)
+				next
+			    ym[1] = max (1., min (b, val1))
+			    ym[2] = max (1., min (b, val2))
+			    ym[3] = max (1., min (b, val3))
+			    ym[4] = max (1., min (b, val4))
+			    ym[5] = ym[1]
+			    y2 = 1
+			    do x2 = 2, 4
+				if (ym[x2] < ym[y2])
+				    y2 = x2
+			    switch (y2) {
+			    case 2:
+				xm[1] = xm[2]; ym[1] = ym[2]
+				xm[2] = xm[3]; ym[2] = ym[3]
+				xm[3] = xm[4]; ym[3] = ym[4]
+				xm[4] = xm[5]; ym[4] = ym[5]
+				xm[5] = xm[1]; ym[5] = ym[1]
+			    case 3:
+				xm[1] = xm[3]; ym[1] = ym[3]
+				xm[3] = xm[5]; ym[3] = ym[5]
+				xm[5] = xm[2]; ym[5] = ym[2]
+				xm[2] = xm[4]; ym[2] = ym[4]
+				xm[4] = xm[5]; ym[4] = ym[5]
+				xm[5] = xm[1]; ym[5] = ym[1]
+			    case 4:
+				xm[5] = xm[4]; ym[5] = ym[4]
+				xm[4] = xm[3]; ym[4] = ym[3]
+				xm[3] = xm[2]; ym[3] = ym[2]
+				xm[2] = xm[1]; ym[2] = ym[1]
+				xm[1] = xm[5]; ym[1] = ym[5]
+			    }
+
+			    s = msigrl (model, xm, ym, 5)
+			}
+			sum = sum + s
+		    }
+		}
+		sum1 = sum1 + sum
+		Memr[ptr] = sum
+		ptr = ptr + 1
+	    }
+	}
+
+	call amulkr (Memr[data], flux/sum1, Memr[data], n)
+	return
+
+# SEEING:
+
+see_	n = nx * ny
+	call aclrr (Memr[data], n)
+	sum = 0.
+
+	nxs = Memi[MKT_NX(see)]
+	nys = Memi[MKT_NY(see)]
+	nxs2 = nxs/2
+	nys2 = nys/2
+
+	# If the profile is very small return full star image rather than
+	# convolution with truncated seeing template.
+
+	if (radius > 0.01) {
+	    a = (nxm / 2.) / radius
+	    b = (nym / 2.) / (ar * radius)
+	    c = cos (pa)
+	    s = sin (pa)
+	    ac = a * c
+	    as = a * s
+	    bc = b * c
+	    bs = b * s
+	    a = nxm
+	    b = nym
+	    xcm = nxm / 2 + 1.
+	    ycm = nym / 2 + 1.
+    
+	    xc1 = xc - int (xc + 0.5) + nx/2
+	    yc1 = yc - int (yc + 0.5) + ny/2
+	    ptr = data-nys2*nx-nxs2
+	    do y = 0, ny-1 {
+		c = (y - yc1) ** 2
+		ys1 = max (0, nys2 - y)
+		ys2 = min (nys-1, ny - y + nys2 - 1)
+		do x = 0, nx-1 {
+		    i = sqrt ((x - xc1) ** 2 + c)
+		    dsub = 1. / max (1, nxsub - i)
+		    xs1 = max (0, nxs2 - x)
+		    xs2 = min (nxs-1, nx - x + nxs2 - 1)
+		    ptr1 = ptr + xs1
+		    for (y1=y-0.5; y1<y+0.5-dsub/2; y1=y1+dsub) {
+			asdy1 = (y1 - yc1)
+			asdy2 = asdy1 + dsub
+			bcdy1 = bc * asdy1 + ycm
+			bcdy2 = bc * asdy2 + ycm
+		        if (pa == 0.) {
+			    val3 = max (1., bcdy1)
+			    if (val3 >= nym)
+			        next
+			    val4 = min (b, bcdy2)
+			    if (val3 >= val4)
+			        next
+		        }
+			asdy1 = as * asdy1
+			asdy2 = as * asdy2
+		        for (x1=x-0.5; x1<x+0.5-dsub/2; x1=x1+dsub) {
+			    bsdx1 = (x1-xc1)
+			    bsdx2 = bsdx1 + dsub
+			    acdx1 = ac * bsdx1 + xcm
+			    acdx2 = ac * bsdx2 + xcm
+			    if (pa == 0.) {
+			        val1 = max (1., acdx1)
+			        if (val1 >= nxm)
+				    next
+			        val2 = min (a, acdx2)
+			        if (val1 >= val2)
+				    next
+			        sum = msisqgrl (model, val1, val2, val3, val4)
+			    } else {
+			        bsdx1 = bs * bsdx1
+			        bsdx2 = bs * bsdx2
+
+			        val1 = acdx1 + asdy1
+			        val2 = acdx2 + asdy1
+			        val3 = acdx2 + asdy2
+			        val4 = acdx1 + asdy2
+			        minval = min (val1, val2, val3, val4)
+			        maxval = max (val1, val2, val3, val4)
+			        if (minval >= a || maxval <= 1.)
+				    next
+			        xm[1] = max (1., min (a, val1))
+			        xm[2] = max (1., min (a, val2))
+			        xm[3] = max (1., min (a, val3))
+			        xm[4] = max (1., min (a, val4))
+			        xm[5] = xm[1]
+
+			        val1 = bcdy1 - bsdx1
+			        val2 = bcdy1 - bsdx2
+			        val3 = bcdy2 - bsdx2
+			        val4 = bcdy2 - bsdx1
+			        minval = min (val1, val2, val3, val4)
+			        maxval = max (val1, val2, val3, val4)
+			        if (minval >= b || maxval <= 1.)
+				    next
+			        ym[1] = max (1., min (b, val1))
+			        ym[2] = max (1., min (b, val2))
+			        ym[3] = max (1., min (b, val3))
+			        ym[4] = max (1., min (b, val4))
+			        ym[5] = ym[1]
+
+# The following is put in to work around a bug in msigrl in V2.8.  When
+# V2.8 is long gone we can take this stuff out since msigrl will do the
+# rotating of the coordinates itself.
+
+				minval = max (1., minval)
+				y2 = 1
+				do x2 = 2, 4
+				    if (ym[x2] < ym[y2])
+					y2 = x2
+				switch (y2) {
+				case 2:
+				    xm[1] = xm[2]; ym[1] = ym[2]
+				    xm[2] = xm[3]; ym[2] = ym[3]
+				    xm[3] = xm[4]; ym[3] = ym[4]
+				    xm[4] = xm[5]; ym[4] = ym[5]
+				    xm[5] = xm[1]; ym[5] = ym[1]
+				case 3:
+				    xm[1] = xm[3]; ym[1] = ym[3]
+				    xm[3] = xm[5]; ym[3] = ym[5]
+				    xm[5] = xm[2]; ym[5] = ym[2]
+				    xm[2] = xm[4]; ym[2] = ym[4]
+				    xm[4] = xm[5]; ym[4] = ym[5]
+				    xm[5] = xm[1]; ym[5] = ym[1]
+				case 4:
+				    xm[5] = xm[4]; ym[5] = ym[4]
+				    xm[4] = xm[3]; ym[4] = ym[3]
+				    xm[3] = xm[2]; ym[3] = ym[2]
+				    xm[2] = xm[1]; ym[2] = ym[1]
+				    xm[1] = xm[5]; ym[1] = ym[5]
+				}
+
+			        sum = msigrl (model, xm, ym, 5)
+			    }
+	    		    call mkt_gstar (see, see1, nxs, nys, x1, y1, 1.)
+			    see1 = see1 + xs1
+			    do y2 = ys1, ys2 {
+				see2 = see1+y2*nxs
+				ptr2 = ptr1+y2*nx
+				do x2 = xs1, xs2 {
+				    Memr[ptr2] = Memr[ptr2] + sum * Memr[see2]
+				    ptr2 = ptr2 + 1
+				    see2 = see2 + 1
+				}
+			    }
+			}
+		    }
+		    ptr = ptr + 1
+		}
+	    }
+	    sum = asumr (Memr[data], n)
+	}
+
+	# If no flux is accumulated or radius is very small return star image.
+	# Otherwise scale to requested flux.
+
+	if (sum == 0.) {
+	    call mkt_gstar (star, see1, nxs, nys, xc, yc, flux)
+	    x = nx/2
+	    y = ny/2
+	    nxs2 = nxs / 2
+	    nys2 = nys / 2
+	    xs1 = max (0, nxs2 - x)
+	    xs2 = min (nxs-1, nx - x + nxs2 - 1)
+	    ys1 = max (0, nys2 - y)
+	    ys2 = min (nys-1, ny - y + nys2 - 1)
+	    ptr1 = data-nys2*nx-nxs2+(y*nx+x+xs1)
+	    see1 = see1 + xs1
+	    do y2 = ys1, ys2 {
+	       see2 = see1+y2*nxs
+	       ptr2 = ptr1+y2*nx
+	       do x2 = xs1, xs2 {
+		   Memr[ptr2] = Memr[ptr2] + Memr[see2]
+		   ptr2 = ptr2 + 1
+		   see2 = see2 + 1
+		}
+	    }
+	} else
+	    call amulkr (Memr[data], flux/sum, Memr[data], n)
+end
+
+
+# UIGAMMA -- Upper Incomplete Gamma Function ratioed to Complete.
+#
+#	uigamma(n,x) = e^(x) sum (x^k/k!) for k=0, n-1
+
+double procedure uigamma (n, x)
+
+int	n		#I argument
+real	x		#I argument
+
+int	i
+double	uigamma, numerator, denominator
+
+begin
+	numerator = exp(-x)
+	denominator = 1
+	uigamma = numerator / denominator
+	do i = 1, n-1 {
+	    numerator = numerator * x
+	    denominator = denominator * i
+	    uigamma = uigamma + numerator / denominator
+	}
+	return (uigamma)
+end
diff --git a/noao/artdata/mktemplates.xBAK b/noao/artdata/mktemplates.xBAK
new file mode 100644
index 00000000..ba8cac01
--- /dev/null
+++ b/noao/artdata/mktemplates.xBAK
@@ -0,0 +1,1326 @@
+include	<error.h>
+include	<imhdr.h>
+include	<math.h>
+include	<math/iminterp.h>
+
+# Template data structure
+define	LEN_MKT		18
+define	MKT_PROF	Memi[$1]	# Pointer to profile
+define	MKT_MSI		Memi[$1+1]	# MSI interpolation pointer
+define	MKT_NXM		Memi[$1+2]	# Number of X points in model
+define	MKT_NYM		Memi[$1+3]	# Number of Y points in model
+define	MKT_F		Memr[P2R($1+4)]	# Fraction of total flux in profile
+define	MKT_SCALE	Memr[P2R($1+5)]	# Radius scale
+
+define	MKT_NALLOC	Memi[$1+6]	# Allocated space for saved templates
+define	MKT_N		Memi[$1+7]	# Number of saved templates
+
+define	MKT_DATA	Memi[$1+8]	# Data pointer
+define	MKT_PTRS	Memi[$1+9]	# Data pointers
+define	MKT_NX		Memi[$1+10]	# Number of X pixels
+define	MKT_NY		Memi[$1+11]	# Number of Y pixels
+define	MKT_XC		Memi[$1+12]	# Subpixel X center
+define	MKT_YC		Memi[$1+13]	# Subpixel Y center
+define	MKT_FLUX	Memi[$1+14]	# Flux
+define	MKT_R		Memi[$1+15]	# Radius
+define	MKT_AR		Memi[$1+16]	# Axial ratio
+define	MKT_PA		Memi[$1+17]	# Position angle
+
+define	NALLOC	25		# Allocation block for saved templates
+define	NPROF	5001		# Profile length
+define	NY	11		# BINPROF binning parameter
+
+
+# MKT_INIT    -- Initialize template memory.
+# MKT_FREE    -- Free template memory.
+# MKT_SAVE    -- Save a template
+# MKT_GET     -- Get a template
+# MKT_STAR    -- Set star and seeing templates.
+# MKT_OBJECT  -- Set object profiles.
+# MKT_GOBJECT -- Get image raster.
+# MKT_BINPROF -- Bin intensity profile
+# MKT_GSTAR   -- Get the precomputed template with center nearest (x,y).
+# MKT_PROFILE -- Make template from profile.
+# MKT_MSI     -- Make template from image interpolation function.
+
+
+# MKT_INIT -- Initialize template memory.
+# The symbol table is used as a simple way to store the object types by name.
+
+procedure mkt_init ()
+
+int	clgeti()
+real	clgetr()
+
+pointer	stopen()
+include	"mktemplates.com"
+
+begin
+	nxc = clgeti ("nxc")
+	nyc = clgeti ("nyc")
+	nxssub = clgeti ("nxsub")
+	nyssub = clgeti ("nysub")
+	nxgsub = clgeti ("nxgsub")
+	nygsub = clgeti ("nygsub")
+	dynrange = clgetr ("dynrange")
+	psfrange = clgetr ("psfrange")
+	stp = stopen ("mkt", 10, 10, 10*SZ_FNAME)
+end
+
+
+# MKT_FREE -- Free template memory.
+
+procedure mkt_free ()
+
+int	i
+pointer sym, mkt, sthead(), stnext()
+include	"mktemplates.com"
+
+begin
+	# For each object type free the profile and image interpolator data,
+	# the last unsaved data buffer, all saved templates, and the object
+	# structure.  Finally free the symbol table.
+
+	for (sym = sthead (stp); sym != NULL; sym = stnext (stp, sym)) {
+	    mkt = Memi[sym]
+	    if (mkt != NULL) {
+	        call mfree (MKT_PROF(mkt), TY_REAL)
+		if (MKT_MSI(mkt) != NULL)
+		   call msifree (MKT_MSI(mkt))
+	        call mfree (MKT_DATA(mkt), TY_REAL)
+		if (MKT_NALLOC(mkt) > 0) {
+		    do i = 0, MKT_N(mkt)-1
+		        call mfree (Memi[MKT_PTRS(mkt)+i], TY_REAL)
+		    call mfree (MKT_PTRS(mkt), TY_POINTER)
+		    call mfree (MKT_NX(mkt), TY_INT)
+		    call mfree (MKT_NY(mkt), TY_INT)
+		    call mfree (MKT_XC(mkt), TY_REAL)
+		    call mfree (MKT_YC(mkt), TY_REAL)
+		    call mfree (MKT_FLUX(mkt), TY_REAL)
+		    call mfree (MKT_R(mkt), TY_REAL)
+		    call mfree (MKT_AR(mkt), TY_REAL)
+		    call mfree (MKT_PA(mkt), TY_REAL)
+		}
+	        call mfree (mkt, TY_STRUCT)
+	    }
+	}
+	call stclose (stp)
+end
+
+
+# MKT_SAVE -- Save a template
+# If a template may be used more than once it may be saved upon direction of
+# the user in the object list.  Otherwise the last unsaved template is
+# freed for the next object.
+
+procedure mkt_save (mkt, data, nx, ny, xc, yc, flux, r, ar, pa, save)
+
+pointer	mkt		#I MKT pointer
+pointer	data		#I Pointer to template data
+int	nx, ny		#I Size of template
+real	xc, yc		#I Subpixel center
+real	flux		#I Flux
+real	r		#I Effective radius
+real	ar		#I Axial ratio
+real	pa		#I Position angle
+int	save		#I Save data?
+
+int	i
+
+begin
+	if (save == NO) {
+	    MKT_DATA(mkt) = data
+	    return
+	}
+
+	if (MKT_NALLOC(mkt) == 0) {
+	    i = NALLOC
+	    call malloc (MKT_PTRS(mkt), i, TY_POINTER)
+	    call malloc (MKT_NX(mkt), i, TY_INT)
+	    call malloc (MKT_NY(mkt), i, TY_INT)
+	    call malloc (MKT_XC(mkt), i, TY_REAL)
+	    call malloc (MKT_YC(mkt), i, TY_REAL)
+	    call malloc (MKT_FLUX(mkt), i, TY_REAL)
+	    call malloc (MKT_R(mkt), i, TY_REAL)
+	    call malloc (MKT_AR(mkt), i, TY_REAL)
+	    call malloc (MKT_PA(mkt), i, TY_REAL)
+	    MKT_NALLOC(mkt) = i
+	} else if (MKT_N(mkt) == MKT_NALLOC(mkt)) {
+	    i = MKT_NALLOC(mkt) + NALLOC
+	    call realloc (MKT_PTRS(mkt), i, TY_POINTER)
+	    call realloc (MKT_NX(mkt), i, TY_INT)
+	    call realloc (MKT_NY(mkt), i, TY_INT)
+	    call realloc (MKT_XC(mkt), i, TY_REAL)
+	    call realloc (MKT_YC(mkt), i, TY_REAL)
+	    call realloc (MKT_FLUX(mkt), i, TY_REAL)
+	    call realloc (MKT_R(mkt), i, TY_REAL)
+	    call realloc (MKT_AR(mkt), i, TY_REAL)
+	    call realloc (MKT_PA(mkt), i, TY_REAL)
+	    MKT_NALLOC(mkt) = i
+	}
+	i = MKT_N(mkt)
+	Memi[MKT_PTRS(mkt)+i] = data
+	Memi[MKT_NX(mkt)+i] = nx
+	Memi[MKT_NY(mkt)+i] = ny
+	Memr[MKT_XC(mkt)+i] = xc
+	Memr[MKT_YC(mkt)+i] = yc
+	Memr[MKT_FLUX(mkt)+i] = flux
+	Memr[MKT_R(mkt)+i] = r
+	Memr[MKT_AR(mkt)+i] = ar
+	Memr[MKT_PA(mkt)+i] = pa
+	MKT_N(mkt) = i + 1
+end
+
+
+# MKT_GET -- Get a template
+# If not a saved template just free last unsaved template.
+# If saved search for match with position, size, axial ratio, and pa.
+# Return null if not found.
+
+procedure mkt_get (mkt, data, nx, ny, xc, yc, flux, r, ar, pa, save)
+
+pointer	mkt		#I MKT pointer
+pointer	data		#O Pointer to template data
+int	nx, ny		#O Size of template
+real	xc, yc		#I Subpixel center
+real	flux		#I Flux
+real	r		#I Effective radius
+real	ar		#I Axial ratio
+real	pa		#I Position angle
+int	save		#I Get saved template?
+
+int	i
+real	f
+
+begin
+	data = NULL
+	call mfree (MKT_DATA(mkt), TY_REAL)
+	if (save == NO)
+	    return
+
+	for (i=0; i<MKT_N(mkt); i=i+1) {
+	    if (xc != Memr[MKT_XC(mkt)+i])
+		next
+	    if (yc != Memr[MKT_YC(mkt)+i])
+		next
+	    if (r != Memr[MKT_R(mkt)+i])
+		next
+	    if (ar != Memr[MKT_AR(mkt)+i])
+		next
+	    if (pa != Memr[MKT_PA(mkt)+i])
+		next
+	    data = Memi[MKT_PTRS(mkt)+i]
+	    nx = Memi[MKT_NX(mkt)+i]
+	    ny = Memi[MKT_NY(mkt)+i]
+	    f = Memr[MKT_FLUX(mkt)+i]
+	    if (f != flux) {
+	        call amulkr (Memr[data], flux/f, Memr[data], nx*ny)
+	        Memr[MKT_FLUX(mkt)+i] = flux
+	    }
+	    return
+	}
+end
+
+
+# MKT_STAR -- Define star and seeing templates.
+# The seeing template has a smaller range for efficiency.
+# THe star templates are determined once over a grid of centers and
+# then not evaluated again.
+
+pointer procedure mkt_star (name)
+
+char	name[ARB]	# Profile name or file
+
+# Star and seeing parameters obatined through CLIO.
+real	r		# Major axis sigma (pixels)
+real	ar		# Axial ratio (minor / major)
+real	pa		# Position angle (radians)
+
+int	i, j, nxm, nym, nx, ny, fd
+real	dr, flux, radius, seeing, beta, xc, yc, dxc, dyc, der[2]
+pointer	sym, mkt1, mkt2, prof, prof1, asi, msi, data, im
+
+bool	streq()
+real	clgetr(), asieval()
+int	open(), fscan(), nscan()
+pointer	immap(), imgs2r(), stfind(), stenter()
+errchk	immap, open, imgs2r, asifit, asieval, asider
+
+include	"mktemplates.com"
+
+begin
+	# Check if previously defined.
+	sym = stfind (stp, "star")
+	if (sym != NULL)
+	    return (Memi[sym])
+
+	# Select type of star profile and set intensity profile array.
+	# Compute the fraction of the total flux in the profile.
+	# Insure that the profile subsamples a subpixel.
+
+	star = NULL
+	see = NULL
+	prof = NULL
+	msi = NULL
+	if (streq (name, "gaussian")) {
+	    r = clgetr ("radius") / sqrt (log (2.))
+	    radius = sqrt (log (dynrange))
+	    seeing = sqrt (log (psfrange))
+	    nxm = max (NPROF, 1 + nint (radius*r*nxssub*nyssub))
+	    call malloc (prof, nxm, TY_REAL)
+
+	    dr = radius / (nxm - 1)
+	    do i = 0, nxm - 1
+		Memr[prof+i] = exp (-(i * dr) ** 2)
+	    flux = 1 - Memr[prof+nxm-1]
+
+	    r = sqrt (log (2.))
+	    radius = radius / r
+	    seeing = seeing / r
+	} else if (streq (name, "moffat")) {
+	    beta = clgetr ("beta")
+	    r = clgetr ("radius") / sqrt (2. ** (1/beta) - 1.)
+	    radius = sqrt ((dynrange) ** (1/beta) - 1)
+	    seeing = sqrt ((psfrange) ** (1/beta) - 1)
+	    nxm = max (NPROF, 1 + nint (radius*r*nxssub*nyssub))
+	    call malloc (prof, nxm, TY_REAL)
+
+	    dr = radius / (nxm - 1)
+	    flux = 0
+	    do i = 0, nxm - 1 {
+		r = i * dr
+		Memr[prof+i] =  1. / ((1 + r**2) ** beta)
+		flux = flux + r * Memr[prof+i]
+	    }
+
+	    # Compute the fraction of the total flux in the profile.
+	    # The last part of the total flux below is computed by expanding
+	    # (1+r**2) --> r**2 under the approximation that r >> 1.
+	    # Note that it is possible to explicitly compute the total
+	    # flux  F(total) = beta / (2 * beta - 2) (CRC 53rd edition)
+	    # I found errors in other versions of CRC for this integral!
+
+	    r = r + dr / 2
+	    xc = 2 * beta - 2
+	    flux = flux / (flux + 1. / (xc * r ** xc))
+
+	    r = sqrt (2. ** (1/beta) - 1.)
+	    radius = radius / r
+	    seeing = seeing / r
+	} else ifnoerr (im = immap (name, READ_ONLY, 0)) {
+	    iferr {
+		nxm = IM_LEN(im,1)
+		nym = IM_LEN(im,2)
+		data = imgs2r (im, 1, nxm, 1, nym)
+		call msiinit (msi, II_BILINEAR)
+		call msifit (msi, Memr[data], nxm, nym, nxm)
+	    } then
+		call erract (EA_WARN)
+	    call imunmap (im)
+
+	    flux = 1.
+	    radius = 1
+	    seeing = 0.8
+	} else ifnoerr (fd = open (name, READ_ONLY, TEXT_FILE)) {
+	    nxm = NPROF
+	    call malloc (prof1, nxm, TY_REAL)
+
+	    j = 0
+	    while (fscan (fd) != EOF) {
+	 	call gargr (flux)
+		if (nscan() < 1)
+		    next
+		if (j == nxm) {
+		    nxm = nxm + NPROF
+		    call realloc (prof1, nxm, TY_REAL)
+		}
+		Memr[prof1+j] = flux
+		j = j + 1
+	    }
+	    call close (fd)
+	    if (j == 0) {
+		call mfree (prof1, TY_REAL)
+		call error (1, "PSF template not found")
+	    }
+
+	    r = clgetr ("radius")
+	    nxm = max (NPROF, 1 + nint (r*nxssub*nyssub))
+	    call malloc (prof, nxm, TY_REAL)
+	    dr = 1. / (nxm - 1)
+	    j = j - 1
+
+	    call asiinit (asi, II_SPLINE3)
+	    call asifit (asi, Memr[prof1], j)
+	    xc = Memr[prof1]
+	    call mfree (prof1, TY_REAL)
+
+	    if (xc == 0.) {
+		flux = 0.
+		do i = 1, nxm - 1 {
+		    r = i * dr
+		    call asider (asi, 1+j*r, der, 2)
+		    Memr[prof+i] = max (0., der[2] / r)
+		    flux = flux + r * Memr[prof+i]
+		}
+		Memr[prof] = max (0., 2 * Memr[prof+1] - Memr[prof+2])
+	    } else {
+		flux = 0.
+		do i = 0, nxm - 1 {
+		    r = i * dr
+		    Memr[prof+i] = asieval (asi, 1+j*r)
+		    flux = flux + r * Memr[prof+i]
+		}
+	    }
+	    call asifree (asi)
+
+	    xc = 0.9 * flux
+	    flux = 0.
+	    for (i=1; i<nxm && flux<xc; i=i+1)
+		flux = flux + i * dr * Memr[prof+i]
+
+	    flux = 1.
+	    radius = 1.
+	    seeing = (i - 1.) * dr
+	} else
+	    call error (1, "PSF template not found")
+
+	# Set size and orientation parameters.
+	r = clgetr ("radius")
+	ar = clgetr ("ar")
+	pa = DEGTORAD (clgetr ("pa"))
+	radius = r * radius
+	seeing = r * seeing
+
+	# Compute templates with subsampling  over a grid of centers.
+	# Do this for the full star profile and a smaller region for
+	# convolving extended objects.
+
+	# Seeing kernel.
+	sym = stenter (stp, "seeing", 1)
+	call calloc (Memi[sym], LEN_MKT, TY_STRUCT)
+	mkt1 = Memi[sym]
+
+	nx = 2 * nint (seeing) + 1
+	ny = nx
+	dxc = 1. / nxc
+	dyc = 1. / nyc
+	if (prof != NULL) {
+	    nym = 1 + nint (radius * nxssub * nyssub)
+	    call malloc (prof1, nym, TY_REAL)
+	    call mkt_binprof (Memr[prof], nxm, Memr[prof1], nym, radius, nxssub)
+	    for (yc = -0.5+dyc/2; yc < 0.5; yc = yc+dyc) {
+	        for (xc = -0.5+dxc/2; xc < 0.5; xc = xc+dxc) {
+		    call malloc (data, nx*ny, TY_REAL)
+		    call mkt_profile (data, nx, ny, xc, yc, 1., Memr[prof1],
+		        nym, radius, ar, pa, nxssub, nyssub)
+		    call mkt_save (mkt1, data, nx, ny, xc, yc, 1., 0., 0., 0.,
+			YES)
+	        }
+	    }
+	} else {
+	    for (yc = -0.5+dyc/2; yc < 0.5; yc = yc+dyc) {
+	        for (xc = -0.5+dxc/2; xc < 0.5; xc = xc+dxc) {
+		    call malloc (data, nx*ny, TY_REAL)
+		    call mkt_msi (data, nx, ny, xc, yc, 1., msi, nxm, nym,
+		        radius, ar, pa, nxssub, nyssub)
+		    call mkt_save (mkt1, data, nx, ny, xc, yc, 1., 0., 0., 0.,
+			YES)
+	        }
+	    }
+	}
+
+	# Full star templates.
+	sym = stenter (stp, "star", 1)
+	call calloc (Memi[sym], LEN_MKT, TY_STRUCT)
+	mkt2 = Memi[sym]
+
+	nx = 2 * nint (radius) + 1
+	ny = nx
+	dxc = 1. / nxc
+	dyc = 1. / nyc
+	if (prof != NULL) {
+	    for (yc = 0.5+dyc/2; yc < 1.5; yc = yc+dyc) {
+	        for (xc = 0.5+dxc/2; xc < 1.5; xc = xc+dxc) {
+		    call malloc (data, nx*ny, TY_REAL)
+		    call mkt_profile (data, nx, ny, xc, yc, flux, Memr[prof1],
+		        nym, radius, ar, pa, nxssub, nyssub)
+		    call mkt_save (mkt2, data, nx, ny, xc, yc, 1., 0., 0., 0.,
+			YES)
+	        }
+	    }
+	    call mfree (prof, TY_REAL)
+	    call mfree (prof1, TY_REAL)
+	} else {
+	    for (yc = 0.5+dyc/2; yc < 1.5; yc = yc+dyc) {
+	        for (xc = 0.5+dxc/2; xc < 1.5; xc = xc+dxc) {
+		    call malloc (data, nx*ny, TY_REAL)
+		    call mkt_msi (data, nx, ny, xc, yc, flux, msi, nxm, nym,
+		        radius, ar, pa, nxssub, nyssub)
+		    call mkt_save (mkt2, data, nx, ny, xc, yc, 1., 0., 0., 0.,
+			YES)
+	        }
+	    }
+	    call msifree (msi)
+	}
+
+	see = mkt1
+	star = mkt2
+	return (star)
+end
+
+
+# MKT_OBJECT -- Set object profiles.
+
+pointer procedure mkt_object (name)
+
+char	name[ARB]	# Profile name or file
+
+int	i, j, nxm, nym, fd
+real	radius, r, dr, flux, c3, c4, c5, c6, c7, der[2]
+pointer	sym, mkt, prof, asi, msi, buf, im
+
+real	asieval()
+int	open(), fscan(), nscan()
+pointer	immap(), imgs2r(), stfind(), stenter()
+bool	streq()
+errchk	open, immap, asifit, asieval, asider
+
+include	"mktemplates.com"
+
+begin
+	# Check if previously defined.
+	sym = stfind (stp, name)
+	if (sym != NULL)
+	    return (Memi[sym])
+
+	# Select type of profile and set intensity profile array.
+	# Compute the fraction of the total flux in the profile.
+
+	prof = NULL
+	msi = NULL
+	if (streq (name, "expdisk")) {
+	    nxm = NPROF
+	    call malloc (prof, nxm, TY_REAL)
+	    radius = log (dynrange)
+	    dr = radius / (nxm - 1)
+	    do i = 0, nxm - 1 {
+		r = i * dr
+		Memr[prof+i] = exp (-r)
+	    }
+
+	    flux = 1 - Memr[prof+nxm-1] * (1 + r)
+	    radius = radius / 1.6783
+	} else if (streq (name, "devauc")) {
+	    nxm = NPROF
+	    call malloc (prof, nxm, TY_REAL)
+	    radius = log (dynrange) ** 4
+	    dr = radius / (nxm - 1)
+	    do i = 0, nxm - 1 {
+		r = (i * dr) ** 0.25
+		Memr[prof+i] = exp (-r)
+	    }
+
+	    c3 = 1. / 6
+	    c4 = c3 / 4
+	    c5 = c4 / 5
+	    c6 = c5 / 6
+	    c7 = c6 / 7
+	    flux = 1 - Memr[prof+nxm-1] *
+		(1+r*(1+r*(.5+r*(c3+r*(c4+r*(c5+r*(c6+c7*r)))))))
+	    radius = radius / 7.67 ** 4
+	} else ifnoerr (im = immap (name, READ_ONLY, 0)) {
+	    iferr {
+		nxm = IM_LEN(im,1)
+		nym = IM_LEN(im,2)
+		buf = imgs2r (im, 1, nxm, 1, nym)
+		call msiinit (msi, II_BILINEAR)
+		call msifit (msi, Memr[buf], nxm, nym, nxm)
+	    } then
+		call erract (EA_WARN)
+	    call imunmap (im)
+
+	    flux = 1.
+	    radius = 1.
+	} else ifnoerr (fd = open (name, READ_ONLY, TEXT_FILE)) {
+	    nxm = NPROF
+	    call malloc (buf, nxm, TY_REAL)
+
+	    j = 0
+	    while (fscan (fd) != EOF) {
+	 	call gargr (flux)
+		if (nscan() < 1)
+		    next
+		if (j == nxm) {
+		    nxm = nxm + NPROF
+		    call realloc (buf, nxm, TY_REAL)
+		}
+		Memr[buf+j] = flux
+		j = j + 1
+	    }
+	    call close (fd)
+	    if (j == 0) {
+		call mfree (buf, TY_REAL)
+		nxm = 0
+		call error (1, "PSF template not found")
+	    }
+
+	    nxm = NPROF
+	    call malloc (prof, nxm, TY_REAL)
+	    dr = 1. / (nxm - 1)
+	    j = j - 1
+
+	    call asiinit (asi, II_SPLINE3)
+	    call asifit (asi, Memr[buf], j)
+	    c3 = Memr[buf]
+	    call mfree (buf, TY_REAL)
+
+	    if (c3 == 0.) {
+		do i = 1, nxm - 1 {
+		    r = i * dr
+		    call asider (asi, 1+j*r, der, 2)
+		    Memr[prof+i] = max (0., der[2] / r)
+		}
+		Memr[prof] = max (0., 2 * Memr[prof+1] - Memr[prof+2])
+	    } else {
+		do i = 0, nxm - 1 {
+		    r = i * dr
+		    Memr[prof+i] = asieval (asi, 1+j*r)
+		}
+	    }
+	    call asifree (asi)
+
+	    flux = 1.
+	    radius = 1.
+	} else {
+	    call eprintf ("WARNING: Object template %s not found.\n")
+		call pargstr (name)
+	    return (NULL)
+	}
+
+	# Create the template structure if a model is defined..
+	if (prof == NULL && msi == NULL)
+	    mkt = NULL
+	else {
+	    call calloc (mkt, LEN_MKT, TY_STRUCT)
+	    MKT_PROF(mkt) = prof
+	    MKT_MSI(mkt) = msi
+	    MKT_NXM(mkt) = nxm
+	    MKT_NYM(mkt) = nym
+	    MKT_F(mkt) = flux
+	    MKT_SCALE(mkt) = radius
+	}
+
+	# Enter object model name in symbol table.
+	sym = stenter (stp, name, 1)
+	Memi[sym] = mkt
+	return (mkt)
+end
+
+
+# MKT_GOBJECT -- Get image raster.
+# The profile type is set by the template structure.
+
+procedure mkt_gobject (mkt, data, nx, ny, x, y, z, r, ar, pa, save)
+
+pointer	mkt		# Object template
+pointer	data		# Data
+int	nx, ny		# Size of returned data
+real	x, y		# Position of object
+real	z		# Flux of object
+real	r		# Major axis scale (pixels)
+real	ar		# Axial ratio (minor / major)
+real	pa		# Position angle (radians)
+int	save		# Use/save template?
+
+real	xc, yc, radius
+int	nprof
+pointer	prof
+
+include	"mktemplates.com"
+
+begin
+	data = NULL
+	if (mkt == NULL)
+	    return
+
+	# Stars are predefined.  Return the nearest template center.
+	# Other objects are computed with or without seeing.
+
+	if (mkt == star)
+	    call mkt_gstar (star, data, nx, ny, x, y, z)
+	else {
+	    xc = x + 0.5 - int (x + 0.5)
+	    yc = y + 0.5 - int (y + 0.5)
+	    call mkt_get (mkt, data, nx, ny, xc, yc, z, r, ar, pa, save)
+	    if (data != NULL)
+		return
+
+	    radius = r * MKT_SCALE(mkt)
+	    nx = max (3, 2 * nint (radius) + 1)
+	    ny = nx
+	    if (see != NULL) {
+	        nx = nx + Memi[MKT_NX(see)] / 2
+	        ny = ny + Memi[MKT_NY(see)] / 2
+	    }
+	    call malloc (data, nx * ny, TY_REAL)
+
+	    if (MKT_PROF(mkt) != 0) {
+	        nprof = 1 + nint (radius * nxgsub * nxgsub)
+	        call malloc (prof, nprof, TY_REAL)
+	        call mkt_binprof (Memr[MKT_PROF(mkt)], MKT_NXM(mkt),
+		    Memr[prof], nprof, radius, nxgsub)
+	        call mkt_profile (data, nx, ny, x, y, z*MKT_F(mkt), Memr[prof],
+		    nprof, radius, ar, pa, nxgsub, nygsub)
+	        call mfree (prof, TY_REAL)
+	    } else {
+	        call mkt_msi (data, nx, ny, x, y, z, MKT_MSI(mkt),
+		    MKT_NXM(mkt), MKT_NYM(mkt), radius, ar, pa,
+		    nxgsub, nygsub)
+	    }
+
+	    call mkt_save (mkt, data, nx, ny, xc, yc, z, r, ar, pa, save)
+	}
+end
+
+
+# MKT_BINPROF -- Bin intensity profile into subpixels
+
+procedure mkt_binprof (prof, nprof, prof1, nprof1, radius, nsub)
+
+real	prof[nprof]		# Input intensity profile
+int	nprof			# Number of input points
+real	prof1[nprof]		# Output binned intensity profile
+int	nprof1			# Number of output points
+real	radius			# Radius of profile
+int	nsub			# Maximum subsampling
+
+int	i, j, k, k1, k2, l, dx
+real	scale, dy, val
+
+int	debug, open()
+data	debug/0/
+
+begin
+	if (radius < 0.1) {
+	    call amovkr (1., prof1, nprof1)
+	    return
+	} else
+	    call aclrr (prof1, nprof1)
+
+	# Set binning parameters
+	scale = (nprof - 1.) / (nprof1 - 1.)
+	dx = nint ((nprof1 - 1.) / nsub / radius / 2.)
+	dy = dx / (NY - 1.)
+
+	# Bin central pixels
+	do i = -dx, 2*dx {
+	    k = abs (i)
+	    k1 = max (1, i - dx + 1) 
+	    k2 = i + dx + 1
+	    do j = 0, NY-1 {
+		if (j == 0)
+		    val = k
+		else if (k == 0)
+		    val = dy * j
+		else
+		    val = k * sqrt (1. + (dy * j / k) ** 2)
+		l = nint (scale * val + 1)
+		if (l > nprof)
+		    next
+		val = prof[l] / NY
+		do l = k1, k2
+		    prof1[l] = prof1[l] + val
+	    }
+	}
+
+	# Now bin remainder of pixels more crudely
+	do i = 2*dx+1, nprof1-1 {
+	    k1 = i - dx + 1
+	    k2 = min (nprof1, i + dx + 1)
+	    val = prof[nint (scale * i + 1)]
+	    do k = k1, k2
+		prof1[k] = prof1[k] + val
+	}
+
+	if (debug == YES) {
+	    j = open ("debug1.dat", APPEND, TEXT_FILE)
+	    do i = 1, nprof {
+		call fprintf (j, "%d %g\n")
+		    call pargi (i)
+		    call pargr (prof[i])
+	    }
+	    call close (j)
+
+	    j = open ("debug2.dat", APPEND, TEXT_FILE)
+	    do i = 1, nprof1 {
+		call fprintf (j, "%d %g\n")
+		    call pargi (i)
+		    call pargr (prof1[i])
+	    }
+	    call close (j)
+	}
+end
+
+
+# MKT_GSTAR -- Get the precomputed template with center nearest (x,y).
+
+procedure mkt_gstar (mkt, data, nx, ny, x, y, z)
+
+pointer	mkt		# Template
+pointer	data		# Data
+int	nx, ny		# Size of data
+real	x, y		# Position of object
+real	z		# Flux of object
+
+int	i, j
+real	f
+
+include	"mktemplates.com"
+
+begin
+	i = (x + 0.5 - int (x + 0.5)) * nxc
+	j = (y + 0.5 - int (y + 0.5)) * nyc
+	i = j * nxc + i
+	data = Memi[MKT_PTRS(mkt)+i]
+	nx = Memi[MKT_NX(mkt)+i]
+	ny = Memi[MKT_NY(mkt)+i]
+	f = Memr[MKT_FLUX(mkt)+i]
+	if (f != z) {
+	    call amulkr (Memr[data], z/f, Memr[data], nx*ny)
+	    Memr[MKT_FLUX(mkt)+i] = z
+	}
+end
+
+
+# MKT_PROFILE -- Make template from profile.
+
+procedure mkt_profile (data, nx, ny, xc, yc, flux, prof, npts, radius,
+	ar, pa, nxsub, nysub)
+
+pointer	data		# Pointer to data array
+int	nx, ny		# Size of template
+real	xc, yc		# Model center
+real	flux		# Model flux
+real	prof[npts]	# 1D profile
+int	npts		# Number of points in profile
+real	radius		# Major axis radius of profile (pixels)
+real	ar		# Axial ratio (minor / major)
+real	pa		# Position angle relative to major axis (radians)
+int	nxsub, nysub	# Number of subpixel samples
+
+int	i, n, nxs, nys, nxs2, nys2, xs1, xs2, ys1, ys2
+int	x, y, x2, y2
+real	a, b, c, r, s, t, z, sum, sum1, asumr()
+real	dx, dy, dsub, dsub2
+real	x1, y1, xc1, yc1
+pointer	ptr, ptr1, ptr2, see1, see2
+
+include	"mktemplates.com"
+
+define	see_	99
+
+begin
+	# Switch on the size of the seeing templates.
+	if (see != NULL)
+	    if (Memi[MKT_NX(see)] * Memi[MKT_NY(see)] > 1)
+	        goto see_
+
+# NO SEEING:
+
+	# If the radius is very small return delta function.
+	if (radius < 0.1) {
+	    call aclrr (Memr[data], nx*ny)
+	    Memr[data+(ny/2)*nx+(nx/2)] = flux
+	    return
+	}
+
+	# Compute elliptical scale factors for entry into profile array.
+	r = ((npts - 1) / radius) ** 2
+	t = ((npts - 1) / (ar * radius)) ** 2
+	c = cos (pa)
+	s = sin (pa)
+	a = r * c * c + t * s * s
+	b = 2 * (r - t) * c * s
+	c = r * s * s + t * c * c
+
+	# Subsample the profile and sum into each pixel.
+	n = nx * ny
+	xc1 = xc - int (xc + 0.5) + nx/2
+	yc1 = yc - int (yc + 0.5) + ny/2
+
+	sum1 = 0.
+	ptr = data
+	do y = 0, ny-1 {
+	    t = (y - yc1) ** 2
+	    do x = 0, nx-1 {
+		i = sqrt ((x - xc1) ** 2 + t)
+		dsub = 1. / max (1, nxsub - i)
+		sum = 0.
+		for (y1 = y-0.5+dsub/2; y1 < y+0.5; y1 = y1+dsub) {
+		    dy = (y1 - yc1)
+		    s = c * dy**2
+		    for (x1=x-0.5+dsub/2; x1<x+0.5; x1=x1+dsub) {
+			dx = (x1-xc1)
+			i = sqrt (a * dx**2 + b * dx * dy + s) + 1.5
+			if (i <= npts)
+			    sum = sum + prof[i]
+		    }
+		}
+		sum = sum * dsub ** 2
+		sum1 = sum1 + sum
+		Memr[ptr] = sum
+		ptr = ptr + 1
+	    }
+	}
+
+	# If the subsamples completely miss and signal is zero then return
+	# delta function otherwise scale to requested flux.
+
+	if (sum1 == 0.)
+	    Memr[data+(ny/2)*nx+(nx/2)] = flux
+	else
+	    call amulkr (Memr[data], flux/sum1, Memr[data], n)
+	return
+
+# WITH SEEING:
+
+see_	n = nx * ny
+	call aclrr (Memr[data], n)
+	sum = 0.
+
+	nxs = Memi[MKT_NX(see)]
+	nys = Memi[MKT_NY(see)]
+	nxs2 = nxs/2
+	nys2 = nys/2
+
+	# If the profile is very small return full star image rather than
+	# convolution with truncated seeing template.
+
+	if (radius > 0.01) {
+	    r = ((npts - 1) / radius) ** 2
+	    t = ((npts - 1) / (ar * radius)) ** 2
+	    c = cos (pa)
+	    s = sin (pa)
+	    a = r * c * c + t * s * s
+	    b = 2 * (r - t) * c * s
+	    c = r * s * s + t * c * c
+    
+	    xc1 = xc - int (xc + 0.5) + nx/2
+	    yc1 = yc - int (yc + 0.5) + ny/2
+	    ptr = data-nys2*nx-nxs2
+	    do y = 0, ny-1 {
+		t = (y - yc1) ** 2
+		ys1 = max (0, nys2 - y)
+		ys2 = min (nys-1, ny - y + nys2 - 1)
+		do x = 0, nx-1 {
+		    i = sqrt ((x - xc1) ** 2 + t)
+		    dsub = 1. / max (1, nxsub - i)
+		    dsub2 = dsub ** 2
+		    xs1 = max (0, nxs2 - x)
+		    xs2 = min (nxs-1, nx - x + nxs2 - 1)
+		    ptr1 = ptr + xs1
+		    for (y1=y-0.5+dsub/2; y1<y+0.5; y1=y1+dsub) {
+			dy = (y1 - yc1)
+			s = c * dy**2
+			for (x1=x-0.5+dsub/2; x1<x+0.5; x1=x1+dsub) {
+			    dx = (x1-xc1)
+			    i = sqrt (a * dx**2 + b * dx * dy + s) + 1.5
+			    if (i <= npts) {
+				z = prof[i] * dsub2
+				call mkt_gstar (see, see1, nxs, nys, x1, y1, 1.)
+				see1 = see1 + xs1
+				do y2 = ys1, ys2 {
+				   see2 = see1+y2*nxs
+				   ptr2 = ptr1+y2*nx
+				   do x2 = xs1, xs2 {
+				       Memr[ptr2] = Memr[ptr2] +
+					   z * Memr[see2]
+				       ptr2 = ptr2 + 1
+				       see2 = see2 + 1
+				    }
+				}
+			    }
+			}
+		    }
+		    ptr = ptr + 1
+		}
+	    }
+	    sum = asumr (Memr[data], n)
+	}
+
+	# If no flux is accumulated or radius is very small return star image.
+	# Otherwise scale to requested flux.
+
+	if (sum == 0.) {
+	    call mkt_gstar (star, see1, nxs, nys, xc, yc, flux)
+	    x = nx/2
+	    y = ny/2
+	    nxs2 = nxs / 2
+	    nys2 = nys / 2
+	    xs1 = max (0, nxs2 - x)
+	    xs2 = min (nxs-1, nx - x + nxs2 - 1)
+	    ys1 = max (0, nys2 - y)
+	    ys2 = min (nys-1, ny - y + nys2 - 1)
+	    ptr1 = data-nys2*nx-nxs2+(y*nx+x+xs1)
+	    see1 = see1 + xs1
+	    do y2 = ys1, ys2 {
+	       see2 = see1+y2*nxs
+	       ptr2 = ptr1+y2*nx
+	       do x2 = xs1, xs2 {
+		   Memr[ptr2] = Memr[ptr2] + Memr[see2]
+		   ptr2 = ptr2 + 1
+		   see2 = see2 + 1
+		}
+	    }
+	} else
+	    call amulkr (Memr[data], flux/sum, Memr[data], n)
+end
+
+
+# MKT_MSI -- Make template from image interpolation function.
+
+procedure mkt_msi (data, nx, ny, xc, yc, flux, model, nxm, nym, radius,
+	ar, pa, nxsub, nysub)
+
+pointer	data		# Pointer to data array
+int	nx, ny		# Size of template
+real	xc, yc		# Model center
+real	flux		# Model flux
+pointer	model		# Surface interpolation pointer for image template
+int	nxm, nym	# Number of points in image template
+real	radius		# Major axis radius of profile (pixels)
+real	ar		# Axial ratio (minor / major)
+real	pa		# Position angle relative to major axis (radians)
+int	nxsub, nysub	# Number of subpixel samples
+
+int	i, n, nxs, nys, nxs2, nys2, xs1, xs2, ys1, ys2, x, y, x2, y2
+real	a, b, c, s, xcm, ycm, x1, y1, xc1, yc1, dsub, sum, sum1
+real	ac, as, bc, bs, acdx1, acdx2, bsdx1, bsdx2, bcdy1, bcdy2, asdy1, asdy2
+real	val1, val2, val3, val4, minval, maxval, xm[5], ym[5]
+real	asumr(), msigrl(), msisqgrl()
+pointer	ptr, ptr1, ptr2, see1, see2
+
+include	"mktemplates.com"
+
+define	see_	99
+
+begin
+	# Switch on the size of the seeing templates.
+	if (see != NULL)
+	    if (Memi[MKT_NX(see)] * Memi[MKT_NY(see)] > 1)
+	        goto see_
+
+# NO SEEING:
+
+	# If the radius is very small return delta function.
+	if (radius < 0.1) {
+	    call aclrr (Memr[data], nx*ny)
+	    Memr[data+(ny/2)*nx+(nx/2)] = flux
+	    return
+	}
+
+	a = (nxm / 2.) / radius
+	b = (nym / 2.) / (ar * radius)
+	c = cos (pa)
+	s = sin (pa)
+	ac = a * c
+	as = a * s
+	bc = b * c
+	bs = b * s
+	a = nxm
+	b = nym
+	xcm = nxm / 2 + 1.
+	ycm = nym / 2 + 1.
+
+	# Subsample the profile and sum into each pixel.
+	n = nx * ny
+	xc1 = xc - int (xc + 0.5) + nx/2
+	yc1 = yc - int (yc + 0.5) + ny/2
+
+	sum1 = 0.
+	ptr = data
+	do y = 0, ny-1 {
+	    c = (y - yc1) ** 2
+	    do x = 0, nx-1 {
+		i = sqrt ((x - xc1) ** 2 + c)
+		dsub = 1. / max (1, nxsub - i)
+		sum = 0.
+		for (y1 = y-0.5; y1 < y+0.5-dsub/2; y1 = y1+dsub) {
+		    asdy1 = (y1 - yc1)
+		    asdy2 = asdy1 + dsub
+		    bcdy1 = bc * asdy1 + ycm
+		    bcdy2 = bc * asdy2 + ycm
+		    if (pa == 0.) {
+			val3 = max (1., bcdy1)
+			if (val3 >= nym)
+			    next
+			val4 = min (b, bcdy2)
+			if (val3 >= val4)
+			    next
+		    }
+		    asdy1 = as * asdy1
+		    asdy2 = as * asdy2
+		    for (x1=x-0.5; x1<x+0.5-dsub/2; x1=x1+dsub) {
+			bsdx1 = (x1-xc1)
+			bsdx2 = bsdx1 + dsub
+			acdx1 = ac * bsdx1 + xcm
+			acdx2 = ac * bsdx2 + xcm
+			if (pa == 0.) {
+			    val1 = max (1., acdx1)
+			    if (val1 >= nxm)
+				next
+			    val2 = min (a, acdx2)
+			    if (val1 >= val2)
+				next
+			    s = msisqgrl (model, val1, val2, val3, val4)
+			} else {
+			    bsdx1 = bs * bsdx1
+			    bsdx2 = bs * bsdx2
+
+			    val1 = acdx1 + asdy1
+			    val2 = acdx2 + asdy1
+			    val3 = acdx2 + asdy2
+			    val4 = acdx1 + asdy2
+			    minval = min (val1, val2, val3, val4)
+			    maxval = max (val1, val2, val3, val4)
+			    if (minval >= a || maxval <= 1.)
+				next
+			    xm[1] = max (1., min (a, val1))
+			    xm[2] = max (1., min (a, val2))
+			    xm[3] = max (1., min (a, val3))
+			    xm[4] = max (1., min (a, val4))
+			    xm[5] = xm[1]
+
+			    val1 = bcdy1 - bsdx1
+			    val2 = bcdy1 - bsdx2
+			    val3 = bcdy2 - bsdx2
+			    val4 = bcdy2 - bsdx1
+			    minval = min (val1, val2, val3, val4)
+			    maxval = max (val1, val2, val3, val4)
+			    if (minval >= b || maxval <= 1.)
+				next
+			    ym[1] = max (1., min (b, val1))
+			    ym[2] = max (1., min (b, val2))
+			    ym[3] = max (1., min (b, val3))
+			    ym[4] = max (1., min (b, val4))
+			    ym[5] = ym[1]
+			    y2 = 1
+			    do x2 = 2, 4
+				if (ym[x2] < ym[y2])
+				    y2 = x2
+			    switch (y2) {
+			    case 2:
+				xm[1] = xm[2]; ym[1] = ym[2]
+				xm[2] = xm[3]; ym[2] = ym[3]
+				xm[3] = xm[4]; ym[3] = ym[4]
+				xm[4] = xm[5]; ym[4] = ym[5]
+				xm[5] = xm[1]; ym[5] = ym[1]
+			    case 3:
+				xm[1] = xm[3]; ym[1] = ym[3]
+				xm[3] = xm[5]; ym[3] = ym[5]
+				xm[5] = xm[2]; ym[5] = ym[2]
+				xm[2] = xm[4]; ym[2] = ym[4]
+				xm[4] = xm[5]; ym[4] = ym[5]
+				xm[5] = xm[1]; ym[5] = ym[1]
+			    case 4:
+				xm[5] = xm[4]; ym[5] = ym[4]
+				xm[4] = xm[3]; ym[4] = ym[3]
+				xm[3] = xm[2]; ym[3] = ym[2]
+				xm[2] = xm[1]; ym[2] = ym[1]
+				xm[1] = xm[5]; ym[1] = ym[5]
+			    }
+
+			    s = msigrl (model, xm, ym, 5)
+			}
+			sum = sum + s
+		    }
+		}
+		sum1 = sum1 + sum
+		Memr[ptr] = sum
+		ptr = ptr + 1
+	    }
+	}
+
+	call amulkr (Memr[data], flux/sum1, Memr[data], n)
+	return
+
+# SEEING:
+
+see_	n = nx * ny
+	call aclrr (Memr[data], n)
+	sum = 0.
+
+	nxs = Memi[MKT_NX(see)]
+	nys = Memi[MKT_NY(see)]
+	nxs2 = nxs/2
+	nys2 = nys/2
+
+	# If the profile is very small return full star image rather than
+	# convolution with truncated seeing template.
+
+	if (radius > 0.01) {
+	    a = (nxm / 2.) / radius
+	    b = (nym / 2.) / (ar * radius)
+	    c = cos (pa)
+	    s = sin (pa)
+	    ac = a * c
+	    as = a * s
+	    bc = b * c
+	    bs = b * s
+	    a = nxm
+	    b = nym
+	    xcm = nxm / 2 + 1.
+	    ycm = nym / 2 + 1.
+    
+	    xc1 = xc - int (xc + 0.5) + nx/2
+	    yc1 = yc - int (yc + 0.5) + ny/2
+	    ptr = data-nys2*nx-nxs2
+	    do y = 0, ny-1 {
+		c = (y - yc1) ** 2
+		ys1 = max (0, nys2 - y)
+		ys2 = min (nys-1, ny - y + nys2 - 1)
+		do x = 0, nx-1 {
+		    i = sqrt ((x - xc1) ** 2 + c)
+		    dsub = 1. / max (1, nxsub - i)
+		    xs1 = max (0, nxs2 - x)
+		    xs2 = min (nxs-1, nx - x + nxs2 - 1)
+		    ptr1 = ptr + xs1
+		    for (y1=y-0.5; y1<y+0.5-dsub/2; y1=y1+dsub) {
+			asdy1 = (y1 - yc1)
+			asdy2 = asdy1 + dsub
+			bcdy1 = bc * asdy1 + ycm
+			bcdy2 = bc * asdy2 + ycm
+		        if (pa == 0.) {
+			    val3 = max (1., bcdy1)
+			    if (val3 >= nym)
+			        next
+			    val4 = min (b, bcdy2)
+			    if (val3 >= val4)
+			        next
+		        }
+			asdy1 = as * asdy1
+			asdy2 = as * asdy2
+		        for (x1=x-0.5; x1<x+0.5-dsub/2; x1=x1+dsub) {
+			    bsdx1 = (x1-xc1)
+			    bsdx2 = bsdx1 + dsub
+			    acdx1 = ac * bsdx1 + xcm
+			    acdx2 = ac * bsdx2 + xcm
+			    if (pa == 0.) {
+			        val1 = max (1., acdx1)
+			        if (val1 >= nxm)
+				    next
+			        val2 = min (a, acdx2)
+			        if (val1 >= val2)
+				    next
+			        sum = msisqgrl (model, val1, val2, val3, val4)
+			    } else {
+			        bsdx1 = bs * bsdx1
+			        bsdx2 = bs * bsdx2
+
+			        val1 = acdx1 + asdy1
+			        val2 = acdx2 + asdy1
+			        val3 = acdx2 + asdy2
+			        val4 = acdx1 + asdy2
+			        minval = min (val1, val2, val3, val4)
+			        maxval = max (val1, val2, val3, val4)
+			        if (minval >= a || maxval <= 1.)
+				    next
+			        xm[1] = max (1., min (a, val1))
+			        xm[2] = max (1., min (a, val2))
+			        xm[3] = max (1., min (a, val3))
+			        xm[4] = max (1., min (a, val4))
+			        xm[5] = xm[1]
+
+			        val1 = bcdy1 - bsdx1
+			        val2 = bcdy1 - bsdx2
+			        val3 = bcdy2 - bsdx2
+			        val4 = bcdy2 - bsdx1
+			        minval = min (val1, val2, val3, val4)
+			        maxval = max (val1, val2, val3, val4)
+			        if (minval >= b || maxval <= 1.)
+				    next
+			        ym[1] = max (1., min (b, val1))
+			        ym[2] = max (1., min (b, val2))
+			        ym[3] = max (1., min (b, val3))
+			        ym[4] = max (1., min (b, val4))
+			        ym[5] = ym[1]
+
+# The following is put in to work around a bug in msigrl in V2.8.  When
+# V2.8 is long gone we can take this stuff out since msigrl will do the
+# rotating of the coordinates itself.
+
+				minval = max (1., minval)
+				y2 = 1
+				do x2 = 2, 4
+				    if (ym[x2] < ym[y2])
+					y2 = x2
+				switch (y2) {
+				case 2:
+				    xm[1] = xm[2]; ym[1] = ym[2]
+				    xm[2] = xm[3]; ym[2] = ym[3]
+				    xm[3] = xm[4]; ym[3] = ym[4]
+				    xm[4] = xm[5]; ym[4] = ym[5]
+				    xm[5] = xm[1]; ym[5] = ym[1]
+				case 3:
+				    xm[1] = xm[3]; ym[1] = ym[3]
+				    xm[3] = xm[5]; ym[3] = ym[5]
+				    xm[5] = xm[2]; ym[5] = ym[2]
+				    xm[2] = xm[4]; ym[2] = ym[4]
+				    xm[4] = xm[5]; ym[4] = ym[5]
+				    xm[5] = xm[1]; ym[5] = ym[1]
+				case 4:
+				    xm[5] = xm[4]; ym[5] = ym[4]
+				    xm[4] = xm[3]; ym[4] = ym[3]
+				    xm[3] = xm[2]; ym[3] = ym[2]
+				    xm[2] = xm[1]; ym[2] = ym[1]
+				    xm[1] = xm[5]; ym[1] = ym[5]
+				}
+
+			        sum = msigrl (model, xm, ym, 5)
+			    }
+	    		    call mkt_gstar (see, see1, nxs, nys, x1, y1, 1.)
+			    see1 = see1 + xs1
+			    do y2 = ys1, ys2 {
+				see2 = see1+y2*nxs
+				ptr2 = ptr1+y2*nx
+				do x2 = xs1, xs2 {
+				    Memr[ptr2] = Memr[ptr2] + sum * Memr[see2]
+				    ptr2 = ptr2 + 1
+				    see2 = see2 + 1
+				}
+			    }
+			}
+		    }
+		    ptr = ptr + 1
+		}
+	    }
+	    sum = asumr (Memr[data], n)
+	}
+
+	# If no flux is accumulated or radius is very small return star image.
+	# Otherwise scale to requested flux.
+
+	if (sum == 0.) {
+	    call mkt_gstar (star, see1, nxs, nys, xc, yc, flux)
+	    x = nx/2
+	    y = ny/2
+	    nxs2 = nxs / 2
+	    nys2 = nys / 2
+	    xs1 = max (0, nxs2 - x)
+	    xs2 = min (nxs-1, nx - x + nxs2 - 1)
+	    ys1 = max (0, nys2 - y)
+	    ys2 = min (nys-1, ny - y + nys2 - 1)
+	    ptr1 = data-nys2*nx-nxs2+(y*nx+x+xs1)
+	    see1 = see1 + xs1
+	    do y2 = ys1, ys2 {
+	       see2 = see1+y2*nxs
+	       ptr2 = ptr1+y2*nx
+	       do x2 = xs1, xs2 {
+		   Memr[ptr2] = Memr[ptr2] + Memr[see2]
+		   ptr2 = ptr2 + 1
+		   see2 = see2 + 1
+		}
+	    }
+	} else
+	    call amulkr (Memr[data], flux/sum, Memr[data], n)
+end
diff --git a/noao/artdata/mktemplates.xNEW b/noao/artdata/mktemplates.xNEW
new file mode 100644
index 00000000..048abf21
--- /dev/null
+++ b/noao/artdata/mktemplates.xNEW
@@ -0,0 +1,1399 @@
+include	<error.h>
+include	<imhdr.h>
+include	<math.h>
+include	<math/iminterp.h>
+
+# Template data structure
+define	LEN_MKT		18
+define	MKT_PROF	Memi[$1]	# Pointer to profile
+define	MKT_MSI		Memi[$1+1]	# MSI interpolation pointer
+define	MKT_NXM		Memi[$1+2]	# Number of X points in model
+define	MKT_NYM		Memi[$1+3]	# Number of Y points in model
+define	MKT_F		Memr[P2R($1+4)]	# Fraction of total flux in profile
+define	MKT_SCALE	Memr[P2R($1+5)]	# Radius scale
+
+define	MKT_NALLOC	Memi[$1+6]	# Allocated space for saved templates
+define	MKT_N		Memi[$1+7]	# Number of saved templates
+
+define	MKT_DATA	Memi[$1+8]	# Data pointer
+define	MKT_PTRS	Memi[$1+9]	# Data pointers
+define	MKT_NX		Memi[$1+10]	# Number of X pixels
+define	MKT_NY		Memi[$1+11]	# Number of Y pixels
+define	MKT_XC		Memi[$1+12]	# Subpixel X center
+define	MKT_YC		Memi[$1+13]	# Subpixel Y center
+define	MKT_FLUX	Memi[$1+14]	# Flux
+define	MKT_R		Memi[$1+15]	# Radius
+define	MKT_AR		Memi[$1+16]	# Axial ratio
+define	MKT_PA		Memi[$1+17]	# Position angle
+
+define	NALLOC	25		# Allocation block for saved templates
+define	NPROF	5001		# Profile length
+define	NY	11		# BINPROF binning parameter
+
+
+# MKT_INIT    -- Initialize template memory.
+# MKT_FREE    -- Free template memory.
+# MKT_SAVE    -- Save a template
+# MKT_GET     -- Get a template
+# MKT_STAR    -- Set star and seeing templates.
+# MKT_OBJECT  -- Set object profiles.
+# MKT_GOBJECT -- Get image raster.
+# MKT_BINPROF -- Bin intensity profile
+# MKT_GSTAR   -- Get the precomputed template with center nearest (x,y).
+# MKT_PROFILE -- Make template from profile.
+# MKT_MSI     -- Make template from image interpolation function.
+
+
+# MKT_INIT -- Initialize template memory.
+# The symbol table is used as a simple way to store the object types by name.
+
+procedure mkt_init ()
+
+int	clgeti()
+real	clgetr()
+
+pointer	stopen()
+include	"mktemplates.com"
+
+begin
+	nxc = clgeti ("nxc")
+	nyc = clgeti ("nyc")
+	nxssub = clgeti ("nxsub")
+	nyssub = clgeti ("nysub")
+	nxgsub = clgeti ("nxgsub")
+	nygsub = clgeti ("nygsub")
+	dynrange = clgetr ("dynrange")
+	psfrange = clgetr ("psfrange")
+	stp = stopen ("mkt", 10, 10, 10*SZ_FNAME)
+end
+
+
+# MKT_FREE -- Free template memory.
+
+procedure mkt_free ()
+
+int	i
+pointer sym, mkt, sthead(), stnext()
+include	"mktemplates.com"
+
+begin
+	# For each object type free the profile and image interpolator data,
+	# the last unsaved data buffer, all saved templates, and the object
+	# structure.  Finally free the symbol table.
+
+	for (sym = sthead (stp); sym != NULL; sym = stnext (stp, sym)) {
+	    mkt = Memi[sym]
+	    if (mkt != NULL) {
+	        call mfree (MKT_PROF(mkt), TY_REAL)
+		if (MKT_MSI(mkt) != NULL)
+		   call msifree (MKT_MSI(mkt))
+	        call mfree (MKT_DATA(mkt), TY_REAL)
+		if (MKT_NALLOC(mkt) > 0) {
+		    do i = 0, MKT_N(mkt)-1
+		        call mfree (Memi[MKT_PTRS(mkt)+i], TY_REAL)
+		    call mfree (MKT_PTRS(mkt), TY_POINTER)
+		    call mfree (MKT_NX(mkt), TY_INT)
+		    call mfree (MKT_NY(mkt), TY_INT)
+		    call mfree (MKT_XC(mkt), TY_REAL)
+		    call mfree (MKT_YC(mkt), TY_REAL)
+		    call mfree (MKT_FLUX(mkt), TY_REAL)
+		    call mfree (MKT_R(mkt), TY_REAL)
+		    call mfree (MKT_AR(mkt), TY_REAL)
+		    call mfree (MKT_PA(mkt), TY_REAL)
+		}
+	        call mfree (mkt, TY_STRUCT)
+	    }
+	}
+	call stclose (stp)
+end
+
+
+# MKT_SAVE -- Save a template
+# If a template may be used more than once it may be saved upon direction of
+# the user in the object list.  Otherwise the last unsaved template is
+# freed for the next object.
+
+procedure mkt_save (mkt, data, nx, ny, xc, yc, flux, r, ar, pa, save)
+
+pointer	mkt		#I MKT pointer
+pointer	data		#I Pointer to template data
+int	nx, ny		#I Size of template
+real	xc, yc		#I Subpixel center
+real	flux		#I Flux
+real	r		#I Effective radius
+real	ar		#I Axial ratio
+real	pa		#I Position angle
+int	save		#I Save data?
+
+int	i
+
+begin
+	if (save == NO) {
+	    MKT_DATA(mkt) = data
+	    return
+	}
+
+	if (MKT_NALLOC(mkt) == 0) {
+	    i = NALLOC
+	    call malloc (MKT_PTRS(mkt), i, TY_POINTER)
+	    call malloc (MKT_NX(mkt), i, TY_INT)
+	    call malloc (MKT_NY(mkt), i, TY_INT)
+	    call malloc (MKT_XC(mkt), i, TY_REAL)
+	    call malloc (MKT_YC(mkt), i, TY_REAL)
+	    call malloc (MKT_FLUX(mkt), i, TY_REAL)
+	    call malloc (MKT_R(mkt), i, TY_REAL)
+	    call malloc (MKT_AR(mkt), i, TY_REAL)
+	    call malloc (MKT_PA(mkt), i, TY_REAL)
+	    MKT_NALLOC(mkt) = i
+	} else if (MKT_N(mkt) == MKT_NALLOC(mkt)) {
+	    i = MKT_NALLOC(mkt) + NALLOC
+	    call realloc (MKT_PTRS(mkt), i, TY_POINTER)
+	    call realloc (MKT_NX(mkt), i, TY_INT)
+	    call realloc (MKT_NY(mkt), i, TY_INT)
+	    call realloc (MKT_XC(mkt), i, TY_REAL)
+	    call realloc (MKT_YC(mkt), i, TY_REAL)
+	    call realloc (MKT_FLUX(mkt), i, TY_REAL)
+	    call realloc (MKT_R(mkt), i, TY_REAL)
+	    call realloc (MKT_AR(mkt), i, TY_REAL)
+	    call realloc (MKT_PA(mkt), i, TY_REAL)
+	    MKT_NALLOC(mkt) = i
+	}
+	i = MKT_N(mkt)
+	Memi[MKT_PTRS(mkt)+i] = data
+	Memi[MKT_NX(mkt)+i] = nx
+	Memi[MKT_NY(mkt)+i] = ny
+	Memr[MKT_XC(mkt)+i] = xc
+	Memr[MKT_YC(mkt)+i] = yc
+	Memr[MKT_FLUX(mkt)+i] = flux
+	Memr[MKT_R(mkt)+i] = r
+	Memr[MKT_AR(mkt)+i] = ar
+	Memr[MKT_PA(mkt)+i] = pa
+	MKT_N(mkt) = i + 1
+end
+
+
+# MKT_GET -- Get a template
+# If not a saved template just free last unsaved template.
+# If saved search for match with position, size, axial ratio, and pa.
+# Return null if not found.
+
+procedure mkt_get (mkt, data, nx, ny, xc, yc, flux, r, ar, pa, save)
+
+pointer	mkt		#I MKT pointer
+pointer	data		#O Pointer to template data
+int	nx, ny		#O Size of template
+real	xc, yc		#I Subpixel center
+real	flux		#I Flux
+real	r		#I Effective radius
+real	ar		#I Axial ratio
+real	pa		#I Position angle
+int	save		#I Get saved template?
+
+int	i
+real	f
+
+begin
+	data = NULL
+	call mfree (MKT_DATA(mkt), TY_REAL)
+	if (save == NO)
+	    return
+
+	for (i=0; i<MKT_N(mkt); i=i+1) {
+	    if (xc != Memr[MKT_XC(mkt)+i])
+		next
+	    if (yc != Memr[MKT_YC(mkt)+i])
+		next
+	    if (r != Memr[MKT_R(mkt)+i])
+		next
+	    if (ar != Memr[MKT_AR(mkt)+i])
+		next
+	    if (pa != Memr[MKT_PA(mkt)+i])
+		next
+	    data = Memi[MKT_PTRS(mkt)+i]
+	    nx = Memi[MKT_NX(mkt)+i]
+	    ny = Memi[MKT_NY(mkt)+i]
+	    f = Memr[MKT_FLUX(mkt)+i]
+	    if (f != flux) {
+	        call amulkr (Memr[data], flux/f, Memr[data], nx*ny)
+	        Memr[MKT_FLUX(mkt)+i] = flux
+	    }
+	    return
+	}
+end
+
+
+# MKT_STAR -- Define star and seeing templates.
+# The seeing template has a smaller range for efficiency.
+# THe star templates are determined once over a grid of centers and
+# then not evaluated again.
+
+pointer procedure mkt_star (name)
+
+char	name[ARB]	# Profile name or file
+
+# Star and seeing parameters obatined through CLIO.
+real	r		# Major axis sigma (pixels)
+real	ar		# Axial ratio (minor / major)
+real	pa		# Position angle (radians)
+
+int	i, j, nxm, nym, nx, ny, fd
+real	dr, flux, radius, seeing, beta, xc, yc, dxc, dyc, der[2]
+pointer	sym, mkt1, mkt2, prof, prof1, asi, msi, data, im
+
+bool	streq()
+real	clgetr(), asieval()
+int	open(), fscan(), nscan()
+pointer	immap(), imgs2r(), stfind(), stenter()
+errchk	immap, open, imgs2r, asifit, asieval, asider
+
+include	"mktemplates.com"
+
+begin
+	# Check if previously defined.
+	sym = stfind (stp, "star")
+	if (sym != NULL)
+	    return (Memi[sym])
+
+	# Select type of star profile and set intensity profile array.
+	# Compute the fraction of the total flux in the profile.
+	# Insure that the profile subsamples a subpixel.
+
+	star = NULL
+	see = NULL
+	prof = NULL
+	msi = NULL
+	if (streq (name, "gaussian")) {
+	    r = clgetr ("radius") / sqrt (log (2.))
+	    radius = sqrt (log (dynrange))
+	    seeing = sqrt (log (psfrange))
+	    nxm = max (NPROF, 1 + nint (radius*r*nxssub*nyssub))
+	    call malloc (prof, nxm, TY_REAL)
+
+	    dr = radius / (nxm - 1)
+	    do i = 0, nxm - 1
+		Memr[prof+i] = exp (-(i * dr) ** 2)
+	    flux = 1 - Memr[prof+nxm-1]
+
+	    r = sqrt (log (2.))
+	    radius = radius / r
+	    seeing = seeing / r
+	} else if (streq (name, "moffat")) {
+	    beta = clgetr ("beta")
+	    r = clgetr ("radius") / sqrt (2. ** (1/beta) - 1.)
+	    radius = sqrt ((dynrange) ** (1/beta) - 1)
+	    seeing = sqrt ((psfrange) ** (1/beta) - 1)
+	    nxm = max (NPROF, 1 + nint (radius*r*nxssub*nyssub))
+	    call malloc (prof, nxm, TY_REAL)
+
+	    dr = radius / (nxm - 1)
+	    flux = 0
+	    do i = 0, nxm - 1 {
+		r = i * dr
+		Memr[prof+i] =  1. / ((1 + r**2) ** beta)
+		flux = flux + r * Memr[prof+i]
+	    }
+
+	    # Compute the fraction of the total flux in the profile.
+	    # The last part of the total flux below is computed by expanding
+	    # (1+r**2) --> r**2 under the approximation that r >> 1.
+	    # Note that it is possible to explicitly compute the total
+	    # flux  F(total) = beta / (2 * beta - 2) (CRC 53rd edition)
+	    # I found errors in other versions of CRC for this integral!
+
+	    r = r + dr / 2
+	    xc = 2 * beta - 2
+	    flux = flux / (flux + 1. / (xc * r ** xc))
+
+	    r = sqrt (2. ** (1/beta) - 1.)
+	    radius = radius / r
+	    seeing = seeing / r
+	} else ifnoerr (im = immap (name, READ_ONLY, 0)) {
+	    iferr {
+		nxm = IM_LEN(im,1)
+		nym = IM_LEN(im,2)
+		data = imgs2r (im, 1, nxm, 1, nym)
+		call msiinit (msi, II_BILINEAR)
+		call msifit (msi, Memr[data], nxm, nym, nxm)
+	    } then
+		call erract (EA_WARN)
+	    call imunmap (im)
+
+	    flux = 1.
+	    radius = 1
+	    seeing = 0.8
+	} else ifnoerr (fd = open (name, READ_ONLY, TEXT_FILE)) {
+	    nxm = NPROF
+	    call malloc (prof1, nxm, TY_REAL)
+
+	    j = 0
+	    while (fscan (fd) != EOF) {
+	 	call gargr (flux)
+		if (nscan() < 1)
+		    next
+		if (j == nxm) {
+		    nxm = nxm + NPROF
+		    call realloc (prof1, nxm, TY_REAL)
+		}
+		Memr[prof1+j] = flux
+		j = j + 1
+	    }
+	    call close (fd)
+	    if (j == 0) {
+		call mfree (prof1, TY_REAL)
+		call error (1, "PSF template not found")
+	    }
+
+	    r = clgetr ("radius")
+	    nxm = max (NPROF, 1 + nint (r*nxssub*nyssub))
+	    call malloc (prof, nxm, TY_REAL)
+	    dr = 1. / (nxm - 1)
+	    j = j - 1
+
+	    call asiinit (asi, II_SPLINE3)
+	    call asifit (asi, Memr[prof1], j)
+	    xc = Memr[prof1]
+	    call mfree (prof1, TY_REAL)
+
+	    if (xc == 0.) {
+		flux = 0.
+		do i = 1, nxm - 1 {
+		    r = i * dr
+		    call asider (asi, 1+j*r, der, 2)
+		    Memr[prof+i] = max (0., der[2] / r)
+		    flux = flux + r * Memr[prof+i]
+		}
+		Memr[prof] = max (0., 2 * Memr[prof+1] - Memr[prof+2])
+	    } else {
+		flux = 0.
+		do i = 0, nxm - 1 {
+		    r = i * dr
+		    Memr[prof+i] = asieval (asi, 1+j*r)
+		    flux = flux + r * Memr[prof+i]
+		}
+	    }
+	    call asifree (asi)
+
+	    xc = 0.9 * flux
+	    flux = 0.
+	    for (i=1; i<nxm && flux<xc; i=i+1)
+		flux = flux + i * dr * Memr[prof+i]
+
+	    flux = 1.
+	    radius = 1.
+	    seeing = (i - 1.) * dr
+	} else
+	    call error (1, "PSF template not found")
+
+	# Set size and orientation parameters.
+	r = clgetr ("radius")
+	ar = clgetr ("ar")
+	pa = DEGTORAD (clgetr ("pa"))
+	radius = r * radius
+	seeing = r * seeing
+
+	# Compute templates with subsampling  over a grid of centers.
+	# Do this for the full star profile and a smaller region for
+	# convolving extended objects.
+
+	# Seeing kernel.
+	sym = stenter (stp, "seeing", 1)
+	call calloc (Memi[sym], LEN_MKT, TY_STRUCT)
+	mkt1 = Memi[sym]
+
+	nx = 2 * nint (seeing) + 1
+	ny = nx
+	dxc = 1. / nxc
+	dyc = 1. / nyc
+	if (prof != NULL) {
+	    nym = 1 + nint (radius * nxssub * nyssub)
+	    call malloc (prof1, nym, TY_REAL)
+	    call mkt_binprof (Memr[prof], nxm, Memr[prof1], nym, radius, nxssub)
+	    for (yc = -0.5+dyc/2; yc < 0.5; yc = yc+dyc) {
+	        for (xc = -0.5+dxc/2; xc < 0.5; xc = xc+dxc) {
+		    call malloc (data, nx*ny, TY_REAL)
+		    call mkt_profile (data, nx, ny, xc, yc, 1., Memr[prof1],
+		        nym, radius, ar, pa, nxssub, nyssub)
+		    call mkt_save (mkt1, data, nx, ny, xc, yc, 1., 0., 0., 0.,
+			YES)
+	        }
+	    }
+	} else {
+	    for (yc = -0.5+dyc/2; yc < 0.5; yc = yc+dyc) {
+	        for (xc = -0.5+dxc/2; xc < 0.5; xc = xc+dxc) {
+		    call malloc (data, nx*ny, TY_REAL)
+		    call mkt_msi (data, nx, ny, xc, yc, 1., msi, nxm, nym,
+		        radius, ar, pa, nxssub, nyssub)
+		    call mkt_save (mkt1, data, nx, ny, xc, yc, 1., 0., 0., 0.,
+			YES)
+	        }
+	    }
+	}
+
+	# Full star templates.
+	sym = stenter (stp, "star", 1)
+	call calloc (Memi[sym], LEN_MKT, TY_STRUCT)
+	mkt2 = Memi[sym]
+
+	nx = 2 * nint (radius) + 1
+	ny = nx
+	dxc = 1. / nxc
+	dyc = 1. / nyc
+	if (prof != NULL) {
+	    for (yc = 0.5+dyc/2; yc < 1.5; yc = yc+dyc) {
+	        for (xc = 0.5+dxc/2; xc < 1.5; xc = xc+dxc) {
+		    call malloc (data, nx*ny, TY_REAL)
+		    call mkt_profile (data, nx, ny, xc, yc, flux, Memr[prof1],
+		        nym, radius, ar, pa, nxssub, nyssub)
+		    call mkt_save (mkt2, data, nx, ny, xc, yc, 1., 0., 0., 0.,
+			YES)
+	        }
+	    }
+	    call mfree (prof, TY_REAL)
+	    call mfree (prof1, TY_REAL)
+	} else {
+	    for (yc = 0.5+dyc/2; yc < 1.5; yc = yc+dyc) {
+	        for (xc = 0.5+dxc/2; xc < 1.5; xc = xc+dxc) {
+		    call malloc (data, nx*ny, TY_REAL)
+		    call mkt_msi (data, nx, ny, xc, yc, flux, msi, nxm, nym,
+		        radius, ar, pa, nxssub, nyssub)
+		    call mkt_save (mkt2, data, nx, ny, xc, yc, 1., 0., 0., 0.,
+			YES)
+	        }
+	    }
+	    call msifree (msi)
+	}
+
+	see = mkt1
+	star = mkt2
+	return (star)
+end
+
+
+# MKT_OBJECT -- Set object profiles.
+
+pointer procedure mkt_object (name)
+
+char	name[ARB]	# Profile name or file
+
+int	i, j, n, nxm, nym, fd
+real	radius, r, dr, s, b, flux, der[2]
+pointer	sym, mkt, prof, asi, msi, buf, im
+
+real	asieval(), uigamma()
+int	open(), fscan(), nscan(), strncmp(), ctor()
+pointer	immap(), imgs2r(), stfind(), stenter()
+bool	streq()
+errchk	open, immap, asifit, asieval, asider
+
+include	"mktemplates.com"
+
+begin
+	# Check if previously defined.
+	sym = stfind (stp, name)
+	if (sym != NULL)
+	    return (Memi[sym])
+
+	# Select type of profile and set intensity profile array.
+	# Compute the fraction of the total flux in the profile.
+
+	prof = NULL
+	msi = NULL
+	if (strncmp (name, "sersic", 6) == 0) {
+	    i = 7
+	    if (ctor (name, i, s) == 0) {
+		call eprintf ("WARNING: Bad sersic profile syntax (%s).\n")
+		    call pargstr (name)
+		return (NULL)
+	    }
+	    n = nint (2 * (s + 0.01))
+	    s = n / 2
+call eprintf ("n = %.1f, 2n = %d\n")
+call pargr (s)
+call pargi (n)
+	    if (n < 1 || n > 20) {
+		call eprintf ("WARNING: Sersic index out of allowed range (%f).\n")
+		    call pargi (s)
+		return (NULL)
+	    }
+	    nxm = NPROF
+	    call malloc (prof, nxm, TY_REAL)
+call eprintf ("A\n")
+	    radius = log (dynrange) ** s
+call eprintf ("B\n")
+	    dr = radius / (nxm - 1)
+	    do i = 0, nxm - 1 {
+		r = (i * dr) ** (1/s)
+		Memr[prof+i] = exp (-r)
+	    }
+
+call eprintf ("C\n")
+	    flux = 1 - uigamma (n, r)
+call eprintf ("D\n")
+	    r = n - 1./3. + 4./(405.*s) + 46./(25515.*s*s)
+call eprintf ("E\n")
+	    radius = radius / r ** s
+call eprintf ("F\n")
+	} else if (streq (name, "expdisk")) {
+	    s = 1.
+	    n = nint (2 * s)
+
+	    nxm = NPROF
+	    call malloc (prof, nxm, TY_REAL)
+	    radius = log (dynrange) ** s
+	    dr = radius / (nxm - 1)
+	    do i = 0, nxm - 1 {
+		r = (i * dr) ** (1/s)
+		Memr[prof+i] = exp (-r)
+	    }
+
+	    flux = 1 - uigamma (n, r)
+	    r = n - 1./3. + 4./(405.*s) + 46./(25515.*s*s)
+	    radius = radius / r ** s
+	} else if (streq (name, "devauc")) {
+	    s = 4.
+	    n = nint (2 * s)
+	    nxm = NPROF
+	    call malloc (prof, nxm, TY_REAL)
+	    radius = log (dynrange) ** s
+	    dr = radius / (nxm - 1)
+	    do i = 0, nxm - 1 {
+		r = (i * dr) ** (1/s)
+		Memr[prof+i] = exp (-r)
+	    }
+
+	    flux = 1 - uigamma (n, r)
+	    r = n - 1./3. + 4./(405.*s) + 46./(25515.*s*s)
+	    radius = radius / r ** s
+	} else ifnoerr (im = immap (name, READ_ONLY, 0)) {
+	    iferr {
+		nxm = IM_LEN(im,1)
+		nym = IM_LEN(im,2)
+		buf = imgs2r (im, 1, nxm, 1, nym)
+		call msiinit (msi, II_BILINEAR)
+		call msifit (msi, Memr[buf], nxm, nym, nxm)
+	    } then
+		call erract (EA_WARN)
+	    call imunmap (im)
+
+	    flux = 1.
+	    radius = 1.
+	} else ifnoerr (fd = open (name, READ_ONLY, TEXT_FILE)) {
+	    nxm = NPROF
+	    call malloc (buf, nxm, TY_REAL)
+
+	    j = 0
+	    while (fscan (fd) != EOF) {
+	 	call gargr (flux)
+		if (nscan() < 1)
+		    next
+		if (j == nxm) {
+		    nxm = nxm + NPROF
+		    call realloc (buf, nxm, TY_REAL)
+		}
+		Memr[buf+j] = flux
+		j = j + 1
+	    }
+	    call close (fd)
+	    if (j == 0) {
+		call mfree (buf, TY_REAL)
+		nxm = 0
+		call error (1, "PSF template not found")
+	    }
+
+	    nxm = NPROF
+	    call malloc (prof, nxm, TY_REAL)
+	    dr = 1. / (nxm - 1)
+	    j = j - 1
+
+	    call asiinit (asi, II_SPLINE3)
+	    call asifit (asi, Memr[buf], j)
+	    s = Memr[buf]
+	    call mfree (buf, TY_REAL)
+
+	    if (s == 0.) {
+		do i = 1, nxm - 1 {
+		    r = i * dr
+		    call asider (asi, 1+j*r, der, 2)
+		    Memr[prof+i] = max (0., der[2] / r)
+		}
+		Memr[prof] = max (0., 2 * Memr[prof+1] - Memr[prof+2])
+	    } else {
+		do i = 0, nxm - 1 {
+		    r = i * dr
+		    Memr[prof+i] = asieval (asi, 1+j*r)
+		}
+	    }
+	    call asifree (asi)
+
+	    flux = 1.
+	    radius = 1.
+	} else {
+	    call eprintf ("WARNING: Object template %s not found.\n")
+		call pargstr (name)
+	    return (NULL)
+	}
+call eprintf ("G\n")
+
+	# Create the template structure if a model is defined..
+	if (prof == NULL && msi == NULL)
+	    mkt = NULL
+	else {
+	    call calloc (mkt, LEN_MKT, TY_STRUCT)
+	    MKT_PROF(mkt) = prof
+	    MKT_MSI(mkt) = msi
+	    MKT_NXM(mkt) = nxm
+	    MKT_NYM(mkt) = nym
+	    MKT_F(mkt) = flux
+	    MKT_SCALE(mkt) = radius
+call eprintf ("flux = %g, radius = %g\n")
+call pargr (MKT_F(mkt))
+call pargr (MKT_SCALE(mkt))
+do i = 0, nxm {
+call eprintf ("%d: %g\n")
+call pargi (i)
+call pargr (Memr[prof+i])
+}
+	}
+call eprintf ("H\n")
+
+	# Enter object model name in symbol table.
+	sym = stenter (stp, name, 1)
+	Memi[sym] = mkt
+	return (mkt)
+end
+
+
+# MKT_GOBJECT -- Get image raster.
+# The profile type is set by the template structure.
+
+procedure mkt_gobject (mkt, data, nx, ny, x, y, z, r, ar, pa, save)
+
+pointer	mkt		# Object template
+pointer	data		# Data
+int	nx, ny		# Size of returned data
+real	x, y		# Position of object
+real	z		# Flux of object
+real	r		# Major axis scale (pixels)
+real	ar		# Axial ratio (minor / major)
+real	pa		# Position angle (radians)
+int	save		# Use/save template?
+
+real	xc, yc, radius
+int	nprof
+pointer	prof
+
+include	"mktemplates.com"
+
+begin
+	data = NULL
+	if (mkt == NULL)
+	    return
+
+	# Stars are predefined.  Return the nearest template center.
+	# Other objects are computed with or without seeing.
+
+	if (mkt == star)
+	    call mkt_gstar (star, data, nx, ny, x, y, z)
+	else {
+	    xc = x + 0.5 - int (x + 0.5)
+	    yc = y + 0.5 - int (y + 0.5)
+	    call mkt_get (mkt, data, nx, ny, xc, yc, z, r, ar, pa, save)
+	    if (data != NULL)
+		return
+
+	    radius = r * MKT_SCALE(mkt)
+	    nx = max (3, 2 * nint (radius) + 1)
+	    ny = nx
+	    if (see != NULL) {
+	        nx = nx + Memi[MKT_NX(see)] / 2
+	        ny = ny + Memi[MKT_NY(see)] / 2
+	    }
+	    call malloc (data, nx * ny, TY_REAL)
+
+	    if (MKT_PROF(mkt) != 0) {
+	        nprof = 1 + nint (radius * nxgsub * nxgsub)
+	        call malloc (prof, nprof, TY_REAL)
+	        call mkt_binprof (Memr[MKT_PROF(mkt)], MKT_NXM(mkt),
+		    Memr[prof], nprof, radius, nxgsub)
+	        call mkt_profile (data, nx, ny, x, y, z*MKT_F(mkt), Memr[prof],
+		    nprof, radius, ar, pa, nxgsub, nygsub)
+	        call mfree (prof, TY_REAL)
+	    } else {
+	        call mkt_msi (data, nx, ny, x, y, z, MKT_MSI(mkt),
+		    MKT_NXM(mkt), MKT_NYM(mkt), radius, ar, pa,
+		    nxgsub, nygsub)
+	    }
+
+	    call mkt_save (mkt, data, nx, ny, xc, yc, z, r, ar, pa, save)
+	}
+end
+
+
+# MKT_BINPROF -- Bin intensity profile into subpixels
+
+procedure mkt_binprof (prof, nprof, prof1, nprof1, radius, nsub)
+
+real	prof[nprof]		# Input intensity profile
+int	nprof			# Number of input points
+real	prof1[nprof]		# Output binned intensity profile
+int	nprof1			# Number of output points
+real	radius			# Radius of profile
+int	nsub			# Maximum subsampling
+
+int	i, j, k, k1, k2, l, dx
+real	scale, dy, val
+
+int	debug, open()
+data	debug/0/
+
+begin
+	if (radius < 0.1) {
+	    call amovkr (1., prof1, nprof1)
+	    return
+	} else
+	    call aclrr (prof1, nprof1)
+
+	# Set binning parameters
+	scale = (nprof - 1.) / (nprof1 - 1.)
+	dx = nint ((nprof1 - 1.) / nsub / radius / 2.)
+	dy = dx / (NY - 1.)
+
+	# Bin central pixels
+	do i = -dx, 2*dx {
+	    k = abs (i)
+	    k1 = max (1, i - dx + 1) 
+	    k2 = i + dx + 1
+	    do j = 0, NY-1 {
+		if (j == 0)
+		    val = k
+		else if (k == 0)
+		    val = dy * j
+		else
+		    val = k * sqrt (1. + (dy * j / k) ** 2)
+		l = nint (scale * val + 1)
+		if (l > nprof)
+		    next
+		val = prof[l] / NY
+		do l = k1, k2
+		    prof1[l] = prof1[l] + val
+	    }
+	}
+
+	# Now bin remainder of pixels more crudely
+	do i = 2*dx+1, nprof1-1 {
+	    k1 = i - dx + 1
+	    k2 = min (nprof1, i + dx + 1)
+	    val = prof[nint (scale * i + 1)]
+	    do k = k1, k2
+		prof1[k] = prof1[k] + val
+	}
+
+	if (debug == YES) {
+	    j = open ("debug1.dat", APPEND, TEXT_FILE)
+	    do i = 1, nprof {
+		call fprintf (j, "%d %g\n")
+		    call pargi (i)
+		    call pargr (prof[i])
+	    }
+	    call close (j)
+
+	    j = open ("debug2.dat", APPEND, TEXT_FILE)
+	    do i = 1, nprof1 {
+		call fprintf (j, "%d %g\n")
+		    call pargi (i)
+		    call pargr (prof1[i])
+	    }
+	    call close (j)
+	}
+end
+
+
+# MKT_GSTAR -- Get the precomputed template with center nearest (x,y).
+
+procedure mkt_gstar (mkt, data, nx, ny, x, y, z)
+
+pointer	mkt		# Template
+pointer	data		# Data
+int	nx, ny		# Size of data
+real	x, y		# Position of object
+real	z		# Flux of object
+
+int	i, j
+real	f
+
+include	"mktemplates.com"
+
+begin
+	i = (x + 0.5 - int (x + 0.5)) * nxc
+	j = (y + 0.5 - int (y + 0.5)) * nyc
+	i = j * nxc + i
+	data = Memi[MKT_PTRS(mkt)+i]
+	nx = Memi[MKT_NX(mkt)+i]
+	ny = Memi[MKT_NY(mkt)+i]
+	f = Memr[MKT_FLUX(mkt)+i]
+	if (f != z) {
+	    call amulkr (Memr[data], z/f, Memr[data], nx*ny)
+	    Memr[MKT_FLUX(mkt)+i] = z
+	}
+end
+
+
+# MKT_PROFILE -- Make template from profile.
+
+procedure mkt_profile (data, nx, ny, xc, yc, flux, prof, npts, radius,
+	ar, pa, nxsub, nysub)
+
+pointer	data		# Pointer to data array
+int	nx, ny		# Size of template
+real	xc, yc		# Model center
+real	flux		# Model flux
+real	prof[npts]	# 1D profile
+int	npts		# Number of points in profile
+real	radius		# Major axis radius of profile (pixels)
+real	ar		# Axial ratio (minor / major)
+real	pa		# Position angle relative to major axis (radians)
+int	nxsub, nysub	# Number of subpixel samples
+
+int	i, n, nxs, nys, nxs2, nys2, xs1, xs2, ys1, ys2
+int	x, y, x2, y2
+real	a, b, c, r, s, t, z, sum, sum1, asumr()
+real	dx, dy, dsub, dsub2
+real	x1, y1, xc1, yc1
+pointer	ptr, ptr1, ptr2, see1, see2
+
+include	"mktemplates.com"
+
+define	see_	99
+
+begin
+	# Switch on the size of the seeing templates.
+	if (see != NULL)
+	    if (Memi[MKT_NX(see)] * Memi[MKT_NY(see)] > 1)
+	        goto see_
+
+# NO SEEING:
+
+	# If the radius is very small return delta function.
+	if (radius < 0.1) {
+	    call aclrr (Memr[data], nx*ny)
+	    Memr[data+(ny/2)*nx+(nx/2)] = flux
+	    return
+	}
+
+	# Compute elliptical scale factors for entry into profile array.
+	r = ((npts - 1) / radius) ** 2
+	t = ((npts - 1) / (ar * radius)) ** 2
+	c = cos (pa)
+	s = sin (pa)
+	a = r * c * c + t * s * s
+	b = 2 * (r - t) * c * s
+	c = r * s * s + t * c * c
+
+	# Subsample the profile and sum into each pixel.
+	n = nx * ny
+	xc1 = xc - int (xc + 0.5) + nx/2
+	yc1 = yc - int (yc + 0.5) + ny/2
+
+	sum1 = 0.
+	ptr = data
+	do y = 0, ny-1 {
+	    t = (y - yc1) ** 2
+	    do x = 0, nx-1 {
+		i = sqrt ((x - xc1) ** 2 + t)
+		dsub = 1. / max (1, nxsub - i)
+		sum = 0.
+		for (y1 = y-0.5+dsub/2; y1 < y+0.5; y1 = y1+dsub) {
+		    dy = (y1 - yc1)
+		    s = c * dy**2
+		    for (x1=x-0.5+dsub/2; x1<x+0.5; x1=x1+dsub) {
+			dx = (x1-xc1)
+			i = sqrt (a * dx**2 + b * dx * dy + s) + 1.5
+			if (i <= npts)
+			    sum = sum + prof[i]
+		    }
+		}
+		sum = sum * dsub ** 2
+		sum1 = sum1 + sum
+		Memr[ptr] = sum
+		ptr = ptr + 1
+	    }
+	}
+
+	# If the subsamples completely miss and signal is zero then return
+	# delta function otherwise scale to requested flux.
+
+	if (sum1 == 0.)
+	    Memr[data+(ny/2)*nx+(nx/2)] = flux
+	else
+	    call amulkr (Memr[data], flux/sum1, Memr[data], n)
+	return
+
+# WITH SEEING:
+
+see_	n = nx * ny
+	call aclrr (Memr[data], n)
+	sum = 0.
+
+	nxs = Memi[MKT_NX(see)]
+	nys = Memi[MKT_NY(see)]
+	nxs2 = nxs/2
+	nys2 = nys/2
+
+	# If the profile is very small return full star image rather than
+	# convolution with truncated seeing template.
+
+	if (radius > 0.01) {
+	    r = ((npts - 1) / radius) ** 2
+	    t = ((npts - 1) / (ar * radius)) ** 2
+	    c = cos (pa)
+	    s = sin (pa)
+	    a = r * c * c + t * s * s
+	    b = 2 * (r - t) * c * s
+	    c = r * s * s + t * c * c
+    
+	    xc1 = xc - int (xc + 0.5) + nx/2
+	    yc1 = yc - int (yc + 0.5) + ny/2
+	    ptr = data-nys2*nx-nxs2
+	    do y = 0, ny-1 {
+		t = (y - yc1) ** 2
+		ys1 = max (0, nys2 - y)
+		ys2 = min (nys-1, ny - y + nys2 - 1)
+		do x = 0, nx-1 {
+		    i = sqrt ((x - xc1) ** 2 + t)
+		    dsub = 1. / max (1, nxsub - i)
+		    dsub2 = dsub ** 2
+		    xs1 = max (0, nxs2 - x)
+		    xs2 = min (nxs-1, nx - x + nxs2 - 1)
+		    ptr1 = ptr + xs1
+		    for (y1=y-0.5+dsub/2; y1<y+0.5; y1=y1+dsub) {
+			dy = (y1 - yc1)
+			s = c * dy**2
+			for (x1=x-0.5+dsub/2; x1<x+0.5; x1=x1+dsub) {
+			    dx = (x1-xc1)
+			    i = sqrt (a * dx**2 + b * dx * dy + s) + 1.5
+			    if (i <= npts) {
+				z = prof[i] * dsub2
+				call mkt_gstar (see, see1, nxs, nys, x1, y1, 1.)
+				see1 = see1 + xs1
+				do y2 = ys1, ys2 {
+				   see2 = see1+y2*nxs
+				   ptr2 = ptr1+y2*nx
+				   do x2 = xs1, xs2 {
+				       Memr[ptr2] = Memr[ptr2] +
+					   z * Memr[see2]
+				       ptr2 = ptr2 + 1
+				       see2 = see2 + 1
+				    }
+				}
+			    }
+			}
+		    }
+		    ptr = ptr + 1
+		}
+	    }
+	    sum = asumr (Memr[data], n)
+	}
+
+	# If no flux is accumulated or radius is very small return star image.
+	# Otherwise scale to requested flux.
+
+	if (sum == 0.) {
+	    call mkt_gstar (star, see1, nxs, nys, xc, yc, flux)
+	    x = nx/2
+	    y = ny/2
+	    nxs2 = nxs / 2
+	    nys2 = nys / 2
+	    xs1 = max (0, nxs2 - x)
+	    xs2 = min (nxs-1, nx - x + nxs2 - 1)
+	    ys1 = max (0, nys2 - y)
+	    ys2 = min (nys-1, ny - y + nys2 - 1)
+	    ptr1 = data-nys2*nx-nxs2+(y*nx+x+xs1)
+	    see1 = see1 + xs1
+	    do y2 = ys1, ys2 {
+	       see2 = see1+y2*nxs
+	       ptr2 = ptr1+y2*nx
+	       do x2 = xs1, xs2 {
+		   Memr[ptr2] = Memr[ptr2] + Memr[see2]
+		   ptr2 = ptr2 + 1
+		   see2 = see2 + 1
+		}
+	    }
+	} else
+	    call amulkr (Memr[data], flux/sum, Memr[data], n)
+end
+
+
+# MKT_MSI -- Make template from image interpolation function.
+
+procedure mkt_msi (data, nx, ny, xc, yc, flux, model, nxm, nym, radius,
+	ar, pa, nxsub, nysub)
+
+pointer	data		# Pointer to data array
+int	nx, ny		# Size of template
+real	xc, yc		# Model center
+real	flux		# Model flux
+pointer	model		# Surface interpolation pointer for image template
+int	nxm, nym	# Number of points in image template
+real	radius		# Major axis radius of profile (pixels)
+real	ar		# Axial ratio (minor / major)
+real	pa		# Position angle relative to major axis (radians)
+int	nxsub, nysub	# Number of subpixel samples
+
+int	i, n, nxs, nys, nxs2, nys2, xs1, xs2, ys1, ys2, x, y, x2, y2
+real	a, b, c, s, xcm, ycm, x1, y1, xc1, yc1, dsub, sum, sum1
+real	ac, as, bc, bs, acdx1, acdx2, bsdx1, bsdx2, bcdy1, bcdy2, asdy1, asdy2
+real	val1, val2, val3, val4, minval, maxval, xm[5], ym[5]
+real	asumr(), msigrl(), msisqgrl()
+pointer	ptr, ptr1, ptr2, see1, see2
+
+include	"mktemplates.com"
+
+define	see_	99
+
+begin
+	# Switch on the size of the seeing templates.
+	if (see != NULL)
+	    if (Memi[MKT_NX(see)] * Memi[MKT_NY(see)] > 1)
+	        goto see_
+
+# NO SEEING:
+
+	# If the radius is very small return delta function.
+	if (radius < 0.1) {
+	    call aclrr (Memr[data], nx*ny)
+	    Memr[data+(ny/2)*nx+(nx/2)] = flux
+	    return
+	}
+
+	a = (nxm / 2.) / radius
+	b = (nym / 2.) / (ar * radius)
+	c = cos (pa)
+	s = sin (pa)
+	ac = a * c
+	as = a * s
+	bc = b * c
+	bs = b * s
+	a = nxm
+	b = nym
+	xcm = nxm / 2 + 1.
+	ycm = nym / 2 + 1.
+
+	# Subsample the profile and sum into each pixel.
+	n = nx * ny
+	xc1 = xc - int (xc + 0.5) + nx/2
+	yc1 = yc - int (yc + 0.5) + ny/2
+
+	sum1 = 0.
+	ptr = data
+	do y = 0, ny-1 {
+	    c = (y - yc1) ** 2
+	    do x = 0, nx-1 {
+		i = sqrt ((x - xc1) ** 2 + c)
+		dsub = 1. / max (1, nxsub - i)
+		sum = 0.
+		for (y1 = y-0.5; y1 < y+0.5-dsub/2; y1 = y1+dsub) {
+		    asdy1 = (y1 - yc1)
+		    asdy2 = asdy1 + dsub
+		    bcdy1 = bc * asdy1 + ycm
+		    bcdy2 = bc * asdy2 + ycm
+		    if (pa == 0.) {
+			val3 = max (1., bcdy1)
+			if (val3 >= nym)
+			    next
+			val4 = min (b, bcdy2)
+			if (val3 >= val4)
+			    next
+		    }
+		    asdy1 = as * asdy1
+		    asdy2 = as * asdy2
+		    for (x1=x-0.5; x1<x+0.5-dsub/2; x1=x1+dsub) {
+			bsdx1 = (x1-xc1)
+			bsdx2 = bsdx1 + dsub
+			acdx1 = ac * bsdx1 + xcm
+			acdx2 = ac * bsdx2 + xcm
+			if (pa == 0.) {
+			    val1 = max (1., acdx1)
+			    if (val1 >= nxm)
+				next
+			    val2 = min (a, acdx2)
+			    if (val1 >= val2)
+				next
+			    s = msisqgrl (model, val1, val2, val3, val4)
+			} else {
+			    bsdx1 = bs * bsdx1
+			    bsdx2 = bs * bsdx2
+
+			    val1 = acdx1 + asdy1
+			    val2 = acdx2 + asdy1
+			    val3 = acdx2 + asdy2
+			    val4 = acdx1 + asdy2
+			    minval = min (val1, val2, val3, val4)
+			    maxval = max (val1, val2, val3, val4)
+			    if (minval >= a || maxval <= 1.)
+				next
+			    xm[1] = max (1., min (a, val1))
+			    xm[2] = max (1., min (a, val2))
+			    xm[3] = max (1., min (a, val3))
+			    xm[4] = max (1., min (a, val4))
+			    xm[5] = xm[1]
+
+			    val1 = bcdy1 - bsdx1
+			    val2 = bcdy1 - bsdx2
+			    val3 = bcdy2 - bsdx2
+			    val4 = bcdy2 - bsdx1
+			    minval = min (val1, val2, val3, val4)
+			    maxval = max (val1, val2, val3, val4)
+			    if (minval >= b || maxval <= 1.)
+				next
+			    ym[1] = max (1., min (b, val1))
+			    ym[2] = max (1., min (b, val2))
+			    ym[3] = max (1., min (b, val3))
+			    ym[4] = max (1., min (b, val4))
+			    ym[5] = ym[1]
+			    y2 = 1
+			    do x2 = 2, 4
+				if (ym[x2] < ym[y2])
+				    y2 = x2
+			    switch (y2) {
+			    case 2:
+				xm[1] = xm[2]; ym[1] = ym[2]
+				xm[2] = xm[3]; ym[2] = ym[3]
+				xm[3] = xm[4]; ym[3] = ym[4]
+				xm[4] = xm[5]; ym[4] = ym[5]
+				xm[5] = xm[1]; ym[5] = ym[1]
+			    case 3:
+				xm[1] = xm[3]; ym[1] = ym[3]
+				xm[3] = xm[5]; ym[3] = ym[5]
+				xm[5] = xm[2]; ym[5] = ym[2]
+				xm[2] = xm[4]; ym[2] = ym[4]
+				xm[4] = xm[5]; ym[4] = ym[5]
+				xm[5] = xm[1]; ym[5] = ym[1]
+			    case 4:
+				xm[5] = xm[4]; ym[5] = ym[4]
+				xm[4] = xm[3]; ym[4] = ym[3]
+				xm[3] = xm[2]; ym[3] = ym[2]
+				xm[2] = xm[1]; ym[2] = ym[1]
+				xm[1] = xm[5]; ym[1] = ym[5]
+			    }
+
+			    s = msigrl (model, xm, ym, 5)
+			}
+			sum = sum + s
+		    }
+		}
+		sum1 = sum1 + sum
+		Memr[ptr] = sum
+		ptr = ptr + 1
+	    }
+	}
+
+	call amulkr (Memr[data], flux/sum1, Memr[data], n)
+	return
+
+# SEEING:
+
+see_	n = nx * ny
+	call aclrr (Memr[data], n)
+	sum = 0.
+
+	nxs = Memi[MKT_NX(see)]
+	nys = Memi[MKT_NY(see)]
+	nxs2 = nxs/2
+	nys2 = nys/2
+
+	# If the profile is very small return full star image rather than
+	# convolution with truncated seeing template.
+
+	if (radius > 0.01) {
+	    a = (nxm / 2.) / radius
+	    b = (nym / 2.) / (ar * radius)
+	    c = cos (pa)
+	    s = sin (pa)
+	    ac = a * c
+	    as = a * s
+	    bc = b * c
+	    bs = b * s
+	    a = nxm
+	    b = nym
+	    xcm = nxm / 2 + 1.
+	    ycm = nym / 2 + 1.
+    
+	    xc1 = xc - int (xc + 0.5) + nx/2
+	    yc1 = yc - int (yc + 0.5) + ny/2
+	    ptr = data-nys2*nx-nxs2
+	    do y = 0, ny-1 {
+		c = (y - yc1) ** 2
+		ys1 = max (0, nys2 - y)
+		ys2 = min (nys-1, ny - y + nys2 - 1)
+		do x = 0, nx-1 {
+		    i = sqrt ((x - xc1) ** 2 + c)
+		    dsub = 1. / max (1, nxsub - i)
+		    xs1 = max (0, nxs2 - x)
+		    xs2 = min (nxs-1, nx - x + nxs2 - 1)
+		    ptr1 = ptr + xs1
+		    for (y1=y-0.5; y1<y+0.5-dsub/2; y1=y1+dsub) {
+			asdy1 = (y1 - yc1)
+			asdy2 = asdy1 + dsub
+			bcdy1 = bc * asdy1 + ycm
+			bcdy2 = bc * asdy2 + ycm
+		        if (pa == 0.) {
+			    val3 = max (1., bcdy1)
+			    if (val3 >= nym)
+			        next
+			    val4 = min (b, bcdy2)
+			    if (val3 >= val4)
+			        next
+		        }
+			asdy1 = as * asdy1
+			asdy2 = as * asdy2
+		        for (x1=x-0.5; x1<x+0.5-dsub/2; x1=x1+dsub) {
+			    bsdx1 = (x1-xc1)
+			    bsdx2 = bsdx1 + dsub
+			    acdx1 = ac * bsdx1 + xcm
+			    acdx2 = ac * bsdx2 + xcm
+			    if (pa == 0.) {
+			        val1 = max (1., acdx1)
+			        if (val1 >= nxm)
+				    next
+			        val2 = min (a, acdx2)
+			        if (val1 >= val2)
+				    next
+			        sum = msisqgrl (model, val1, val2, val3, val4)
+			    } else {
+			        bsdx1 = bs * bsdx1
+			        bsdx2 = bs * bsdx2
+
+			        val1 = acdx1 + asdy1
+			        val2 = acdx2 + asdy1
+			        val3 = acdx2 + asdy2
+			        val4 = acdx1 + asdy2
+			        minval = min (val1, val2, val3, val4)
+			        maxval = max (val1, val2, val3, val4)
+			        if (minval >= a || maxval <= 1.)
+				    next
+			        xm[1] = max (1., min (a, val1))
+			        xm[2] = max (1., min (a, val2))
+			        xm[3] = max (1., min (a, val3))
+			        xm[4] = max (1., min (a, val4))
+			        xm[5] = xm[1]
+
+			        val1 = bcdy1 - bsdx1
+			        val2 = bcdy1 - bsdx2
+			        val3 = bcdy2 - bsdx2
+			        val4 = bcdy2 - bsdx1
+			        minval = min (val1, val2, val3, val4)
+			        maxval = max (val1, val2, val3, val4)
+			        if (minval >= b || maxval <= 1.)
+				    next
+			        ym[1] = max (1., min (b, val1))
+			        ym[2] = max (1., min (b, val2))
+			        ym[3] = max (1., min (b, val3))
+			        ym[4] = max (1., min (b, val4))
+			        ym[5] = ym[1]
+
+# The following is put in to work around a bug in msigrl in V2.8.  When
+# V2.8 is long gone we can take this stuff out since msigrl will do the
+# rotating of the coordinates itself.
+
+				minval = max (1., minval)
+				y2 = 1
+				do x2 = 2, 4
+				    if (ym[x2] < ym[y2])
+					y2 = x2
+				switch (y2) {
+				case 2:
+				    xm[1] = xm[2]; ym[1] = ym[2]
+				    xm[2] = xm[3]; ym[2] = ym[3]
+				    xm[3] = xm[4]; ym[3] = ym[4]
+				    xm[4] = xm[5]; ym[4] = ym[5]
+				    xm[5] = xm[1]; ym[5] = ym[1]
+				case 3:
+				    xm[1] = xm[3]; ym[1] = ym[3]
+				    xm[3] = xm[5]; ym[3] = ym[5]
+				    xm[5] = xm[2]; ym[5] = ym[2]
+				    xm[2] = xm[4]; ym[2] = ym[4]
+				    xm[4] = xm[5]; ym[4] = ym[5]
+				    xm[5] = xm[1]; ym[5] = ym[1]
+				case 4:
+				    xm[5] = xm[4]; ym[5] = ym[4]
+				    xm[4] = xm[3]; ym[4] = ym[3]
+				    xm[3] = xm[2]; ym[3] = ym[2]
+				    xm[2] = xm[1]; ym[2] = ym[1]
+				    xm[1] = xm[5]; ym[1] = ym[5]
+				}
+
+			        sum = msigrl (model, xm, ym, 5)
+			    }
+	    		    call mkt_gstar (see, see1, nxs, nys, x1, y1, 1.)
+			    see1 = see1 + xs1
+			    do y2 = ys1, ys2 {
+				see2 = see1+y2*nxs
+				ptr2 = ptr1+y2*nx
+				do x2 = xs1, xs2 {
+				    Memr[ptr2] = Memr[ptr2] + sum * Memr[see2]
+				    ptr2 = ptr2 + 1
+				    see2 = see2 + 1
+				}
+			    }
+			}
+		    }
+		    ptr = ptr + 1
+		}
+	    }
+	    sum = asumr (Memr[data], n)
+	}
+
+	# If no flux is accumulated or radius is very small return star image.
+	# Otherwise scale to requested flux.
+
+	if (sum == 0.) {
+	    call mkt_gstar (star, see1, nxs, nys, xc, yc, flux)
+	    x = nx/2
+	    y = ny/2
+	    nxs2 = nxs / 2
+	    nys2 = nys / 2
+	    xs1 = max (0, nxs2 - x)
+	    xs2 = min (nxs-1, nx - x + nxs2 - 1)
+	    ys1 = max (0, nys2 - y)
+	    ys2 = min (nys-1, ny - y + nys2 - 1)
+	    ptr1 = data-nys2*nx-nxs2+(y*nx+x+xs1)
+	    see1 = see1 + xs1
+	    do y2 = ys1, ys2 {
+	       see2 = see1+y2*nxs
+	       ptr2 = ptr1+y2*nx
+	       do x2 = xs1, xs2 {
+		   Memr[ptr2] = Memr[ptr2] + Memr[see2]
+		   ptr2 = ptr2 + 1
+		   see2 = see2 + 1
+		}
+	    }
+	} else
+	    call amulkr (Memr[data], flux/sum, Memr[data], n)
+end
+
+
+# UIGAMMA -- Upper Incomplete Gamma Function
+#
+#	uigamma(n,x) = (n-1)!e^(x) sum (x^k/k!) for k=0, n-1
+
+real procedure uigamma (n, x)
+
+int	n		#I argument
+real	x		#I argument
+
+int	i
+real	uigamma
+double	sum, numerator, denominator
+
+begin
+	numerator = exp(-x)
+	denominator = 1
+	sum = numerator / denominator
+	do i = 1, n {
+	    numerator = numerator * x
+	    denominator = denominator * i
+	    sum = sum + numerator / denominator
+	}
+	uigamma = denominator * sum
+	return (uigamma)
+end
diff --git a/noao/artdata/numrecipes.x b/noao/artdata/numrecipes.x
new file mode 100644
index 00000000..fa0f56b6
--- /dev/null
+++ b/noao/artdata/numrecipes.x
@@ -0,0 +1,121 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<math.h>
+
+# GAMMLN -- Return natural log of gamma function.
+# POIDEV -- Returns Poisson deviates for a given mean.
+# GASDEV -- Return a normally distributed deviate of zero mean and unit var.
+
+
+# GAMMLN -- Return natural log of gamma function.
+# Argument must greater than 0.  Full accuracy is obtained for values
+# greater than 1.  For 0<xx<1, the reflection formula can be used first.
+#
+# Based on Numerical Recipes by Press, Flannery, Teukolsky, and Vetterling.
+# Used by permission of the authors.
+# Copyright(c) 1986 Numerical Recipes Software.
+
+real procedure gammln (xx)
+
+real	xx		# Value to be evaluated
+
+int	j
+double	cof[6], stp, x, tmp, ser
+data	cof, stp / 76.18009173D0, -86.50532033D0, 24.01409822D0,
+		-1.231739516D0,.120858003D-2,-.536382D-5,2.50662827465D0/
+
+begin
+	x = xx - 1.0D0
+	tmp = x + 5.5D0
+	tmp = (x + 0.5D0) * log (tmp) - tmp
+	ser = 1.0D0
+	do j = 1, 6 {
+	    x = x + 1.0D0
+	    ser = ser + cof[j] / x
+	}
+	return (tmp + log (stp * ser))
+end
+
+
+# POIDEV -- Returns Poisson deviates for a given mean.
+# The real value returned is an integer.
+#
+# Based on Numerical Recipes by Press, Flannery, Teukolsky, and Vetterling.
+# Used by permission of the authors.
+# Copyright(c) 1986 Numerical Recipes Software.
+#
+# Modified to return zero for input values less than or equal to zero.
+
+real procedure poidev (xm, seed)
+
+real	xm		# Poisson mean
+long	seed		# Random number seed
+
+real	oldm, g, em, t, y, ymin, ymax, sq, alxm, gammln(), urand(), gasdev()
+data	oldm /-1./
+
+begin
+	if (xm <= 0)
+	    em = 0
+	else if (xm < 12) {
+	    if (xm != oldm) {
+		oldm = xm
+		g = exp (-xm)
+	    }
+	    em = 0
+	    for (t = urand (seed); t > g; t = t * urand (seed))
+		em = em + 1
+	} else if (xm < 100) {
+	    if (xm != oldm) {
+		oldm = xm
+		sq = sqrt (2. * xm)
+		ymin = -xm / sq
+		ymax = (1000 - xm) / sq
+		alxm = log (xm)
+		g = xm * alxm - gammln (xm+1.)
+	    }
+	    repeat {
+		repeat {
+	            y = tan (PI * urand(seed))
+		} until (y >= ymin)
+	        em = int (sq * min (y, ymax) + xm)
+	        t = 0.9 * (1 + y**2) * exp (em * alxm - gammln (em+1) - g)
+	    } until (urand(seed) <= t)
+	} else
+	    em = xm + sqrt (xm) * gasdev (seed)
+	return (em)
+end
+
+
+# GASDEV -- Return a normally distributed deviate with zero mean and unit
+# variance.  The method computes two deviates simultaneously.
+#
+# Based on Numerical Recipes by Press, Flannery, Teukolsky, and Vetterling.
+# Used by permission of the authors.
+# Copyright(c) 1986 Numerical Recipes Software.
+
+real procedure gasdev (seed)
+
+long	seed		# Seed for random numbers
+
+real	urand()
+double	v1, v2, r, fac
+int	iset
+data	iset/0/
+
+begin
+	if (iset == 0) {
+	    repeat {
+	        v1 = 2 * urand (seed) - 1.
+	        v2 = 2 * urand (seed) - 1.
+	        r = v1 ** 2 + v2 ** 2
+	    } until ((r > 0) && (r < 1))
+	    fac = sqrt (-2. * log (r) / r)
+
+	    iset = 1
+	    return (v1 * fac)
+	} else {
+	    iset = 0
+	    return (v2 * fac)
+	}
+end
diff --git a/noao/artdata/starlist.par b/noao/artdata/starlist.par
new file mode 100644
index 00000000..8416df1f
--- /dev/null
+++ b/noao/artdata/starlist.par
@@ -0,0 +1,43 @@
+# STARLIST Parameter File
+
+starlist,f,a,,,,"Output star list file"
+nstars,i,a,5000,,,"Number of stars in the list"
+interactive,b,h,no,,,"Interactive mode?
+
+SPATIAL DISTRIBUTION"
+spatial,s,h,"uniform","uniform|hubble|file",,"Spatial density function (uniform|hubble|file)"
+xmin,r,h,1.0,,,"Minimum x coordinate value"
+xmax,r,h,512.0,,,"Maximum x coordinate value"
+ymin,r,h,1.0,,,"Minimum y coordinate value"
+ymax,r,h,512.0,,,"Maximum y coordinate value"
+xcenter,r,h,INDEF,,,"X coordinate of center of Hubble distribution"
+ycenter,r,h,INDEF,,,"Y coordinate of center of Hubble distribution"
+core_radius,r,h,30.0,,,"Core radius of Hubble distribution"
+base,r,h,0.0,,,"Relative background density of the Hubble distribution"
+sseed,i,h,1,,,"Seed for sampling the spatial density probability function
+
+MAGNITUDE DISTRIBUTION"
+luminosity,s,h,"powlaw","uniform|salpeter|bands|powlaw|file",,"Luminosity function (uniform|salpeter|bands|powlaw|file)"
+minmag,r,h,-7.0,,,"Minimum magnitude"
+maxmag,r,h,0.0,,,"Maximum magnitude"
+mzero,r,h,-4.,,,"Absolute magnitude zero point for salpeter and bands"
+power,r,h,0.6,,,"Power law magnitude distribution coefficient"
+alpha,r,h,0.74,,,"Alpha parameter for bands function"
+beta,r,h,0.04,,,"Beta parameter for bands function"
+delta,r,h,0.294,,,"Delta parameter for bands function"
+mstar,r,h,1.28,,,"Mstar parameter for bands function"
+lseed,i,h,1,,,"Seed for sampling the luminsosity probability function
+
+USER FUNCTIONS"
+sfile,f,a,"",,,"File containing spatial density function"
+nssample,i,h,100,,,"Number of spatial density function sampling points "
+sorder,i,h,10,,,"Number of spline pieces for spatial probability function"
+lfile,f,a,"",,,"File containing luminosity function"
+nlsample,i,h,100,,,"Number of luminosity function sampling points"
+lorder,i,h,10,,,"Number of spline pieces for luminosity probability function
+
+INTERACTIVE PARAMETERS"
+rbinsize,r,h,10.,,,"Bin size of radial density function histogram in pixels"
+mbinsize,r,h,0.5,,,"Bin size of luminosity function in magnitudes"
+graphics,s,h,stdgraph,,,"Standard graphics device"
+cursor,*gcur,h,"",,,"Graphics cursor"
diff --git a/noao/artdata/stdheader.dat b/noao/artdata/stdheader.dat
new file mode 100644
index 00000000..da6152c3
--- /dev/null
+++ b/noao/artdata/stdheader.dat
@@ -0,0 +1,10 @@
+DATE-OBS= '1990-01-01T00:00:00'
+RA      = '00:00:00'
+DEC     = '00:00:00'
+EPOCH   =                1990.
+UT      = '00:00:00'
+ST      = '00:00:00'
+ZT      =                   0.
+AIRMASS =                   1.
+EXPTIME =                   1.
+INSTRUME= 'IRAF/ARTDATA'
diff --git a/noao/artdata/t_mk1dspec.x b/noao/artdata/t_mk1dspec.x
new file mode 100644
index 00000000..5fe5b928
--- /dev/null
+++ b/noao/artdata/t_mk1dspec.x
@@ -0,0 +1,443 @@
+include	<error.h>
+include	<imhdr.h>
+
+define	LEN_UA		20000			# Maximum user header
+define	LEN_COMMENT	70			# Maximum comment length
+
+# Profile types.
+define  PTYPES  "|gaussian|lorentzian|voigt|"
+define  GAUSS           1       # Gaussian profile
+define  LORENTZ         2       # Lorentzian profile
+define  VOIGT           3       # Voigt profile
+
+
+# T_MK1DSPEC -- Make one dimensional spectra.  New images may be created
+# or existing images modified.  The continuum may be a slope and/or
+# a blackbody.  A line list may be given or random lines generated.
+# The lines may be emission or absorption and may have varying
+# widths and strengths.  Subsampling is used.
+
+procedure t_mk1dspec()
+
+int	ilist			# List of input spectra (input param)
+int	olist			# List of output spectra (output param)
+
+int	line			# Line number
+int	ap			# Aperture
+int	beam			# Beam
+int	nw			# Number of pixels (ncols param or imlen)
+double	w0			# Starting wavelength (wstart param)
+double	wpc			# Wavelength per pix (wstart/wend params)
+double	z			# Redshift
+
+double	cont			# Continuum at first pixel
+double	slope			# Continuum slope per pixel
+double	temp			# Blackbody temperture (Kelvin)
+int	fnu			# F-nu flux?
+
+int	llist			# List of files containing lines (lines param)
+pointer	profile			# Profile type
+double	peak			# Peak/continuum
+double	gfwhm			# Sigma of Gaussian (Angstroms)
+double	lfwhm			# FWHM of Lorentzian (Angstroms)
+int	nlines			# Number of lines
+double	subsample		# Subsampling (nxsub param)
+double	ngfwhm			# Dynamic range of gaussian (dynrange param)
+double	nlfwhm			# Dynamic range of lorentzian (dynrange param)
+long	seed			# Random number seed
+
+bool	new, ranlist
+int	i, j, dtype, ptype
+long	seed1
+double	w, x, x1, x2, x3, z1
+real	v, u, aplow[2], aphigh[2]
+pointer	sp, input, output, lines, comment, coeff
+pointer	in, out, mw, ptypes, waves, peaks, gfwhms, lfwhms, spec, buf
+
+long	clgetl(), clktime()
+int	clgeti(), clgwrd(), imtopenp(), imtgetim()
+int	nowhite(), access(), open(), fscan(), nscan(), strdic()
+real	urand()
+double	clgetd()
+pointer	immap(), mw_open(), smw_openim(), imgl2d(), impl2d()
+bool	clgetb(), streq()
+errchk	open()
+
+begin
+	call smark (sp)
+	call salloc (input, SZ_FNAME, TY_CHAR)
+	call salloc (output, SZ_FNAME, TY_CHAR)
+	call salloc (lines, SZ_FNAME, TY_CHAR)
+	call salloc (comment, LEN_COMMENT, TY_CHAR)
+	call salloc (profile, SZ_FNAME, TY_CHAR)
+	coeff = NULL
+
+	# Get file lists and fixed parameters.
+	ilist = imtopenp ("input")
+	olist = imtopenp ("output")
+	llist = imtopenp ("lines")
+	subsample = 1. / clgeti ("nxsub")
+	x1 = clgetd ("dynrange")
+	ngfwhm = 0.424661 * sqrt (2. * log (x1))
+	nlfwhm = sqrt (0.5 * (x1 - 1))
+	z = clgetd ("rv")
+	if (clgetb ("z"))
+	    z = 1 + z
+	else {
+	    z = z / 299792.5
+	    z = sqrt ((1 + z) / (1 - z)) 
+	}
+
+	# Loop through input images.  Missing output images take input
+	# image name.  Line list files may be missing.
+
+	Memc[lines] = EOS
+	while (imtgetim (ilist, Memc[input], SZ_FNAME) != EOF) {
+	    if (imtgetim (olist, Memc[output], SZ_FNAME) == EOF)
+	        call strcpy (Memc[input], Memc[output], SZ_FNAME)
+	    i = imtgetim (llist, Memc[lines], SZ_FNAME)
+
+	    # Map images.  Check for new, existing, and in-place images.
+	    if (streq (Memc[input], Memc[output])) {
+		ifnoerr (in = immap (Memc[input], READ_WRITE, 0)) {
+		    iferr (mw = smw_openim (in)) {
+			call imunmap (in)
+			call erract (EA_WARN)
+			next
+		    }
+		    out = in
+	            new = false
+	        } else {
+		    iferr (out = immap (Memc[output], NEW_IMAGE, LEN_UA)) {
+			call erract (EA_WARN)
+			next
+		    }
+		    in = out
+	            new = true
+
+		    call clgstr ("header", Memc[comment], LEN_COMMENT)
+		    iferr (call mkh_header (out, Memc[comment], true, false))
+			call erract (EA_WARN)
+
+		    IM_LEN(out,1) = clgeti ("ncols")
+		    IM_LEN(out,2) = clgeti ("naps")
+		    if (IM_LEN(out,2) == 1)
+			IM_NDIM(out) = 1
+		    else
+			IM_NDIM(out) = 2
+	            IM_PIXTYPE(out) = TY_REAL
+		    call clgstr ("title", IM_TITLE(out), SZ_IMTITLE)
+
+		    i = IM_NDIM(out)
+		    mw = mw_open (NULL, i)
+		    call mw_newsystem (mw, "equispec", i)
+		    call mw_swtype (mw, 1, 1, "linear", "")
+		    if (i > 1)
+			call mw_swtype (mw, 2, 1, "linear", "")
+		    call mw_swattrs (mw, 1, "label", "Wavelength")
+		    call mw_swattrs (mw, 1, "units", "Angstroms")
+		    call smw_open (mw, NULL, out)
+
+		    dtype = -1
+		    nw = IM_LEN(out,1)
+		    w0 = 1.
+	    	    wpc = 1.
+		    aplow[1] = INDEF
+		    aplow[2] = INDEF
+		    aphigh[1] = INDEF
+		    aphigh[2] = INDEF
+		    do i = 1, IM_LEN(out,2)
+			call smw_swattrs (mw, i, 1, i, i, dtype, w0, wpc, nw,
+			    0D0, aplow, aphigh, "")
+	        }
+	    } else {
+	        iferr (in = immap (Memc[input], READ_ONLY, 0)) {
+		    call erract (EA_WARN)
+		    next
+		}
+	        iferr (out = immap (Memc[output], NEW_COPY, in)) {
+		    call erract (EA_WARN)
+		    call imunmap (in)
+		    next
+		}
+		iferr (mw = smw_openim (in)) {
+		    call imunmap (in)
+		    call imunmap (out)
+		    call erract (EA_WARN)
+		    next
+		}
+	        new = false
+	    }
+
+	    line = max (1, min (clgeti ("ap"), IM_LEN(out,2)))
+	    call smw_gwattrs (mw, line, 1, ap, beam, dtype, w0, wpc, nw,
+		z1, aplow, aphigh, coeff)
+
+	    if (dtype < 0) {
+		dtype = 0
+		nw = min (clgeti ("ncols"), IM_LEN(out,1))
+		w0 = clgetd ("wstart")
+		wpc = (clgetd ("wend") - w0) / (nw - 1)
+		call smw_swattrs (mw, line, 1, ap, beam, dtype, w0, wpc, nw,
+		    0D0, aplow, aphigh, "")
+	    }
+
+	    # Get the line list if given or create random lines.
+	    ranlist = false
+	    i = nowhite (Memc[lines], Memc[lines], SZ_FNAME)
+	    if (access (Memc[lines], 0, 0) == YES) {
+	        i = open (Memc[lines], READ_ONLY, TEXT_FILE)
+	        nlines = 0
+		dtype = clgwrd ("profile", Memc[profile], SZ_FNAME, PTYPES)
+		x1 = clgetd ("peak")
+		x2 = clgetd ("gfwhm")
+		x3 = clgetd ("lfwhm")
+	        seed = clgetl ("seed")
+		if (IS_INDEFL(seed))
+		    seed1 = seed1 + clktime (long (0))
+		else
+		    seed1 = seed
+	        while (fscan (i) != EOF) {
+		    call gargd (w)
+		    call gargd (peak)
+		    call gargwrd (Memc[profile], SZ_FNAME)
+		    call gargd (gfwhm)
+		    call gargd (lfwhm)
+		    ptype = strdic (Memc[profile], Memc[profile], SZ_FNAME,
+			PTYPES)
+		    if (ptype == 0)
+			ptype = dtype
+		    switch (nscan()) {
+		    case 0:
+			next
+		    case 1:
+			peak = x1 * urand (seed1)
+			ptype = dtype
+			gfwhm = x2
+			lfwhm = x3
+		    case 2:
+			ptype = dtype
+			gfwhm = x2
+			lfwhm = x3
+		    case 3:
+			gfwhm = x2
+			lfwhm = x3
+		    case 4:
+			switch (ptype) {
+			case GAUSS:
+			    lfwhm = x3
+			case LORENTZ:
+			    lfwhm = gfwhm
+			    gfwhm = x2
+			case VOIGT:
+			    lfwhm = x3
+			}
+		    }
+
+		    if (nlines == 0) {
+		        j = 50
+		        call malloc (ptypes, j, TY_INT)
+		        call malloc (waves, j, TY_DOUBLE)
+		        call malloc (peaks, j, TY_DOUBLE)
+		        call malloc (gfwhms, j, TY_DOUBLE)
+		        call malloc (lfwhms, j, TY_DOUBLE)
+		    } else if (nlines == j) {
+		        j = j + 10
+		        call realloc (ptypes, j, TY_INT)
+		        call realloc (waves, j, TY_DOUBLE)
+		        call realloc (peaks, j, TY_DOUBLE)
+		        call realloc (gfwhms, j, TY_DOUBLE)
+		        call realloc (lfwhms, j, TY_DOUBLE)
+		    }
+		    Memi[ptypes+nlines] = ptype
+		    Memd[waves+nlines] = z * w
+		    Memd[peaks+nlines] = peak / z
+		    Memd[gfwhms+nlines] = z * gfwhm
+		    Memd[lfwhms+nlines] = z * lfwhm
+		    nlines = nlines + 1
+	        }
+	        call close (i)
+	    } else {
+	        nlines = clgeti ("nlines")
+		ptype = clgwrd ("profile", Memc[profile], SZ_FNAME, PTYPES)
+	        peak = clgetd ("peak")
+	        gfwhm = clgetd ("gfwhm")
+	        lfwhm = clgetd ("lfwhm")
+	        seed = clgetl ("seed")
+		if (IS_INDEFL(seed))
+		    seed1 = seed1 + clktime (long (0))
+		else
+		    seed1 = seed
+	        call malloc (ptypes, nlines, TY_INT)
+	        call malloc (waves, nlines, TY_DOUBLE)
+	        call malloc (peaks, nlines, TY_DOUBLE)
+	        call malloc (gfwhms, nlines, TY_DOUBLE)
+	        call malloc (lfwhms, nlines, TY_DOUBLE)
+	        do i = 0, nlines-1 {
+		    w = z * (w0 + wpc * (nw - 1) * urand (seed1))
+		    x = (w - w0) / wpc / (nw - 1)
+		    if (x < 0)
+			x = x - int (x - 1)
+		    else
+		        x = x - int (x)
+		    w = w0 + wpc * (nw - 1) * x
+		    Memi[ptypes+i] = ptype
+		    Memd[waves+i] = w
+		    Memd[peaks+i] = peak / z * urand (seed1)
+		    Memd[gfwhms+i] = z * gfwhm
+		    Memd[lfwhms+i] = z * lfwhm
+	        }
+	        if (nlines > 0 && Memc[lines] != EOS) {
+	            i = open (Memc[lines], NEW_FILE, TEXT_FILE)
+		    do j = 0, nlines-1 {
+			switch (Memi[ptypes+j]) {
+			case GAUSS:
+			    call fprintf (i, "%g %g %10s %g\n")
+			    call pargd (Memd[waves+j] / z)
+			    call pargd (Memd[peaks+j] * z)
+			    call pargstr ("gaussian")
+			    call pargd (Memd[gfwhms+j] / z)
+			case LORENTZ:
+			    call fprintf (i, "%g %g %10s %g\n")
+			    call pargd (Memd[waves+j] / z)
+			    call pargd (Memd[peaks+j] * z)
+			    call pargstr ("lorentzian")
+			    call pargd (Memd[lfwhms+j] / z)
+			case VOIGT:
+			    call fprintf (i, "%g %g %10s %g %g\n")
+			    call pargd (Memd[waves+j] / z)
+			    call pargd (Memd[peaks+j] * z)
+			    call pargstr ("voigt")
+			    call pargd (Memd[gfwhms+j] / z)
+			    call pargd (Memd[lfwhms+j] / z)
+			}
+		    }
+	            call close (i)
+	        }
+	    }
+
+	    # Make the spectrum.
+	    spec = impl2d (out, line)
+	    if (new)
+	        call aclrd (Memd[spec], IM_LEN(in,1))
+	    else
+		call amovd (Memd[imgl2d(in, line)], Memd[spec], IM_LEN(in,1))
+
+	    # Make the lines.
+	    call calloc (buf, nw, TY_DOUBLE)
+	    do i = 0, nlines-1 {
+		ptype = Memi[ptypes+i]
+	        w = (Memd[waves+i] - w0) / wpc + 1.
+	        peak = Memd[peaks+i] * subsample
+	        gfwhm = Memd[gfwhms+i] / abs(wpc)
+	        lfwhm = Memd[lfwhms+i] / abs(wpc)
+		x3 = max (ngfwhm*gfwhm, min (20D0, nlfwhm)*lfwhm)
+	        x1 = max (1.0D0, w - x3)
+	        x2 = min (double (nw), w + x3)
+		switch (ptype) {
+		case GAUSS:
+		    x3 = -0.360674 * gfwhm**2
+		    for (x = x1; x <= x2; x = x + subsample) {
+			j = buf + int (x - 0.5)
+			Memd[j] = Memd[j] + peak * exp ((x-w)**2 / x3)
+		    }
+		case LORENTZ:
+		    x3 = 0.25 * lfwhm**2
+		    for (x = x1; x <= x2; x = x + subsample) {
+			j = buf + int (x - 0.5)
+			Memd[j] = Memd[j] + peak / (1 + (x-w)**2 / x3)
+		    }
+		case VOIGT:
+		    x3 = 1.66511 / gfwhm
+		    cont = (lfwhm / 2 )  * x3
+		    call voigt (0., real(cont), v, u)
+		    peak = peak / v
+		    for (x = x1; x <= x2; x = x + subsample) {
+			j = buf + int (x - 0.5)
+			call voigt (real((x-w)*x3), real(cont), v, u)
+			Memd[j] = Memd[j] + peak * v
+		    }
+		}
+	    }
+
+	    # Make the continuum.
+	    cont = clgetd ("continuum")
+	    slope = clgetd ("slope")
+	    temp = clgetd ("temperature")
+	    if (clgetb ("fnu"))
+		fnu = 3
+	    else
+		fnu = 5
+	    if (temp > 0.) {
+	        w  = w0 * 1.0e-8
+	        x1 = exp (1.4388 / (w * temp))
+	        x2 = w**fnu * (x1-1.0)
+
+		w = w / z
+	        wpc = wpc * 1.0e-8 / z
+	    }
+	    do i = 0, nw-1 {
+	        x = cont + slope / wpc * ((w0 + wpc * i) / z - w0)
+	        if (temp > 0.) {
+		    x1 = exp (1.4388 / (w * temp))
+		    x = x * (x2 / w**fnu / (x1-1.0))
+		    w = w + wpc
+	        }
+		if (x > 0.)
+	            Memd[spec+i] = Memd[spec+i] +
+			max (0.0D0, x * (1. + Memd[buf+i]))
+		else
+		    Memd[spec+i] = Memd[spec+i] + Memd[buf+i]
+	    }
+
+	    call mfree (ptypes, TY_INT)
+	    call mfree (waves, TY_DOUBLE)
+	    call mfree (peaks, TY_DOUBLE)
+	    call mfree (gfwhms, TY_DOUBLE)
+	    call mfree (lfwhms, TY_DOUBLE)
+	    call mfree (buf, TY_DOUBLE)
+
+	    # Add comment history of task parameters.
+	    if (clgetb ("comments")) {
+		call strcpy ("# ", Memc[comment], LEN_COMMENT)
+		call cnvtime (clktime (0), Memc[comment+2], LEN_COMMENT-2)
+		call mkh_comment (out, Memc[comment])
+		call mkh_comment (out, "begin    mk1dspec")
+		call mkh_comment1 (out, "ap", 'i')
+		call mkh_comment1 (out, "rv", 'd')
+		call mkh_comment1 (out, "z", 'b')
+		call mkh_comment1 (out, "wstart", 'd')
+		call mkh_comment1 (out, "wend", 'd')
+		call mkh_comment1 (out, "continuum", 'd')
+		call mkh_comment1 (out, "slope", 'd')
+		call mkh_comment1 (out, "temperature", 'd')
+		call mkh_comment1 (out, "fnu", 'b')
+		if (nlines > 0) {
+		    if (Memc[lines] != EOS)
+			call mkh_comment1 (out, "lines", 's')
+		    call sprintf (Memc[comment], LEN_COMMENT, "%9tnlines%24t%d")
+			call pargi (nlines)
+		    call mkh_comment (out, Memc[comment])
+		    if (ranlist) {
+			call mkh_comment1 (out, "profile", 's')
+			call mkh_comment1 (out, "peak", 'd')
+			call mkh_comment1 (out, "gfwhm", 'd')
+			call mkh_comment1 (out, "lfwhm", 'd')
+			call mkh_comment1 (out, "seed", 'i')
+		    }
+		}
+	    }
+
+	    call smw_saveim (mw, out)
+	    call smw_close (mw)
+	    if (in != out)
+	        call imunmap (in)
+	    call imunmap (out)
+	}
+
+	call mfree (coeff, TY_CHAR)
+	call imtclose (ilist)
+	call imtclose (olist)
+	call imtclose (llist)
+	call sfree (sp)
+end
diff --git a/noao/artdata/t_mk2dspec.x b/noao/artdata/t_mk2dspec.x
new file mode 100644
index 00000000..8f13d8e2
--- /dev/null
+++ b/noao/artdata/t_mk2dspec.x
@@ -0,0 +1,297 @@
+include	<error.h>
+include	<imhdr.h>
+include	<math/iminterp.h>
+
+define	LEN_UA		20000		# Maximum user header
+define	LEN_COMMENT	70		# Maximum comment length
+
+define	NALLOC		10		# Alloc block size
+define	NPROF		201		# Length of profile
+
+# Each spectrum is described by a 1D spectrum and shape and position info.
+define	LEN_MOD		7		# Length of model spectrum structure
+define	SPEC	Memi[$1]		# Pointer to spectrum
+define	NPTS	Memi[$1+1]		# Number of points in spectrum
+define	PTYPE	Memi[$1+2]		# Profile type
+define	WIDTH	Memr[P2R($1+3)]		# Profile width (FWHM at center line)
+define	DWIDTH	Memr[P2R($1+4)]		# Derivative of width
+define	POS	Memr[P2R($1+5)]		# Profile position (at center line)
+define	DPOS	Memr[P2R($1+6)]		# Derivative of position
+
+define	PTYPES	"|gaussian|slit|"
+define	GAUSS	1			# Gaussian (pexp = 2)
+define	SLIT	2			# Slit (pexp = 10)
+
+
+# T_MK2DSPEC -- Make a 2D spectrum from 1D template and a profile function.
+# The dispersion axis is along the columns and the spectrum is taken from
+# 1D spectrum.  The cross dispersion profile is either a Gaussian or a
+# slit with a specified FWHM.  The center of the profile along the dispersion
+# axis is a sloped line.  The width of the profile may also be variable.
+
+procedure t_mk2dspec ()
+
+pointer	input				# Input image
+pointer	output				# Output image
+pointer	models				# Spectrum models (file)
+int	nc				# Number of columns
+int	nl				# Number of lines
+bool	cmmts				# Add comments?
+
+pointer	template			# Template spectrum name
+real	scale				# Intensity scale
+int	ptype				# Profile type
+real	width				# Profile width (FWHM at center line)
+real	dwidth				# Derivative of profile width
+real	pos				# Profile position (center of image)
+real	dpos				# Deriviative of position
+
+bool	new
+int	ilist, olist, mlist
+int	i, j, k, k1, k2, fd, npts, nmods, nalloc
+real	pcen[2], fwhm[2], flux[2], peak, pstep, pstart, pend, x1, x2, dx
+pointer	sp, comment, mod, mods, asi, asis[2], data, in, out, temp, pname
+
+bool	streq(), clgetb()
+real	asigrl()
+int	clgeti(), access(),  open(), fscan(), nscan(), strdic()
+int	imtopenp(), imtlen(), imtgetim(), clktime()
+pointer	immap(), imgl1r(), imgl2r(), impl2r()
+errchk	open, immap
+
+begin
+	call smark (sp)
+	call salloc (comment, LEN_COMMENT, TY_CHAR)
+	call salloc (input, SZ_FNAME, TY_CHAR)
+	call salloc (output, SZ_FNAME, TY_CHAR)
+	call salloc (models, SZ_FNAME, TY_CHAR)
+	call salloc (template, SZ_FNAME, TY_CHAR)
+	call salloc (pname, SZ_FNAME, TY_CHAR)
+
+	# Make the profile templates stored as an interpolation function
+	# with the returned center, fwhm, and flux.
+
+	call mkprof (2., asis[1], pcen[1], fwhm[1], flux[1])
+	call mkprof (10., asis[2], pcen[2], fwhm[2], flux[2])
+
+	# Get the file lists and loop through them.
+	ilist = imtopenp ("input")
+	olist = imtopenp ("output")
+	mlist = imtopenp ("models")
+	cmmts = clgetb ("comments")
+
+	if (max (1, imtlen (olist)) != imtlen (ilist))
+	    call error (1, "Output image list does not match input image list")
+
+	Memc[models] = EOS
+	while (imtgetim (ilist, Memc[input], SZ_FNAME) != EOF) {
+	    if (imtgetim (olist, Memc[output], SZ_FNAME) == EOF)
+	        call strcpy (Memc[input], Memc[output], SZ_FNAME)
+	    i = imtgetim (mlist, Memc[models], SZ_FNAME)
+	    if (access (Memc[models], 0, 0) == NO) {
+		call eprintf ("WARNING: Can't access model file (%s)\n")
+		    call pargstr (Memc[models])
+		next
+	    }
+
+	    # Map images.  Check for new, existing, and in-place images.
+	    if (streq (Memc[input], Memc[output])) {
+		ifnoerr (in = immap (Memc[input], READ_WRITE, 0)) {
+		    out = in
+	            new = false
+	        } else {
+		    iferr (out = immap (Memc[output], NEW_IMAGE, LEN_UA)) {
+			call erract (EA_WARN)
+			next
+		    }
+		    in = out
+	            new = true
+
+		    call clgstr ("header", Memc[comment], LEN_COMMENT)
+		    iferr (call mkh_header (out, Memc[comment], true, false))
+			call erract (EA_WARN)
+
+	            IM_NDIM(out) = 2
+	            IM_LEN(out,1) = clgeti ("ncols")
+	            IM_LEN(out,2) = clgeti ("nlines")
+	            IM_PIXTYPE(out) = TY_REAL
+		    call clgstr ("title", IM_TITLE(out), SZ_IMTITLE)
+		    call imaddi (out, "dispaxis", 2)
+	        }
+	    } else {
+	        iferr (in = immap (Memc[input], READ_ONLY, 0)) {
+		    call erract (EA_WARN)
+		    next
+		}
+	        iferr (out = immap (Memc[output], NEW_COPY, in)) {
+		    call erract (EA_WARN)
+		    call imunmap (in)
+		    next
+		}
+	        new = false
+	    }
+	    nc = IM_LEN(out,1)
+	    nl = IM_LEN(out,2)
+
+	    # Read the models file.
+	    fd = open (Memc[models], READ_ONLY, TEXT_FILE)
+	    nmods = 0
+	    while (fscan (fd) != EOF) {
+	        call gargwrd (Memc[template], SZ_FNAME)
+	        call gargr (scale)
+	        call gargwrd (Memc[pname], SZ_FNAME)
+	        call gargr (width)
+	        call gargr (dwidth)
+	        call gargr (pos)
+	        call gargr (dpos)
+	        if (nscan() != 7)
+		    next
+
+	        temp = immap (Memc[template], READ_ONLY, 0)
+	        npts = IM_LEN(temp,1)
+	        call malloc (data, npts, TY_REAL)
+	        call amulkr (Memr[imgl1r(temp)], scale, Memr[data], npts)
+	        call imunmap (temp)
+
+		call malloc (mod, LEN_MOD, TY_STRUCT)
+	        SPEC(mod) = data
+	        NPTS(mod) = npts
+	        PTYPE(mod) = strdic (Memc[pname], Memc[pname], SZ_FNAME, PTYPES)
+	        WIDTH(mod) = width - nl / 2. * dwidth
+	        DWIDTH(mod) = dwidth
+	        POS(mod) = pos - 1 - nl / 2. * dpos
+	        DPOS(mod) = dpos
+
+	        if (nmods == 0) {
+		    nalloc = NALLOC
+		    call malloc (mods, nalloc, TY_POINTER)
+	        } else if (nmods == nalloc) {
+		    nalloc = nalloc + NALLOC
+		    call realloc (mods, nalloc, TY_POINTER)
+	        }
+	        Memi[mods+nmods] = mod
+	        nmods = nmods + 1
+	    }
+	    call close (fd)
+	    if (nmods == 0) {
+	        call imunmap (out)
+	        call sfree (sp)
+	        call error (1, "No model spectra defined")
+	    }
+
+	    # Now expand the 1D spectra into 2D profiles.
+
+	    do i = 1, nl {
+	        data = impl2r (out, i)
+	        if (new)
+	            call aclrr (Memr[data], nc)
+	        else
+		    call amovr (Memr[imgl2r(in,i)], Memr[data], nc)
+	        do j = 1, nmods {
+	            mod = Memi[mods+j-1]
+	            if (NPTS(mod) < i)
+		        next
+		    ptype = PTYPE(mod)
+		    asi = asis[ptype]
+	            peak = Memr[SPEC(mod)+i-1] / flux[ptype]
+		    width = WIDTH(mod) + i * DWIDTH(mod)
+	            pos = POS(mod) + i * DPOS(mod)
+		    pstep = width / fwhm[ptype]
+		    pstart = max (-0.5, pos - pcen[ptype] * pstep)
+		    pend = min (nc - 0.51, pos + pcen[ptype] * pstep)
+		    if (pstart >= pend)
+			next
+
+		    k1 = pstart + 0.5
+		    k2 = pend + 0.5
+		    x1 = (pstart - pos) / pstep + pcen[ptype] + 1
+		    x2 = (k1 + 0.5 - pos) / pstep + pcen[ptype] + 1
+		    x1 = max (1., x1)
+		    x2 = max (1., x2)
+		    Memr[data+k1] = Memr[data+k1] + peak * asigrl (asi, x1, x2)
+
+		    dx = 1 / pstep
+		    do k = k1+1, k2-1 {
+		       x1 = x2
+		       x2 = x1 + dx
+		       Memr[data+k] = Memr[data+k] + peak * asigrl (asi, x1, x2)
+		    }
+		    x1 = x2
+		    x2 = (pend - pos) / pstep + pcen[ptype] + 1
+		    Memr[data+k2] = Memr[data+k2] + peak * asigrl (asi, x1, x2)
+	        }
+	    }
+
+	    # Add comment history of task parameters.
+	    if (cmmts) {
+		call strcpy ("# ", Memc[comment], LEN_COMMENT)
+		call cnvtime (clktime (0), Memc[comment+2], LEN_COMMENT-2)
+		call mkh_comment (out, Memc[comment])
+		call mkh_comment (out, "begin        mk2dspec")
+		call mkh_comment1 (out, "models", 's')
+
+		fd = open (Memc[models], READ_ONLY, TEXT_FILE)
+		while (fscan (fd) != EOF) {
+		    call gargstr (Memc[comment], LEN_COMMENT)
+		    call mkh_comment (out, Memc[comment])
+		}
+		call close (fd)
+	    }
+
+	    if (in != out)
+	        call imunmap (in)
+	    call imunmap (out)
+	    do i = 0, nmods-1
+		call mfree (SPEC(Memi[mods+i]), TY_REAL)
+	    call mfree (mods, TY_POINTER)
+	}
+
+	call asifree (asis[1])
+	call asifree (asis[2])
+	call imtclose (ilist)
+	call imtclose (olist)
+	call imtclose (mlist)
+	call sfree (sp)
+end
+
+
+# MKPROF -- Make a well sampled profile and fit it by an interpolation
+# function.  Return the interpolation function, the center, the FWHM,
+# and total flux.
+
+procedure mkprof (pexp, asi, center, fwhm, flux)
+
+real	pexp		# Profile exponent
+pointer	asi		# IMINTERP pointer
+real	center		# Profile center
+real	fwhm		# FWHM of profile
+real	flux		# Flux of profile
+
+int	i
+real	scale, x, asigrl()
+pointer	sp, prof
+
+begin
+	call smark (sp)
+	call salloc (prof, NPROF, TY_REAL)
+
+	# Put the profile center at the center of the array.  Set the
+	# scale so the array extends to the 0.5% level.  Compute the
+	# FWHM.  Generate the profile values and fit the interpolation
+	# function.  Finally, compute the total flux by integrating
+	# the interpolation function.
+
+	center = (NPROF - 1) / 2.
+	scale = center / (log (200.) ** (1/pexp))
+	fwhm = 2 * scale * log(2.) ** (1/pexp)
+	do i = 0, NPROF-1 {
+	    x = abs (i - center) / scale
+	    Memr[prof+i] = exp (-(x**pexp))
+	}
+	call asiinit (asi, II_LINEAR)
+	call asifit (asi, Memr[prof], NPROF)
+
+	flux = asigrl (asi, 1., real (NPROF))
+
+	call sfree (sp)
+end
diff --git a/noao/artdata/t_mkechelle.x b/noao/artdata/t_mkechelle.x
new file mode 100644
index 00000000..ca9e5e37
--- /dev/null
+++ b/noao/artdata/t_mkechelle.x
@@ -0,0 +1,1248 @@
+include	<error.h>
+include	<imhdr.h>
+include	<math.h>
+
+define	LEN_UA		20000		# Maximum user header
+define	LEN_COMMENT	70		# Maximum comment length
+
+define	PTYPES	"|extracted|gaussian|slit|"
+define	EXTRACTED	1		# Extracted format
+define	GAUSS		2		# Gaussian (pexp = 2)
+define	SLIT		3		# Slit (pexp = 10)
+
+
+# T_MKECHELLE -- Make echelle spectra.
+# Extracted or full two dimensional formats may be created.
+# The spectrum may consist of a constant continuum, a blackbody continuum,
+# and emission and absorption lines of varying widths and strengths.
+# The spectral features may come from a line list or be randomly generated.
+# A redshift may be applied to the spectrum.  The order profiles may
+# be either a gaussian or a slit with a specified FWHM.  Both the
+# spectral features and the profile are subsampled.  The echelle format
+# includes a blaze function corrected for light losses to other other
+# other orders and reflected components.  If a focal length is specified
+# the wavelength nonlinearity is included.
+
+procedure t_mkechelle()
+
+int	images			# List of echelle spectra to be created
+int	nc			# Number of columns (across dispersion)
+int	nl			# Number of lines (along dispersion)
+int	norders			# Number of orders
+int	profile			# Profile type
+real	width			# Profile width (pixels)
+real	scattered		# Scattered light peak intensity
+real	xc, yc			# Central pixel postion
+real	pixsize			# Pixel size (mm)
+
+int	mc[2]			# Central order
+real	f[2]			# Focal length (mm)
+real	gmm[2]			# Grating grooves per mm
+real	blaze[2]		# Blaze angle (degrees)
+real	t[2]			# Angle from blaze angle
+real	wc[2]			# Central wavelength
+real	disp[2]			# Central dispersion
+
+real	z			# Redshift
+real	cont			# Continuum at central wavelength
+real	temp			# Blackbody temperture (Kelvin)
+int	lines			# List of files containing lines
+int	nrandom			# Number of spectral lines
+real	peak			# Peak/continuum
+real	sigma			# Sigma of lines (Angstroms)
+long	seed			# Random number seed
+real	subsample		# Subsampling (nxsub param)
+real	nsigma			# Dynamic range of gaussian (dynrange param)
+
+int	ncnew, nlnew, nonew
+bool	new, flag[2]
+int	i, j, k, k1, k2, m, m1, m2, dc
+long	seed1
+real	mwc, mw1, mw2, dmw, x, x1, x2, dx, w, p, s, xc1, dx1
+real	p1, p2, pcen, fwhm, flux, flux1
+real	a[2], b[2], c[2], tb[2], cb[2], tt[2], ctb[2], t2tb[2], xmin[2], xmax[2]
+real	aplow[2], aphigh[2]
+double	w1, dw
+pointer	sp, image, fname, apnum, comment
+pointer	im, mw, waves, peaks, sigmas, buf, spec, bf1, bf2, asi, data
+
+long	clgetl(), clktime()
+int	clgeti(), clgwrd(), imtopenp(), imtgetim()
+int	nowhite(), access(), open(), fscan(), nscan()
+real	clgetr(), urand(), asigrl()
+real	ecx2w(), ecxdx(), ecw2x(), ecw2xr, ecdelta()
+pointer	immap(), mw_open(), impl2r(), imgl2r()
+bool	clgetb()
+errchk	open(), ecgrating()
+
+begin
+	call smark (sp)
+	call salloc (image, SZ_FNAME, TY_CHAR)
+	call salloc (fname, SZ_FNAME, TY_CHAR)
+	call salloc (apnum, SZ_FNAME, TY_CHAR)
+	call salloc (comment, LEN_COMMENT, TY_CHAR)
+
+	# Get parameters.
+	if (clgetb ("make"))
+	    images = imtopenp ("images")
+	ncnew = clgeti ("ncols")
+	nlnew = clgeti ("nlines")
+	nonew = clgeti ("norders")
+	profile = clgwrd ("profile", Memc[comment], LEN_COMMENT, PTYPES)
+	width = clgetr ("width")
+	scattered = clgetr ("scattered")
+	xc = clgetr ("xc")
+	yc = clgetr ("yc")
+	pixsize = clgetr ("pixsize")
+
+	f[1] = clgetr ("f")
+	mc[1] = clgeti ("order")
+	gmm[1] = clgetr ("gmm")
+	blaze[1] = clgetr ("blaze")
+	t[1] = clgetr ("theta")
+	wc[1] = clgetr ("wavelength")
+	disp[1] = clgetr ("dispersion")
+
+	f[2] = clgetr ("cf")
+	mc[2] = clgeti ("corder")
+	gmm[2] = clgetr ("cgmm")
+	blaze[2] = clgetr ("cblaze")
+	t[2] = clgetr ("ctheta")
+	wc[2] = clgetr ("cwavelength")
+	disp[2] = clgetr ("cdispersion")
+
+	z = clgetr ("rv")
+	if (clgetb ("z"))
+	    z = 1 + z
+	else {
+	    z = z / 299792.5
+	    z = sqrt ((1 + z) / (1 - z)) 
+	}
+	cont = clgetr ("continuum")
+	temp = clgetr ("temperature")
+	lines = imtopenp ("lines")
+	peak = clgetr ("peak")
+	sigma = clgetr ("sigma")
+	seed = clgetl ("seed")
+	if (IS_INDEFL(seed))
+	    seed1 = seed1 + clktime (long(0))
+	else
+	    seed1 = seed
+	subsample = 1. / clgeti ("nxsub")
+	nsigma = sqrt (2. * log (clgetr ("dynrange")))
+
+	# Substitute defaults for INDEF center parameters
+	if (IS_INDEF(xc))
+	    xc = (ncnew - 1) / 2.
+	if (IS_INDEF(yc))
+	    yc = (nlnew - 1) / 2.
+
+	# Derive and check grating parameters.
+	do i = 1, 2 {
+	    if (mc[i] == 0) {
+		if (IS_INDEF(wc[i]) || IS_INDEF(disp[i]))
+		    call error (1, "Prism wavelength parameters missing")
+		next
+	    }
+	    if (!IS_INDEF(pixsize)) {
+		if (!IS_INDEF(f[i]))
+		    f[i] = f[i] / pixsize
+		if (!IS_INDEF(disp[i]))
+		    disp[i] = disp[i] * pixsize
+	    }
+	    if (i == 1)
+	       flag[i] = true
+	    else
+	       flag[i] = false
+	    iferr (call ecgrating (flag[i], f[i], gmm[i], blaze[i], t[i], mc[i],
+		wc[i], disp[i])) {
+		if (i == 1)
+		    call eprintf ("Echelle grating: ")
+		else
+		    call eprintf ("Crossdisperser grating: ")
+		if (!IS_INDEF(mc[i])&&!IS_INDEF(wc[i])&&!IS_INDEF(disp[i])) {
+		    call eprintf ("Using linear dispersion\n")
+		    call erract (EA_WARN)
+		    flag[i] = true
+		} else {
+		    call eprintf ("\n")
+		    call erract (EA_ERROR)
+		}
+	    } else
+		flag[i] = false
+	}
+
+	# List grating parameters if desired.
+	if (clgetb ("list"))
+	    call eclist (pixsize, f, gmm, blaze, t, mc, wc, disp)
+	
+	# If not making an image return.
+	if (!clgetb ("make")) {
+	    call sfree (sp)
+	    return
+	}
+
+	# Loop through images.  Line list files may be missing.
+	Memc[fname] = EOS
+	while (imtgetim (images, Memc[image], SZ_FNAME) != EOF) {
+	    i = imtgetim (lines, Memc[fname], SZ_FNAME)
+
+	    # Map image and check for existing images.
+	    ifnoerr (im = immap (Memc[image], READ_WRITE, LEN_UA)) {
+		call eprintf ("%s: ")
+		    call pargstr (Memc[image])
+		call flush (STDERR)
+		if (!clgetb ("clobber")) {
+		    call eprintf ("Warning: Image already exists (%s)\n")
+			call pargstr (Memc[image])
+		    call imunmap (im)
+		    next
+		}
+		new = false
+
+		if (profile == EXTRACTED) {
+		    nl = IM_LEN(im,1)
+		    norders = IM_LEN(im,2)
+		} else {
+		    nc = IM_LEN(im,1)
+		    nl = IM_LEN(im,2)
+		}
+	    } else {
+		iferr (im = immap (Memc[image], NEW_IMAGE, LEN_UA)) {
+		    call erract (EA_WARN)
+		    next
+		}
+		new = true
+
+		nc = ncnew
+		nl = nlnew
+		norders = nonew
+
+		IM_PIXTYPE(im) = TY_REAL
+		IM_NDIM(im) = 2
+		if (profile == EXTRACTED) {
+		    IM_LEN(im,1) = nl
+		    IM_LEN(im,2) = norders
+		} else {
+		    IM_LEN(im,1) = nc
+		    IM_LEN(im,2) = nl
+		}
+	    }
+
+	    # Set frequently used constants.
+	    do i = 1, 2 {
+		if (flag[i]) {
+		    f[i] = INDEF
+		    a[i] = mc[i] * wc[i]
+		    b[i] = mc[i] * disp[i]
+		    c[i] = PI * mc[i] * disp[i]
+		} else {
+		    b[i] = 1e7 / gmm[i]
+		    a[i] = b[i] * sin (DEGTORAD(t[i]))
+		    c[i] = b[i] * PI * cos (DEGTORAD(t[i]))
+		    ctb[i] = cos (DEGTORAD(blaze[i]))
+		    t2tb[i] = tan (DEGTORAD(2 * blaze[i]))
+		    tt[i] = tan (DEGTORAD(t[i] - blaze[i]))
+		    tb[i] = tan (DEGTORAD(2 * blaze[i] - t[i]))
+		    cb[i] = cos (DEGTORAD(2 * blaze[i] - t[i]))
+		    xmin[i] = -1. / max (tt[i], f[i] / yc)
+		    xmax[i] = -1. / min (tt[i], -f[i] / yc)
+		}
+	    }
+
+	    # Set orders.
+	    m1 = max (1, mc[1] - (norders-1) / 2)
+	    m2 = m1 + norders - 1
+	    mwc = mc[1] * wc[1]
+	    mw1 = ecx2w (-yc, 1, a, b, f, cb, tb, t2tb, xmin, xmax)
+	    mw2 = ecx2w (yc, 1, a, b, f, cb, tb, t2tb, xmin, xmax)
+	    dmw = mw2 - mw1
+	    if (mc[2] == 0) {
+		disp[2] = disp[2] / wc[2]
+		dx1 = 1.
+	    } else {
+		xc1 = xc - ecw2x (mc[2]*wc[1], 2, a, b, f, tb, ctb, t2tb)
+		dx1 = ecxdx (xc - xc1, 2, f, tb)
+	    }
+
+	    # For 2D images adjust orders to exclude those outside image.
+	    if (profile != EXTRACTED) {
+		for (; m1<mc[1]; m1=m1+1) {
+		    w = mw1 / m1
+		    if (mc[2] == 0)
+			x = (w - wc[1]) / (w * disp[2]) + xc
+		    else
+			x = ecw2x (mc[2]*w, 2, a, b, f, tb, ctb, t2tb) + xc1
+		    if (x < nc)
+			break
+		}
+		for (; m2>mc[1]; m2=m2-1) {
+		    w = mw2 / m2
+		    if (mc[2] == 0)
+			x = (w - wc[1]) / (w * disp[2]) + xc
+		    else
+			x = ecw2x (mc[2]*w, 2, a, b, f, tb, ctb, t2tb) + xc1
+		    if (x > 0)
+			break
+		}
+		norders = m2 - m1 + 1
+	    }
+
+	    # Setup header parameters for new images.
+	    if (new) {
+		call clgstr ("header", Memc[comment], LEN_COMMENT)
+		iferr (call mkh_header (im, Memc[comment], true, false))
+		    call erract (EA_WARN)
+
+		call clgstr ("title", IM_TITLE(im), SZ_IMTITLE)
+		if (profile == EXTRACTED) {
+		    mw = mw_open (NULL, 2)
+		    call mw_newsystem (mw, "multispec", 2)
+		    call mw_swtype (mw, 1, 1, "multispec", "")
+		    call mw_swtype (mw, 2, 1, "multispec", "")
+		    if (IS_INDEF(f[1])) {
+			call mw_swattrs (mw, 1, "label", "Wavelength")
+			call mw_swattrs (mw, 1, "units", "Angstroms")
+		    }
+		    call smw_open(mw, NULL, im)
+
+		    do m = m1, m2 {
+			i = m - m1 + 1
+			if (IS_INDEF(f[1])) {
+			    w1 = mw1 / m
+			    dw = b[1] / m
+			    dc = 0
+			} else {
+			    w1 = 1.
+			    dw = 1.
+			    dc = -1
+			}
+			w = mwc / m
+			if (mc[2] == 0)
+			    x = (w - wc[1]) / (w * disp[2]) + xc
+			else
+			    x = ecw2x (mc[2]*w, 2, a, b, f, tb, ctb, t2tb) + xc1
+			aplow[1] = 1 + x - width
+			aphigh[1] = 1 + x + width
+			aplow[2] = INDEFR
+			aphigh[2] = INDEFR
+			call smw_swattrs (mw, i, 1, i, m, dc, w1, dw, nl,
+			    0D0, aplow, aphigh, "")
+		    }
+		    call smw_saveim (mw, im)
+		    call smw_close (mw)
+		} else
+		    call imaddi (im, "DISPAXIS", 2)
+	    }
+
+	    # Get the line list if given or create random lines.
+	    i = nowhite (Memc[fname], Memc[fname], SZ_FNAME)
+	    if (access (Memc[fname], 0, 0) == YES) {
+		i = open (Memc[fname], READ_ONLY, TEXT_FILE)
+		nrandom = 0
+		while (fscan (i) != EOF) {
+		    call gargr (w)
+		    call gargr (p)
+		    call gargr (s)
+		    if (nscan() < 1)
+			next
+		    if (nscan() < 3)
+			s = sigma
+		    if (nscan() < 2)
+			p = peak * urand (seed1)
+		    if (nrandom == 0) {
+			j = 50
+			call malloc (waves, j, TY_REAL)
+			call malloc (peaks, j, TY_REAL)
+			call malloc (sigmas, j, TY_REAL)
+		    } else if (nrandom == j) {
+			j = j + 10
+			call realloc (waves, j, TY_REAL)
+			call realloc (peaks, j, TY_REAL)
+			call realloc (sigmas, j, TY_REAL)
+		    }
+		    Memr[waves+nrandom] = w * z
+		    Memr[peaks+nrandom] = p / z
+		    Memr[sigmas+nrandom] = s * z
+		    nrandom = nrandom + 1
+		}
+		call close (i)
+	    } else {
+		nrandom = clgeti ("nrandom")
+		call malloc (waves, nrandom, TY_REAL)
+		call malloc (peaks, nrandom, TY_REAL)
+		call malloc (sigmas, nrandom, TY_REAL)
+		j = max (1, mc[1] - (norders-1) / 2)
+		do i = 0, nrandom-1 {
+		    w = z * (mw1 + dmw * urand (seed1))
+		    w = w - dmw * nint ((w - mwc) / dmw)
+		    m = j + norders * urand (seed1)
+		    Memr[waves+i] = w / m
+		    Memr[peaks+i] = peak * urand (seed1) / z
+		    Memr[sigmas+i] = sigma * z
+		}
+		if (nrandom > 0 && Memc[fname] != EOS) {
+		    i = open (Memc[fname], NEW_FILE, TEXT_FILE)
+		    do j = 0, nrandom-1 {
+			call fprintf (i, "%g %g %g\n")
+			    call pargr (Memr[waves+j] / z)
+			    call pargr (Memr[peaks+j] * z)
+			    call pargr (Memr[sigmas+j] / z)
+		    }
+		    call close (i)
+		}
+	    }
+
+	    # Find the absolute response of the gratings at the reference
+	    # blaze peak.
+
+	    flux = 1.
+	    w = wc[1]
+	    m = mc[1]
+	    do i = m - 1, 1, -1 {
+		x = ecw2x (i*w, 1, a, b, f, tb, ctb, t2tb)
+		if (IS_INDEF(x))
+		    break
+		p = ecdelta (x, w, 1, f, c, tt)
+		flux = flux + (sin (p) / p) ** 2
+		if (abs (p) > 100.)
+		    break
+	    }
+	    do i = m + 1, ARB {
+		x = ecw2x (i*w, 1, a, b, f, tb, ctb, t2tb)
+		if (IS_INDEF(x))
+		    break
+		p = ecdelta (x, w, 1, f, c, tt)
+		flux = flux + (sin (p) / p) ** 2
+		if (abs (p) > 100.)
+		    break
+	    }
+	    j = (a[1] + b[1]) / w
+	    do i = j, 1, -1 {
+		x = ecw2xr (i*w, 1, a, b, f, tb, ctb, t2tb)
+		if (IS_INDEF(x))
+		    break
+		p = ecdelta (x, w, 1, f, c, tt)
+		flux = flux + (sin (p) / p) ** 2
+		if (abs (p) > 100.)
+		    break
+	    }
+	    if (mc[2] != 0) {
+		x = ecw2x (mc[2]*w, 2, a, b, f, tb, ctb, t2tb)
+		p = ecdelta (x, w, 2, f, c, tt)
+		if (p != 0.) {
+		    p = (sin (p) / p) ** 2
+		    if (p != 0.)
+		       flux = flux / p
+		}
+	    }
+	    flux1 = flux
+
+	    # Make the 1D spectrum.
+	    call malloc (buf, norders*nl, TY_REAL)
+	    do m = m1, m2 {
+		spec = buf + (m - m1) * nl
+		call aclrr (Memr[spec], nl)
+
+		# Make the lines.
+		do i = 0, nrandom-1 {
+		    w = m * Memr[waves+i]
+		    p = Memr[peaks+i] * subsample
+		    dx = m * Memr[sigmas+i]
+		    x1 = max (-0.499,
+			ecw2x (w-nsigma*dx, 1, a, b, f, tb, ctb, t2tb)+yc)
+		    x2 = min (nl-0.501,
+			ecw2x (w+nsigma*dx, 1, a, b, f, tb, ctb, t2tb)+yc)
+		    dx = -0.5 / dx ** 2
+		    for (x = x1; x <= x2; x = x + subsample) {
+			s = ecx2w (x-yc, 1, a, b, f, cb, tb, t2tb, xmin, xmax)
+			j = nint (x)
+			Memr[spec+j] = Memr[spec+j] + p * exp (dx*(s-w)**2)
+		    }
+		}
+
+		# Initialize blackbody function.
+		if (temp > 0.) {
+		    w  = wc[1] * 1.0e-8
+		    x = exp (1.4388 / (w * temp))
+		    p1 = w**5 * (x-1.0)
+		}
+
+		# Compute blaze peak correction
+		flux = 1.
+		w = mc[1] * wc[1] / m
+
+		do i = m - 1, 1, -1 {
+		    x = ecw2x (i*w, 1, a, b, f, tb, ctb, t2tb)
+		    if (IS_INDEF(x))
+			break
+		    p = ecdelta (x, w, 1, f, c, tt)
+		    flux = flux + (sin (p) / p) ** 2
+		    if (abs (p) > 100.)
+			break
+		}
+		do i = m + 1, ARB {
+		    x = ecw2x (i*w, 1, a, b, f, tb, ctb, t2tb)
+		    if (IS_INDEF(x))
+			break
+		    p = ecdelta (x, w, 1, f, c, tt)
+		    flux = flux + (sin (p) / p) ** 2
+		    if (abs (p) > 100.)
+			break
+		}
+		j = (a[1] + b[1]) / w
+		do i = j, 1, -1 {
+		    x = ecw2xr (i*w, 1, a, b, f, tb, ctb, t2tb)
+		    if (IS_INDEF(x))
+			break
+		    p = ecdelta (x, w, 1, f, c, tt)
+		    flux = flux + (sin (p) / p) ** 2
+		    if (abs (p) > 100.)
+			break
+		}
+
+		do i = 0, nl-1 {
+		    w = ecx2w (i-yc, 1, a, b, f, cb, tb, t2tb, xmin, xmax) / m
+
+		    # Scale by continuum.
+		    p = cont
+		    if (temp > 0.) {
+			x2 = w * 1e-8
+			x1 = exp (1.4388 / (x2 * temp))
+			p = p * (p1 / x2**5 / (x1-1.0))
+		    }
+		    if (p > 0.)
+			Memr[spec+i] = max (0., p * (1. + Memr[spec+i]))
+
+		    # Apply blaze functions and pixel size corrections.
+		    x = 1 / flux
+		    p = ecdelta (i-yc, w, 1, f, c, tt)
+		    if (p != 0.)
+			x = x * (sin (p) / p) ** 2
+
+		    if (mc[2] != 0) {
+			s = ecw2x (mc[2]*w, 2, a, b, f, tb, ctb, t2tb)
+			p = ecdelta (s, w, 2, f, c, tt)
+			if (p != 0.)
+			   x = x * (sin (p) / p) ** 2
+		    }
+
+		    dx = ecxdx (i-yc, 1, f, tb) * mc[1] / m
+		    if (mc[2] != 0)
+			dx = dx * ecxdx (s, 2, f, tb)
+
+		    Memr[spec+i] = Memr[spec+i] * flux1 * x * dx / dx1
+		}
+	    }
+
+	    # Write 1D spectrum or create 2D spectrum.
+	    if (profile == EXTRACTED) {
+		do i = 1, norders {
+		    spec = buf + (i - 1) * nl
+		    if (new)
+			call amovr (Memr[spec], Memr[impl2r(im,i)], nl)
+		    else
+			call aaddr (Memr[spec], Memr[imgl2r(im,i)],
+			    Memr[impl2r(im,i)], nl)
+		}
+	    } else {
+		# Make scattered light response.
+		if (scattered > 0.) {
+		    call malloc (bf1, nc, TY_REAL)
+		    call malloc (bf2, nl, TY_REAL)
+		    if (mc[2] != 0) {
+			do i = 0, nc-1 {
+			    s = i - xc1
+			    w = ecx2w (s, 2, a, b, f, cb, tb, t2tb,
+				xmin, xmax) / mc[2]
+			    p = ecdelta (s, w, 2, f, c, tt)
+			    if (p == 0.)
+				Memr[bf1+i] = scattered
+			    else
+				Memr[bf1+i] = scattered * (sin (p) / p) ** 2
+			}
+		    } else
+			call amovkr (scattered, Memr[bf1], nc)
+
+		    s = wc[1] - disp[1] * yc
+		    do i = 0, nl - 1 {
+			w = ecx2w (i-yc, 1, a, b, f, cb, tb, t2tb, xmin, xmax) /
+			    mc[1]
+			p = ecdelta (i-yc, w, 1, f, c, tt)
+			if (p == 0.)
+			    Memr[bf2+i] = 1.
+			else
+			    Memr[bf2+i] = (sin (p) / p) ** 2
+		    }
+		} else
+		    bf1 = NULL
+
+		# Make the profile templates stored as an interpolation function
+		# with the returned center, fwhm, and flux.
+
+		switch (profile) {
+		case GAUSS:
+		    call mkprof (2., asi, pcen, fwhm, flux)
+		case SLIT:
+		    call mkprof (10., asi, pcen, fwhm, flux)
+		}
+
+		# Now expand the 1D spectra into 2D profiles.
+		dx = fwhm / width
+		do i = 0, nl-1 {
+		    data = impl2r (im, i+1)
+		    if (new)
+			call aclrr (Memr[data], nc)
+		    else
+			call amovr (Memr[imgl2r(im,i+1)], Memr[data], nc)
+
+		    if (bf1 != NULL)
+			do j = 0, nc-1
+			    Memr[data+j] = Memr[data+j] +
+				Memr[bf1+j] * Memr[bf2+i]
+			
+		    w = ecx2w (i-yc, 1, a, b, f, cb, tb, t2tb, xmin, xmax)
+		    do j = 0, norders-1 {
+			x = w / (m1 + j)
+			p = Memr[buf+j*nl+i] / flux
+			if (mc[2] == 0)
+			    x = (x - wc[1]) / (x * disp[2]) + xc
+			else
+			    x = ecw2x (mc[2]*x, 2, a, b, f, tb, ctb, t2tb) +
+				xc1
+			p1 = max (-0.49, x - pcen / dx)
+			p2 = min (nc - 0.51, x + pcen / dx)
+			if (p1 >= p2)
+			    next
+
+			k1 = p1 + 0.5
+			k2 = p2 + 0.5
+			x1 = (p1 - x) * dx + pcen + 1
+			x2 = (min (p2, k1 + 0.5) - x) * dx + pcen + 1
+			x1 = max (1., x1)
+			x2 = max (1., x2)
+
+			m = data + k1
+			Memr[m] = Memr[m] + p * asigrl (asi, x1, x2)
+			do k = k1+1, k2-1 {
+			   x1 = x2
+			   x2 = x1 + dx
+			   m = m + 1
+			   Memr[m] = Memr[m] + p * asigrl (asi, x1, x2)
+			}
+			x1 = x2
+			x2 = (p2 - x) * dx + pcen + 1
+			m = m + 1
+			Memr[m] = Memr[m] + p * asigrl (asi, x1, x2)
+		    }
+		}
+
+		call asifree (asi)
+	    }
+
+	    call mfree (buf, TY_REAL)
+	    if (bf1 != NULL) {
+		call mfree (bf1, TY_REAL)
+		call mfree (bf2, TY_REAL)
+	    }
+	    call mfree (waves, TY_REAL)
+	    call mfree (peaks, TY_REAL)
+	    call mfree (sigmas, TY_REAL)
+
+	    # Add comment history of task parameters.
+	    if (clgetb ("comments")) {
+		call strcpy ("# ", Memc[comment], LEN_COMMENT)
+		call cnvtime (clktime (0), Memc[comment+2], LEN_COMMENT-2)
+		call mkh_comment (im, Memc[comment])
+		call mkh_comment (im, "begin        mkechelle")
+		call mkh_comment1 (im, "profile", 's')
+		if (profile != EXTRACTED) {
+		    call mkh_comment1 (im, "width", 'r')
+		    call mkh_comment1 (im, "scattered", 'r')
+		}
+		call mkh_comment1 (im, "norders", 'i')
+		call sprintf (Memc[comment], LEN_COMMENT, "%9txc%24t%g")
+		    call pargr (1+xc)
+		call mkh_comment (im, Memc[comment])
+		call sprintf (Memc[comment], LEN_COMMENT, "%9tyc%24t%g")
+		    call pargr (1+yc)
+		call mkh_comment (im, Memc[comment])
+		call mkh_comment1 (im, "pixsize", 'r')
+
+		call sprintf (Memc[comment], LEN_COMMENT, "%9tf%24t%g")
+		    if (IS_INDEF(pixsize) || IS_INDEF(f[1]))
+			call pargr (f[1])
+		    else
+			call pargr (f[1] * pixsize)
+		call mkh_comment (im, Memc[comment])
+		call sprintf (Memc[comment], LEN_COMMENT, "%9tgmm%24t%g")
+		    call pargr (gmm[1])
+		call mkh_comment (im, Memc[comment])
+		call sprintf (Memc[comment], LEN_COMMENT, "%9tblaze%24t%g")
+		    call pargr (blaze[1])
+		call mkh_comment (im, Memc[comment])
+		call sprintf (Memc[comment], LEN_COMMENT, "%9ttheta%24t%g")
+		    call pargr (t[1])
+		call mkh_comment (im, Memc[comment])
+		call sprintf (Memc[comment], LEN_COMMENT, "%9torder%24t%d")
+		    call pargi (mc[1])
+		call mkh_comment (im, Memc[comment])
+		call sprintf (Memc[comment], LEN_COMMENT, "%9twavelength%24t%g")
+		    call pargr (wc[1])
+		call mkh_comment (im, Memc[comment])
+		call sprintf (Memc[comment], LEN_COMMENT, "%9tdispersion%24t%g")
+		    if (IS_INDEF(pixsize) || IS_INDEF(disp[1]))
+			call pargr (disp[1])
+		    else
+			call pargr (disp[1] / pixsize)
+		call mkh_comment (im, Memc[comment])
+
+		call sprintf (Memc[comment], LEN_COMMENT, "%9tcf%24t%g")
+		    if (IS_INDEF(pixsize) || IS_INDEF(f[2]))
+			call pargr (f[2])
+		    else
+			call pargr (f[2] * pixsize)
+		call mkh_comment (im, Memc[comment])
+		call sprintf (Memc[comment], LEN_COMMENT, "%9tcgmm%24t%g")
+		    call pargr (gmm[2])
+		call mkh_comment (im, Memc[comment])
+		call sprintf (Memc[comment], LEN_COMMENT, "%9tcblaze%24t%g")
+		    call pargr (blaze[2])
+		call mkh_comment (im, Memc[comment])
+		call sprintf (Memc[comment], LEN_COMMENT, "%9tctheta%24t%g")
+		    call pargr (t[2])
+		call mkh_comment (im, Memc[comment])
+		call sprintf (Memc[comment], LEN_COMMENT, "%9tcorder%24t%d")
+		    call pargi (mc[2])
+		call mkh_comment (im, Memc[comment])
+		call sprintf (Memc[comment], LEN_COMMENT, "%9tcwavelength%24t%g")
+		    call pargr (wc[2])
+		call mkh_comment (im, Memc[comment])
+		call sprintf (Memc[comment], LEN_COMMENT, "%9tcdispersion%24t%g")
+		    if (IS_INDEF(pixsize) || IS_INDEF(disp[2]))
+			call pargr (disp[2])
+		    else
+			call pargr (disp[2] / pixsize)
+		call mkh_comment (im, Memc[comment])
+
+		call mkh_comment1 (im, "rv", 'r')
+		call mkh_comment1 (im, "z", 'b')
+		call mkh_comment1 (im, "continuum", 'r')
+		call mkh_comment1 (im, "temperature", 'r')
+		if (nrandom > 0) {
+		    if (Memc[fname] != EOS)
+			call mkh_comment1 (im, "lines", 's')
+		    call sprintf (Memc[comment], LEN_COMMENT, "%9tnlines%24t%d")
+			call pargi (nrandom)
+		    call mkh_comment (im, Memc[comment])
+		    call mkh_comment1 (im, "peak", 'r')
+		    call mkh_comment1 (im, "sigma", 'r')
+		    call mkh_comment1 (im, "seed", 'i')
+		}
+	    }
+
+	    call imunmap (im)
+	}
+
+	call imtclose (images)
+	call imtclose (lines)
+	call sfree (sp)
+end
+
+
+# Definitions of INDEF parameter flags.
+define	F	1B
+define	G	2B
+define	B	4B
+define	T	10B
+define	M	20B
+define	W	40B
+define	D	100B
+
+# Combinations
+define	FG	3B
+define	FB	5B
+define	FT	11B
+define	FM	21B
+define	FW	41B
+define	GB	6B
+define	GT	12B
+define	GW	42B
+define	GD	102B
+define	BT	14B
+define	BM	24B
+define	BW	44B
+define	BD	104B
+define	TM	30B
+define	TW	50B
+define	TD	110B
+define	MW	60B
+define	MD	120B
+define	WD	140B
+
+
+# ECGRATING -- Derive and check grating parameters.
+
+procedure ecgrating (e, f, g, b, t, m, w, d)
+
+bool	e
+real	f,  g, b, t, w, d, x
+int	m
+
+int	i, flags
+define	err_	10
+
+begin
+	if (!IS_INDEF(f)) {
+	    if (f <= 0.)
+		f = INDEF
+	}
+	if (!IS_INDEF(g)) {
+	    if (g <= 0.)
+		g = INDEF
+	    else
+		g = g / 1e7
+	}
+	if (!IS_INDEF(b)) {
+	    b = DEGTORAD (b)
+	    if (b == 0. && t == 0.)
+		t = INDEF
+	}
+	if (!IS_INDEF(t)) {
+	    t = DEGTORAD (t)
+	    if (t > PI && !IS_INDEF(b))
+		t = t - TWOPI + b
+	}
+	if (!IS_INDEFI(m) && m <= 0)
+	    m = INDEFI
+	if (!IS_INDEF(w) && w <= 0.)
+	    w = INDEF
+	if (!IS_INDEF(d) && d <= 0.)
+	    d = INDEF
+
+	flags = 0
+	if (IS_INDEF(f))
+	    flags = flags + F
+	if (IS_INDEF(g))
+	    flags = flags + G
+	if (IS_INDEF(b))
+	    flags = flags + B
+	if (IS_INDEF(t))
+	    flags = flags + T
+	if (IS_INDEFI(m))
+	    flags = flags + M
+	if (IS_INDEF(w))
+	    flags = flags + W
+	if (IS_INDEF(d))
+	    flags = flags + D
+
+	switch (flags) {
+	case 0, F, G, B, T, M, W, D:
+	    switch (flags) {
+	    case F:
+		f = cos (2 * b - t) / (g * m * d)
+	    case G: 
+		g = (sin (t) + sin (2 * b - t)) / (m * w)
+		if (g == 0.)
+		    g = INDEF
+	    case B:
+		if (t > PI) {
+		    x = g * m * w / (2 * cos (t))
+		    if (abs (x) > 1.)
+			goto err_
+		    b = asin (x)
+		    t = t - TWOPI + b
+		} else {
+		    x = g * m * w - sin (t)
+		    if (abs (x) > 1.)
+			goto err_
+		    b = (t + asin (x)) / 2
+		}
+	    case T:
+		x = g * m * w / (2 * sin(b))
+		if (abs (x) > 1.)
+		    goto err_
+		if (e)
+		    t = b + acos (x)
+		else
+		    t = b - acos (x)
+	    case M:
+		m = max (1, nint ((sin(t) + sin(2*b-t)) / (g * w)))
+	    }
+	    if (!IS_INDEF(g)) {
+		w = (sin (t) + sin (2 * b - t)) / (g * m)
+		d = cos (2 * b - t) / (f * g * m)
+	    }
+	case FG:
+	    x = (sin (t) + sin (2 * b - t)) / (m * w)
+	    if (x == 0.)
+		goto err_
+	    g = x
+	    f = cos (2 * b - t) / (g * m * d)
+	case FB:
+	    if (t > PI) {
+		x = g * m * w / (2 * cos (t))
+		if (abs (x) > 1.)
+		    goto err_
+		b = asin (x)
+		t = t - TWOPI + b
+	    } else {
+		x = g * m * w - sin (t)
+		if (abs (x) > 1.)
+		    goto err_
+		b = (t + asin (x)) / 2
+	    }
+	    f = cos (2 * b - t) / (g * m * d)
+	case FT:
+	    x = g * m * w / (2 * sin (b))
+	    if (abs (x) > 1.)
+		goto err_
+	    if (e)
+		t = b + acos (x)
+	    else
+		t = b - acos (x)
+	    f = cos (2 * b - t) / (g * m * d)
+	case FM:
+	    m = nint ((sin (t) + sin (2 * b - t)) / (g * w))
+	    f = cos (2 * b - t) / (g * m * d)
+	    w = (sin (t) + sin (2 * b - t)) / (g * m)
+	    d = cos (2 * b - t) / (f * g * m)
+	case FW:
+	    w = (sin (t) + sin (2 * b - t)) / (g * m)
+	    f = cos (2 * b - t) / (g * m * d)
+	case GB:
+	    x = f * d / w
+	    if (t > PI) {
+		b = atan (1 / (2 * x - tan (t)))
+		t = t - TWOPI + b
+	    } else {
+		x = (tan (t) - x) / (1 + 2 * x * tan (t))
+		b = atan (x + sqrt (1 + x * x))
+	    }
+	    g = (sin (t) + sin (2 * b - t)) / (m * w)
+	case GT:
+	    t = b + atan (2 * f * d / w - 1 / tan (b))
+	    g = (sin (t) + sin (2 * b - t)) / (m * w)
+	case GW:
+	    g = cos (2 * b - t) / (f * m * d)
+	    if (g == 0.)
+		g = INDEF
+	    else
+		w = (sin (t) + sin (2 * b - t)) / (g * m)
+	case GD:
+	    x = (sin (t) + sin (2 * b - t)) / (m * w)
+	    if (x == 0.)
+		goto err_
+	    g = x
+	    d = cos (2 * b - t) / (f * g * m)
+	case BT:
+	    x = f * g * m * d
+	    if (abs (x) > 1.)
+		goto err_
+	    x = acos (x)
+	    x = g * m * w - sin (x)
+	    if (abs (x) > 1.)
+		goto err_
+	    t = asin (x)
+	    b = (acos (f * g * m * d) + t) / 2
+	case BM:
+	    x = f * d / w
+	    if (t > PI) {
+		b = atan (1 / (2 * x - tan (t)))
+		t = t - TWOPI + b
+	    } else {
+		x = (tan (t) - x) / (1 + 2 * x * tan (t))
+		b = atan (x + sqrt (1 + x * x))
+	    }
+	    m = max (1, nint ((sin(t) + sin(2*b-t)) / (g * w)))
+	    b = (t + asin (g * m * w - sin (t))) / 2
+	    w = (sin (t) + sin (2 * b - t)) / (g * m)
+	    d = cos (2 * b - t) / (f * g * m)
+	case BW:
+	    b = (t + acos (f * g * m * d)) / 2
+	    w = (sin (t) + sin (2 * b - t)) / (g * m)
+	case BD:
+	    if (t > PI) {
+		x = g * m * w / (2 * cos (t))
+		if (abs (x) > 1.)
+		    goto err_
+		b = asin (x)
+		t = t - TWOPI + b
+	    } else {
+		x = g * m * w - sin (t)
+		if (abs (x) > 1.)
+		    goto err_
+		b = (t + asin (x)) / 2
+	    }
+	    d = cos (2 * b - t) / (f * g * m)
+	case TM:
+	    x = f * d / w
+	    x = b + 2 * atan (x - 1 / (2 * tan (b)))
+	    i = max (1, nint ((sin(x) + sin(2*b-x)) / (g * w)))
+	    x = g * i * w / (2 * sin (b))
+	    if (abs (x) > 1.)
+		goto err_
+	    if (e)
+		t = b + acos (x)
+	    else
+		t = b - acos (x)
+	    m = i
+	    w = (sin (t) + sin (2 * b - t)) / (g * m)
+	    d = cos (2 * b - t) / (f * g * m)
+	case TW:
+	    x = f * g * m * d
+	    if (abs (x) > 1.)
+		goto err_
+	    t = 2 * b - acos (x)
+	    w = (sin (t) + sin (2 * b - t)) / (g * m)
+	case TD:
+	    x = g * m * w / (2 * sin (b))
+	    if (abs (x) > 1.)
+		goto err_
+	    if (e)
+		t = b + acos (x)
+	    else
+		t = b - acos (x)
+	    d = cos (2 * b - t) / (f * g * m)
+	case MW:
+	    m = max (1, nint (cos (2 * b - t) / (f * g * d)))
+	    w = (sin (t) + sin (2 * b - t)) / (g * m)
+	    d = cos (2 * b - t) / (f * g * m)
+	case MD:
+	    m = max (1, nint ((sin(t) + sin(2*b-t)) / (g * w)))
+	    w = (sin (t) + sin (2 * b - t)) / (g * m)
+	    d = cos (2 * b - t) / (f * g * m)
+	case WD:
+	    w = (sin (t) + sin (2 * b - t)) / (g * m)
+	    d = cos (2 * b - t) / (f * g * m)
+	}
+
+	if (!IS_INDEF(g))
+	    g = g * 1e7
+	if (!IS_INDEF(b))
+	    b = RADTODEG (b)
+	if (!IS_INDEF(t))
+	    t = RADTODEG (t)
+			   
+	if (IS_INDEF(f) || IS_INDEF(g) || IS_INDEF(b) || IS_INDEF(t) ||
+	    IS_INDEF(m) || IS_INDEF(w) || IS_INDEF(d))
+	    call error (1,
+		"Insufficient information to to resolve grating parameters")
+
+	return
+
+err_	if (!IS_INDEF(g))
+	    g = g * 1e7
+	if (!IS_INDEF(b))
+	    b = RADTODEG (b)
+	if (!IS_INDEF(t))
+	    t = RADTODEG (t)
+	call error (2, "Impossible combination of grating parameters")
+end
+
+
+# ECLIST -- List grating parameters.
+
+procedure eclist (p, f, g, b, t, m, w, d)
+
+real	p, f[2], g[2], b[2], t[2], w[2], d[2]
+int	m[2]
+
+begin
+	call printf ("Echelle grating parameters:\n")
+	    call printf ("  Focal length = %g %s\n")
+		if (IS_INDEF(p) || IS_INDEF(f[1]))
+		    call pargr (f[1])
+		else
+		    call pargr (f[1] * p)
+		if (IS_INDEF(p))
+		    call pargstr ("pixels")
+		else
+		    call pargstr ("mm")
+	    call printf ("  Grating = %g grooves/mm\n")
+		call pargr (g[1])
+	    call printf ("  Blaze angle = %g degrees\n")
+		call pargr (b[1])
+	    call printf ("  Incidence angle = %g degrees\n")
+		call pargr (t[1])
+	    call printf ("  Reference order = %d\n")
+		call pargi (m[1])
+	    call printf (
+		"  Blaze wavelength of reference order = %g Angstroms\n")
+		call pargr (w[1])
+	    call printf (
+		"  Blaze dispersion of reference order = %g Angstroms/%s\n")
+		if (IS_INDEF(p) || IS_INDEF(d[1]))
+		    call pargr (d[1])
+		else
+		    call pargr (d[1] / p)
+		if (IS_INDEF(p))
+		    call pargstr ("pixels")
+		else
+		    call pargstr ("mm")
+
+	if (m[2] == 0.) {
+	    call printf ("Crossdisperser prism parameters:\n")
+		call printf ("  Reference wavelength = %g Angstroms/pixel\n")
+		    call pargr (w[2])
+		call printf (
+		"  Dispersion at reference wavelength = %g Angstroms/%s\n")
+		    if (IS_INDEF(p) || IS_INDEF(d[2]))
+			call pargr (d[2])
+		    else
+			call pargr (d[2] / p)
+		    if (IS_INDEF(p))
+			call pargstr ("pixels")
+		    else
+			call pargstr ("mm")
+	} else {
+	    call printf ("Crossdisperser grating parameters:\n")
+		call printf ("  Focal length = %g %s\n")
+		    if (IS_INDEF(p) || IS_INDEF(f[2]))
+			call pargr (f[2])
+		    else
+			call pargr (f[2] * p)
+		    if (IS_INDEF(p))
+			call pargstr ("pixels")
+		    else
+			call pargstr ("mm")
+		call printf ("  Grating = %g grooves/mm\n")
+		    call pargr (g[2])
+		call printf ("  Blaze angle = %g degrees\n")
+		    call pargr (b[2])
+		call printf ("  Incidence angle = %g degrees\n")
+		    call pargr (t[2])
+		call printf ("  Order = %d\n")
+		    call pargi (m[2])
+		call printf (
+		    "  Blaze wavelength = %g Angstroms\n")
+		    call pargr (w[2])
+		call printf (
+		    "  Blaze dispersion = %g Angstroms/%s\n")
+		    if (IS_INDEF(p) || IS_INDEF(d[2]))
+			call pargr (d[2])
+		    else
+			call pargr (d[2] / p)
+		    if (IS_INDEF(p))
+			call pargstr ("pixels")
+		    else
+			call pargstr ("mm")
+	}
+	call flush (STDOUT)
+end
+
+
+# ECX2W -- Given pixel position return wavelength.
+
+real procedure ecx2w (x, i, a, b, f, cb, tb, t2tb, xmin, xmax)
+
+real	x, a[2], b[2], f[2], cb[2], tb[2], t2tb[2], xmin[2], xmax[2], w
+int	i
+
+begin
+    if (IS_INDEF(f[i]))
+	return (a[i] + b[i] * x)
+    w = x / f[1]
+    w = a[i] + b[i] * cb[i] / sqrt (1 + w * w) * (w + tb[i])
+    return (w)
+end
+
+
+# ECX2WR -- Given pixel position return wavelength of reflected component.
+
+real procedure ecx2wr (x, i, a, b, f, cb, tb, t2tb, xmin, xmax)
+
+real	x, a[2], b[2], f[2], cb[2], tb[2], t2tb[2], xmin[2], xmax[2], w
+int	i
+
+begin
+    if (IS_INDEF(f[i]))
+	return (INDEF)
+
+    w = x / f[i]
+    if (x <= xmin[i] || x >= xmax[i])
+	return (INDEF)
+
+    w = (w - t2tb[i]) / (1 + w * t2tb[i])
+    w = a[i] + b[i] * cb[i] /  sqrt (1 + w * w) * (w + tb[i])
+    return (w)
+end
+
+
+# ECXDX -- Given pixel position return pixel size per unit wavelength
+# normalized to the central pixel.
+
+real procedure ecxdx (x, i, f, tb)
+
+real	x, f[2], tb[2], dx
+int	i
+
+begin
+	if (IS_INDEF(f[i]))
+	    return (1.)
+
+	dx = x / f[i]
+	dx = (1 - dx * tb[i]) / sqrt ((1 + dx * dx) ** 3)
+	return (dx)
+end
+
+
+# ECW2X -- Given wavelength return pixel position.
+
+real procedure ecw2x (w, i, a, b, f, tb, ctb, t2tb)
+
+real	w, a[2], b[2], f[2], tb[2], ctb[2], t2tb[2], x
+int	i
+
+begin
+	if (IS_INDEF(f[i]))
+	    return ((w - a[i]) / b[i])
+
+	x = (w - a[i]) / b[i]
+	if (x >= 1. || x <= -ctb[i])
+	    return (INDEF)
+	x = x / sqrt (1 - x * x)
+	x = f[i] * (x - tb[i]) / (1 + x * tb[i])
+	return (x)
+
+end
+
+
+# ECW2XR -- Given wavelength return pixel position of reflected component.
+
+real procedure ecw2xr (w, i, a, b, f, tb, ctb, t2tb)
+
+real	w, a[2], b[2], f[2], tb[2], ctb[2], t2tb[2], x
+int	i
+
+begin
+	if (IS_INDEF(f[i]))
+	    return (INDEF)
+
+	x = (w - a[i]) / b[i]
+	if (x >= 1. || x <= ctb[i])
+	    return (INDEF)
+	x = x / sqrt (1 - x * x)
+	x = (x - tb[i]) / (1 + x * tb[i])
+	x = f[i] * (x + t2tb[i]) / (1 - x * t2tb[i])
+	return (x)
+end
+
+
+# ECDELTA -- Given pixel position and wavelength return blaze function
+# phase angle.
+
+real procedure ecdelta (x, w, i, f, c, tt)
+
+real	x, w, f[2], c[2], tt[2], d
+int	i
+
+begin
+	if (IS_INDEF(f[i]))
+	    return (c[i] / w * x)
+
+	d = x / f[i]
+	d = 1 / sqrt (1 + d * d)
+	d = c[i] / w * (d * x / f[i] + tt[i] * (1 - d))
+	return (d)
+end
diff --git a/noao/artdata/t_mkheader.x b/noao/artdata/t_mkheader.x
new file mode 100644
index 00000000..d9074d24
--- /dev/null
+++ b/noao/artdata/t_mkheader.x
@@ -0,0 +1,52 @@
+include	<error.h>
+include	<imhdr.h>
+include	<ctype.h>
+
+define	LEN_UA		20000			# Maximum user header
+
+# T_MKHEADER -- Append or substitute new image header from an image or file.
+# Only the legal FITS cards (ignoring leading whitespace) will be copied
+# from a file.
+
+procedure t_mkheader ()
+
+int	imlist			# List of images
+int	flist			# List of data files
+bool	append			# Append to existing keywords?
+bool	verbose			# Verbose output?
+
+int	stat
+pointer	im, sp, image, fname
+
+bool	clgetb()
+int	imtopenp(), clpopnu(), clplen(), imtgetim(), clgfil()
+pointer	immap()
+
+begin
+	call smark (sp)
+	call salloc (image, SZ_FNAME, TY_CHAR)
+	call salloc (fname, SZ_FNAME, TY_CHAR)
+
+	imlist = imtopenp ("images")
+	flist = clpopnu ("headers")
+	if (clplen (flist) == 0)
+	    call error (1, "No header files specified")
+	append = clgetb ("append")
+	verbose = clgetb ("verbose")
+
+	while (imtgetim (imlist, Memc[image], SZ_FNAME) != EOF) {
+	    stat = clgfil (flist, Memc[fname], SZ_FNAME)
+
+	    iferr (im = immap (Memc[image], READ_WRITE, LEN_UA)) {
+		call erract (EA_WARN)
+		next
+	    }
+	    iferr (call mkh_header (im, Memc[fname], append, verbose))
+		call erract (EA_WARN)
+	    call imunmap (im)
+	}
+
+	call imtclose (imlist)
+	call clpcls (flist)
+	call sfree (sp)
+end
diff --git a/noao/artdata/t_mknoise.x b/noao/artdata/t_mknoise.x
new file mode 100644
index 00000000..59e7258a
--- /dev/null
+++ b/noao/artdata/t_mknoise.x
@@ -0,0 +1,577 @@
+include	<error.h>
+include	<imhdr.h>
+include	<mach.h>
+
+define	LEN_UA		20000			# Maximum user header
+define	LEN_COMMENT	70			# Maximum comment length
+
+# Cosmic ray data structure
+define	LEN_MKO		4
+define	MKO_X		Memi[$1]		# X position
+define	MKO_Y		Memi[$1+1]		# Y position
+define	MKO_Z		Memi[$1+2]		# Flux
+define	MKO_SORT	Memi[$1+3]		# Sort index
+
+
+# T_MKNOISE -- Add cosmic rays and possion and readout noise to images.
+# New images may be created or noise added to existing images.
+# The noise is not completely random for reasons of speed.
+
+procedure t_mknoise ()
+
+int	ilist				# Input image list
+int	olist				# Output image list
+int	objects				# List of cosmic ray files
+int	nl				# Number of lines
+int	nc				# Number of columns
+real	background			# Background level
+real	gain				# Gain (electrons/DN)
+int	ranbuf				# Random number buffer size
+real	rdnoise				# Read noise (in electrons)
+bool	poisson				# Add Poisson noise?
+long	seed				# Random number seed
+int	nobjects			# Number of random cosmic rays
+real	energy				# Maximum random energy (electrons)
+bool	cmmts				# Add comments?
+
+bool	new, fcmmts
+long	seed1
+real	x, y, z, dmin, dmax
+int	i, j, k, l, nx, ny, nlines, c1, c2, c3, c4, l1, l2, l3, l4, irbuf, ipbuf
+pointer	sp, input, output, fname, comment, rbuf, pbuf
+pointer	in, out, buf, obuf, lines, newlines, obj, ptr1, ptr2
+pointer	mko, mkt
+
+long	clgetl(), clktime()
+bool	clgetb(), streq()
+int	imtopenp(), imtlen(), imtgetim()
+int	clgeti(), access(), nowhite(), open(), fscan(), nscan()
+real	clgetr(), urand()
+pointer	immap(), imgl2r(), impl2r()
+pointer	mkt_star()
+errchk	open, immap, imgl2r, impl2r, malloc, realloc, mkt_gstar
+
+int	mko_compare()
+extern	mko_compare
+pointer	mko_sort
+common	/mko_qsort/ mko_sort
+
+begin
+	call smark (sp)
+	call salloc (input, SZ_FNAME, TY_CHAR)
+	call salloc (output, SZ_FNAME, TY_CHAR)
+	call salloc (fname, SZ_FNAME, TY_CHAR)
+	call salloc (comment, max (SZ_FNAME,LEN_COMMENT), TY_CHAR)
+
+	# Get parameters which apply to all images.
+	ilist = imtopenp ("input")
+	olist = imtopenp ("output")
+	objects = imtopenp ("cosrays")
+	background = clgetr ("background")
+	gain = clgetr ("gain")
+	ranbuf = clgeti ("ranbuf")
+	if (ranbuf == 0)
+	    ranbuf = -1
+	rdnoise = clgetr ("rdnoise") / gain
+	if (rdnoise > 0. && ranbuf > 0)
+	    call salloc (rbuf, ranbuf, TY_REAL)
+	poisson = clgetb ("poisson")
+	if (poisson && ranbuf > 0)
+	    call salloc (pbuf, ranbuf, TY_REAL)
+	seed = clgetl ("seed")
+	if (IS_INDEFL(seed))
+	    seed1 = seed1 + clktime (long (0))
+	else
+	    seed1 = seed
+	cmmts = clgetb ("comments")
+
+	if (imtlen (ilist) == 0)
+	    call error (1, "No input image list")
+
+	# Loop through input, output, and cosmic ray lists.
+	# Missing output images take the input image name.
+	# The cosmic ray list will repeat if shorter than input list.
+
+	Memc[fname] = EOS
+	while (imtgetim (ilist, Memc[input], SZ_FNAME) != EOF) {
+	    if (imtgetim (olist, Memc[output], SZ_FNAME) == EOF)
+		call strcpy (Memc[input], Memc[output], SZ_FNAME)
+	    i = imtgetim (objects, Memc[fname], SZ_FNAME)
+
+	    # Map images.  Check for new, existing, and in-place images.
+	    if (streq (Memc[input], Memc[output])) {
+		ifnoerr (in = immap (Memc[input], READ_WRITE, LEN_UA)) {
+		    out = in
+		    new = false
+		} else {
+		    iferr (out = immap (Memc[output], NEW_IMAGE, LEN_UA)) {
+			call erract (EA_WARN)
+			next
+		    }
+		    in = out
+
+		    call clgstr ("header", Memc[comment], SZ_FNAME)
+		    iferr (call mkh_header (out, Memc[comment], true, false))
+			call erract (EA_WARN)
+
+		    IM_NDIM(in) = 2
+		    IM_LEN(in,1) = clgeti ("ncols")
+		    IM_LEN(in,2) = clgeti ("nlines")
+		    IM_PIXTYPE(in) = TY_REAL
+		    call clgstr ("title", IM_TITLE(out), SZ_IMTITLE)
+		    new = true
+		}
+	    } else {
+		iferr (in = immap (Memc[input], READ_ONLY, LEN_UA)) {
+		    call erract (EA_WARN)
+		    next
+		}
+		iferr (out = immap (Memc[output], NEW_COPY, in)) {
+		    call erract (EA_WARN)
+		    call imunmap (in)
+		    next
+		}
+		new = false
+	    }
+	    nc = IM_LEN(in,1)
+	    nl = IM_LEN(in,2)
+	    IM_MIN(out) = MAX_REAL
+	    IM_MAX(out) = -MAX_REAL
+
+	    call imaddr (out, "gain", gain)
+	    call imaddr (out, "rdnoise", rdnoise * gain)
+
+	    # Read the object list.
+	    call malloc (mko, LEN_MKO, TY_STRUCT)
+	    call mkt_init ()
+
+	    # Set cosmic ray templates.
+	    mkt = mkt_star ("gaussian")
+
+	    # Read the object list.  If none or a nonexistent list is given
+	    # and a number of random events is specified then generate them.
+	    # If a nonexistent object list is given then write the random
+	    # events out.
+
+	    fcmmts = false
+	    energy = INDEF
+	    nobjects = 0
+	    i = nowhite (Memc[fname], Memc[fname], SZ_FNAME)
+	    if (access (Memc[fname], 0, 0) == YES) {
+		i = open (Memc[fname], READ_ONLY, TEXT_FILE)
+		while (fscan (i) != EOF) {
+		    call gargr (x)
+		    call gargr (y)
+		    call gargr (z)
+		    if (nscan() < 3) {
+			fcmmts = true
+			next
+		    }
+		    if (x < 1 || x > nc || y < 1 || y > nl)
+			next
+		    if (nobjects == 0) {
+			j = 100
+			call malloc (MKO_X(mko), j, TY_REAL)
+			call malloc (MKO_Y(mko), j, TY_REAL)
+			call malloc (MKO_Z(mko), j, TY_REAL)
+			call malloc (MKO_SORT(mko), j, TY_INT)
+		    } else if (nobjects == j) {
+			j = j + 100
+			call realloc (MKO_X(mko), j, TY_REAL)
+			call realloc (MKO_Y(mko), j, TY_REAL)
+			call realloc (MKO_Z(mko), j, TY_REAL)
+			call realloc (MKO_SORT(mko), j, TY_INT)
+		    }
+
+		    Memr[MKO_X(mko)+nobjects] = x
+		    Memr[MKO_Y(mko)+nobjects] = y
+		    Memr[MKO_Z(mko)+nobjects] = z / gain
+		    Memi[MKO_SORT(mko)+nobjects] = nobjects
+		    nobjects = nobjects + 1
+		}
+		call close (i)
+	    } else {
+		nobjects = clgeti ("ncosrays")
+		if (nobjects > 0) {
+		    energy = clgetr ("energy") / gain
+		    call malloc (MKO_X(mko), nobjects, TY_REAL)
+		    call malloc (MKO_Y(mko), nobjects, TY_REAL)
+		    call malloc (MKO_Z(mko), nobjects, TY_REAL)
+		    call malloc (MKO_SORT(mko), nobjects, TY_INT)
+		    do i = 0, nobjects-1 {
+			Memr[MKO_X(mko)+i] = 1 + (nc-1) * urand (seed1)
+			Memr[MKO_Y(mko)+i] = 1 + (nl-1) * urand (seed1)
+			Memr[MKO_Z(mko)+i] = energy * urand (seed1)
+			Memi[MKO_SORT(mko)+i] = i
+		    }
+		    if (Memc[fname] != EOS) {
+			i = open (Memc[fname], NEW_FILE, TEXT_FILE)
+			do j = 0, nobjects-1 {
+			    call fprintf (i, "%g %g %g\n")
+				call pargr (Memr[MKO_X(mko)+j])
+				call pargr (Memr[MKO_Y(mko)+j])
+				call pargr (gain * Memr[MKO_Z(mko)+j])
+			}
+			call close (i)
+		    }
+		}
+	    }
+
+	    # If no objects are requested then do the image I/O
+	    # line by line to add requested background and noise
+	    # and then go on to the next image.
+
+	    irbuf = 0
+	    ipbuf = 0
+	    if (nobjects == 0) {
+		call mkt_free ()
+		call mfree (mko, TY_STRUCT)
+
+		if (new) {
+		    do i = 1, nl {
+			obuf = impl2r (out, i)
+			if (background == 0.)
+			    call aclrr (Memr[obuf], nc)
+			else
+			    call amovkr (background, Memr[obuf], nc)
+			if (poisson)
+			    call mkpnoise (Memr[obuf], Memr[obuf], nc, 0.,
+				gain, pbuf, ranbuf, ipbuf, seed1)
+			if (rdnoise > 0.)
+			    call mkrnoise (Memr[obuf], nc, rdnoise,
+				rbuf, ranbuf, irbuf, seed1)
+			call alimr (Memr[obuf], nc, dmin, dmax)
+			IM_MIN(out) = min (IM_MIN(out), dmin)
+			IM_MAX(out) = max (IM_MAX(out), dmax)
+		    }
+		} else {
+		    do i = 1, nl {
+			obuf = impl2r (out, i)
+			ptr1 = imgl2r (in, i)
+			if (background == 0.)
+			    call amovr (Memr[ptr1], Memr[obuf], nc)
+			else
+			    call aaddkr (Memr[ptr1], background,
+				Memr[obuf], nc)
+			if (poisson)
+			    call mkpnoise (Memr[obuf], Memr[obuf], nc, 0.,
+				gain, pbuf, ranbuf, ipbuf, seed1)
+			if (rdnoise > 0.)
+			    call mkrnoise (Memr[obuf], nc, rdnoise,
+				rbuf, ranbuf, irbuf, seed1)
+			call alimr (Memr[obuf], nc, dmin, dmax)
+			IM_MIN(out) = min (IM_MIN(out), dmin)
+			IM_MAX(out) = max (IM_MAX(out), dmax)
+		    }
+		}
+
+		# Add comment history of task parameters.
+		if (cmmts) {
+		    call strcpy ("# ", Memc[comment], LEN_COMMENT)
+		    call cnvtime (clktime (0), Memc[comment+2], LEN_COMMENT-2)
+		    call mkh_comment (out, Memc[comment])
+		    call mkh_comment (out, "begin        mknoise")
+		    call mkh_comment1 (out, "background", 'r')
+		    call mkh_comment1 (out, "gain", 'r')
+		    call mkh_comment1 (out, "rdnoise", 'r')
+		    call mkh_comment1 (out, "poisson", 'b')
+		    call mkh_comment1 (out, "seed", 'i')
+		}
+
+		IM_LIMTIME(out) = IM_MTIME(out) + 1
+		if (in != out)
+		    call imunmap (in)
+		call imunmap (out)
+		next
+	    }
+
+	    # Add the cosmic rays.
+	    #
+	    # The object list is first sorted in Y for efficiency.
+	    # Get buffer of as many lines as possible to minimize random
+	    # access and speed up adding the objects.  Ideally the whole
+	    # image should be in memory but if not we scroll a buffer
+	    # using the fact that the objects are ordered in Y.
+	    # Use error checking to determine how much memory is available.
+
+	    mko_sort = MKO_Y(mko)
+	    call qsort (Memi[MKO_SORT(mko)], nobjects, mko_compare)
+
+	    for (nlines=nl;; nlines = 0.8 * nlines)
+		ifnoerr (call malloc (buf, nlines * nc, TY_REAL))
+		    break
+	    call malloc (lines, nlines, TY_INT)
+	    call malloc (lines, nlines, TY_INT)
+	    call malloc (newlines, nl, TY_INT)
+	    call amovki (YES, Memi[newlines], nl)
+
+	    # Fill the line buffer.
+	    do l = 1, nlines {
+		j = mod (l, nlines) 
+		ptr2 = buf + j * nc
+		Memi[lines+j] = l
+		if (new)
+		    call aclrr (Memr[ptr2], nc)
+		else
+		    call amovr (Memr[imgl2r(in,l)], Memr[ptr2], nc) 
+		Memi[newlines+l-1] = NO
+	    }
+
+	    do i = 0, nobjects-1 {
+		j = Memi[MKO_SORT(mko)+i]
+		x = Memr[MKO_X(mko)+j]
+		y = Memr[MKO_Y(mko)+j]
+		z = Memr[MKO_Z(mko)+j]
+
+		call mkt_gstar (mkt, obj, nx, ny, x, y, z)
+
+		c1 = x - nx/2 + 0.5
+		c2 = c1 + nx - 1
+		c3 = max (1, c1)
+		c4 = min (nc, c2)
+		l1 = y - ny/2 + 0.5
+		l2 = l1 + ny - 1
+		l3 = max (1, l1)
+		l4 = min (nl, l2)
+		k = c4 - c3 + 1 
+		ptr1 = obj + (l3 - l1) * nx + c3 - c1
+		c3 = c3 - 1
+		do l = l3, l4 {
+		    j = mod (l, nlines)
+		    if (l != Memi[lines+j]) {
+			ptr2 = buf + j * nc
+			obuf = impl2r (out, Memi[lines+j])
+			call amovr (Memr[ptr2], Memr[obuf], nc)
+			call alimr (Memr[obuf], nc, dmin, dmax)
+			IM_MIN(out) = min (IM_MIN(out), dmin)
+			IM_MAX(out) = max (IM_MAX(out), dmax)
+			Memi[lines+j] = l
+			if (Memi[newlines+l-1] == NO)
+			    call amovr (Memr[imgl2r(out,l)], Memr[ptr2], nc)
+			else if (new)
+			    call aclrr (Memr[ptr2], nc)
+			else
+			    call amovr (Memr[imgl2r(in,l)], Memr[ptr2], nc)
+			Memi[newlines+l-1] = NO
+		    }
+		    ptr2 = buf + j * nc + c3
+		    call aaddr (Memr[ptr1], Memr[ptr2], Memr[ptr2], k)
+		    ptr1 = ptr1 + nx
+		}
+	    }
+
+            # Flush out the line buffer.  If the whole image is in memory then
+	    # we can add the background and noise before flushing the data.
+	    # Otherwise, we need a second pass reading the image in line
+	    # by line and adding the background and noise.
+
+	    if (nlines == nl) {
+		do i = 1, nlines {
+		    j = mod (i, nlines) 
+		    ptr2 = buf + j * nc
+		    l = Memi[lines+j]
+		    if (background != 0.)
+			call aaddkr (Memr[ptr2], background, Memr[ptr2], nc)
+		    if (poisson)
+			call mkpnoise (Memr[ptr2], Memr[ptr2], nc, 0., gain,
+			    pbuf, ranbuf, ipbuf, seed1)
+		    if (rdnoise > 0.)
+			call mkrnoise (Memr[ptr2], nc, rdnoise,
+			    rbuf, ranbuf, irbuf, seed1)
+		    obuf = impl2r (out, l)
+		    call amovr (Memr[ptr2], Memr[obuf], nc) 
+		    call alimr (Memr[obuf], nc, dmin, dmax)
+		    IM_MIN(out) = min (IM_MIN(out), dmin)
+		    IM_MAX(out) = max (IM_MAX(out), dmax)
+		}
+	    } else {
+		do i = 1, nlines {
+		    j = mod (i, nlines) 
+		    ptr2 = buf + j * nc
+		    l = Memi[lines+j]
+		    obuf = impl2r (out, l)
+		    call amovr (Memr[ptr2], Memr[obuf], nc) 
+		    call alimr (Memr[obuf], nc, dmin, dmax)
+		    IM_MIN(out) = min (IM_MIN(out), dmin)
+		    IM_MAX(out) = max (IM_MAX(out), dmax)
+		}
+
+		call imflush (out)
+		do i = 1, nl {
+		    obuf = impl2r (out, i)
+		    ptr1 = imgl2r (out, i)
+		    if (background == 0.)
+			call amovr (Memr[ptr1], Memr[obuf], nc)
+		    else
+			call aaddkr (Memr[ptr1], background, Memr[obuf], nc)
+		    if (poisson)
+			call mkpnoise (Memr[obuf], Memr[obuf], nc, 0., gain,
+			    pbuf, ranbuf, ipbuf, seed1)
+		    if (rdnoise > 0.)
+			call mkrnoise (Memr[obuf], nc, rdnoise,
+			    rbuf, ranbuf, irbuf, seed1)
+		    call alimr (Memr[obuf], nc, dmin, dmax)
+		    IM_MIN(out) = min (IM_MIN(out), dmin)
+		    IM_MAX(out) = max (IM_MAX(out), dmax)
+		}
+	    }
+
+            # Since each image is different and the object lists may be
+            # different we free most of the memory within the image list
+            # loop.
+
+	    call mfree (buf, TY_REAL)
+	    call mfree (lines, TY_INT)
+	    call mkt_free ()
+	    call mfree (MKO_X(mko), TY_REAL)
+	    call mfree (MKO_Y(mko), TY_REAL)
+	    call mfree (MKO_Z(mko), TY_REAL)
+	    call mfree (MKO_SORT(mko), TY_INT)
+	    call mfree (mko, TY_STRUCT)
+
+	    # Add comment history of task parameters.
+	    if (cmmts) {
+		call strcpy ("# ", Memc[comment], LEN_COMMENT)
+		call cnvtime (clktime (0), Memc[comment+2], LEN_COMMENT-2)
+		call mkh_comment (out, Memc[comment])
+		call mkh_comment (out, "begin        mknoise")
+		call mkh_comment1 (out, "background", 'r')
+		call mkh_comment1 (out, "gain", 'r')
+		call mkh_comment1 (out, "rdnoise", 'r')
+		call mkh_comment1 (out, "poisson", 'b')
+		call mkh_comment1 (out, "seed", 'i')
+		if (fcmmts && Memc[fname] != EOS) {
+		    call mkh_comment1 (out, "cosrays", 's')
+		    i = open (Memc[fname], READ_ONLY, TEXT_FILE)
+		    while (fscan (i) != EOF) {
+			call gargr (x)
+			call gargr (y)
+			call gargr (z)
+			if (nscan() < 3) {
+			    call reset_scan ()
+			    call gargstr (Memc[comment], LEN_COMMENT)
+			    call mkh_comment (out, Memc[comment])
+			}
+		    }
+		    call close (i)
+		}
+		call sprintf (Memc[comment], LEN_COMMENT,
+		    "%9tncosrays%24t%d")
+		    call pargi (nobjects)
+		call mkh_comment (out, Memc[comment])
+		if (!IS_INDEF (energy))
+		    call mkh_comment1 (out, "energy", 'r')
+		call mkh_comment1 (out, "radius", 'r')
+		call mkh_comment1 (out, "ar", 'r')
+		call mkh_comment1 (out, "pa", 'r')
+	    }
+
+	    IM_LIMTIME(out) = IM_MTIME(out) + 1
+	    if (in != out)
+		call imunmap (in)
+	    call imunmap (out)
+
+	}
+
+	call imtclose (ilist)
+	call imtclose (olist)
+	call sfree (sp)
+end
+
+
+# MKRNOISE -- Make gaussian read noise.  A buffer of saved noise values may be
+# used to greatly speed up the noise.  In this case new noise values
+# are randomly chosen from the buffer.
+
+procedure mkrnoise (data, ndata, rdnoise, buf, nbuf, ibuf, seed)
+
+real	data[ndata]		# Output data
+int	ndata			# Number of data points
+real	rdnoise			# Read noise (in data units)
+pointer	buf			# Random value buffer	
+int	nbuf			# Size of random value buffer (may be zero)
+int	ibuf			# Number of random numbers saved
+				#   ibuf < nbuf		Save new values
+				#   ibuf = nbuf		Use saved values
+				#   ibuf > nbuf		Use new values
+long	seed			# Random number seed
+
+int	i
+real	val, urand(), gasdev()
+
+begin
+	if (ibuf == nbuf)
+	    do i = 1, ndata
+		data[i] = data[i] + Memr[buf+int(nbuf*urand (seed))]
+	else if (ibuf > nbuf)
+	    do i = 1, ndata
+		data[i] = data[i] + rdnoise * gasdev (seed)
+	else {
+	    do i = 1, ndata {
+		if (ibuf < nbuf) {
+		    val = rdnoise * gasdev (seed)
+		    Memr[buf+ibuf] = val
+		    ibuf = ibuf + 1
+		} else
+		    val = Memr[buf+int(nbuf*urand (seed))]
+		data[i] = data[i] + val
+	    }
+	}
+end
+
+
+# MKPNOISE -- Make poisson noise.  For speed, values greater than 20
+# use a gaussian approximation with the square root of the value as
+# the sigma.  The normalized gaussian values may be saved and reused
+# by random selection to speed things up.
+
+procedure mkpnoise (in, data, ndata, b, g, buf, nbuf, ibuf, seed)
+
+real	in[ndata]		# Data to add noise
+real	data[ndata]		# Output data
+int	ndata			# Number of data points
+real	b			# Background (in data units)
+real	g			# Gain
+pointer	buf			# Random value buffer	
+int	nbuf			# Size of random value buffer (may be zero)
+int	ibuf			# Number of random numbers saved
+				#   ibuf < nbuf		Save new values
+				#   ibuf = nbuf		Use saved values
+				#   ibuf > nbuf		Use new values
+long	seed			# Random number seed
+
+int	i
+real	v, gv, urand(), poidev(), gasdev()
+
+begin
+	if (ibuf == nbuf)
+	    do i = 1, ndata {
+		v = g * (in[i] + b)
+		if (v < 20.)
+		    data[i] = data[i] + (poidev (v, seed) - v) / g
+		else
+		    data[i] = data[i] +
+			sqrt (v) * Memr[buf+int(nbuf*urand(seed))] / g
+	    }
+	else if (ibuf > nbuf)
+	    do i = 1, ndata {
+		v = g * (in[i] + b)
+		data[i] = data[i] + (poidev (v, seed) - v) / g
+	    }
+	else {
+	    do i = 1, ndata {
+		v = g * (in[i] + b)
+		if (v < 20.)
+		    data[i] = data[i] + (poidev (v, seed) - v) / g
+		else {
+		    if (ibuf < nbuf) {
+			gv = gasdev (seed)
+			Memr[buf+ibuf] = gv
+			ibuf = ibuf + 1
+		    } else
+			gv = Memr[buf+int(nbuf*urand (seed))]
+		    data[i] = data[i] + sqrt (v) * gv / g
+		}
+	    }
+	}
+end
diff --git a/noao/artdata/t_mkobjects.x b/noao/artdata/t_mkobjects.x
new file mode 100644
index 00000000..c9ad0ce3
--- /dev/null
+++ b/noao/artdata/t_mkobjects.x
@@ -0,0 +1,552 @@
+include	<error.h>
+include	<imhdr.h>
+include	<math.h>
+include	<mach.h>
+
+define	LEN_UA		20000			# Maximum user header
+define	LEN_COMMENT	70			# Maximum comment length
+
+# Object data structure
+define	LEN_MKO		9
+define	MKO_MKT		Memi[$1]		# Template
+define	MKO_X		Memi[$1+1]		# X position
+define	MKO_Y		Memi[$1+2]		# Y position
+define	MKO_Z		Memi[$1+3]		# Flux
+define	MKO_R		Memi[$1+4]		# Scale size
+define	MKO_AR		Memi[$1+5]		# Axial ratio
+define	MKO_PA		Memi[$1+6]		# Position angle
+define	MKO_SAVE	Memi[$1+7]		# Save template?
+define	MKO_SORT	Memi[$1+8]		# Sort index
+
+
+# T_MKOBJECTS -- Add stars and galaxies to images.
+# New images may be created with a background and noise.
+
+procedure t_mkobjects ()
+
+int	ilist				# Input image list
+int	olist				# Output image list
+int	objects				# List of model files
+real	xo				# X offset
+real	yo				# Y offset
+int	nl				# Number of lines
+int	nc				# Number of columns
+real	background			# Background level
+real	gain				# Gain (electrons/DN)
+int	ranbuf				# Random number buffer size
+real	rdnoise				# Read noise (in electrons)
+bool	poisson				# Add Poisson noise?
+real	exptime				# Exposure time
+real	distance			# Relative distance
+real	m0				# Magnitude zero point
+long	seed				# Random number seed
+
+int	nobjects, save
+real	x, y, z, r, ar, pa, dmin, dmax
+
+bool	new, bsave, cmmts, fcmmts
+int	i, j, k, l, nx, ny, nlines, c1, c2, c3, c4, l1, l2, l3, l4, irbuf, ipbuf
+long	seed1
+pointer	sp, input, output, fname, type, star, comment, rbuf, pbuf
+pointer	in, out, buf, obuf, lines, newlines, obj, ptr1, ptr2
+pointer	mko, mkt
+
+long	clgetl(), clktime()
+bool	clgetb(), streq()
+int	imtopenp(), imtlen(), imtgetim(), btoi()
+int	clgeti(), open(), fscan(), nscan()
+real	clgetr()
+pointer	immap(), imgl2r(), impl2r()
+pointer	mkt_star(), mkt_object()
+errchk	open, immap, imgl2r, impl2r, malloc, realloc, mkt_star, mkt_object
+
+int	mko_compare()
+extern	mko_compare
+pointer	mko_sort
+common	/mko_qsort/ mko_sort
+
+begin
+	call smark (sp)
+	call salloc (input, SZ_FNAME, TY_CHAR)
+	call salloc (output, SZ_FNAME, TY_CHAR)
+	call salloc (fname, SZ_FNAME, TY_CHAR)
+	call salloc (type, SZ_FNAME, TY_CHAR)
+	call salloc (star, SZ_FNAME, TY_CHAR)
+	call salloc (comment, LEN_COMMENT, TY_CHAR)
+
+	# Get parameters which apply to all images.
+	ilist = imtopenp ("input")
+	olist = imtopenp ("output")
+	objects = imtopenp ("objects")
+	xo = clgetr ("xoffset")
+	yo = clgetr ("yoffset")
+	call clgstr ("star", Memc[star], SZ_FNAME)
+	distance = clgetr ("distance")
+	background = clgetr ("background")
+	gain = clgetr ("gain")
+	ranbuf = clgeti ("ranbuf")
+	if (ranbuf == 0)
+	    ranbuf = -1
+	rdnoise = clgetr ("rdnoise") / gain
+	if (rdnoise > 0. && ranbuf > 0)
+	    call salloc (rbuf, ranbuf, TY_REAL)
+	poisson = clgetb ("poisson")
+	if (poisson && ranbuf > 0)
+	    call salloc (pbuf, ranbuf, TY_REAL)
+	exptime = clgetr ("exptime")
+	m0 = clgetr ("magzero")
+	seed = clgetl ("seed")
+	if (IS_INDEFL(seed))
+	    seed1 = seed1 + clktime (long (0))
+	else
+	    seed1 = seed
+	cmmts = clgetb ("comments")
+
+	background = exptime * background
+
+	if (imtlen (objects) != imtlen (ilist))
+	    call error (1, "Input and objects lists don't match")
+
+	# Initialize the template library.
+	call mkt_init ()
+
+	# Loop through input, output, and object lists.
+	# Missing output images take the input image name.
+	# The object list will repeat if shorter than input list.
+
+	Memc[fname] = EOS
+	while (imtgetim (ilist, Memc[input], SZ_FNAME) != EOF) {
+	    if (imtgetim (olist, Memc[output], SZ_FNAME) == EOF)
+		call strcpy (Memc[input], Memc[output], SZ_FNAME)
+
+	    # Get and check object list.
+	    i = imtgetim (objects, Memc[fname], SZ_FNAME)
+	    iferr (i = open (Memc[fname], READ_ONLY, TEXT_FILE)) {
+		call erract (EA_WARN)
+		next
+	    }
+
+	    # Map images.  Check for new, existing, and in-place images.
+	    if (streq (Memc[input], Memc[output])) {
+		ifnoerr (out = immap (Memc[output], READ_WRITE, LEN_UA)) {
+		    in = out
+		    new = false
+		} else {
+		    iferr (out = immap (Memc[output], NEW_IMAGE, LEN_UA)) {
+			call erract (EA_WARN)
+			next
+		    }
+
+		    call clgstr ("header", Memc[comment], LEN_COMMENT)
+		    iferr (call mkh_header (out, Memc[comment], false, false))
+			call erract (EA_WARN)
+
+		    IM_NDIM(out) = 2
+		    IM_LEN(out,1) = clgeti ("ncols")
+		    IM_LEN(out,2) = clgeti ("nlines")
+		    IM_PIXTYPE(out) = TY_REAL
+		    call clgstr ("title", IM_TITLE(out), SZ_IMTITLE)
+		    call imaddr (out, "exptime", exptime)
+		    call imaddr (out, "gain", gain)
+		    call imaddr (out, "rdnoise", rdnoise * gain)
+
+		    in = out
+		    new = true
+		}
+	    } else {
+		iferr (in = immap (Memc[input], READ_ONLY, LEN_UA)) {
+		    call erract (EA_WARN)
+		    next
+		}
+		iferr (out = immap (Memc[output], NEW_COPY, in)) {
+		    call erract (EA_WARN)
+		    call imunmap (in)
+		    next
+		}
+		new = false
+	    }
+	    nc = IM_LEN(in,1)
+	    nl = IM_LEN(in,2)
+	    IM_MIN(out) = MAX_REAL
+	    IM_MAX(out) = -MAX_REAL
+
+	    # Set star and seeing templates.
+	    mkt = mkt_star (Memc[star])
+
+	    # Read the object list.
+	    call malloc (mko, LEN_MKO, TY_STRUCT)
+	    fcmmts = false
+	    nobjects = 0
+	    while (fscan (i) != EOF) {
+		call gargr (x)
+		call gargr (y)
+		call gargr (z)
+		if (nscan() < 3) {
+		    fcmmts = true
+		    next
+		}
+		call gargwrd (Memc[type], SZ_FNAME)
+		call gargr (r)
+		call gargr (ar)
+		call gargr (pa)
+		call gargb (bsave)
+		x = xo + x / distance
+		y = yo + y / distance
+		if (x < 1 || x > nc || y < 1 || y > nl)
+		    next
+		if (nobjects == 0) {
+		    j = 100
+		    call malloc (MKO_MKT(mko), j, TY_POINTER)
+		    call malloc (MKO_X(mko), j, TY_REAL)
+		    call malloc (MKO_Y(mko), j, TY_REAL)
+		    call malloc (MKO_Z(mko), j, TY_REAL)
+		    call malloc (MKO_R(mko), j, TY_REAL)
+		    call malloc (MKO_AR(mko), j, TY_REAL)
+		    call malloc (MKO_PA(mko), j, TY_REAL)
+		    call malloc (MKO_SAVE(mko), j, TY_INT)
+		    call malloc (MKO_SORT(mko), j, TY_INT)
+		} else if (nobjects == j) {
+		    j = j + 100
+		    call realloc (MKO_MKT(mko), j, TY_POINTER)
+		    call realloc (MKO_X(mko), j, TY_REAL)
+		    call realloc (MKO_Y(mko), j, TY_REAL)
+		    call realloc (MKO_Z(mko), j, TY_REAL)
+		    call realloc (MKO_R(mko), j, TY_REAL)
+		    call realloc (MKO_AR(mko), j, TY_REAL)
+		    call realloc (MKO_PA(mko), j, TY_REAL)
+		    call realloc (MKO_SAVE(mko), j, TY_INT)
+		    call realloc (MKO_SORT(mko), j, TY_INT)
+		}
+
+		Memr[MKO_X(mko)+nobjects] = x
+		Memr[MKO_Y(mko)+nobjects] = y
+		Memr[MKO_Z(mko)+nobjects] =
+		    exptime / (distance * distance) * 10. ** (-0.4*(z-m0))
+		if (nscan() < 7)
+		    Memi[MKO_MKT(mko)+nobjects] = mkt_star (Memc[star])
+		else {
+		    Memi[MKO_MKT(mko)+nobjects] = mkt_object (Memc[type])
+		    Memr[MKO_R(mko)+nobjects] = r / distance
+		    Memr[MKO_AR(mko)+nobjects] = ar
+		    Memr[MKO_PA(mko)+nobjects] = DEGTORAD (pa)
+		    if (nscan() == 8)
+			Memi[MKO_SAVE(mko)+nobjects] = btoi (bsave)
+		    else
+			Memi[MKO_SAVE(mko)+nobjects] = NO
+		}
+		Memi[MKO_SORT(mko)+nobjects] = nobjects
+		nobjects = nobjects + 1
+	    }
+	    call close (i)
+
+	    # If no objects are requested then do the image I/O
+	    # line by line.  Add noise if creating a new image or
+	    # copy the input image if a new output image is desired.
+	    # Then go on to the next image.
+
+	    irbuf = 0
+	    ipbuf = 0
+	    if (nobjects == 0) {
+		call mfree (mko, TY_STRUCT)
+
+		if (new) {
+		    do i = 1, nl {
+			obuf = impl2r (out, i)
+			if (background == 0.)
+			    call aclrr (Memr[obuf], nc)
+			else
+			    call amovkr (background, Memr[obuf], nc)
+			if (poisson)
+			    call mkpnoise (Memr[obuf], Memr[obuf], nc, 0., gain,
+				pbuf, ranbuf, ipbuf, seed1)
+			if (rdnoise > 0.)
+			    call mkrnoise (Memr[obuf], nc, rdnoise,
+				rbuf, ranbuf, irbuf, seed1)
+			call alimr (Memr[obuf], nc, dmin, dmax)
+			IM_MIN(out) = min (IM_MIN(out), dmin)
+			IM_MAX(out) = max (IM_MAX(out), dmax)
+		    }
+		} else if (in != out) {
+		    do i = 1, nl {
+			obuf = impl2r (out, i)
+			call amovr (Memr[imgl2r(in,i)], Memr[obuf],
+			    IM_LEN(in,1))
+			call alimr (Memr[obuf], nc, dmin, dmax)
+			IM_MIN(out) = min (IM_MIN(out), dmin)
+			IM_MAX(out) = max (IM_MAX(out), dmax)
+		    }
+		}
+
+		# Add comment history of task parameters.
+		if (cmmts) {
+		    call strcpy ("# ", Memc[comment], LEN_COMMENT)
+		    call cnvtime (clktime (0), Memc[comment+2], LEN_COMMENT-2)
+		    call mkh_comment (out, Memc[comment])
+		    call mkh_comment (out, "begin        mkobjects")
+		    call mkh_comment (out, Memc[comment])
+		    call mkh_comment1 (out, "background", 'r')
+		    call mkh_comment1 (out, "xoffset", 'r')
+		    call mkh_comment1 (out, "yoffset", 'r')
+		    call mkh_comment1 (out, "distance", 'r')
+		    call mkh_comment1 (out, "exptime", 'r')
+		    call mkh_comment1 (out, "magzero", 'r')
+		    call mkh_comment1 (out, "gain", 'r')
+		    call mkh_comment1 (out, "rdnoise", 'r')
+		    call mkh_comment1 (out, "poisson", 'b')
+		    call mkh_comment1 (out, "seed", 'i')
+		}
+
+		IM_LIMTIME(out) = IM_MTIME(out) + 1
+		if (in != out)
+		    call imunmap (in)
+		call imunmap (out)
+		next
+	    }
+
+	    # Add the objects.
+	    #
+	    # The object list is first sorted in Y for efficiency.
+	    # Get buffer of as many lines as possible to minimize random
+	    # access and speed up adding the objects.  Ideally the whole
+	    # image should be in memory but if not we scroll a buffer
+	    # using the fact that the objects are ordered in Y.
+	    # Use error checking to determine how much memory is available.
+
+	    mko_sort = MKO_Y(mko)
+	    call qsort (Memi[MKO_SORT(mko)], nobjects, mko_compare)
+
+	    for (nlines=nl;; nlines = 0.8 * nlines)
+		ifnoerr (call malloc (buf, nlines * nc, TY_REAL))
+		    break
+	    call malloc (lines, nlines, TY_INT)
+	    call malloc (newlines, nl, TY_INT)
+	    call amovki (YES, Memi[newlines], nl)
+
+	    # Fill the line buffer.
+	    do l = 1, nlines {
+		j = mod (l, nlines) 
+		ptr2 = buf + j * nc
+		Memi[lines+j] = l
+		if (new)
+		    call aclrr (Memr[ptr2], nc)
+		else
+		    call amovr (Memr[imgl2r(in,l)], Memr[ptr2], nc) 
+		Memi[newlines+l-1] = NO
+	    }
+		
+	    # Generate the object subrasters, add noise if needed, and
+	    # add the data to the line buffer.  Check for parts of the
+	    # object off the image (the object center is guarenteed to
+	    # be on the image).  Do image I/O if needed.
+
+	    do i = 0, nobjects-1 {
+		j = Memi[MKO_SORT(mko)+i]
+		mkt = Memi[MKO_MKT(mko)+j]
+		if (mkt == NULL)
+		    next
+		x = Memr[MKO_X(mko)+j]
+		y = Memr[MKO_Y(mko)+j]
+		z = Memr[MKO_Z(mko)+j]
+		r = Memr[MKO_R(mko)+j]
+		ar = Memr[MKO_AR(mko)+j]
+		pa = Memr[MKO_PA(mko)+j]
+		save = Memi[MKO_SAVE(mko)+j]
+
+		call mkt_gobject (mkt, obj, nx, ny, x, y, z, r, ar, pa, save)
+
+		c1 = nint (x) - nx/2
+		c2 = c1 + nx - 1
+		c3 = max (1, c1)
+		c4 = min (nc, c2)
+		l1 = nint (y) - ny/2
+		l2 = l1 + ny - 1
+		l3 = max (1, l1)
+		l4 = min (nl, l2)
+		k = c4 - c3 + 1 
+		ptr1 = obj + (l3 - l1) * nx + c3 - c1
+		c3 = c3 - 1
+		do l = l3, l4 {
+		    j = mod (l, nlines)
+		    if (l != Memi[lines+j]) {
+			ptr2 = buf + j * nc
+			obuf = impl2r (out, Memi[lines+j])
+			call amovr (Memr[ptr2], Memr[obuf], nc)
+			call alimr (Memr[obuf], nc, dmin, dmax)
+			IM_MIN(out) = min (IM_MIN(out), dmin)
+			IM_MAX(out) = max (IM_MAX(out), dmax)
+			Memi[lines+j] = l
+			if (Memi[newlines+l-1] == NO)
+			    call amovr (Memr[imgl2r(out,l)], Memr[ptr2], nc)
+			else if (new)
+			    call aclrr (Memr[ptr2], nc)
+			else
+			    call amovr (Memr[imgl2r(in,l)], Memr[ptr2], nc)
+			Memi[newlines+l-1] = NO
+		    }
+		    ptr2 = buf + j * nc + c3
+		    call aaddr (Memr[ptr1], Memr[ptr2], Memr[ptr2], k)
+		    if (!new) {
+		        if (poisson)
+			    call mkpnoise (Memr[ptr1], Memr[ptr2], k,
+				background, gain, pbuf, ranbuf, ipbuf, seed1)
+		        if (rdnoise > 0.)
+			    call mkrnoise (Memr[ptr2], k,
+				rdnoise, rbuf, ranbuf, irbuf, seed1)
+		    }
+		    ptr1 = ptr1 + nx
+		}
+	    }
+
+	    # Flush out the line buffer.  A new image requires addition of
+	    # background and noise.  If the whole image is in memory then
+	    # we can add the background and noise before flushing the data.
+	    # Otherwise, we need a second pass reading the image in line
+	    # by line and adding the background and noise.  Note that if
+	    # the image was not new then noise was added only to the
+	    # objects.
+	    
+	    if (nlines == nl) {
+		do i = 1, nlines {
+		    j = mod (i, nlines) 
+		    ptr2 = buf + j * nc
+		    l = Memi[lines+j]
+		    if (new) {
+			if (background != 0.)
+			    call aaddkr (Memr[ptr2], background, Memr[ptr2], nc)
+			if (poisson)
+			    call mkpnoise (Memr[ptr2], Memr[ptr2], nc, 0., gain,
+				pbuf, ranbuf, ipbuf, seed1)
+			if (rdnoise > 0.)
+			    call mkrnoise (Memr[ptr2], nc, rdnoise,
+				rbuf, ranbuf, irbuf, seed1)
+		    }
+		    obuf = impl2r (out, l)
+		    call amovr (Memr[ptr2], Memr[obuf], nc) 
+		    call alimr (Memr[obuf], nc, dmin, dmax)
+		    IM_MIN(out) = min (IM_MIN(out), dmin)
+		    IM_MAX(out) = max (IM_MAX(out), dmax)
+		}
+	    } else {
+		do i = 1, nlines {
+		    j = mod (i, nlines) 
+		    ptr2 = buf + j * nc
+		    l = Memi[lines+j]
+		    obuf = impl2r (out, l)
+		    call amovr (Memr[ptr2], Memr[obuf], nc) 
+		    call alimr (Memr[obuf], nc, dmin, dmax)
+		    IM_MIN(out) = min (IM_MIN(out), dmin)
+		    IM_MAX(out) = max (IM_MAX(out), dmax)
+		}
+
+		if (new) {
+		    call imflush (out)
+		    do i = 1, nl {
+			obuf = impl2r (out, i)
+			ptr1 = imgl2r (out, i)
+			if (background == 0.)
+			    call amovr (Memr[ptr1], Memr[obuf], nc)
+			else
+			    call aaddkr (Memr[ptr1], background, Memr[obuf], nc)
+			if (poisson)
+			    call mkpnoise (Memr[obuf], Memr[obuf], nc, 0., gain,
+				pbuf, ranbuf, ipbuf, seed1)
+			if (rdnoise > 0.)
+			    call mkrnoise (Memr[obuf], nc, rdnoise,
+				rbuf, ranbuf, irbuf, seed1)
+			call alimr (Memr[obuf], nc, dmin, dmax)
+			IM_MIN(out) = min (IM_MIN(out), dmin)
+			IM_MAX(out) = max (IM_MAX(out), dmax)
+		    }
+		}
+	    }
+
+	    # Since each image is different and the object lists may be
+	    # different we free most of the memory within the image list
+	    # loop.
+
+	    call mfree (buf, TY_REAL)
+	    call mfree (lines, TY_INT)
+	    call mfree (newlines, TY_INT)
+	    call mfree (MKO_MKT(mko), TY_POINTER)
+	    call mfree (MKO_X(mko), TY_REAL)
+	    call mfree (MKO_Y(mko), TY_REAL)
+	    call mfree (MKO_Z(mko), TY_REAL)
+	    call mfree (MKO_R(mko), TY_REAL)
+	    call mfree (MKO_AR(mko), TY_REAL)
+	    call mfree (MKO_PA(mko), TY_REAL)
+	    call mfree (MKO_SAVE(mko), TY_INT)
+	    call mfree (MKO_SORT(mko), TY_INT)
+	    call mfree (mko, TY_STRUCT)
+
+	    # Add comment history of task parameters.
+	    if (cmmts) {
+		call strcpy ("# ", Memc[comment], LEN_COMMENT)
+		call cnvtime (clktime (0), Memc[comment+2], LEN_COMMENT-2)
+		call mkh_comment (out, Memc[comment])
+		call mkh_comment (out, "begin        mkobjects")
+		call sprintf (Memc[comment], LEN_COMMENT, "%9t%s%24t%s")
+		    call pargstr ("objects")
+		    call pargstr (Memc[fname])
+		call mkh_comment (out, Memc[comment])
+		call mkh_comment1 (out, "background", 'r')
+		call mkh_comment1 (out, "xoffset", 'r')
+		call mkh_comment1 (out, "yoffset", 'r')
+		call mkh_comment1 (out, "star", 's')
+		call mkh_comment1 (out, "radius", 'r')
+		call mkh_comment1 (out, "beta", 'r')
+		call mkh_comment1 (out, "ar", 'r')
+		call mkh_comment1 (out, "pa", 'r')
+		call mkh_comment1 (out, "distance", 'r')
+		call mkh_comment1 (out, "exptime", 'r')
+		call mkh_comment1 (out, "magzero", 'r')
+		call mkh_comment1 (out, "gain", 'r')
+		call mkh_comment1 (out, "rdnoise", 'r')
+		call mkh_comment1 (out, "poisson", 'b')
+		call mkh_comment1 (out, "seed", 'i')
+		if (fcmmts) {
+		    i = open (Memc[fname], READ_ONLY, TEXT_FILE)
+		    while (fscan (i) != EOF) {
+			call gargr (x)
+			call gargr (y)
+			call gargr (z)
+			if (nscan() < 3) {
+			    call reset_scan ()
+			    call gargstr (Memc[comment], LEN_COMMENT)
+			    call mkh_comment (out, Memc[comment])
+			}
+		    }
+		    call close (i)
+		}
+	    }
+
+	    IM_LIMTIME(out) = IM_MTIME(out) + 1
+	    if (in != out)
+		call imunmap (in)
+	    call imunmap (out)
+
+	}
+
+	call mkt_free ()
+	call imtclose (ilist)
+	call imtclose (olist)
+	call sfree (sp)
+end
+
+
+# MKO_COMPARE -- Compare two values in the mko_sort array.
+
+int procedure mko_compare (i, j)
+
+int	i, j		# Array indices to be compared.
+
+pointer	mko_sort
+common	/mko_qsort/ mko_sort
+
+begin
+	if (Memr[mko_sort+i] < Memr[mko_sort+j])
+	    return (-1)
+	else if (Memr[mko_sort+i] > Memr[mko_sort+j])
+	    return (1)
+	else
+	    return (0)
+end
diff --git a/noao/artdata/t_mkpattern.x b/noao/artdata/t_mkpattern.x
new file mode 100644
index 00000000..08b1973b
--- /dev/null
+++ b/noao/artdata/t_mkpattern.x
@@ -0,0 +1,318 @@
+include	<error.h>
+include	<imhdr.h>
+
+define	LEN_UA		20000
+
+# Editing  options
+define	OPTIONS		"|replace|add|multiply|"
+define	REPLACE		1	# Replace pixels
+define	ADD		2	# Add to pixels
+define	MULTIPLY	3	# Multiply pixels
+
+# Patterns
+define	PATTERNS	"|constant|grid|checker|coordinates|slope|square"
+define	CONST		1	# Constant = v1
+define	GRID		2	# Grid lines of v2 with given spacing
+define	CHECK		3	# Checkboard of given size
+define	COORD		4	# Coordinates
+define	SLOPE		5	# Slope
+define	SQUARE		6	# Square root checkerboard
+
+# T_MKPATTERN -- Create or modify images using simple patterns.
+# Images may be created of a specified size, dimensionality, and pixel
+# datatype.  The images may be modified to replace, add, or multiply
+# by specified values.  The patterns include a constant value,
+# a grid, a checkerboard or fixed size or increasing size, the
+# 1D pixel coordinate, and a slope.  For dimensions greater than
+# 2 the 2D pattern is repeated.
+
+procedure t_mkpattern ()
+
+
+int	ilist				# Input image list
+int	olist				# Output image list
+int	op				# Operation option
+int	pat				# Pattern
+real	v1				# Pattern value 1
+real	v2				# Pattern value 2
+int	size				# Pattern size
+int	nl				# Number of lines
+int	nc				# Number of columns
+
+bool	new
+int	i
+long	vin[IM_MAXDIM], vout[IM_MAXDIM]
+pointer	sp, input, output, header, in, out, indata, outdata, pat1, pat2
+
+char	clgetc()
+bool	streq()
+int	clgwrd(), clgeti()
+int	imtopenp(), imtlen(), imtgetim(), imgnlr(), impnlr()
+real	clgetr()
+pointer	immap()
+errchk	immap
+
+begin
+	call smark (sp)
+	call salloc (input, SZ_FNAME, TY_CHAR)
+	call salloc (output, SZ_FNAME, TY_CHAR)
+	call salloc (header, SZ_FNAME, TY_CHAR)
+
+	# Set the task parameters which apply to all images.
+	ilist = imtopenp ("input")
+	olist = imtopenp ("output")
+	pat = clgwrd ("pattern", Memc[input], SZ_FNAME, PATTERNS)
+	op = clgwrd ("option", Memc[input], SZ_FNAME, OPTIONS)
+	v1 = clgetr ("v1")
+	v2 = clgetr ("v2")
+	size = max (1, clgeti ("size"))
+
+	if (max (1, imtlen (olist)) != imtlen (ilist))
+	    call error (1, "Output image list does not match input image list")
+
+	# Loop over the input image lists.  If no output list is given
+	# then create or modify the input image.
+
+	while (imtgetim (ilist, Memc[input], SZ_FNAME) != EOF) {
+	    if (imtgetim (olist, Memc[output], SZ_FNAME) == EOF)
+	        call strcpy (Memc[input], Memc[output], SZ_FNAME)
+
+	    # Map images.  Check for new, existing, and inplace images.
+	    if (streq (Memc[input], Memc[output])) {
+		ifnoerr (out = immap (Memc[output], READ_WRITE, 0)) {
+		    in = out
+	            new = false
+	        } else {
+		    iferr (out = immap (Memc[output], NEW_IMAGE, LEN_UA)) {
+			call erract (EA_WARN)
+			next
+		    }
+
+		    call clgstr ("header", Memc[header], SZ_FNAME)
+		    iferr (call mkh_header (out, Memc[header], false, false))
+			call erract (EA_WARN)
+
+	            IM_NDIM(out) = clgeti ("ndim")
+		    IM_LEN(out,1) = clgeti ("ncols")
+		    IM_LEN(out,2) = clgeti ("nlines")
+		    IM_LEN(out,3) = clgeti ("n3")
+		    IM_LEN(out,4) = clgeti ("n4")
+		    IM_LEN(out,5) = clgeti ("n5")
+		    IM_LEN(out,6) = clgeti ("n6")
+		    IM_LEN(out,7) = clgeti ("n7")
+		    switch (clgetc ("pixtype")) {
+		    case 'u':
+		        IM_PIXTYPE(out) = TY_USHORT
+		    case 's':
+		        IM_PIXTYPE(out) = TY_SHORT
+		    case 'i':
+		        IM_PIXTYPE(out) = TY_INT
+		    case 'l':
+		        IM_PIXTYPE(out) = TY_LONG
+		    case 'r':
+		        IM_PIXTYPE(out) = TY_REAL
+		    case 'd':
+		        IM_PIXTYPE(out) = TY_DOUBLE
+		    case 'c':
+		        IM_PIXTYPE(out) = TY_COMPLEX
+		    default:
+			call error (0, "Bad pixel type")
+		    }
+		    call clgstr ("title", IM_TITLE(out), SZ_IMTITLE)
+		    in = out
+	            new = true
+	        }
+	    } else {
+	        iferr (in = immap (Memc[input], READ_ONLY, 0)) {
+		    call erract (EA_WARN)
+		    next
+		}
+	        iferr (out = immap (Memc[output], NEW_COPY, in)) {
+		    call erract (EA_WARN)
+		    call imunmap (in)
+		    next
+		}
+	        new = false
+	    }
+	    nc = IM_LEN(out,1)
+	    nl = IM_LEN(out,2)
+
+	    call amovkl (long (1), vin, IM_MAXDIM)
+	    call amovkl (long (1), vout, IM_MAXDIM)
+
+	    # Initialize the pattern; two pointers are returned.
+	    call mkpatinit (pat, size, v1, v2, pat1, pat2, nc, nl)
+
+	    # Create or modify the image with the specified pattern.
+	    # A new image is always the same as replace.
+
+	    if (new) {
+	        while (impnlr (out, outdata, vout) != EOF)
+		    call mkpattern (pat, size, v1, v2, pat1, pat2,
+			vout[2]-1, outdata, nc, nl)
+	    } else {
+	        switch (op) {
+	        case REPLACE:
+	            while (impnlr (out, outdata, vout) != EOF)
+		        call mkpattern (pat, size, v1, v2, pat1, pat2,
+			    vout[2]-1, outdata, nc, nl)
+	        case ADD:
+	            while (impnlr (out, outdata, vout) != EOF) {
+		        i = imgnlr (in, indata, vin)
+		        call mkpattern (pat, size, v1, v2, pat1, pat2,
+			    vout[2]-1, outdata, nc, nl)
+		        call aaddr (Memr[indata], Memr[outdata], Memr[outdata],
+			    nc)
+	            }
+	        case MULTIPLY:
+	            while (impnlr (out, outdata, vout) != EOF) {
+		        i = imgnlr (in, indata, vin)
+		        call mkpattern (pat, size, v1, v2, pat1, pat2,
+			    vout[2]-1, outdata, nc, nl)
+		        call amulr (Memr[indata], Memr[outdata], Memr[outdata],
+			    nc)
+	            }
+	        }
+	    }
+
+	    call mkpatfree (pat1, pat2)
+	    if (in != out)
+	        call imunmap (in)
+	    call imunmap (out)
+	}
+
+	call imtclose (ilist)
+	call imtclose (olist)
+	call sfree (sp)
+end
+
+
+# MKPATINIT -- Initialize the pattern.  For speed one or two lines of the
+# pattern are created and then used over the image by simple array
+# operations.
+
+procedure mkpatinit (pat, size, v1, v2, pat1, pat2, nc, nl)
+
+int	pat		# Pattern
+int	size		# Pattern size
+real	v1		# Value 1 for pattern
+real	v2		# Value 2 for pattern
+pointer	pat1		# Pattern 1 buffer
+pointer	pat2		# Pattern 2 buffer
+int	nc		# Number of columns
+int	nl		# Number of lines
+
+int	i
+
+begin
+	pat1 = NULL
+	pat2 = NULL
+
+	switch (pat) {
+	case CONST:
+	    call malloc (pat1, nc, TY_REAL)
+	    call amovkr (v1, Memr[pat1], nc)
+	case GRID:
+	    call malloc (pat1, nc, TY_REAL)
+	    call malloc (pat2, nc, TY_REAL)
+	    call amovkr (v1, Memr[pat1], nc)
+	    call amovkr (v2, Memr[pat2], nc)
+	    size = max (size, 2)
+	    do i = 1, nc-1, size
+		Memr[pat1+i] = v2
+	case CHECK:
+	    call malloc (pat1, nc, TY_REAL)
+	    call malloc (pat2, nc, TY_REAL)
+	    do i = 0, nc-1 {
+		if (mod (i/size, 2) == 0) {
+		    Memr[pat1+i] = v1
+		    Memr[pat2+i] = v2
+		} else {
+		    Memr[pat1+i] = v2
+		    Memr[pat2+i] = v1
+		}
+	    }
+	case COORD:
+	    call malloc (pat1, nc, TY_REAL)
+	    do i = 0, nc-1
+		Memr[pat1+i] = i / size + 1
+	case SLOPE:
+	    call malloc (pat1, nc, TY_REAL)
+	    call malloc (pat2, 1, TY_REAL)
+	    Memr[pat2] = (v2 - v1) / ((nc + nl - 2) / size)
+	    do i = 0, nc - 1
+		Memr[pat1+i] = v1 + Memr[pat2] * i / size
+	case SQUARE:
+	    call malloc (pat1, nc, TY_REAL)
+	    call malloc (pat2, nc, TY_REAL)
+	    do i = 0, nc-1 {
+		if (mod (int (sqrt (real (i/size))), 2) == 0) {
+		    Memr[pat1+i] = v1
+		    Memr[pat2+i] = v2
+		} else {
+		    Memr[pat1+i] = v2
+		    Memr[pat2+i] = v1
+		}
+	    }
+	}
+end
+
+
+# MKPATFREE -- Free memory used in the pattern buffers.
+
+procedure mkpatfree (pat1, pat2)
+
+pointer	pat1, pat2	# Pattern buffers
+
+begin
+	call mfree (pat1, TY_REAL)
+	call mfree (pat2, TY_REAL)
+end
+
+
+# MKPATTERN -- Make a line of data.
+
+procedure mkpattern (pat, size, v1, v2, pat1, pat2, line, data, nc, nl)
+
+int	pat		# Pattern
+int	size		# Pattern size
+real	v1		# Pattern value
+real	v2		# Pattern value
+pointer	pat1		# Pattern 1
+pointer	pat2		# Pattern 2
+int	line		# Line
+pointer	data		# Data
+int	nc		# Number of columns
+int	nl		# Number of lines
+
+int	i
+
+begin
+	i = max (0, line-1) / size
+
+	switch (pat) {
+	case CONST:
+	    call amovr (Memr[pat1], Memr[data], nc)
+	case GRID:
+	    if (mod (line, size) == 1)
+	        call amovr (Memr[pat2], Memr[data], nc)
+	    else
+	        call amovr (Memr[pat1], Memr[data], nc)
+	case CHECK:
+	    if (mod (i, 2) == 0)
+	        call amovr (Memr[pat1], Memr[data], nc)
+	    else
+	        call amovr (Memr[pat2], Memr[data], nc)
+	case COORD:
+	    call amovr (Memr[pat1], Memr[data], nc)
+	    call aaddkr (Memr[data], real(i*nc/size), Memr[data], nc)
+	case SLOPE:
+	    call amovr (Memr[pat1], Memr[data], nc)
+	    call aaddkr (Memr[data], i*Memr[pat2], Memr[data], nc)
+	case SQUARE:
+	    if (mod (int (sqrt (real (i))), 2) == 0)
+	        call amovr (Memr[pat1], Memr[data], nc)
+	    else
+	        call amovr (Memr[pat2], Memr[data], nc)
+	}
+end
diff --git a/noao/artdata/voigt.x b/noao/artdata/voigt.x
new file mode 100644
index 00000000..08a44c78
--- /dev/null
+++ b/noao/artdata/voigt.x
@@ -0,0 +1,71 @@
+# VOIGT -- Compute the real (Voigt function) and imaginary parts of the
+# complex function w(z)=exp(-z**2)*erfc(-i*z) in the upper half-plane
+# z=x+iy.  The maximum relative error of the real part is 2E-6 and the
+# imaginary part is 5E-6.
+#
+# From: Humlicek, J. Quant. Spectrosc. Radiat. Transfer, V21, p309, 1979.
+
+procedure voigt (xarg, yarg, wr, wi)
+
+real	xarg		#I Real part of argument
+real	yarg		#I Imaginary part of argument
+real	wr		#O Real part of function
+real	wi		#O Imaginary part of function
+
+int	i
+real	x, y, y1, y2, y3, d, d1, d2, d3, d4, r, r2
+real	t[6], c[6], s[6]
+
+data	t/.314240376,.947788391,1.59768264,2.27950708,3.02063703,3.8897249/
+data	c/1.01172805,-.75197147,1.2557727e-2,1.00220082e-2,-2.42068135e-4,
+	  5.00848061e-7/
+data	s/1.393237,.231152406,-.155351466,6.21836624e-3,9.19082986e-5,
+	  -6.27525958e-7/
+
+begin
+	x = xarg
+	y = abs (yarg)
+	wr = 0.
+	wi = 0.
+	y1 = y + 1.5
+	y2 = y1 * y1
+
+	# Region II
+	if (y < 0.85 && abs(x) > 18.1*y+1.65) {
+	    if (abs(x) < 12)
+		wr = exp (-x * x)
+	    y3 = y + 3
+	    do i = 1, 6 {
+		r = x - t[i]
+		r2 = r * r
+		d = 1 / (r2 + y2)
+		d1 = y1 * d
+		d2 = r * d
+		wr = wr + y * (c[i] * (r * d2 - 1.5 * d1) + s[i] * y3 * d2) /
+		    (r2 + 2.25)
+		r = x + t[i]
+		r2 = r * r
+		d = 1 / (r2 + y2)
+		d3 = y1 * d
+		d4 = r * d
+		wr = wr + y * (c[i] * (r * d4 - 1.5 * d3) - s[i] * y3 * d4) /
+		    (r2 + 2.25)
+		wi = wi + c[i] * (d2 + d4) + s[i] * (d1 - d3)
+	    }
+
+	# Region I
+	} else {
+	    do i = 1, 6 {
+		r = x - t[i]
+		d = 1 / (r * r + y2)
+		d1 = y1 * d
+		d2 = r * d
+		r = x + t[i]
+		d = 1 / (r * r + y2)
+		d3 = y1 * d
+		d4 = r * d
+		wr = wr + c[i] * (d1 + d3) - s[i] * (d2 - d4)
+		wi = wi + c[i] * (d2 + d4) + s[i] * (d1 - d3)
+	    }
+	}
+end
diff --git a/noao/artdata/x_artdata.x b/noao/artdata/x_artdata.x
new file mode 100644
index 00000000..2429722a
--- /dev/null
+++ b/noao/artdata/x_artdata.x
@@ -0,0 +1,9 @@
+task	mk1dspec	= t_mk1dspec,
+	mk2dspec	= t_mk2dspec,
+	mkechelle	= t_mkechelle,
+	mkheader	= t_mkheader,
+	mknoise		= t_mknoise,
+	mkobjects	= t_mkobjects,
+	mkpattern	= t_mkpattern,
+	starlist	= t_starlist,
+	gallist		= t_gallist