diff options
Diffstat (limited to 'noao/mtlocal/r2df')
| -rw-r--r-- | noao/mtlocal/r2df/README | 2 | ||||
| -rw-r--r-- | noao/mtlocal/r2df/mkpkg | 15 | ||||
| -rw-r--r-- | noao/mtlocal/r2df/r2df.com | 14 | ||||
| -rw-r--r-- | noao/mtlocal/r2df/r2df.h | 107 | ||||
| -rw-r--r-- | noao/mtlocal/r2df/r2dfrd.x | 72 | ||||
| -rw-r--r-- | noao/mtlocal/r2df/r2dfrhdr.x | 160 | ||||
| -rw-r--r-- | noao/mtlocal/r2df/r2dfrim.x | 70 | ||||
| -rw-r--r-- | noao/mtlocal/r2df/r2dfrpix.x | 126 | ||||
| -rw-r--r-- | noao/mtlocal/r2df/r2dftoks.x | 173 | ||||
| -rw-r--r-- | noao/mtlocal/r2df/t_r2df.x | 118 |
10 files changed, 857 insertions, 0 deletions
diff --git a/noao/mtlocal/r2df/README b/noao/mtlocal/r2df/README new file mode 100644 index 00000000..be8c4202 --- /dev/null +++ b/noao/mtlocal/r2df/README @@ -0,0 +1,2 @@ +R2DF -- This directory contains the reader program for converting CTIO 2-d + Frutti data tapes into IRAF image files. diff --git a/noao/mtlocal/r2df/mkpkg b/noao/mtlocal/r2df/mkpkg new file mode 100644 index 00000000..5f829c90 --- /dev/null +++ b/noao/mtlocal/r2df/mkpkg @@ -0,0 +1,15 @@ +# Make the 2-d frutti portion of the mtlocal library. + +$checkout libpkg.a ../ +$update libpkg.a +$checkin libpkg.a ../ +$exit + +libpkg.a: + r2dfrd.x r2df.com r2df.h <error.h> <imhdr.h> + r2dfrhdr.x r2df.com r2df.h r2df.com <imhdr.h> <mach.h> + r2dfrim.x r2df.com r2df.h <imhdr.h> <mach.h> + r2dfrpix.x r2df.com <fset.h> <mach.h> <mii.h> + r2dftoks.x <mach.h> r2df.h <imhdr.h> + t_r2df.x r2df.com <error.h> <fset.h> + ; diff --git a/noao/mtlocal/r2df/r2df.com b/noao/mtlocal/r2df/r2df.com new file mode 100644 index 00000000..96f6fce7 --- /dev/null +++ b/noao/mtlocal/r2df/r2df.com @@ -0,0 +1,14 @@ +# 2D-FRUTTI reader common + +int len_record # Record length (determined from header) +int data_type # Output data type + +# Option flags +int make_image # Create an IRAF image +int long_header # Print a long 2D-FRUTTI header +int short_header # Print a short header (Title and size) +int lsbf # Least significant byte first +int tape # tape input + +common /rcamcom/ len_record, data_type, make_image, long_header, + short_header, lsbf, tape diff --git a/noao/mtlocal/r2df/r2df.h b/noao/mtlocal/r2df/r2df.h new file mode 100644 index 00000000..e0c0c719 --- /dev/null +++ b/noao/mtlocal/r2df/r2df.h @@ -0,0 +1,107 @@ +# 2D-FRUTTI Definitions + +# The 2D-FRUTTI standard readable by the 2D-FRUTTI reader: +# +# 1. 8 bits / byte +# 2. ASCII character code +# 3. 16 bit, twos complement with least significant bytes first +# +# The following deviations from the 2D-FRUTTI standard are allowed: +# +# A user specified flag allows selecting most significant byte format + +define CAM_BYTE 8 # Number of bits in 2D-FRUTTI byte +define BITPIX 16 # Bits per 2D-FRUTTI data values +#define LSBF YES # Least Significant Byte First +define LEN_CAM_PARAMETERS 256 # Number of 2D-FRUTTI header parameters +define LEN_CAM_TEXT 40 # Length of 2D-FRUTTI text +define LEN_HEADER 4096 # Number of 16 bit words in the header +define FST_HDRBYTE 101 # The first word of the ID string + +# Mapping of 2D-FRUTTI Parameters to IRAF image header + +define NAXIS IM_NDIM($1) # Number of image dimensions +define PARAM5 IM_LEN($1,1) # Number of pixels in first dimension +define PARAM6 IM_LEN($1,2) # Number of pixels in second dimension +define TITLE IM_TITLE($1) + +define LEN_TITLE 40 + +# Additional IRAF header parameters + +define PIXTYPE IM_PIXTYPE($1) +define LIMTIME IM_LIMTIME($1) +define IRAFMAX IM_MAX($1) +define IRAFMIN IM_MIN($1) + +# define the user area parameters + +define LEN_USER_AREA 2880 +define UNKNOWN Memc[($1+IMU-1)*SZ_STRUCT + 1] +define LEN_KEYWORD 8 +define LEN_OBJECT 63 + +# Define rcamera structure. Definitions which are commented out may be needed +# later + +define CCD_PICNO $1[1] # CCD picture number +#define DATA_TYPE $1[0] # Data type, object, bias etc. +#define NRECS (($1[11]*$1[12]-1)/4096+1) # Number of DATA records +define NAXIS1 $1[12] # Number of columns +define NAXIS2 $1[11] # Number of rows +define ITIME $1[9] # Integration time in seconds +define TTIME $1[8] # Total time in seconds +define OTIME $1[10] # Open time in seconds +#define UT_HR $1[0] # Universal time +#define UT_MIN $1[0] # +#define UT_SEC $1[0] # +#define ZD_DEG $1[0] # Zenith distance +#define ZD_MIN $1[0] # +#define ZD_SEC $1[0] # +#define OBS_MON $1[0] # Date of observation +#define OBS_DAY $1[0] # +#define OBS_YR $1[0] # +#define ST_HR $1[0] # Sidereal time +#define ST_MIN $1[0] # +#define ST_SEC $1[0] # +#define EPOCH $1[0] # Epoch of RA and DEC +define REC_LEN ($1[1] * 0 + 4096) # Length of a data record +#define BIAS_PIX $1[0] # +#define RA_HR $1[0] # RA +#define RA_MIN $1[0] # +#define RA_SEC $1[0] # +#define DEC_DEG $1[0] # Declination +#define DEC_MIN $1[0] # +#define DEC_SEC $1[0] # +#define CAM_TEMP $1[0] # Camera temperature +#define DEW_TEMP $1[0] # Dewar temperature +#define CAM_HEAD $1[0] # Camera head ID +#define F1POS $1[0] # Position of filter bolt 1 +#define F2POS $1[0] # Position of filter bolt 2 +#define TV_FILTER $1[0] # TV filter +#define COMP_LAMP $1[0] # Comparison lamp +#define TILT_POS $1[0] # Tilt position +#define PED_POS $1[0] # Pedestal positions +#define AIR_MASS $1[0] # Airmass * 100 +#define BT_FLAG $1[0] # Bias trim flag +#define BP_FLAG $1[0] # Bad pixel cleaning flag +#define CR_FLAG $1[0] # Cosmic ray cleaning flag +#define DK_FLAG $1[0] # Dark subtraction flag +#define FF_FLAG $1[0] # Flat field flag +#define FR_FLAG $1[0] # Fringe correction flag +#define FR_SC100 $1[0] # Fringe scaling parameter X 100 +#define FR_SC1 $1[0] # Fringe scaling parameter X 1 +#define BI_FLAG $1[0] # Bias subtract flag + +# Define image data types. + +define OBJECT 0 +define DARK 1 +define PFLAT 2 +define SFLAT 3 +define COMP 4 +define BIAS 5 +define DFLAT 6 +define MASK 7 +define MULT 8 +define SCAN 9 diff --git a/noao/mtlocal/r2df/r2dfrd.x b/noao/mtlocal/r2df/r2dfrd.x new file mode 100644 index 00000000..80a492e9 --- /dev/null +++ b/noao/mtlocal/r2df/r2dfrd.x @@ -0,0 +1,72 @@ +include <error.h> +include <imhdr.h> +include "r2df.h" + +# R2DFRD -- Convert a 2D-FRUTTI file into an IRAF imagefile. +# An EOT is signalled by returning EOF. + +int procedure r2dfrd (camfile, iraffile) + +char camfile[ARB] +char iraffile[ARB] + +int stat +pointer cam_fd, im +int r2dfrhdr() +pointer mtopen(), immap() +errchk salloc, r2dfrhdr, mtopen, close, immap, delete +errchk r2dfrim +include "r2df.com" + +begin + # Open input 2D-FRUTTI file. If an error occurs on open file + # is at EOT. + + cam_fd = mtopen (camfile, READ_ONLY, 0) + + # Print long or short header. + + if (long_header == YES || short_header == YES) { + if (make_image == YES) { + call printf ("File: %s ") + call pargstr (iraffile) + } else { + call printf ("File: %s ") + call pargstr (camfile) + } + if (long_header == YES) + call printf ("\n") + } + + # Create IRAF image header. If only a header listing is desired + # then a temporary image header is created and later deleted. + + if (make_image == NO) + call strcpy ("dev$null", iraffile, SZ_FNAME) + im = immap (iraffile, NEW_IMAGE, LEN_USER_AREA) + + # Read the header. EOT is signalled by an EOF status from fits_read_ + # header. Create an IRAF image if desired + + iferr { + stat = r2dfrhdr (cam_fd, im) + if (stat == EOF) + call printf ("End of data\n") + else { + if (make_image == YES) + call r2dfrim (cam_fd, im) + } + } then + call erract (EA_WARN) + + # Close files and clean up. + + call imunmap (im) + if (stat == EOF || make_image == NO) + call imdelete (iraffile) + if (long_header == YES) + call printf ("\n") + call close (cam_fd) + + return (stat) +end diff --git a/noao/mtlocal/r2df/r2dfrhdr.x b/noao/mtlocal/r2df/r2dfrhdr.x new file mode 100644 index 00000000..4573afba --- /dev/null +++ b/noao/mtlocal/r2df/r2dfrhdr.x @@ -0,0 +1,160 @@ +include <imhdr.h> +include <mach.h> +include "r2df.h" + +# R2DFRHDR -- Read a 2D-FRUTTI header. +# If EOF is reached the routine returns EOF, otherwise it returns the +# number of data records in the 2D-FRUTTI image file. + +int procedure r2dfrhdr (cam_fd, im) + +pointer cam_fd # pointer to camera file +pointer im # pointer to the IRAF image + +int i, sz_rec +char text[LEN_CAM_TEXT], header[LEN_HEADER * SZ_SHORT] +short parameters[LEN_CAM_PARAMETERS] + +int read(), r2dfrndup() +errchk r2dfdcd_hdr, read +include "r2df.com" + +begin + # Read in header record + sz_rec = r2dfrndup (SZB_CHAR * LEN_HEADER, SZB_CHAR) / SZB_CHAR + + i = read (cam_fd, header, sz_rec) + + if (i == EOF) + return (EOF) + else if (i != sz_rec) + call error (1, "Error reading 2D-FRUTTI header") + + # If the least significant byte is first byteswap the 2d-frutti + # parameters otherwise byteswap the header text. + + call bytmov (header, FST_HDRBYTE, text, 1, LEN_CAM_TEXT) + if (lsbf == NO) + call bswap2 (text, 1, text, 1, LEN_CAM_TEXT) + call bytmov (header, 1, parameters, 1, LEN_CAM_PARAMETERS * 2) + if (lsbf != BYTE_SWAP2) + call bswap2 (parameters, 1, parameters, 1, 2 * LEN_CAM_PARAMETERS) + + # Decode the text string + call chrupk (text, 1, text, 1, LEN_CAM_TEXT) + text[LEN_CAM_TEXT+1] = EOS + + # Put the 2D-FRUTTI parameters in the IRAF image header + call r2dfdcd_hdr (im, parameters, text) + call r2dfprnt_hdr (parameters, text) + + return (OK) +end + + +# R2DFDCD_HDR -- Decode a 2D-FRUTTI header record. + +procedure r2dfdcd_hdr (im, parameters, text) + +pointer im +short parameters[ARB] +char text[ARB] + +include "r2df.com" + +begin + # Determine the length of the record in short integers. + len_record = REC_LEN(parameters) + + # Set IRAF image parameters. Send extra keywords to the user area. + if (make_image == YES) { + NAXIS(im) = 2 + PARAM5(im) = NAXIS1(parameters) + PARAM6(im) = NAXIS2(parameters) + call strcpy (text, TITLE(im), LEN_TITLE) + call r2dfstore_token (parameters, im) + } +end + + +# R2DFPRNT_HDR -- Print the 2D-FRUTTI header. + +procedure r2dfprnt_hdr (parameters, text) + +short parameters[ARB] +char text[ARB] + +include "r2df.com" + +begin + if (long_header == YES) + call r2dflng_hdr1 (parameters, text) + + if (short_header == YES && long_header == NO) { + call printf ("ID: %.30s ") + call pargstr (text) + call printf ("Size = %d x %d\n") + call pargs (NAXIS1(parameters)) + call pargs (NAXIS2(parameters)) + } +end + + +# R2DFLNG_HDR1 -- Print the full 2D-FRUTTI header. + +procedure r2dflng_hdr1 (parameters, text) + +short parameters[ARB] +char text[ARB] + +begin + call printf ("ID: %.30s CCDPICNO: %d\n") + call pargstr (text) + call pargs (CCD_PICNO(parameters)) + call printf ("NAXIS1= %3d ") + call pargs (NAXIS1(parameters)) + call printf ("NAXIS2= %3d\n") + call pargs (NAXIS2(parameters)) + call printf ("INTEGRATION= %5d ") + call pargs (ITIME(parameters)) + call printf ("OPEN TIME= %5d\n") + call pargs (OTIME(parameters)) + call r2dflng_hdr2 (parameters, text) +end + + +# R2DFLNG_HDR2 -- This routine is used because of number of strings +# limitation in preprocessor. + +procedure r2dflng_hdr2 (parameters, text) + +short parameters[ARB] +char text[ARB] + +int nrecs + +begin + nrecs = (int (NAXIS2(parameters)) * int (NAXIS1(parameters))) / 4096 + 1 + call printf ("RECORDS= %3d ") + call pargi (nrecs) + call printf ("RECORD LENGTH= %5d\n") + call pargi (REC_LEN(parameters)) +end + + +# R2DFRNDUP -- Procedure to round an integer to the next highest number +# divisible by base. + +int procedure r2dfrndup (number, base) + +int number, base +int value + +begin + if (mod(number, base) == 0) + return (number) + else { + value = (number/base + 1) * base + return (value) + } +end diff --git a/noao/mtlocal/r2df/r2dfrim.x b/noao/mtlocal/r2df/r2dfrim.x new file mode 100644 index 00000000..55f5a2a1 --- /dev/null +++ b/noao/mtlocal/r2df/r2dfrim.x @@ -0,0 +1,70 @@ +include <imhdr.h> +include <mach.h> +include "r2df.h" + +# R2DFRIM -- Read 2D-FRUTTI image pixels to IRAF image file. + +procedure r2dfrim (cam_fd, im) + +int cam_fd +pointer im + +pointer buf +int i, nlines +short linemin, linemax +long v[IM_MAXDIM] + +long clktime() +int r2dfin_pixel(), r2dfrpix(), impnls() +errchk impnls, init_read_pixels(), read_pixels() +include "r2df.com" + +begin + call r2dfset_im_hdr (im) + + if (NAXIS(im) == 0) + return + + IRAFMAX(im) = -MAX_REAL + IRAFMIN(im) = MAX_REAL + + call amovkl (long(1), v, IM_MAXDIM) + nlines = PARAM6(im) + + # 2D-FRUTTI data is converted to type SHORT. + + i= r2dfin_pixel (len_record, BITPIX, TY_SHORT) + + do i = 1, nlines { + if (impnls (im, buf, v) == EOF) + call error (3, "Error writing 2D-FRUTTI data") + if (r2dfrpix (cam_fd, Mems[buf], PARAM5(im)) != + PARAM5(im)) + call error (4, "Error reading 2D-FRUTTI data") + call alims (Mems[buf], PARAM5(im), linemin, linemax) + IRAFMAX(im) = max (IRAFMAX(im), real (linemax)) + IRAFMIN(im) = min (IRAFMIN(im), real (linemin)) + } + + LIMTIME(im) = clktime (long (0)) +end + + +# R2DFSET_IM_HDR -- Set remaining header fields not set in read_header. + +procedure r2dfset_im_hdr (im) + +pointer im +include "r2df.com" + +begin + # Set IRAF image pixel type. + + if (data_type == ERR) { + if (BITPIX <= SZ_SHORT * SZB_CHAR * NBITS_BYTE) + PIXTYPE(im) = TY_SHORT + else + PIXTYPE(im) = TY_LONG + } else + PIXTYPE(im) = data_type +end diff --git a/noao/mtlocal/r2df/r2dfrpix.x b/noao/mtlocal/r2df/r2dfrpix.x new file mode 100644 index 00000000..946c253b --- /dev/null +++ b/noao/mtlocal/r2df/r2dfrpix.x @@ -0,0 +1,126 @@ +include <mii.h> +include <mach.h> +include <fset.h> + +# R2DFIN_PIXEL and RPIXEL -- Read pixel data with record buffering +# and data type conversion. The input data must meet the MII standard +# except for possibly having the least significant byte first. +# +# Read data in records of len_record and convert to the specified IRAF +# data type. Successive calls of <r2dfrpix> returns the next npix pixels. +# Read_pixels returns EOF or the number of pixels converted. +# <r2dfin_pixel> must be called before <r2dfrpix>. +# +# Error conditions are: +# 1. A short input record +# 2. Error in converting the pixels by miiup. +# +# This routine is based on the MII unpack routine which is machine dependent. +# The bitpix must correspond to an MII type. If the lsbf (least significant +# byte first) flag is YES then the pixels do not satisfy the MII standard. +# In this case the bytes are first swapped into most significant byte first +# before the MII unpack routine is called. +# +# This version has been modified for the 2D-FRUTTI format in that byte data +# is also swapped if lsbf = YES and a new record is read if only a +# partial line of data is in the buffer. + +int procedure r2dfin_pixel (npix_record, bitpix, spp_type) + +long npix_record # Number of pixels per input record +int bitpix # Bits per pixel (must correspond to an MII type) +int spp_type # SPP data type to be returned + +# entry r2dfrpix (fd, buffer, npix) + +int r2dfrpix +int fd # Input file descriptor +char buffer[1] # Output buffer +int npix # Number of pixels to read + +int ty_mii, ty_spp +int npix_rec, nch_rec, sz_rec, nchars, len_mii +int i, n, ip, op +int swap +pointer mii, spp + +int read(), sizeof(), miilen() +errchk miilen, mfree, malloc, read, miiup +data mii/NULL/, spp/NULL/ +include "r2df.com" + +begin + swap = lsbf + ty_mii = bitpix + ty_spp = spp_type + npix_rec = npix_record + nch_rec = npix_rec * sizeof (ty_spp) + + len_mii = miilen (npix_rec, ty_mii) + sz_rec = len_mii * SZ_INT + + if (mii != NULL) + call mfree (mii, TY_INT) + call malloc (mii, len_mii, TY_INT) + + if (spp != NULL) + call mfree (spp, TY_CHAR) + call malloc (spp, nch_rec, TY_CHAR) + + ip = nch_rec + return (OK) + +entry r2dfrpix (fd, buffer, npix) + + nchars = npix * sizeof (ty_spp) + op = 0 + + repeat { + # If data is exhausted read the next record. + + if (ip + nchars > nch_rec) { # Modified for 2D-FRUTTI data + + # flush the tape buffers, only needed to handle + # camera tapes created with 7-to-9 conversions + + if (tape == YES) + call fseti (fd, F_CANCEL, YES) + + # Read a data record. + i = read (fd, Memi[mii], sz_rec) + if (i == EOF) + return (EOF) + else if ( i < sz_rec - SZ_INT + 1) + call error (0, "Short record encountered") + + # Convert from MII format to SPP format + if (swap == YES) + switch (ty_mii) { + + # Modified for 2D-FRUTTI data # + case MII_BYTE: # + call bswap2 (Memi[mii], 1, Memi[mii], 1, # + sz_rec * SZB_CHAR) # + + case MII_SHORT: + call bswap2 (Memi[mii], 1, Memi[mii], 1, + sz_rec * SZB_CHAR) + case MII_LONG: + call bswap4 (Memi[mii], 1, Memi[mii], 1, + sz_rec * SZB_CHAR) + } + + call miiupk (Memi[mii], Memc[spp], npix_rec, ty_mii, ty_spp) + + ip = 0 + } + + n = min (nch_rec - ip, nchars - op) + call amovc (Memc[spp + ip], buffer[1 + op], n) + ip = ip + n + op = op + n + + } until (op == nchars) + + return (npix) +end diff --git a/noao/mtlocal/r2df/r2dftoks.x b/noao/mtlocal/r2df/r2dftoks.x new file mode 100644 index 00000000..efbf30f4 --- /dev/null +++ b/noao/mtlocal/r2df/r2dftoks.x @@ -0,0 +1,173 @@ +include <mach.h> +include <imhdr.h> +include "r2df.h" + +define LEN_KEYWORD 8 + + +# R2DFSTORE_TOKEN -- Store 2D-FRUTTI specific keywords in the IRAF +# image header. + +procedure r2dfstore_token (parameters, im) + +short parameters[ARB] # Pointer to program data structure +pointer im # Pointer to image + +int fd +int stropen() +errchk stropen, r2dfsicard + +begin + # Open image user area as a string + fd = stropen (UNKNOWN(im), (LEN_USER_AREA - 1) * SZ_STRUCT, WRITE_ONLY) + + # FITS keyword are formatted and appended to the image user area. + call r2dfsicard (fd, "ITIME", ITIME(parameters), + "REQUESTED INTEGRATION TIME (SECS)") + call r2dfsicard (fd, "OTIME", OTIME(parameters), + "ACTUAL INTEGRATION TIME (SECS)") + + call close (fd) +end + + +# R2DFFCARD -- Format and append a FITS header card with a real keyword value +# to the input string buffer. + +procedure r2dffcard (fd, keyword, value, comment, precision) + +int fd # File descriptor of input string buffer +char keyword[ARB] # FITS keyword +real value # Value of FITS keyword +char comment[ARB] # Comment string +int precision # Number of decimal places output + +begin + call fprintf (fd, "%-8.8s= %20.*f / %-45.45s\n") + call pargstr (keyword) + call pargi (precision) + call pargr (value) + call pargstr (comment) +end + + +# R2DFSICARD -- Format and append a FITS header card with a short integer +# keyword value to the input string buffer. + +procedure r2dfsicard (fd, keyword, value, comment) + +int fd # File descriptor of input string buffer +char keyword[ARB] # FITS keyword +short value # Value of FITS keyword +char comment[ARB] # Comment string + +begin + call fprintf (fd, "%-8.8s= %20d / %-45.45s\n") + call pargstr (keyword) + call pargs (value) + call pargstr (comment) +end + + +# R2DFHMSCARD -- Format and append a FITS header card to the input string +# buffer. The value is input as 3 short integers; it is output in HH:MM:SS +# format with %h. The procedure can be used for RA, DEC and ST, UT and HA. + +procedure r2dfhmscard (fd, keyword, hours, minutes, seconds, comment) + +int fd # File descriptor +char keyword[ARB] # FITS keyword +short hours # Hours +short minutes # Minutes +short seconds # Seconds +char comment # Comment string + +begin + call fprintf (fd, "%-8.8s= '%c%02d:%02d:%02d' / %-54.54s\n") + call pargstr (keyword) + if (hours < 0) + call pargc ('-') + else + call pargc (' ') + call pargs (hours) + call pargs (minutes) + call pargs (seconds) + call pargstr (comment) +end + + +# R2DFYMDCARD - Format and append a FITS header card to the input +# string buffer. The value is input as 3 short integers; it is output +# in the format dd-mm-yy the format dd-mm-yy. + +procedure r2dfymdcard (fd, keyword, years, months, days, comment) + +int fd # File descriptor +char keyword[ARB] # FITS keyword +short years # Hours +short months # Minutes +short days # Seconds +char comment # Comment string + +begin + call fprintf (fd, "%-8.8s= '%02d-%02d-%4d' / %-55.55s\n") + call pargstr (keyword) + call pargs (days) + call pargs (months) + call pargs (years) + call pargstr (comment) +end + + +# R2DFOBSCARD -- Procedure to code the object type into a FITS card. + +procedure r2dfobscard (fd, keyword, data_code, comment) + +int fd # File descriptor +char keyword[ARB] # FITS keyword +short data_code # type of data +char comment[ARB] # coment string + +char str[LEN_OBJECT+1] +int maxch, nblanks +int strlen() + +begin + switch (data_code) { + case OBJECT: + call strcpy ("OBJECT", str, LEN_OBJECT) + case DARK: + call strcpy ("DARK", str, LEN_OBJECT) + case PFLAT: + call strcpy ("PROJECTOR FLAT", str, LEN_OBJECT) + case SFLAT: + call strcpy ("SKY FLAT", str, LEN_OBJECT) + case COMP: + call strcpy ("COMPARISON LAMP", str, LEN_OBJECT) + case BIAS: + call strcpy ("BIAS", str, LEN_OBJECT) + case DFLAT: + call strcpy ("DOME FLAT", str, LEN_OBJECT) + case MASK: + call strcpy ("MASK", str, LEN_OBJECT) + case MULT: + call strcpy ("MULT", str, LEN_OBJECT) + case SCAN: + call strcpy ("SCAN", str, LEN_OBJECT) + } + call sprintf (str[strlen (str) + 1], LEN_OBJECT, " (%d)") + call pargs (data_code) + + maxch = strlen (str) + maxch = max (maxch, LEN_KEYWORD) + nblanks = LEN_OBJECT - maxch + + call fprintf (fd, "%-8.8s= '%*.*s' / %*.*s\n") + call pargstr (keyword) + call pargi (-maxch) + call pargi (maxch) + call pargstr (str) + call pargi (-nblanks) + call pargi (nblanks) + call pargstr (comment) +end diff --git a/noao/mtlocal/r2df/t_r2df.x b/noao/mtlocal/r2df/t_r2df.x new file mode 100644 index 00000000..61997346 --- /dev/null +++ b/noao/mtlocal/r2df/t_r2df.x @@ -0,0 +1,118 @@ +include <error.h> +include <fset.h> + +define MAX_RANGES 100 +define NTYPES 7 + + +# R2DF -- CL callable task to read 2D-FRUTTI format data. Further +# documentation given in 2df.hlp. + +procedure t_r2df() + +char infile[SZ_FNAME] # the input file name list +char outfile[SZ_FNAME] # the output file name list +char file_list[SZ_LINE] # the input file number list +int offset # the output name file number offset + +char in_fname[SZ_FNAME], out_fname[SZ_FNAME] +int range[MAX_RANGES*2+2] +int file_number, stat, nfiles + +bool clgetb() +char clgetc() +int fstati(), clgeti(), btoi(), mtfile(), mtneedfileno() +int r2dfread(), decode_ranges(), get_next_number(), r2dfget_type() +include "r2df.com" + +begin + if (fstati (STDOUT, F_REDIR) == NO) + call fseti (STDOUT, F_FLUSHNL, YES) + + # Get the input file name. + call clgstr ("r2df_file", infile, SZ_FNAME) + + # Request the input files to be converted if the input file is a + # tape device. Otherwise, convert only the first file. + + if (mtfile (infile) == YES) { + tape = YES + if (mtneedfileno (infile) == YES) + call clgstr ("file_list", file_list, SZ_LINE) + else + call strcpy ("1", file_list, SZ_LINE) + } else { + tape = NO + call strcpy ("1", file_list, SZ_LINE) + } + + if (decode_ranges (file_list, range, MAX_RANGES, nfiles) == ERR) + call error (1, "Illegal file number list") + + # Set up the output options. + long_header = btoi (clgetb ("long_header")) + short_header = btoi (clgetb ("short_header")) + lsbf = btoi (clgetb ("standard_format")) + make_image = btoi (clgetb ("make_image")) + offset = clgeti ("offset") + + # Determine the output image data type. + if (make_image == YES) { + data_type = r2dfget_type (clgetc ("datatype")) + call clgstr ("iraf_file", outfile, SZ_FNAME) + } else + outfile[1] = EOS + + # Read successive 2D-FRUTTI files, convert and write into a numbered + # succession of output IRAF files. + + file_number = 0 + while (get_next_number (range, file_number) != EOF) { + + # Get the input file name. + if (tape == YES) { + if (mtneedfileno (infile) == YES) + call mtfname (infile, file_number, in_fname, SZ_FNAME) + else + call strcpy (infile, in_fname, SZ_FNAME) + } else + call strcpy (infile, in_fname, SZ_FNAME) + + # Get the output file name. + if (nfiles > 1) { + call sprintf (out_fname[1], SZ_FNAME, "%s%03d") + call pargstr (outfile) + call pargi (file_number + offset) + } else + call strcpy (outfile, out_fname, SZ_FNAME) + + # Convert 2D-FRUTTI file to the output IRAF file. If EOT is + # reached then exit. If an error is detected then print a + # warning and continue with the next file. + + iferr (stat = r2dfread (in_fname, out_fname)) + call erract (EA_FATAL) + if (stat == EOF) # EOT found + return + } +end + + +# R2DFGET_TYPE -- Convert a character to an IRAF image type. + +int procedure r2dfget_type (c) + +char c # character describing the data type + +int type_codes[NTYPES], i +int stridx() +string types "usilrdx" +data type_codes /TY_USHORT, TY_SHORT, TY_INT, TY_LONG, TY_REAL, + TY_DOUBLE, TY_COMPLEX/ +begin + i = stridx (c, types) + if (i == 0) + return (ERR) + else + return (type_codes[stridx (c, types)]) +end |