Initial commit

15 files changed, 862 insertions, 0 deletions

diff --git a/sys/imfort/tasks/README b/sys/imfort/tasks/README
new file mode 100644
index 00000000..9eb3e075
--- /dev/null
+++ b/sys/imfort/tasks/README
@@ -0,0 +1,20 @@
+IMIO$IMFORT/ZZDEBUG -
+
+    This directory contains a set of Fortran programs used to test the IMFORT
+software, and to provide real working examples illustrating the use of the
+IMFORT interface in host Fortran programs.
+
+	hello.f		prints `hello, world!'
+	imcopy.f	copy an image
+	imdel.f		delete an image
+	imren.f		rename an image
+	keyw.f		test header keyword access
+	minmax.f	update datamin, datamax
+	mkim.f		make a test image, pix[i,j] = j * 100 + i
+	pcube.f		print a subraster, e.g., of a MKIM test image
+	phead.f		print an image header in FITS format
+	planck.f	compute the planck function
+	readim.f	test sequential read through an image
+
+To compile individual programs:		cl> fc prog.f
+To define the tasks to the CL:		cl> cl < tasks.cl (edit tasks.cl first)
diff --git a/sys/imfort/tasks/args.f b/sys/imfort/tasks/args.f
new file mode 100644
index 00000000..b484c4cd
--- /dev/null
+++ b/sys/imfort/tasks/args.f
@@ -0,0 +1,33 @@
+c ARGS -- Test the command line argument interface.
+c
+c	usage:  args [arg1 [arg2 ...]]
+c ------------------------------------------------------------------------
+
+	program args
+
+	character*80	argstr
+	integer		nargs, ier, i
+
+c --- Test raw command line access.
+	call clrawc (argstr, ier)
+	if (ier .ne. 0) then
+	    write (*, '('' clrawc returns status '', i3)') ier
+	else
+	    write (*, '('' clrawc: '', a80)') argstr
+	endif
+
+c --- Test parsed command line access.
+	call clnarg (nargs)
+	write (*, '('' nargs = '', i3)') nargs
+
+	do 10 i = 1, nargs
+	    call clargc (i, argstr, ier)
+	    if (ier .ne. 0) then
+		write (*, '('' unexpected error '', i3)') ier
+	    else
+		write (*, '(i4, 2x, a70)') i, argstr
+	    endif
+ 10	continue
+
+	stop
+	end
diff --git a/sys/imfort/tasks/hello.f b/sys/imfort/tasks/hello.f
new file mode 100644
index 00000000..f1649f31
--- /dev/null
+++ b/sys/imfort/tasks/hello.f
@@ -0,0 +1,6 @@
+c HELLO -- Sample Fortran program to demonstate compile/link.
+
+	program hello
+	write (*,*) 'hello, world!'
+	stop
+	end
diff --git a/sys/imfort/tasks/imcopy.f b/sys/imfort/tasks/imcopy.f
new file mode 100644
index 00000000..c81f5f05
--- /dev/null
+++ b/sys/imfort/tasks/imcopy.f
@@ -0,0 +1,81 @@
+c IMCOPY -- Copy an image of up to 2048 pixels per line.  Works for images of
+c up to three dimensions with a pixel type of either short or real.
+c
+c	usage:  imcopy oldimage newimage
+c ----------------------------------------------------------------------------
+
+	program imcopy
+
+	real		rpix(2048)
+	integer*2	spix(4096)
+	equivalence	(rpix, spix)
+	character*80	oimage, nimage, errmsg
+	integer		ncols, nlines, nbands, j, k, oim, nim
+	integer		ier, axlen(7), naxis, pixtype, nargs
+
+c --- Get command line arguments.
+	call clnarg (nargs)
+	if (nargs .eq. 2) then
+	    call clargc (1, oimage, ier)
+	    if (ier .ne. 0) goto 91
+	    call clargc (2, nimage, ier)
+	    if (ier .ne. 0) goto 91
+	else
+	    write (*, '('' input image: '',$)')
+	    read (*,*) oimage
+	    write (*, '('' output image: '',$)')
+	    read (*,*) nimage
+	endif
+
+c --- Open the input image.
+	call imopen (oimage, 1, oim, ier)
+	if (ier .ne. 0) goto 91
+
+c --- Create a new output image with the same header and size as the
+c	input image.
+
+	call imopnc (nimage, oim, nim, ier)
+	if (ier .ne. 0) goto 91
+
+c --- Determine the size and pixel type of the image being copied.
+	call imgsiz (oim, axlen, naxis, pixtype, ier)
+	if (ier .ne. 0) goto 91
+	ncols  = axlen(1)
+	nlines = axlen(2)
+	nbands = axlen(3)
+
+c --- Copy the image.
+	if (pixtype .eq. 3) then
+	    do 15 k = 1, nbands
+		do 10 j = 1, nlines
+		    call imgl3s (oim, spix, j, k, ier)
+		    if (ier .ne. 0) goto 91
+		    call impl3s (nim, spix, j, k, ier)
+		    if (ier .ne. 0) goto 91
+ 10	        continue
+ 15	    continue
+	else
+	    do 25 k = 1, nbands
+		do 20 j = 1, nlines
+		    call imgl3r (oim, rpix, j, k, ier)
+		    if (ier .ne. 0) goto 91
+		    call impl3r (nim, rpix, j, k, ier)
+		    if (ier .ne. 0) goto 91
+ 20	        continue
+ 25	    continue
+	endif
+
+c --- Clean up.
+	call imclos (oim, ier)
+	if (ier .ne. 0) goto 91
+	call imclos (nim, ier)
+	if (ier .ne. 0) goto 91
+
+	stop
+
+c -- Error actions.
+ 91	call imemsg (ier, errmsg)
+	write (*, '('' Error: '', a80)') errmsg
+
+	stop
+	end
diff --git a/sys/imfort/tasks/imdel.f b/sys/imfort/tasks/imdel.f
new file mode 100644
index 00000000..d7b65ab9
--- /dev/null
+++ b/sys/imfort/tasks/imdel.f
@@ -0,0 +1,29 @@
+c IMDEL -- Delete an image.
+c
+c	usage:  imdel imagename
+c ----------------------------------------------------------------------
+
+	program imdel
+
+	integer		ier
+	character*80	image, errmsg
+
+c --- Get the name of the image to be deleted.
+	call clargc (1, image, ier)
+	if (ier .ne. 0) then
+	    write (*, '('' enter image name: '',$)')
+	    read (*,*) image
+	endif
+
+c --- Delete the image.
+	call imdele (image, ier)
+	if (ier .ne. 0) goto 91
+
+	stop
+
+c --- Error exit.
+ 91	call imemsg (ier, errmsg)
+	write (*, '('' Error: '', a80)') errmsg
+
+	stop
+	end
diff --git a/sys/imfort/tasks/imren.f b/sys/imfort/tasks/imren.f
new file mode 100644
index 00000000..ea70a1e4
--- /dev/null
+++ b/sys/imfort/tasks/imren.f
@@ -0,0 +1,36 @@
+c IMREN -- Rename an image.
+c
+c	usage:  imren oldname newname
+c ----------------------------------------------------------------------
+
+	program imren
+
+	integer		nargs, ier
+	character*80	oname, nname, errmsg
+
+c --- Get the old and new names of the image to be renamed.
+	call clnarg (nargs)
+	if (nargs .ge. 2) then
+	    call clargc (1, oname, ier)
+	    if (ier .ne. 0) goto 91
+	    call clargc (2, nname, ier)
+	    if (ier .ne. 0) goto 91
+	else
+	    write (*, '('' enter old image name: '',$)')
+	    read (*,*) oname
+	    write (*, '('' enter new image name: '',$)')
+	    read (*,*) nname
+	endif
+
+c --- Rename the image.
+	call imrnam (oname, nname, ier)
+	if (ier .ne. 0) goto 91
+
+	stop
+
+c --- Error exit.
+ 91	call imemsg (ier, errmsg)
+	write (*, '('' Error: '', a80)') errmsg
+
+	stop
+	end
diff --git a/sys/imfort/tasks/keyw.f b/sys/imfort/tasks/keyw.f
new file mode 100644
index 00000000..ee235f51
--- /dev/null
+++ b/sys/imfort/tasks/keyw.f
@@ -0,0 +1,116 @@
+c KEYW -- Test the image header get/put interface routines.
+c
+c	usage:  keyw imagename
+c ----------------------------------------------------------------------------
+
+	program keyw
+
+	character*80	image, errmsg
+	character*8	keywrd, option
+	character*80	valstr, commnt
+	integer		ncols, nlines, dtype
+	integer		im, ier, axlen(7), naxis
+
+c --- Get image name.
+	call clargc (1, image, ier)
+	if (ier .ne. 0) then
+	    write (*, '('' enter image name: '',$)')
+	    read (*,*) image
+	endif
+
+c --- Open the image.
+	call imopen (image, 3, im, ier)
+	if (ier .ne. 0) goto 91
+	call imgsiz (im, axlen, naxis, dtype, ier)
+	if (ier .ne. 0) goto 91
+
+	ncols  = axlen(1)
+	nlines = axlen(2)
+
+c --- Interpreter loop.
+ 10	continue
+	write (*, '('' enter command (quit,gkw[cir],pkw[cir],addk,delk): '',$)')
+	read (*,*) option
+
+	if (option .eq. 'pkwc') then
+	    write (*, '('' keyword name: '',$)')
+	    read (*,*) keywrd
+	    write (*, '('' value: '',$)')
+	    read (*,*) valstr
+	    call impkwc (im, keywrd, valstr, ier)
+	    if (ier .ne. 0) goto 91
+	    goto 10
+
+	else if (option .eq. 'pkwi') then
+	    write (*, '('' keyword name: '',$)')
+	    read (*,*) keywrd
+	    write (*, '('' value: '',$)')
+	    read (*,*) ival
+	    call impkwi (im, keywrd, ival, ier)
+	    if (ier .ne. 0) goto 91
+	    goto 10
+
+	else if (option .eq. 'pkwr') then
+	    write (*, '('' keyword name: '',$)')
+	    read (*,*) keywrd
+	    write (*, '('' value: '',$)')
+	    read (*,*) rval
+	    call impkwr (im, keywrd, rval, ier)
+	    if (ier .ne. 0) goto 91
+	    goto 10
+
+	else if (option .eq. 'gkwc') then
+	    write (*, '('' keyword name: '',$)')
+	    read (*,*) keywrd
+	    call imgkwc (im, keywrd, valstr, ier)
+	    if (ier .ne. 0) goto 91
+	    write (*,*) 'value ', valstr
+	    goto 10
+
+	else if (option .eq. 'gkwi') then
+	    write (*, '('' keyword name: '',$)')
+	    read (*,*) keywrd
+	    call imgkwi (im, keywrd, ival, ier)
+	    if (ier .ne. 0) goto 91
+	    write (*,*) 'value ', ival
+	    goto 10
+
+	else if (option .eq. 'gkwr') then
+	    write (*, '('' keyword name: '',$)')
+	    read (*,*) keywrd
+	    call imgkwr (im, keywrd, rval, ier)
+	    if (ier .ne. 0) goto 91
+	    write (*,*) 'value ', rval
+	    goto 10
+
+	else if (option .eq. 'addk') then
+	    write (*, '('' keyword name: '',$)')
+	    read (*,*) keywrd
+	    write (*, '('' keyword datatype: '',$)')
+	    read (*,*) dtype
+	    write (*, '('' comment field: '',$)')
+	    read (*,*) commnt
+	    call imaddk (im, keywrd, dtype, commnt, ier)
+	    if (ier .ne. 0) goto 91
+	    write (*,*) 'value ', rval
+	    goto 10
+
+	else if (option .eq. 'delk') then
+	    write (*, '('' keyword name: '',$)')
+	    read (*,*) keywrd
+	    call imdelk (im, keywrd, ier)
+	    if (ier .ne. 0) goto 91
+	    goto 10
+
+	endif
+
+c --- Clean up.
+	call imclos (im, ier)
+	if (ier .ne. 0) goto 91
+
+	stop
+ 91	call imemsg (ier, errmsg)
+	write (*, '('' Error: '', a80)') errmsg
+
+	stop
+	end
diff --git a/sys/imfort/tasks/minmax.f b/sys/imfort/tasks/minmax.f
new file mode 100644
index 00000000..34edaea5
--- /dev/null
+++ b/sys/imfort/tasks/minmax.f
@@ -0,0 +1,56 @@
+c MINMAX -- Compute the minimum and maximum pixel values in an image.
+c The new values are printed as well as updated in the image header.
+c
+c	usage:  minmax image
+c ----------------------------------------------------------------------
+
+	program minmax
+
+	character*80	image, errmsg
+	real		pix(8192), dmin, dmax, vmin, vmax
+	integer		im, axlen(7), naxis, dtype, ier, j
+
+c --- Get image name.
+	call clargc (1, image, ier)
+	if (ier .ne. 0) then
+	    write (*, '('' enter image name: '',$)')
+	    read (*,*) image
+	endif
+
+c --- Open the image for readwrite access (we need to update the header).
+	call imopen (image, 3, im, ier)
+	if (ier .ne. 0) goto 91
+	call imgsiz (im, axlen, naxis, dtype, ier)
+	if (ier .ne. 0) goto 91
+
+c --- Read through the image and compute the limiting pixel values.
+	do 10 j = 1, axlen(2)
+	    call imgl2r (im, pix, j, ier)
+	    if (ier .ne. 0) goto 91
+	    call alimr (pix, axlen(1), vmin, vmax)
+	    if (j .eq. 1) then
+		dmin = vmin
+		dmax = vmax
+	    else
+		dmin = min (dmin, vmin)
+		dmax = max (dmax, vmax)
+	    endif
+ 10	continue
+
+c --- Update the image header.
+	call impkwr (im, 'datamin', dmin, ier)
+	if (ier .ne. 0) goto 91
+	call impkwr (im, 'datamax', dmax, ier)
+	if (ier .ne. 0) goto 91
+
+c --- Clean up.
+	call imclos (im, ier)
+	if (ier .ne. 0) goto 91
+	write (*, '(1x, a20, 2 g12.5)') image, dmin, dmax
+	stop
+
+c --- Error exit.
+ 91	call imemsg (ier, errmsg)
+	write (*, '('' Error: '', a80)') errmsg
+	stop
+	end
diff --git a/sys/imfort/tasks/mkim.f b/sys/imfort/tasks/mkim.f
new file mode 100644
index 00000000..7aec2b24
--- /dev/null
+++ b/sys/imfort/tasks/mkim.f
@@ -0,0 +1,75 @@
+c MKIM -- Make a two dimensional test image of type short or real.  The pixel
+c values go 1, 2, 3, etc. in storage order.
+c
+c 	usage:  mkim image ncols nlines [dtype] [pixdir]
+c
+c The data type defaults to type short if not specified on the command line.
+c ---------------------------------------------------------------------------- 
+
+	program mkim
+
+	character*80	image, errmsg, pixdir
+	integer		im, ier, axlen(7), naxis, dtype
+	integer		nlines, ncols, i, j
+	real		pix(8192)
+
+c --- Get image name.
+	call clargc (1, image, ier)
+	if (ier .ne. 0) then
+	    write (*, '('' enter image name: '',$)')
+	    read (*,*) image
+	endif
+
+c --- Get image size.
+	call clargi (2, ncols, ier)
+	if (ier .ne. 0) then
+	    write (*, '('' ncols: '',$)')
+	    read (*,*) ncols
+	endif
+	call clargi (3, nlines, ier)
+	if (ier .ne. 0) then
+	    write (*, '('' nlines: '',$)')
+	    read (*,*) nlines
+	endif
+
+c --- Get pixel datatype (optional).
+	call clargi (4, dtype, ier)
+	if (ier .ne. 0) dtype = 3
+
+c --- Get pixel directory (optional).
+	call clargc (5, pixdir, ier)
+	if (ier .eq. 0) then
+	    call imsdir (pixdir)
+	endif
+
+	axlen(1) = ncols
+	axlen(2) = nlines
+	naxis    = 2
+
+c --- Create the image.
+	call imcrea (image, axlen, naxis, dtype, ier)
+	if (ier .ne. 0) goto 91
+
+c --- Open the image for writing, and write the data.
+	call imopen (image, 3, im, ier)
+	if (ier .ne. 0) goto 91
+
+	do 20 j = 1, nlines
+	    do 10 i = 1, ncols
+		pix(i) = (j-1) * ncols + i
+ 10	    continue
+	    call impl2r (im, pix, j, ier)
+	    if (ier .ne. 0) goto 91
+ 20	continue
+
+c --- Close the image and quit.
+	call imclos (im, ier)
+	if (ier .ne. 0) goto 91
+
+	stop
+
+c --- Error exit.
+ 91	call imemsg (ier, errmsg)
+	write (*, '('' Error: '', a80)') errmsg
+	stop
+	end
diff --git a/sys/imfort/tasks/pcube.f b/sys/imfort/tasks/pcube.f
new file mode 100644
index 00000000..89dd3651
--- /dev/null
+++ b/sys/imfort/tasks/pcube.f
@@ -0,0 +1,108 @@
+c PCUBE -- Extract a subraster (image cube) from an image and print
+c the values on the standard output.  This is used with a standard
+c test image to verify that the IMFORT interface is working correctly.
+c
+c	usage:  pcube image i1 i2 [j1 j2 [k1 k2]]
+c ---------------------------------------------------------------------
+
+	program pcube
+
+	character*80	image, errmsg
+	integer		i1, i2, j1, j2, k1, k2
+	integer		im, ier, axlen(7), naxis, dtype, nargs
+	real		pix(8192)
+
+c --- Get image name.
+	call clargc (1, image, ier)
+	if (ier .ne. 0) then
+	    write (*, '('' enter image name: '',$)')
+	    read (*,*) image
+	endif
+
+c --- Open the image.
+	call imopen (image, 1, im, ier)
+	if (ier .ne. 0) goto 91
+	call imgsiz (im, axlen, naxis, dtype, ier)
+	if (ier .ne. 0) goto 91
+
+c --- Get subraster coordinates.
+	call clnarg (nargs)
+	if (nargs .lt. 3) then
+	    write (*, '('' enter subraster coordinates (i1 i2 j1 j2): '',$)')
+	    read (*,*) i1, i2, j1, j2
+	    k1 = 1
+	    k2 = 1
+	else
+	    call clargi (2, i1, ier)
+	    if (ier .ne. 0) goto 91
+	    call clargi (3, i2, ier)
+	    if (ier .ne. 0) goto 91
+
+	    if (nargs .ge. 5) then
+		call clargi (4, j1, ier)
+		if (ier .ne. 0) goto 91
+		call clargi (5, j2, ier)
+		if (ier .ne. 0) goto 91
+	    else
+		j1 = 1
+		j2 = 1
+	    endif
+
+	    if (nargs .ge. 7) then
+		call clargi (6, k1, ier)
+		if (ier .ne. 0) goto 91
+		call clargi (7, k2, ier)
+		if (ier .ne. 0) goto 91
+	    else
+		k1 = 1
+		k2 = 1
+	    endif
+	endif
+
+c --- Extract the subraster.
+	call imgs3r (im, pix, i1, i2, j1, j2, k1, k2, ier)
+	if (ier .ne. 0) goto 91
+
+c --- Print the pixel values.
+	call pcuber (pix, i2-i1+1, j2-j1+1, k2-k1+1, i1,i2, j1,j2, k1,k2)
+
+c --- Close the input image and quit.
+	call imclos (im, ier)
+	if (ier .ne. 0) goto 91
+
+	stop
+
+c --- Error handler.
+ 91	call imemsg (ier, errmsg)
+	write (*, '('' Error: '', a80)') errmsg
+	stop
+	end
+
+
+c PCUBER -- Print pixel values, 3d subraster, type real.
+c ----------------------------------------------------------------
+
+	subroutine pcuber (pix, nx,ny,nz, i1,i2, j1,j2, k1,k2)
+
+	integer		nx, ny, nz
+	real		pix(nx,ny,nz)
+	integer		i1, i2, j1, j2, k1, k2
+	integer		i, j, k
+
+	nx = i2 - i1 + 1
+	ny = j2 - j1 + 1
+	nz = k2 - k1 + 1
+
+	do 20 k = k1, k2
+	    write (*, '('' band '', i3)') k
+
+	    print 81, i1, i2, j1, j2
+	    do 10 j = 1, ny
+		print 82, j-1+j1, (pix(i,j,k), i = 1, nx)
+ 10	    continue
+ 20	continue
+
+ 81	format (' subraster at ', 4 i4)
+ 82	format (' line ', i4, 8 (1x, f7.0))
+
+	end
diff --git a/sys/imfort/tasks/phead.f b/sys/imfort/tasks/phead.f
new file mode 100644
index 00000000..4a54b584
--- /dev/null
+++ b/sys/imfort/tasks/phead.f
@@ -0,0 +1,155 @@
+c PHEAD -- Print the header of the named image in FITS format, one keyword
+c per line.  A pattern may optionally be specified to list some subset of the
+c header keywords.
+c
+c	usage:  phead image [pattern]
+c ----------------------------------------------------------------------------
+
+	program phead
+
+	character*20	kwname
+	character*80	image, patstr, errmsg
+	integer		im, kwl, ier
+	logical		sortit
+
+c --- Get image name.
+	call clargc (1, image, ier)
+	if (ier .ne. 0) then
+	    write (*, '('' enter image name: '',$)')
+	    read (*,*) image
+	endif
+
+c --- Get pattern string (list everything if no pattern given).
+	call clargc (2, patstr, ier)
+	if (ier .ne. 0) then
+	    patstr = '*'
+	endif
+
+c --- Open the image.
+	call imopen (image, 1, im, ier)
+	if (ier .ne. 0) goto 91
+
+c --- Open the keyword list and print each keyword in FITS format on the
+c     standard output device.
+
+	sortit = .false.
+	call imokwl (im, patstr, sortit, kwl, ier)
+
+ 10	continue
+	call imgnkw (kwl, kwname, ier)
+	if (ier .ne. 0) goto 20
+	    call putkey (im, kwname, ier)
+	    if (ier .ne. 0) goto 91
+	    goto 10
+ 20	continue
+
+	call imckwl (kwl, ier)
+	if (ier .ne. 0) goto 91
+
+c --- Clean up.
+	call imclos (im, ier)
+	if (ier .ne. 0) goto 91
+
+	stop
+
+c --- Error exit.
+ 91	call imemsg (ier, errmsg)
+	write (*, '(1x, '' Error: '', a80)') errmsg
+
+	stop
+	end
+
+
+c PUTKEY -- Read the value and comment fields of the named image header
+c keyword, and print the value of the keyword in FITS format on the
+c standard output device.
+c
+c     000000000111111111122222222223333333333444444444455555555556
+c     123456789012345678901234567890123456789012345678901234567890
+c     keyword =                  xxx / comment
+c     keyword = 'sval    '           / comment
+c
+c Datatype codes: 1=bool, 2=char, 3,4,5=int, 6,7=real/double, 8=complex
+c Only codes 1, 2, 4, and 6 (bool,char,int,real) are returned by IMTYPK.
+c ------------------------------------------------------------------------
+
+	subroutine putkey (im, kwname, ier)
+
+	integer		im
+	character*(*)	kwname
+
+	logical		bval
+	character*68	sval
+	integer		ival
+	doubleprecision dval
+
+	character*18	valstr
+	character*47	comstr
+	character*70	lngstr
+	integer		nchars, dtype, ier, i
+
+c --- Get the keyword data type and comment information.
+	call imtypk (im, kwname, dtype, comstr, ier)
+	if (ier .ne. 0) return
+
+c --- Print the value of the keyword in FITS format.  The format depends
+c     upon the datatype of the parameter.
+
+	if (dtype .eq. 1) then
+	    call imgkwb (im, kwname, bval, ier)
+	    if (ier .ne. 0) return
+	    write (*, 10) kwname, bval, comstr
+ 10	    format (1x, a8, '= ', l20, ' / ', a47)
+
+	else if (dtype .ge. 3 .and. dtype .le. 5) then
+	    call imgkwi (im, kwname, ival, ier)
+	    if (ier .ne. 0) return
+	    write (*, 20) kwname, ival, comstr
+ 20	    format (1x, a8, '= ', i20, ' / ', a47)
+
+	else if (dtype .eq. 6 .or. dtype .eq. 7) then
+	    call imgkwd (im, kwname, dval, ier)
+	    if (ier .ne. 0) return
+	    if (abs(dval) .lt. 1.0E6 .and. abs(dval) .ge. 1.0E-1) then
+	        write (*, 30) kwname, dval, comstr
+ 30	        format (1x, a8, '= ', f20.2, ' / ', a47)
+	    else
+	        write (*, 31) kwname, dval, comstr
+ 31	        format (1x, a8, '= ', e20.12, ' / ', a47)
+	    endif
+
+	else
+	    call imgkwc (im, kwname, sval, ier)
+	    if (ier .ne. 0) return
+
+	    nchars = len(sval) - 1
+	    do 40 i = nchars, 9, -1
+		if (sval(i:i) .ne. ' ') goto 41
+		nchars = i - 1
+ 40	    continue
+ 41	    continue
+
+	    if (nchars .le. 8) then
+		write (*, 45) kwname, sval, comstr
+ 45	    	format (1x, a8, '= ''', a8, '''', 10x, ' / ', a47)
+	    else if (nchars .le. 18) then
+		valstr = sval
+		write (*, 46) kwname, valstr, comstr
+ 46	    	format (1x, a8, '= ''', a18, '''', ' / ', a47)
+	    else
+		nchars = min (nchars, len(lngstr) - 2)
+		lngstr(1:1) = ''''
+		do 47 i = 1, nchars
+		    lngstr(i+1:i+1) = sval(i:i)
+ 47		continue
+		lngstr(nchars+2:nchars+2) = ''''
+		do 48 i = nchars + 3, len(lngstr)
+		    lngstr(i:i) = ' '
+ 48		continue
+		write (*, 49) kwname, lngstr
+ 49	    	format (1x, a8, '= ', a69)
+	    endif
+	endif
+
+	ier = 0
+	end
diff --git a/sys/imfort/tasks/planck.f b/sys/imfort/tasks/planck.f
new file mode 100644
index 00000000..520183c0
--- /dev/null
+++ b/sys/imfort/tasks/planck.f
@@ -0,0 +1,59 @@
+c PLANCK -- Compute the Planck blackbody radiation distribution for a
+c given temperature and wavelength region.
+c
+c       usage:  planck temperature lambda1 lambda2
+c
+c The temperature is specified in degrees Kelvin and the wavelength
+c region in microns (1u=10000A).  100 [x,y] data points defining the
+c curve are output.
+c ----------------------------------------------------------------------
+
+        program planck
+
+	character*80	errmsg
+        integer         nargs, ier, i
+        real            w1, w2, dw, cm, t
+        real            xv(100), yv(100)
+
+c --- Get the temperature in degrees kelvin.
+        call clargr (1, t, ier)
+        if (ier .ne. 0) then
+            write (*, '('' temperature (degrees kelvin): '',$)')
+            read (*,*) t
+        endif
+
+c --- Get the wavelength region to be computed.
+        call clnarg (nargs)
+        if (nargs .ge. 3) then
+            call clargr (2, w1, ier)
+            if (ier .ne. 0) goto 91
+            call clargr (3, w2, ier)
+            if (ier .ne. 0) goto 91
+        else
+            write (*, '('' start wavelength (microns): '',$)')
+            read (*,*) w1
+            write (*, '('' end wavelength (microns): '',$)')
+            read (*,*) w2
+        endif
+
+c --- Compute the blackbody curve.
+        dw = (w2 - w1) / 99.0
+        do 10 i = 1, 100
+            xv(i) = ((i-1) * dw) + w1
+            cm = xv(i) * 1.0E-4
+            yv(i) = (3.74185E-5 * (cm ** -5)) /
+     *          (2.71828 ** (1.43883 / (cm * t)) - 1.0)
+ 10	continue
+
+c --- Print the curve as a table.
+        do 20 i = 1, 100
+	    write (*, '(1x, f7.4, g12.4)') xv(i), yv(i)
+ 20	continue
+
+	stop
+
+c --- Error exit. 
+ 91	call imemsg (ier, errmsg)
+	write (*, '('' Error: '', a80)') errmsg
+	stop
+	end
diff --git a/sys/imfort/tasks/readim.f b/sys/imfort/tasks/readim.f
new file mode 100644
index 00000000..466da0e0
--- /dev/null
+++ b/sys/imfort/tasks/readim.f
@@ -0,0 +1,53 @@
+c READIM -- Read through an image and count the lines (used for timing tests).
+c Tests line sequential i/o.
+c
+c	usage:  readim image
+c ----------------------------------------------------------------------------
+
+	program readim
+
+	character*80	image, errmsg
+	integer		ncols, nlines, nbands, j, k
+	integer		im, ier, axlen(7), naxis, dtype
+	integer*2	pix(8192)
+
+c --- Get image name.
+	call clargc (1, image, ier)
+	if (ier .ne. 0) then
+	    write (*, '('' enter image name: '',$)')
+	    read (*,*) image
+	endif
+
+c --- Open the image.
+	call imopen (image, 1, im, ier)
+	if (ier .ne. 0) goto 91
+	call imgsiz (im, axlen, naxis, dtype, ier)
+	if (ier .ne. 0) goto 91
+
+	ncols  = axlen(1)
+	nlines = axlen(2)
+	nbands = axlen(3)
+
+c --- Read through the image.
+	do 20 k = 1, nbands
+	    do 10 j = 1, nlines
+		call imgl3s (im, pix, j, k, ier)
+		if (ier .ne. 0) goto 91
+ 10	    continue
+ 20	continue
+
+c --- Clean up.
+	call imclos (im, ier)
+	if (ier .ne. 0) goto 91
+
+	print 81, nlines, image
+ 81	format (' read ', i4, ' lines from image ', a64)
+
+	stop
+
+c --- Error exit.
+ 91	call imemsg (ier, errmsg)
+	write (*, '('' Error: '', a80)') errmsg
+
+	stop
+	end
diff --git a/sys/imfort/tasks/tasks.unix b/sys/imfort/tasks/tasks.unix
new file mode 100644
index 00000000..13aa52fb
--- /dev/null
+++ b/sys/imfort/tasks/tasks.unix
@@ -0,0 +1,18 @@
+# Declare the IMFORT test/demo tasks as CL foreign tasks [MACHDEP].
+# Usage: uncomment the appropriate declarations, and type `cl < tasks.cl'.
+# NOTE - requires that "iraf" be defined in the host environment. 
+
+task $args = "$${iraf}sys/imfort/tasks/args.e $1 $2 $3 $4 $5"
+task $hello = "$${iraf}sys/imfort/tasks/hello.e"
+task $imcopy = "$${iraf}sys/imfort/tasks/imcopy.e $(*)"
+task $imdel = "$${iraf}sys/imfort/tasks/imdel.e $(*)"
+task $imren = "$${iraf}sys/imfort/tasks/imren.e $(*)"
+task $keyw = "$${iraf}sys/imfort/tasks/keyw.e"
+task $minmax = "$${iraf}sys/imfort/tasks/minmax.e $(*)"
+task $mkim = "$${iraf}sys/imfort/tasks/mkim.e $(1) $2 $3 $4 $(5)"
+task $pcube = "$${iraf}sys/imfort/tasks/pcube.e $(1) $2 $3 $4 $5 $6 $7"
+task $phead = "$${iraf}sys/imfort/tasks/phead.e $(1) $2"
+task $planck = "$${iraf}sys/imfort/tasks/planck.e"
+task $readim = "$${iraf}sys/imfort/tasks/readim.e $(*)"
+
+keep
diff --git a/sys/imfort/tasks/tasks.vms b/sys/imfort/tasks/tasks.vms
new file mode 100644
index 00000000..2be943f4
--- /dev/null
+++ b/sys/imfort/tasks/tasks.vms
@@ -0,0 +1,17 @@
+# Declare the IMFORT test/demo tasks as CL foreign tasks [MACHDEP].
+# Usage: uncomment the appropriate declarations, and type `cl < tasks.cl'.
+
+task $args = "$args:==\$irafdisk:[iraf.sys.imfort.tasks]args.exe!args $1 $2 $3 $4 $5"
+task $hello = "$hello:==\$irafdisk:[iraf.sys.imfort.tasks]hello.exe!hello"
+task $imcopy = "$imcopy:==\$irafdisk:[iraf.sys.imfort.tasks]imcopy.exe!imcopy $(*)"
+task $imdel = "$imdel:==\$irafdisk:[iraf.sys.imfort.tasks]imdel.exe!imdel $(*)"
+task $imren = "$imren:==\$irafdisk:[iraf.sys.imfort.tasks]imren.exe!imren $(*)"
+task $keyw = "$keyw:==\$irafdisk:[iraf.sys.imfort.tasks]keyw.exe!keyw"
+task $minmax = "$minmax:==\$irafdisk:[iraf.sys.imfort.tasks]minmax.exe!minmax $(*)"
+task $mkim = "$mkim:==\$irafdisk:[iraf.sys.imfort.tasks]mkim.exe!mkim $(*) $2 $3 $4"
+task $pcube = "$pcube:==\$irafdisk:[iraf.sys.imfort.tasks]pcube.exe!pcube $(*) $2 $3 $4 $5 $6 $7"
+task $phead = "$phead:==\$irafdisk:[iraf.sys.imfort.tasks]phead.exe!phead $(1) $2"
+task $planck = "$planck:==\$irafdisk:[iraf.sys.imfort.tasks]planck.exe!planck"
+task $readim = "$readim:==\$irafdisk:[iraf.sys.imfort.tasks]readim.exe!readim $(*)"
+
+keep