From fa080de7afc95aa1c19a6e6fc0e0708ced2eadc4 Mon Sep 17 00:00:00 2001 From: Joseph Hunkeler Date: Wed, 8 Jul 2015 20:46:52 -0400 Subject: Initial commit --- sys/imfort/db/imdelf.x | 44 ++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 44 insertions(+) create mode 100644 sys/imfort/db/imdelf.x (limited to 'sys/imfort/db/imdelf.x') diff --git a/sys/imfort/db/imdelf.x b/sys/imfort/db/imdelf.x new file mode 100644 index 00000000..78be8a88 --- /dev/null +++ b/sys/imfort/db/imdelf.x @@ -0,0 +1,44 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include +include +include "idb.h" + +# IMDELF -- Delete a user field from the image header. It is an error if the +# named field does not exist. + +procedure imdelf (im, key) + +pointer im # image descriptor +char key[ARB] # name of the new parameter + +int off +pointer rp, sp, keyname +int idb_kwlookup(), idb_findrecord(), stridxs() +errchk syserrs + +begin + call smark (sp) + call salloc (keyname, SZ_FNAME, TY_CHAR) + + # FITS format requires that the keyword name be upper case. + call strcpy (key, Memc[keyname], SZ_FNAME) + call strupr (Memc[keyname]) + + # Cannot delete standard header keywords. + if (idb_kwlookup (key) > 0) + call syserrs (SYS_IDBNODEL, key) + + # Verify that the named user field exists. + if (idb_findrecord (im, key, rp) <= 0) + call syserrs (SYS_IDBDELNXKW, key) + + # Delete the field. + off = stridxs ("\n", Memc[rp]) + if (off > 0) + call strcpy (Memc[rp+off], Memc[rp], ARB) + else + Memc[rp] = EOS + + call sfree (sp) +end -- cgit