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/mwcs/iwparray.x | 53 +++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 53 insertions(+) create mode 100644 sys/mwcs/iwparray.x (limited to 'sys/mwcs/iwparray.x') diff --git a/sys/mwcs/iwparray.x b/sys/mwcs/iwparray.x new file mode 100644 index 00000000..cb6cb0d9 --- /dev/null +++ b/sys/mwcs/iwparray.x @@ -0,0 +1,53 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "imwcs.h" + +# IW_PUTARRAY -- Output a double floating array as a sequence of FITS cards, +# one value per card in the form "keyword = value", using the format string +# given to format the name of the FITS keyword. + +procedure iw_putarray (iw, new, old, ndim, kw_format, kw_type, kw_index) + +pointer iw #I pointer to IMWCS descriptor +double new[ndim] #I new array values +double old[ndim] #I old array values from header +int ndim #I image and WCS dimension +char kw_format[ARB] #I format for encoding keyword name +int kw_type #I IMWCS keyword type code +int kw_index #I keword index or 0 if don't care + +int axis +pointer cp, im +char kwname[SZ_KWNAME] +bool fp_equald() +pointer iw_findcard() +errchk imaddf, imputd + +begin + do axis = 1, ndim { + # If new value is zero, no output, delete old card if present. + if (fp_equald (new[axis], 0.0D0)) + next + + # See if we read the card for this parameter. + cp = iw_findcard (iw, kw_type, axis, kw_index) + im = IW_IM(iw) + + # If value is unchanged, no need to do anything. + if (fp_equald (new[axis], old[axis])) { + if (cp != NULL) + C_UPDATED(cp) = YES + next + } + + # Update the keyword in the image header. + call sprintf (kwname, SZ_KWNAME, kw_format) + call pargi (axis) + + if (cp == NULL) + call imaddf (im, kwname, "d") + call imputd (im, kwname, new[axis]) + if (cp != NULL) + C_UPDATED(cp) = YES + } +end -- cgit