Initial commit

1 files changed, 116 insertions, 0 deletions

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