diff options
Diffstat (limited to 'pkg/obsolete/fits/t_wfits.x')
| -rw-r--r-- | pkg/obsolete/fits/t_wfits.x | 216 |
1 files changed, 216 insertions, 0 deletions
diff --git a/pkg/obsolete/fits/t_wfits.x b/pkg/obsolete/fits/t_wfits.x new file mode 100644 index 00000000..13cdd81f --- /dev/null +++ b/pkg/obsolete/fits/t_wfits.x @@ -0,0 +1,216 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <mach.h> +include <error.h> +include <fset.h> +include "wfits.h" + +# T_WFITS -- This procedure converts a series of IRAF image files to +# FITS image files. + +procedure t_wfits () + +char iraf_files[SZ_FNAME] # list of IRAF images +char fits_files[SZ_FNAME] # list of FITS files +bool newtape # new or used tape ? +char in_fname[SZ_FNAME] # input file name +char out_fname[SZ_FNAME] # output file name + +int imlist, flist, nimages, nfiles, file_number +bool clgetb() +double clgetd() +int imtopen(), imtlen (), wft_get_bitpix(), clgeti(), imtgetim() +int mtfile(), btoi(), fstati(), fntlenb(), fntgfnb(), mtneedfileno() +int wft_blkfac(), fntrfnb(), strlen() +pointer fntopnb() + +include "wfits.com" + +begin + # Flush on a newline if STDOUT has not been redirected. + if (fstati (STDOUT, F_REDIR) == NO) + call fseti (STDOUT, F_FLUSHNL, YES) + + # Open iraf_files template and determine number of files in list. + call clgstr ("iraf_files", iraf_files, SZ_FNAME) + imlist = imtopen (iraf_files) + nimages = imtlen (imlist) + + # Get the wfits parameters. + long_header = btoi (clgetb ("long_header")) + short_header = btoi (clgetb ("short_header")) + make_image = btoi (clgetb ("make_image")) + + # Get the FITS bits per pixel and the FITS logical record size. + bitpix = wft_get_bitpix (clgeti ("bitpix")) + len_record = FITS_RECORD + + # Get the scaling parameters. + scale = btoi (clgetb ("scale")) + if (scale == YES) { + if (clgetb ("autoscale")) + autoscale = YES + else { + bscale = clgetd ("bscale") + bzero = clgetd ("bzero") + autoscale = NO + } + } else { + autoscale = NO + bscale = 1.0d0 + bzero = 0.0d0 + } + + # Get the output file name and type (tape or disk). If no tape file + # number is given for output, the user is asked if the tape is blank + # or contains data. If the tape is blank output begins at BOT, + # otherwise at EOT. + + if (make_image == YES) { + call clgstr ("fits_files", fits_files, SZ_FNAME) + if (mtfile (fits_files) == YES) { + flist = NULL + if (mtneedfileno (fits_files) == YES) { + newtape = clgetb ("newtape") + if (newtape) + call mtfname (fits_files, 1, out_fname, SZ_FNAME) + else + call mtfname (fits_files, EOT, out_fname, SZ_FNAME) + } else { + call strcpy (fits_files, out_fname, SZ_FNAME) + newtape = false + } + } else { + flist = fntopnb (fits_files, NO) + nfiles = fntlenb (flist) + if ((nfiles > 1) && (nfiles != nimages)) + call error (0, + "T_WFITS: Input and output lists are not the same length") + } + } else { + fits_files[1] = EOS + flist = NULL + } + + # Get the fits file blocking factor. + blkfac = wft_blkfac (fits_files, clgeti ("blocking_factor")) + + # Loop through the list of input images files. + + file_number = 1 + while (imtgetim (imlist, in_fname, SZ_FNAME) != EOF) { + + # Print the id string. + if (long_header == YES || short_header == YES) { + call printf ("File %d: %s") + call pargi (file_number) + call pargstr (in_fname) + } + + # Get the output file name. If single file output to disk, use + # name fits_file. If multiple file output to disk, the file number + # is added to the output file name, if no output name list is + # supplied. If an output name list is supplied then the names + # are extracted one by one from that list. + + if (make_image == YES) { + if (mtfile (fits_files) == YES) { + if (file_number == 2) + call mtfname (out_fname, EOT, out_fname, SZ_FNAME) + } else if (nfiles > 1) { + if (fntgfnb (flist, out_fname, SZ_FNAME) == EOF) + call error (0, "Error reading output file name") + } else { + if (fntrfnb (flist, 1, out_fname, SZ_FNAME) == EOF) + call strcpy (fits_files, out_fname, SZ_FNAME) + if (nimages > 1) { + call sprintf (out_fname[strlen(out_fname)+1], + SZ_FNAME, "%04d") + call pargi (file_number) + } + } + } + + # Write each output file. + iferr (call wft_write_fitz (in_fname, out_fname)) { + call printf ("Error writing file: %s\n") + call pargstr (out_fname) + call erract (EA_WARN) + break + } else + file_number = file_number + 1 + } + + # Close up the input and output lists. + call clpcls (imlist) + if (flist != NULL) + call fntclsb (flist) +end + + +# WFT_GET_BITPIX -- This procedure fetches the user determined bitpix or ERR if +# the bitpix is not one of the permitted FITS types. + +int procedure wft_get_bitpix (bitpix) + +int bitpix + +begin + switch (bitpix) { + case FITS_BYTE, FITS_SHORT, FITS_LONG, FITS_REAL, FITS_DOUBLE: + return (bitpix) + default: + return (ERR) + } +end + + +# WFT_BLKFAC -- Get the fits tape blocking factor. + +int procedure wft_blkfac (file, ublkfac) + +char file[ARB] # the input file name +int ublkfac # the user supplied blocking factor + +int bs, fb, blkfac +pointer gty +int mtfile(), mtcap(), gtygeti() +errchk mtcap(), gtygeti() + +begin + # Return a blocking factor of 1 if the file is a disk file. + if (mtfile (file) == NO) + return (0) + + # Open the tapecap device entry for the given device, and get + # the device block size and default FITS blocking factor + # parameters. + + iferr (gty = mtcap (file)) + return (max (ublkfac,1)) + iferr (bs = gtygeti (gty, "bs")) { + call gtyclose (gty) + return (max (ublkfac,1)) + } + iferr (fb = max (gtygeti (gty, "fb"), 1)) + fb = 1 + + # Determine whether the device is a fixed or variable blocked + # device. Set the fits blocking factor to the value of the fb + # parameter if device is fixed block or if the user has + # requested the default blocking factor. Set the blocking factor + # to the user requested value if the device supports variable + # blocking factors. + + if (bs == 0) { + if (ublkfac <= 0) + blkfac = fb + else + blkfac = ublkfac + } else + blkfac = fb + + call gtyclose (gty) + + return (blkfac) +end |