diff options
Diffstat (limited to 'noao/mtlocal')
105 files changed, 11083 insertions, 0 deletions
diff --git a/noao/mtlocal/README b/noao/mtlocal/README new file mode 100644 index 00000000..60e14bed --- /dev/null +++ b/noao/mtlocal/README @@ -0,0 +1 @@ +MTNTAPE -- NOAO special mountain format tape readers. diff --git a/noao/mtlocal/Revisions b/noao/mtlocal/Revisions new file mode 100644 index 00000000..ab7586f8 --- /dev/null +++ b/noao/mtlocal/Revisions @@ -0,0 +1,303 @@ +.help revisions Jun88 noao.mtlocal +.nf +noao$mtlocal/cyber/t_ridsfile.x + Fixed minor error in calling procedures. (7/11/09, MJF) + +noao$mtlocal/camera/t_rcamera.x +noao$mtlocal/camera/cam_rheader.x.x +noao$mtlocal/r2df/t_r2df.x +noao$mtlocal/cyber/t_ldumpf.x +noao$mtlocal/cyber/t_rdumpf.x +noao$mtlocal/cyber/t_ridsfile.x +noao$mtlocal/cyber/rrcopy/t_rrcopy.x + Davis, January 7, 1992 + Modified the rcamera, r2df, rpds, ldumpsf, dumpf, ridsfile, and rrcopy + tasks to accept the new mag tape name syntax. + +noao$mtlocal/lib/mkpkg +noao$pds/lib/mkpkg + Davis, December 3, 1991 + Added some missing file dependencies for the ranges.x entry (ctype.h + and mach.h). + Added some missing file dependencies for the pds_rimage.x entry (mach.h). + +noao$mtlocal/camera/rcamera.h,cam_keywords.x + Davis, October 11, 1988 + Some minor modifications were made to the camera header reader to + suport the infrared array header parameters. Additional images types + (numbers 32 to 44) were added to the image type list, a new parameter + IRBSCALE as added to the iraf header and a switch to allow for + millisecond integration times was added. + +noao$mtlocal/cyber/t_ridsout.x + Two bugs were fixed in the ridsout task. Double precision values of + airmass, starting lambda and delta lambda were being printed to stdout + as reals, with a pargr. This was noticed on the SUN. These values + were however, being written to the header correctly. The second bug + was that negative pixel values were being read incorrectly. The + leading minus sign caused them to fill the 10 character field width + without whitespace separating them from the next value. Ridsout was + using 'gargr' to parse the text string into pixel values, which requires + whitespace. Both the negative pixel and the pixel that followed were + being read incorrectly. (ShJ 29/12/87) + +noao$mtlocal/camera/cam_keywords.x,cam_rheader.x + Davis, Dec 17, 1987 + Fixed a bug in the call to bitpak for the fringe scaling parameter. + The first argument n bitpak was expecting an integer and was receiving + a short. This had so far only caused problems on the sun 4. + +noao$mtlocal/camera/cam_keywords.x,cam_rheader.x + Davis, May 21, 1987 + There was a bug in computing -ve decs which only showed up on SUN + iraf. A char constant (integer) was being passed to a char array, + so that the -ve sign was not being printed out. While fixing this + bug I noticed a potential problem for decs in the 0 to -1 degree + range and fixed that. + +noao$mtlocal/camera/cam_rheader.x + Davis, May 7, 1987 + Rcamera has been modified to print an error message if the header record + is not 1026 bytes long. This modification will only work on tape input. + +noao$mtlocal/r2df/r2dfrhdr.x +noao$mtlocal/r2df/r2df.h + Davis, April 2, 1987 + An integer overflow was occuring in r2dfrhdr on the Steward mv10000. + Two shorts were being multiplied together with the result being greater + than MAX_SHORT. This was implicit in the definition of NRECS. I removed + the NRECS definition from the task .h file and forced the computation + of NRECS to be integer. This error would only occur when the lo+ + option was used. + +noao$mtlocal/cyber/cy_keywords.x +noao$mtlocal/idsmtn/wkeywords.x + Hammond, March 28, 1987 + Tasks RIDSMTN and RIDSFILE were writing real values to the image header + user area with only 3 digits of precision. These files had not been + updated since mtlocal$lib/addcards.x was changed to output real values + with a %g rather than a %f format. (See Oct 27 note below.) An argument + passed to addcard_r that was previously interpreted as the number of + decimal places was now being interpreted as the number of digits of + precision. Keywords WPC, W0 and the COEFF array written by RIDSMTN + were affected by this error; keywords WPC, W0 and AIRMASS written by + RIDSFILE were also. + +noao$mtlocal/pds/pds_rpixels + Davis, March 5, 1987 + A minor change was made to pds_rpixels to overcome an apparent compiler + (not optimizer) error on the Sun. A do loop limit parameter was being + overwritten. + +noao$mtlocal/cyber/rrcopy/rc_rbits.x + Hammond, March 2, 1987 + An error in the RCOPY task has been fixed. The error was seen when + reading IPPS rasters with 12 or 20 bit integer pixels. 30 bit pixels + were not affected. + +noao$mtlocal/widsout - +noao$mtlocal/widsout.par - +noao$mtlocal/mkpkg +noao$mtlocal/x_mtlocal.x +noao$mtlocal/mtlocal.cl +noao$mtlocal/mtlocal.men +noao$mtlocal/mtlocal.hd + Valdes, Feb 27, 1987 + The WIDSOUT task has been archived (Tape 2977 - J. Barnes) and removed + as obsolete. The package was modified to remove this task. + +noao$mtlocal/camera/t_rcamera.x: Davis, Jan 20, 1987: + The rcamera task has been modified to accept input from a list + of disk files as well as a list of tape files. This should facilitate + transfers over the ethernet. + +noao$mtlcoal/pds/t_pdsread.x: Davis, Jan 20, 1987 + The rpds task has been modified to accept input from a list of + disk files as well as a list of tape files. This should facilitate + transfers over the ethernet. + +noao$mtlocal/camera/cam_keywords.x: Davis, Jan 12, 1987 + I changed the pargc calls inside the cam_hmscard procedure to pargstr + calls. A character constant which was stored as an integer was being + passed to a routine which expected a char. This bug only showed up on the + SUN and would cause extra 0's and slashes to be encoded in the dec, ra etc + strings. + +noao$mtlocal/pds/t_pdsread.x: Davis, Dec 2, 1986 + The file list parameters was being set to the NULL string when a pds + file was read from disk. The decode_ranges procedure did not detect + this as an error causing the program to loop over the same file + indefinitely. + +noao$mtlocal/camera/cam_keywords.x: Davis, Oct 27, 1986 + I changed the defined constant CENTURY in cam_ymdcard to 100 from 1900. + The current year was being computed as mod (year, CENTURY) and would + have been inaccurate after year 2000. Also removed the mod declaration. + These changes were found in the AOS port. + +noao$mtlocal/pds/pds_rheader.x: Davis, Oct 27, 1986 + The intrinsic function mod was being called with mismatched type + arguments one octal constant and one short. The octal constant was + being converted to an integer. Changed both to type short. + Detected in the AOS port. + +noao$mtlocal/lib/addcards.x: Hammond, Oct 27, 1986 + Header cards containing real values are now written with a %g format + rather than %f. + +noao$mtlocal/cyber/cyber.h, t_ridsfile.x, cy_keywords.x: Hammond, Sep2, 1986 + A field in the RIDSFILE data structure was named POINTER, which + is a reserved keyword that gets translated to 'int'. It has been + renamed POINT. The bug was discovered in Doug's port of IRAF to + DAO's Alliant; it was apparently not a problem on the Vax's. + +noao$mtlocal/r2df/r2dfrhdr.x: Davis, Aug19, 1986 + R2DF was not decoding the header record correctly on the SUN + machines. The header parameters were not being byte-swapped + correctly when BYTE_SWAP2 == NO. + +noao$mtlocal/cyber/t_ridsfile.x, cy_keywords.x: Hammond, Jul23, 1986 + To accomodate the following mod to WIDSTAPE, task RIDSOUT + has been changed to deal with INDEF's in the UT and ST fields. + +onedspec$t_widstape.x: Hammond, Jul23, 1986 + Task WIDSTAPE was generating an overflow error in images that + did't have header entries for ST and UT. These entries were + not being changed from their preset value of INDEFR and then + were multiplied by 3600, causing the overflow. + +__________________________________________________________________________ + + +From Davis July 7, 1986: + +1. A byte-swapping error in the header reading code of RCAMERA was fixed. +The bytes of the 256 header parameters were not being swapped correctly +on the SUN. + +---------------------------------------------------------------------------- + +From Davis June 23, 1986: + +1. A new task R2DF has been added to the MTLOCAL package. R2DF was +written at CTIO to read 2D-frutti data tapes. A few modification were +made in the CTIO code: 1) the header now prints out correctly 2) the +CCD picture number is printed out as a short integer 3) a lot of +extraneous code dealing with image lists was removed. + +--------------------------------------------------------------------------- + +From Davis May 22, 1986: + +1. All records written to the image user area will now be blocked to 80 +characters instead of being of variable length. This change was made to +facilitate the implementation of the image database facilities. +The affected tasks are RCAMERA, RIDSFILE, RIDSMTN, and RIDSOUT. + +--------------------------------------------------------------------------- + +From Hammond Apr 21, 1986: + +Task RIDSMTN can now add an offset to the output filename, so a continuous +sequence of filenames can be generated over more than one night's data. +This was not previously being done correctly. + +----------------------------------------------------------------------------- + +From Davis Apr 17, 1986: + +Changed boolean == false constructs in files t_wcardimage.x and t_reblock.x +to ! boolean. + +---------------------------------------------------------------------------- + +From Davis Apr 4, 1986: + +The format of the RCAMERA DATE-OBS parameter has been changed form +dd-mm-yyyy to dd/mm/yyyy to bring it into conformity with FITS standard. + +___________________________________________________________________________ + +From Davis Mar 9, 1986: + +The order of the REBLOCK parameters outfiles and file_list has been switched +in order to preserve the correct command line sequence + +---------------------------------------------------------------------------- + +From Davis Mar 3, 1986: + +The error checking in WFITS has been corrected so that WFITS terminates if +it encounters a file write error instead of continuing to the next file +as done previously. + +---------------------------------------------------------------------------- + +From Davis Feb 19, 1986: + +1. Rfits and rpds have been fixed so that attempting to delete the last +empty image does not generate a cannot delete protected file message. + +---------------------------------------------------------------------------- + +From Davis Feb 3, 1986: + +1. A mysterious bug in which the date of observation card would sometimes +not appear in the header has been fixed. A newline was missing from the +proceeding header card. + +---------------------------------------------------------------------------- + +From Davis Jan 16, 1986: + +1. Wfits no longer needs write permission to work. However as a consequence +wfits no longer updates the image min and max. + +2. The scaling routines in rfits and wfits fits have been replaced by +appropriate vector operators. + +3. The coordinate transformation parameters are now stored in the user +area and are available to hedit, imgets etc. + +4. Scaled data is now read into real images regardless of the value of +bitpix. + +----------------------------------------------------------------------------- + +From Davis Jan. 5, 1986: + +1. Rfits, rpds and rcamera now open dev$null instead of a temporary disk +file for option make_image = no. This eliminates a lot od disk access overhead +and should speed up these readers considerably. + +2. The default parameter options are now long_header=no and short_header=yes. +Setting the long_header parameter to yes will over-ride the short header +parameter. + +--------------------------------------------------------------------------- + +From Davis Dec. 3, 1985: + +1. Rcamera will now print and store the header parameters ccdpicno and airmass +if defined. + +2. A bug in the fringe scaling parameter calculation in rcamera was fixed. +Currently the mountain programs store this number in floating point format. +This will be changed in future necessitating a corresponding change in +rcamera. + +--------------------------------------------------------------------------- + +From Hammond Oct. 29, 1985: + +1. Installed task rtextimage. The source code shares subdirectory +imtext with wtextimage. + +----------------------------------------------------------------------- +From Valdes Oct. 10, 1985: + +1. Defined widstape from ONEDSPEC package in the DATAIO package. The +source and executable, however, still reside in ONEDSPEC (x_onedutil.e). +Widstape and widsout should be combined and the source put in DATAIO +at some point. +.endhelp diff --git a/noao/mtlocal/camera/README b/noao/mtlocal/camera/README new file mode 100644 index 00000000..2226fbf9 --- /dev/null +++ b/noao/mtlocal/camera/README @@ -0,0 +1 @@ +The code for the camera format reader. diff --git a/noao/mtlocal/camera/cam_keywords.x b/noao/mtlocal/camera/cam_keywords.x new file mode 100644 index 00000000..6b5ad5ef --- /dev/null +++ b/noao/mtlocal/camera/cam_keywords.x @@ -0,0 +1,584 @@ +include <mach.h> +include <imhdr.h> +include "rcamera.h" + +define LEN_KEYWORD 8 + +# CAM_STORE_KEYWORDS -- store CAMERA specific keywords in the IRAF image header. + +procedure cam_store_keywords (parameters, im) + +short parameters[ARB] # Pointer to program data structure +pointer im # Pointer to image + +int fd +real value +int stropen() +errchk stropen, cam_sicard, cam_rcard, cam_hmscard, cam_ymdcard, cam_obscard + +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 cam_sicard (fd, "CCDPICNO", CCD_PICNO(parameters), + "ORIGINAL CCD PICTURE NUMBER") + if (IMAGE_TYPE(parameters) < BEG_IRDATA) { + call cam_sicard (fd, "EXPTIME", ITIME(parameters), + "ACTUAL INTEGRATION TIME (SECONDS)") + call cam_sicard (fd, "DARKTIME", TTIME(parameters), + "TOTAL ELAPSED TIME (SECONDS)") + call cam_sicard (fd, "OTIME", OTIME(parameters), + "SHUTTER OPEN TIME (SECS)") + } else if (IMAGE_TYPE(parameters) >= BEG_IRDATA && + IMAGE_TYPE(parameters) <= END_IRDATA) { + value = TTIME(parameters) / 1000. + OTIME(parameters) + call cam_rcard (fd, "EXPTIME", value, + "ACTUAL INTEGRATION TIME (SECONDS)", 3) + } + + # Observation date, time and position cards + call cam_obscard (fd, "IMAGETYP", IMAGE_TYPE(parameters), + "OBJECT,DARK,BIAS,ETC.") + if (PIC_IRBSCALE(parameters) > 0) { + value = 1.0 / PIC_IRBSCALE(parameters) + call cam_rcard (fd, "IRBSCALE", value, "PICTURE SCALING FACTOR", 3) + } + + call cam_ymdcard (fd, "DATE-OBS", OBS_YR(parameters), + OBS_MON(parameters), OBS_DAY(parameters), "DATE DD/MM/YY") + call cam_hmscard (fd, "RA", RA_HR(parameters), RA_MIN(parameters), + RA_SEC(parameters), "RIGHT ASCENSION (TELESCOPE)") + call cam_hmscard (fd, "DEC", DEC_DEG(parameters), + DEC_MIN(parameters), DEC_SEC(parameters), + "DECLINATION (TELESCOPE)") + value = EPOCH(parameters) / 10. + call cam_rcard (fd, "EPOCH", value, "EPOCH OF RA AND DEC", 2) + call cam_hmscard (fd, "ZD", ZD_DEG(parameters), ZD_MIN(parameters), + ZD_SEC(parameters), "ZENITH DISTANCE") + call cam_hmscard (fd, "UT", UT_HR(parameters), UT_MIN(parameters), + UT_SEC(parameters), "UNIVERSAL TIME") + call cam_hmscard (fd, "ST", ST_HR(parameters), ST_MIN(parameters), + ST_SEC(parameters), "SIDEREAL TIME") + if (AIR_MASS(parameters) != 0) { + value = AIR_MASS(parameters) / 100. + call cam_rcard (fd, "AIRMASS", value, "AIR MASS", 3) + } + + # Observation instrumentation cards + call cam_detcard (fd, "DETECTOR", CAM_HEAD(parameters), + "DETECTOR (CCD TYPE, PHOTON COUNTER, ETC)") + if (GAIN(parameters) != 0) { + value = GAIN(parameters) / 100. + call cam_rcard (fd, "GAIN", value, "GAIN (ELECTRONS/ADU)", 2) + } + if (RDNOISE(parameters) != 0) { + value = RDNOISE(parameters) / 100. + call cam_rcard (fd, "RDNOISE", value, "READOUT NOISE (ELECTRONS)", + 1) + } + if (PREFLASH(parameters) != 0) { + call cam_sicard (fd, "PREFLASH", PREFLASH(parameters), + "PREFLASH TIME (SECONDS)") + } + value = CAM_TEMP(parameters) / 100. + call cam_rcard (fd, "CAMTEMP", value, "CAMERA TEMPERATURE, DEG C", 2) + value = DEW_TEMP(parameters) / 100. + call cam_rcard (fd, "DEWTEMP", value, "DEWAR TEMPRATURE, DEG C", 2) + if (PFLEVEL(parameters) != 0) { + call cam_sicard (fd, "PFLEVEL", PFLEVEL(parameters), + "PREFLASH LEVEL") + } + call cam_2sintcard (fd, "FILTERS", F1POS(parameters), F2POS(parameters), + "FILTER BOLT POSITIONS") + call cam_sicard (fd, "TVFILT", TV_FILTER(parameters), "TV FILTER") + call cam_sicard (fd, "COMPLAMP", COMP_LAMP(parameters), + "COMPARISON LAMP") + if (TILT_POS(parameters) != 0) { + call cam_sicard (fd, "TILTPOS", TILT_POS(parameters), + "TILT POSITION") + } + if (PED_POS(parameters) != 0) { + call cam_sicard (fd, "TELEFOCUS", PED_POS(parameters), + "TELESCOPE FOCUS") + } + + # Reduction flags + if (BIAS_PIX(parameters) != 0) { + call cam_sicard (fd, "BIASPIX", BIAS_PIX(parameters), "") + } + if (BT_FLAG(parameters) != 0) { + call cam_sicard (fd, "OVERSCAN", BT_FLAG(parameters), + "OVERSCAN VALUE SUBTRACTED") + call cam_sicard (fd, "TRIM", short (1), "TRIMMED IMAGE") + } + if (BI_FLAG(parameters) != 0) { + call cam_sicard (fd, "ZEROCOR", BI_FLAG(parameters), + "ZERO IMAGE SUBTRACTED (PREFLASH, BIAS)") + } + if (BP_FLAG(parameters) != 0) { + call cam_sicard (fd, "FIXPIX", BP_FLAG(parameters), + "BAD PIXEL CORRECTION") + } + if (CR_FLAG(parameters) != 0) { + call cam_sicard (fd, "CRFLAG", CR_FLAG(parameters), + "COSMIC RAYS REMOVED") + } + if (DK_FLAG(parameters) != 0) { + call cam_sicard (fd, "DARKCOR", DK_FLAG(parameters), + "DARK SUBTRACTED") + } + if (FF_FLAG(parameters) != 0) { + call cam_sicard (fd, "FLATCOR", FF_FLAG(parameters), + "FLAT FIELD CORRECTION") + } + if (FR_FLAG(parameters) != 0) { + call cam_sicard (fd, "FRINGCOR", FR_FLAG(parameters), + "FRINGING SUBTRACTED") + } + if (FR_SC100(parameters) != 0) { + call bitpak (int (FR_SC100(parameters)), value, 1, 32) + call cam_rcard (fd, "FRINGSCL", value, "FRINGE SCALING", 2) + } + + # Geometry parameters + call cam_section (fd, parameters) + + if (PIC_XSUM(parameters) != 0 && PIC_YSUM(parameters) != 0) { + call cam_2sintcard (fd, "CCDSUM", PIC_XSUM(parameters), + PIC_YSUM(parameters), "ON CHIP SUMMATION (X,Y)") + } + + call close (fd) + +end + + +# CAM_RCARD -- Format and append a FITS header card with a real +# keyword value to the input string buffer. + +procedure cam_rcard (fd, keyword, value, comment, precision) + +int fd # File descriptor of input string buffer +char keyword[LEN_KEYWORD] # 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 + + +# CAM_ICARD -- Format and append a FITS header card with a short integer +# keyword value to the input string buffer. + +procedure cam_icard (fd, keyword, value, comment) + +int fd # File descriptor of input string buffer +char keyword[LEN_KEYWORD] # FITS keyword +int 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 + + +# CAM_SICARD -- Format and append a FITS header card with a short integer +# keyword value to the input string buffer. + +procedure cam_sicard (fd, keyword, value, comment) + +int fd # File descriptor of input string buffer +char keyword[LEN_KEYWORD] # 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 + + +# CAM_CCARD -- Procedure to format a FITS string parameter. + +procedure cam_ccard (fd, keyword, param, maxch, comment) + +int fd # Output file descriptor +char keyword[ARB] # FITS keyword +char param[ARB] # FITS string parameter +int maxch # maximum number of chars in parameter +char comment[ARB] # Comment string + +int i, maxchar, nblanks + +begin + # Trim off trailing blanks and compute length of string to encode. + for (i = maxch; (i >= 1) && param[i] == ' '; i = i - 1) + ; + param[i+1] = EOS + + maxchar = max (LEN_KEYWORD, min (i, LEN_OBJECT)) + nblanks = min (LEN_OBJECT - maxchar + 2, LEN_OBJECT) + + # Print the string. + if (nblanks < 45) { + call fprintf (fd, "%-8.8s= '%*.*s'%33t/ %*.*s\n") + call pargstr (keyword) + call pargi (-maxchar) + call pargi (maxchar) + call pargstr (param) + call pargi (-nblanks) + call pargi (nblanks) + call pargstr (comment) + } else { + call fprintf (fd, "%-8.8s= '%*.*s'%33t/ %-45.-45s\n") + call pargstr (keyword) + call pargi (-maxchar) + call pargi (maxchar) + call pargstr (param) + call pargstr (comment) + } +end + + +# CAM_HMSCARD -- 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. The procedure can be used for RA, DEC +# and ST, UT and HA. + +procedure cam_hmscard (fd, keyword, hours, minutes, seconds, comment) + +int fd # File descriptor +char keyword[LEN_KEYWORD] # FITS keyword +short hours # Hours +short minutes # Minutes +short seconds # Seconds +char comment # Comment string + + +begin + call fprintf (fd, "%-8.8s= '%s%02d:%02d:%02d'%33t/ %-45.45s\n") + call pargstr (keyword) + if (hours < 0 || minutes < 0 || seconds < 0) + call pargstr ("-") + else + call pargstr (" ") + call pargs (abs(hours)) + call pargs (abs(minutes)) + call pargs (abs(seconds)) + call pargstr (comment) +end + + +define CENTURY 100 + +# CAM_YMDCARD - 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. + +procedure cam_ymdcard (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 + +short const + +begin + const = mod (int (years), CENTURY) + call fprintf (fd, "%-8.8s= '%02d/%02d/%02d'%33t/ %-45.45s\n") + call pargstr (keyword) + call pargs (days) + call pargs (months) + call pargs (const) + call pargstr (comment) +end + + +# CAM_OBSCARD -- Procedure to code the object type into a FITS +# card + +procedure cam_obscard (fd, keyword, data_code, comment) + +int fd # File descriptor +char keyword[LEN_KEYWORD] # FITS keyword +short data_code # type of data +char comment[ARB] # coment string + +int nchars +pointer sp, str +int gstrcpy(), itoc() + +begin + call smark (sp) + call salloc (str, LEN_OBJECT, TY_CHAR) + + switch (data_code) { + CASE OBJECT,IROBJECT: + nchars = gstrcpy ("OBJECT", Memc[str], LEN_OBJECT) + CASE DARK,IRDARK: + nchars = gstrcpy ("DARK", Memc[str], LEN_OBJECT) + CASE PFLAT,IRPFLAT: + nchars = gstrcpy ("PROJECTOR FLAT", Memc[str], LEN_OBJECT) + CASE SFLAT,IRSFLAT: + nchars = gstrcpy ("SKY FLAT", Memc[str], LEN_OBJECT) + CASE COMP,IRCOMP: + nchars = gstrcpy ("COMPARISON", Memc[str], LEN_OBJECT) + CASE BIAS,IRBIAS: + nchars =gstrcpy ("BIAS", Memc[str], LEN_OBJECT) + CASE DFLAT,IRDFLAT: + nchars = gstrcpy ("DOME FLAT", Memc[str], LEN_OBJECT) + CASE MASK,IRMASK: + nchars = gstrcpy ("MASK", Memc[str], LEN_OBJECT) + CASE MULT,IRMULT: + nchars = gstrcpy ("MULTIPLE EXP", Memc[str], LEN_OBJECT) + CASE SCAN,IRSCAN: + nchars = gstrcpy ("SCAN", Memc[str], LEN_OBJECT) + case OCCULTATION: + nchars = gstrcpy ("OCCULTATION", Memc[str], LEN_OBJECT) + case IRGRID: + nchars = gstrcpy ("INFRARED GRID", Memc[str], LEN_OBJECT) + case IRSPECTRA: + nchars = gstrcpy ("INFRARED SPECTRA", Memc[str], LEN_OBJECT) + case IRSPECKLE: + nchars = gstrcpy ("INFRARED SPECKLE", Memc[str], LEN_OBJECT) + default: + nchars = itoc (int (data_code), Memc[str], LEN_OBJECT) + } + + call cam_ccard (fd, keyword, Memc[str], nchars, comment) + + call sfree (sp) +end + + +# CAM_DETCARD -- Procedure to code the detector into a FITS card. + +procedure cam_detcard (fd, keyword, data_code, comment) + +int fd # File descriptor +char keyword[LEN_KEYWORD] # FITS keyword +short data_code # type of data +char comment[ARB] # coment string + +int nchars +pointer sp, str +int gstrcpy(), itoc() + +begin + call smark (sp) + call salloc (str, LEN_OBJECT, TY_CHAR) + + switch (data_code) { + CASE TEK1: + nchars = gstrcpy ("TEK1", Memc[str], LEN_OBJECT) + CASE RCA3: + nchars = gstrcpy ("RCA3", Memc[str], LEN_OBJECT) + CASE TI1: + nchars = gstrcpy ("TI1", Memc[str], LEN_OBJECT) + CASE RCA0: + nchars = gstrcpy ("RCA0", Memc[str], LEN_OBJECT) + CASE RCA2: + nchars = gstrcpy ("RCA2", Memc[str], LEN_OBJECT) + CASE RCA1: + nchars = gstrcpy ("RCA1", Memc[str], LEN_OBJECT) + CASE TI2: + nchars = gstrcpy ("TI2", Memc[str], LEN_OBJECT) + CASE TI3: + nchars = gstrcpy ("TI3", Memc[str], LEN_OBJECT) + CASE TI4: + nchars = gstrcpy ("TI4", Memc[str], LEN_OBJECT) + CASE TI5: + nchars = gstrcpy ("TI5", Memc[str], LEN_OBJECT) + default: + nchars = itoc (int (data_code), Memc[str], LEN_OBJECT) + } + + call cam_ccard (fd, keyword, Memc[str], nchars, comment) + + call sfree (sp) +end + + +# CAM_2SINTCARD -- Procedure to encode the filter positions into a FITS card. + +procedure cam_2sintcard (fd, keyword, sint1, sint2, comment) + +int fd # File descriptor +char keyword[LEN_KEYWORD] # FITS keyword +short sint1 # First short integer +short sint2 # Second short integer +char comment[ARB] # comment string + +int maxch +pointer sp, str +int strlen() + +begin + call smark (sp) + call salloc (str, LEN_OBJECT, TY_CHAR) + + call sprintf (Memc[str], LEN_OBJECT, "%d %d") + call pargs (sint1) + call pargs (sint2) + + maxch = max (strlen (Memc[str]), LEN_KEYWORD) + call fprintf (fd, "%-8.8s= '%*.*s'%33t/ %-45.45s\n") + call pargstr (keyword) + call pargi (-maxch) + call pargi (maxch) + call pargstr (Memc[str]) + call pargstr (comment) + + call sfree (sp) +end + + +# CAM_SECTION -- Procedure to encode the camera keywords which are formated +# like sections. + +procedure cam_section (fd, parameters) + +int fd # pointer to string file descriptor +short parameters[ARB] # list of parameters + +int nx1, nx2, ny1, ny2, maxch +pointer sp, str +int strlen() + +begin + call smark (sp) + call salloc (str, LEN_OBJECT, TY_CHAR) + + # Redefine the dimensions. + if (PIC_NXRAW(parameters) <= 0) + PIC_NXRAW(parameters) = PIC_NX(parameters) + if (PIC_NYRAW(parameters) <= 0) + PIC_NYRAW(parameters) = PIC_NY(parameters) + + # Write the DATASEC keyword. + nx1 = 1 + PIC_XPRE(parameters) + PIC_NXOFF(parameters) + nx2 = PIC_XPRE(parameters) + PIC_NXOFF(parameters) + PIC_NX(parameters) + ny1 = 1 + PIC_YPRE(parameters) + PIC_NYOFF(parameters) + ny2 = PIC_YPRE(parameters) + PIC_NYOFF(parameters) + PIC_NY(parameters) + call sprintf (Memc[str], LEN_OBJECT, "[%d:%d,%d:%d]") + call pargi (nx1) + call pargi (nx2) + call pargi (ny1) + call pargi (ny2) + maxch = strlen (Memc[str]) + call cam_ccard (fd, "DATASEC", Memc[str], maxch, + "IMAGE PORTION OF FRAME") + + # Write the BIASSEC keyword. + if (BT_FLAG(parameters) == 0) { + + if (PIC_XPRE(parameters) != 0) { + nx1 = 1 + PIC_S1(parameters) + nx2 = PIC_X0(parameters) - PIC_S2(parameters) + ny1 = 1 + PIC_YPRE(parameters) + PIC_YT1(parameters) + ny2 = PIC_YPRE(parameters) + PIC_NYRAW(parameters) - + PIC_YT2(parameters) + } + if (PIC_X0(parameters) != 0) { + nx1 = 1 + PIC_XPRE(parameters) + PIC_NXRAW(parameters) + + PIC_S1(parameters) + nx2 = PIC_XPRE(parameters) + PIC_NXRAW(parameters) + + PIC_X0(parameters) - PIC_S2(parameters) + ny1 = 1 + PIC_YPRE(parameters) + PIC_YT1(parameters) + ny2 = PIC_YPRE(parameters) + PIC_NYRAW(parameters) - + PIC_YT2(parameters) + } + + if (PIC_YPRE(parameters) != 0) { + nx1 = 1 + PIC_XPRE(parameters) + PIC_XT1(parameters) + nx2 = PIC_XPRE(parameters) + PIC_NXRAW(parameters) - + PIC_XT2(parameters) + ny1 = 1 + PIC_S1(parameters) + ny2 = PIC_Y0(parameters) - PIC_S2(parameters) + } + if (PIC_Y0(parameters) != 0) { + nx1 = 1 + PIC_XPRE(parameters) + PIC_XT1(parameters) + nx2 = PIC_XPRE(parameters) + PIC_NXRAW(parameters) - + PIC_XT2(parameters) + ny1 = 1 + PIC_YPRE(parameters) + PIC_NYRAW(parameters) + + PIC_S1(parameters) + ny2 = PIC_YPRE(parameters) + PIC_NYRAW(parameters) + + PIC_Y0(parameters) - PIC_S2(parameters) + } + + call sprintf (Memc[str], LEN_OBJECT, "[%d:%d,%d:%d]") + call pargi (nx1) + call pargi (nx2) + call pargi (ny1) + call pargi (ny2) + maxch = strlen (Memc[str]) + call cam_ccard (fd, "BIASSEC", Memc[str], maxch, + "OVERSCAN PORTION OF FRAME") + } + + # Write the TRIMSEC keyword. + if (BT_FLAG(parameters) == 0) { + nx1 = 1 + PIC_XPRE(parameters) +PIC_NXOFF(parameters) + + PIC_XT1(parameters) + nx2 = PIC_XPRE(parameters) + PIC_NXOFF(parameters) + + PIC_NX(parameters) - PIC_XT2(parameters) + ny1 = 1 + PIC_YPRE(parameters) + PIC_NYOFF(parameters) + + PIC_YT1(parameters) + ny2 = PIC_YPRE(parameters) + PIC_NYOFF(parameters) + + PIC_NY(parameters) - PIC_YT2(parameters) + call sprintf (Memc[str], LEN_OBJECT, "[%d:%d,%d:%d]") + call pargi (nx1) + call pargi (nx2) + call pargi (ny1) + call pargi (ny2) + maxch = strlen (Memc[str]) + call cam_ccard (fd, "TRIMSEC", Memc[str], maxch, + "REGION TO BE EXTRACTED AFTER PROC") + } + + # Write the CCDSEC keyword. + nx1 = 1 + PIC_XPRE(parameters) + nx2 = PIC_XPRE(parameters) + PIC_NXRAW(parameters) + ny1 = 1 + PIC_XPRE(parameters) + ny2 = PIC_YPRE(parameters) + PIC_NYRAW(parameters) + call sprintf (Memc[str], LEN_OBJECT, "[%d:%d,%d:%d]") + call pargi (nx1) + call pargi (nx2) + call pargi (ny1) + call pargi (ny2) + maxch = strlen (Memc[str]) + call cam_ccard (fd, "CCDSEC", Memc[str], maxch, + "ORIENTATION TO FULL FORMAT FRAME") + + # Write the ORIGSEC keyword. + nx1 = 1 + PIC_XPRE(parameters) + nx2 = PIC_XPRE(parameters) + PIC_NXRAW(parameters) + ny1 = 1 + PIC_XPRE(parameters) + ny2 = PIC_YPRE(parameters) + PIC_NYRAW(parameters) + call sprintf (Memc[str], LEN_OBJECT, "[%d:%d,%d:%d]") + call pargi (nx1) + call pargi (nx2) + call pargi (ny1) + call pargi (ny2) + maxch = strlen (Memc[str]) + call cam_ccard (fd, "ORIGSEC", Memc[str], maxch, + "ORIGINAL SIZE OF FULL FORMAT FRAME") + + call sfree (sp) +end diff --git a/noao/mtlocal/camera/cam_longhdr.x b/noao/mtlocal/camera/cam_longhdr.x new file mode 100644 index 00000000..7d4936e1 --- /dev/null +++ b/noao/mtlocal/camera/cam_longhdr.x @@ -0,0 +1,153 @@ +include <mach.h> +include "rcamera.h" + +define LEN_KEYWORD 8 + +# CAM_LONG_HEADER -- Print CAMERA longheader on the standard output. + +procedure cam_long_header (parameters, text) + +short parameters[ARB] # Pointer to program data structure +char text[ARB] # ID string + +real value +errchk cam_sicard, cam_rcard, cam_hmscard, cam_ymdcard, cam_obscard + +begin + # FITS keyword are formatted and appended to the image user area. + call cam_ccard (STDOUT, "OBJECT", text, LEN_CAM_TEXT, + "TITLE OF IMAGE") + call cam_sicard (STDOUT, "NAXIS1", NAXIS1(parameters), + "NUMBER OF IMAGE COLUMNS") + call cam_sicard (STDOUT, "NAXIS2", NAXIS2(parameters), + "NUMBER OF IMAGE ROWS") + call cam_sicard (STDOUT, "RECLEN", REC_LEN(parameters), + "RCAMERA RECORD LENGTH") + call cam_sicard (STDOUT, "CCDPICNO", CCD_PICNO(parameters), + "ORIGINAL CCD PICTURE NUMBER") + if (IMAGE_TYPE(parameters) < BEG_IRDATA) { + call cam_sicard (STDOUT, "EXPTIME", ITIME(parameters), + "ACTUAL INTEGRATION TIME (SECONDS)") + call cam_sicard (STDOUT, "DARKTIME", TTIME(parameters), + "TOTAL ELAPSED TIME (SECONDS)") + call cam_sicard (STDOUT, "OTIME", OTIME(parameters), + "ACTUAL INTEGRATION TIME (SECS)") + } else if (IMAGE_TYPE(parameters) >= BEG_IRDATA && + IMAGE_TYPE(parameters) <= END_IRDATA) { + value = TTIME(parameters) / 1000. + OTIME(parameters) + call cam_rcard (STDOUT, "EXPTIME", value, + "ACTUAL INTEGRATION TIME (SECONDS)", 3) + } + + # Observation date, time and position cards + call cam_obscard (STDOUT, "IMAGETYP", IMAGE_TYPE(parameters), + "OBJECT,DARK,BIAS,ETC.") + if (PIC_IRBSCALE(parameters) > 0) { + value = 1.0 / PIC_IRBSCALE(parameters) + call cam_rcard (STDOUT, "IRBSCALE", value, "PICTURE SCALING FACTOR", + 3) + } + call cam_ymdcard (STDOUT, "DATE-OBS", OBS_YR(parameters), + OBS_MON(parameters), OBS_DAY(parameters), "DATE DD/MM/YY") + call cam_hmscard (STDOUT, "RA", RA_HR(parameters), RA_MIN(parameters), + RA_SEC(parameters), "RIGHT ASCENSION (TELESCOPE)") + call cam_hmscard (STDOUT, "DEC", DEC_DEG(parameters), + DEC_MIN(parameters), DEC_SEC(parameters), + "DECLINATION (TELESCOPE)") + value = EPOCH(parameters) / 10. + call cam_rcard (STDOUT, "EPOCH", value, "EPOCH OF RA AND DEC", 2) + call cam_hmscard (STDOUT, "ZD", ZD_DEG(parameters), ZD_MIN(parameters), + ZD_SEC(parameters), "ZENITH DISTANCE") + call cam_hmscard (STDOUT, "UT", UT_HR(parameters), UT_MIN(parameters), + UT_SEC(parameters), "UNIVERSAL TIME") + call cam_hmscard (STDOUT, "ST", ST_HR(parameters), ST_MIN(parameters), + ST_SEC(parameters), "SIDEREAL TIME") + if (AIR_MASS(parameters) != 0) { + value = AIR_MASS(parameters) / 100. + call cam_rcard (STDOUT, "AIRMASS", value, "AIR MASS", 3) + } + + # Observation instrumentation cards + call cam_detcard (STDOUT, "DETECTOR", CAM_HEAD(parameters), + "DETECTOR (CCD TYPE, PHOTON COUNTER, ETC)") + if (GAIN(parameters) != 0) { + value = GAIN(parameters) / 100. + call cam_rcard (STDOUT, "GAIN", value, "GAIN (ELECTRONS/ADU)", 2) + } + if (RDNOISE(parameters) != 0) { + value = RDNOISE(parameters) / 100. + call cam_rcard (STDOUT, "RDNOISE", value, + "READOUT NOISE (ELECTRONS)", 1) + } + if (PREFLASH(parameters) != 0) { + call cam_sicard (STDOUT, "PREFLASH", PREFLASH(parameters), + "PREFLASH TIME (SECONDS)") + } + value = CAM_TEMP(parameters) / 100. + call cam_rcard (STDOUT, "CAMTEMP", value, "CAMERA TEMPERATURE, DEG C", + 2) + value = DEW_TEMP(parameters) / 100. + call cam_rcard (STDOUT, "DEWTEMP", value, "DEWAR TEMPRATURE, DEG C", 2) + if (PFLEVEL(parameters) != 0) { + call cam_sicard (STDOUT, "PFLEVEL", PFLEVEL(parameters), + "PREFLASH LEVEL") + } + call cam_2sintcard (STDOUT, "FILTERS", F1POS(parameters), F2POS(parameters), + "FILTER BOLT POSITIONS") + call cam_sicard (STDOUT, "TVFILT", TV_FILTER(parameters), "TV FILTER") + call cam_sicard (STDOUT, "COMPLAMP", COMP_LAMP(parameters), + "COMPARISON LAMP") + if (TILT_POS(parameters) != 0) { + call cam_sicard (STDOUT, "TILTPOS", TILT_POS(parameters), + "TILT POSITION") + } + if (PED_POS(parameters) != 0) { + call cam_sicard (STDOUT, "TELEFOCUS", PED_POS(parameters), + "TELESCOPE FOCUS") + } + + # Reduction flags + if (BIAS_PIX(parameters) != 0) { + call cam_sicard (STDOUT, "BIASPIX", BIAS_PIX(parameters), "") + } + if (BT_FLAG(parameters) != 0) { + call cam_sicard (STDOUT, "OVERSCAN", BT_FLAG(parameters), + "OVERSCAN SUBTRACTED") + call cam_sicard (STDOUT, "TRIM", short (1), "TRIMMED IMAGE") + } + if (BI_FLAG(parameters) != 0) { + call cam_sicard (STDOUT, "ZEROCOR", BI_FLAG(parameters), + "ZERO LEVEL SUBTRACTED (PREFLASH, BIAS)") + } + if (BP_FLAG(parameters) != 0) { + call cam_sicard (STDOUT, "FIXPIX", BP_FLAG(parameters), + "BAD PIXEL CORRECTION") + } + if (CR_FLAG(parameters) != 0) { + call cam_sicard (STDOUT, "CRFLAG", CR_FLAG(parameters), + "COSMIC RAYS REMOVED") + } + if (DK_FLAG(parameters) != 0) { + call cam_sicard (STDOUT, "DARKCOR", DK_FLAG(parameters), + "DARK SUBTRACTED") + } + if (FF_FLAG(parameters) != 0) { + call cam_sicard (STDOUT, "FLATCOR", FF_FLAG(parameters), + "FLAT FIELD CORRECTION") + } + if (FR_FLAG(parameters) != 0) { + call cam_sicard (STDOUT, "FRINGCOR", FR_FLAG(parameters), + "FRINGING SUBTRACTED") + } + if (FR_SC100(parameters) != 0) { + call bitpak (int (FR_SC100(parameters)), value, 1, 32) + call cam_rcard (STDOUT, "FRINGSCL", value, "FRINGE SCALING", 2) + } + + call cam_section (STDOUT, parameters) + + if (PIC_XSUM(parameters) != 0 && PIC_YSUM(parameters) != 0) { + call cam_2sintcard (STDOUT, "CCDSUM", PIC_XSUM(parameters), + PIC_YSUM(parameters), "ON CHIP SUMMATION (X,Y)") + } +end diff --git a/noao/mtlocal/camera/cam_read.x b/noao/mtlocal/camera/cam_read.x new file mode 100644 index 00000000..06396c0b --- /dev/null +++ b/noao/mtlocal/camera/cam_read.x @@ -0,0 +1,139 @@ +include <error.h> +include <imhdr.h> +include "rcamera.h" + +# CAM_READ -- Convert a CAMERA file into an IRAF imagefile. +# An EOT is signalled by returning EOF. + +int procedure cam_read (camfile, iraffile, image_ranges, nimages) + +char camfile[ARB] +char iraffile[ARB] +int image_ranges[ARB] +int nimages + +char irafname[SZ_FNAME] +int cam_fd, image_number, image_count, stat, nrecs +long loffset +pointer im + +int cam_read_header(), mtopen(), immap(), get_next_number() +int mt_skip_record() +int strlen() +long note() + +errchk salloc, cam_read_header, mtopen, close, immap, imdelete +errchk mt_skip_record, cam_read_image + +include "rcamera.com" + +begin + # Open input CAMERA file. If an error occurs on open file is at EOT + cam_fd = mtopen (camfile, READ_ONLY, 0) + + image_count = 1 + image_number = 0 + + # loop over the image list + while (get_next_number (image_ranges, image_number) != EOF) { + + # Read header. An EOF status from cam_read_header will cause READ_ + # CAMERA to skip to the next tape file. + + while (image_count <= image_number) { + + # An EOF mean end of file. If the image number is not + # in the image list the appropriate number of records + # are skipped. READ_HEADER returns the the number of + # data records to be skipped if the input is from tape + # or the number of chars to be skipped in the disk file + # to read the next header. + + stat = cam_read_header (cam_fd) + + if (stat == EOF) + + break + + else if (image_number != image_count) { + + if (tape == YES) + nrecs = mt_skip_record (cam_fd, stat) + else { + loffset = note (cam_fd) + call seek (cam_fd, loffset + stat) + } + + } else { + + # add image number to output file name + call strcpy (iraffile, irafname, SZ_FNAME) + if (nimages > 1) { + call sprintf (irafname[strlen(irafname)+1], SZ_FNAME, + ".%03d") + call pargi (image_number) + } + + # Print long or short header + if (long_header == YES || short_header == YES) { + if (make_image == YES) { + call printf ("File: %s ") + call pargstr (irafname) + } 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", irafname, SZ_FNAME) + im = immap (irafname, NEW_IMAGE, LEN_USER_AREA) + + # Decode the image header + call cam_rparams (im) + + # Create an IRAF image if desired + if (make_image == YES) + call cam_read_image (cam_fd, im) + + if (long_header == YES) + call printf ("\n") + + # Close files and clean up + call imunmap (im) + if (make_image == NO) + call imdelete (irafname) + + # If headers only skip data records + if (make_image == NO) { + if (tape == YES) + nrecs = mt_skip_record (cam_fd, stat) + else { + loffset = note (cam_fd) + call seek (cam_fd, loffset + stat) + } + } + + } + + image_count = image_count + 1 + } + + if (stat == EOF) + break + } + + # Close tape file + call close (cam_fd) + + # Return status + if (image_count == 1) + return (EOF) + else + return (OK) +end diff --git a/noao/mtlocal/camera/cam_rheader.x b/noao/mtlocal/camera/cam_rheader.x new file mode 100644 index 00000000..258a5f4a --- /dev/null +++ b/noao/mtlocal/camera/cam_rheader.x @@ -0,0 +1,141 @@ +include <imhdr.h> +include <mach.h> +include <fset.h> +include "rcamera.h" + +# CAM_READ_HEADER -- Read a CAMERA header. +# If EOF is reached the routine returns EOF, otherwise it returns the +# number of data records in the CAMERA image file. + +int procedure cam_read_header (cam_fd) + +int cam_fd + +char text[LEN_CAM_TEXT], header[LEN_HEADER * SZ_SHORT] +int i, sz_rec, nbytes +pointer im +short parameters[LEN_CAM_PARAMETERS] +int read(), cam_roundup(), fstati() + +# entry points +int cam_rparams() +errchk cam_decode_header, read, chrupk, bswaps +include "rcamera.com" + +begin + # Read in header record. + sz_rec = cam_roundup (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 CAMERA header") + if (tape == YES) { + nbytes = fstati (cam_fd, F_SZBBLK) + if ((nbytes != SZB_CHAR * LEN_HEADER) && (nbytes != SZB_CHAR * + (LEN_HEADER+ 1))) + call error (0, "Not a camera file") + } + + # If the least significant byte is first byteswap the camera + # parameters otherwise byteswap the header text. Return the + # number of data records which is stored in parameters[4]. + + if (lsbf == YES) + call bswap2 (header, 2 * LEN_CAM_PARAMETERS + 1, header, + 2 * LEN_CAM_PARAMETERS + 1, LEN_CAM_TEXT) + if (lsbf != BYTE_SWAP2) + call bswap2 (header, 1, header, 1, 2 * LEN_CAM_PARAMETERS) + call bytmov (header, 1, parameters, 1, LEN_CAM_PARAMETERS * 2) + + # If tape return the number of tape data records to skip, otherwise + # return the number of chars to skip. An error will occur if the + # number of tape bytes to skip is not an integral number of chars. + + if (tape == YES) + return (int (parameters[4])) + else + return (int (parameters[4]) * int (parameters[25]) * 2 / SZB_CHAR) + +# Decode the header parameters. +entry cam_rparams (im) + + # Extract and trim the header text. + call bytmov (header, 2 * LEN_CAM_PARAMETERS + 1, text, 1, LEN_CAM_TEXT) + call chrupk (text, 1, text, 1, LEN_CAM_TEXT) + for (i = LEN_CAM_TEXT; text[i] == ' ' && i >= 1; i = i - 1) + ; + text[i+1] = EOS + + # Put the CAMERA parameters in the IRAF image header. + call cam_decode_header (im, parameters, text) + call cam_print_header (parameters, text) + + return (OK) +end + + +# CAM_DECODE_HEADER -- Decode a CAMERA header record. + +procedure cam_decode_header (im, parameters, text) + +pointer im +short parameters[ARB] +char text[ARB] + +include "rcamera.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 cam_store_keywords (parameters, im) + } +end + + +# CAM_PRINT_HEADER -- Print the CAMERA header + +procedure cam_print_header (parameters, text) + +short parameters[ARB] +char text[ARB] + +include "rcamera.com" + +begin + if (long_header == YES) + call cam_long_header (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 + + +# CAM_ROUNDUP -- Procedure to round an integer to the next highest number +# divisible by base. + +int procedure cam_roundup (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/camera/cam_rimage.x b/noao/mtlocal/camera/cam_rimage.x new file mode 100644 index 00000000..296683bf --- /dev/null +++ b/noao/mtlocal/camera/cam_rimage.x @@ -0,0 +1,71 @@ +include <imhdr.h> +include <mach.h> +include "rcamera.h" + +# CAM_READ_IMAGE -- Read CAMERA image pixels to IRAF image file. + +procedure cam_read_image (cam_fd, im) + +int cam_fd +pointer im + +int i, nlines +short linemin, linemax +pointer buf +long v[IM_MAXDIM] + +int cam_init_read_pixels(), cam_read_pixels(), impnls() +long clktime() +errchk impnls, init_read_pixels(), read_pixels() + +include "rcamera.com" + +begin + call cam_set_image_header (im) + + if (NAXIS(im) == 0) + return + + IRAFMAX(im) = -MAX_REAL + IRAFMIN(im) = MAX_REAL + + call amovkl (long(1), v, IM_MAXDIM) + + nlines = PARAM6(im) + + # CAMERA data is converted to type SHORT. + i= cam_init_read_pixels (len_record, BITPIX, TY_SHORT) + + do i = 1, nlines { + if (impnls (im, buf, v) == EOF) + call error (3, "Error writing CAMERA data") + if (cam_read_pixels (cam_fd, Mems[buf], PARAM5(im)) != + PARAM5(im)) + call error (4, "Error reading CAMERA 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 + + +# CAM_SET_IMAGE_HEADER -- Set remaining header fields not set in read_header. + +procedure cam_set_image_header (im) + +pointer im + +include "rcamera.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/camera/cam_rpixels.x b/noao/mtlocal/camera/cam_rpixels.x new file mode 100644 index 00000000..3a10e650 --- /dev/null +++ b/noao/mtlocal/camera/cam_rpixels.x @@ -0,0 +1,127 @@ +include <mii.h> +include <mach.h> +include <fset.h> + +# CAM_INIT_READ_PIXELS and READ_PIXELS -- 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 cam_read_pixels returns the next npix pixels. +# Read_pixels returns EOF or the number of pixels converted. +# Cam_init_read_pixels must be called before cam_read_pixels. +# +# 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 CAMERA 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 cam_init_read_pixels (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 cam_read_pixels (fd, buffer, npix) +int cam_read_pixels +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() + +include "rcamera.com" + +errchk miilen, mfree, malloc, read, miiup +data mii/NULL/, spp/NULL/ + + +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 cam_read_pixels (fd, buffer, npix) + + op = 0 + nchars = npix * sizeof (ty_spp) + repeat { + + # If data is exhausted read the next record + + if (ip + nchars > nch_rec) { # Modified for CAMERA 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 CAMERA 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/camera/mkpkg b/noao/mtlocal/camera/mkpkg new file mode 100644 index 00000000..291f5011 --- /dev/null +++ b/noao/mtlocal/camera/mkpkg @@ -0,0 +1,17 @@ +# Rcamera Library + +$checkout libpkg.a ../ +$update libpkg.a +$checkin libpkg.a ../ +$exit + +libpkg.a: + t_rcamera.x rcamera.com <fset.h> <error.h> + cam_read.x rcamera.com rcamera.h <imhdr.h> <error.h> + cam_rimage.x rcamera.com rcamera.h <imhdr.h> <mach.h> + cam_rheader.x rcamera.com rcamera.h <imhdr.h> <mach.h>\ + <fset.h> + cam_rpixels.x rcamera.com <mii.h> <mach.h> <fset.h> + cam_keywords.x rcamera.h <imhdr.h> <mach.h> + cam_longhdr.x rcamera.h <mach.h> + ; diff --git a/noao/mtlocal/camera/rcamera.com b/noao/mtlocal/camera/rcamera.com new file mode 100644 index 00000000..3b80c320 --- /dev/null +++ b/noao/mtlocal/camera/rcamera.com @@ -0,0 +1,14 @@ +# CAMERA 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 CAMERA 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/camera/rcamera.doc b/noao/mtlocal/camera/rcamera.doc new file mode 100644 index 00000000..f381308e --- /dev/null +++ b/noao/mtlocal/camera/rcamera.doc @@ -0,0 +1,82 @@ + + +NAME + rcamera -- Convert Kitt Peak CAMERA image files to IRAF image files + + +USAGE + rcamera [camera_file, file_list, iraf_file] + + +DESCRIPTION + Kitt Peak CAMERA format image data is read from the specified + source; either a disk file or magnetic tape. The CAMERA header may + optionally be printed on the standard output as either a full + listing or a short description. Image data may optionally be + converted to an IRAF image of specified data type. + + +PARAMETERS + + camera_file + The CAMERA data source. If the data source is a disk file or + an explict tape file specification of the form mt*[n] where n + is a file number then only that file is converted. If the + general tape device name is given, i.e. mta, mtb800, etc, then + the files specified by the files parameter will be read from + the tape. + + file_list + The files to be read from a tape are specified by the file_list + string. The string can consist of any sequence of file numbers + separated by at least one of whitespace, comma, or dash. A + dash specifies a range of files. For example the string + + 1 2, 3 - 5,8-6 + + will convert the files 1 through 8. + + iraf_file + The IRAF file which will receive the CAMERA data if the + read_image parameter switch is set. For tape files specified + by the file_list parameter the filename will be used as a + prefix and the file number will be appended. Otherwise, the + file will be named as specified. Thus, reading files 1 and 3 + from a CAMERA tape with a filename of data will produce the + files data1 and data3. It is legal to use a null filename. + + make_image + This switch determines whether CAMERA image data is converted + to an IRAF image file. This switch is set to no to obtain just + header information with the long_header or short_header + switches. + + long_header + If this switch is set the full CAMERA header is printed on the + standard output. + + short_header + If this switch is set only the output filename, the title + string, and the image dimensions are printed. + + standard_format + The CAMERA standard format has the least significant byte + first. Some CAMERA data, however, does not follow this byte + order convention. Thus, to read the non-standard CAMERA data + this parameter is set to no. + + datatype + The IRAF image file may be of a different data type than the + CAMERA image data. The data type may be specified as s for + short, l for long, r for real, and d for double. The user must + beware of truncation problems if an inappropriate data type is + specified. If an incorrect data_type or a null string is given + for this parameter then a default data type is used which is + the appropriate minimum size for the input pixel values. + + +OTHER PROCEDURES TO BE LINKED + + decode_ranges() in xtools + get_next_number() in xtools + get_data_type() in xtools diff --git a/noao/mtlocal/camera/rcamera.h b/noao/mtlocal/camera/rcamera.h new file mode 100644 index 00000000..3e97a5ab --- /dev/null +++ b/noao/mtlocal/camera/rcamera.h @@ -0,0 +1,168 @@ +# CAMERA Definitions + +# The CAMERA standard readable by the CAMERA reader: +# +# 1. 8 bits / byte +# 2. ASCII character code +# 3. 16 bit, twos complement with least significant bytes first +# +# The following deviations from the CAMERA standard are allowed: +# +# A user specified flag allows selecting most significant byte format + +define CAM_BYTE 8 # Number of bits in CAMERA byte +define BITPIX 16 # Bits per CAMERA data values +#define LSBF YES # Least Significant Byte First +define LEN_CAM_PARAMETERS 256 # Number of CAMERA header parameters +define LEN_CAM_TEXT 64 # Length of CAMERA text +define LEN_HEADER 513 # Number of 16 bit words in the header + +# Mapping of CAMERA 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 64 + +# Define IRAF coordinate transformation keywords +# No longer in use, may wish to change in future + +define CRVAL CT_CRVAL(IM_CTRAN($1), $2) +define CRPIX CT_CRPIX(IM_CTRAN($1), $2) +define CDELT CT_CDELT(IM_CTRAN($1), $2) +define CROTA CT_CROTA(IM_CTRAN($1), $2) +define CTYPE CT_CTYPE(IM_CTRAN($1)) + +# 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 + +define CCD_PICNO $1[2] # CCD picture number +define IMAGE_TYPE $1[3] # Data type, object, bias etc. +define NRECS $1[4] # Number of DATA records +define NAXIS1 $1[5] # Number of columns +define NAXIS2 $1[6] # Number of rows +define ITIME $1[7] # Integration time in seconds +define TTIME $1[8] # Total time in seconds +define OTIME $1[9] # Open time in seconds +define UT_HR $1[10] # Universal time +define UT_MIN $1[11] # +define UT_SEC $1[12] # +define ZD_DEG $1[13] # Zenith distance +define ZD_MIN $1[14] # +define ZD_SEC $1[15] # +define OBS_MON $1[16] # Date of observation +define OBS_DAY $1[17] # +define OBS_YR $1[18] # +define ST_HR $1[19] # Sidereal time +define ST_MIN $1[20] # +define ST_SEC $1[21] # +define EPOCH $1[22] # Epoch of RA and DEC +define REC_LEN $1[25] # Length of a data record +define BIAS_PIX $1[26] # +define RA_HR $1[27] # RA +define RA_MIN $1[28] # +define RA_SEC $1[29] # +define DEC_DEG $1[30] # Declination +define DEC_MIN $1[31] # +define DEC_SEC $1[32] # +define CAM_TEMP $1[33] # Camera temperature +define DEW_TEMP $1[34] # Dewar temperature +define CAM_HEAD $1[35] # Camera head ID +define F1POS $1[36] # Position of filter bolt 1 +define F2POS $1[37] # Position of filter bolt 2 +define TV_FILTER $1[38] # TV filter +define COMP_LAMP $1[39] # Comparison lamp +define TILT_POS $1[40] # Tilt position +define PED_POS $1[41] # Pedestal positions +define AIR_MASS $1[42] # Airmass * 100 +define GAIN $1[47] # Gain +define PREFLASH $1[48] # Preflash +define PFLEVEL $1[49] # Preflash level +define RDNOISE $1[50] # Readout noise +define BT_FLAG $1[51] # Bias trim flag +define BP_FLAG $1[52] # Bad pixel cleaning flag +define CR_FLAG $1[53] # Cosmic ray cleaning flag +define DK_FLAG $1[54] # Dark subtraction flag +define FF_FLAG $1[55] # Flat field flag +define FR_FLAG $1[56] # Fringe correction flag +define FR_SC100 $1[57] # Fringe scaling parameter X 100 +define FR_SC1 $1[58] # Fringe scaling parameter X 1 +define BI_FLAG $1[59] # Bias subtract flag +define PIC_NX $1[61] # Number of x pixels in frame +define PIC_NY $1[62] # Number of y pixels in frame +define PIC_X0 $1[63] # Overscan pixels in x +define PIC_Y0 $1[64] # Overscan pixels in y +define PIC_XSUM $1[65] # Summed pixels in x +define PIC_YSUM $1[66] # Summed pixels in y +define PIC_XPRE $1[67] # Prescan pixels in x +define PIC_YPRE $1[68] # Prescan pixels in y +define PIC_NXRAW $1[69] # Full format pixels in x +define PIC_NYRAW $1[70] # Full format pixels in y +define PIC_NXOFF $1[71] # X offset from data in full format +define PIC_NYOFF $1[72] # Y offset from data in full format +define PIC_XT1 $1[73] # X pixels to skip at data start +define PIC_XT2 $1[74] # X pixels to skip at data end +define PIC_YT1 $1[75] # Y pixels to skip at data start +define PIC_YT2 $1[76] # Y pixels to skip at data end +define PIC_S1 $1[77] # Pixels to ignore start/end prescan +define PIC_S2 $1[78] # Pixels to ignore start/end prescan +define PIC_IRBSCALE $1[146] # Picture scaling factor + +# define image data types + +define BEG_IRDATA 32 +define END_IRDATA 44 + +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 +define OCCULTATION 10 + +define IROBJECT 32 +define IRDARK 33 +define IRPFLAT 34 +define IRSFLAT 35 +define IRCOMP 36 +define IRBIAS 37 +define IRDFLAT 38 +define IRMASK 39 +define IRMULT 40 +define IRSCAN 41 +define IRGRID 42 +define IRSPECTRA 43 +define IRSPECKLE 44 + +# define the instrument types + +define TEK1 1 +define RCA3 2 +define TI1 3 +define RCA0 4 +define RCA2 5 +define RCA1 6 +define TI2 7 +define TI3 8 +define TI4 9 +define TI5 10 diff --git a/noao/mtlocal/camera/structure.hlp b/noao/mtlocal/camera/structure.hlp new file mode 100644 index 00000000..73b24959 --- /dev/null +++ b/noao/mtlocal/camera/structure.hlp @@ -0,0 +1,104 @@ +.help rcamera 2 "Program Structure" +.sh +RCAMERA Structure Chart + +.nf +t_rcamera () +# Returns when file list is satisfied or if EOT is encountered +# Errors from called routines are trapped and printed as a warning. + + read_camera (camfile, iraffile) + # Returns OK or EOF + + read_header (cam_fd, im) + # Returns OK or EOF + + decode_camera (im, parameters, text) + + prheader (parameters, text) + + prcam (parameters, text) + + prcam1 (parameters, text) + + read_image (cam_fd, im) + # Invokes error handler if EOF is encountered + + set_image_header (im) + + init_read_pixels (npix_record, bitpix, lsbf, spp_type) + # Returns OK + + read_pixels (fd, buffer, npix) + # Returns EOF or the number of pixels converted +.fi + +.sh +RCAMERA Structure Summary + +.ls 4 t_rcamera +The main procedure reads the control parameters. +The files to be read and converted are calculated from the specified source +and file list. A loop through +the files determines the specific input source names and output filenames +and calls READ_CAMERA for each conversion. +.ls read_camera +The input source is opened and the output image header file is created. +If only the CAMERA header is to be listed then a temporary image header file +is created. The CAMERA header is read and decoded into the IRAF image +header by READ_HEADER. If the image is to be read then MAKE_IMAGE is +called. Finally, all files are closed. If a temporary image header file +was created it is deleted. +.ls read_header +The CAMERA header is read into an array of short parameters and a +character array of text. If EOF is encountered +then EOF is returned. The parameter and text arrays are passed to +DECODE_CAMERA to set the IRAF image file header. The arrays are also +passed to PRHEADER to print the header information. +The routine returns OK if the header was successfully read or EOF +if encountered. All other errors are returned +via the error handler. +.ls decode_camera +The appropriate parameters are taken from the CAMERA header and put into +the IRAF image file header. +.le +.ls prheader +If the short_header switch is set then the image title and size are printed. +If the long_header switch is set then PRCAM is called to print the long +header. +.ls prcam +The CAMERA header information is formatted and printed. Because of a string +limitation in the SPP half of the header information must be printed by +a call to PRCAM1. +.ls prcam1 +The second half of the CAMERA header information is formatted and printed. +.le +.le +.le +.le +.ls read_image +The CAMERA image pixels are converted to an IRAF image file. +The image file header is set. +The lines of the image are converted one at a time. +.ls set_image_header +The pixel type for the IRAF image is set to the user specified type. +If no type has been specified then the type is determined from the number +of bits per pixel given in camera.h. +.le +.ls init_read_pixels +The pixel reading routine is initialized. The parameters are the number +of pixels per record, the number of bits per pixel which must be a +valid MII type, a byte order flag, and the SPP data type to be converted +to. In the CAMERA reader the byte order is specified to be least significant +byte first and the SPP data type is TY_SHORT. +.le +.ls read_pixels +The pixels are read into a record buffer. Data conversion is accomplished +with an initial byte swap to put the input in most significant byte first +form and then the MII routines are called. The +specified number of pixels is returned in the specified buffer. +.le +.le +.le +.le +.endhelp diff --git a/noao/mtlocal/camera/t_rcamera.x b/noao/mtlocal/camera/t_rcamera.x new file mode 100644 index 00000000..ccf235e5 --- /dev/null +++ b/noao/mtlocal/camera/t_rcamera.x @@ -0,0 +1,137 @@ +include <error.h> +include <fset.h> + +# T_RCAMERA -- Read CAMERA format data. Further documentation given +# in rcamera.hlp + +define MAX_RANGES 100 + +procedure t_rcamera() + +char infile[SZ_FNAME] # input file name list +char outfile[SZ_FNAME] # output image name list +char file_list[SZ_LINE] # input file number list +char image_list[SZ_LINE] # output image number list +int offset # output file number offset + +char in_fname[SZ_FNAME], out_fname[SZ_FNAME] +int range[MAX_RANGES * 2 + 1], image_ranges[MAX_RANGES * 2 + 1] +int nimages, nfiles, file_number, stat, lenlist, junk +pointer list + +bool clgetb() +char clgetc() +int fstati(), mtfile(), mtneedfileno(), clgeti(), btoi(), fntlenb() +int fntgfnb(), cam_read(), decode_ranges(), get_next_number() +int cam_get_image_type() +pointer fntopnb() + +include "rcamera.com" + +begin + # Flush the standard output. + if (fstati (STDOUT, F_REDIR) == NO) + call fseti (STDOUT, F_FLUSHNL, YES) + + # Get the parameters. + call clgstr ("camera_file", infile, SZ_FNAME) + if (mtfile (infile) == YES) { + list = NULL + 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 + list = fntopnb (infile, NO) + lenlist = fntlenb (list) + call sprintf (file_list, SZ_LINE, "1-%d") + call pargi (lenlist) + } + + # Decode the ranges string. + 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") + + # Get the image pixel type. + if (make_image == YES) { + data_type = cam_get_image_type (clgetc ("datatype")) + call clgstr ("iraf_file", outfile, SZ_FNAME) + } else + outfile[1] = EOS + + # Get the list of images per file. + call clgstr ("image_list", image_list, SZ_LINE) + if (decode_ranges (image_list, image_ranges, MAX_RANGES, nimages) + == ERR) + call error (1, "Illegal image number list") + + # Read successive CAMERA 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 == NO) + junk = fntgfnb (list, in_fname, SZ_FNAME) + else { + if (mtneedfileno (infile) == YES) + call mtfname (infile, file_number, 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 CAMERA file to the output IRAF file. If EOT is reached + # then exit. If an error is detected that is not trapped lower down + # in the code terminate execution. + + iferr (stat = cam_read (in_fname, out_fname, image_ranges, + nimages)) + call erract (EA_FATAL) + if (stat == EOF) # EOT found + break + } + + if (list != NULL) + call fntclsb (list) +end + + +# CAM_GET_IMAGE_TYPE -- Convert a character to an IRAF image type. + +define NTYPES 7 + +int procedure cam_get_image_type (c) + +char c # the input data type + +int i, type_codes[NTYPES] +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 diff --git a/noao/mtlocal/cyber/README b/noao/mtlocal/cyber/README new file mode 100644 index 00000000..a5c88b40 --- /dev/null +++ b/noao/mtlocal/cyber/README @@ -0,0 +1,4 @@ +This directory ("dataio$cyber/") contains code for four Cyber tape readers: +LDUMPF, RDUMPF, RIDSOUT, RIDSFILE. The executable file is x_cyber; the +definition file cyber.h is common to all four readers. +The subdirectory "rrcopy" contains code for the RRCOPY reader. diff --git a/noao/mtlocal/cyber/cyber.h b/noao/mtlocal/cyber/cyber.h new file mode 100644 index 00000000..4cd4aa39 --- /dev/null +++ b/noao/mtlocal/cyber/cyber.h @@ -0,0 +1,187 @@ +# Fix length of user area +define LEN_USER_AREA 2880 + +# Offsets to elements of the IPPS raster header (RDUMPF) + +define DATA_TYPE_OFFSET 33 # Offset to data_type (nbpp) +define NCOLS_OFFSET 35 # Offset to ncols (nppr) +define NWORDS_OFFSET 37 # Offet to nwords_per_row +define NROWS_OFFSET 41 # Offset to nrows +define FIRST_PRU_OFFSET 43 # Offset to 1st pru of raster +define MIN_OFFSET 63 # Offset to data min +define MAX_OFFSET 65 # Offset to data max +define EOR_OFFSET 89 # Offset to terminating pru + +# Bit-offsets to fields in the Permanent File Table (LDUMPF) + +define PFN_OFFSET (27 * 60 + 1 - 6) # Name: Left justified +define PF_ID_OFFSET (26 * 60 + 1 - 6) # ID: Right justified +define CY_OFFSET (31 * 60 + 1 - 12) # Cycle number +define CREATE_OFFSET (32 * 60 + 1 - 18) # Creation date +define ATTACH_OFFSET (33 * 60 + 1 - 18) # Date of last attach +define ALTER_OFFSET (34 * 60 + 1 - 18) # Date of last alteration +define NCHARS_OFFSET (8 * 60 + 7) # Nchars in PF name + +# The IPPS raster descriptor structure DT (RDUMPF): + +define LEN_DT 10 + SZ_IPPS_ID + 1 + +define BITS_PIXEL Memi[$1] +define PRU_EOR Memi[$1+1] +define WRDS_PER_ROW Memi[$1+2] +define NPRU_ROW Memi[$1+3] +define PRU_ROW_ONE Memi[$1+4] +define NCOLS Memi[$1+5] +define NROWS Memi[$1+6] +define DATA_MIN Memr[P2R($1+7)] +define DATA_MAX Memr[P2R($1+8)] +define IPPS_ID Memc[P2C($1+10)] + + +# The DUMPF tape descriptor structure DMP (LDUMPF): + +define LEN_DMP 15 + SZ_PFN + SZ_PF_ID + 2 + +define CY Memi[$1] +define M_CREATE Memi[$1+1] +define D_CREATE Memi[$1+2] +define Y_CREATE Memi[$1+3] +define M_ALTER Memi[$1+4] +define D_ALTER Memi[$1+5] +define Y_ALTER Memi[$1+6] +define M_ATTACH Memi[$1+7] +define D_ATTACH Memi[$1+8] +define Y_ATTACH Memi[$1+9] +define NCHARS_PFN Memi[$1+10] +define PFN Memc[P2C($1+15)] +define ID Memc[P2C($1+50)] + +# Bit-offsets to various IDSFILE header words are defined: + +define TAPE_OFFSET ((512 + (15 - 1)) * 64 + 1) +define SCAN_OFFSET ((512 + (1 - 1)) * 64 + 1) +define ITM_OFFSET ((512 + (2 - 1)) * 64 + 1) +define NP1_OFFSET ((512 + (5 - 1)) * 64 + 1) +define NP2_OFFSET ((512 + (6 - 1)) * 64 + 1) +define BEAM_OFFSET ((512 + (7 - 1)) * 64 + 1) +define COMPANION_OFFSET ((512 + (64 - 1)) * 64 + 1) +define OLD_OFFSET ((512 + (64 - 1)) * 64 + 1) +define SMODE_OFFSET ((512 + (10 - 1)) * 64 + 1) +define UT_OFFSET ((512 + (11 - 1)) * 64 + 1) +define ST_OFFSET ((512 + (12 - 1)) * 64 + 1) +define DF_OFFSET ((512 + (16 - 1)) * 64 + 1) +define SM_OFFSET ((512 + (17 - 1)) * 64 + 1) +define QF_OFFSET ((512 + (18 - 1)) * 64 + 1) +define DC_OFFSET ((512 + (19 - 1)) * 64 + 1) +define QD_OFFSET ((512 + (20 - 1)) * 64 + 1) +define EX_OFFSET ((512 + (21 - 1)) * 64 + 1) +define BS_OFFSET ((512 + (22 - 1)) * 64 + 1) +define CA_OFFSET ((512 + (23 - 1)) * 64 + 1) +define CO_OFFSET ((512 + (24 - 1)) * 64 + 1) +define HA_OFFSET ((512 + 26) * 64 + 1) +define AIR_OFFSET ((512 + 27) * 64 + 1) +define RA_OFFSET ((512 + 12) * 64 + 1) +define DEC_OFFSET ((512 + 13) * 64 + 1) +define LAM_OFFSET ((512 + 2) * 64 + 1) +define DEL_OFFSET ((512 + 3) * 64 + 1) +define OFLAG_OFFSET ((512 + (26 - 1)) * 64 + 1) +define ALPHA1_OFFSET ((512 + (25 - 1)) * 64 + 55) +define ALPHA2_OFFSET (ALPHA1_OFFSET - 6) +define ALPHA3_OFFSET (ALPHA2_OFFSET - 6) +define IDS_ID_OFFSET (512 + 28) +define COEFF_OFFSET (512 + 37) +define IDSO_REC_OFF 1 +define IDSO_TAPE_OFF 961 + +# Definition of the control parameter descriptor structure (RIDSFILE, RIDSOUT) + +define LEN_CP 5 + SZ_FNAME + SZ_LINE + 2 + +define MAKE_IMAGE Memi[$1] +define PRINT_PIXELS Memi[$1+1] +define LONG_HEADER Memi[$1+2] +define DATA_TYPE Memi[$1+3] +define IRAF_FILE Memc[P2C($1+5)] +define REC_NUMBERS Memc[P2C($1+5+SZ_FNAME)] + +# The IDSFILE descriptor structure IDS (RIDSOUT, RIDSFILE): + +define LEN_IDS 35 + 5 + SZ_IDS_ID + 1 + +define HA Memd[P2D($1)] +define AIRMASS Memd[P2D($1+2)] +define RA Memd[P2D($1+4)] +define DEC Memd[P2D($1+6)] +define LAMBDA0 Memd[P2D($1+8)] +define DELTA_LAMBDA Memd[P2D($1+10)] +define RECORD_NUMBER Memi[$1+12] +define ITM Memi[$1+13] +define NP1 Memi[$1+14] +define NP2 Memi[$1+15] +define BEAM_NUMBER Memi[$1+16] +define COMPANION_RECORD Memi[$1+17] +define SMODE Memi[$1+18] +define UT Memi[$1+19] +define ST Memi[$1+20] +define DF_FLAG Memi[$1+21] +define SM_FLAG Memi[$1+22] +define QF_FLAG Memi[$1+23] +define DC_FLAG Memi[$1+24] +define QD_FLAG Memi[$1+25] +define EX_FLAG Memi[$1+26] +define BS_FLAG Memi[$1+27] +define CA_FLAG Memi[$1+28] +define CO_FLAG Memi[$1+29] +define OFLAG Memi[$1+30] +define COEFF Memi[$1+31] +define ALPHA_ID Memc[P2C($1+35)] +define LABEL Memc[P2C($1+40)] + + +# Definitions for the Cyber DUMPF tape reading programs RDUMPF and LDUMPF + +define NBITS_CHAR (NBITS_BYTE * SZB_CHAR) # Number of bits per char +define NBITS_CYBER_WORD 60 # Number of bits per Cyber word +define LEN_PRU 64 # Number of words per Cyber pru +define NCHARS_PRU (64 * 60 / NBITS_CHAR) # Nchars per PRU +define NBITS_PRU 3840 # Number of bits per Cyber pru +define NCHARS_NOISE (48 / NBITS_CHAR) # Nchars in a Cyber noise record +define NBITS_EOR_MARK 48 # Number of bits per eor marker +define LEN_HEADER 64 # Number of words per header +define SZ_HEADER ((64 * 60) / NBITS_CHAR) # Nchars in IPPS header +define SZ_TAPE_BLK ((512 * 60) / NBITS_CHAR) # Size in chars of tape block +define SZ_TAPE_BUFFER (SZ_TAPE_BLK + 60) # Size of tape buffer for read +define LEN_PFT 48 # Size of Permanent File Table +define SZ_IPPS_ID 127 # Max number of characters in ID +define MAX_RANGES 100 +define NOT_SET 0 # Flag for data_type not set +define BLANK 0.0 # Temporary value for blanks +define NBYTES_WORD 5 # 5 12-bit bytes per Cyber word +define NINT_CYBER_WRD 2 +define LEN_CYBER_READ (4 * 65) # Number of Cyber words read at once +define SZ_PFT ((48 * 60) / NBITS_CHAR) # Chars in Perm file table +define SZ_PFN 40 # Max characters in PF Name +define SZ_PF_ID 9 # Max characters in PF ID +define NBITS_DATE 18 # Dates are written in 18 bits +define NBITS_CY 12 # Cycle # written in 12 bits +define NBITS_DC 6 # Nbits display code character +define NCHARS_WORD 10 # Number of display code + # characters per cyber word + +define LEN_INDEX (5 * LEN_PRU) +define LEN_USER_INDEX (2 * LEN_PRU) +define LEN_IDS_RECORD (9 * LEN_PRU) +define NPIX_IDS_RECORD 1024 +define SZ_IDS_ID 64 +define NCHAR_ALPHA 3 +define START_OF_IDSFILE 6 # First PRU of IDSFILE after index +define NBITS_LRN 18 +define NBITS_HRN 18 +define NBITS_NPRU 24 +define LRN_OFFSET 19 # Offset in index to lrn +define HRN_OFFSET 1 # Offset in index to hrn +define NPRU_OFFSET 37 # Offset in index to pru ordinal +define NBITS_DC 6 # Number of bits in a display code char +define MAX_COEFF 28 # Maximum n_coeff if DF is set +define NPIX_LINE 8 # Npixels per line of text (IDSOUT) +define NLINES_PIXELS 128 # Nlines of text containing pixels diff --git a/noao/mtlocal/cyber/cykeywords.x b/noao/mtlocal/cyber/cykeywords.x new file mode 100644 index 00000000..f6a2b194 --- /dev/null +++ b/noao/mtlocal/cyber/cykeywords.x @@ -0,0 +1,102 @@ +include <mach.h> +include <imhdr.h> +include "cyber.h" + +define LEN_KEYWORD 8 +define UNKNOWN Memc[($1+IMU-1)*SZ_STRUCT + 1] + +# CY_STORE_KEYWORDS -- store IDS specific keywords in the IRAF image header. + +procedure cy_store_keywords (ids, im) + +pointer ids # Pointer to program data structure +pointer im # Pointer to image + +char keyword[LEN_KEYWORD] +int fd, i, nrp +int stropen() +real value + +begin + # Open image user area as a file + fd = stropen (UNKNOWN(im), LEN_USER_AREA - 1, NEW_FILE) + + # FITS keyword are formatted and appended to the image user + # area with the addcard procedures. + + call addcard_i (fd, "RECORD", RECORD_NUMBER(ids), "IDS record") + + if (SMODE(ids) != 0) { + call addcard_i (fd, "COMPANIO", COMPANION_RECORD(ids), + "Companion record") + + } + + call addcard_i (fd, "EXPOSURE", ITM(ids), "Exposure time (seconds)") + + call addcard_i (fd, "OFLAG", OFLAG(ids), "Object flag") + + call addcard_i (fd, "BEAM-NUM", BEAM_NUMBER(ids), "Beam number") + + nrp = NDIGITS_RP + value = real (LAMBDA0(ids)) + call addcard_r (fd, "W0", value, "Starting wavelength", nrp) + + value = real (DELTA_LAMBDA(ids)) + call addcard_r (fd, "WPC", value, "Wavelength per channel", nrp) + + call addcard_i (fd, "NP1", NP1(ids), "Left plot limit") + + call addcard_i (fd, "NP2", NP2(ids), "Right plot limit") + + if (IS_INDEFI (UT(ids))) + value = INDEFR + else + value = real (UT(ids) / 3600.) + call addcard_time (fd, "UT", value, "Universal time") + + if (IS_INDEFI (ST(ids))) + value = INDEFR + else + value = real (ST(ids)/ 3600.) + call addcard_time (fd, "ST", value, "Sidereal time") + + value = real (RA(ids)) + call addcard_time (fd, "RA", value, "Right ascension") + + value = real (DEC(ids)) + call addcard_time (fd, "DEC", value, "Declination") + + value = real (HA(ids)) + call addcard_time (fd, "HA", value, "Hour angle") + + value = real (AIRMASS(ids)) + call addcard_r (fd, "AIRMASS", value, "Airmass", nrp) + + # The 9 reduction flags + call addcard_i (fd, "DF-FLAG", DF_FLAG(ids), "Dispersion flag") + call addcard_i (fd, "SM-FLAG", SM_FLAG(ids), "Smoothing flag") + call addcard_i (fd, "QF-FLAG", QF_FLAG(ids), "Quartz fit flag") + call addcard_i (fd, "DC-FLAG", DC_FLAG(ids), "Dispersion corrected") + call addcard_i (fd, "QD-FLAG", QD_FLAG(ids), "Quartz division flag") + call addcard_i (fd, "EX-FLAG", EX_FLAG(ids), "Extinction flag") + call addcard_i (fd, "BS-FLAG", BS_FLAG(ids), "Beam switch flag") + call addcard_i (fd, "CA-FLAG", CA_FLAG(ids), "Calibration flag") + call addcard_i (fd, "CO-FLAG", CO_FLAG(ids), "Coincidence flag") + + # The df coeffecients are written out in the case where the df + # flag is set, and the first coefficient is nonzero. (The later + # condition is a test for IDSOUT data, where the df coeffecients + # have been applied but not stored in the header.) + + if (DF_FLAG(ids) != -1 && COEFF(ids) != 0) { + call strcpy ("DF", keyword, LEN_KEYWORD) + do i = 1, DF_FLAG(ids) { + call sprintf (keyword[3], LEN_KEYWORD, "%s") + call pargi (i) + call addcard_d (fd, keyword, Memd[COEFF(ids)+i-1], "", nrp) + } + } + + call close (fd) +end diff --git a/noao/mtlocal/cyber/cyrbits.x b/noao/mtlocal/cyber/cyrbits.x new file mode 100644 index 00000000..9f4df03f --- /dev/null +++ b/noao/mtlocal/cyber/cyrbits.x @@ -0,0 +1,371 @@ +include <mach.h> +include <imhdr.h> +include <error.h> +include "cyber.h" + +# UNPK_12 -- Unpack 12-bit unsigned integers from an array containing +# one sixty bit cyber word in each pair of array elements. +# Each output word contains successive 12-bit pixels from the +# input array. +# Pixels are unpacked starting with element "first_word" of the input array. +# Each cyber 60-bit word contains 5 packed 12-bit pixels, the first pixel +# in the highest 12 bits. The input array contains one cyber word per two +# array elements; the cyber word occupies the lower 60 bits of each pair +# of array values. + +procedure unpk_12 (input, first_word, output, npix_unpk) + +int input[ARB] # +int first_word # +int output[npix_unpk] # +int npix_unpk # + +int n, nn, i, offset[5], off +int npix_word, ncyber_words, index +data (offset[i], i=1, 5) /15, 27, 39, 51, 63/ +int bitupk() + +begin + npix_word = 5 + if (mod (npix_unpk, npix_word) == 0) + ncyber_words = (npix_unpk) / npix_word + else + call error (0, "Incorrect number of pixels to be unpacked") + index = 1 + + i = 1 + for (n = first_word; i <= npix_unpk; n = n + 2) { + do nn = 1, npix_word { + off = (n + 1) * NBITS_INT - offset[nn] + output[i] = bitupk (input, off, 12) + if (output[i] == 7777B) + output[i] = BLANK + i = i + 1 + } + } +end + + +# UNPK-20 -- Unpack 20-bit signed integers from an array containing +# one 60-bit Cyber word per pair of array elements. Each output +# word contains successive 20-bit pixels from the input array. Pixels +# are unpacked starting with array element "first_word". Conversion +# from one's complement to two's complement is performed. Each Cyber +# word contains 3 packed 20-bit pixels, the first pixel in the highest +# 20 bits. + +procedure unpk_20 (input, first_word, output, npix_unpk) + +int input[ARB] +int output[npix_unpk], npix_unpk, first_word +int n, i, nn, off +int npix_word, ncyber_words, pix_val, offset[3] +data (offset[i], i=1, 3) /23, 43, 63/ +int bitupk() + +begin + npix_word = 3 + if (mod (npix_unpk, npix_word) == 0) + ncyber_words = npix_unpk / npix_word + else + call error (0, "Incorrect number of pixels to be unpacked") + + i = 1 + for (n = first_word; i <= npix_unpk; n = n + 2) { + do nn = 1, npix_word { + off = (n + 1) * NBITS_INT - offset[nn] + pix_val = bitupk (input, off, 20) + if (pix_val == 3777777B) + pix_val = BLANK + else if (and (pix_val, 2000000B) != 0) + # negative pixel + pix_val = -and (3777777B, not(pix_val)) + output[i] = pix_val + i = i + 1 + } + } +end + + +# UNPK_60R -- Unpack Cyber 60-bit floating point numbers from an array +# containing one 60-bit word per pair of array elements. +# The 30 most significant bits from each 60-bit word are +# unpacked and then reconstructed as a floating point number with +# with REPACK_FP. The extracted bits include an 18-bit mantissa, +# 11-bit exponent and a sign bit. This routine is used for getting +# the min and max values from the header; no 60-bit IPPS pixels are +# expected. + +procedure unpk_60r (input, first_word, fp_value, nwords) + +int input[ARB] +real fp_value[nwords] +int first_word, nwords, n, i +pointer int_buf, sp +int bitupk() + +begin + # Allocate space on stack + call smark (sp) + call salloc (int_buf, nwords, TY_INT) + + i = 1 + for (n = first_word; i <= nwords; n = n + 2) { + Memi[int_buf + i - 1] = bitupk (input[n], 31, 30) + i = i + 1 + } + + call repack_fp (Memi[int_buf], fp_value, nwords) + call sfree (sp) +end + + +# UNPK_60I -- Unpack 60-bit integers from an array containing one Cyber +# word per each NINT_CYBER_WRD elements. Each word +# of output contains only the lower 32 bits of each input word, as this +# procedure is called only for getting the reduction flags from the +# IDSFILE header. + +procedure unpk_60i (input, initial_bit_offset, output, nwords) + +char input[ARB] +int output[nwords] +int initial_bit_offset, nwords, bit_offset, n +int bitupk() +errchk bitupk + +begin + bit_offset = initial_bit_offset + + do n = 1, nwords { + output[n] = bitupk (input, bit_offset, NBITS_INT) + if (and (output[n], 2000000000B) != 0) + # negative value + output[n] = -not(output[n]) + bit_offset = bit_offset + (NINT_CYBER_WRD * NBITS_INT) + } +end + + +# CONVERT_60BIT_FP -- returns a floating point number equivalent to the Cyber +# 60-bit number input. The full 48-bit mantissa and 11-bit exponent +# is used in reconstructing the floating point value. + +double procedure convert_60bit_fp (cyber_word, bit_offset) + +int cyber_word[ARB], bit_offset +int temp1, temp2 +double float_value +int exp, lower_mantissa, upper_mantissa, i +int bitupk(), and(), not() +double tbl[255] +include "powd.inc" +errchk bitupk + +begin + # Extract cyber word in question into temp array + temp1 = bitupk (cyber_word, bit_offset, 30) + temp2 = bitupk (cyber_word, bit_offset + 30, 30) + + # Check "bit59" and complement all bits if it is set + if (bitupk (temp2, 30, 1) != 0) { + temp1 = not (temp1) + temp2 = not (temp2) + lower_mantissa = -and (temp1, 7777777777B) + upper_mantissa = -and (temp2, 777777B) + } else { + lower_mantissa = temp1 + upper_mantissa = and (temp2, 777777B) + } + + # Extract and interpret exponent; remove Cyber bias of 2000B and + # convert to two's complement if negative number + exp = bitupk (temp2, 19, 11) + if (exp > 1777B) + # "bit58" is set, positive exponent + exp = exp - 2000B + else + # negative exponent + exp = exp - 1777B + + # Reconstruct the floating point number. 30 is added to the + # exponent for the upper mantissa. The 129 is to register the data + # array matrix: tbl[1] = 2 ** -128 ==> 2 ** n = tbl[n + 129] + # float_value = mantissa * 2 ** (exp + 129) + # + # float_value = (lower_mantissa) * 2 ** (exp + 129) + + # (upper_mantissa) * 2 ** (exp + 30 + 129) + + float_value = double (lower_mantissa) * tbl[exp + 129] + + double (upper_mantissa) * tbl[exp + 30 + 129] + + return (float_value) +end + + +# UNPK_30 -- unpack Cyber 30-bit floating point numbers from an array +# containing one 60-bit Cyber word in each pair of array elements. Each +# 30-bit pixel is unpacked from this array; procedure REPACK_FP is called +# to reconstruct the floating point number. Pixels are unpacked starting +# with array element "first_word". Each Cyber word contains 2 30-bit +# pixels, the first pixel in the higher 30 bits. + +procedure unpk_30 (input, first_word, fp_value, npix) + +int input[ARB] +int first_word, npix +real fp_value[npix] +pointer int_buf, sp +int n, i, off, offset[2] +int bitupk() +data (offset[i], i = 1, 2) /33, 63/ +errchk bitupk + +begin + # Allocate buffer space, allowing for maximum of 1 extraneous pixel + call smark (sp) + call salloc (int_buf, npix + 1, TY_INT) + + i = 1 + for (n = first_word; i <= npix; n = n + 2) { + off = (n + 1) * NBITS_INT - offset[1] + Memi[int_buf + i - 1] = bitupk (input, off, 30) + off = (n + 1) * NBITS_INT - offset[2] + Memi[int_buf + i] = bitupk (input, off, 30) + i = i + 2 + } + + call repack_fp (Memi[int_buf], fp_value, npix) + call sfree (sp) +end + + +# UNPK_ID -- Unpacks ID string from input array, which contains one Cyber +# word per two array elements. The word_offset equals the number of Cyber +# words to skip before beginning to unpack. If the character string +# begins in word one of "input", word_offset = 0. The IPPS ID string +# is written in 7-bit ASCII, with eight characters per Cyber word. The lowest +# 4 bits of each 60-bit word is unused. The highest 7 bits of the first Cyber +# word contain the character count. + +procedure unpk_id (input, word_offset, output) + +int input[ARB] +int word_offset +char output[SZ_IPPS_ID] +int nbits, nchar_offset, id_offset, nchars, n +int nchars_word, ncyber_words, nn, index +int bitupk() + +begin + nbits = 7 + nchar_offset = (word_offset * NBITS_INT * NINT_CYBER_WRD) + + NBITS_CYBER_WORD - 6 + nchars = bitupk (input, nchar_offset, nbits) + ncyber_words = (nchars + 6) / 7 + index = 1 + + for (n = 1; n <= ncyber_words; n = n + 1) { + if (n == 1) { + nchars_word = 7 + id_offset = nchar_offset - 7 + } else { + nchars_word = 8 + id_offset = nchar_offset + ((n-1) * NBITS_INT * NINT_CYBER_WRD) + } + do nn = 1, nchars_word { + output[index] = bitupk (input, id_offset, nbits) + index = index + 1 + id_offset = id_offset - 7 + } + } + output[nchars+1] = EOS +end + + +# REPACK_FP -- Reconstruct a floating point number. The input to REPACK_FP +# is an array of integers containing Cyber 30-bit floating point numbers +# in the least significant bits of each array element. The exponent, mantissa +# and two bits indicating the sign are extracted and used to reassemble +# the floating point value. Cyber blanks and overflows are returned as BLANK. + +procedure repack_fp (int_value, float_value, nvalues) + +int int_value[ARB], nvalues +real float_value[nvalues] + +int i, pixel +int exp, mantissa +real tbl[255] +int bitupk(), and(), not() +include "pow.inc" + +begin + do i=1, nvalues { + pixel = int_value[i] + # Check for blanks + if (pixel == 1777000000B) { + float_value[i] = BLANK + next + } + + # Check "bit59" and complement all bits if it is set + if (and (pixel, 4000000000B) != 0) { + pixel = not (pixel) + mantissa = -and (pixel, 777777B) + } else + mantissa = and (pixel, 777777B) + + # Extract and interpret exponent: remove Cyber bias of 2000B + # and convert to two's complement if negative number + exp = bitupk (pixel, 19, 11) + if (exp > 1777B) + # "bit58" is set, positive exponent + exp = exp - 2000B + else + # negative exponent + exp = exp - 1777B + + # Reconstruct the floating point value: 30 is added to the + # exponent because only the top 18 bits of the 48-bit mantissa + # were extracted; the 129 is to register the data array index. + # float_value[i] = real(mantissa) * 2 ** (exp + 30) + # (tbl[1] = 2 ** -128) ==> (2 ** n = tbl[n + 129]). + + exp = exp + 30 + 129 + if (exp <= 0) { + #call eprintf ( + #"RDUMPF_REPACK_FP: pixel with exponent underflow seen\n") + float_value[i] = 0.0 + } else if (exp > 255) { + #call eprintf ( + #"RDUMPF_REPACK_FP: pixel with exponent overflow seen\n") + float_value[i] = MAX_REAL + } else if (exp > 0 && exp <= 255) + float_value[i] = real(mantissa) * tbl[exp] + } +end + + +# DISPLAY_CODE -- returns the ascii character equivalent to the display +# code character input. The Cyber uses the 63-character display code +# set internally, although the 64-character set is used for output. + +procedure display_code (in_char, out_char) + +char in_char, out_char +char dc[64] +int i + +data (dc[i], i=1,8) /072B, 101B, 102B, 103B, 104B, 105B, 106B, 107B/ +data (dc[i], i=9,16) /110B, 111B, 112B, 113B, 114B, 115B, 116B, 117B/ +data (dc[i], i=17,24) /120B, 121B, 122B, 123B, 124B, 125B, 126B, 127B/ +data (dc[i], i=25,32) /130B, 131B, 132B, 060B, 061B, 062B, 063B, 064B/ +data (dc[i], i=33,40) /065B, 066B, 067B, 070B, 071B, 053B, 055B, 052B/ +data (dc[i], i=41,48) /057B, 050B, 051B, 044B, 075B, 040B, 054B, 056B/ +data (dc[i], i=49,56) /043B, 133B, 135B, 045B, 042B, 137B, 041B, 046B/ +data (dc[i], i=57,64) /047B, 077B, 074B, 076B, 100B, 134B, 136B, 073B/ + +begin + out_char = dc[in_char + 1] +end diff --git a/noao/mtlocal/cyber/cyrheader.x b/noao/mtlocal/cyber/cyrheader.x new file mode 100644 index 00000000..7471b118 --- /dev/null +++ b/noao/mtlocal/cyber/cyrheader.x @@ -0,0 +1,120 @@ +include <mach.h> +include <imhdr.h> +include <error.h> +include "cyber.h" + +# CY_READ_HEADER -- reads the IPPS header (64 60-bit words) into the 128 element +# integer array "header". Any extraneous information between the header +# and data is skipped; the tape is left positioned at the first data +# record. + +int procedure cy_read_header (rd, dt) + +int rd +pointer dt +int header[NINT_CYBER_WRD * LEN_HEADER] +int npru_skip +int read_dumpf() +errchk cy_unpk_header, read_dumpf, cy_skip_pru, unpack_cyber_record +errchk order_cyber_bits + +begin + # Read the header into array header, one cyber word per two elements + if (read_dumpf (rd, header, LEN_HEADER) == EOF) + return (EOF) + + # Unpack bit stream and fill structure dt + iferr { + call cy_unpk_header (header, dt) + npru_skip = PRU_ROW_ONE(dt) - 1 + } then { + call erract (EA_WARN) + # Position to first row of raster before posting error + if (npru_skip > 0) + call cy_skip_pru (rd, npru_skip) + call error (1, "Bad header, attempting to skip raster") + } + + # Position to first row of IPPS raster + if (npru_skip > 0) + call cy_skip_pru (rd, npru_skip) + + return (OK) +end + + +# CY_LIST_HEADER -- prints the IPPS header information. + +procedure cy_list_header (dt, file_number, raster_num) + +pointer dt +int raster_num, file_number + +begin + # Print header information from IPPS raster + call printf ("[%d.%d]%7t IPPS_ID: %s\n") + call pargi (file_number) + call pargi (raster_num) + call pargstr (IPPS_ID(dt)) + call printf ("%7t NCOLS=%d, NROWS=%d, MIN=%g, MAX=%g, NBPP=%d\n") + call pargi (NCOLS(dt)) + call pargi (NROWS(dt)) + call pargr (DATA_MIN(dt)) + call pargr (DATA_MAX(dt)) + call pargi (BITS_PIXEL(dt)) +end + + +# CY_UNPK_HEADER -- unpacks header words from the char array header +# and fills the program data structure. A few values are checked to +# make sure a valid IPPS raster is being read. Offsets to various +# header words have been defined previously. + +procedure cy_unpk_header (header, dt) + +int header[NINT_CYBER_WRD * LEN_HEADER] +pointer dt + +begin + # From array header, first the ID is unpacked + call unpk_id (header, 0, IPPS_ID(dt)) + + # An EOR marker terminates each raster + PRU_EOR(dt) = header[EOR_OFFSET] + + # The PRU containing the first data row + PRU_ROW_ONE(dt) = header[FIRST_PRU_OFFSET] + + # Most significant 30 bits of the data min are used + call unpk_60r (header, MIN_OFFSET, DATA_MIN(dt), 1) + + # Most significant 30 bits of the data max are used + call unpk_60r (header, MAX_OFFSET, DATA_MAX(dt), 1) + + # Bits per pixel is unpacked and tested + BITS_PIXEL(dt) = header[DATA_TYPE_OFFSET] + + switch (BITS_PIXEL(dt)) { + case 12,20,30,60: + ; + default: + call error (2, "Incorrect IPPS BITS_PIXEL") + } + + # Number of columns is unpacked and tested + NCOLS(dt) = header[NCOLS_OFFSET] + if (NCOLS(dt) <= 0) + call error (2, "IPPS ncols <= 0") + + # Number of Cyber words per row must be integral # of PRU's + WRDS_PER_ROW(dt) = header[NWORDS_OFFSET] + NPRU_ROW(dt) = WRDS_PER_ROW(dt) / LEN_PRU + + if (mod (WRDS_PER_ROW(dt), LEN_PRU) != 0) + call error (2, "Invalid IPPS NWPR") + + # Number of rows is unpacked and tested + NROWS(dt) = header[NROWS_OFFSET] + if (NROWS(dt) <= 0) + call error (2, "IPPS nrows <= 0") +end diff --git a/noao/mtlocal/cyber/cyrimage.x b/noao/mtlocal/cyber/cyrimage.x new file mode 100644 index 00000000..5766e838 --- /dev/null +++ b/noao/mtlocal/cyber/cyrimage.x @@ -0,0 +1,166 @@ +include <mach.h> +include <imhdr.h> +include <error.h> +include "cyber.h" + +# READ_IPPS_ROWS -- reads the ipps raster image row by row from the tape and +# writes the output image. At the completion of READ_IMAGE, the tape is +# positioned to the header record of the next ipps raster. + +procedure read_ipps_rows (rd, out_fname, data_type, dt) + +int rd, data_type +char out_fname[SZ_FNAME] +pointer dt + +pointer sp, im, spp_buf +int npru_skip, i, stat +long clktime() + +int read_dumpf() +pointer immap(), impl2r() +errchk cy_skip_pru, immap, ipps_to_iraf, read_dumpf() + +begin + # Allocate buffer for ipps raster pixels + call smark (sp) + call salloc (spp_buf, WRDS_PER_ROW(dt) * NINT_CYBER_WRD, TY_INT) + + # Map new iraf image and set up image header + im = immap (out_fname, NEW_IMAGE, 0) + IM_LEN(im, 1) = NCOLS(dt) + IM_LEN(im, 2) = NROWS(dt) + call strcpy (IPPS_ID(dt), IM_TITLE(im), SZ_IMTITLE) + IM_MIN(im) = DATA_MIN(dt) + IM_MAX(im) = DATA_MAX(dt) + + # Set optimum image pixel type + if (data_type == NOT_SET) { + switch (BITS_PIXEL(dt)) { + case 12: + IM_PIXTYPE(im) = TY_SHORT + case 20: + IM_PIXTYPE(im) = TY_REAL + case 30: + IM_PIXTYPE(im) = TY_REAL + case 60: + IM_PIXTYPE(im) = TY_REAL + default: + call error (3, "IPPS BITS_PIXEL is incorrect") + } + } else + IM_PIXTYPE(im) = data_type + IM_LIMTIME(im) = clktime (long(0)) + + # Loop over rows to read, reorder and convert pixels. + for (i=1; i <= NROWS(dt); i=i+1) { + iferr { + stat = read_dumpf (rd, Memi[spp_buf], WRDS_PER_ROW(dt)) + } then { + call imunmap (im) + call sfree (sp) + call erract (EA_WARN) + return + } + if (stat == EOF) { + call imunmap (im) + call sfree (sp) + call eprintf ("Premature EOF in image at row # %d\n") + call pargi (i) + return + } + + call ipps_to_iraf (Memi[spp_buf], Memr[impl2r(im,i)], NCOLS(dt), + BITS_PIXEL(dt)) + } + + # Skip from present position to end of rcopy raster + npru_skip = PRU_EOR(dt) - PRU_ROW_ONE(dt) - (NPRU_ROW(dt)*NROWS(dt)) + call cy_skip_pru (rd, npru_skip) + + call imunmap (im) + call sfree (sp) +end + + +# IPPS_TO_IRAF -- performs the conversion from Cyber pixels to IRAF pixels. +# Each row of the ipps image is required to occupy an integral number of Cyber +# PRU's, so the input buffer contains pixels plus filler. The number of +# pixels unpacked from this buffer will always fill an integral number of +# Cyber words; a maximum of 4 extraneous pixels will be unpacked. + +procedure ipps_to_iraf (in_buf, iraf_real, npix, nbits_pixel) + +int in_buf[ARB] +real iraf_real[npix] +pointer iraf_int, sp +int nbits_pixel, npix, offset, npix_unpk, npix_cyber_wrd +errchk unpk_12, unpk_20 + +begin + # Allocate (maximum) space needed on the stack. + call smark (sp) + call salloc (iraf_int, npix + 4, TY_INT) + offset = 1 + + switch (nbits_pixel) { + case 12: + npix_cyber_wrd = 5 + npix_unpk = ((npix + 4) / npix_cyber_wrd) * npix_cyber_wrd + call unpk_12 (in_buf, offset, Memi[iraf_int], npix_unpk) + call achtir (Memi[iraf_int], iraf_real, npix) + + case 20: + npix_cyber_wrd = 3 + npix_unpk = ((npix + 2) / npix_cyber_wrd) * npix_cyber_wrd + call unpk_20 (in_buf, offset, Memi[iraf_int], npix_unpk) + call achtir (Memi[iraf_int], iraf_real, npix) + + case 30: + call unpk_30 (in_buf, offset, iraf_real, npix) + + case 60: + call unpk_60r (in_buf, offset, iraf_real, npix) + + default: + call error (5, "Illegal IPPS #B/P") + } + + call sfree (sp) +end + + +# CY_SKIP_IMAGE -- skips over an IPPS raster once the header has been +# read. When SKIP_IMAGE returns, the tape is positioned to the first +# record of the next tape image. + +procedure cy_skip_image (rd, dt) + +int rd +pointer dt +int npru_skip +errchk cy_skip_pru + +begin + # Calculate number of PRU's in image + npru_skip = PRU_EOR(dt) - PRU_ROW_ONE(dt) + call cy_skip_pru (rd, npru_skip) +end + +# CY_SKIP_PRU -- positions the tape by skipping the requested number of PRU's. + +procedure cy_skip_pru (rd, npru_skip) + +int rd, npru_skip +pointer sp, dummy +int read_dumpf() + +begin + call smark (sp) + call salloc (dummy, NINT_CYBER_WRD * LEN_PRU * npru_skip, TY_INT) + + if (read_dumpf (rd, Memi[dummy], npru_skip * LEN_PRU) == EOF) + call eprintf ("Unexpected EOF when skipping image\n") + + call sfree (sp) +end diff --git a/noao/mtlocal/cyber/mkpkg b/noao/mtlocal/cyber/mkpkg new file mode 100644 index 00000000..b546080e --- /dev/null +++ b/noao/mtlocal/cyber/mkpkg @@ -0,0 +1,22 @@ +# The four cyber format readers LDUMPF, RDUMPF, RIDSFILE, RIDSOUT contribute +# the following sources to the dataio package library: + +$checkout libpkg.a ../ +$update libpkg.a +$checkin libpkg.a ../ +$exit + +libpkg.a: + @rrcopy + + cykeywords.x <mach.h> cyber.h <imhdr.h> + cyrbits.x pow.inc powd.inc <error.h> <imhdr.h> <mach.h> cyber.h + cyrheader.x <error.h> <imhdr.h> <mach.h> cyber.h + cyrimage.x cyber.h <error.h> <imhdr.h> <mach.h> + rdumpf.x cyber.h <mach.h> + rpft.x <mach.h> cyber.h + t_ldumpf.x <mach.h> cyber.h + t_rdumpf.x cyber.h <error.h> <fset.h> <mach.h> + t_ridsfile.x cyber.h <error.h> <fset.h> <mach.h> <imhdr.h> + t_ridsout.x cyber.h <ctype.h> <error.h> <fset.h> <imhdr.h> <mach.h> + ; diff --git a/noao/mtlocal/cyber/pow.inc b/noao/mtlocal/cyber/pow.inc new file mode 100644 index 00000000..b87b75bb --- /dev/null +++ b/noao/mtlocal/cyber/pow.inc @@ -0,0 +1,86 @@ + data (tbl[i], i=1, 3) /0.0 , 0.0 , 0.0 / + data (tbl[i], i=4, 6) /0.0 , 0.0 , 0.0 / + data (tbl[i], i=7, 9) /1.880791E-37, 3.761582E-37, 7.523164E-37/ + data (tbl[i], i=10, 12) /1.504633E-36, 3.009266E-36, 6.018531E-36/ + data (tbl[i], i=13, 15) /1.203706E-35, 2.407412E-35, 4.814825E-35/ + data (tbl[i], i=16, 18) /9.629650E-35, 1.925930E-34, 3.851860E-34/ + data (tbl[i], i=19, 21) /7.703720E-34, 1.540744E-33, 3.081488E-33/ + data (tbl[i], i=22, 24) /6.162976E-33, 1.232595E-32, 2.465190E-32/ + data (tbl[i], i=25, 27) /4.930381E-32, 9.860761E-32, 1.972152E-31/ + data (tbl[i], i=28, 30) /3.944305E-31, 7.888609E-31, 1.577722E-30/ + data (tbl[i], i=31, 33) /3.155444E-30, 6.310887E-30, 1.262177E-29/ + data (tbl[i], i=34, 36) /2.524355E-29, 5.048710E-29, 1.009742E-28/ + data (tbl[i], i=37, 39) /2.019484E-28, 4.038968E-28, 8.077936E-28/ + data (tbl[i], i=40, 42) /1.615587E-27, 3.231174E-27, 6.462349E-27/ + data (tbl[i], i=43, 45) /1.292470E-26, 2.584939E-26, 5.169879E-26/ + data (tbl[i], i=46, 48) /1.033976E-25, 2.067952E-25, 4.135903E-25/ + data (tbl[i], i=49, 51) /8.271806E-25, 1.654361E-24, 3.308722E-24/ + data (tbl[i], i=52, 54) /6.617445E-24, 1.323489E-23, 2.646978E-23/ + data (tbl[i], i=55, 57) /5.293956E-23, 1.058791E-22, 2.117582E-22/ + data (tbl[i], i=58, 60) /4.235165E-22, 8.470329E-22, 1.694066E-21/ + data (tbl[i], i=61, 63) /3.388132E-21, 6.776264E-21, 1.355253E-20/ + data (tbl[i], i=64, 66) /2.710505E-20, 5.421011E-20, 1.084202E-19/ + data (tbl[i], i=67, 69) /2.168404E-19, 4.336809E-19, 8.673617E-19/ + data (tbl[i], i=70, 72) /1.734723E-18, 3.469447E-18, 6.938894E-18/ + data (tbl[i], i=73, 75) /1.387779E-17, 2.775558E-17, 5.551115E-17/ + data (tbl[i], i=76, 78) /1.110223E-16, 2.220446E-16, 4.440892E-16/ + data (tbl[i], i=79, 81) /8.881784E-16, 1.776357E-15, 3.552714E-15/ + data (tbl[i], i=82, 84) /7.105427E-15, 1.421085E-14, 2.842171E-14/ + data (tbl[i], i=85, 87) /5.684342E-14, 1.136868E-13, 2.273737E-13/ + data (tbl[i], i=88, 90) /4.547474E-13, 9.094947E-13, 1.818989E-12/ + data (tbl[i], i=91, 93) /3.637979E-12, 7.275958E-12, 1.455192E-11/ + data (tbl[i], i=94, 96) /2.910383E-11, 5.820766E-11, 1.164153E-10/ + data (tbl[i], i=97, 99) /2.328306E-10, 4.656613E-10, 9.313226E-10/ + data (tbl[i], i=100, 102) / 1.862645E-9, 3.725290E-9, 7.450581E-9/ + data (tbl[i], i=103, 105) / 1.490116E-8, 2.980232E-8, 5.960464E-8/ + data (tbl[i], i=106, 108) / 1.192093E-7, 2.384186E-7, 4.768372E-7/ + data (tbl[i], i=109, 111) / 9.536743E-7, 1.907349E-6, 3.814697E-6/ + data (tbl[i], i=112, 114) / 7.629395E-6, 1.525879E-5, 3.051758E-5/ + data (tbl[i], i=115, 117) / 6.103516E-5, 1.220703E-4, 2.441406E-4/ + data (tbl[i], i=118, 120) / 4.882813E-4, 9.765625E-4, 0.001953125/ + data (tbl[i], i=121, 123) / 0.00390625, 0.0078125, 0.015625/ + data (tbl[i], i=124, 126) / 0.03125, 0.0625, 0.125/ + data (tbl[i], i=127, 129) / 0.25, 0.5, 1./ + data (tbl[i], i=130, 132) / 2., 4., 8./ + data (tbl[i], i=133, 135) / 16., 32., 64./ + data (tbl[i], i=136, 138) / 128., 256., 512./ + data (tbl[i], i=139, 141) / 1024., 2048., 4096./ + data (tbl[i], i=142, 144) / 8192., 16384., 32768./ + data (tbl[i], i=145, 147) / 65536., 131072., 262144./ + data (tbl[i], i=148, 150) / 524288., 1048576., 2097152./ + data (tbl[i], i=151, 153) / 4194304., 8388608., 16777216./ + data (tbl[i], i=154, 156) / 33554432., 67108864., 134217728./ + data (tbl[i], i=157, 159) / 268435456., 536870912., 1.073742E9/ + data (tbl[i], i=160, 162) / 2.147484E9, 4.294967E9, 8.589935E9/ + data (tbl[i], i=163, 165) / 1.717987E10, 3.435974E10, 6.871948E10/ + data (tbl[i], i=166, 168) / 1.374390E11, 2.748779E11, 5.497558E11/ + data (tbl[i], i=169, 171) / 1.099512E12, 2.199023E12, 4.398047E12/ + data (tbl[i], i=172, 174) / 8.796093E12, 1.759219E13, 3.518437E13/ + data (tbl[i], i=175, 177) / 7.036874E13, 1.407375E14, 2.814750E14/ + data (tbl[i], i=178, 180) / 5.629500E14, 1.125900E15, 2.251800E15/ + data (tbl[i], i=181, 183) / 4.503600E15, 9.007199E15, 1.801440E16/ + data (tbl[i], i=184, 186) / 3.602880E16, 7.205759E16, 1.441152E17/ + data (tbl[i], i=187, 189) / 2.882304E17, 5.764608E17, 1.152922E18/ + data (tbl[i], i=190, 192) / 2.305843E18, 4.611686E18, 9.223372E18/ + data (tbl[i], i=193, 195) / 1.844674E19, 3.689349E19, 7.378698E19/ + data (tbl[i], i=196, 198) / 1.475740E20, 2.951479E20, 5.902958E20/ + data (tbl[i], i=199, 201) / 1.180592E21, 2.361183E21, 4.722366E21/ + data (tbl[i], i=202, 204) / 9.444733E21, 1.888947E22, 3.777893E22/ + data (tbl[i], i=205, 207) / 7.555786E22, 1.511157E23, 3.022315E23/ + data (tbl[i], i=208, 210) / 6.044629E23, 1.208926E24, 2.417852E24/ + data (tbl[i], i=211, 213) / 4.835703E24, 9.671407E24, 1.934281E25/ + data (tbl[i], i=214, 216) / 3.868563E25, 7.737125E25, 1.547425E26/ + data (tbl[i], i=217, 219) / 3.094850E26, 6.189700E26, 1.237940E27/ + data (tbl[i], i=220, 222) / 2.475880E27, 4.951760E27, 9.903520E27/ + data (tbl[i], i=223, 225) / 1.980704E28, 3.961408E28, 7.922816E28/ + data (tbl[i], i=226, 228) / 1.584563E29, 3.169127E29, 6.338253E29/ + data (tbl[i], i=229, 231) / 1.267651E30, 2.535301E30, 5.070602E30/ + data (tbl[i], i=232, 234) / 1.014120E31, 2.028241E31, 4.056482E31/ + data (tbl[i], i=235, 237) / 8.112964E31, 1.622593E32, 3.245186E32/ + data (tbl[i], i=238, 240) / 6.490371E32, 1.298074E33, 2.596148E33/ + data (tbl[i], i=241, 243) / 5.192297E33, 1.038459E34, 2.076919E34/ + data (tbl[i], i=244, 246) / 4.153837E34, 8.307675E34, 1.661535E35/ + data (tbl[i], i=247, 249) / 3.323070E35, 6.646140E35, 1.329228E36/ + data (tbl[i], i=250, 252) / 2.658456E36, 5.316912E36, 1.063382E37/ + data (tbl[i], i=253, 255) / 2.126765E37, 4.253530E37, 8.507059E37/ + diff --git a/noao/mtlocal/cyber/powd.inc b/noao/mtlocal/cyber/powd.inc new file mode 100644 index 00000000..2dd8e81f --- /dev/null +++ b/noao/mtlocal/cyber/powd.inc @@ -0,0 +1,128 @@ + data (tbl(i), i=1, 2) /2.93873587706D-39, 5.87747175411D-39/ + data (tbl(i), i=3, 4) /1.17549435082D-38, 2.35098870164D-38/ + data (tbl(i), i=5, 6) /4.70197740329D-38, 9.40395480658D-38/ + data (tbl(i), i=7, 8) /1.88079096132D-37, 3.76158192263D-37/ + data (tbl(i), i=9, 10) /7.52316384526D-37, 1.50463276905D-36/ + data (tbl(i), i=11, 12) /3.00926553811D-36, 6.01853107621D-36/ + data (tbl(i), i=13, 14) /1.20370621524D-35, 2.40741243048D-35/ + data (tbl(i), i=15, 16) /4.81482486097D-35, 9.62964972194D-35/ + data (tbl(i), i=17, 18) /1.92592994439D-34, 3.85185988877D-34/ + data (tbl(i), i=19, 20) /7.70371977755D-34, 1.54074395551D-33/ + data (tbl(i), i=21, 22) /3.08148791102D-33, 6.16297582204D-33/ + data (tbl(i), i=23, 24) /1.23259516441D-32, 2.46519032882D-32/ + data (tbl(i), i=25, 26) /4.93038065763D-32, 9.86076131526D-32/ + data (tbl(i), i=27, 28) /1.97215226305D-31, 3.94430452611D-31/ + data (tbl(i), i=29, 30) /7.88860905221D-31, 1.57772181044D-30/ + data (tbl(i), i=31, 32) /3.15544362088D-30, 6.31088724177D-30/ + data (tbl(i), i=33, 34) /1.26217744835D-29, 2.52435489671D-29/ + data (tbl(i), i=35, 36) /5.04870979341D-29, 1.00974195868D-28/ + data (tbl(i), i=37, 38) /2.01948391737D-28, 4.03896783473D-28/ + data (tbl(i), i=39, 40) /8.07793566946D-28, 1.61558713389D-27/ + data (tbl(i), i=41, 42) /3.23117426779D-27, 6.46234853557D-27/ + data (tbl(i), i=43, 44) /1.29246970711D-26, 2.58493941423D-26/ + data (tbl(i), i=45, 46) /5.16987882846D-26, 1.03397576569D-25/ + data (tbl(i), i=47, 48) /2.06795153138D-25, 4.13590306277D-25/ + data (tbl(i), i=49, 50) /8.27180612553D-25, 1.65436122511D-24/ + data (tbl(i), i=51, 52) /3.30872245021D-24, 6.61744490042D-24/ + data (tbl(i), i=53, 54) /1.32348898008D-23, 2.64697796017D-23/ + data (tbl(i), i=55, 56) /5.29395592034D-23, 1.05879118407D-22/ + data (tbl(i), i=57, 58) /2.11758236814D-22, 4.23516473627D-22/ + data (tbl(i), i=59, 60) /8.47032947254D-22, 1.69406589451D-21/ + data (tbl(i), i=61, 62) /3.38813178902D-21, 6.77626357803D-21/ + data (tbl(i), i=63, 64) /1.35525271561D-20, 2.71050543121D-20/ + data (tbl(i), i=65, 66) /5.42101086243D-20, 1.08420217249D-19/ + data (tbl(i), i=67, 68) /2.16840434497D-19, 4.33680868994D-19/ + data (tbl(i), i=69, 70) /8.67361737988D-19, 1.73472347598D-18/ + data (tbl(i), i=71, 72) /3.46944695195D-18, 6.93889390391D-18/ + data (tbl(i), i=73, 74) /1.38777878078D-17, 2.77555756156D-17/ + data (tbl(i), i=75, 76) /5.55111512313D-17, 1.11022302463D-16/ + data (tbl(i), i=77, 78) /2.22044604925D-16, 4.44089209850D-16/ + data (tbl(i), i=79, 80) /8.88178419700D-16, 1.77635683940D-15/ + data (tbl(i), i=81, 82) /3.55271367880D-15, 7.10542735760D-15/ + data (tbl(i), i=83, 84) /1.42108547152D-14, 2.84217094304D-14/ + data (tbl(i), i=85, 86) /5.68434188608D-14, 1.13686837722D-13/ + data (tbl(i), i=87, 88) /2.27373675443D-13, 4.54747350886D-13/ + data (tbl(i), i=89, 90) /9.09494701773D-13, 1.81898940355D-12/ + data (tbl(i), i=91, 92) /3.63797880709D-12, 7.27595761418D-12/ + data (tbl(i), i=93, 94) /1.45519152284D-11, 2.91038304567D-11/ + data (tbl(i), i=95, 96) /5.82076609135D-11, 1.16415321827D-10/ + data (tbl(i), i=97, 98) /2.32830643654D-10, 4.65661287308D-10/ + data (tbl(i), i=99, 100) /9.31322574615D-10, 1.86264514923D-9/ + data (tbl(i), i=101, 102) /3.72529029846D-9, 7.45058059692D-9/ + data (tbl(i), i=103, 104) /1.49011611938D-8, 2.98023223877D-8/ + data (tbl(i), i=105, 106) /5.96046447754D-8, 1.19209289551D-7/ + data (tbl(i), i=107, 108) /2.38418579102D-7, 4.76837158203D-7/ + data (tbl(i), i=109, 110) /9.53674316406D-7, 1.90734863281D-6/ + data (tbl(i), i=111, 112) /3.81469726563D-6, 7.62939453125D-6/ + data (tbl(i), i=113, 114) /1.52587890625D-5, 3.05175781250D-5/ + data (tbl(i), i=115, 116) /6.10351562500D-5, 1.22070312500D-4/ + data (tbl(i), i=117, 118) /2.44140625000D-4, 4.88281250000D-4/ + data (tbl(i), i=119, 120) /9.76562500000D-4, 0.001953125/ + data (tbl(i), i=121, 122) /0.00390625, 0.0078125/ + data (tbl(i), i=123, 124) /0.015625, 0.03125/ + data (tbl(i), i=125, 126) /0.0625, 0.125/ + data (tbl(i), i=127, 128) /0.25, 0.5/ + data (tbl(i), i=129, 130) /1., 2./ + data (tbl(i), i=131, 132) /4., 8./ + data (tbl(i), i=133, 134) /16., 32./ + data (tbl(i), i=135, 136) /64., 128./ + data (tbl(i), i=137, 138) /256., 512./ + data (tbl(i), i=139, 140) /1024., 2048./ + data (tbl(i), i=141, 142) /4096., 8192./ + data (tbl(i), i=143, 144) /16384., 32768./ + data (tbl(i), i=145, 146) /65536., 131072./ + data (tbl(i), i=147, 148) /262144., 524288./ + data (tbl(i), i=149, 150) /1048576., 2097152./ + data (tbl(i), i=151, 152) /4194304., 8388608./ + data (tbl(i), i=153, 154) /16777216., 33554432./ + data (tbl(i), i=155, 156) /67108864., 134217728./ + data (tbl(i), i=157, 158) /268435456., 536870912./ + data (tbl(i), i=159, 160) /1073741824., 2147483648./ + data (tbl(i), i=161, 162) /4294967296., 8589934592./ + data (tbl(i), i=163, 164) /17179869184., 34359738368./ + data (tbl(i), i=165, 166) /68719476736., 137438953472./ + data (tbl(i), i=167, 168) /274877906944., 549755813888./ + data (tbl(i), i=169, 170) /1099511627776., 2199023255552./ + data (tbl(i), i=171, 172) /4398046511104., 8796093022208./ + data (tbl(i), i=173, 174) /17592186044416., 35184372088832./ + data (tbl(i), i=175, 176) /70368744177664., 140737488355328./ + data (tbl(i), i=177, 178) /281474976710656., 562949953421312./ + data (tbl(i), i=179, 180) /1.12589990684D15, 2.25179981369D15/ + data (tbl(i), i=181, 182) /4.50359962737D15, 9.00719925474D15/ + data (tbl(i), i=183, 184) /1.80143985095D16, 3.60287970190D16/ + data (tbl(i), i=185, 186) /7.20575940379D16, 1.44115188076D17/ + data (tbl(i), i=187, 188) /2.88230376152D17, 5.76460752303D17/ + data (tbl(i), i=189, 190) /1.15292150461D18, 2.30584300921D18/ + data (tbl(i), i=191, 192) /4.61168601843D18, 9.22337203685D18/ + data (tbl(i), i=193, 194) /1.84467440737D19, 3.68934881474D19/ + data (tbl(i), i=195, 196) /7.37869762948D19, 1.47573952590D20/ + data (tbl(i), i=197, 198) /2.95147905179D20, 5.90295810359D20/ + data (tbl(i), i=199, 200) /1.18059162072D21, 2.36118324143D21/ + data (tbl(i), i=201, 202) /4.72236648287D21, 9.44473296574D21/ + data (tbl(i), i=203, 204) /1.88894659315D22, 3.77789318630D22/ + data (tbl(i), i=205, 206) /7.55578637259D22, 1.51115727452D23/ + data (tbl(i), i=207, 208) /3.02231454904D23, 6.04462909807D23/ + data (tbl(i), i=209, 210) /1.20892581961D24, 2.41785163923D24/ + data (tbl(i), i=211, 212) /4.83570327846D24, 9.67140655692D24/ + data (tbl(i), i=213, 214) /1.93428131138D25, 3.86856262277D25/ + data (tbl(i), i=215, 216) /7.73712524553D25, 1.54742504911D26/ + data (tbl(i), i=217, 218) /3.09485009821D26, 6.18970019643D26/ + data (tbl(i), i=219, 220) /1.23794003929D27, 2.47588007857D27/ + data (tbl(i), i=221, 222) /4.95176015714D27, 9.90352031428D27/ + data (tbl(i), i=223, 224) /1.98070406286D28, 3.96140812571D28/ + data (tbl(i), i=225, 226) /7.92281625143D28, 1.58456325029D29/ + data (tbl(i), i=227, 228) /3.16912650057D29, 6.33825300114D29/ + data (tbl(i), i=229, 230) /1.26765060023D30, 2.53530120046D30/ + data (tbl(i), i=231, 232) /5.07060240091D30, 1.01412048018D31/ + data (tbl(i), i=233, 234) /2.02824096037D31, 4.05648192073D31/ + data (tbl(i), i=235, 236) /8.11296384146D31, 1.62259276829D32/ + data (tbl(i), i=237, 238) /3.24518553658D32, 6.49037107317D32/ + data (tbl(i), i=239, 240) /1.29807421463D33, 2.59614842927D33/ + data (tbl(i), i=241, 242) /5.19229685853D33, 1.03845937171D34/ + data (tbl(i), i=243, 244) /2.07691874341D34, 4.15383748683D34/ + data (tbl(i), i=245, 246) /8.30767497366D34, 1.66153499473D35/ + data (tbl(i), i=247, 248) /3.32306998946D35, 6.64613997892D35/ + data (tbl(i), i=249, 250) /1.32922799578D36, 2.65845599157D36/ + data (tbl(i), i=251, 252) /5.31691198314D36, 1.06338239663D37/ + data (tbl(i), i=253, 254) /2.12676479326D37, 4.25352958651D37/ + data tbl(255) /8.50705917302D37/ diff --git a/noao/mtlocal/cyber/rdumpf.x b/noao/mtlocal/cyber/rdumpf.x new file mode 100644 index 00000000..d9371579 --- /dev/null +++ b/noao/mtlocal/cyber/rdumpf.x @@ -0,0 +1,283 @@ +include <mach.h> +include "cyber.h" + +# READ_DUMPF -- Read data from an array of cyber words, passing the +# requested number of cyber words to the output buffer. +# The word array contains control words and "Zero length PRU's" as well +# as data. The control words are read and used to properly +# interpret the PRU that follows. Each read by GET_CYBER_WORDS begins +# on a control word boundry. It is expected that read_dumpf returns an +# integral number of PRU's; if not, the data remaining in the PRU is discarded, +# as the buffer pointer must be positioned to the control word preceeding +# a PRU upon entry to read_dumpf. The number of cyber words read is +# returned by read_dumpf. Pointer ip is in units of cyber words; there +# are two array elements per cyber word. + +int procedure read_dumpf (rd, out, max_cyb_words) + +int rd, max_cyb_words +int out[ARB], pru_buf[NINT_CYBER_WRD * LEN_CYBER_READ] +int nwords, nwords_read, word_count, ip +int get_cyber_words(), read_dumpf_init(), bitupk() + +begin + if (mod (max_cyb_words, LEN_PRU) != 0) + call error (0, "READ_DUMPF: Non-integral PRU requested") + + for (nwords=0; nwords < max_cyb_words; nwords = nwords + word_count) { + # If necessary, read more data into the pru buffer. This + # will be necessary when all data in the pru buffer has + # been transferred to the output buffer. + + if (ip >= nwords_read) { + # Read another chunk of cyber words; reset buffer position + nwords_read = get_cyber_words (rd, pru_buf, LEN_CYBER_READ) + ip = 1 + + if (nwords_read == EOF) + break + } + + # Get the number of 12-bit bytes in the next pru from control word. + # This number stored in lowest 9 bits of the cyber word. + word_count = bitupk (pru_buf[(NINT_CYBER_WRD * ip) - 1], 1, 9) / + NBYTES_WORD + ip = ip + 1 + + if (word_count == 0) { + # Zero length PRU to be skipped over + ip = ip + LEN_PRU + next + } + + if (mod (word_count * 60, NBITS_CHAR) != 0) + call error (0, "READ_DUMPF: Impossible PRU to CHAR Conversion") + + call amovi (pru_buf[(NINT_CYBER_WRD * ip) - 1], out[(nwords * + NINT_CYBER_WRD) + 1], word_count * NINT_CYBER_WRD) + ip = ip + LEN_PRU + } + + if (nwords == 0) + return (EOF) + else + return (nwords) + +entry read_dumpf_init () + + ip = 1 + nwords_read = 0 +end + +.help read_cyber +.nf ________________________________________________________________________ +GET_CYBER_WORDS -- Read binary chars from a file, ignoring short "noise" +records and extraneous bits inserted to fill out a byte. The requested +number of cyber words is returned, one cyber word per two array elements. +Data is read from +the file buffer and placed in the output array by UNPACK_CYBER_WORDS. The +file buffer is refilled as necessary by calling READ; the output array is +supplied by the calling procedure. Cyber noise records (48 bits) and bits +used to fill out a byte are not transferred to the output array. +Variables marking the current position and top of the buffer are initialized +by GET_CYBER_WORDS_INIT; buf pos marks the buffer position in cyber words. +The number of cyber words read is returned as the function value; the number +of output array elements filled is twice the number of cyber words read. +.endhelp ___________________________________________________________________ + +int procedure get_cyber_words (rd, out, max_cyb_words) + +int rd, max_cyb_words +int out[ARB] +char cyber_buf[SZ_TAPE_BUFFER] +int buf_pos, ncyber_words +int nwords, word_chunk, nchars_read +int read(), get_cyber_words_init() + +begin + for (nwords = 0; nwords < max_cyb_words; nwords = nwords + word_chunk) { + # See if it is necessary to transfer more data from the binary file + # to the file buffer. This will be necessary when all data from the + # file buffer has been transferred to the output array. + + if (buf_pos >= ncyber_words) { + # Read the next non-noise record into cyber_buf; reset buf_pos + repeat { + nchars_read = read (rd, cyber_buf, SZ_TAPE_BUFFER) + } until (nchars_read >= NCHARS_NOISE || nchars_read == EOF) + buf_pos = 1 + ncyber_words = (nchars_read * NBITS_CHAR) / NBITS_CYBER_WORD + + if (nchars_read == EOF) + break + } + + # The number of cyber words to output is the smaller of the number + # requested or the number of words left in the buffer. + + word_chunk = min (max_cyb_words - nwords, ncyber_words- buf_pos + 1) + call unpack_cyber_words (cyber_buf, buf_pos, out, + (NINT_CYBER_WRD * nwords) + 1, word_chunk) + buf_pos = buf_pos + word_chunk + } + + if (nwords == 0) + return (EOF) + else + return (nwords) + +entry get_cyber_words_init () + + buf_pos = 1 + ncyber_words = 0 + return (OK) +end + + + +.help unpack_cyber_words +.nf __________________________________________________________________________ +UNPACK_CYBER_WORDS -- Convert a raw data array from a 60-bit Cyber computer into +an SPP array containing one Cyber word in each 64-bit increment. +The least significant Cyber bit is bit 1 in each output word and the most +significant bit is bit 60. [MACHDEP]. + +When the Cyber outputs an array of 60 bit Cyber words it moves a stream of +bits into output bytes, filling however many bytes as necessary to output a +given number of Cyber words. The most significant bits are output first, +i.e., bit 60 of the first word is moved to bit 8 of the first output byte, +bit 59 is moved to bit 7 of the first output byte, and so on. If effect the +Cyber byte flips each 60-bit word. + +To deal with Cyber words as an ordered bit stream we must reorder the bytes +and bits so that the least significant bits are first. This function is +performed by the primitives CYBOOW and CYBOEW (order odd/even Cyber word) +for individual 60-bit Cyber words. A portable (and less efficient) version +of order_cyber_bits is available which does not use these primitives. +.endhelp _____________________________________________________________________ + + +procedure unpack_cyber_words (raw_cyber, first_cyber_word, int_array, + first_output_element, ncyber_words) + +char raw_cyber[ARB] # raw Cyber array (e.g. from tape) +int first_cyber_word # first 60-bit Cyber word to be unpacked +int int_array[ARB] # output unpacked array of Cyber words +int first_output_element # first output integer to be filled +int ncyber_words # number of Cyber words to unpack + +bool odd_word +int word, inbit, outbit + +begin + odd_word = (mod (first_cyber_word, 2) == 1) + inbit = (first_cyber_word - 1) * NBITS_CYBER_WORD + 1 + outbit = (first_output_element - 1) * NBITS_INT + 1 + + do word = 1, ncyber_words { + # Call odd or even primitive to reorder bits and move 60-bit + # ordered Cyber word to the output array. + + if (odd_word) { + call cyboow (raw_cyber, inbit, int_array, outbit) + odd_word = false + } else { + call cyboew (raw_cyber, inbit, int_array, outbit) + odd_word = true + } + + inbit = inbit + NBITS_CYBER_WORD + outbit = outbit + NINT_CYBER_WRD * NBITS_INT + } +end + + +# The portable version of order_cyber_bits follows. +#.help order_cyber_bits +#.nf __________________________________________________________________________ +#ORDER_CYBER_BITS -- Convert a raw data array from a 60-bit Cyber computer into +#an SPP bit-array. The output SPP bit-array is a bit-packed array of 60-bit +#Cyber words, i.e., bits 1-60 are word 1, bits 61-120 are word 2, and so on. +#The least significant Cyber bit is bit 1 in each output word and the most +#significant bit is bit 60. [MACHDEP]. +# +#The byte stream from the Cyber contains bits 53-60 of the first word in the +#first byte, bits 45-52 in the second byte, and so on (most significant bytes +#first). In essence we swap the order of the 7 8-bit bytes and the 4-bit half +#byte in each 60 bit word. The bits in each byte are in the correct order. +# +#Each successive pair of Cyber words fits into 15 bytes. Byte 8 contains the +#last 4 bits of word 1 in the most signficant half of the byte and the first +#4 bits of word 2 in the first half of the byte. In each 60 bit word we must +#move bit segments (bytes or half bytes) as follows (for the VAX): +# +#Odd words (from N*60 bit-offset): +# [from] [to] [nbits] +# 1 53 8 +# 9 45 8 +# 17 37 8 +# 25 29 8 +# 33 21 8 +# 41 13 8 +# 49 5 8 +# 61 1 4 +# +#Even words (from N*60 bit-offset): +# [from] [to] [nbits] +# -3 57 4 +# 5 49 8 +# 13 41 8 +# 21 33 8 +# 29 25 8 +# 37 17 8 +# 45 9 8 +# 53 1 8 +#.endhelp _____________________________________________________________________ +# +#define NBITS_PER_WORD 60 +#define NSEGMENTS 8 +# +# +#procedure order_cyber_bits (raw_cyber, first_cyber_word, bit_array, +# ncyber_words) +# +#char raw_cyber[ARB] # raw Cyber array (e.g. from tape) +#int first_cyber_word # first 60-bit Cyber word to be unpacked +#char bit_array[ARB] # output bit-array +#int ncyber_words # number of Cyber words to unpack +# +#int word, inword, inbit, outbit, temp, i +#int o_from[NSEGMENTS], o_to[NSEGMENTS], o_nbits[NSEGMENTS] +#int e_from[NSEGMENTS], e_to[NSEGMENTS], e_nbits[NSEGMENTS] +#int bitupk() +# +#data o_from / 1, 9,17,25,33,41,49,61/ # odd words +#data o_to /53,45,37,29,21,13, 5, 1/ +#data o_nbits / 8, 8, 8, 8, 8, 8, 8, 4/ +#data e_from /-3, 5,13,21,29,37,45,53/ # even words +#data e_to /57,49,41,33,25,17, 9, 1/ +#data e_nbits / 4, 8, 8, 8, 8, 8, 8, 8/ +# +#begin +# do word = 1, ncyber_words { +# inword = first_cyber_word + word - 1 +# inbit = (inword - 1) * NBITS_PER_WORD +# outbit = ( word - 1) * NBITS_PER_WORD +# +# # Move bits to the output bit array. Segment list used depends +# # on whether the word is an odd or even word. This code will work +# # even if the caller only wishes to order a single word. +# +# if (mod (inword,2) == 1) { +# do i = 1, NSEGMENTS { +# temp = bitupk (raw_cyber, inbit + o_from[i], o_nbits[i]) +# call bitpak (temp, bit_array, outbit + o_to[i], o_nbits[i]) +# } +# } else { +# do i = 1, NSEGMENTS { +# temp = bitupk (raw_cyber, inbit + e_from[i], e_nbits[i]) +# call bitpak (temp, bit_array, outbit + e_to[i], e_nbits[i]) +# } +# } +# } +#end diff --git a/noao/mtlocal/cyber/rpft.x b/noao/mtlocal/cyber/rpft.x new file mode 100644 index 00000000..f21ec44c --- /dev/null +++ b/noao/mtlocal/cyber/rpft.x @@ -0,0 +1,211 @@ +include <mach.h> +include "cyber.h" + +.help read_cyber +.nf ________________________________________________________________________ +READ_CYBER -- Read binary chars from a file, ignoring short "noise" records. +Data is read in chunks from the file buffer into the output buffer. The +file buffer is refilled as necessary by calling READ; the output buffer is +supplied by the calling procedure. Cyber noise records (48 bits) +are not transferred to the output buffer and so are ignored. READ_CYBER_INIT +must be called to initialize variables for CYBER_READ. Variables marking the +current position and top of the buffer are initialized. +.endhelp ___________________________________________________________________ + +int procedure read_cyber (rd, out_buffer, maxch) + +int buf_pos, buf_top +int rd, maxch +char out_buffer[ARB] +char block_buf[SZ_TAPE_BUFFER] +int nchars, chunk_size, nchars_read +int read(), read_cyber_init() + +begin + for (nchars = 0; nchars < maxch; nchars = nchars + chunk_size) { + # See if it is necessary to transfer more data from the binary file + # to the file buffer. This will be necessary when all data from the + # file buffer has been moved to the output buffer. + + if (buf_pos >= buf_top) { + # Read the next non-noise record into block_buf; reset buf_pos + repeat { + nchars_read = read (rd, block_buf, SZ_TAPE_BUFFER) + } until (nchars_read > NCHARS_NOISE || nchars_read == EOF) + buf_pos = 1 + buf_top = nchars_read + } + + # The number of chars to output is the smaller of the number of + # characters requested or the number of characters left in the + # buffer + + if (nchars_read == EOF) + break + else + chunk_size = min (maxch - nchars, buf_top - buf_pos + 1) + + # Move data to output array, increment buffer offset + call amovc (block_buf[buf_pos], out_buffer[nchars+1], chunk_size) + buf_pos = buf_pos + chunk_size + } + + if (nchars == 0) + return (EOF) + else + return (nchars) + +entry read_cyber_init () + + buf_pos = 1 + buf_top = 0 + return (OK) +end + + +.help order_cyber_bits +.nf __________________________________________________________________________ +ORDER_CYBER_BITS -- Convert a raw data array from a 60-bit Cyber computer into +an SPP bit-array. The output SPP bit-array is a bit-packed array of 60-bit +Cyber words, i.e., bits 1-60 are word 1, bits 61-120 are word 2, and so on. +The least significant Cyber bit is bit 1 in each output word and the most +significant bit is bit 60. [MACHDEP]. + +When the Cyber outputs an array of 60 bit Cyber words it moves a stream of +bits into output bytes, filling however many bytes as necessary to output a +given number of Cyber words. The most significant bits are output first, +i.e., bit 60 of the first word is moved to bit 8 of the first output byte, +bit 59 is moved to bit 7 of the first output byte, and so on. If effect the +Cyber byte flips each 60-bit word. + +To deal with Cyber words as an ordered bit stream we must reorder the bytes +and bits so that the least significant bits are first. This function is +performed by the primitives CYBOOW and CYBOEW (order odd/even Cyber word) +for individual 60-bit Cyber words. A portable (and less efficient) version +of order_cyber_bits is available which does not use these primitives. +.endhelp _____________________________________________________________________ + + +procedure order_cyber_bits (raw_cyber, first_cyber_word, bit_array, + ncyber_words) + +char raw_cyber[ARB] # raw Cyber array (e.g. from tape) +int first_cyber_word # first 60-bit Cyber word to be unpacked +char bit_array[ARB] # output bit-array +int ncyber_words # number of Cyber words to unpack + +bool odd_word +int word, inbit, outbit + +begin + odd_word = (mod (first_cyber_word, 2) == 1) + inbit = (first_cyber_word - 1) * NBITS_CYBER_WORD + 1 + outbit = 1 + + do word = 1, ncyber_words { + # Call odd or even primitive to reorder bits and move 60-bit + # ordered Cyber word to the output array. + + if (odd_word) { + call cyboow (raw_cyber, inbit, bit_array, outbit) + odd_word = false + } else { + call cyboew (raw_cyber, inbit, bit_array, outbit) + odd_word = true + } + + inbit = inbit + NBITS_CYBER_WORD + outbit = outbit + NBITS_CYBER_WORD + } +end + + +# The portable version of order_cyber_bits follows. +#.help order_cyber_bits +#.nf __________________________________________________________________________ +#ORDER_CYBER_BITS -- Convert a raw data array from a 60-bit Cyber computer into +#an SPP bit-array. The output SPP bit-array is a bit-packed array of 60-bit +#Cyber words, i.e., bits 1-60 are word 1, bits 61-120 are word 2, and so on. +#The least significant Cyber bit is bit 1 in each output word and the most +#significant bit is bit 60. [MACHDEP]. +# +#The byte stream from the Cyber contains bits 53-60 of the first word in the +#first byte, bits 45-52 in the second byte, and so on (most significant bytes +#first). In essence we swap the order of the 7 8-bit bytes and the 4-bit half +#byte in each 60 bit word. The bits in each byte are in the correct order. +# +#Each successive pair of Cyber words fits into 15 bytes. Byte 8 contains the +#last 4 bits of word 1 in the most signficant half of the byte and the first +#4 bits of word 2 in the first half of the byte. In each 60 bit word we must +#move bit segments (bytes or half bytes) as follows (for the VAX): +# +#Odd words (from N*60 bit-offset): +# [from] [to] [nbits] +# 1 53 8 +# 9 45 8 +# 17 37 8 +# 25 29 8 +# 33 21 8 +# 41 13 8 +# 49 5 8 +# 61 1 4 +# +#Even words (from N*60 bit-offset): +# [from] [to] [nbits] +# -3 57 4 +# 5 49 8 +# 13 41 8 +# 21 33 8 +# 29 25 8 +# 37 17 8 +# 45 9 8 +# 53 1 8 +#.endhelp _____________________________________________________________________ +# +#define NBITS_PER_WORD 60 +#define NSEGMENTS 8 +# +# +#procedure order_cyber_bits (raw_cyber, first_cyber_word, bit_array, +# ncyber_words) +# +#char raw_cyber[ARB] # raw Cyber array (e.g. from tape) +#int first_cyber_word # first 60-bit Cyber word to be unpacked +#char bit_array[ARB] # output bit-array +#int ncyber_words # number of Cyber words to unpack +# +#int word, inword, inbit, outbit, temp, i +#int o_from[NSEGMENTS], o_to[NSEGMENTS], o_nbits[NSEGMENTS] +#int e_from[NSEGMENTS], e_to[NSEGMENTS], e_nbits[NSEGMENTS] +#int bitupk() +# +#data o_from / 1, 9,17,25,33,41,49,61/ # odd words +#data o_to /53,45,37,29,21,13, 5, 1/ +#data o_nbits / 8, 8, 8, 8, 8, 8, 8, 4/ +#data e_from /-3, 5,13,21,29,37,45,53/ # even words +#data e_to /57,49,41,33,25,17, 9, 1/ +#data e_nbits / 4, 8, 8, 8, 8, 8, 8, 8/ +# +#begin +# do word = 1, ncyber_words { +# inword = first_cyber_word + word - 1 +# inbit = (inword - 1) * NBITS_PER_WORD +# outbit = ( word - 1) * NBITS_PER_WORD +# +# # Move bits to the output bit array. Segment list used depends +# # on whether the word is an odd or even word. This code will work +# # even if the caller only wishes to order a single word. +# +# if (mod (inword,2) == 1) { +# do i = 1, NSEGMENTS { +# temp = bitupk (raw_cyber, inbit + o_from[i], o_nbits[i]) +# call bitpak (temp, bit_array, outbit + o_to[i], o_nbits[i]) +# } +# } else { +# do i = 1, NSEGMENTS { +# temp = bitupk (raw_cyber, inbit + e_from[i], e_nbits[i]) +# call bitpak (temp, bit_array, outbit + e_to[i], e_nbits[i]) +# } +# } +# } +#end diff --git a/noao/mtlocal/cyber/rrcopy/README b/noao/mtlocal/cyber/rrcopy/README new file mode 100644 index 00000000..ec7e7c70 --- /dev/null +++ b/noao/mtlocal/cyber/rrcopy/README @@ -0,0 +1,2 @@ +This directory contains source code for rrcopy, the Cyber RCOPY tape +reader. diff --git a/noao/mtlocal/cyber/rrcopy/Revisions b/noao/mtlocal/cyber/rrcopy/Revisions new file mode 100644 index 00000000..09bf9e12 --- /dev/null +++ b/noao/mtlocal/cyber/rrcopy/Revisions @@ -0,0 +1,15 @@ +.help revisions Jun88 noao.mtlocal.cyber.rrcopy +.nf +noao$mtlocal/cyber/rrcopy/t_rrcopy.x, rcrheader.x + Fixed two places in t_rrcopy where the procedure was returning + without closing the mt file. Procedure rc_read_header was + not returning the value (OK) when NOT at EOF. These two errors, + while present all along, had not been seen until rrcopy was modified + to read tapes with more then one datafile; see below. (4-AUG-88 ShJ) + +noao$mtlocal/cyber/rrcopy/t_rrcopy.x + Added a hidden parameter "datafile" to the rrcopy task. This + allows more than one file of rcopy format data per tape. With + this "extension" to the rcopy format, many rcopy files can be + archived on a single tape. (26-JULY-88 ShJ) +.endhelp diff --git a/noao/mtlocal/cyber/rrcopy/mkpkg b/noao/mtlocal/cyber/rrcopy/mkpkg new file mode 100644 index 00000000..6d2d99d3 --- /dev/null +++ b/noao/mtlocal/cyber/rrcopy/mkpkg @@ -0,0 +1,15 @@ +# The Cyber rcopy format reader RRCOPY makes the following contributions +# to the dataio package library: + +$checkout libpkg.a ../../ +$update libpkg.a +$checkin libpkg.a ../../ +$exit + +libpkg.a: + rcrbits.x ../pow.inc <error.h> <imhdr.h> <mach.h> rrcopy.h + rcrheader.x <error.h> <imhdr.h> <mach.h> rrcopy.h + rcrimage.x rrcopy.h <error.h> <imhdr.h> <mach.h> + rrcopy.x <mach.h> rrcopy.h + t_rrcopy.x rrcopy.h <error.h> <imhdr.h> <mach.h> + ; diff --git a/noao/mtlocal/cyber/rrcopy/rcrbits.x b/noao/mtlocal/cyber/rrcopy/rcrbits.x new file mode 100644 index 00000000..c6525787 --- /dev/null +++ b/noao/mtlocal/cyber/rrcopy/rcrbits.x @@ -0,0 +1,279 @@ +include <mach.h> +include <imhdr.h> +include <error.h> +include "rrcopy.h" + +# RC_UP_12 -- Unpack 12-bit unsigned integers from a stream of bits. +# Each output integer word contains successive 12-bit increments +# of the input bit stream in the least significant bit positions. +# It is assummed that the initial_bit_offset is the first bit of a +# Cyber 60-bit word containing 5 packed 12-bit pixels, the first pixel +# in the highest 12 bits. + +procedure rc_up_12 (input, initial_bit_offset, output, npix_unpk) + +char input[ARB] +int output[npix_unpk], npix_unpk +int initial_bit_offset, nbits, n, nn, bit_offset +int npix_word, ncyb_words, index +int bitupk() + +begin + nbits = 12 + npix_word = 5 + if (mod (npix_unpk, npix_word) == 0) + ncyb_words = (npix_unpk) / npix_word + else + call error (0, "Incorrect number of pixels to be unpacked") + index = 1 + + do n = 1, ncyb_words { + bit_offset = initial_bit_offset + (n * 60) + do nn = 1, npix_word { + bit_offset = bit_offset - nbits + output[index] = bitupk (input, bit_offset, nbits) + if (output[index] == 7777B) + output[index] = BLANK + index = index + 1 + } + } +end + + +# RC_UP_20 -- Unpack 20-bit signed integers from a stream of bits. +# Each output integer word contains sucessive 20-bit increments of the input. +# Conversion from one's complement to two's complement is performed. +# It is assummed that initial_bit_offset is the first bit of a Cyber +# 60-bit word containing 3 packed 20-bit pixels, the first pixel in the +# highest 20 bits. + +procedure rc_up_20 (input, initial_bit_offset, output, npix_unpk) + +char input[ARB] +int output[npix_unpk], npix_unpk +int nbits, n, index, bit_offset, initial_bit_offset +int npix_word, ncyb_words, nn, pix_val +int bitupk() + +begin + nbits = 20 + npix_word = 3 + if (mod (npix_unpk, npix_word) == 0) + ncyb_words = npix_unpk / npix_word + else + call error (0, "Incorrect number of pixels to be unpacked") + index = 1 + + do n = 1, ncyb_words { + bit_offset = initial_bit_offset + (n * 60) + do nn = 1, npix_word { + bit_offset = bit_offset - nbits + pix_val = bitupk (input, bit_offset, nbits) + if (pix_val == 3777777B) + pix_val = BLANK + else if (and (pix_val, 2000000B) != 0) + # negative pixel + pix_val = -and (3777777B, not(pix_val)) + output[index] = pix_val + index = index + 1 + } + } +end + + +# RC_UP_30 -- unpack Cyber 30-bit floating point numbers from a stream of +# bits. The input bit stream is unpacked in 30-bit increments into +# an integer array. Procedure REPACK_FP is called to reconstruct the +# floating point numbers from this array. It is assumed initial_bit_offset +# is the first bit of a Cyber 60-bit word containing 2 30-bit pixels, the +# first pixel in the higher 30 bits. + +procedure rc_up_30 (input, initial_bit_offset, fp_value, npix) + +char input[ARB] +real fp_value[npix] +pointer int_buf, sp +int initial_bit_offset, npix, bit_offset +int nbits, n +int bitupk() + +begin + # Allocate buffer space, allowing for maximum of 1 extraneous pixel + call smark (sp) + call salloc (int_buf, npix + 1, TY_INT) + + nbits = 30 + bit_offset = initial_bit_offset - 60 + + do n = 1, npix, 2 { + bit_offset = bit_offset + 90 + Memi[int_buf + n - 1] = bitupk (input, bit_offset, 30) + bit_offset = bit_offset - nbits + Memi[int_buf + n] = bitupk (input, bit_offset, 30) + } + + call rc_repack_fp (Memi[int_buf], fp_value, npix) + call sfree (sp) +end + + +# RC_UP_60R -- Unpack Cyber 60-bit floating point numbers from a stream +# of bits. The 30 most significant bits from each 60-bit word are +# unpacked into an integer array. Procedure REPACK_FP is called to +# reconstruct the floating point numbers from this array. +# An 18-bit mantissa, 11-bit exponent and a sign bit are unpacked into +# the lower 30 bits of each output word. + +procedure rc_up_60r (input, initial_bit_offset, fp_value, nwords) + +char input[ARB] +real fp_value[nwords] +int initial_bit_offset, nwords, bit_offset +pointer int_buf, sp +int n, nbits_unpk, nbits +int bitupk() + +begin + # Allocate space on stack + call smark (sp) + call salloc (int_buf, nwords, TY_INT) + + nbits = 60 + nbits_unpk = 30 + bit_offset = initial_bit_offset + 30 + + do n = 1, nwords { + Memi[int_buf + n - 1] = bitupk (input, bit_offset, nbits_unpk) + bit_offset = bit_offset + 60 + } + + call rc_repack_fp (Memi[int_buf], fp_value, nwords) + call sfree (sp) +end + + +# RC_UP_60I -- Unpack 60-bit integers from a stream of bits. Each element +# of output contains only the lower 32 bits of each input word, as this +# procedure is called only for getting NROWS, NCOLS and a few other small +# positive integer values. (A 60-bit intger is not a valid IPPS pixel type.) + +procedure rc_up_60i (input, initial_bit_offset, output, nwords) + +char input[ARB] +int output[nwords] +int initial_bit_offset, nwords, bit_offset +int n, nbits_unpk, nbits +int bitupk() + +begin + nbits_unpk = NBITS_INT + nbits = 60 + bit_offset = initial_bit_offset + + do n = 1, nwords { + output[n] = bitupk (input, bit_offset, nbits_unpk) + bit_offset = bit_offset + 60 + } +end + + +# RC_UP_ID -- Unpacks ID string from input bit stream. The IPPS ID string is +# written in 7-bit ASCII, with eight characters per Cyber word. The lowest +# 4 bits of each 60-bit word is unused. The highest 7 bits of the first Cyber +# word in the bit stream contains the character count. + +procedure rc_up_id (input, output) + +char input[SZ_HEADER] +char output[SZ_HEADER] +int nbits, nchar_offset, id_offset, nchars, n +int nchars_word, ncyb_words, nn, index +int bitupk() + +begin + nbits = 7 + nchar_offset = NBITS_CYBER_WORD - 6 + nchars = bitupk (input, nchar_offset, nbits) + ncyb_words = (nchars + 7) / 8 + index = 1 + + do n = 1, ncyb_words { + if (n == 1) { + nchars_word = 7 + id_offset = nchar_offset - 7 + } else { + nchars_word = 8 + id_offset = (n * NBITS_CYBER_WORD) - 6 + } + do nn = 1, nchars_word { + output[index] = bitupk (input, id_offset, nbits) + index = index + 1 + id_offset = id_offset - 7 + } + } + output[nchars+1] = EOS +end + + +# RC_REPACK_FP -- returns a floating point number as the function value. +# The input to REPACK_FP is an integer containing a 30-bit Cyber floating +# point number in the least significant bits. The exponent, mantissa +# and two bits indicating the sign are extracted and used to reassemble +# the floating point value. Cyber blanks and overflows are returned as BLANK. + +procedure rc_repack_fp (int_value, float_value, nvalues) + +int int_value[ARB], nvalues +real float_value[nvalues] + +int i, pixel +int exp, mantissa +real tbl[255] +int bitupk(), and(), not() +include "../pow.inc" + +begin + do i=1, nvalues { + pixel = int_value[i] + # Check for blanks + if (pixel == 1777000000B) { + float_value[i] = BLANK + next + } + + # Check "bit59" and complement all bits if it is set + if (and (pixel, 4000000000B) != 0) { + pixel = not (pixel) + mantissa = -and (pixel, 777777B) + } else + mantissa = and (pixel, 777777B) + + # Extract and interpret exponent: remove Cyber bias of 2000B + # and convert to two's complement if negative number + exp = bitupk (pixel, 19, 11) + if (exp > 1777B) + # "bit58" is set, positive exponent + exp = exp - 2000B + else + # negative exponent + exp = exp - 1777B + + # Reconstruct the floating point value: 30 is added to the + # exponent because only the top 18 bits of the 48-bit mantissa + # were extracted; the 129 is to register the data array index. + # float_value[i] = real(mantissa) * 2 ** (exp + 30) + # (tbl[1] = 2 ** -128) ==> (2 ** n = tbl[n + 129]). + + exp = exp + 30 + 129 + if (exp <= 0) { + #call eprintf ( + #"RRCOPY_RPACK_FP: Exponent underflow in following record\n") + float_value[i] = 0.0 + } else if (exp > 255) { + #call eprintf ( + #"RRCOPY_REPACK_FP: Exponent overflow in following record\n") + float_value[i] = MAX_REAL + } else if (exp > 0 && exp <= 255) + float_value[i] = double (mantissa) * tbl[exp] + } +end diff --git a/noao/mtlocal/cyber/rrcopy/rcrheader.x b/noao/mtlocal/cyber/rrcopy/rcrheader.x new file mode 100644 index 00000000..2187c6a1 --- /dev/null +++ b/noao/mtlocal/cyber/rrcopy/rcrheader.x @@ -0,0 +1,119 @@ +include <mach.h> +include <imhdr.h> +include <error.h> +include "rrcopy.h" + +# RC_READ_HEADER -- reads the IPPS header (64 60-bit words) as +# a bit stream into consecutive elements of char array header. +# Any extraneous information between the header and data is skipped; +# the tape is left positioned at the first data record. + +int procedure rc_header_read (rd, rp) + +int rd +pointer rp +char raw_header[SZ_HEADER], header[SZ_HEADER] +int nchars_to_skip, first_word +int rc_read_cyber() +errchk rc_header_unpk, rc_skip_chars, rc_read_cyber, rc_order_cyber_bits + +begin + if (rc_read_cyber (rd, raw_header, SZ_HEADER) == EOF) + return (EOF) + + first_word = 1 + call rc_order_cyber_bits (raw_header, first_word, header, LEN_PRU) + + # Unpack bit stream and fill structure rp + iferr { + call rc_header_unpk (header, rp) + nchars_to_skip = (PRU_ROW_ONE(rp) - 1) * NBITS_PRU / NBITS_CHAR + } then { + call erract (EA_WARN) + # Position to first row of raster before posting error + if (nchars_to_skip > 0) + call rc_skip_chars (rd, nchars_to_skip) + call error (1, "Bad header, attempting to skip raster") + } + + # Position to first row of IPPS raster + if (nchars_to_skip > 0) + call rc_skip_chars (rd, nchars_to_skip) + + return (OK) +end + + +# RC_LIST_HEADER -- prints the RCOPY header information. + +procedure rc_list_header (rp, raster_num) + +pointer rp +int raster_num + +begin + # Print header information from rcopy tape + call printf ("[%d]%7t IPPS_ID: %s\n") + call pargi (raster_num) + call pargstr (IPPS_ID(rp)) + call printf ("%7t NCOLS=%d, NROWS=%d, MIN=%g, MAX=%g, NBPP=%d\n") + call pargi (NCOLS(rp)) + call pargi (NROWS(rp)) + call pargr (DATA_MIN(rp)) + call pargr (DATA_MAX(rp)) + call pargi (BITS_PIXEL(rp)) +end + + +# RC_UNPACK_HEADER -- unpacks header words from the char array header +# and fills the RCOPY data structure. A few values are checked to +# make sure a valid IPPS raster is being read. Offsets to various +# header words have been defined previously. + +procedure rc_header_unpk (header, rp) + +char header[SZ_HEADER] +pointer rp + +begin + # From the reordered array, first the ID is unpacked + call rc_up_id (header, IPPS_ID(rp)) + + # An EOR marker terminates each raster + call rc_up_60i (header, EOR_OFFSET, PRU_EOR(rp), 1) + + # The PRU containing the first data row + call rc_up_60i (header, FIRST_PRU_OFFSET, PRU_ROW_ONE(rp), 1) + + # Most significant 30 bits of the data min are used + call rc_up_60r (header, MIN_OFFSET, DATA_MIN(rp), 1) + + # Most significant 30 bits of the data max are used + call rc_up_60r (header, MAX_OFFSET, DATA_MAX(rp), 1) + + # Bits per pixel is unpacked and tested + call rc_up_60i (header, DATA_TYPE_OFFSET, BITS_PIXEL(rp), 1) + + switch (BITS_PIXEL(rp)) { + case 12,20,30,60: + ; + default: + call error (2, "Incorrect IPPS BITS_PIXEL") + } + + # Number of columns is unpacked and tested + call rc_up_60i (header, NCOLS_OFFSET, NCOLS(rp), 1) + if (NCOLS(rp) <= 0) + call error (2, "IPPS ncols <= 0") + + # Number of Cyber words per row must be integral # of PRU's + call rc_up_60i (header, NWORDS_OFFSET, WRDS_PER_ROW(rp), 1) + + if (mod (WRDS_PER_ROW(rp), LEN_PRU) != 0) + call error (2, "Invalid IPPS NWPR") + + # Number of rows is unpacked and tested + call rc_up_60i (header, NROWS_OFFSET, NROWS(rp), 1) + if (NROWS(rp) <= 0) + call error (2, "IPPS nrows <= 0") +end diff --git a/noao/mtlocal/cyber/rrcopy/rcrimage.x b/noao/mtlocal/cyber/rrcopy/rcrimage.x new file mode 100644 index 00000000..dc7ebcfb --- /dev/null +++ b/noao/mtlocal/cyber/rrcopy/rcrimage.x @@ -0,0 +1,173 @@ +include <mach.h> +include <imhdr.h> +include <error.h> +include "rrcopy.h" + +# RC_READ_IMAGE -- reads the rcopy image row by row from the tape and writes +# the output image. At the completion of READ_IMAGE, the tape is positioned +# to the header record of the next tape raster. + +procedure rc_read_image (rd, out_fname, data_type, rp) + +int rd, data_type +char out_fname[SZ_FNAME] +pointer rp + +pointer sp, im, cyber_buf, spp_buf +int nchars_per_row, nbits_skip, nchars_to_skip, i +long clktime() + +int rc_read_cyber() +pointer immap(), impl2r() +errchk rc_skip_chars, immap, rc_ipps_to_iraf + +begin + # Allocate buffer for rcopy image pixels + call smark (sp) + nchars_per_row = WRDS_PER_ROW(rp) * NBITS_CYBER_WORD / NBITS_CHAR + call salloc (cyber_buf, nchars_per_row, TY_CHAR) + call salloc (spp_buf, nchars_per_row, TY_CHAR) + + # Map new iraf image and set up image header + im = immap (out_fname, NEW_IMAGE, 0) + IM_LEN(im, 1) = NCOLS(rp) + IM_LEN(im, 2) = NROWS(rp) + call strcpy (IPPS_ID(rp), IM_TITLE(im), SZ_IMTITLE) + IM_MIN(im) = DATA_MIN(rp) + IM_MAX(im) = DATA_MAX(rp) + + # Set optimum image pixel type + if (data_type == NOT_SET) { + switch (BITS_PIXEL(rp)) { + case 12: + IM_PIXTYPE(im) = TY_SHORT + case 20: + IM_PIXTYPE(im) = TY_REAL + case 30: + IM_PIXTYPE(im) = TY_REAL + case 60: + IM_PIXTYPE(im) = TY_REAL + default: + call error (3, "IPPS BITS_PIXEL is incorrect") + } + } else + IM_PIXTYPE(im) = data_type + IM_LIMTIME(im) = clktime (long(0)) + + # Loop over rows to read, reorder and convert pixels. + for (i=1; i <= NROWS(rp); i=i+1) { + if (rc_read_cyber (rd, Memc[cyber_buf], nchars_per_row) == EOF) + call error (4, "Unexpected EOT when reading image") + call rc_order_cyber_bits (Memc[cyber_buf], 1, Memc[spp_buf], + WRDS_PER_ROW(rp)) + call rc_ipps_to_iraf (Memc[spp_buf], Memr[impl2r(im,i)], NCOLS(rp), + BITS_PIXEL(rp)) + } + + # Skip from present position to end of rcopy raster + nbits_skip = ((PRU_EOR(rp) - PRU_ROW_ONE(rp)) * LEN_PRU - + (WRDS_PER_ROW(rp) * NROWS(rp))) * NBITS_CYBER_WORD + NBITS_EOR_MARK + + nchars_to_skip = nbits_skip / NBITS_CHAR + call rc_skip_chars (rd, nchars_to_skip) + + call imunmap (im) + call sfree (sp) +end + + +# RC_IPPS_TO_IRAF -- performs the conversion from Cyber pixels to IRAF pixels. +# Each row of the rcopy image is required to occupy an integral of Cyber +# PRU's, so the input buffer contains pixels plus filler. The entire +# buffer is converted and npix pixels are written to the output image. + +procedure rc_ipps_to_iraf (in_buf, iraf_real, npix, nbits_pixel) + +char in_buf[ARB] +real iraf_real[npix] +pointer iraf_int, sp +int nbits_pixel, npix, bit_offset, npix_unpk, npix_cyber_wrd +errchk rc_up_12, rc_up_20 + +begin + # Calculate and allocate (maximum) space needed on the stack. The + # number of pixels unpacked will always fill an integral number + # of Cyber words. A maximum of 4 extraneous pixels will be unpacked. + call smark (sp) + call salloc (iraf_int, npix + 4, TY_INT) + bit_offset = 1 + + switch (nbits_pixel) { + case 12: + npix_cyber_wrd = 5 + npix_unpk = ((npix + 4) / npix_cyber_wrd) * npix_cyber_wrd + call rc_up_12 (in_buf, bit_offset, Memi[iraf_int], npix_unpk) + call achtir (Memi[iraf_int], iraf_real, npix) + + case 20: + npix_cyber_wrd = 3 + npix_unpk = ((npix + 2) / npix_cyber_wrd) * npix_cyber_wrd + call rc_up_20 (in_buf, bit_offset, Memi[iraf_int], npix_unpk) + call achtir (Memi[iraf_int], iraf_real, npix) + + case 30: + call rc_up_30 (in_buf, bit_offset, iraf_real, npix) + + case 60: + call rc_up_60r (in_buf, bit_offset, iraf_real, npix) + + default: + call error (5, "Illegal IPPS #B/P") + } + + call sfree (sp) +end + + +# RC_SKIP_IMAGE -- skips over an RCOPY raster once the header has been +# read. When SKIP_IMAGE returns, the tape is positioned to the first +# record of the next tape image. + +procedure rc_skip_image (rd, rp) + +int rd +pointer rp +int nchars_to_skip +errchk rc_skip_chars + +begin + # Calculate number of chars in image + nchars_to_skip = ((PRU_EOR(rp) - PRU_ROW_ONE(rp)) * + LEN_PRU * NBITS_CYBER_WORD + NBITS_EOR_MARK ) / NBITS_CHAR + call rc_skip_chars (rd, nchars_to_skip) +end + +# RC_SKIP_CHARS -- positions the tape by skipping the requested number of chars. + +procedure rc_skip_chars (rd, nchars_to_skip) + +int rd, nchars_to_skip +pointer sp, dummy +int nblks_read, nchars_remaining, i +int rc_read_cyber() + +begin + call smark (sp) + call salloc (dummy, SZ_TAPE_BLK, TY_CHAR) + + # Calculate the number of full blocks to skip + nblks_read = nchars_to_skip / SZ_TAPE_BLK + nchars_remaining = mod (nchars_to_skip, SZ_TAPE_BLK) + + # Read from tape, a block at a time + for (i=1; i <= nblks_read; i=i+1) { + if (rc_read_cyber (rd, Memc[dummy], SZ_TAPE_BLK) == EOF) + call error (6, "Unexpected EOT when skipping image") + } + + # Read partial block from tape + if (rc_read_cyber (rd, Memc[dummy], nchars_remaining) == EOF) + call error (7, "Unexpected EOT when skipping image") + + call sfree (sp) +end diff --git a/noao/mtlocal/cyber/rrcopy/rrcopy.h b/noao/mtlocal/cyber/rrcopy/rrcopy.h new file mode 100644 index 00000000..9579b623 --- /dev/null +++ b/noao/mtlocal/cyber/rrcopy/rrcopy.h @@ -0,0 +1,41 @@ + +# Definitions for the Cyber RCOPY tape reader + +define NBITS_CHAR (NBITS_BYTE * SZB_CHAR) # Number of bits per char +define NBITS_CYBER_WORD 60 # Number of bits per Cyber word +define LEN_PRU 64 # Number of words per Cyber pru +define NBITS_PRU 3840 # Number of bits per Cyber pru +define NCHARS_NOISE (48 / NBITS_CHAR) # Nchars in a Cyber noise record +define NBITS_EOR_MARK 48 # Number of bits per eor marker +define SZ_HEADER ((64 * 60) / NBITS_CHAR) # Size in chars of IPPS header +define SZ_TAPE_BLK ((512 * 60) / NBITS_CHAR) # Size in chars of tape block +define SZ_BUFFER (SZ_TAPE_BLK + 100) # Size of tape buffer for read +define SZ_IPPS_ID 127 # Max number of characters in ID +define MAX_RANGES 100 +define NOT_SET 0 # Flag for data_type not set +define BLANK 0.0 # Temporary value for blanks + +# Bit-offsets to IPPS header words + +define DATA_TYPE_OFFSET (16 * 60 + 1) # Offset to data_type (nbpp) +define NCOLS_OFFSET (17 * 60 + 1) # Offset to ncols (nppr) +define NWORDS_OFFSET (18 * 60 + 1) # Offet to nwords_per_row +define NROWS_OFFSET (20 * 60 + 1) # Offset to nrows +define FIRST_PRU_OFFSET (21 * 60 + 1) # Offset to 1st pru of raster +define MIN_OFFSET (31 * 60 + 1) # Offset to data min +define MAX_OFFSET (32 * 60 + 1) # Offset to data max +define EOR_OFFSET (44 * 60 + 1) # Offset to terminating pru + +# The IPPS raster descriptor structure RP: + +define LEN_RP 10 + SZ_IPPS_ID + 1 + +define BITS_PIXEL Memi[$1] +define PRU_EOR Memi[$1+1] +define WRDS_PER_ROW Memi[$1+2] +define PRU_ROW_ONE Memi[$1+3] +define NCOLS Memi[$1+4] +define NROWS Memi[$1+5] +define DATA_MIN Memr[P2R($1+6)] +define DATA_MAX Memr[P2R($1+7)] +define IPPS_ID Memc[P2C($1+10)] diff --git a/noao/mtlocal/cyber/rrcopy/rrcopy.x b/noao/mtlocal/cyber/rrcopy/rrcopy.x new file mode 100644 index 00000000..0a6b5de7 --- /dev/null +++ b/noao/mtlocal/cyber/rrcopy/rrcopy.x @@ -0,0 +1,212 @@ +include <mach.h> +include "rrcopy.h" + +.help rc_read_cyber +.nf ________________________________________________________________________ +RC_READ_CYBER -- Read binary chars from a file, ignoring short "noise" records. +Data is read in chunks from the file buffer passed as a bit stream into the +output buffer. (See also: read_dumpf and get_cyber_words.) The +file buffer is refilled as necessary by calling READ; the output buffer is +supplied by the calling procedure. Cyber noise records (48 bits) +are not transferred to the output buffer and so are ignored. READ_CYBER_INIT +must be called to initialize variables for CYBER_READ. Variables marking the +current position and top of the buffer are initialized. +.endhelp ___________________________________________________________________ + +int procedure rc_read_cyber (rd, out_buffer, maxch) + +int buf_pos, buf_top +int rd, maxch +char out_buffer[ARB] +char block_buf[SZ_BUFFER] +int nchars, chunk_size, nchars_read +int read(), rc_read_cyber_init() + +begin + for (nchars = 0; nchars < maxch; nchars = nchars + chunk_size) { + # See if it is necessary to transfer more data from the binary file + # to the file buffer. This will be necessary when all data from the + # file buffer has been moved to the output buffer. + + if (buf_pos >= buf_top) { + # Read the next non-noise record into block_buf; reset buf_pos + repeat { + nchars_read = read (rd, block_buf, SZ_BUFFER) + } until (nchars_read >= NCHARS_NOISE || nchars_read == EOF) + buf_pos = 1 + buf_top = nchars_read + } + + # The number of chars to output is the smaller of the number of + # characters requested or the number of characters left in the + # buffer + + if (nchars_read == EOF) + break + else + chunk_size = min (maxch - nchars, buf_top - buf_pos + 1) + + # Move data to output array, increment buffer offset + call amovc (block_buf[buf_pos], out_buffer[nchars+1], chunk_size) + buf_pos = buf_pos + chunk_size + } + + if (nchars == 0) + return (EOF) + else + return (nchars) + +entry rc_read_cyber_init () + + buf_pos = 1 + buf_top = 0 + return (OK) +end + + +.help rc_order_cyber_bits +.nf __________________________________________________________________________ +RC_ORDER_CYBER_BITS -- Convert raw data array from a 60-bit Cyber computer into +an SPP bit-array. The output SPP bit-array is a bit-packed array of 60-bit +Cyber words, i.e., bits 1-60 are word 1, bits 61-120 are word 2, and so on. +The least significant Cyber bit is bit 1 in each output word and the most +significant bit is bit 60. [MACHDEP]. + +When the Cyber outputs an array of 60 bit Cyber words it moves a stream of +bits into output bytes, filling however many bytes as necessary to output a +given number of Cyber words. The most significant bits are output first, +i.e., bit 60 of the first word is moved to bit 8 of the first output byte, +bit 59 is moved to bit 7 of the first output byte, and so on. If effect the +Cyber byte flips each 60-bit word. + +To deal with Cyber words as an ordered bit stream we must reorder the bytes +and bits so that the least significant bits are first. This function is +performed by the primitives CYBOOW and CYBOEW (order odd/even Cyber word) +for individual 60-bit Cyber words. A portable (and less efficient) version +of order_cyber_bits is available which does not use these primitives. +.endhelp _____________________________________________________________________ + + +procedure rc_order_cyber_bits (raw_cyber, first_cyber_word, bit_array, + ncyber_words) + +char raw_cyber[ARB] # raw Cyber array (e.g. from tape) +int first_cyber_word # first 60-bit Cyber word to be unpacked +char bit_array[ARB] # output bit-array +int ncyber_words # number of Cyber words to unpack + +bool odd_word +int word, inbit, outbit + +begin + odd_word = (mod (first_cyber_word, 2) == 1) + inbit = (first_cyber_word - 1) * NBITS_CYBER_WORD + 1 + outbit = 1 + + do word = 1, ncyber_words { + # Call odd or even primitive to reorder bits and move 60-bit + # ordered Cyber word to the output array. + + if (odd_word) { + call cyboow (raw_cyber, inbit, bit_array, outbit) + odd_word = false + } else { + call cyboew (raw_cyber, inbit, bit_array, outbit) + odd_word = true + } + + inbit = inbit + NBITS_CYBER_WORD + outbit = outbit + NBITS_CYBER_WORD + } +end + + +# The portable version of order_cyber_bits follows. +#.help order_cyber_bits +#.nf __________________________________________________________________________ +#ORDER_CYBER_BITS -- Convert a raw data array from a 60-bit Cyber computer into +#an SPP bit-array. The output SPP bit-array is a bit-packed array of 60-bit +#Cyber words, i.e., bits 1-60 are word 1, bits 61-120 are word 2, and so on. +#The least significant Cyber bit is bit 1 in each output word and the most +#significant bit is bit 60. [MACHDEP]. +# +#The byte stream from the Cyber contains bits 53-60 of the first word in the +#first byte, bits 45-52 in the second byte, and so on (most significant bytes +#first). In essence we swap the order of the 7 8-bit bytes and the 4-bit half +#byte in each 60 bit word. The bits in each byte are in the correct order. +# +#Each successive pair of Cyber words fits into 15 bytes. Byte 8 contains the +#last 4 bits of word 1 in the most signficant half of the byte and the first +#4 bits of word 2 in the first half of the byte. In each 60 bit word we must +#move bit segments (bytes or half bytes) as follows (for the VAX): +# +#Odd words (from N*60 bit-offset): +# [from] [to] [nbits] +# 1 53 8 +# 9 45 8 +# 17 37 8 +# 25 29 8 +# 33 21 8 +# 41 13 8 +# 49 5 8 +# 61 1 4 +# +#Even words (from N*60 bit-offset): +# [from] [to] [nbits] +# -3 57 4 +# 5 49 8 +# 13 41 8 +# 21 33 8 +# 29 25 8 +# 37 17 8 +# 45 9 8 +# 53 1 8 +#.endhelp _____________________________________________________________________ +# +#define NBITS_PER_WORD 60 +#define NSEGMENTS 8 +# +# +#procedure order_cyber_bits (raw_cyber, first_cyber_word, bit_array, +# ncyber_words) +# +#char raw_cyber[ARB] # raw Cyber array (e.g. from tape) +#int first_cyber_word # first 60-bit Cyber word to be unpacked +#char bit_array[ARB] # output bit-array +#int ncyber_words # number of Cyber words to unpack +# +#int word, inword, inbit, outbit, temp, i +#int o_from[NSEGMENTS], o_to[NSEGMENTS], o_nbits[NSEGMENTS] +#int e_from[NSEGMENTS], e_to[NSEGMENTS], e_nbits[NSEGMENTS] +#int bitupk() +# +#data o_from / 1, 9,17,25,33,41,49,61/ # odd words +#data o_to /53,45,37,29,21,13, 5, 1/ +#data o_nbits / 8, 8, 8, 8, 8, 8, 8, 4/ +#data e_from /-3, 5,13,21,29,37,45,53/ # even words +#data e_to /57,49,41,33,25,17, 9, 1/ +#data e_nbits / 4, 8, 8, 8, 8, 8, 8, 8/ +# +#begin +# do word = 1, ncyber_words { +# inword = first_cyber_word + word - 1 +# inbit = (inword - 1) * NBITS_PER_WORD +# outbit = ( word - 1) * NBITS_PER_WORD +# +# # Move bits to the output bit array. Segment list used depends +# # on whether the word is an odd or even word. This code will work +# # even if the caller only wishes to order a single word. +# +# if (mod (inword,2) == 1) { +# do i = 1, NSEGMENTS { +# temp = bitupk (raw_cyber, inbit + o_from[i], o_nbits[i]) +# call bitpak (temp, bit_array, outbit + o_to[i], o_nbits[i]) +# } +# } else { +# do i = 1, NSEGMENTS { +# temp = bitupk (raw_cyber, inbit + e_from[i], e_nbits[i]) +# call bitpak (temp, bit_array, outbit + e_to[i], e_nbits[i]) +# } +# } +# } +#end diff --git a/noao/mtlocal/cyber/rrcopy/semicode.doc b/noao/mtlocal/cyber/rrcopy/semicode.doc new file mode 100644 index 00000000..a7ad514c --- /dev/null +++ b/noao/mtlocal/cyber/rrcopy/semicode.doc @@ -0,0 +1,310 @@ +Semicode for Cyber RCOPY Reader; Frozen at "detailed semicode" stage, Jan 84. + + +# rcopy tape descriptor + +struct rcopy { + + real data_min # minimum data value + real data_max # maximum data value + int nrows # number of rows in ipps raster + int ncols # number of columns in ipps raster + int data_type # number of bits per pixel in the ipps raster + int pru_eor # pru position of level zero eor + int wrds_per_row # number of 60-bit words per row; each row + # occupies an integral number of 64word pru's. + int pru_row_one # relative pru ordinal of the first row of raster. + char ipps_id # id string of the ipps raster +} + +procedure t_rrcopy (rcopy_file, raster_list, iraf_file) + + +begin + # get input filename and open tape drive + rcopy_fd = open (rcopy_file) + + # get output filename if it will be needed + if (make_image = yes) + outfile = fetch root name of output file + + # expand list of rasters to be read from tape + if (decode_ranges (raster_list, range, MAX_RANGES, nfiles) == ERR) + call error (0, "Illegal raster number list") + + raster_number = 0 + tape_pos = 1 + while (get_next_number (range, raster_number, != EOF) { + # position tape to first record of raster_number + if (tape_pos != raster_number) { + iferr { + stat = position_rcopy (rcopy_fd, tape_pos ,raster_number) + if (stat = EOF) + return + } then + call ERRACT (EA_FATAL) + } + iraffile = generate output filename from root + iferr { + (stat = read_rcopy(rcopy_fd, iraffile, tape_pos)) + if (stat = EOF) + return + } then { + call ERRACT (EA_WARN) + skip over rcopy raster + } + } + +end + +int procedure position_rcopy (rcopy_fd, tape_pos, raster_number) + +begin + + nrasters_skip = raster_number - tape_pos + for (i=1; i<=nrasters_skip; i=i+1) { + stat = read_header (rcopy_fd, rcopy) + if (stat = EOF) + return (EOF) + call read_header (rcopy_fd, rcopy) + call skip_image (rcopy_fd, rcopy) + } +end + +int procedure read_rcopy (rcopy_fd, iraffile, tape_pos) + +begin + + # Read ipps raster header from rcopy tape + stat = read_header (rcopy_fd, rcopy) + if (stat = EOF) + return (EOF) + + # Print header information from rcopy tape + if (print_header) + call print_header (rcopy) + + # read image data if desired + if (make_image) + call read_image(rcopy_fd, iraffile, rcopy) + + # skip image if not to be read + else + call skip_image (rcopy_fd, rcopy) + + # increment tape position marker + tape_pos = tape_pos + 1 + + +end + +int procedure read_header(rcopy_fd, rcopy) + +begin + # structure rcopy contains decoded header + # Read ipps header (64 60-bit words = 240 chars) as a + # bit stream into temp. + NBITS_CHAR = SZB_CHAR * NBITS_BYTE + NBITS_CYBER_WORD = 60 + NWORDS_CYBER_PRU = 64 + SZ_HEADER = 240 + stat = read_tape (rcopy_fd, raw_header, SZ_HEADER) + if (stat = EOF)) + return (EOF) + + # Unpack bit stream and fill structure rcopy + call unpack_header (raw_header, rcopy) + + # skip to first row of raster + if (rcopy.pru_row_one not equal to 1) { + nchars_to_skip = (rcopy.pru_row_one - 1) * NWORDS_CYBER_PRU + * NBITS_CYBER_WORD / NBITS_CHAR + call skip_chars (rcopy_fd, nchars_to_skip) + } +end + +procedure read_image (rcopy_fd, iraffile, rcopy) + +begin + + # map new iraf image and set up image header + im = immap (iraffile, NEW_IMAGE) + im.im_len[1] = rcopy.ncols + im.im_len[2] = rcopy.nrows + im.im_title = rcopy.ipps_id + im.im_min = rcopy.data_min + im.im_max = rcopy.data_max + + if (user hasn's supplied data type) { + switch (rcopy.data_type) { + case 12 : + im.im_pixtype = short + case 20 : + im.im_pixtype = real + case 30 : + im.im_pixtype = real + default: + call error (0, "error in data_type") + } + } + + # Calculate number of chars per row; this will always be an + # integral number of chars because rcopy.words_per_row + # is always divisible by 64. + NBITS_CHAR = SZB_CHAR * NBITS_BYTE + NBITS_CYBER_WORD = 60 + NWORDS_CYBER_PRU = 64 + num_chars_per_row = rcopy.wrds_per_row * NBITS_CYBER_WORD / NBITS_CHAR + + # Loop to read rcopy raster line by line into buf1, then + # convert ipps pixels to iraf pixels. + for(i=1; i<=rcopy.nrows; i=i+1) { + stat = read a single row from the internal buffer + if (stat = EOF) { + close imagefile already accumulated + call error (0, "unexpected EOF at row# ") + } + call ipps_to_iraf (buf1, Memr[impl2r(im,i)], rcopy) + } + + # Read until header of next raster into dummy buffer. + # Calculate offset in chars from present position to eor + nchars_to_skip = (((rcopy.eor - rcopy.pru_row_one) * NWORDS_CYBER_PRU + + (rcopy.words_per_row * rcopy.nrows)) * NBITS_CYBER_WORD + 48) + / NBITS_CHAR + + call skip_chars (rcopy_fd, nchars_to_skip) +end + +procedure ipps_to_iraf (buf1, buf2, rcopy) + +begin + + # convert (rcopy.ncols * rcopy.data_type ) bits from buf1. + # This is the number of bits per row that actually represent + # pixels. buf1 contains pixels plus filler. + + switch (rcopy.data_type) { + case 12: + call unpack12 (buf1, bit_offset, buf2, npix) + case 20: + call unpack20 (buf1, bit_offset, buf2, npix) + case 30: + call unpack30 (buf1, bit_offset, buf2, npix) + default: + call error (0, "illegal ipps #b/p") + } +end + +procedure skip_image(rcopy_fd, rcopy) + +begin + + # Calculate number of chars in image + nchars_to_skip = ((rcopy.eor - rcopy.pru_row_one ) * NWORDS_CYBER_PRU * + NBITS_CYBER_WORD + 48 ) / NBITS_CHAR + call skip_chars (rcopy_fd, nchars_to_skip) + +end + +procedure print_header (rcopy) + +begin + # print header information from rcopy tape + print, rcopy.ipps_id, rcopy.ncols, rcopy.nrows, rcopy.data_min, + rcopy.data_max, rcopy.ipps_data_type +end + +procedure unpack_header (raw_header, rcopy) + +begin + + get from raw_header: nrows, ncols, data_type, ipps_id, pru_eor, + wrds_per_row, pru_row_one, data_min, data_max + + if (rcopy.data_type != 12, 20, or 30) + call error (0, "invalid ipps #b/p") + if (nrows or ncols or pru_row_one !> 0) + call error (0, "invalid ipps raster") + if (wrds_per_row not divisible by 64) + call error (0, "invalid ipps raster") + +end + +procedure skip_chars (rcopy_fd, nchars_to_skip) + +begin + + # calculate the number of chars in a tape block = (512 * 60) / 16 + # This is the number of chars to be read at one time. + SZ_TAPE_BLK = 1920 + + # calculate number of blocks to skip (type int) + nblks_read = nchars_to_skip / SZ_TAPE_BLK + nchars_remaining = mod (nchars_to_skip, SZ_TAPE_BLK) + + # read chars into dummy buffer + for (i=1; i<=nblks_read; i=i+1) + stat = read_tape (rcopy_fd, dummy, SZ_TAPE_BLK) + + stat = read_tape (rcopy_fd, dummy, nchars_remaining) + + # confirm reaching eor + if (searching for eor) { + reread last 3 chars and compare with level zero eor marker + if (eor not confirmed) + call error (0, "attempted skip to eor unsuccessful") + } + +end + + +.help rrcopy 2 "Program Structure" +.sh +RCOPY Structure Chart + +.nf +procedure t_rrcopy () +# Returns when file list is satisfied or if EOT is encountered + + int procedure read_header (rcopy_fd, rcopy) + #returns EOF, ERR or OK + + int procedure read (rcopy_fd, raw_header, SZ_HEADER) + #returns EOF or OK + + int procedure unpack_header (raw_header, rcopy) + #returns ERR or OK + + int procedure skip_image (rcopy_fd, rcopy) + #returns ERR, EOF or OK + + int procedure skip_chars (rcopy_fd, nchars_to_skip) + #returns EOF, ERR or OK + + procedure read_rcopy (rcopy_fd, iraffile) + #aborts if output filename exists and noclobber is set + + int procedure read_header (rcopy_fd, rcopy) + #returns EOF, ERR or OK + + int procedure read (rcopy_fd, raw_header, SZ_HEADER) + #returns EOF or OK + + int procedure unpack_header (raw_header, rcopy) + #returns ERR or OK + + procedure print_header (rcopy) + + procedure read_image (rcopy_rd, iraffile, rcopy) + #returns EOF, or OK + + int procedure read (rcopy_rd, buf1, num_chars_per_row) + #returns EOF or OK + + int procedure ipps_to_iraf + #returns ERR or OK + + int procedure skip_image (rcopy_rd, rcopy) + #returns EOF, ERR or OK +.endhelp diff --git a/noao/mtlocal/cyber/rrcopy/t_rrcopy.x b/noao/mtlocal/cyber/rrcopy/t_rrcopy.x new file mode 100644 index 00000000..9bb83885 --- /dev/null +++ b/noao/mtlocal/cyber/rrcopy/t_rrcopy.x @@ -0,0 +1,147 @@ +include <mach.h> +include <imhdr.h> +include <error.h> +include "rrcopy.h" + +# T_RRCOPY -- The main procedure for the RCOPY reader. The RCOPY reader +# converts IPPS rasters written in RCOPY format to IRAF images. All IPPS +# rasters on an RCOPY tape are in a single file. Each raster header must +# be read before the image can be either skipped or read. T_RRCOPY gets +# parameters from the cl and decodes the string of rasters to be read. It +# then calls READ_HEADER for each raster on the tape. The header information +# is printed if print_header=true. If make_image = true, the image is +# converted to an IRAF image by READ_IMAGE. Otherwise, the image is skipped +# with SKIP_IMAGE. T_RRCOPY terminates when the raster list is depleted or +# the tape is at EOT. +# +# Modified 26-JULY-88 to allow for multiple rcopy files on a single tape. +# This allows for rcopy format data to be archived in multiple files on +# one tape. The task is still run once per input file. The user is queried +# (hidden parameter) for the data file to be read. The tape file is actually +# datafile + 1 because of the ANSI label on each rrcopy tape. (ShJ) + +procedure t_rrcopy () + +pointer sp, rp +bool make_image, print_header, bad_header +char rcopy_file[SZ_FNAME], iraf_file[SZ_FNAME] +char out_fname[SZ_FNAME], raster_list[SZ_LINE] +int rd, ras_number, current_ras, nras, stat, tapefile +int ranges[3, MAX_RANGES], data_type, init + +bool clgetb() +char clgetc() +int get_data_type(), position_rcopy(), rc_read_cyber_init(), clgeti() +int mtopen(), decode_ranges(), get_next_number(), rc_header_read(), strlen() +int mtfile() + +begin + # Allocate space on stack for program data structure + call smark (sp) + call salloc (rp, LEN_RP, TY_STRUCT) + + # Get input filename and open tape drive to second file, skipping label + call clgstr ("rcopy_file", rcopy_file, SZ_FNAME) + if (mtfile (rcopy_file) == YES) { + tapefile = clgeti ("datafile") + 1 + call mtfname (rcopy_file, tapefile, rcopy_file, SZ_FNAME) + } + rd = mtopen (rcopy_file, READ_ONLY, SZ_BUFFER) + init = rc_read_cyber_init() + + # Get output root filename if it will be needed + make_image = clgetb ("make_image") + if (make_image) { + call clgstr ("iraf_file", iraf_file, SZ_FNAME) + data_type = get_data_type (clgetc ("data_type")) + if (data_type == ERR) + data_type = NOT_SET + } + + # Set options + print_header = clgetb ("print_header") + + # Expand list of rasters to be read from tape + call clgstr ("raster_list", raster_list, SZ_LINE) + if (decode_ranges (raster_list, ranges, MAX_RANGES, nras) == ERR) + call error (0, "Illegal raster number list") + + ras_number = 0 + current_ras = 1 + while (get_next_number (ranges, ras_number) != EOF) { + # Position tape to first record of ras_number + if (current_ras != ras_number) { + iferr (stat = position_rcopy (rd, current_ras, ras_number, rp)) + call erract (EA_FATAL) + if (stat == EOF) + break + } + + # Assume header is good + bad_header = false + iferr { + stat = rc_header_read (rd, rp) + } then { + # Error reading header; will attempt to skip raster + bad_header = true + call erract (EA_WARN) + } + + if (stat == EOF) { + call printf ("\nRCOPY tape at End of Tape\n") + break + } + + if (print_header) + call rc_list_header (rp, ras_number) + call flush (STDOUT) + + if (make_image && ! bad_header) { + # Generate output filename + call strcpy (iraf_file, out_fname, SZ_FNAME) + if (nras > 1) { + call sprintf (out_fname[strlen(out_fname)+1], SZ_FNAME, + "%03d") + call pargi (ras_number) + } + iferr (call rc_read_image (rd, out_fname, data_type, rp)) + call erract (EA_FATAL) + } else + iferr (call rc_skip_image (rd, rp)) + call erract (EA_FATAL) + + # Increment tape position + current_ras = current_ras + 1 + } + + # Return space allocated for rp, close tape unit + call close (rd) + call sfree (sp) +end + + +# POSITION_RCOPY -- Position the tape to the first +# record of the next raster to be read. Each raster header must +# be read; each image can then be skipped. + +int procedure position_rcopy (rd, current_ras, ras_number, rp) + +int rd, current_ras, ras_number +pointer rp +int nras_skip, i, stat +int rc_header_read() +errchk rc_skip_image + +begin + nras_skip = ras_number - current_ras + for (i=1; i <= nras_skip; i=i+1) { + stat = rc_header_read (rd, rp) + if (stat == EOF) { + call printf ("Cannot position RCOPY tape beyond EOF\n") + return (EOF) + } + call rc_skip_image (rd, rp) + current_ras = current_ras + 1 + } + return (OK) +end diff --git a/noao/mtlocal/cyber/t_ldumpf.x b/noao/mtlocal/cyber/t_ldumpf.x new file mode 100644 index 00000000..880c0290 --- /dev/null +++ b/noao/mtlocal/cyber/t_ldumpf.x @@ -0,0 +1,220 @@ +include <mach.h> +include "cyber.h" + +# T_LDUMPF -- list permanent files stored on a DUMPF tape. +# The permanent file name, owner id, cycle number, creation date, +# last attach and last alteration dates are listed for specified files +# of a Cyber DUMPF format tape. + +procedure t_ldumpf () + +pointer sp, dmp +char dumpf_file[SZ_FNAME], file_list[SZ_LINE], in_fname[SZ_FNAME] +int file_number, ranges[3, MAX_RANGES], nfiles +int read_pf_table(), get_next_number(), decode_ranges() +int mtfile() + +begin + # Allocate space for program data structure. + call smark (sp) + call salloc (dmp, LEN_DMP, TY_STRUCT) + + # Get parameters; get file_list only if dump_file is a general + # tape name. + call clgstr ("dumpf_file", dumpf_file, SZ_FNAME) + if (mtfile (dumpf_file) == YES) + call clgstr ("file_list", file_list, SZ_LINE) + else + call strcpy ("1", file_list, SZ_LINE) + if (decode_ranges (file_list, ranges, MAX_RANGES, nfiles) == ERR) + call error (0, "Illegal file number list") + + # For each file in file_list call read_pf_table. + file_number = 0 + while (get_next_number (ranges, file_number) != EOF) { + if (mtfile (dumpf_file) == YES) + call mtfname (dumpf_file, file_number + 1, in_fname, SZ_FNAME) + else + call strcpy (dumpf_file, in_fname, SZ_FNAME) + if (read_pf_table (in_fname, file_number, dmp) == EOF) { + call printf ("End of DUMPF tape\n") + call sfree (sp) + return + } + } + call sfree (sp) +end + + +# READ_PF_TABLE -- reads and prints out the Cyber permanent file information. + +int procedure read_pf_table (dumpf_file, file_num, dmp) + +char dumpf_file[SZ_FNAME] +int file_num +pointer dmp +int dump_fd, init +pointer dump_buf, spp_buf, sp +int mtopen(), read_cyber(), bitupk(), read_cyber_init() + +begin + # Allocate buffer space for the Permanent File Table + call smark (sp) + call salloc (dump_buf, SZ_PFT, TY_CHAR) + call salloc (spp_buf, SZ_PFT, TY_CHAR) + + # Open input DUMPF tape + dump_fd = mtopen (dumpf_file, READ_ONLY, SZ_TAPE_BUFFER) + init = read_cyber_init() + + # Read File Header, Permanent File Catalog and Permanent File Table + if (read_cyber (dump_fd, Memc[dump_buf], SZ_PFT) == EOF) { + call sfree (sp) + call close (dump_fd) + return (EOF) + } + + # Reorder Cyber bits into packed SPP bit array + call order_cyber_bits (Memc[dump_buf], 1, Memc[spp_buf], LEN_PFT) + + # Get number of characters in permanent file name + NCHARS_PFN(dmp) = bitupk (Memc[spp_buf], NCHARS_OFFSET, 6) + + # Unpack file information from Permanent File Table + call unpk_pf_info (Memc[spp_buf], dmp) + + # Print Permanent File information + call print_pf_info (file_num, dmp) + call flush (STDOUT) + + # Return buffer, close tape file + call sfree (sp) + call close (dump_fd) + return (OK) +end + + +# DECIPHER_DC -- An ascii character string is decoded from an input +# bit stream. An offset into the bit stream and the number of characters +# to unpack are input. + +procedure decipher_dc (inbuf, bit_offset, nchars, outbuf) + +char inbuf[ARB], outbuf[nchars + 1] +int offset, nchars, ip, op, temp, bit_offset +int bitupk() + +begin + op = 1 + offset = bit_offset + do ip = 1, nchars { + temp = bitupk (inbuf, offset, NBITS_DC) + if (temp == 55B) { + # Blank + offset = offset - NBITS_DC + next + } + else { + call display_code (temp, outbuf[op]) + op = op + 1 + offset = offset - NBITS_DC + } + } + outbuf[op] = EOS +end + + +# UNPK_PF_INFO -- unpacks words from the Permanent File Information Table +# and fills program data structure dmp. + +procedure unpk_pf_info (inbuf, dmp) + +char inbuf[SZ_PFT] +pointer dmp +int creation, attach, alteration +int bitupk() + +begin + # Extract Permanent File Name + call decipher_dc (inbuf, PFN_OFFSET, NCHARS_PFN(dmp), PFN(dmp)) + + # Extract ID + call decipher_dc (inbuf, PF_ID_OFFSET, SZ_PF_ID, ID(dmp)) + + # Extract cycle number + CY(dmp) = bitupk (inbuf, CY_OFFSET, NBITS_CY) + + # Extract creation, last_attach and last_alteration dates which are + # written in 18-bits as "yyddd". + creation = bitupk (inbuf, CREATE_OFFSET, NBITS_DATE) + call ld_get_date (creation, D_CREATE(dmp), M_CREATE(dmp), Y_CREATE(dmp)) + + attach = bitupk (inbuf, ATTACH_OFFSET, NBITS_DATE) + call ld_get_date (attach, D_ATTACH(dmp), M_ATTACH(dmp), Y_ATTACH(dmp)) + + alteration = bitupk (inbuf, ALTER_OFFSET, NBITS_DATE) + call ld_get_date (alteration, D_ALTER(dmp), M_ALTER(dmp), Y_ALTER(dmp)) +end + + +# GET_DATE -- The day, month and year are decoded from the lower 18 bits +# of the input integer. The input format is "yyddd"; three integers are +# returned as arguments: day, month, year. + +procedure ld_get_date (yyddd, day, month, year) + +int yyddd, day, month, year, ddd +int days_in_month[12], i, bitupk() + +data (days_in_month[i], i=1,9) /31, 28, 31, 30, 31, 30, 31, 31, 30/ +data (days_in_month[i], i=10, 12) /31, 30, 31/ + +begin + year = bitupk (yyddd, 10, 9) + 1900 + ddd = bitupk (yyddd, 1, 9) + + # Leap year tests + if (mod (year, 4) == 0) + days_in_month[2] = 29 + if (mod (year, 100) == 0) + days_in_month[2] = 28 + if (mod (year, 400) == 0) + days_in_month[2] = 29 + + for (i=1; i<=12; i=i+1) { + if (ddd <= days_in_month[i]) + break + else + ddd = ddd - days_in_month[i] + } + + month = i + day = ddd +end + + +# PRINT_PF_INFO -- information from the permanent file table is printed. + +procedure print_pf_info (file_num, dmp) + +pointer dmp +int file_num + +begin + call printf ("\n[%d]%6tPFN= %s, ID= %s, CY= %d\n") + call pargi (file_num) + call pargstr (PFN(dmp)) + call pargstr (ID(dmp)) + call pargi (CY(dmp)) + call printf ("%6tCreation: %d/%d/%d, Last Alteration: %d/%d/%d, ") + call pargi (M_CREATE(dmp)) + call pargi (D_CREATE(dmp)) + call pargi (Y_CREATE(dmp)) + call pargi (M_ALTER(dmp)) + call pargi (D_ALTER(dmp)) + call pargi (Y_ALTER(dmp)) + call printf ("Last Attach: %d/%d/%d\n") + call pargi (M_ATTACH(dmp)) + call pargi (D_ATTACH(dmp)) + call pargi (Y_ATTACH(dmp)) +end diff --git a/noao/mtlocal/cyber/t_rdumpf.x b/noao/mtlocal/cyber/t_rdumpf.x new file mode 100644 index 00000000..9d780b9e --- /dev/null +++ b/noao/mtlocal/cyber/t_rdumpf.x @@ -0,0 +1,162 @@ +include <mach.h> +include <error.h> +include <fset.h> +include "cyber.h" + +# T_RDUMPF-- The main procedure for the DUMPF reader. Permanent files +# containing IPPS rasters are read in dumpf format and optionally +# converted to IRAF images. Each permanent file is a seperate tape file; +# the IPPS rasters are sequentially stored in the permanent file, seperated +# by "zero length PRU's". The first 48 words of each permanent file +# contain the Cyber permanent file table, catalog and file header information +# for the file. This information is listed with task LDUMPF. For each +# file in file_list, the file is opened. Then for each raster in the file, +# READ_HEADER must be called, followed by either READ_IMAGE or SKIP_IMAGE. + +procedure t_rdumpf() + +pointer sp, dt, dummy +bool make_image, print_header, bad_header +char dumpf_file[SZ_FNAME], iraf_file[SZ_FNAME], file_list[SZ_LINE] +char out_fname[SZ_FNAME], raster_list[SZ_LINE], in_fname[SZ_FNAME] +int fd, file_number, ras_number, current_ras +int stat, nfile, nras +int rasters[3, MAX_RANGES], files[3, MAX_RANGES], data_type + +bool clgetb() +char clgetc() +int get_data_type(), strlen(), mtfile() +int get_cyber_words() +int get_cyber_words_init(), read_dumpf_init(), position_dumpf() +int mtopen(), decode_ranges(), get_next_number(), cy_read_header() + +begin + call fseti (STDOUT, F_FLUSHNL, YES) + + # Allocate space for program data structure and buffers + call smark (sp) + call salloc (dt, LEN_DT, TY_STRUCT) + call salloc (dummy, NINT_CYBER_WRD * LEN_PFT, TY_INT) + + # Get paramters from cl + call clgstr ("dumpf_file", dumpf_file, SZ_FNAME) + if (mtfile (dumpf_file) == YES) + call clgstr ("file_list", file_list, SZ_LINE) + else + call strcpy ("1", file_list, SZ_LINE) + if (decode_ranges (file_list, files, MAX_RANGES, nfile) == ERR) + call error (0, "Illegal file list") + + call clgstr ("raster_list", raster_list, SZ_LINE) + if (decode_ranges (raster_list, rasters, MAX_RANGES, nras) == ERR) + call error (1, "Illegal raster list") + + print_header = clgetb ("print_header") + make_image = clgetb ("make_image") + if (make_image) { + call clgstr ("iraf_file", iraf_file, SZ_FNAME) + data_type = get_data_type (clgetc ("data_type")) + if (data_type == ERR) + data_type = NOT_SET + } + + # Expand file_list and open dumpf_file + file_number = 0 + while (get_next_number (files, file_number) != EOF) { + + # Get the file name and open file. + if (mtfile (dumpf_file) == YES) + call mtfname (dumpf_file, file_number + 1, in_fname, SZ_FNAME) + else + call strcpy (dumpf_file, in_fname, SZ_FNAME) + fd = mtopen (in_fname, READ_ONLY, SZ_TAPE_BUFFER) + + # Position to first IPPS raster in file, skipping Cyber PFT etc. + stat = get_cyber_words_init() + stat = read_dumpf_init() + + if (get_cyber_words (fd, Memi[dummy], LEN_PFT) == EOF) { + call printf ("DUMPF Tape at EOF\n") + call close (fd) + call sfree (sp) + return + } + + + ras_number = 0 + current_ras = 1 + while (get_next_number (rasters, ras_number) != EOF) { + # Position to first record of ras_number + if (current_ras != ras_number) { + iferr (stat = position_dumpf (fd, current_ras, ras_number, + dt)) + call erract (EA_FATAL) + if (stat == EOF) + break + } + + bad_header = false + iferr { + stat = cy_read_header (fd, dt) + } then { + # Error reading header; will attempt to skip raster + bad_header = true + call erract (EA_WARN) + } + + if (stat == EOF) { + call printf ("DUMPF Tape at End of File%d\n\n") + call pargi (file_number) + break + } + + if (print_header) + call cy_list_header (dt, file_number, ras_number) + + if (make_image && ! bad_header) { + call strcpy (iraf_file, out_fname, SZ_FNAME) + if (nras > 1 || nfile > 1) { + call sprintf (out_fname[strlen(out_fname)+1], SZ_FNAME, + "%d.%03d") + call pargi (file_number) + call pargi (ras_number) + } + iferr (call read_ipps_rows (fd, out_fname, data_type, dt)) + call erract (EA_FATAL) + } else + iferr (call cy_skip_image (fd, dt)) + call erract (EA_FATAL) + + current_ras = current_ras + 1 + } + call close (fd) + } + call sfree (sp) + return +end + + +# POSITION_DUMPF -- Position the tape to the first +# record of the next raster to be read. Each raster header must +# be read; each image can then be skipped. + +int procedure position_dumpf (rd, current_ras, ras_number, dt) + +int rd, current_ras, ras_number +pointer dt +int nras_skip, i +int cy_read_header() +errchk cy_skip_image + +begin + nras_skip = ras_number - current_ras + for (i=1; i <= nras_skip; i=i+1) { + if (cy_read_header (rd, dt) == EOF) { + call printf ("Cannot position DUMPF tape beyond EOF\n") + return (EOF) + } + call cy_skip_image (rd, dt) + current_ras = current_ras + 1 + } + return (OK) +end diff --git a/noao/mtlocal/cyber/t_ridsfile.x b/noao/mtlocal/cyber/t_ridsfile.x new file mode 100644 index 00000000..c7179763 --- /dev/null +++ b/noao/mtlocal/cyber/t_ridsfile.x @@ -0,0 +1,516 @@ +include <mach.h> +include <imhdr.h> +include <fset.h> +include <error.h> +include "cyber.h" + + +# T_RIDSFILE __ code for the DUMPF IDSFILE reader. IDS records in an IDSFILE +# are read from a Cyber DUMPF tape and optionally converted to IRAF images. +# IDS records are not written sequentially in the IDSFILE, so, each record +# must be read and then checked against the list of "record_numbers" to +# see if the user requested the record to be read. The procedure terminates +# when the requested number of records has been read or EOF is encountered. +# The IDS trailer information is printed in either a short or long form; +# the pixel values can also be printed. + +procedure t_ridsfile() + +pointer sp, cp +char in_fname[SZ_FNAME], dumpf_file[SZ_FNAME] +int file_ordinal + +int mtfile(), clgeti(), get_data_type(), btoi() +bool clgetb() +char clgetc() + +begin + # Allocate space for the control parameter descriptor structure + call smark (sp) + call salloc (cp, LEN_CP, TY_STRUCT) + + call fseti (STDOUT, F_FLUSHNL, YES) + + # Get parameters from cl and generate input file name. If the input + # file is a tape, append the file_ordinal suffix, incremented by one + # to skip over the DUMPF tape label. + + call clgstr ("dumpf_file", dumpf_file, SZ_FNAME) + if (mtfile (dumpf_file) == YES) { + file_ordinal = clgeti ("file_ordinal") + call mtfname (dumpf_file, file_ordinal + 1, in_fname, SZ_FNAME) + } else + call strcpy (dumpf_file, in_fname, SZ_FNAME) + + LONG_HEADER(cp) = btoi (clgetb ("long_header")) + PRINT_PIXELS(cp) = btoi (clgetb ("print_pixels")) + call clgstr ("record_numbers", REC_NUMBERS(cp), SZ_LINE) + + # If an output image is to be written, get root output file name and + # output data type. + MAKE_IMAGE(cp) = btoi (clgetb ("make_image")) + if (MAKE_IMAGE(cp) == YES) { + call clgstr ("iraf_file", IRAF_FILE(cp), SZ_FNAME) + DATA_TYPE(cp) = get_data_type (clgetc ("data_type")) + if (DATA_TYPE(cp) == ERR) + DATA_TYPE(cp) = TY_REAL + } + call read_idsfile (in_fname, cp) + + call sfree (sp) +end + + +# READ_IDSFILE -- read and sort the index of record ranges. Call +# idsf_read_record for each record in each index range. + +procedure read_idsfile (in_fname, cp) + +char in_fname[SZ_FNAME] # Name of input file +pointer cp # Pointer to control parameter structure + +int records[3, MAX_RANGES], nrecs, i +pointer sp, pft, pru_buf +int fd, junk, index_buf[LEN_INDEX * NINT_CYBER_WRD], nranges, nids_read +int current_pru, n_index, next_pru, nrecords_to_read, npru_skip, n_rec +long sorted_index[LEN_INDEX] + +int mtopen(), get_cyber_words_init(), read_dumpf_init(), read_dumpf() +int get_cyber_words(), idsf_read_record(), decode_ranges() +errchk mtopen, read_dumpf, get_cyber_words, idsf_read_record +errchk sort_index, decode_ranges + +begin + # Allocate space for program data structure and buffers + call smark (sp) + call salloc (pft, NINT_CYBER_WRD * LEN_PFT, TY_INT) + call salloc (pru_buf, NINT_CYBER_WRD * LEN_PRU, TY_INT) + + # Open and initialize the tape file, and read the permanent file table + fd = mtopen (in_fname, READ_ONLY, SZ_TAPE_BUFFER) + junk = get_cyber_words_init() + junk = read_dumpf_init() + if (get_cyber_words (fd, Memi[pft], LEN_PFT) == EOF) { + call printf ("DUMPF tape at EOT\n") + call sfree (sp) + call close (fd) + return + } + + # Read and sort IDSFILE user index information. The first two + # pru's of this index are relevant. Up to 3 more pru's can + # follow, depending on the format of the idsfile. The code was + # modified 13Jan86 to read an old format tape of Paul Hintzen's + # and hopefully provide a general solution to the problem of + # different formats. + + if (read_dumpf (fd, index_buf, LEN_USER_INDEX)== EOF) { + call close (fd) + call error (1, "Unexpected EOF when reading index") + } + if (decode_ranges (REC_NUMBERS(cp), records, MAX_RANGES, junk) == ERR) + call error (2, "Error in record_numbers specification") + + call sort_index (index_buf, records, sorted_index, nranges, nrecs) + + # Loop over each range of records in the index. nids_read counts + # the number of records requested by the user that have been read. + # nrecords_to_read is the number of records in the current index range. + + nids_read = 0 + current_pru = 3 + for (n_index = 1; n_index <= nranges; n_index = n_index + 1) { + next_pru = sorted_index[n_index] / 1000 + nrecords_to_read = mod (sorted_index[n_index], 1000) + npru_skip = next_pru - current_pru + do i = 1, npru_skip { + if (read_dumpf (fd, Memi[pru_buf], LEN_PRU) == EOF) { + # At end of IDSFILE + call printf ("DUMPF tape at EOF\n") + break + } + } + + current_pru = current_pru + npru_skip + + # Loop over each record within the current range of records + for (n_rec = 1; n_rec <= nrecords_to_read; n_rec = n_rec + 1) { + if (nids_read >= nrecs) { + # No need to continue + call close (fd) + call sfree (sp) + return + } + + if (idsf_read_record (fd, records, nrecs, nids_read, + cp) == EOF) { + call close (fd) + call sfree (sp) + return + } + + + current_pru = current_pru + (LEN_IDS_RECORD / LEN_PRU) + } + } + + call close (fd) + call sfree (sp) +end + + +# IDSF_READ_RECORD -- reads a single idsrecord. If the record is in the +# set of records to be read, the record is processed and the count of requested +# records read is incremented. + +int procedure idsf_read_record (fd, records, nrecs, nids_read, cp) + +int fd # File descriptor of input file +int records[3, MAX_RANGES] # Array of ranges of records specified by user +int nrecs # Number of requested records found on tape +int nids_read # Number of requested records already read +pointer cp # Pointer to control parameter structure + +char out_fname[SZ_FNAME] +pointer sp, ids +int ids_buffer[LEN_IDS_RECORD * NINT_CYBER_WRD], this_record +int tape, scan +real pixels[NPIX_IDS_RECORD] + +bool is_in_range() +int read_dumpf(), bitupk(), strlen() +errchk read_dumpf, read_header, idsf_write_image, list_values + +begin + # Allocate space for program data structure + call smark (sp) + call salloc (ids, LEN_IDS, TY_STRUCT) + + # Read the next ids record + if (read_dumpf (fd, ids_buffer, LEN_IDS_RECORD) == EOF) { + # At end of IDSFILE + call printf ("DUMPF tape at EOF\n") + call sfree (sp) + return (EOF) + } + + scan = bitupk (ids_buffer, SCAN_OFFSET, NBITS_INT) + tape = bitupk (ids_buffer, TAPE_OFFSET, NBITS_INT) + this_record = (tape * 1000) + scan + if (is_in_range (records, this_record)) { + nids_read = nids_read + 1 + RECORD_NUMBER(ids) = this_record + iferr { + call calloc (COEFF(ids), MAX_COEFF, TY_DOUBLE) + call idsf_read_header (ids_buffer, ids) + } then { + call erract (EA_WARN) + call mfree (COEFF(ids), TY_DOUBLE) + call sfree (sp) + return (ERR) + } + + call print_header (ids, LONG_HEADER(cp)) + + if (MAKE_IMAGE(cp) == YES) { + call strcpy (IRAF_FILE(cp), out_fname, SZ_FNAME) + call sprintf (out_fname[strlen(out_fname) + 1], SZ_FNAME, ".%d") + call pargi (RECORD_NUMBER(ids)) + iferr { + + call idsf_write_image (ids_buffer, DATA_TYPE(cp), + PRINT_PIXELS(cp), out_fname, ids) + + } then { + call ERRACT (EA_WARN) + call mfree (COEFF(ids), TY_DOUBLE) + call sfree (sp) + return (ERR) + } + } + + if (PRINT_PIXELS(cp) == YES && MAKE_IMAGE(cp) == NO) { + call unpk_30 (ids_buffer, 1, pixels, NPIX_IDS_RECORD) + call list_values (pixels) + } + call mfree (COEFF(ids), TY_DOUBLE) + } + + call sfree (sp) + return (OK) +end + + +# SORT_INDEX -- Sort index information that precedes each IDSFILE. This +# index occupies 5 PRU's and points to ranges of records. Each index +# entry contains a PRU number and the low and high record numbers of the +# records that begin at the stated PRU. These three pieces of information +# are stored in a single 60-bit Cyber word. The number of records requested +# by the user that are actually in the IDSFILE is also counted. This +# number is returned as a parameter to the calling procedure. + +procedure sort_index (index_buf, records, sorted_index, nranges, nrecs_on_tape) + +int index_buf[ARB] # Buffer containing IDS index information +int records[3, MAX_RANGES] # Array of ranges of records specified by user +long sorted_index[LEN_INDEX] # Returned array of sorted index information +int nranges # Number of ranges of IDS records in IDSFILE +int nrecs_on_tape # Number of requested records actually on tape + +int i, start_pru, low_record_number, high_record_number, nrecs, j +long index[LEN_INDEX] +bool is_in_range() +int bitupk() +errchk asrtl, bitupk + +begin + nrecs_on_tape = 0 + nranges = 0 + do i = 1, NINT_CYBER_WRD * LEN_USER_INDEX, NINT_CYBER_WRD { + start_pru = bitupk (index_buf[i], NPRU_OFFSET, NBITS_NPRU) + if (start_pru == 0) + next + low_record_number = bitupk (index_buf[i], LRN_OFFSET, NBITS_LRN) + high_record_number = bitupk (index_buf[i], HRN_OFFSET, NBITS_HRN) + nrecs = high_record_number - low_record_number + 1 + nranges = nranges + 1 + index[nranges] = real (start_pru * 1000) + nrecs + + for (j=low_record_number; j<=high_record_number; j=j+1) { + if (is_in_range (records, j)) + nrecs_on_tape = nrecs_on_tape + 1 + } + } + + call asrtl (index, sorted_index, nranges) +end + + +# LIST_VALUES -- Print the ids pixel values. + +procedure list_values (pixel_buf) + +real pixel_buf[NPIX_IDS_RECORD] # Buffer containing pixels to be listed +int n_pix + +begin + for (n_pix = 1; n_pix <= NPIX_IDS_RECORD; n_pix = n_pix + 4) { + call printf ("%10.4e %10.4e %10.4e %10.4e\n") + call pargr (pixel_buf[n_pix]) + call pargr (pixel_buf[n_pix + 1]) + call pargr (pixel_buf[n_pix + 2]) + call pargr (pixel_buf[n_pix + 3]) + } + call printf ("\n") +end + +# IDSF_READ_HEADER -- Decode ids header parameters from the input buffer and +# fill the program data structure. + +procedure idsf_read_header (ids_buffer, ids) + +int ids_buffer[NINT_CYBER_WRD*LEN_IDS_RECORD] # Input IDSFILE buffer +pointer ids # Pointer to program data structure + +int n_coeff, i +char alpha[3] +int bitupk() +double convert_60bit_fp() +errchk bitupk, unpk_60i, convert_60bit_fp, unpk_id, display_code + +begin + # Get unsigned integer parameters from header + ITM(ids) = bitupk (ids_buffer, ITM_OFFSET, NBITS_INT) + NP1(ids) = bitupk (ids_buffer, NP1_OFFSET, NBITS_INT) + NP2(ids) = bitupk (ids_buffer, NP2_OFFSET, NBITS_INT) + BEAM_NUMBER(ids) = bitupk (ids_buffer, BEAM_OFFSET, NBITS_INT) + SMODE(ids) = bitupk (ids_buffer, SMODE_OFFSET, NBITS_INT) + if (SMODE(ids) != 0) { + # Determine companion record number + if (BEAM_NUMBER(ids) == 1) + COMPANION_RECORD(ids) = RECORD_NUMBER(ids) - 1 + else + COMPANION_RECORD(ids) = RECORD_NUMBER(ids) + 1 + } + UT(ids) = bitupk (ids_buffer, UT_OFFSET, NBITS_INT) + ST(ids) = bitupk (ids_buffer, ST_OFFSET, NBITS_INT) + + # The following integer parameters can be negative + call unpk_60i (ids_buffer, DF_OFFSET, DF_FLAG(ids), 1) + call unpk_60i (ids_buffer, SM_OFFSET, SM_FLAG(ids), 1) + call unpk_60i (ids_buffer, QF_OFFSET, QF_FLAG(ids), 1) + call unpk_60i (ids_buffer, DC_OFFSET, DC_FLAG(ids), 1) + call unpk_60i (ids_buffer, QD_OFFSET, QD_FLAG(ids), 1) + call unpk_60i (ids_buffer, EX_OFFSET, EX_FLAG(ids), 1) + call unpk_60i (ids_buffer, BS_OFFSET, BS_FLAG(ids), 1) + call unpk_60i (ids_buffer, CA_OFFSET, CA_FLAG(ids), 1) + call unpk_60i (ids_buffer, CO_OFFSET, CO_FLAG(ids), 1) + call unpk_60i (ids_buffer, OFLAG_OFFSET, OFLAG(ids), 1) + + # If the dispersion flag (DF) is set, get the coeffecients. The pointer + # to the coeffecient array is stored in the structure ids. + if (DF_FLAG(ids) > -1) { + n_coeff = DF_FLAG(ids) + do i = 1, n_coeff { + Memd[COEFF(ids)+i-1] = convert_60bit_fp (ids_buffer, + (COEFF_OFFSET + (i - 1)) * 64 + 1) + } + } + + # These header values converted from Cyber 60-bit floating point + HA(ids) = convert_60bit_fp (ids_buffer, HA_OFFSET) + AIRMASS(ids) = convert_60bit_fp (ids_buffer, AIR_OFFSET) + RA(ids) = convert_60bit_fp (ids_buffer, RA_OFFSET) + DEC(ids) = convert_60bit_fp (ids_buffer, DEC_OFFSET) + LAMBDA0(ids) = convert_60bit_fp (ids_buffer, LAM_OFFSET) + DELTA_LAMBDA(ids) = convert_60bit_fp (ids_buffer, DEL_OFFSET) + + # The 3 character ALPHA_ID is stored in Cyber display code + call display_code (bitupk (ids_buffer, ALPHA1_OFFSET, NBITS_DC), + alpha[1]) + call display_code (bitupk (ids_buffer, ALPHA2_OFFSET, NBITS_DC), + alpha[2]) + call display_code (bitupk (ids_buffer, ALPHA3_OFFSET, NBITS_DC), + alpha[3]) + call strcpy (alpha, ALPHA_ID(ids), NCHAR_ALPHA) + + # The ids label is written in 7-bit ascii + call unpk_id (ids_buffer, IDS_ID_OFFSET, LABEL(ids)) +end + + +# PRINT_HEADER -- print the ids header in either long or short mode. + +procedure print_header (ids, long_header) + +pointer ids # Pointer to program data structure +int long_header # Print header in long format (YES/NO)? +int i + +real value1, value2 + +begin + if (long_header == YES) { + call printf ("RECORD = %d, label = \"%s\",\n") + call pargi (RECORD_NUMBER(ids)) + call pargstr (LABEL(ids)) + + if (OFLAG(ids) == 1) { + call printf ("oflag = OBJECT, beam_number = %d, ") + call pargi (BEAM_NUMBER(ids)) + } else if (OFLAG (ids) == 0) { + call printf ("oflag = SKY, beam_number = %d, ") + call pargi (BEAM_NUMBER(ids)) + } + call printf ("alpha_ID = %s") + call pargstr (ALPHA_ID(ids)) + if (SMODE(ids) != 0) { + call printf (", companion = %d,\n") + call pargi (COMPANION_RECORD(ids)) + } else + call printf (",\n") + + call printf ("airmass = %5.3f,%24tW0 = %0.3f,") + call pargd (AIRMASS(ids)) + call pargd (LAMBDA0(ids)) + call printf (" WPC = %0.3f, ITM = %d,\n") + call pargd (DELTA_LAMBDA(ids)) + call pargi (ITM(ids)) + call printf ("NP1 = %d, NP2 = %d,") + call pargi (NP1(ids)) + call pargi (NP2(ids)) + + if (IS_INDEFI (UT(ids))) + value1 = INDEFR + else + value1 = real (UT(ids) / 3600.) + + if (IS_INDEFI (ST(ids))) + value2 = INDEFR + else + value2 = real (ST(ids) / 3600.) + call printf (" UT = %h, ST = %h,\n") + call pargr (value1) + call pargr (value2) + + call printf ("HA = %h,") + call pargd (HA(ids)) + call printf (" RA = %h, DEC = %h,\n") + call pargd (RA(ids)) + call pargd (DEC(ids)) + call printf ("df = %d, sm = %d, qf = %d, dc = %d, qd = %d, ") + call pargi (DF_FLAG(ids)) + call pargi (SM_FLAG(ids)) + call pargi (QF_FLAG(ids)) + call pargi (DC_FLAG(ids)) + call pargi (QD_FLAG(ids)) + call printf ("ex = %d, bs = %d, ca = %d, co = %d") + call pargi (EX_FLAG(ids)) + call pargi (BS_FLAG(ids)) + call pargi (CA_FLAG(ids)) + call pargi (CO_FLAG(ids)) + + # The df coeffecients are printed out in the case where the df + # flag is set, and the first coefficient is nonzero. The later + # condition is a test for IDSOUT data, where the df coeffecients + # have been applied but not stored in the header. + + if (DF_FLAG(ids) != -1 && COEFF(ids) != 0) { + call printf (",\n") + do i = 1, DF_FLAG(ids) { + call printf ("df[%d] = %10.8g") + call pargi(i) + call pargd(Memd[COEFF(ids)+i-1]) + if (i != DF_FLAG(ids)) + call printf (", ") + if (mod (i, 4) == 0) + call printf ("\n") + } + call printf ("\n") + } else + call printf ("\n") + call printf ("\n") + } else { + call printf ("RECORD = %d, label = \"%s\"\n") + call pargi (RECORD_NUMBER(ids)) + call pargstr (LABEL(ids)) + } +end + + +# IDSF_WRITE_IMAGE -- pixels are unpacked from the input buffer and written to +# a one dimensional IRAF image. + +procedure idsf_write_image (ids_buffer, data_type, print_pixels, out_fname, + ids) + +int ids_buffer[NINT_CYBER_WRD * LEN_IDS_RECORD] # Input IDSFILE buffer +int data_type # Data type of pixels to be written +int print_pixels # List pixel values (YES/NO)? +char out_fname[SZ_FNAME] # Name of output image +pointer ids # Pointer to program data structure + +pointer im, pixels +pointer impl1r(), immap() +errchk immap, unpk_30, cy_store_keywords, imunmap + +begin + # Map new iraf image and set up image header + im = immap (out_fname, NEW_IMAGE, LEN_USER_AREA) + IM_NDIM(im) = 1 + IM_LEN(im, 1) = NPIX_IDS_RECORD + call strcpy (LABEL(ids), IM_TITLE(im), SZ_IMTITLE) + IM_PIXTYPE(im) = data_type + pixels = impl1r(im) + + # Convert pixels to spp reals and write image line + call unpk_30 (ids_buffer, 1, Memr[pixels], NPIX_IDS_RECORD) + + if (print_pixels == YES) + call list_values (Memr[pixels]) + + # Write ids specific header words to iraf image header + call cy_store_keywords (ids, im) + + call imunmap (im) +end diff --git a/noao/mtlocal/cyber/t_ridsout.x b/noao/mtlocal/cyber/t_ridsout.x new file mode 100644 index 00000000..473d120f --- /dev/null +++ b/noao/mtlocal/cyber/t_ridsout.x @@ -0,0 +1,386 @@ +include <mach.h> +include <ctype.h> +include <imhdr.h> +include <fset.h> +include <error.h> +include "cyber.h" + +define MAX_WIDTH 10 # Maximum format width for pixel data + +# T_RIDSOUT -- the IDSOUT format reader, which reads a text file of IDS +# records in IDSOUT format. Each IDS record contains 133 card images: 4 +# cards of header information followed by 128 cards of pixel values and +# one blank card. The IDSOUT reader will read the text file and optionally +# convert the data to a sequence of one dimensional IRAF images. The +# header information can be printed in long or short form; the pixel values +# can also be listed. + +procedure t_ridsout () + +pointer sp, cp +int fd +char in_fname[SZ_FNAME] +int get_data_type(), clpopni(), clgfil(), btoi() +bool clgetb() +char clgetc() +errchk clpopni + +begin + # Allocate space for the control parameter descriptor structure + call smark (sp) + call salloc (cp, LEN_CP, TY_STRUCT) + + call fseti (STDOUT, F_FLUSHNL, YES) + + # Get parameters from the cl and fill control parameter structure + fd = clpopni ("idsout_file") + + LONG_HEADER(cp) = btoi (clgetb ("long_header")) + PRINT_PIXELS(cp) = btoi (clgetb ("print_pixels")) + call clgstr ("record_numbers", REC_NUMBERS(cp), SZ_LINE) + + # If an output image is to be written, get root output file name + # and output data type. + + MAKE_IMAGE(cp) = btoi (clgetb ("make_image")) + if (MAKE_IMAGE(cp) == YES) { + call clgstr ("iraf_file", IRAF_FILE(cp), SZ_FNAME) + DATA_TYPE(cp) = get_data_type (clgetc ("data_type")) + if (DATA_TYPE(cp) == ERR) + DATA_TYPE(cp) = TY_REAL + } + + while (clgfil (fd, in_fname, SZ_FNAME) != EOF) { + call read_idsout (in_fname, cp) + } + + call clpcls (fd) + call sfree (sp) +end + + +# READ_IDSOUT -- open IDSOUT text file and direct processing depending on +# user's request. + +procedure read_idsout (in_fname, cp) + +char in_fname[SZ_FNAME] # Input file name +pointer cp # Pointer to control parameter structure + +pointer sp, ids +char out_fname[SZ_FNAME] +int in, records[3, MAX_RANGES], nrecs, nrecs_read, stat +bool is_in_range() +int open(), decode_ranges(), idso_read_header(), strlen() +errchk open, read, idso_read_header, decode_ranges, idso_write_image +errchk copy_pixels + +begin + # Open text file and allocate space for descriptor structure ids + in = open (in_fname, READ_ONLY, TEXT_FILE) + call smark (sp) + call salloc (ids, LEN_IDS, TY_STRUCT) + + if (decode_ranges (REC_NUMBERS(cp), records, MAX_RANGES, nrecs) == ERR) + call error (1, "Error in record_numbers specification") + + nrecs_read = 0 + repeat { + iferr { + stat = idso_read_header (in, ids) + } then { + call erract (EA_WARN) + call eprintf ("Bad header, attempting to skip pixels\n") + call copy_pixels (in, NULL) + next + } + + if (stat == EOF) { + call printf ("\nIDSOUT file \"%s\" at EOF\n") + call pargstr (in_fname) + call close (in) + call sfree (sp) + return + } + + if (is_in_range (records, RECORD_NUMBER(ids))) { + nrecs_read = nrecs_read + 1 + call print_header (ids, LONG_HEADER(cp)) + + if (MAKE_IMAGE(cp) == YES) { + call strcpy (IRAF_FILE(cp), out_fname, SZ_FNAME) + call sprintf (out_fname[strlen(out_fname)+1], SZ_FNAME, + ".%04d") + call pargi (RECORD_NUMBER(ids)) + iferr { + call idso_write_image (in, DATA_TYPE(cp), + PRINT_PIXELS(cp), out_fname, ids) + } then { + call erract (EA_WARN) + if (PRINT_PIXELS(cp) == YES) + call copy_pixels (in, STDOUT) + else + call copy_pixels (in, NULL) + next + } + + } else if (PRINT_PIXELS(cp) == YES) + # Simply copy card image data to standard output + call copy_pixels (in, STDOUT) + + if (PRINT_PIXELS(cp) == NO && MAKE_IMAGE(cp) == NO) + call copy_pixels (in, NULL) + } else + call copy_pixels (in, NULL) + + } until (nrecs_read == nrecs) + + call sfree (sp) + call close (in) +end + + +# IDSO_READ_HEADER -- decode header parameter from IDSOUT header cards. The +# IDSO prefix implies IDSOUT format; IDSF is used for IDSFILE format. The +# first four cards of each record in the IDSOUT file are the header. + +int procedure idso_read_header (in, ids) + +int in # File descriptor of input text file +pointer ids # Pointer to program data structure + +pointer sp, temp +int record, tape, junk, ip +int fscan(), nscan(), strlen(), getline() +errchk fscan + +begin + # Allocate space on stack for temporary char storage + call smark (sp) + call salloc (temp, SZ_LINE, TY_CHAR) + + # Skip any blank lines that may preceede the first header card. + # Break out of repeat when first non-blank line is encountered. + + repeat { + if (getline (in, Memc[temp]) == EOF) { + call sfree (sp) + return (EOF) + } else { + for (ip = temp; IS_WHITE (Memc[ip]); ip = ip + 1) + ; + if (Memc[ip] == '\n' || Memc[ip] == EOS) + # Blank line + ; + else + break + } + } + + call sscan (Memc[temp]) { + # Values to be read from first card of file: + call gargi (record) + call gargi (ITM(ids)) + call gargd (LAMBDA0(ids)) + call gargd (DELTA_LAMBDA(ids)) + call gargi (NP1(ids)) + call gargi (NP2(ids)) + call gargi (BEAM_NUMBER(ids)) + call gargi (junk) + call gargi (junk) + call gargi (SMODE(ids)) + call gargi (UT(ids)) + if (nscan() < 11) + call error (2, "First header card incomplete") + } + + if (fscan (in) == EOF) { + call sfree (sp) + return (EOF) + } else { + # Values to be read from second card of file + call gargi (ST(ids)) + call gargd (RA(ids)) + call gargd (DEC(ids)) + call gargi (tape) + if (tape > 0) + RECORD_NUMBER(ids) = tape * 1000 + record + else + RECORD_NUMBER(ids) = record + call gargi (DF_FLAG(ids)) + call gargi (SM_FLAG(ids)) + call gargi (QF_FLAG(ids)) + call gargi (DC_FLAG(ids)) + call gargi (QD_FLAG(ids)) + call gargi (EX_FLAG(ids)) + call gargi (BS_FLAG(ids)) + if (nscan() < 11) + call error (3, "Second header card incomplete") + } + + if (fscan (in) == EOF) { + call sfree (sp) + return (EOF) + } else { + # Values to be read from third card of file + call gargi (CA_FLAG(ids)) + call gargi (CO_FLAG(ids)) + call gargwrd (ALPHA_ID(ids), 3) + call gargi (OFLAG(ids)) + call gargd (HA(ids)) + call gargd (AIRMASS(ids)) + if (nscan() < 6) { + call error (4, "Third header card incomplete") + } + } + + if (fscan (in) == EOF) { + call sfree (sp) + return (EOF) + } else { + call gargstr (Memc[temp], SZ_LINE) + + # Count number of characters in id string by skipping trailing + # white space. 'END' are always the last 3 characters of the + # line of text containing the ID; they are also skipped. + + for (ip = strlen(Memc[temp]) - 3; IS_WHITE (Memc[temp+ip-1]) && + ip > 0 ; ip = ip - 1) + ; + Memc[temp+ip] = EOS + call strcpy (Memc[temp], LABEL(ids), SZ_LINE) + } + + # Since this is IDSOUT format data, initialize COEFF(ids) to integer 0. + COEFF(ids) = 0 + + # Determine companion record number if appropriate + if (SMODE(ids) != 0) { + if (BEAM_NUMBER(ids) == 1) + COMPANION_RECORD(ids) = RECORD_NUMBER(ids) - 1 + else + COMPANION_RECORD(IDS) = RECORD_NUMBER(IDS) + 1 + } + + call sfree (sp) + return (OK) + +end + + +# COPY_PIXELS -- copy pixel values from input to output file. A blank line +# terminates each IDS record. + +procedure copy_pixels (in, out) + +int in # File descriptor of input text file +int out # File descriptor of output file + +pointer sp, line_buffer +bool leading_blank +int ip +int getline() + +begin + # Allocate space on stack for line_buffer + call smark (sp) + call salloc (line_buffer, SZ_LINE, TY_CHAR) + + # Ignore blank lines until first non_blank line encountered + leading_blank = true + + repeat { + if (getline (in, Memc[line_buffer]) == EOF) + call error (5, "Unexpected EOF when copying pixels") + + # Find first non-whitespace character + for (ip = line_buffer; IS_WHITE (Memc[ip]); ip = ip + 1) + ; + + if (Memc[ip] == '\n' || Memc[ip] == EOS) { + # Blank line + if (leading_blank) + ; + else + break + } else { + leading_blank = false + if (out != NULL) + call putline (out, Memc[line_buffer]) + } + } + + call sfree (sp) +end + + +# IDSO_WRITE_IMAGE -- convert card image data values to reals and write +# 1-d IRAF image. + +procedure idso_write_image (in, data_type, print_pixels, out_fname, ids) + +int in # File descriptor of input text file +int data_type # Data type of image pixels to be written +int print_pixels # Are pixel values to be listed (YES/NO)? +char out_fname[SZ_FNAME] # Name of output image +pointer ids # Pointer to program data structure + +pointer im, pixels, op +char line[SZ_LINE], temp[MAX_WIDTH] +int i, j, ip, iip, nchars +pointer immap(), impl1r() +int fscan(), nscan(), strlen(), ctowrd(), ctor() +errchk immap, imunmap, fscan, impl1r, unpk_30, cy_store_keywords + +begin + im = immap (out_fname, NEW_IMAGE, LEN_USER_AREA) + IM_NDIM(im) = 1 + IM_LEN(im, 1) = NPIX_IDS_RECORD + call strcpy (LABEL(ids), IM_TITLE(im), SZ_IMTITLE) + IM_PIXTYPE(im) = data_type + pixels = impl1r(im) + op = pixels + + # Position to first non_blank line. + repeat { + if (fscan (in) == EOF) { + call imunmap (im) + return + } else + call gargstr (line, SZ_LINE) + } until (strlen (line) > 1) + call reset_scan() + + + # Scan and convert pixel values to image pixels. A blank line + # terminates the IDS record. + + do i = 1, NLINES_PIXELS { + ip = 1 + # Extract 8 pixel values from each line of text + do j = 1, NPIX_LINE { + iip = 1 + call gargstr (line, SZ_LINE) + nchars = ctowrd (line, ip, temp, MAX_WIDTH) + nchars = ctor (temp, iip, Memr[op]) + # call gargr (Memr[op]) + op = op + 1 + } + + if (nscan () <= 1) + # Premature blank line encountered + break + + # Get next line of pixels + if (fscan (in) == EOF) + break + } + + if (print_pixels == YES) + call list_values (Memr[pixels]) + + # Write ids specific header words to iraf image header + call cy_store_keywords (ids, im) + + call imunmap (im) +end diff --git a/noao/mtlocal/doc/Mtio_notes b/noao/mtlocal/doc/Mtio_notes new file mode 100644 index 00000000..c5fb2fe5 --- /dev/null +++ b/noao/mtlocal/doc/Mtio_notes @@ -0,0 +1,12 @@ + +MTIO mods: + + (1) Install error checking in MTOPEN ("errchk open"). + + (2) Attempt to position to a file beyond EOT for reading should not + cause an error, rather EOF should be returned at the first read, + indicating a zero length file (i.e., EOT). + + (3) ZARDMT should zero-fill to an integral number of chars, provided + space is available at end of buffer (see ZARDBF, which I had to + modify to provide zero-fill). diff --git a/noao/mtlocal/doc/Rpds_notes b/noao/mtlocal/doc/Rpds_notes new file mode 100644 index 00000000..dbd03326 --- /dev/null +++ b/noao/mtlocal/doc/Rpds_notes @@ -0,0 +1,84 @@ +.help pdsread 2 "Program Structure" +.sh +PDSREAD Structure Chart + +.nf +t_pdsread() +# Returns when file list is satified or if EOT is encountered. + + read_pds (pdsfile, iraffile) + # Returns OK or EOF + + read_header (pds_fd, im, parameters) + # Returns OK or EOF + + read_image (pds_fd, im, parameters) + + set_image_header (im) + + init_read_scan (parameters) + # Returns OK + + read_scan (fd, scanbuf) + # Returns EOF or number of points in a scan +.fi + +.sh +PDSREAD Structure Summary + +.ls t_pdsread +The main procedure reads the control parameters. +The files to be read and converted are calculated from the specified source +and file list. +A loop through the files determines the specific input source names and +output file names and calls READ_PDS for each conversion. +.ls read_pds +The input source is opened and the output image header file is created. +If only the PDS header is to be listed then a temporary image header +file is created. The PDS header is read and decoded into the IRAF +image header bye READ_HEADER. If the image is to be read then +READ_IMAGE is called. Finally all files are closed. If a temporary +image file was created it is deleted. +.ls read_header +The 120 byte PDS header is read into an integer array. The ID string +in the first 80 bytes is unpacked into a text string using the MIIUP routine +and stored in the IRAF image header. The 12 bit PDP values are converted to +SPP short data valuese using the routine APDP8S. +The PDP 059 text code is converted to ASCII using the routine APDP059. +The remaining header quantities are unpacked into short +or long SPP integers using the MIIUP, APDP8S, UNPACKS and UNPACKL and +the image dimensions are stored in the IRAF image header. +Finally the PRINT_HEADER is called to print a long or short version of the +header. +.le +.le +.le +.ls read_image +The PDS image pixels are converted to an IRAF image file. +The image file header is set. +The lines of the image are converted one at a time. +.ls set_image_header +The pixel type for the IRAF image is set to the user specified type. +If no type has been specified then the type is determined from the +number of bits per pixel given in pds.h. +.le +.ls init_read_scan +Initializes the scan parameters. Input is a long integer array containing +the decoded header parameters. The procedure uses the number of data points +per scan, the number of records per scan and the number of points per full +records, calculates and allocates the buffer space required and determines +the size of each record in chars. If the tape is an old 7 track tape the +size of the record must be rounded up till it holds an integral number +of Cyber words in length. For example a record containing 1001 real data +points will actually be 1005 data points long with junk in the last 4 spaces. +.le +.ls read_scan +Reads an entire PDS scan a record at a time looping over the number of +records per scan. The procedure uses the MIIUP +routine which is machine dependent. The bitpix must correspond to +an MII type. READ_SCAN returns the number of data points per scan or EOF. +READ_SCAN calls APDP8S to convert the 10 or 12 bit data values to short +integers and calls AFLIPS to flip every other scan if the PDS scan +is a raster scan. +.le +.endhelp diff --git a/noao/mtlocal/doc/ldumpf.hlp b/noao/mtlocal/doc/ldumpf.hlp new file mode 100644 index 00000000..bfd584ff --- /dev/null +++ b/noao/mtlocal/doc/ldumpf.hlp @@ -0,0 +1,45 @@ +.help ldumpf Jun87 noao.mtlocal +.ih +NAME +ldumpf -- list the permanent files on a Cyber DUMPF tape. +.ih +USAGE +ldumpf dumpf_file file_list +.ih +PARAMETERS +.ls dumpf_file +The DUMPF data source, i.e., the name of a magtape device or a DUMPF +format disk file. If reading from tape, the files to be listed are +specified by the \fIfile_list\fR parameter. +.le +.ls file_list +A string listing the DUMPF files to be listed from \fIdumpf_file\fR. +.le +.ih +DESCRIPTION +Cyber permanent files stored on DUMPF tapes are listed. The permanent file +name, cycle number, owner id, dates of last attach, last alteration and +the creation date are printed. Task \fBldumpf\fR lists the contents of a +DUMPF tape; +to convert IPPS rasters stored on DUMPF tapes to IRAF images, use task +\fBrdumpf\fR. +.ih +EXAMPLES +List all permanent files on a DUMPF tape: + + cl> ldumpf mta 1-999 + +List information for the 4th permanent file on the tape: + + cl> ldumpf mta 4 +.ih +BUGS +The Cyber format readers, including task \fIldumpf\fR, have not been +implemented on SUN/IRAF and AOS/IRAF. + +The current version of IRAF magtape I/O does not read beyond the first +volume of a multivolume tape. +.ih +SEE ALSO +rdumpf +.endhelp diff --git a/noao/mtlocal/doc/r2df.hlp b/noao/mtlocal/doc/r2df.hlp new file mode 100644 index 00000000..38054ad3 --- /dev/null +++ b/noao/mtlocal/doc/r2df.hlp @@ -0,0 +1,88 @@ +.help r2df Jun86 noao.mtlocal +.ih +NAME +r2df -- convert CTIO 2D-Frutti image files to IRAF image files +.ih +USAGE +r2df r2df_file file_list iraf_file +.ih +PARAMETERS +.ls 4 r2df_file +The 2D-Frutti data source. If the data source is a disk file or an explicit +tape file +specification of the form mt*[n] where n is a file number then only that file +is converted. If the general tape device name is given, i.e. mta, mtb800, etc, +then the files specified by the files parameter will be read from the tape. +.le +.ls file_list +The files to be read from a tape are specified by the file_list string. The +string can consist of any sequence of file numbers separated by +at least one of comma, or dash. +A dash specifies a range of files. For example the string + + "1,2,3-5,8-6" + +will convert the files 1 through 8. +.le +.ls iraf_file +The IRAF image file which will receive the 2D-Frutti data if the make_image +parameter switch is set. For tape files specified by the file_list parameter +the filename will be used as a prefix and the file number will be appended. +Otherwise, the file will be named as specified. Thus, +reading files 1 and 3 from a 2D-Frutti tape with a filename of data will produce +the files data1 and data3. It is legal to use a null filename. +.le +.ls make_image = yes +This switch determines if 2D-Frutti image data is converted to an IRAF image +file. This switch is set to no to obtain just header information with the +long_header or short_header switches. +.le +.ls long_header = no +If this switch is set the full 2D-Frutti header is printed on standard output. +.le +.ls short_header = yes +If this switch is set only the output filename, +the title string, and the image dimensions are printed. +.le +.ls standard_format = yes +The 2D-Frutti standard format has least significant byte first. Some 2D-Frutti +data, however, does not follow this byte order convention. Thus, to read +the non-standard 2D-Frutti data this parameter is set to no. +.le +.ls datatype = "s" +The IRAF image file may be of a different data type than 2D-Frutti image data. +The data type may be specified as s for short, l for long, r for real, and +d for double. The user must beware of truncation problems if an +inappropriate data type is specified. If an incorrect data_type or a +null string is given for this parameter then a default data type is used +which is the appropriate minimum size for the input pixel values. +.le +.ls offset = 0 +Offset is an integer parameter specifying the offset to the tape file number +appended to iraf_file. For example if the user specifies offset = 100, +iraf_file = "r2d" and file_list = "1-3", the output file names produced +will be "r2d101", "r2d102" and "r2d103" respectively, instead of "r2d001", +"r2d002" and "r2d003". +.le +.ih +DESCRIPTION +Cerro Tololo 2D-Frutti format image data is read from the specified source; +either a disk file or magnetic tape. +The 2D-Frutti header may optionally be printed on the standard +output as either a full listing or a short description. Image data may +optionally be converted to an IRAF image of specified data type. +.ih +EXAMPLES + +1. Convert a 2D-Frutti image tape to a set of IRAF images. + + da> r2df mtb1600 1-999 r2dfile + +2. List the contents of a 2D-Frutti tape on the standard output without +creating an image file. + + da> r2df mtb1600 1-999 r2dfile ma- +.ih +SEE ALSO +t2d, mtexamine, rewind +.endhelp diff --git a/noao/mtlocal/doc/rcamera.hlp b/noao/mtlocal/doc/rcamera.hlp new file mode 100644 index 00000000..491edc71 --- /dev/null +++ b/noao/mtlocal/doc/rcamera.hlp @@ -0,0 +1,109 @@ +.help rcamera Jan87 noao.mtlocal +.ih +NAME +rcamera -- Convert Kitt Peak CAMERA image files to IRAF image files +.ih +USAGE +rcamera camera_file file_list iraf_file +.ih +PARAMETERS +.ls 4 camera_file +The CAMERA data source. If the data source is a list of disk files or an +explicit tape file +specification of the form mt*[n] where n is a file number. If the file +number is specified then only that file +is converted. If the general tape device name is given, i.e. mta, mtb800, etc, +then the files specified by the file_list parameter will be read from the tape. +.le +.ls file_list +The files to be read from a tape are specified by the file_list string. The +string can consist of any sequence of file numbers separated by +at least one of comma, or dash. +A dash specifies a range of files. For example the string + + "1,2,3-5,8-6" + +will convert the files 1 through 8. +.le +.ls iraf_file +The IRAF file which will receive the CAMERA data if the make_image parameter +switch is set. For multiple disk or tape files the filename +will be used as a prefix and the tape file number or disk sequence number +will be appended. Otherwise, +the file will be named as specified. Thus, +reading files 1 and 3 from a CAMERA tape with a iraf_file set to data will +produce the files data001 and data003. +.le +.ls image_list = "1" +The list of CAMERA images to extract from a single tape file. For all recent +tapes image_list = "1". Old tapes were however contained multiple images +per file. +.le +.ls make_image = yes +This switch determines whether CAMERA image data is converted to an IRAF image +file. This switch is set to no to obtain just header information with the +long_header or short_header switches. +.le +.ls long_header = no +If this switch is set the full CAMERA header is printed on the standard output. +.le +.ls short_header = yes +If this switch is set only the output filename, +the title string, and the image dimensions are printed. +.le +.ls standard_format = yes +The CAMERA standard format has the least significant byte first. Some CAMERA +data, however, does not follow this byte order convention. Thus, to read +the non-standard CAMERA data this parameter is set to no. +.le +.ls datatype = "s" +The IRAF image file may be of a different data type than the CAMERA image data. +The data type may be specified as s for short, l for long, r for real, and +d for double. The user must beware of truncation problems if an +inappropriate data type is specified. If an incorrect data_type or a +null string is given for this parameter then a default data type is used +which is the appropriate minimum size for the input pixel values. +.le +.ls offset = 0 +Offset is an integer parameter specifying the offset to the tape file number +appended to iraf_file. For example if the user specifies offset = 100, +iraf_file = "cam" and file_list = "1-3", the output file names produced +will be "cam101", "cam102" and "cam103" respectively, instead of "cam001", +"cam002" and "cam003". +.le +.ih +DESCRIPTION + +Kitt Peak CAMERA format image data is read from the specified source; +either a disk or magnetic tape. +The CAMERA header may optionally be printed on the standard +output as either a full listing or a short description. Image data may +optionally be converted to an IRAF image of specified data type. +.ih +EXAMPLES + +Convert a camera image tape to a set of IRAF images. + +.nf + cl> rcamera mtb1600 1-999 images +.fi + +Convert a list of camera disk files to IRAF images. + +.nf + cl> rcamera cam* 1 images +.fi + +List the contents of a camera tape on the standard output without +creating an image file. + +.nf + cl> rcamera mtb1600 1-999 images ma- +.fi + +Read images 1-3 and 6-8 from an old CAMERA tape with many images per file. + +.nf + cl> rcam mtb1600[1] image image_list=1-3,6-8 +.fi +.endhelp diff --git a/noao/mtlocal/doc/rdumpf.hlp b/noao/mtlocal/doc/rdumpf.hlp new file mode 100644 index 00000000..d995774e --- /dev/null +++ b/noao/mtlocal/doc/rdumpf.hlp @@ -0,0 +1,89 @@ +.help rdumpf Jul87 noao.mtlocal +.ih +NAME +rdumpf -- convert IPPS rasters from DUMPF tapes to IRAF images +.ih +USAGE +rdumpf dumpf_file file_list iraf_file +.ih +PARAMETERS +.ls dumpf_file +The dumpf data source, i.e., the name of a magtape device. +.le +.ls file_list +A string listing the permanent files to be read from the DUMPF tape. +.le +.ls iraf_file +The IRAF file which will receive the image data if the \fImake_image\fR +parameter +is set. If more then one raster is being read, the output +filename is concatenated from the \fIiraf_file\fR parameter, the tape +file number and the raster sequence number. That is, reading rasters 1 - 3 +from files 3 and 4 with iraf_file = \fIpic\fR would generate a sequence of +files: +pic3.001, pic3.002, pic3.003, pic4.001, pic4.002, pic4.003. +.le +.ls raster_list = "1-999" +A string listing the IPPS rasters to be read from each file specified by +the \fIfile_list\fR parameter. +.le +.ls make_image = yes +This switch determines whether the IPPS rasters are converted to IRAF images. +When this switch is set to \fIno\fR, only a listing of the IPPS rasters is +produced, no output image is written. +.le +.ls print_header = yes +This switch determines if the IPPS header information will be listed for those +rasters being read. +.le +.ls data_type = "" +The data type of the output IRAF image. If an incorrect data_type or null +string is entered, the default data type used is determined by the number +of bits per pixel in the IPPS raster. +.le +.ih +DESCRIPTION +IPPS rasters stored in DUMPF format are read and optionally converted to +IRAF images. The IPPS ID and other header information is printed. +The rasters to be converted are specified by both a file +number and then a raster number within that file. It may be helpful to +first run task \fBldumpf\fR to list the contents of the DUMPF tape; only +IPPS rasters can be converted. +.sp +Some dumpf volumes are written on more than one tape. +Task \fIrdumpf\fR cannot recover a file that is split across two tapes on +a "multi-volume-set" dumpf tape. It is, however, possible to read the files +beyond the leading partial file; this is done by incrementing the +\fBfile_list\fR parameter by 1. For example, the first complete file +on the second tape of a multi-volume-set is indicated by \fBfile_list\fR = 2. +.ih +EXAMPLES +[1] Convert all rasters in the 3rd permanent file on tape: + + cl> rdumpf mta 3 ipps + +[2] Convert all rasters in all permanent files: + + cl> rdumpf mta 1-999 ipps + +[3] List the first 10 IPPS rasters of the first permanent file: + + cl> rdumpf mta 1 raster_list=1-10 make_image=no + +.ih +BUGS +The Cyber format readers, including \fIrdumpf\fR, have not been implemented +on SUN/IRAF and AOS/IRAF. + +The current version of IRAF magtape I/O does not read beyond the first +volume of a multivolume tape. As described above, \fIrdumpf\fR cannot +read a file split across two tapes. +.sp +The record structure of a DUMPF tape is used to +filter out noise records and extraneous bits that fill out a tape byte; +this tape structure information is lost when the tape is copied to disk, +and so \fBrdumpf\fR may not be able to convert some DUMPF format disk files. +.ih +SEE ALSO +ldumpf +.endhelp diff --git a/noao/mtlocal/doc/ridsfile.hlp b/noao/mtlocal/doc/ridsfile.hlp new file mode 100644 index 00000000..42f98884 --- /dev/null +++ b/noao/mtlocal/doc/ridsfile.hlp @@ -0,0 +1,102 @@ +.help ridsfile Jun87 noao.mtlocal +.ih +NAME +ridsfile -- convert DUMPF format IDSFILE to IRAF images +.ih +USAGE +ridsfile dumpf_file file_number iraf_file +.ih +PARAMETERS +.ls dumpf_file +The dumpf data source, i.e., the name of a magtape device. +.le +.ls file_number +The ordinal of the DUMPF permanent file containing the IDSFILE to +be read. A listing of permanent files on the DUMPF tape can be +obtained with the \fBldumpf\fR task. +.le +.ls iraf_file +The IRAF file which will receive the data if the \fImake_image\fR parameter +is set. If multiple records are being read, the output +filename is concatenated from this parameter and the IDS record number. +That is, images with these names would be created if \fIiraf_file\fR = "ids": +ids.1001, ids.1002, ids.1003, ..., ids.2001, ids.2002, ..., ids.3001 .... +.le +.ls record_numbers = "1001-9999" +A string listing the IDS records to be read from the IDSFILE. +.le +.ls make_image = yes +This switch determines whether the IDS records are converted to IRAF images. +When \fImake_image\fR = no, only a listing of the headers is produced, +no output image is written. +.le +.ls print_pixels = no +When this parameter is set to yes, the values of the ids pixels are printed. +.le +.ls long_header = no +This parameter determines whether a long or short header is printed. When +\fIlong_header\fR = no, a short header is printed. The +short header contains only the record number and ID string; the long header +contains all information available +including the RA, Dec, HA, ST, UT, reduction flags, airmass, integration time, +starting wavelength and wavelength per channel information. +.le +.ls data_type = "r" +The data type of the output IRAF image. If an incorrect data_type or null +string is entered, the default data type \fIreal\fR is used. +.le +.ih +DESCRIPTION +The IDS records in an IDSFILE are read from a Cyber DUMPF tape and optionally +converted to a sequence of one dimensional IRAF images. The records to be +read from the IDSFILE can be +specified. The IDS header information is printed in either a short or long +form. The pixels values can be listed as well. +.ih +EXAMPLES +[1] Convert all records in the IDSFILE to IRAF images, with the root image name +being "aug83". From running task LDUMPF, it is known that the IDSFILE is the +fourth permanent file on the DUMPF tape. The DUMPF tape is mounted on mtb. + + cl> ridsfile mtb 4 aug83 + +[2] List the headers from the same IDSFILE read in example 1, but don't make +output images. A \fBlong_header\fR will be listed; sample output is shown. + + cl> ridsfile mtb 4 make_image=no long_header=yes + +.nf +RECORD = 2317, label = "CALLISTO 2297/2298 CLEAR/2.5ND", +oflag = OBJECT, beam_number = 0, alpha_ID = NEW, companion = 2318, +airmass = 1.524, W0 = 3430.735, WPC = 1.032, ITM = 960, +NP1 = 0, NP2 = 1024, UT = 3:36:20.0, ST = 15:36:43.0, +HA = 1:39:48.5, RA = 13:56:55.5, DEC = -10:42:37.1, +df = -1, sm = -1, qf = -1, dc = 0, qd = 0, ex = 0, bs = 1, ca = 0, co = -1 +.fi + +[3] Print the pixel values for records 5086 and 5087. No output image will +be written, and only the short header listed. Again, the IDSFILE is the +fourth permanent file on the DUMPF tape, which is mounted on mtb. + + cl> ridsfile mtb 4 make_im- rec=5086,5087 print+ +.ih +BUGS +The current version of IRAF magtape I/O does not read beyond the first +volume of a multivolume tape. +.sp +The record structure of a DUMPF tape is used to +filter out noise records and extraneous bits that fill out a tape byte; +this tape structure information is lost when the tape is copied to disk, +and so \fBridsfile\fR may not be able to convert some DUMPF format disk files. +.sp +Task \fBridsfile\fR allows for converting only one IDSFILE per execution. +If you wish to read more than one IDSFILE +from a DUMPF tape, \fBridsfile\fR must be executed more than once. +.ih +BUGS +The Cyber format readers, including \fIridsfile\fR, have not been implemented +on SUN/IRAF and AOS/IRAF. +.ih +SEE ALSO +ldumpf, ridsout, ridsmtn +.endhelp diff --git a/noao/mtlocal/doc/ridsmtn.hlp b/noao/mtlocal/doc/ridsmtn.hlp new file mode 100644 index 00000000..48ec58aa --- /dev/null +++ b/noao/mtlocal/doc/ridsmtn.hlp @@ -0,0 +1,133 @@ +.help ridsmtn Jun86 noao.mtlocal +.ih +NAME +ridsmtn -- convert mountain format IDS data to IRAF images +.ih +USAGE +ridsmtn ids_file iraf_file +.ih +PARAMETERS +.ls ids_file +The IDS data source. +.le +.ls iraf_file +The IRAF file which will receive the data if the \fImake_image\fR parameter +is set. If multiple records are being read, the output +filename is concatenated from this parameter and the IDS record number. +IRAF images with these names would be created from IDS records 1, 2 and 3 if +\fIiraf_file\fR = "ids" (and offset = 0; see below): ids.0001, ids.0002, +ids.0003. +.le +.ls file_number = 1 +If \fIids_file\fR is a tape device, this parameter tells which tape file +will be read. In almost all cases, the IDS data will occupy the first +and only file on the tape. +.le +.ls record_numbers = "1-9999" +A string listing the IDS records to be read. +.le +.ls reduced_data = yes +A boolean parameter which indicates the data is mountain reduced if set +to yes, and that the data is raw (unreduced) if set to no. +.le +.ls np1 = 0 +The starting pixel to extract in the image. If set to 0, the +record header parameter NP1 will be used to determine the +starting pixel. +This and the following parameter are in effect only when reduced_data +is set to no. If reduced_data=yes, then the entire spectrum (1024 points) +is copied. +.le +.ls np2 = 0 +The ending pixel to extract. If set to 0, the record +header parameter NP2 will be used to determine the +starting pixel. +.le +.ls make_image = yes +This switch determines whether the IDS records are converted to IRAF images. +When \fImake_image\fR = no, only a listing of the headers is produced, +no output image is written. +.le +.ls print_pixels = no +When this parameter is set to yes, the values of the ids pixels are printed. +.le +.ls long_header = no +This parameter determines whether a long or short header is printed. The +short header contains only the record number and ID string; the long header +contains all information available +including the RA, Dec, HA, ST, UT, reduction flags, airmass, integration time, +starting wavelength and wavelength per channel information. +.le +.ls data_type = "r" +The data type of the output IRAF image. If an incorrect data_type or null +string is entered, the default data type \fIreal\fR is used. +.le +.ls offset = 0 +The integer value of this parameter is added to each IDS record number when +generating output filenames. Filenames are of the form +.nf + \fIiraf_file\fR.record_number+\fIoffset\fR + +.fi +The offset parameter can be used to create a sequence of output IRAF +filenames with continuous, sequential suffixes over more than one night's data. +.le +.ih +DESCRIPTION +The IDS records from either a raw or reduced IDS mountain tape are read and +optionally converted to a sequence of one dimensional IRAF images. The records +to be read can be specified. The IDS header information is printed in either +a short or long form. The pixel values can be listed as well. + +The entire image may be extracted (default for reduced data) by specifying +the parameters np1=1 and np2=1024 (IIDS and IRS). Otherwise, the +header parameters NP1 and NP2 will be used to indicate the useful +portion of the spectrum. For raw data these values are 6 and 1024 for the +IIDS and 68 and 888 for the IRS (your IRS values may vary). + +On the mountain, the NEW-TAPE command writes a dummy record on tape with a +record number equal to the starting record number minus 1. If this dummy +record number is included in the \fIrecord_numbers\fR range, a meaningless +IRAF image will be written. In most cases, the dummy record number = 0. +.ih +EXAMPLES +[1] Convert all records on the IDS tape to IRAF images, with the root image name +being "aug83". The data is mountain reduced, and all records will be +converted. The IDS tape is mounted on mtb. + + cl> ridsmtn mtb aug83 + +[2] List the headers from the same mountain tape read in example 1 but don't +make output images. A \fIlong_header\fR will be listed; sample output is shown. + + cl> ridsmtn mtb make_image=no long_header=yes + +.nf + +RECORD = 79, label = "NGC 7662 7.4E 10S AUG 23/24 84 CLOUDS", +oflag = OBJECT, beam_number = 0, W0 = 4588.503, WPC = 2.598, ITM = 120, +NP1 = 0, NP2 = 1024, UT = 7:37:04.0, ST = 22:21:46.0, HA = -1:03:25.7, +RA = 23:25:12.6, DEC = 42:26:37.0, DRA = 7.4, DDEC = -10., +df =-1, sm =-1, qf =-1, dc = 0, qd = 0, ex =-1, bs = -1, ca = -1, co = 0 + + +RECORD = 238, label = "HENEAR AUG 23/24 84 END 8.4" ENT", +oflag = SKY, beam_number = 1, W0 = 4585.501, WPC = 2.602, ITM = 400, +NP1 = 8, NP2 = 1019, UT = 12:31:01.0, ST = 3:16:33.0, HA = 0:17:16.3, +RA = 2:59:16.7, DEC = 31:57:30.0 +df = 6, sm = -1, qf = -1, dc = -1, qd =-1, ex =-1, bs =-1, ca =-1, co = -1, +df[1] = 5889.2139, df[2] = 1355.6821, df[3] = 23.1303, df[4] = -2.85366, +df[5] = 3.0472932, df[6] = -4.541831 +.fi + +[3] Print the pixel values for records 5086 and 5087. No output image will +be written, and only the short header listed. This time, the IDS tape +contains raw data, not reduced. + +.nf + cl> ridsmtn mtb red- make_im- rec=5086,5087 print_pix- +.fi +.ih +SEE ALSO +ridsout, ridsfile +.endhelp diff --git a/noao/mtlocal/doc/ridsout.hlp b/noao/mtlocal/doc/ridsout.hlp new file mode 100644 index 00000000..03f1cf75 --- /dev/null +++ b/noao/mtlocal/doc/ridsout.hlp @@ -0,0 +1,97 @@ +.help ridsout Sep84 noao.mtlocal +.ih +NAME +ridsout -- convert IDSOUT format text file to IRAF images +.ih +USAGE +ridsout idsout_file iraf_file +.ih +PARAMETERS +.ls idsout_file +The text file or files containing the IDSOUT format data. This will most likely +be the redirected output from task \fBrcardimage\fR. +.le +.ls iraf_file +The IRAF file which will receive the data if the \fImake_image\fR parameter +is set. If multiple records are being converted, the output +filename is concatenated from this parameter and the IDS record number. +That is, images with these names would be created if \fIiraf_file\fR = "ids": +ids.1001, ids.1002, ids.1003, ..., ids.2001, ids.2002, ..., ids.3001 .... +.le +.ls record_numbers = "1001-9999" +A string listing the IDS records to be read. +.le +.ls make_image = yes +This switch determines whether the IDS records are converted to IRAF images. +When \fImake_image\fR = no, only a listing of the headers is produced, +no output image is written. +.le +.ls print_pixels = no +When this parameter is set to yes, the values of the ids pixels are printed. +.le +.ls long_header = yes +This parameter determines whether a long or short header is printed. When +\fIlong_header\fR = no, a short header is printed. The +short header contains only the record number and ID string; the long header +contains all information available +including the RA, Dec, HA, ST, UT, reduction flags, airmass, integration time, +starting wavelength and wavelength per channel information. +.le +.ls data_type = "r" +The data type of the output IRAF image. If an incorrect data_type or null +string is entered, the default data type \fIreal\fR is used. +.le +.ih +DESCRIPTION +IDSOUT format IDS records are read from a text file and optionally +converted to a sequence of one dimensional IRAF images. The text file will +most likely have been created by reading an IDSOUT tape with \fBrcardimage\fR. +The IDS records to be read from the file can be specified. +The IDS header information is printed in either a short or long +form. The pixels values can be listed as well. +.ih +EXAMPLES +[1] Convert all records in the IDSOUT file to IRAF images, with the root image +name being "aug83". The IDSOUT file is the first file on the tape, which is +mounted on mtb. + + cl> rcardimage mtb[1] | ridsout aug83 + +[2] List the headers from the same IDSOUT file read in example 1, but don't make +output images. A \fBlong_header\fR will be listed; sample output is shown. + + cl> rcardimage mtb[1] | ridsout make_image=no + +.nf + +RECORD = 2317, label = "CALLISTO 2297/2298 CLEAR/2.5ND", +oflag = OBJECT, beam_number = 0, alpha_ID = NEW, companion = 2318, +airmass = 1.524, W0 = 3430.735, WPC = 1.032, ITM = 960, +NP1 = 0, NP2 = 1024, UT = 3:36:20.0, ST = 15:36:43.0, +HA = 1:39:48.5, RA = 13:56:55.5, DEC = -10:42:37.1, +df = -1, sm = -1, qf = -1, dc = 0, qd = 0, ex = 0, bs = 1, ca = 0, co = -1 +.fi + +[3] Print the pixel values for records 5086 and 5087. No output image will +be written, and only the short header listed. Again, the IDSOUT file is the +first file on the tape, which is mounted on mtb. + +.nf + cl> rcard mtb[1] | ridsout make- long- print+ rec = 5086,5087 +.fi +.ih +BUGS +The current version of IRAF magtape I/O does not read beyond the first +volume of a multivolume tape. +.sp +Task \fBridsout\fR allows for converting more than one IDSOUT file per +execution. In cases where a given record number occurs in more than one +IDSOUT file being read and \fImake_image = yes\fR, this creates a problem, as +the images being written will have the same name for the duplicate record +numbers ("iraf_name.record_number"). The action taken in this situation depends +on the value of "noclobber"; the user should be aware of the potential +problem. +.ih +SEE ALSO +ridsfile, ridsmtn +.endhelp diff --git a/noao/mtlocal/doc/rpds.hlp b/noao/mtlocal/doc/rpds.hlp new file mode 100644 index 00000000..57c7c83d --- /dev/null +++ b/noao/mtlocal/doc/rpds.hlp @@ -0,0 +1,93 @@ +.help rpds Jan87 noao.mtlocal +.ih +NAME +rpds -- Convert Kitt Peak PDS image files to IRAF image files +.ih +USAGE +rpds pds_file file_list iraf_file +.ih +PARAMETERS +.ls pds_file +The PDS data source. The data source may be a template specifying +a list of disk files, e.g. pds* or a mag tape file specification of +the form mtl*[n], e.g. "mta1600" or "mtb800[1]". The mt specifies magtape, +l specifies the drive, a,b,c etc, * specifies the density and [n] +the tape file number. If no tape file number is specified rpds reads +the tape files specified by file_list. +.le +.ls file_list +A string parameter containing the list of tape files to be processed. +File_list is only requested if no tape file number is specified in pds_file. +For example the string + + "1,2,3-5,8-6" + +will convert files 1 through 8. +.le +.ls iraf_file +The IRAF file which will receive the PDS data if the make_image +switch is set. If multiple files are input from tape or disk, the tape file +number or disk sequence number will be appended to the output file name. +.le +.ls make_image = yes +If make_image is not set, the PDS image headers are listed on the standard +output and no image file is created. +.le +.ls long_header = no +If this switch is set the full PDS header is printed on the standard output. +.le +.ls short_header = yes +If this switch is set only the output filename, +the title string, and the image dimensions for each image are printed +on the standard output. +.le +.ls datatype = "s" +The IRAF image data type, s (short integer), i (integer), l (long integer), + r (real) or d (double). +.le +.ls tenbit = no +Old ten bit format? +.le +.ls ninetrack = yes +Ninetrack or old seven track tapes? +.le +.ls offset = 0 +Offset is an integer parameter which is added to the tape file number +or disk sequence number and +appended to the parameter iraf_file. For example if offset = 100, +iraf_file = "pds" and file_list = "1-3" the output file names will be +"pds101", "pds102" and "pds103" respectively, instead of "pds001", "pds002" +and "pds003". +.le +.ih +DESCRIPTION + +Kitt Peak PDS data is read into IRAF from either a +list of disk files or magnetic tape. +The PDS header may optionally be printed on the standard output as either a +full listing or a short description. +.ih +EXAMPLES + +Convert a ninetrack PDS image tape to a set of IRAF images. + +.nf + cl> pdsread mtb1600 1-999 images +.fi + +List the contents of a nintrack PDS tape on the standard output. + +.nf + cl> pdsread mtb1600 1-999 images ma- +.fi + +Convert a list of pds file on disk to IRAF images. + +.nf + cl> pdsread pds* 1 images +.fi + +.ih +BUGS + +.endhelp diff --git a/noao/mtlocal/doc/rrcopy.hlp b/noao/mtlocal/doc/rrcopy.hlp new file mode 100644 index 00000000..09d02486 --- /dev/null +++ b/noao/mtlocal/doc/rrcopy.hlp @@ -0,0 +1,65 @@ +.help rrcopy Jun87 noao.mtlocal +.ih +NAME +rrcopy -- Convert IPPS rasters from RCOPY tapes to IRAF images +.ih +USAGE +rrcopy rcopy_file raster_list iraf_file +.ih +PARAMETERS +.ls rcopy_file +The RCOPY data source, i.e., the name of a magtape device or a RCOPY +format disk file. +.le +.ls raster_list +A string listing the IPPS rasters to be read from the rcopy file. +.le +.ls iraf_file +The IRAF file which will receive the RCOPY data if the make_image parameter +is set. If more than one raster is being read, the output filenames +will be concatenated from this +parameter and the raster sequence number on the RCOPY tape. That +is, reading rasters 1 thru 8 from tape into iraf_file 'pic' +would generate a sequence of files: pic001, pic002, ..., pic008. +.le +.ls make_image = yes +This switch determines whether RCOPY image data is converted to an IRAF image +file. When this switch it set to no, only a listing is produced, no output +image is written. +.le +.ls print_header = yes +This switch determines if the header information will be printed for those +rasters in "raster_list". (It might be appropriate to set print_header=no, or +redirect the output, if RRCOPY is being run as a background task.) +.le +.ls data_type = "" +The data type of the output IRAF image. If an incorrect data_type or null +string is entered, the default data type used is +determined by the number of bits per pixel in the IPPS raster. +.le +.ih +DESCRIPTION +IPPS rasters stored on RCOPY tapes are read from the specified source. +IPPS raster header information is listed. The image data may optionally +be converted to an IRAF image file. It takes RRCOPY about 16 cpu seconds +to read a 256 x 256 30-bit IPPS raster; 42 cpu seconds for a 320 x 512 +30-bit raster; 34 cpu seconds for a 320 x 512 20-bit raster. +.ih +EXAMPLES + +[1] List all IPPS headers from an RCOPY tape: + + cl> rrcopy mtb 1-999 make_image=no + +[2] Read the first 5 rasters from tape into IRAF images ipps001 +through ipps005 with default data types: + + cl> rrcopy mtb 1-5 ipps +.ih +BUGS +The Cyber format readers, including \fIrrcopy\fR, have not been implemented +on SUN/IRAF and AOS/IRAF. + +The current version of IRAF magtape I/O does not read beyond the first +volume of a multivolume tape. +.endhelp diff --git a/noao/mtlocal/doc/widsout.hlp b/noao/mtlocal/doc/widsout.hlp new file mode 100644 index 00000000..b868a5f7 --- /dev/null +++ b/noao/mtlocal/doc/widsout.hlp @@ -0,0 +1,113 @@ +.help widsout Oct84 noao.mtlocal +.ih +NAME +widsout -- Convert an IRAF image to IDSOUT text format +.ih +USAGE +widsout image idsout +.ih +PARAMETERS +.ls image +Image to be converted to IDSOUT text format. +.le +.ls idsout +IDSOUT filename for single file output and IDSOUT root name for multiple +file output. +.le +.ls type_output = "multiple" +Type of output to be created. The options are "single" and "multiple". +In type "single" the IDSOUT records, one for each image line, are +appended to the file given by the parameter \fIidsout\fR. +In type "multiple" the IDSOUT record for each line is appended to a different +file. The files have names formed from the root name, given by \fIidsout\fR, +with the extensions .001, .002, etc, where the extension is the image line. +.001, .002, etc. +.le +.ls label = +List structured string parameter for the record labels. +.le +.ls uttime = 0 +Universal time in integer seconds. +.le +.ls utdate = 0 +Universal date given in the integer format yymmdd. +.le +.ls siderial = 0. +Siderial time in hours. +.le +.ls ra = 0. +Right Ascension in hours. +.le +.ls dec = 0. +Declination in degrees. +.le +.ls ha = 0. +Hour angle in hours. +.le +.ls airmass = 1. +Air mass. +.le +.ls integration = 0 +Integration time in integer seconds. +.le +.ls wavelen1 = 4000. +Wavelength of the first bin. +.le +.ls dispersion = 1. +Dispersion per pixel. +.le +.ih +DESCRIPTION +The \fIimage\fR containing one spectrum per image line is converted to the +IDSOUT card format described below. There are two types of output selected by +the parameter \fItype_output\fR. The options for this parameter are "single" +and "multiple". In type "single" the IDSOUT records, one for each image line, +are appended to the file given by the parameter \fIidsout\fR. +In type "multiple" the IDSOUT record for each line is appended to a different +file. The files have names formed from the root name, given by \fIidsout\fR, +with the extensions .001, .002, etc, where the extension is the image line. +Each record contains a record label which is read from the list structured +parameter \fIlabel\fR. If \fIlabel\fR is not specified the user is prompted +for the label for each image line. Otherwise the file specified is read +for the labels. The remaining parameters are general record header information +whose meanings are apparent. + +The IDSOUT text format consists of 133 80 character lines. The format of these +lines is: + +.nf + Line Column Type + 1 1-5 Integer Record number within IDSOUT text file + 6-10 Integer Integration time + 11-25 Real Wavelength of first bin + 26-40 Real Dispersion + 41-45 Integer 0 (Index of first pixel) + 46-50 Integer Line length - 1 (Index of last pixel) + 71-80 Integer UT time + 2 1-10 Real Siderial time + 11-25 Real Right Ascension + 26-40 Real Declination + 3 21-35 Real Hour Angle + 36-50 Real Air mass + 51-58 Integer UT date + 60-76 String Image title + 78-80 String END + 4 1-64 String Record label + 78-80 String END +5-132 Real 1024 pixel values, 8 per line + 133 Blank line +.fi + +The data of type real are in exponent format; i.e FORTRAN 'E' format (1.234e3). +.ih +EXAMPLES +To convert an two dimensional image containing three spectra to the +output file "idsout": + + cl> widsout image idsout type_output=single label=file + +where file contains three strings to be used for the record labels. +.ih +SEE ALSO +ridsout +.endhelp diff --git a/noao/mtlocal/doc/widstape.hlp b/noao/mtlocal/doc/widstape.hlp new file mode 100644 index 00000000..518a1013 --- /dev/null +++ b/noao/mtlocal/doc/widstape.hlp @@ -0,0 +1,90 @@ +.help widstape Mar85 noao.mtlocal +.ih +NAME +widstape -- Write a Cyber style IDSOUT tape +.ih +USAGE +widstape idsout input records +.ih +PARAMETERS +.ls idsout +The output file name to receive the card-image data. This may be a +magtape specification (e.g. mta, mtb) or disk file name. +.le +.ls input +The input root file name for the spectra to be written +.le +.ls records +The record string to be appended to the root name to create the image +names of the spectra to be written. +.le +.ls new_tape = no +If set to yes, the tape is rewound and output begins at BOT. If no, +output begins at EOT unless an explicit file specification is given +as part of the magtape file name for parameter "idsout" (e.g. mta[2]). +If idsout contains a file specification of [1], then writing begins +at BOT regardless of the value for new_tape. +.le +.ls block_size = 3200 +The tape block size in bytes. This must be an integral factor of 80. +.le +.ls ebcdic = no +The default character code is ASCII, but if this parameter is set to yes, +the output character will be in EBCDIC. +.le +.ih +DESCRIPTION +The specified spectra are copied to the output file in a card-image format +defined in the IPPS-IIDS/IRS Reduction Manual. Values from the extended +image header are used to fill in the observational parameters. + +The basic format consists of 4 - 80 byte header cards, 128 data cards +having 8 data elements per card in 1PE10.3 FORTRAN equivalent format, +and a trailing blank card for a total of 133 cards. +Thus spectra up to 1024 points may be contained in the IDSOUT format. +The format is outlined below: + +.nf + Line Column Type + 1 1-5 Integer Record number within IDSOUT text file + 6-10 Integer Integration time + 11-25 Real Wavelength of first bin + 26-40 Real Dispersion + 41-45 Integer 0 (Index of first pixel) + 46-50 Integer Line length - 1 (Index of last pixel) + 71-80 Integer UT time + 2 1-10 Real Siderial time + 11-25 Real Right Ascension + 26-40 Real Declination + 3 21-35 Real Hour Angle + 36-50 Real Air mass + 51-58 Integer UT date + 60-76 String Image title + 78-80 String END + 4 1-64 String Record label + 78-80 String END +5-132 Real 1024 pixel values, 8 per line + 133 Blank line +.fi + +The data of type real are in exponent format; i.e FORTRAN 'E' format (1.234e3). + +There are no special marks between spectral images, +and when multiple spectra are written with a single command, the first card +of a subsequent spectrum may be within the same physical tape block +as the last card of the previous spectrum. This assures that all tape +blocks (except the very last one in the tape file) are all the same +length. A double end-of-mark is written after the last spectrum. +.ih +EXAMPLES +The following example writes an IDSOUT format tape starting at the +beginning of the tape. + + cl> widstape mta nite1 1001-1200 new_tape+ +.ih +TIME REQUIREMENTS: UNIX/VAX 11/750 +Each spectrum of 1024 points requires about 2 second. +.ih +SEE ALSO +rcardimage, ridsout +.endhelp diff --git a/noao/mtlocal/idsmtn/README b/noao/mtlocal/idsmtn/README new file mode 100644 index 00000000..7680e2d2 --- /dev/null +++ b/noao/mtlocal/idsmtn/README @@ -0,0 +1,3 @@ +This directory (dataio$idsmtn) contains code for the mountain format +IIDS/IRS tapes. Either raw or mountain reduced data tapes are read +with task ridsmtn. This task was installed in dataio 11/84. SEH diff --git a/noao/mtlocal/idsmtn/idsmtn.h b/noao/mtlocal/idsmtn/idsmtn.h new file mode 100644 index 00000000..2ea3c9eb --- /dev/null +++ b/noao/mtlocal/idsmtn/idsmtn.h @@ -0,0 +1,82 @@ +# Definitions for the Mountain format IDS tape reader: + +define MAX_RANGES 100 +define DUMMY 3 # Value returned if DUMMY IDS record is read + +define SZB_IDS_RECORD 4216 +define NPIX_IDS_REC 1024 +define DATA_BYTE 9 # First byte of data +define MAX_NCOEFF 25 +define SZ_IDS_ID 64 +define LEN_USER_AREA 2880 + +# The control parameter structure is defined below: + +define LEN_CP (10 + SZ_FNAME + 1) + +define IS_REDUCED Memi[$1] +define LONG_HEADER Memi[$1+1] +define PRINT_PIXELS Memi[$1+2] +define MAKE_IMAGE Memi[$1+3] +define OFFSET Memi[$1+4] +define DATA_TYPE Memi[$1+5] +define IRAF_FILE Memc[P2C($1+10)] + + +# The header structure is defined below: + +define LEN_IDS (40 + SZ_IDS_ID + 1) + +define HA Memd[P2D($1)] +define AIRMASS Memd[P2D($1+2)] +define RA Memd[P2D($1+4)] +define DEC Memd[P2D($1+6)] +define W0 Memd[P2D($1+8)] +define WPC Memd[P2D($1+10)] +define NREC Memi[$1+12] +define NP1 Memi[$1+13] +define NP2 Memi[$1+14] +define ITM Memi[$1+15] +define BEAM Memi[$1+16] +define COMPANION_RECORD Memi[$1+17] +define SMODE Memi[$1+18] +define UT Memi[$1+19] +define ST Memi[$1+20] +define DF_FLAG Memi[$1+21] +define SM_FLAG Memi[$1+22] +define QF_FLAG Memi[$1+23] +define DC_FLAG Memi[$1+24] +define QD_FLAG Memi[$1+25] +define EX_FLAG Memi[$1+26] +define BS_FLAG Memi[$1+27] +define CA_FLAG Memi[$1+28] +define CO_FLAG Memi[$1+29] +define OFLAG Memi[$1+30] +define COEFF Memi[$1+31] +define DRA Memi[$1+32] +define DDEC Memi[$1+33] +define ALPHA_ID Memc[P2C($1+35)] +define LABEL Memc[P2C($1+40)] + + +# BYTE offsets to various IDS header words are defined below. These become +# word offsets once each byte is unpacked per element of an integer array. + +define NREC_OFFSET ((1 * 2) - 1) +define ITM_OFFSET ((3 * 2) - 1) +define DATA_OFFSET ((5 * 2) - 1) +define W0_OFFSET ((2053 * 2) - 1) +define WPC_OFFSET ((2056 * 2) - 1) +define NP1_OFFSET ((2059 * 2) - 1) +define NP2_OFFSET ((2060 * 2) - 1) +define OFLAG_OFFSET ((2061 * 2) - 1) +define SMODE_OFFSET ((2062 * 2) - 1) +define UT_OFFSET ((2063 * 2) - 1) +define ST_OFFSET ((2065 * 2) - 1) +define BEAM_OFFSET ((2067 * 2) - 1) +define HA_OFFSET ((2068 * 2) - 1) +define RA_OFFSET ((2071 * 2) - 1) +define DEC_OFFSET ((2074 * 2) - 1) +define DRA_OFFSET ((2077 * 2) - 1) +define DDEC_OFFSET ((2078 * 2) - 1) +define LABEL_OFFSET ((2079 * 2) - 1) diff --git a/noao/mtlocal/idsmtn/lut.com b/noao/mtlocal/idsmtn/lut.com new file mode 100644 index 00000000..0a67bbd8 --- /dev/null +++ b/noao/mtlocal/idsmtn/lut.com @@ -0,0 +1,6 @@ +# Common block for look up tables used by idsmtn format reader. These tables +# are used to evaluate each byte of both integer and floating point varian +# numbers. They are initialized in t_ridsmtn.x. + +int neg_lut6[256], neg_lut7[256], neg_lut8[256] +common /lut/neg_lut6, neg_lut7, neg_lut8 diff --git a/noao/mtlocal/idsmtn/mkpkg b/noao/mtlocal/idsmtn/mkpkg new file mode 100644 index 00000000..afef1186 --- /dev/null +++ b/noao/mtlocal/idsmtn/mkpkg @@ -0,0 +1,14 @@ +# Ridsmtn Library + +$checkout libpkg.a ../ +$update libpkg.a +$checkin libpkg.a ../ +$exit + +libpkg.a: + wkeywords.x idsmtn.h <mach.h> <imhdr.h> + rvarian.x idsmtn.h <mach.h> <error.h> powersof2.com lut.com + redflags.x idsmtn.h <mach.h> + t_ridsmtn.x idsmtn.h <mach.h> <imhdr.h> <error.h> <fset.h> \ + powersof2.com lut.com + ; diff --git a/noao/mtlocal/idsmtn/powersof2.com b/noao/mtlocal/idsmtn/powersof2.com new file mode 100644 index 00000000..1128f9e1 --- /dev/null +++ b/noao/mtlocal/idsmtn/powersof2.com @@ -0,0 +1,6 @@ +# Common block for look up tables used by idsmtn format reader. This table +# contains powers of 2 used to reassemble floating point numbers. It is +# initialized in t_ridsmtn.x. + +double tbl[255] +common /po2/tbl diff --git a/noao/mtlocal/idsmtn/redflags.x b/noao/mtlocal/idsmtn/redflags.x new file mode 100644 index 00000000..90c91a39 --- /dev/null +++ b/noao/mtlocal/idsmtn/redflags.x @@ -0,0 +1,97 @@ +include <mach.h> +include "idsmtn.h" + +define RED_FLAG_OFFSET 3 # Byte offset (starts at bit 17) +define DF_ORD_OFFSET 9 # Byte offset to df order value (bit 65) +define DFB 4 # Number of bytes per DF coefficient +define FIRST_BYTE 13 + +# REDUCTION_FLAGS -- Extract and interpret the reduction flags found in +# the IDS header. 9 flags are used: DF, SM, QF, DC, QD, EX, BS, CA, CO. +# Each flag is represented by a single bit in a varian 16-bit integer. +# If a flag is set, it's value = 0; unset flags = -1. If the QF flag is +# set, the order of the fitting polynomial must be unpacked. If the DF +# flag is set, the order of the fitting polynomial as well as the +# coefficients must be unpacked from the header. The location of the +# coefficients depends on the order of the fit. + +procedure reduction_flags (vn, ids) + +int vn[ARB] # Input buffer of IDS record - one byte per int +pointer ids # Pointer to ids header structure + +int flag_word, offset, byte_offset, op +real rtemp, tmp[MAX_NCOEFF] +errchk vn_rred + +begin + # Initialize flags to -1 + DF_FLAG(ids) = -1 + SM_FLAG(ids) = -1 + QF_FLAG(ids) = -1 + DC_FLAG(ids) = -1 + QD_FLAG(ids) = -1 + EX_FLAG(ids) = -1 + BS_FLAG(ids) = -1 + CA_FLAG(ids) = -1 + CO_FLAG(ids) = -1 + + # Unpack the flag_word from the header and determine flags. If a + # flag_bit is set, the corresponding flag is true and set = 0. + + flag_word = vn[RED_FLAG_OFFSET] * (2 ** 8) + vn[RED_FLAG_OFFSET+1] + + if (and (flag_word, 40B) != 0) + CO_FLAG(ids) = 0 + + if (and (flag_word, 100B) != 0) + CA_FLAG(ids) = 0 + + if (and (flag_word, 200B) != 0) + BS_FLAG(ids) = 0 + + if (and (flag_word, 400B) != 0) + EX_FLAG(ids) = 0 + + if (and (flag_word, 1000B) != 0) + QD_FLAG(ids) = 0 + + if (and (flag_word, 2000B) != 0) + DC_FLAG(ids) = 0 + + if (and (flag_word, 4000B) != 0) + # The qf_flag is set equal to the degree of the fitting polynomial. + # This value is stored in the lowest 5-bits of the flag word. + QF_FLAG(ids) = and (flag_word, 37B) + + if (and (flag_word, 10000B) != 0) + SM_FLAG(ids) = 0 + + # The df_flag is interpreted next: + if (and (flag_word, 20000B) != 0) { + # The degree of the fitting polynomial is written in 2wrd_vn_fp at + # the location of the first data pixel. The df_flag is set equal + # to the integer value of the polynomial degree. + + call vn_rred (vn, DF_ORD_OFFSET, rtemp, 1) + DF_FLAG(ids) = int (rtemp) + + # Now to unpack the coefficients. The coefficients have been + # written over pixels at the beginning and end of the IDS scan. + # The number and location of the overwritten pixels depends on + # the order of fit and values of NP1 and NP2. + + do op = 1, DF_FLAG(ids) { + offset = op + if (offset >= NP1(ids)) + # This coefficient must be stored at the end of scan + offset = offset + NP2(ids) - NP1(ids) + + byte_offset = FIRST_BYTE + ((offset - 1) * DFB) + call vn_rred (vn, byte_offset, tmp[op], 1) + } + + # Copy decoded coefficients into structure + call amovr (tmp, Memr[COEFF(ids)], DF_FLAG(ids)) + } +end diff --git a/noao/mtlocal/idsmtn/ridsmtn.semi b/noao/mtlocal/idsmtn/ridsmtn.semi new file mode 100644 index 00000000..3131837b --- /dev/null +++ b/noao/mtlocal/idsmtn/ridsmtn.semi @@ -0,0 +1,94 @@ +# T_RIDSMTN -- Semicode for the IDS mountain format tape reader. IDS +# records in raw or mountain reduced format can be read into a series of +# one dimensional IRAF images. The first record on each mtn tape is a +# dummy record and is ignored. Each IDS header is read and compared +# against the "record_numbers" list. Depending on the user's request, +# the header can be printed in long or short form, an IRAF image can +# be written and the pixel values listed. All IDS records are in a +# single file; an EOF implies EOT. Procedure terminates when EOF is +# encountered or all requested records havs been read. + +procedure t_ridsmtn (ids_file, iraf_file) + +begin + get control parameters from cl + if (output image is to be made) + get root output name + + fd = open input file + + while (all requested records haven't been read) { + + # Code has been revised to accomodate the apparent fact that + # the data matrix is imbedded in the header information. The + # entire record (header + data) is now read in at one time. + + if (read (fd, ids_record, length_of_record) == EOF) + quit + else { + current_record = unpack current record from buffer + if (current_record is to be read) + call idsm_read_record (ids_record, header_struct, cp_struct) + } + } +end + + +# IDSM_READ_RECORD -- is called once for each IDS record that appears in +# the "record_numbers" range. The header is printed and the IDS pixels +# converted, printed or skipped depending on user request. + +procedure idsm_read_record (ids_record, header_struct, control_param) + +begin + stat = idsm_read_header (ids_record, header_struct) + if (stat == DUMMY) { + report dummy record encountered + return + } + call idsm_print_header (header_struct, long_header) + + if (make_image or print_pixels == YES) { + # First unpack pixels into a pixel buffer + if (reduced data) + call red_ids_unpk (fd, pixels) + else + call raw_ids_unpk (fd, pixels) + + if (output image is to be written) { + generate output filename + call idsm_write_image (pixels, data_type, out_fname, + header_struct) + } + + if (pixels values are to be listed) + call isdm_print_pixels (pixels) + +end + + +# IDSM_READ_HEADER -- Read an IDS header and fill the program data +# structure with header values. Returns DUMMY or OK. + +int procedure idsm_read_header (ids_buffer, header_structure) + +begin + unpack header words into header structure + if record is DUMMY record + return (DUMMY) + else + return (OK) +end + + +# IDSM_WRITE_IMAGE -- Write a one dimensional IRAF image of an IDS record. + +procedure idsm_write_image (pixels, data_type, out_fname, header_struct) + +begin + map output image + + move pixel_buffer into row vector + + store IDS header values in image user area +end diff --git a/noao/mtlocal/idsmtn/rvarian.x b/noao/mtlocal/idsmtn/rvarian.x new file mode 100644 index 00000000..ebfd7c4b --- /dev/null +++ b/noao/mtlocal/idsmtn/rvarian.x @@ -0,0 +1,126 @@ +include <error.h> +include <mach.h> +include "idsmtn.h" + +# UNPK_VN_ID -- Unpack an ID string from an array of FORTH ascii characters, +# one 7-bit character per byte. The first byte contains the character +# count for the string. + +procedure unpk_vn_id (varian, offset, output_string) + +int varian[ARB] # Array with one byte per int +int offset # Word offset to first character to be unpacked +char output_string[SZ_IDS_ID] # Output array - one character per element + +pointer sp, id +int nchars_id + +begin + call smark (sp) + nchars_id = min (varian[offset], SZ_IDS_ID-1) + call salloc (id, nchars_id, TY_CHAR) + + call achtic (varian[offset+1], Memc[id], nchars_id) + call strcpy (Memc[id], output_string, nchars_id) + + call sfree (sp) +end + + +# VN_RRAW -- Read Varian long (32-bit) integers from a packed bit array. +# Raw pixels are written as Varian long integers. Each pixel is +# 32-bits with bit 1 least significant, bit 16 unused and bit 32 the +# sign bit. The bits are extracted and reassembled to form a real array of +# IDS pixels, one pixel per array element. + +procedure vn_rraw (varian, offset, pixels, nwords) + +int varian[ARB] # Pointer to array of packed IDS record +int offset # Word offset to first word to unpack +real pixels[nwords] # Output array of unpacked IDS pixels +int nwords # Number of values to unpack + +int ip, op, bytes[4], int_value + +include "lut.com" + +begin + ip = offset + for (op = 1; op <= nwords; op = op + 1) { + + call amovi (varian[ip], bytes, 4) + + if (bytes[1] < 127) + int_value = bytes[4] + (bytes[3] * (2 ** 8)) + (bytes[2] * + (2 ** 15)) + (bytes[1] * (2 ** 23)) + else { + bytes[1] = neg_lut8[bytes[1]] * (2 ** 23) + bytes[2] = neg_lut8[bytes[2]] * (2 ** 15) + bytes[3] = neg_lut7[bytes[3]] * (2 ** 8) + bytes[4] = neg_lut8[bytes[4]] + int_value = -1 * (bytes[1] + bytes[2] + bytes[3] + bytes[4] + 1) + } + + pixels[op] = real (int_value) + ip = ip + 4 + } +end + + +# VN_RRED -- Read 32-bit floating point pixels from a packed bit array. +# The values are written in special (Jan Schwitters) 2 word Varian floating +# point. Reduced pixels are written in this format. + +procedure vn_rred (varian, offset, pixels, nwords) + +int varian[ARB] # Array of packed varian values +int offset # Word offset to first value to unpack +real pixels[nwords] # Output array of unpacked values +int nwords # Number of values to unpack + +int ip, op, mantissa, exp, bytes[4] + +include "lut.com" +include "powersof2.com" + +begin + ip = offset + + do op = 1, nwords { + + call amovi (varian[ip], bytes, 4) + + if (mod (bytes[1], 2) == 0) + mantissa = bytes[4] + (bytes[3] * (2**8)) + (bytes[2] * (2**15)) + else { + bytes[4] = neg_lut8[bytes[4]] + bytes[3] = neg_lut7[bytes[3]] * (2 ** 8) + bytes[2] = neg_lut8[bytes[2]] * (2 ** 15) + mantissa = -1 * (bytes[4] + bytes[3] + bytes[2] + 1) + } + + # Divide out mantissa sign bit + exp = bytes[1]/2 + if (bytes[1] > 127) + exp = -1 * (neg_lut6[exp] + 1) + + # Reconstruct the floating point number as a SPP real. Powers of + # two are stored in the tbl[] array where 2 ** n = tbl[n + 129]. + # The mantissa is divided by 2 ** 23 to move the binary point + # above bit 23. + + exp = exp + 129 - 23 + + if (exp <= 0) + pixels[op] = 0.0 + + else if (exp > 255) + pixels[op] = MAX_REAL + + else if (exp > 0 && exp <= 255) + pixels[op] = real (mantissa) * tbl [exp] + + # Increment the input pointer for the next word to be unpacked + ip = ip + 4 + } +end diff --git a/noao/mtlocal/idsmtn/t_ridsmtn.x b/noao/mtlocal/idsmtn/t_ridsmtn.x new file mode 100644 index 00000000..2956ba84 --- /dev/null +++ b/noao/mtlocal/idsmtn/t_ridsmtn.x @@ -0,0 +1,523 @@ +include <error.h> +include <fset.h> +include <mach.h> +include <imhdr.h> +include "idsmtn.h" + +# T_RIDSMTN -- Code for the IDS mountain format tape reader. IDS +# records in raw or mountain reduced format can be read into a series of +# one dimensional IRAF images. The first record on each mtn tape is a +# dummy record and is ignored. Each IDS header is read and compared +# against the "record_numbers" list. Depending on the user's request, +# the header can be printed in long or short form, an IRAF image can created. +# +# Modified 6May85 to key off the IIDS header parameters NP1 and NP2 +# to copy to the output image only the pixels indicated. + +procedure t_ridsmtn () + +pointer sp, cp, ids, vnb +char ids_file[SZ_PATHNAME], rec_numbers[SZ_LINE] +int file_number, records[3, MAX_RANGES], nrecs, nrecs_read, fd +int unp1, unp2, i, sz_buffer + +bool clgetb(), is_in_range() +char clgetc() +int clgeti(), mtopen(), decode_ranges(), read() +int get_data_type(), btoi(), mtfile(), mtneedfileno() + +include "lut.com" +include "powersof2.com" + +begin + # Allocate space for the control parameter descriptor structure + # and the program data structure + + call smark (sp) + call salloc (cp, LEN_CP, TY_STRUCT) + call salloc (ids, LEN_IDS, TY_STRUCT) + + # Initialize look up tables used to decode bytes of varian data. + do i = 0, 255 { + neg_lut6[i] = and (not (i), 77B) + neg_lut7[i] = and (not (i), 177B) + neg_lut8[i] = and (not (i), 377B) + } + + # Initialize powers of 2 table used to assemble floating point numbers. + do i = 1, 255 + tbl[i] = 2.0D0 ** double (i - 129) + + # Get parameters from the cl and generate the input file name. If + # the input file is a general tape device, append the file_number suffix + + call clgstr ("ids_file", ids_file, SZ_FNAME) + if (mtfile(ids_file) == YES) { + if (mtneedfileno (ids_file) == YES) { + file_number = clgeti ("file_number") + call mtfname (ids_file, file_number, ids_file, SZ_FNAME) + } + } + + IS_REDUCED(cp) = btoi (clgetb ("reduced_data")) + LONG_HEADER(cp) = btoi (clgetb ("long_header")) + PRINT_PIXELS(cp) = btoi (clgetb ("print_pixels")) + call clgstr ("record_numbers", rec_numbers, SZ_LINE) + if (decode_ranges (rec_numbers, records, MAX_RANGES, nrecs) == ERR) + call error (1, "Error in record_numbers specifications") + + # If an output image is to be written, get output data type and + # root output data type. + + MAKE_IMAGE(cp) = btoi (clgetb ("make_image")) + if (MAKE_IMAGE(cp) == YES) { + call clgstr ("iraf_file", IRAF_FILE(cp), SZ_FNAME) + OFFSET(cp) = clgeti ("offset") + DATA_TYPE(cp) = get_data_type (clgetc ("data_type")) + if (DATA_TYPE(cp) == ERR) + DATA_TYPE(cp) = TY_REAL + + unp1 = clgeti ("np1") + unp2 = clgeti ("np2") + } + + fd = mtopen (ids_file, READ_ONLY, 0) + sz_buffer = SZB_IDS_RECORD / SZB_CHAR + if (mtfile (ids_file) == YES) + sz_buffer = sz_buffer + 64 + + # Allocate input buffer in units of integers + call salloc (vnb, sz_buffer * SZ_INT, TY_INT) + + nrecs_read = 0 + while (nrecs_read < nrecs) { + + # Read IDS record into buffer. Unpack bytes into integer array. + if (read (fd, Memi[vnb], sz_buffer) == EOF) { + call printf ("IDS tape at End of File\n") + break + } else { + call achtbi (Memi[vnb], Memi[vnb], SZB_IDS_RECORD) + call vn_int_to_int (Memi[vnb], 1, NREC(ids)) + + iferr { + if (is_in_range (records, NREC(ids))) { + nrecs_read = nrecs_read + 1 + call idsm_read_record (Memi[vnb], cp, ids, unp1,unp2) + call flush (STDOUT) + } + } then { + call erract (EA_WARN) + next + } + } + } + + call sfree (sp) + call close (fd) +end + + +# IDSM_READ_RECORD -- is called once for each IDS record that appears in +# the "record_numbers" range. The header is printed and the IDS pixels +# converted or skipped, depending on user request. + +procedure idsm_read_record (vnb, cp, ids, unp1, unp2) + +int vnb[ARB] # Buffer of unpacked IDS record - one byte/int +pointer cp # Pointer to control parameter data structure +pointer ids # Pointer to program data structure +int unp1, unp2 # End points of the spectrum + +pointer sp, pixels +char out_fname[SZ_FNAME] +int stat +int strlen(), idsm_read_header() +errchk idsm_read_header, idsm_write_image, bswap4, vn_rraw +errchk vn_rred, salloc, malloc + +begin + # Allocate space on stack for pixel buffers + call smark (sp) + call salloc (pixels, NPIX_IDS_REC, TY_REAL) + call malloc (COEFF(ids), MAX_NCOEFF, TY_REAL) + + iferr (stat = idsm_read_header (vnb, ids)) { + call mfree (COEFF(ids), TY_REAL) + call sfree (sp) + call erract (EA_WARN) + return + } + + if (stat == DUMMY) { + call printf ("Dummy IDS record encountered\n") + call mfree (COEFF(ids), TY_REAL) + call sfree (sp) + return + } else + call idsm_print_header (ids, LONG_HEADER(cp)) + + if (MAKE_IMAGE(cp) == YES || PRINT_PIXELS(cp) == YES) { + + if (IS_REDUCED(cp) == YES) + call vn_rred (vnb, DATA_BYTE, Memr[pixels], NPIX_IDS_REC) + else + call vn_rraw (vnb, DATA_BYTE, Memr[pixels], NPIX_IDS_REC) + + if (MAKE_IMAGE(cp) == YES) { + call strcpy (IRAF_FILE(cp), out_fname, SZ_FNAME) + call sprintf (out_fname[strlen(out_fname)+1], SZ_FNAME, ".%04d") + call pargi (NREC(ids) + OFFSET(cp)) + iferr { + call idsm_write_image (Memr[pixels], DATA_TYPE(cp), + IS_REDUCED(cp), out_fname, ids, unp1, unp2) + } then { + call mfree (COEFF(ids), TY_REAL) + call sfree (sp) + call erract (EA_WARN) + return + } + } + + if (PRINT_PIXELS(cp) == YES) + call idsm_print_pixels (Memr[pixels], NP2(ids)) + + } + call mfree (COEFF(ids), TY_REAL) + call sfree (sp) +end + + +# IDSM_READ_HEADER -- Read an IDS header and fill the program data +# structure with header values. Returns EOF or OK. + +int procedure idsm_read_header (varian, ids) + +int varian[ARB] # Buffer of unpack varian record - one byte/int +pointer ids # Pointer to program data structure + +errchk vn_int_to_int, vn_long_to_int, vn_gdouble, reduction_flags +errchk unpk_vn_id + +begin + # The following header words are written as Varian single word + # integers. + + call vn_int_to_int (varian, NREC_OFFSET, NREC(ids)) + + if (NREC(ids) == 0) + # DUMMY IDS record encountered + return (DUMMY) + + call vn_int_to_int (varian, NP1_OFFSET, NP1(ids)) + call vn_int_to_int (varian, NP2_OFFSET, NP2(ids)) + call vn_int_to_int (varian, OFLAG_OFFSET, OFLAG(ids)) + call vn_int_to_int (varian, SMODE_OFFSET, SMODE(ids)) + call vn_int_to_int (varian, BEAM_OFFSET, BEAM(ids)) + call vn_int_to_int (varian, DRA_OFFSET, DRA(ids)) + call vn_int_to_int (varian, DDEC_OFFSET, DDEC(ids)) + + # Now unpack Varian double word integers into integers. + call vn_long_to_int (varian, ITM_OFFSET, ITM(ids)) + call vn_long_to_int (varian, UT_OFFSET, UT(ids)) + call vn_long_to_int (varian, ST_OFFSET, ST(ids)) + + # Now unpack those header words written in Varian 3 word floating point. + call vn_gdouble (varian, W0_OFFSET, W0(ids)) + call vn_gdouble (varian, WPC_OFFSET, WPC(ids)) + call vn_gdouble (varian, HA_OFFSET, HA(ids)) + call vn_gdouble (varian, RA_OFFSET, RA(ids)) + call vn_gdouble (varian, DEC_OFFSET, DEC(ids)) + + # Extract and interpret the 9 reduction flags + call reduction_flags (varian, ids) + + # Unpack the IDS label + call unpk_vn_id (varian, LABEL_OFFSET, LABEL(ids)) + + return (OK) +end + + +# VN_INT_TO_INT -- Unpack a single integer value from a char buffer containing +# packed varian short (16-bit) integers. The number of the word containing +# the value of interest is passed as an argument. + +procedure vn_int_to_int (inbuf, offset, int_value) + +int inbuf[ARB] # Unpacked IDS record +int offset # WORD offset as read from tape +int int_value # Integer value returned + +int bytes[2] + +include "lut.com" + +begin + call amovi (inbuf[offset], bytes, 2) + if (bytes[1] < 127) + int_value = (bytes[1] * (2 ** 8)) + bytes[2] + else { + bytes[1] = neg_lut8[bytes[1]] * (2 ** 8) + bytes[2] = neg_lut8[bytes[2]] + int_value = -1 * (bytes[1] + bytes[2] + 1) + } +end + + +# VN_LONG_TO_INT -- Unpack a SPP integer from a buffer containing packed +# varian long (32-bit) intgers. + +procedure vn_long_to_int (inbuf, offset, int_value) + +int inbuf[ARB] # Buffer containing unpacked varian longs one byte/int +int offset # Byte offset to field to be unpacked +int int_value # Integer value returned + +int bytes[4] + +include "lut.com" + +begin + call amovi (inbuf[offset], bytes, 4) + + if (bytes[1] < 127) + int_value = bytes[4] + (bytes[3] * (2 ** 8)) + (bytes[2] * + (2 ** 15)) + (bytes[1] * (2 ** 23)) + else { + bytes[1] = neg_lut8[bytes[1]] + (2 ** 23) + bytes[2] = neg_lut8[bytes[2]] + (2 ** 15) + bytes[3] = neg_lut7[bytes[3]] + (2 ** 8) + bytes[4] = neg_lut8[bytes[4]] + int_value = -1 * (bytes[1] + bytes[2] + bytes[3] + bytes[4] + 1) + } +end + + +# VN_GDOUBLE -- Unpack a SPP double from a buffer containing packed +# varian 3-word (48-bit) floating point numbers. + +procedure vn_gdouble (inbuf, offset, dbl_value) + +int inbuf[ARB] # Buffer of unpacked varian 3wrd reals 1 byte/int +int offset # Word offset to value to be unpacked +double dbl_value # Double value returned + +int bytes[6], exp, mantissa + +include "lut.com" +include "powersof2.com" + +begin + call amovi (inbuf[offset], bytes, 6) + + if (bytes[3] > 127) { + bytes[6] = neg_lut8[bytes[6]] + bytes[5] = neg_lut7[bytes[5]] * (2 ** 8) + bytes[4] = neg_lut8[bytes[4]] * (2 ** 15) + bytes[3] = neg_lut6[bytes[3]] * (2 ** 23) + mantissa = -1 * (bytes[6] + bytes[5] + bytes[4] + bytes[3] + 1) + } else + mantissa = bytes[6] + (bytes[5] * (2 ** 8)) + (bytes[4] * + (2 ** 15)) + (bytes[3] * (2 ** 23)) + + if (bytes[1] > 127) { + bytes[1] = neg_lut8[bytes[1]] * (2 ** 8) + bytes[2] = neg_lut8[bytes[2]] + exp = -1 * (bytes[1] + bytes[2] + 1) + } else + exp = bytes[2] + (bytes[1] * (2 ** 8)) + + # Reconstruct the floating point number as a SPP real. Powers of + # two are stored in the tbl[] array where 2 ** n = tbl[n+129]. + # The mantissa is divided by 2 ** 29 to move the binary point + # above bit 29. + + exp = exp + 129 - 29 + + if (exp <= 0) + dbl_value = 0.0D0 + else if (exp > 255) + dbl_value = double (MAX_REAL) + else if (exp > 0 && exp <= 255) + dbl_value = double (mantissa) * tbl[exp] +end + + +# IDSM_WRITE_IMAGE -- Write a one dimensional IRAF image of an IDS record. + +procedure idsm_write_image (pixels, data_type, is_reduced, out_fname, + ids, unp1, unp2) + +real pixels[ARB] # Array of unpacked IDS pixels +int data_type # Data type of output pixels +int is_reduced # Is data in reduced format? +char out_fname[SZ_FNAME] # Filename of output IRAF image +pointer ids # Pointer to program data structure +int unp1, unp2 # Pixel endpoints of spectrum + +int pix1, pix2, npts, temp +pointer im +pointer immap(), impl1r() +errchk immap, amovr, idsm_store_keywords, impl1r, imunmap + +begin + # Map new IRAF image and set up image header + im = immap (out_fname, NEW_IMAGE, LEN_USER_AREA) + IM_NDIM(im) = 1 + + # Select the pixels to be written out. + # When the data is in reduced format, write out the + # entire vector. + # + # If the user parameter is zero, use the header elements. + # On some IRS tapes, these parameters are backwards. + + if (NP1(ids) > NP2(ids)) { + temp = NP1(ids) + NP1(ids) = NP2(ids) + NP2(ids) = temp + } + + if (is_reduced == YES) { + pix1 = 1 + pix2 = NPIX_IDS_REC + + } else { + + if (unp1 == 0) + pix1 = NP1(ids) + 1 + else + pix1 = unp1 + + if (unp2 == 0) + pix2 = NP2(ids) + else + pix2 = unp2 + } + + npts = pix2 - pix1 + 1 + + NP1(ids) = 0 + NP2(ids) = npts + + IM_LEN(im, 1) = npts + call strcpy (LABEL(ids), IM_TITLE(im), SZ_IMTITLE) + IM_PIXTYPE(im) = data_type + + # Move pixel_buffer into image row vector + call amovr (pixels[pix1], Memr[impl1r(im)], npts) + + # Write IDS specific header words to IRAF image header + # Update W0 for possible new starting pixel + + W0(ids) = W0(ids) + double (pix1 - 1) * WPC(ids) + + call idsm_store_keywords (ids, im) + + call imunmap (im) +end + + +# IDSM_PRINT_HEADER -- print the ids header in either long or short mode. This +# procedure has been slightly modified from the version used in ridsfile or +# RIDSOUT. + +procedure idsm_print_header (ids, long_header) + +pointer ids # Pointer to program data structure +int long_header # Print header in long format (YES/NO)? +int i + +begin + if (long_header == YES) { + call printf ("\nRECORD = %d, label = \"%s\",\n") + call pargi (NREC(ids)) + call pargstr (LABEL(ids)) + + if (OFLAG(ids) == 1) { + call printf ("oflag = OBJECT, beam_number = %d,") + call pargi (BEAM(ids)) + } else { + call printf ("oflag = SKY, beam_number = %d,") + call pargi (BEAM(ids)) + } + + call printf (" W0 = %0.3f,") + call pargd (W0(ids)) + call printf (" WPC = %0.3f, ITM = %d,\n") + call pargd (WPC(ids)) + call pargi (ITM(ids)) + call printf ("NP1 = %d, NP2 = %d,") + call pargi (NP1(ids)) + call pargi (NP2(ids)) + call printf (" UT = %h, ST = %h,") + call pargr (UT(ids) / 3600.) + call pargr (ST(ids) / 3600.) + call printf (" HA = %h,\n") + call pargd (HA(ids)) + call printf ("RA = %h, DEC = %h,") + call pargd (RA(ids)) + call pargd (DEC(ids)) + if (DRA(ids) != 0 || DDEC(ids) != 0) { + call printf (" DRA = %g, DDEC = %g,\n") + call pargr (DRA(ids) / 100.) + call pargr (DDEC(ids) / 100.) + } else + call printf ("\n") + call printf ("df = %d, sm = %d, qf = %d, dc = %d, qd = %d, ") + call pargi (DF_FLAG(ids)) + call pargi (SM_FLAG(ids)) + call pargi (QF_FLAG(ids)) + call pargi (DC_FLAG(ids)) + call pargi (QD_FLAG(ids)) + call printf ("ex = %d, bs = %d, ca = %d, co = %d") + call pargi (EX_FLAG(ids)) + call pargi (BS_FLAG(ids)) + call pargi (CA_FLAG(ids)) + call pargi (CO_FLAG(ids)) + + # The df coeffecients are printed out in the case where the df + # flag has been set. + + if (DF_FLAG(ids) != -1) { + call printf (",\n") + do i = 1, DF_FLAG(ids) { + call printf ("df[%d] = %10.8g") + call pargi(i) + call pargr(Memr[COEFF(ids)+i-1]) + if (i != DF_FLAG(ids)) + call printf (", ") + if (mod (i, 4) == 0) + call printf ("\n") + } + } else + call printf ("\n") + call printf ("\n") + } else { + call printf ("RECORD = %d, label = \"%.45s\", ITM = %d\n") + call pargi (NREC(ids)) + call pargstr (LABEL(ids)) + call pargi (ITM(ids)) + } +end + + +# IDSM_PRINT_PIXELS -- Print the ids pixel values. + +procedure idsm_print_pixels (pixel_buf, nvalues) + +real pixel_buf[ARB] # Buffer containing pixels to be listed +int nvalues # Number of pixel values to print +int n_pix + +begin + for (n_pix = 1; n_pix < nvalues; n_pix = n_pix + 4) { + call printf ("%10.4e %10.4e %10.4e %10.4e\n") + call pargr (pixel_buf[n_pix]) + call pargr (pixel_buf[n_pix + 1]) + call pargr (pixel_buf[n_pix + 2]) + call pargr (pixel_buf[n_pix + 3]) + } + call printf ("\n") +end diff --git a/noao/mtlocal/idsmtn/wkeywords.x b/noao/mtlocal/idsmtn/wkeywords.x new file mode 100644 index 00000000..12e41245 --- /dev/null +++ b/noao/mtlocal/idsmtn/wkeywords.x @@ -0,0 +1,90 @@ +include <mach.h> +include <imhdr.h> +include "idsmtn.h" + +define COL_VALUE 11 +define LEN_KEYWORD 8 +define LEN_OBJECT 65 +define LEN_CARD 80 + +# IDSM_STORE_KEYWORDS -- store IDS specific keywords in the IRAF image header. + +procedure idsm_store_keywords (ids, im) + +pointer ids # Pointer to program data structure +pointer im # Pointer to image + +char keyword[LEN_KEYWORD] +int fd, i, nrp +bool fp_equalr() +int stropen() +real value +errchk stropen, addcard_i, addcard_r, addcard_st + +begin + # Open image user area as a file. + fd = stropen (Memc[IM_USERAREA(im)], LEN_USER_AREA - 1, NEW_FILE) + + # FITS keyword are formatted and appended to the image user + # area with the addcard procedures. + + call addcard_i (fd, "RECORD", NREC(ids), "IDS record") + call addcard_i (fd, "EXPOSURE", ITM(ids), "Exposure time (seconds)") + call addcard_i (fd, "OFLAG", OFLAG(ids), "Object flag") + + call addcard_i (fd, "BEAM-NUM", BEAM(ids), "Beam number") + + value = real (W0(ids)) + nrp = NDIGITS_RP + call addcard_r (fd, "W0", value, "Starting wavelength", nrp) + + value = real (WPC(ids)) + call addcard_r (fd, "WPC", value, "Wavelength per channel", nrp) + + call addcard_i (fd, "NP1", NP1(ids), "Left plot limit") + + call addcard_i (fd, "NP2", NP2(ids), "Right plot limit") + + value = real (UT(ids) / 3600.) + call addcard_time (fd, "UT", value, "Universal time") + + value = real (ST(ids)/ 3600.) + call addcard_time (fd, "ST", value, "Sidereal time") + + value = real (RA(ids)) + call addcard_time (fd, "RA", value, "Right ascension") + + value = real (DEC(ids)) + call addcard_time (fd, "DEC", value, "Declination") + + value = real (HA(ids)) + call addcard_time (fd, "HA", value, "Hour angle") + + # The 9 reduction flags + call addcard_i (fd, "DF-FLAG", DF_FLAG(ids), "Dispersion flag") + call addcard_i (fd, "SM-FLAG", SM_FLAG(ids), "Smoothing flag") + call addcard_i (fd, "QF-FLAG", QF_FLAG(ids), "Quartz fit flag") + call addcard_i (fd, "DC-FLAG", DC_FLAG(ids), "Dispersion corrected") + call addcard_i (fd, "QD-FLAG", QD_FLAG(ids), "Quartz division flag") + call addcard_i (fd, "EX-FLAG", EX_FLAG(ids), "Extinction flag") + call addcard_i (fd, "BS-FLAG", BS_FLAG(ids), "Beam switch flag") + call addcard_i (fd, "CA-FLAG", CA_FLAG(ids), "Calibration flag") + call addcard_i (fd, "CO-FLAG", CO_FLAG(ids), "Coincidence flag") + + # The df coeffecients are written out in the case where the df + # flag is set, and the first coefficient is nonzero. (The later + # condition is a test for IDSOUT data, where the df coeffecients + # have been applied but not stored in the header.) + + if (DF_FLAG(ids) != -1 && (! fp_equalr (Memr[COEFF(ids)], 0.))) { + call strcpy ("DF", keyword, LEN_KEYWORD) + do i = 1, DF_FLAG(ids) { + call sprintf (keyword[3], LEN_KEYWORD, "%s") + call pargi (i) + call addcard_r (fd, keyword, Memr[COEFF(ids)+i-1], "", nrp) + } + } + + # call strclose (fd) + call close (fd) +end diff --git a/noao/mtlocal/ldumpf.par b/noao/mtlocal/ldumpf.par new file mode 100644 index 00000000..88765745 --- /dev/null +++ b/noao/mtlocal/ldumpf.par @@ -0,0 +1,4 @@ +#LDUMPF parameters +dumpf_file,f,a,mta,,,DUMPF data source +file_list,s,a,,,,file list +mode, s,h,ql,,, diff --git a/noao/mtlocal/lib/addcards.x b/noao/mtlocal/lib/addcards.x new file mode 100644 index 00000000..6c650578 --- /dev/null +++ b/noao/mtlocal/lib/addcards.x @@ -0,0 +1,138 @@ +define MAXLEN_STRVAL 65 +define LEN_KEYWORD 8 +define LEN_STRING 18 + +# ADDCARD_R -- Format and append a FITS header card with a real +# keyword value to the input string buffer. + +procedure addcard_r (fd, keyword, value, comment, precision) + +int fd # File descriptor of input string buffer +char keyword[LEN_KEYWORD] # 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.*g / %-45.45s\n") + call pargstr (keyword) + call pargi (precision) + call pargr (value) + call pargstr (comment) +end + + +# ADDCARD_I -- Format and append a FITS header card with an integer +# keyword value to the input string buffer. + +procedure addcard_i (fd, keyword, value, comment) + +int fd # File descriptor of input string buffer +char keyword[LEN_KEYWORD] # FITS keyword +int value # Value of FITS keyword +char comment[ARB] # Comment string + +begin + call fprintf (fd, "%-8.8s= %20d / %-45.45s\n") + call pargstr (keyword) + call pargi (value) + call pargstr (comment) +end + + +# ADDCARD_TIME -- Format and append a FITS header card to the input +# file descriptor. The value is input as a real number; it is output +# in HH:MM:SS.S format with %h. The procedure can be used for RA, DEC +# and ST, UT and HA. + +procedure addcard_time (fd, keyword, value, comment) + +int fd # File descriptor +char keyword[LEN_KEYWORD] # FITS keyword +real value # Value of FITS keyword to be encoded +char comment[ARB] # Comment string + + +begin + call fprintf (fd, "%-8.8s= '%-18.1h' / %-45s\n") + call pargstr (keyword) + call pargr (value) + call pargstr (comment) +end + + +# ADDCARD_ST -- Format and output a FITS header card to the input +# file descriptor. The value is output as a string with the given keyword. +# If the string value is longer than 18 characters, it is output without +# a comment. + +procedure addcard_st (fd, keyword, value, comment, length) + +int fd # File descriptor +char keyword[LEN_KEYWORD] # FITS keyword +char value[SZ_LINE] # String value of FITS keyword to be encoded +char comment[ARB] # Comment string +int length # Length of string value + +begin + if (length <= LEN_STRING) { + call fprintf (fd, "%-8.8s= '%-18.18s' / %-45s\n") + call pargstr (keyword) + call pargstr (value) + call pargstr (comment) + } else { + length = min (length, MAXLEN_STRVAL) + call fprintf (fd, "%-8.8s= '%*.*s' /\n") + call pargstr (keyword) + call pargi (-length) + call pargi (length) + call pargstr (value) + } +end + + +# ADDCARD_B -- Format and output a FITS header card to the input file +# descriptor. The value is output as a boolean with the given keyword. +# Unlike string parameters, booleans are not enclosed in quotes. + +procedure addcard_b (fd, keyword, value, comment) + +int fd # File descriptor +char keyword[LEN_KEYWORD] # FITS keyword +bool value # Boolean parameter (T/F) +char comment[ARB] # Comment string +char truth + +begin + if (value) + truth = 'T' + else + truth = 'F' + + call fprintf (fd, "%-8.8s= %20c / %-45.45s\n") + call pargstr (keyword) + call pargc (truth) + call pargstr (comment) +end + + +# ADDCARD_D -- Format and append a FITS header card with a double +# keyword value to the input string buffer. + +procedure addcard_d (fd, keyword, value, comment, precision) + +int fd # File descriptor of input string buffer +char keyword[LEN_KEYWORD] # FITS keyword +double value # Value of FITS keyword +char comment[ARB] # Comment string +int precision # Number of decimal places output + + +begin + call fprintf (fd, "%-8.8s= %20.*g / %-45.45s\n") + call pargstr (keyword) + call pargi (precision) + call pargd (value) + call pargstr (comment) +end diff --git a/noao/mtlocal/lib/cyboow.x b/noao/mtlocal/lib/cyboow.x new file mode 100644 index 00000000..65459a44 --- /dev/null +++ b/noao/mtlocal/lib/cyboow.x @@ -0,0 +1,47 @@ +# CYBOOW, CYBOEW -- Order the bits in an odd or even indexed 60-bit Cyber word. +# The operation may not be performed in-place. The offsets and sizes of the +# bit segments which must be moved are as follows: +# +# --> Odd Words <-- --> Even Words <-- +# [from] [to] [nbits] +# 1 53 8 -3 57 4 +# 9 45 8 5 49 8 +# 17 37 8 13 41 8 +# 25 29 8 21 33 8 +# 33 21 8 29 25 8 +# 41 13 8 37 17 8 +# 49 5 8 45 9 8 +# 61 1 4 53 1 8 +# +# Input bit-offsets must be a multiple of the Cyber word size, i.e., 1, 61, +# 121, etc. An output word may begin at any bit-offset. + + +# CYBOOW -- Order odd cyber word. After swapping the first 8 bytes of IN the +# ordered 60-bit Cyber word is in bits 5-64 of the temporary storage area at W. + +procedure cyboow (in, inbit, out, outbit) + +int in[ARB] +int inbit +int out[ARB] +int outbit + +begin + call error (1, "Cyber readers have not been implemented") +end + + +# CYBOEW -- Order even cyber word. After swapping the 8 bytes the ordered +# Cyber word will be found in bits 1-60 of the temporary storage area at W. + +procedure cyboew (in, inbit, out, outbit) + +int in[ARB] +int inbit +int out[ARB] +int outbit + +begin + call error (1, "Cyber readers have not been implemented") +end diff --git a/noao/mtlocal/lib/getdatatype.x b/noao/mtlocal/lib/getdatatype.x new file mode 100644 index 00000000..46bea060 --- /dev/null +++ b/noao/mtlocal/lib/getdatatype.x @@ -0,0 +1,55 @@ +define NTYPES 9 + +# GETDATATYPE -- Convert a character to an IRAF data type + +int procedure getdatatype (ch) + +char ch +int i, type_code[NTYPES] +int stridx() + +string types "bcusilrdx" # Supported data types +data type_code /TY_UBYTE, TY_CHAR, TY_USHORT, TY_SHORT, TY_INT, TY_LONG, + TY_REAL, TY_DOUBLE, TY_COMPLEX/ + +begin + i = stridx (ch, types) + if (i == 0) + return (ERR) + else + return (type_code[stridx(ch,types)]) +end + + +# DTSTRING -- Convert a datatype to a string + +procedure dtstring (datatype, str, maxchar) + +int datatype # IRAF datatype +char str[maxchar] # Output string +int maxchar # Maximum characters in string + +begin + switch (datatype) { + case TY_UBYTE: + call strcpy ("unsigned byte", str, maxchar) + case TY_CHAR: + call strcpy ("character", str, maxchar) + case TY_USHORT: + call strcpy ("unsigned short", str, maxchar) + case TY_SHORT: + call strcpy ("short", str, maxchar) + case TY_INT: + call strcpy ("integer", str, maxchar) + case TY_LONG: + call strcpy ("long", str, maxchar) + case TY_REAL: + call strcpy ("real", str, maxchar) + case TY_DOUBLE: + call strcpy ("double", str, maxchar) + case TY_COMPLEX: + call strcpy ("complex", str, maxchar) + default: + call strcpy ("unknown", str, maxchar) + } +end diff --git a/noao/mtlocal/lib/mkpkg b/noao/mtlocal/lib/mkpkg new file mode 100644 index 00000000..da0cc863 --- /dev/null +++ b/noao/mtlocal/lib/mkpkg @@ -0,0 +1,13 @@ +# These routines are used by more than one task in the dataio package: + +$checkout libpkg.a ../ +$update libpkg.a +$checkin libpkg.a ../ +$exit + +libpkg.a: + cyboow.x + ranges.x <mach.h> <ctype.h> + getdatatype.x + addcards.x + ; diff --git a/noao/mtlocal/lib/ranges.x b/noao/mtlocal/lib/ranges.x new file mode 100644 index 00000000..9b2cfa1f --- /dev/null +++ b/noao/mtlocal/lib/ranges.x @@ -0,0 +1,232 @@ +include <mach.h> +include <ctype.h> + +define FIRST 1 # Default starting range +define LAST MAX_INT # Default ending range +define STEP 1 # Default step + +# DECODE_RANGES -- Parse a string containing a list of integer numbers or +# ranges, delimited by either spaces or commas. Return as output a list +# of ranges defining a list of numbers, and the count of list numbers. +# Range limits must be positive nonnegative integers. ERR is returned as +# the function value if a conversion error occurs. The list of ranges is +# delimited by a single NULL. + +int procedure decode_ranges (range_string, ranges, max_ranges, nvalues) + +char range_string[ARB] # Range string to be decoded +int ranges[3, max_ranges] # Range array +int max_ranges # Maximum number of ranges +int nvalues # The number of values in the ranges + +int ip, nrange, first, last, step, ctoi() + +begin + ip = 1 + nvalues = 0 + + do nrange = 1, max_ranges - 1 { + # Defaults to all positive integers + first = FIRST + last = LAST + step = STEP + + # Skip delimiters + while (IS_WHITE(range_string[ip]) || range_string[ip] == ',') + ip = ip + 1 + + # Get first limit. + # Must be a number, '-', 'x', or EOS. If not return ERR. + if (range_string[ip] == EOS) { # end of list + if (nrange == 1) { + # Null string defaults + ranges[1, 1] = first + ranges[2, 1] = last + ranges[3, 1] = step + ranges[1, 2] = NULL + nvalues = nvalues + abs (last-first) / step + 1 + return (OK) + } else { + ranges[1, nrange] = NULL + return (OK) + } + } else if (range_string[ip] == '-') + ; + else if (range_string[ip] == 'x') + ; + else if (IS_DIGIT(range_string[ip])) { # ,n.. + if (ctoi (range_string, ip, first) == 0) + return (ERR) + } else + return (ERR) + + # Skip delimiters + while (IS_WHITE(range_string[ip]) || range_string[ip] == ',') + ip = ip + 1 + + # Get last limit + # Must be '-', or 'x' otherwise last = first. + if (range_string[ip] == 'x') + ; + else if (range_string[ip] == '-') { + ip = ip + 1 + while (IS_WHITE(range_string[ip]) || range_string[ip] == ',') + ip = ip + 1 + if (range_string[ip] == EOS) + ; + else if (IS_DIGIT(range_string[ip])) { + if (ctoi (range_string, ip, last) == 0) + return (ERR) + } else if (range_string[ip] == 'x') + ; + else + return (ERR) + } else + last = first + + # Skip delimiters + while (IS_WHITE(range_string[ip]) || range_string[ip] == ',') + ip = ip + 1 + + # Get step. + # Must be 'x' or assume default step. + if (range_string[ip] == 'x') { + ip = ip + 1 + while (IS_WHITE(range_string[ip]) || range_string[ip] == ',') + ip = ip + 1 + if (range_string[ip] == EOS) + ; + else if (IS_DIGIT(range_string[ip])) { + if (ctoi (range_string, ip, step) == 0) + ; + } else if (range_string[ip] == '-') + ; + else + return (ERR) + } + + # Output the range triple. + ranges[1, nrange] = first + ranges[2, nrange] = last + ranges[3, nrange] = step + nvalues = nvalues + abs (last-first) / step + 1 + } + + return (ERR) # ran out of space +end + + +# GET_NEXT_NUMBER -- Given a list of ranges and the current file number, +# find and return the next file number. Selection is done in such a way +# that list numbers are always returned in monotonically increasing order, +# regardless of the order in which the ranges are given. Duplicate entries +# are ignored. EOF is returned at the end of the list. + +int procedure get_next_number (ranges, number) + +int ranges[ARB] # Range array +int number # Both input and output parameter + +int ip, first, last, step, next_number, remainder + +begin + # If number+1 is anywhere in the list, that is the next number, + # otherwise the next number is the smallest number in the list which + # is greater than number+1. + + number = number + 1 + next_number = MAX_INT + + for (ip=1; ranges[ip] != NULL; ip=ip+3) { + first = min (ranges[ip], ranges[ip+1]) + last = max (ranges[ip], ranges[ip+1]) + step = ranges[ip+2] + if (number >= first && number <= last) { + remainder = mod (number - first, step) + if (remainder == 0) + return (number) + if (number - remainder + step <= last) + next_number = number - remainder + step + } else if (first > number) + next_number = min (next_number, first) + } + + if (next_number == MAX_INT) + return (EOF) + else { + number = next_number + return (number) + } +end + + +# GET_PREVIOUS_NUMBER -- Given a list of ranges and the current file number, +# find and return the previous file number. Selection is done in such a way +# that list numbers are always returned in monotonically decreasing order, +# regardless of the order in which the ranges are given. Duplicate entries +# are ignored. EOF is returned at the end of the list. + +int procedure get_previous_number (ranges, number) + +int ranges[ARB] # Range array +int number # Both input and output parameter + +int ip, first, last, step, next_number, remainder + +begin + # If number-1 is anywhere in the list, that is the previous number, + # otherwise the previous number is the largest number in the list which + # is less than number-1. + + number = number - 1 + next_number = 0 + + for (ip=1; ranges[ip] != NULL; ip=ip+3) { + first = min (ranges[ip], ranges[ip+1]) + last = max (ranges[ip], ranges[ip+1]) + step = ranges[ip+2] + if (number >= first && number <= last) { + remainder = mod (number - first, step) + if (remainder == 0) + return (number) + if (number - remainder >= first) + next_number = number - remainder + } else if (last < number) { + remainder = mod (last - first, step) + if (remainder == 0) + next_number = max (next_number, last) + else if (last - remainder >= first) + next_number = max (next_number, last - remainder) + } + } + + if (next_number == 0) + return (EOF) + else { + number = next_number + return (number) + } +end + + +# IS_IN_RANGE -- Test number to see if it is in range. + +bool procedure is_in_range (ranges, number) + +int ranges[ARB] # Range array +int number # Number to be tested against ranges + +int ip, first, last, step + +begin + for (ip=1; ranges[ip] != NULL; ip=ip+3) { + first = min (ranges[ip], ranges[ip+1]) + last = max (ranges[ip], ranges[ip+1]) + step = ranges[ip+2] + if (number >= first && number <= last) + if (mod (number - first, step) == 0) + return (true) + } + + return (false) +end diff --git a/noao/mtlocal/mkpkg b/noao/mtlocal/mkpkg new file mode 100644 index 00000000..8de9058b --- /dev/null +++ b/noao/mtlocal/mkpkg @@ -0,0 +1,29 @@ +# Make the MTLOCAL package. + +$call relink +$exit + +update: + $call relink + $call install + ; + +relink: + $set LIBS = "-lxtools" + $update libpkg.a + $omake x_mtlocal.x + $link x_mtlocal.o libpkg.a $(LIBS) -o xx_mtlocal.e + ; + +install: + $move xx_mtlocal.e noaobin$x_mtlocal.e + ; + +libpkg.a: + @lib + @idsmtn + @cyber + @camera + @pds + @r2df + ; diff --git a/noao/mtlocal/mtlocal.cl b/noao/mtlocal/mtlocal.cl new file mode 100644 index 00000000..ed80269d --- /dev/null +++ b/noao/mtlocal/mtlocal.cl @@ -0,0 +1,19 @@ +dataio + +#{ The MTLOCAL special format NOAO tape reader package. + +package mtlocal + +task rcamera, + rpds, + rrcopy, + rdumpf, + ldumpf, + r2df, + ridsout, + ridsfile, + ridsmtn = "mtlocal$x_mtlocal.e" + +task widstape = "onedspec$irsiids/x_onedspec.e" + +clbye() diff --git a/noao/mtlocal/mtlocal.hd b/noao/mtlocal/mtlocal.hd new file mode 100644 index 00000000..0f0648d1 --- /dev/null +++ b/noao/mtlocal/mtlocal.hd @@ -0,0 +1,21 @@ +# Help directory for the MTLOCAL package. + +$doc = "noao$mtlocal/doc/" +$camera = "noao$mtlocal/camera/" +$pds = "noao$mtlocal/pds/" +$cyber = "noao$mtlocal/cyber/" +$rrcopy = "noao$mtlocal/cyber/rrcopy/" +$idsmtn = "noao$mtlocal/idsmtn/" +$r2df = "noao$mtlocal/r2df/" + +ldumpf hlp=doc$ldumpf.hlp, src=cyber$t_ldumpf.x +r2df hlp=doc$r2df.hlp, src=r2df$t_r2df.x +rcamera hlp=doc$rcamera.hlp, src=camera$t_rcamera.x +rdumpf hlp=doc$rdumpf.hlp, src=cyber$t_rdumpf.x +ridsfile hlp=doc$ridsfile.hlp, src=cyber$t_ridsfile.x +ridsmtn hlp=doc$ridsmtn.hlp, src=idsmtn$t_ridsmtn.x +ridsout hlp=doc$ridsout.hlp, src=cyber$t_ridsout.x +rpds hlp=doc$rpds.hlp, src=pds$t_rpds.x +rrcopy hlp=doc$rrcopy.hlp, src=rrcopy$t_rrcopy.x +widstape hlp=doc$widstape.hlp, src=onedspec$t_widstape.x +revisions sys=Revisions diff --git a/noao/mtlocal/mtlocal.men b/noao/mtlocal/mtlocal.men new file mode 100644 index 00000000..fcb8f641 --- /dev/null +++ b/noao/mtlocal/mtlocal.men @@ -0,0 +1,10 @@ + ldumpf - List the permanent files on a Cyber DUMPF tape + r2df - Convert a CTIO 2-d frutti image into an IRAF image + rcamera - Convert a CAMERA image into an IRAF image + rdumpf - Convert IPPS rasters from a DUMPF tape to IRAF images + ridsfile - Convert IDSFILES from a DUMPF tape to IRAF images + ridsmtn - Convert mountain format IDS/IRS data to IRAF images + ridsout - Convert a text file in IDSOUT format to IRAF images + rpds - Convert a PDS image into an IRAF image + rrcopy - Convert IPPS rasters from an RCOPY tape to IRAF images + widstape - Convert ONEDSPEC spectra to IDSOUT text format diff --git a/noao/mtlocal/mtlocal.par b/noao/mtlocal/mtlocal.par new file mode 100644 index 00000000..ff362077 --- /dev/null +++ b/noao/mtlocal/mtlocal.par @@ -0,0 +1,4 @@ +# Dummy package parameter file. + +version,s,h,"26Apr86" +mode,s,h,ql diff --git a/noao/mtlocal/pds/README b/noao/mtlocal/pds/README new file mode 100644 index 00000000..f10ad9c4 --- /dev/null +++ b/noao/mtlocal/pds/README @@ -0,0 +1 @@ +The code for the PDS reader. diff --git a/noao/mtlocal/pds/mkpkg b/noao/mtlocal/pds/mkpkg new file mode 100644 index 00000000..d24534ad --- /dev/null +++ b/noao/mtlocal/pds/mkpkg @@ -0,0 +1,14 @@ +# Pdsread library + +$checkout libpkg.a ../ +$update libpkg.a +$checkin libpkg.a ../ +$exit + +libpkg.a: + t_pdsread.x rpds.com <fset.h> <error.h> + pds_read.x rpds.com rpds.h <imhdr.h> <error.h> + pds_rimage.x rpds.com rpds.h <imhdr.h> <mach.h> + pds_rheader.x rpds.com rpds.h <imhdr.h> <mii.h> <mach.h> + pds_rpixels.x rpds.com rpds.h <mii.h> <mach.h> + ; diff --git a/noao/mtlocal/pds/pds_read.x b/noao/mtlocal/pds/pds_read.x new file mode 100644 index 00000000..0cba96d7 --- /dev/null +++ b/noao/mtlocal/pds/pds_read.x @@ -0,0 +1,71 @@ + +include <error.h> +include <imhdr.h> +include "rpds.h" + +# PDS_READ -- Convert a PDS file +# An EOT is signalled by returning EOF. + +int procedure pds_read (pdsfile, iraffile) + +char pdsfile[ARB], iraffile[ARB] +int pds_fd +int stat +long parameters[LEN_PAR_ARRAY] +pointer im + +int pds_read_header(), mtopen() +pointer immap() + +errchk salloc, pds_read_header, pds_read_image, mtopen, immap, imdelete + +include "rpds.com" + +begin + # Open input PDS data + pds_fd = mtopen (pdsfile, READ_ONLY, 0) + + 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 (pdsfile) + } + 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, 0) + + # Read header. EOT is signalled by an EOF status from pds_read_header. + iferr { + stat = pds_read_header (pds_fd, im, parameters) + if (stat == EOF) + call printf ("End of data\n") + else { + # Create an IRAF image if desired + if (make_image == YES) + call pds_read_image (pds_fd, im, parameters) + } + } then + call erract (EA_WARN) + + if (long_header == YES) + call printf ("\n") + + # Close files and clean up + call imunmap (im) + if (stat == EOF || make_image == NO) + call imdelete (iraffile) + call close (pds_fd) + + return (stat) +end diff --git a/noao/mtlocal/pds/pds_rheader.x b/noao/mtlocal/pds/pds_rheader.x new file mode 100644 index 00000000..5032d987 --- /dev/null +++ b/noao/mtlocal/pds/pds_rheader.x @@ -0,0 +1,234 @@ +include <imhdr.h> +include <mii.h> +include <mach.h> +include "rpds.h" + +# PDS_READ_HEADER -- Read a PDS header. EOT is detected by an EOF on the +# first read and EOF is returned to the calling routine. Errors are +# passed to the calling routine. + +int procedure pds_read_header (pds_fd, im, parameters) + +int pds_fd +pointer im +long parameters[LEN_PAR_ARRAY] + +int nchars, sz_header, header[LEN_PDS_HEADER] +short temptext[LEN_PDS_TEXT] +char text[LEN_PDS_TEXT] + +int read(), pds_roundup() +short pds_unpacks() +long pds_unpackl() + +errchk read, miiupk + +include "rpds.com" + +begin + # Read the header record + sz_header = pds_roundup (LEN_PDS_HEADER, SZB_CHAR) / SZB_CHAR + nchars = read (pds_fd, header, sz_header) + if (nchars == EOF) + return (EOF) + else if (nchars != sz_header) + call error (1, "Error reading pds header.") + + # Unpack ID string, convert to ASCII and copy to image header + call miiupk (header, temptext, LEN_PDS_TEXT, MII_SHORT, TY_SHORT) + call pds_apdp8s (temptext, temptext, LEN_PDS_TEXT) + call pds_apdp059 (temptext, text, LEN_PDS_TEXT) + text[LEN_PDS_TEXT + 1] = EOS + call strcpy (text, TITLE(im), SZ_TITLE) + + # Unpack the remainder of the header + # If XCOORD or YCOORD are greater than TWO_TO_23 convert to + # -ve number using TWO_TO_24 + + P_DX(parameters) = DX(header) + P_DY(parameters) = DY(header) + P_NPTS_PER_SCAN(parameters) = NPTS_PER_SCAN(header) + P_NSCANS(parameters) = NSCANS(header) + P_SCANTYPE(parameters) = SCANTYPE(header) + P_SCANSPEED(parameters) = SCANSPEED(header) + P_SCANORIGIN(parameters) = SCANORIGIN(header) + P_CORNER(parameters) = CORNER(header) + P_NRECS_PER_SCAN(parameters) = NRECS_PER_SCAN(header) + P_XTRAVEL(parameters) = XTRAVEL(header) + P_YTRAVEL(parameters) = YTRAVEL(header) + P_NPTS_PER_REC(parameters) = NPTS_PER_REC(header) + P_XCOORD(parameters) = XCOORD(header) + if (P_XCOORD(parameters) >= TWO_TO_23) + P_XCOORD(parameters) = P_XCOORD(parameters) - TWO_TO_24 + P_YCOORD(parameters) = YCOORD(header) + if (P_YCOORD(parameters) >= TWO_TO_23) + P_YCOORD(parameters) = P_YCOORD(parameters) - TWO_TO_24 + + # Write parameters to header + CT_VALID(im) = NO + NAXIS(im) = 2 + NCOLS(im) = P_NPTS_PER_SCAN(parameters) + NLINES(im) = P_NSCANS(parameters) + + # print the header + call pds_print_header (text, parameters) + + return (OK) +end + +# PDS_UNPACKS -- Procedure to unpack a short header value. +# The header value is stored in the integer array buffer, beginning +# at byte number offset. The value is unpacked into a temporary +# buffer, temp and converted to SPP format using the mii routines. +# Finally the PDS 10 or 12 bit bytes are converted to an SPP short value. + +short procedure pds_unpacks (buffer, offset) + +int buffer[ARB], offset + +short value[1] +long temp[1] +errchk miiupk, miiupk + +begin + call bytmov (buffer, offset, temp, 1, SZB_MIISHORT) + call miiupk (temp, value[1], 1, MII_SHORT, TY_SHORT) + call pds_apdp8s (value[1], value[1], 1) + return (value[1]) +end + +# PDS_UNPACKL -- Procedure to unpack a 24 bit long header value. + +long procedure pds_unpackl (buffer, offset) + +int buffer[ARB], offset + +short temps[2] +long temp[1], value[1] +errchk miiupk, bytmov + +begin + call bytmov (buffer, offset, temp, 1, SZB_MIILONG) + call miiupk (temp, temps, 2, MII_SHORT, TY_SHORT) + call pds_apdp8s (temps, temps, 2) + value[1] = temps[1] * 10000b + temps[2] + return (value[1]) +end + +# PDS_APDP8S -- Precedure to change a 12 or 10 bit PDP8 value to a short integer +# value. + +procedure pds_apdp8s (a, b, npix) + +short a[npix], b[npix] +int npix + +int i + +begin + for (i=1; i <= npix; i = i + 1) + b[i] = (a[i] / 400b) * 100b + mod (int (a[i]), 400b) +end + +# PDS_APDP059 -- Procedure to convert PDP 059 code into ASCII + +procedure pds_apdp059 (a, b, nchar) + +char b[nchar] +int nchar +short a[nchar] + +int i, j +char table[LEN_TABLE] + +# Conversion table from PDS 059 code to ASCII +data table/ ' ', ' ', ' ', ' ', '$', ' ', ' ', '"', '(', ')', + '*', '+', ',', '-', '.', '/', '0', '1', '2', '3', + '4', '5', '6', '7', '8', '9', ' ', ' ', ' ', '=', + ' ', ' ', ' ', 'A', 'B', 'C', 'D', 'E', 'F', 'G', + 'H', 'I', 'J', 'K', 'L', 'M', 'N', 'O', 'P', 'Q', + 'R', 'S', 'T', 'U', 'V', 'W', 'X', 'Y', 'Z', ' ', + ' ', ' ', ' ', ' ', ' ', 'a', 'b', 'c', 'd', 'e', + 'f', 'g', 'h', 'i', 'j', 'k', 'l', 'm', 'n', 'o', + 'p', 'q', 'r', 's', 't', 'u', 'v', 'w', 'x', 'y', + 'z', ' ', ' ', ' ', ' ', ' ', EOS/ + +begin + for (i = 1; i <= nchar; i = i + 1) + b[i] = a[i] - 159 + + for (i = 1; i <= nchar; i = i + 1) { + j = b[i] + if (j < 1 || j > LEN_TABLE) + j = 1 + b[i] = table[j] + } +end + + + +# PDS_PRINT_HEADER -- Procedure to print the header. + +procedure pds_print_header (text, parameters) + +char text[LEN_PDS_TEXT] +long parameters[LEN_PAR_ARRAY] + +include "rpds.com" + +begin + if (long_header == YES) + call pds_long_header (text, parameters) + if (short_header == YES && long_header == NO) { + call printf ("ID: %.30s ") + call pargstr (text) + call printf ("size =%d * %d \n") + call pargl (P_NPTS_PER_SCAN(parameters)) + call pargl (P_NSCANS(parameters)) + } +end + +# PDS_LONG_HEADER -- Print a long header + +procedure pds_long_header (text, parameters) + +char text[LEN_PDS_TEXT] +long parameters[LEN_PAR_ARRAY] + +begin + call printf ("ID:%s\n") + call pargstr (text) + call printf ("NPTS = %d ") + call pargl (P_NPTS_PER_SCAN(parameters)) + call printf ("NSCANS = %d ") + call pargl (P_NSCANS(parameters)) + call printf ("NRECS/SCAN = %d ") + call pargl (P_NRECS_PER_SCAN(parameters)) + call printf ("PPERR = %d\n") + call pargl (P_NPTS_PER_REC(parameters)) + call printf ("SCANTYPE = %s ") + if (P_SCANTYPE(parameters) == RASTER) + call pargstr ("RASTER") + else if (P_SCANTYPE(parameters) == EDGE) + call pargstr ("EDGE") + else + call pargstr ("FLIPPED") + call printf ("SCANSPEED = %d ") + call pargl (P_SCANSPEED(parameters)) + call printf ("SCANORIGIN = %d ") + call pargl (P_SCANORIGIN(parameters)) + call printf ("CORNER = %d\n") + call pargl (P_CORNER(parameters)) + call printf ("DX = %d ") + call pargl (P_DX(parameters)) + call printf ("XTRAVEL = %d ") + call pargl (P_XTRAVEL(parameters)) + call printf ("XCOORD = %d\n") + call pargl (P_XCOORD(parameters)) + call printf ("DY = %d ") + call pargl (P_DY(parameters)) + call printf ("YTRAVEL = %d ") + call pargl (P_YTRAVEL(parameters)) + call printf ("YCOORD = %d\n") + call pargl (P_YCOORD(parameters)) +end diff --git a/noao/mtlocal/pds/pds_rimage.x b/noao/mtlocal/pds/pds_rimage.x new file mode 100644 index 00000000..13fd6309 --- /dev/null +++ b/noao/mtlocal/pds/pds_rimage.x @@ -0,0 +1,74 @@ + +include <imhdr.h> +include <mach.h> +include "rpds.h" + + +# PDS_READ_IMAGE -- Read PDS image pixels to IRAF image file + +procedure pds_read_image (pds_fd, im, parameters) + +int pds_fd +pointer im +long parameters[LEN_PAR_ARRAY] + +short linemin, linemax +int i, nlines +pointer buf +long v[IM_MAXDIM] + +int pds_init_read_scan(), pds_read_scan(), impnls() +long clktime() + +errchk impnls, pds_init_read_scan, pds_read_scan + +include "rpds.com" + +begin + call pds_set_image_header (im) + + if (NAXIS(im) == 0) + return + + IRAFMAX(im) = -MAX_REAL + IRAFMIN(im) = MAX_REAL + + call amovkl (long(1), v, IM_MAXDIM) + + nlines = NLINES(im) + + # PDS data is converted to type SHORT. + i= pds_init_read_scan (parameters) + + do i = 1, nlines { + if (impnls (im, buf, v) == EOF) + call error (3, "Error writing PDS data") + if (pds_read_scan (pds_fd, Mems[buf]) != NCOLS(im)) + call error (4, "Error reading PDS data") + call alims (Mems[buf], NCOLS(im), linemin, linemax) + IRAFMAX(im) = max (IRAFMAX(im), real (linemax)) + IRAFMIN(im) = min (IRAFMIN(im), real (linemin)) + } + + LIMTIME(im) = clktime (long(0)) +end + + +# PDS_SET_IMAGE_HEADER -- Set remaining header fields not set in read_header. + +procedure pds_set_image_header (im) + +pointer im + +include "rpds.com" + +begin + # Set IRAF image pixel type + if (data_type == ERR) { + if (BITPIX <= SZ_SHORT * SZB_CHAR * NBITS_BYTE) + IM_PIXTYPE(im) = TY_SHORT + else + IM_PIXTYPE(im) = TY_LONG + } else + IM_PIXTYPE(im) = data_type +end diff --git a/noao/mtlocal/pds/pds_rpixels.x b/noao/mtlocal/pds/pds_rpixels.x new file mode 100644 index 00000000..2f3371d4 --- /dev/null +++ b/noao/mtlocal/pds/pds_rpixels.x @@ -0,0 +1,182 @@ +include <mii.h> +include <mach.h> +include "rpds.h" + +# PDS_INIT_READ_SCAN -- A single PDS scan consists of one or more physical +# records. Each scan begins with a 10 byte scan start parameter. +# A "full" record will contain p_npts_per_rec data points, usually +# set equal to 2000. The last record may be short. +# If the number of records per scan is 1, the first record +# may also be shorter than p_npts_per_record. +# If the input tape is 7 track the actual number of points on the tape +# is rounded up to an integral multiple of 5. +# The input parameters of the procedure are an array of parameters of +# type long which are derived from the PDS header. The routine +# calculates the sizes of the records in chars, allocates the space +# required to hold the record buffer, and initializes the line count. + +# PDS_READ_SCAN -- Reads an entire PDS scan a record at a time. This procedure +# uses the MII unpack routine which is machine dependent. The bitpix +# must correspond to an MII type. The routine returns the number of +# data points per scan or EOF. READ_SCAN converts the 12 or 10 bit data +# values to short integers and flips every other scan if the PDS scan +# is a raster scan. + +int procedure pds_init_read_scan (parameters) + +long parameters[LEN_PAR_ARRAY] # array of header parameters + +# entry pds_read_scan (fd, scanbuf) + +int pds_read_scan() +int fd +short scanbuf[1] + +int maxbufsize, len_mii, linecount, temp +int npts_first, npts_full, npts_last +int sz_first, sz_full, sz_last +int p_npts_per_rec, p_npts_per_scan, p_nrecs_per_scan, p_scantype +int nrec, op, nchars +pointer mii + +int miilen(), pds_roundup(), read() + +errchk miilen, malloc, mfree, miiupk, read + +data mii/NULL/ + +include "rpds.com" + +begin + # Allocate sufficient space for the largest record in a scan + # Rounding up if the recordsize is not an integral number of chars. + + p_nrecs_per_scan = P_NRECS_PER_SCAN(parameters) + p_npts_per_scan = P_NPTS_PER_SCAN(parameters) + p_npts_per_rec = P_NPTS_PER_REC(parameters) + p_scantype = P_SCANTYPE(parameters) + temp = p_nrecs_per_scan + + maxbufsize = pds_roundup (SCANSTART + 2*p_npts_per_rec, SZB_CHAR) + maxbufsize = pds_roundup (maxbufsize, 2) / 2 + len_mii = miilen (maxbufsize, MII_SHORT) + if (mii != NULL) + call mfree (mii, TY_INT) + call malloc (mii, len_mii, TY_INT) + + # Calculate the number of data points, and the number of chars + # in a first, full and last record rounding up if the record is + # not an integral number of chars + + linecount = 1 + npts_first = min (p_npts_per_scan, p_npts_per_rec) + if (ninetrack == NO) { + sz_first = pds_roundup (npts_first, SCANSTART/2) + sz_first = pds_roundup (2*sz_first + SCANSTART, SZB_CHAR) / SZB_CHAR + } else + sz_first = pds_roundup (2*npts_first + SCANSTART, + SZB_CHAR) / SZB_CHAR + npts_full = p_npts_per_rec + sz_full = pds_roundup (npts_full*2, SZB_CHAR) / SZB_CHAR + npts_last = mod (p_npts_per_scan, p_npts_per_rec) + if (ninetrack == NO) { + sz_last = pds_roundup (npts_last, SCANSTART/2) + sz_last = pds_roundup (2*sz_last, SZB_CHAR) / SZB_CHAR + } else + sz_last = pds_roundup (2*npts_last, SZB_CHAR) / SZB_CHAR + + return (OK) + +entry pds_read_scan (fd, scanbuf) + + op = 1 + + # Loop over the number of records in a scan + do nrec = 1, temp { + + # Get 1st record, remove the 10 bytes containing the scan start + # parameter, and unpack the data. + if (nrec == 1) { + nchars = read (fd, Memi[mii], sz_first) + if (nchars == EOF) + return (EOF) + else if (nchars < sz_first) + call error (6, "Short record encountered.") + call bytmov (Memi[mii], SCANSTART + 1, Memi[mii], 1, + npts_first*2) + call miiupk (Memi[mii], scanbuf[op], npts_first, + MII_SHORT, TY_SHORT) + op = op + npts_first + + # Get last record which may be short + } else if (nrec == p_nrecs_per_scan) { + nchars = read (fd, Memi[mii], sz_last) + if (nchars == EOF) + return (EOF) + else if (nchars < sz_last) + call error (6, "Short record encountered.") + call miiupk (Memi[mii], scanbuf[op], npts_last, + MII_SHORT, TY_SHORT) + op = op + npts_last + + # Get a full record + } else { + nchars = read (fd, Memi[mii], sz_full) + if (nchars == EOF) + return (EOF) + else if ( nchars < sz_full) + call error (6, "Short record encountered.") + call miiupk (Memi[mii], scanbuf[op], npts_full, + MII_SHORT, TY_SHORT) + op = op + npts_full + } + } + + # Convert PDS 10 or 12 bit values to short SPP values + call pds_apdp8s (scanbuf, scanbuf, p_npts_per_scan) + + # If the image is a raster scan flip every other line + if (p_scantype == RASTER && mod (linecount, 2) == 0) + call pds_aflips (scanbuf, p_npts_per_scan) + + linecount = linecount + 1 + return (op - 1) +end + + +# PDS_AFLIPS -- Procedure to flip a short vector in place + +procedure pds_aflips (buf, npix) + +short buf[npix] +int npix + +int n_total, n_half, i, j + +begin + n_half = npix/2 + n_total = npix + 1 + for (i=1; i <= n_half; i = i + 1) { + j = buf[i] + buf[i] = buf[n_total - i] + buf[n_total - i] = j + } +end + + +# PDS_ROUNDUP -- Procedure to round an integer to the next highest number +# divisible by base. + +int procedure pds_roundup (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/pds/rpds.com b/noao/mtlocal/pds/rpds.com new file mode 100644 index 00000000..ef62e4fa --- /dev/null +++ b/noao/mtlocal/pds/rpds.com @@ -0,0 +1,13 @@ +# PDS reader common + +int data_type # Output data type + +# Option flags +int make_image # Create an IRAF image +int long_header # Print a long PDSheader +int short_header # Print a short header (Title and size) +int tenbit # Specify tenbit data +int ninetrack # Specify ninetrack tape + +common /pdsreadcom/ data_type, make_image, long_header, short_header, tenbit, + ninetrack diff --git a/noao/mtlocal/pds/rpds.doc b/noao/mtlocal/pds/rpds.doc new file mode 100644 index 00000000..b2a3f244 --- /dev/null +++ b/noao/mtlocal/pds/rpds.doc @@ -0,0 +1,83 @@ + PDSREAD (dataio) PDS Reader PDSREAD (dataio) + + + +NAME + pdsread -- Convert Kitt Peak PDS image files to IRAF image files + + +USAGE + pds [pds_file, file_list, iraf_file] + + +DESCRIPTION + Kitt Peak PDS format image data is read from the specified source, + either a disk file or magnetic tape. The PDS header may + optionally be printed on the standard output as either a full + listing or a short description. Image data may optionally be + converted to an IRAF image of specified data type. + + +PARAMETERS + + pds_file + The PDS data source. If the data source is a disk file or an + explict tape file specification of the form mt*[n] where n is + a file number then only that file is converted. If the + general tape device name is given, i.e. mta, mtb800, etc, + then the files specified by the files parameter will be read + from the tape. + + file_list + The files to be read from a tape are specified by the + file_list string. The string can consist of any sequence of + file numbers separated by at least one of whitespace, comma, + or dash. A dash specifies a range of files. For example the + string + + 1 2, 3 - 5,8-6 + + will convert the files 1 through 8. + + iraf_file + The IRAF file which will receive the PDS data if the + read_image parameter switch is set. For tape files specified + by the file_list parameter the filename will be used as a + prefix and the file number will be appended. Otherwise, the + file will be named as specified. Thus, reading files 1 and 3 + from a PDS tape with a filename of data will produce the + files data1 and data3. It is legal to use a null filename. + + read_image + This switch determines whether PDS image data is converted to + + + -1- + PDSREAD (dataio) PDS Reader PDSREAD (dataio) + + + + an IRAF image file. This switch is set to no to obtain just + header information with the long_header or short_header + switches. + + long_header + If this switch is set the full PDS header is printed on the + standard output. + + short_header + If this switch is set only the output filename, the title + string, and the image dimensions are printed. + + standard_format + The PDS standard format has the most significant byte first. + + data_type + The IRAF image file may be of a different data type than the + PDS image data. The data type may be specified as s for + short, l for long, and r for real. The user must beware of + truncation problems if an inappropriate data type is + specified. If an incorrect data_type or a null string is + given for this parameter then a default data type is used + which is the appropriate minimum size for the input pixel + values. diff --git a/noao/mtlocal/pds/rpds.h b/noao/mtlocal/pds/rpds.h new file mode 100644 index 00000000..33c7c673 --- /dev/null +++ b/noao/mtlocal/pds/rpds.h @@ -0,0 +1,88 @@ + +# PDS Definitions + +# The PDS standard readable by the PDS reader: +# +# 1. 8 bits / byte +# 2. 6 bits of data / byte +# 3. high order byte is first +# 4. first 80 bytes are an id string in 059 code containing 40 characters +# 12 bits per character +# 5. remaining 40 bytes contain short and long parameter values +# +# A user specified flag allows selecting most significant byte format + +define BITPIX 16 # Number of bits per PDS data value +define PDS_BYTE 8 # Number of bits per PDS byte +define LEN_PDS_TEXT 40 # Length of PDS text in characters +define LEN_PDS_HEADER 120 # Length of PDS header in bytes +define LEN_TABLE 96 # Length of 059 to ASCII table +define LEN_PAR_ARRAY 14 # Length of paramter array +define SZB_MIISHORT 2 # Number of bytes in an MII short +define SZB_MIILONG 4 # Number of bytes in an MII long + +# Mapping of PDS Parameters to IRAF image header + +define NAXIS IM_NDIM($1) # Number of image dimensions +define NCOLS IM_LEN($1, 1) # Number of pixels in first dimension +define NLINES IM_LEN($1, 2) # Number of pixels in second dimension +define TITLE IM_TITLE($1) +define SZ_TITLE SZ_IMTITLE + +# define the IRAF coordinate tranformation parameters + +define CRVAL CT_CRVAL(IM_CTRAN($1), $2) +define CRPIX CT_CRPIX(IM_CTRAN($1), $2) +define CDELT CT_CDELT(IM_CTRAN($1), $2) +define CROTA CT_CROTA(IM_CTRAN($1), $2) +define CTYPE CT_CTYPE(IM_CTRAN($1)) + +# define remaining IRAF header parameters + +define IRAFMAX IM_MAX($1) +define IRAFMIN IM_MIN($1) +define LIMTIME IM_LIMTIME($1) +define PIXTYPE IM_PIXTYPE($1) + +# define scan types +define RASTER 210 +define EDGE 197 +define FLIPPED 198 + +# define the octal constants for conversion of signed parameters +define TWO_TO_23 40000000b +define TWO_TO_24 100000000b + +# define the byte offsets for the header parameters +define DX pds_unpacks ($1,81) # Delta x in microns of scan +define DY pds_unpackl ($1,83) # Delta y in microns of scan +define NPTS_PER_SCAN pds_unpackl ($1,87) # Number of scans +define NSCANS pds_unpacks ($1,91) # Number of scans +define SCANTYPE pds_unpacks ($1,93) # Edge, flipped or raster +define SCANSPEED pds_unpacks ($1,95) # Scanning speed (1-255) +define SCANORIGIN pds_unpacks ($1,97) # Origin of scan 1,2,3,4 or 0 +define CORNER pds_unpacks ($1,99) # Starting corner of scan +define NRECS_PER_SCAN pds_unpacks ($1,101) # Number of records per scan +define XTRAVEL pds_unpackl ($1,103) # Xtravel in microns per scan +define YTRAVEL pds_unpackl ($1,107) # Ytravel in microns per scan +define NPTS_PER_REC pds_unpacks ($1,111) # Number of points per record +define XCOORD pds_unpackl ($1,113) # X coordinate of origin +define YCOORD pds_unpackl ($1,117) # Y coordinate of origin + +# define the parameter array +define P_DX $1[1] +define P_DY $1[2] +define P_NPTS_PER_SCAN $1[3] +define P_NSCANS $1[4] +define P_SCANTYPE $1[5] +define P_SCANSPEED $1[6] +define P_SCANORIGIN $1[7] +define P_CORNER $1[8] +define P_NRECS_PER_SCAN $1[9] +define P_XTRAVEL $1[10] +define P_YTRAVEL $1[11] +define P_NPTS_PER_REC $1[12] +define P_XCOORD $1[13] +define P_YCOORD $1[14] + +define SCANSTART 10 # Number of bytes in the scanstart indicator diff --git a/noao/mtlocal/pds/structure.doc b/noao/mtlocal/pds/structure.doc new file mode 100644 index 00000000..5a560f35 --- /dev/null +++ b/noao/mtlocal/pds/structure.doc @@ -0,0 +1,105 @@ + PDSREAD (Program Structure) PDSREAD (Program Structure) + + + +PDS Structure Chart + +t_pdsread() +# Returns when file list is satified or if EOT is encountered. +# Errors from called routines are trapped and printed as a warning. + + read_pds + # Returns OK or EOF + + read_header + # Returns OK or EOF + + init_read_pixels + # Returns OK + + read_pixels + # Returns OK + + decode_header + + decode_text + + decode_parameters + + print_header + + read_image + + set_image_header + + init_read_pixels + + read_pixels + + + + +PDSREAD Structure Summary + + +t_pdsread + The main procedure reads the control parameters. The files to be + converted are calculated from the specified source and file list. + A loop through the files determines the specific input source + names and output filenames and calls READ_PDS for each conversion. + + read_pds + The input source is opened and the output header file is + + + -1- + PDSREAD (Program Structure) PDSREAD (Program Structure) + + + + created. If only the PDS header is to be listed then a + temporary image header file is created. The PDS header is + read and decoded into the IRAF image header by READ_HEADER. + If make_image is true then READ_IMAGE is called. Finally all + the files are closed. If a temporary image header file was + created it is deleted. + + read_header + The PDS header is read into an array of text and an an + array of parameters using INIT_READ_PIXEL and READ_PIXEL. + These arrays are passed to DECODE_HEADER and subsequently + printed on the standard output. The routine returns OK or + EOF. Errors are returned by the error handler. + + init_read_pixels + The pixel reading routine is initialized. + + read_pixels + The pixels are read into a record buffer. + + decode_header + Decodes the text portion of the header using + DECODE_TEXT and DECODE_PARAMETERS. + + decode_text + Converts the id string from 059 code to 8 bit + ASCII. + + decode_parameters + Decodes the PDS scan parameters. + + print_header + If the short_header switch is set then the image title + and size are printed. If the long_header switch is + set then all the header information is printed. + + read_image + The PDS image pixels are converted to an IRAF image file. + The image file header is set using SET_IMAGE_HEADER. The + lines of the image are converted one at a time. + + set_image_header + The pixel type for the IRAF image is set to the user + specified type. If no type has been specified then + the type is determined from the number of bits per + pixel given in pds.h. diff --git a/noao/mtlocal/pds/structure.hlp b/noao/mtlocal/pds/structure.hlp new file mode 100644 index 00000000..6bb2eab8 --- /dev/null +++ b/noao/mtlocal/pds/structure.hlp @@ -0,0 +1,85 @@ +.help pdsread 2 "Program Structure" +.sh +PDSREAD Structure Chart + +.nf +t_pdsread() +# Returns when file list is satisfied or if EOT is encountered. + + read_pds (pdsfile, iraffile) + # Returns OK or EOF + + read_header (pds_fd, im, parameters) + # Returns OK or EOF + + read_image (pds_fd, im, parameters) + + set_image_header (im) + + init_read_scan (parameters) + # Returns OK + + read_scan (fd, scanbuf) + # Returns EOF or number of points in a scan +.fi + +.sh +PDSREAD Structure Summary + +.ls t_pdsread +The main procedure reads the control parameters. +The files to be read and converted are calculated from the specified source +and file list. +A loop through the files determines the specific input source names and +output file names and calls READ_PDS for each conversion. +.ls read_pds +The input source is opened and the output image header file is created. +If only the PDS header is to be listed then a temporary image header +file is created. The PDS header is read and decoded into the IRAF +image header bye READ_HEADER. If the image is to be read then +READ_IMAGE is called. Finally all files are closed. If a temporary +image file was created it is deleted. +.ls read_header +The 120 byte PDS header is read into an integer array. The ID string +in the first 80 bytes is unpacked into a text string using the MIIUP routine +and stored in the IRAF image header. The 12 bit PDP values are converted to +SPP short data valuese using the routine APDP8S. +The PDP 059 text code is converted to ASCII using the routine APDP059. +The remaining header quantities are unpacked into short +or long SPP integers using the MIIUP, APDP8S, UNPACKS and UNPACKL and +the image dimensions are stored in the IRAF image header. +Finally the PRINT_HEADER is called to print a long or short version of the +header. +.le +.ls read_image +The PDS image pixels are converted to an IRAF image file. +The image file header is set. +The lines of the image are converted one at a time. +.ls set_image_header +The pixel type for the IRAF image is set to the user specified type. +If no type has been specified then the type is determined from the +number of bits per pixel given in pds.h. +.le +.ls init_read_scan +Initializes the scan parameters. Input is a long integer array containing +the decoded header parameters. The procedure uses the number of data points +per scan, the number of records per scan and the number of points per full +records, calculates and allocates the buffer space required and determines +the size of each record in chars. If the tape is an old 7 track tape the +size of the record must be rounded up till it holds an integral number +of Cyber words in length. For example a record containing 1001 real data +points will actually be 1005 data points long with junk in the last 4 spaces. +.le +.ls read_scan +Reads an entire PDS scan a record at a time looping over the number of +records per scan. The procedure uses the MIIUP +routine which is machine dependent. The bitpix must correspond to +an MII type. READ_SCAN returns the number of data points per scan or EOF. +READ_SCAN calls APDP8S to convert the 10 or 12 bit data values to short +integers and calls AFLIPS to flip every other scan if the PDS scan +is a raster scan. +.le +.le +.le +.le +.endhelp diff --git a/noao/mtlocal/pds/t_pdsread.x b/noao/mtlocal/pds/t_pdsread.x new file mode 100644 index 00000000..94b13320 --- /dev/null +++ b/noao/mtlocal/pds/t_pdsread.x @@ -0,0 +1,127 @@ +include <error.h> +include <fset.h> + +# T_PDSREAD -- Read PDS format data. Further documentation given +# in pds.hlp + +define MAX_RANGES 100 + +procedure t_pdsread() + +char infile[SZ_FNAME] # the input file name list +char outfile[SZ_FNAME] # the output file name list +char file_list[SZ_FNAME] # the input file number list +int offset # the output file name offset + +char in_fname[SZ_FNAME], out_fname[SZ_FNAME] +int range[MAX_RANGES*2+1], nfiles, file_number, stat, junk +int lenlist +pointer list + +bool clgetb() +char clgetc() +int fstati(), btoi(), clgeti(), fntlenb(), fntgfnb(), mtfile() +int mtneedfileno() +int pds_read(), decode_ranges(), get_next_number(), pds_get_image_type() +pointer fntopnb() + +include "rpds.com" + +begin + # Set up the standard output to flush on a newline. + if (fstati (STDOUT, F_REDIR) == NO) + call fseti (STDOUT, F_FLUSHNL, YES) + + # Get the input file name(s). + call clgstr ("pds_file", infile, SZ_FNAME) + if (mtfile (infile) == YES) { + list = NULL + if (mtneedfileno (infile) == YES) + call clgstr ("file_list", file_list, SZ_LINE) + else + call strcpy ("1", file_list, SZ_LINE) + } else { + list = fntopnb (infile, YES) + lenlist = fntlenb (list) + call sprintf (file_list, SZ_LINE, "1-%d") + call pargi (lenlist) + } + + # Decode the ranges. + if (decode_ranges (file_list, range, MAX_RANGES, nfiles) == ERR) + call error (1, "Illegal file number list") + + # Setup the output options. + long_header = btoi (clgetb ("long_header")) + short_header = btoi (clgetb ("short_header")) + make_image = btoi (clgetb ("make_image")) + tenbit = btoi (clgetb ("tenbit")) + ninetrack = btoi (clgetb ("ninetrack")) + offset = clgeti ("offset") + + # Set the output image data type. + if (make_image == YES) { + data_type = pds_get_image_type (clgetc ("datatype")) + call clgstr ("iraf_file", outfile, SZ_FNAME) + } else + outfile[1] = EOS + + # Read successive PDS 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 (list != NULL) + junk = fntgfnb (list, in_fname, SZ_FNAME) + else { + if (mtneedfileno (infile) == YES) + call mtfname (infile, file_number, 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 PDS 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 = pds_read (in_fname, out_fname)) + call erract (EA_FATAL) + if (stat == EOF) # EOT found + break + } + + if (list != NULL) + call fntclsb (list) +end + +# GET_IMAGE_TYPE -- Convert a character to an IRAF image type. + +define NTYPES 7 + +int procedure pds_get_image_type(c) + +char c +int i, type_codes[NTYPES] +int stridx() + +string types "usilrds" # supported image data types +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 diff --git a/noao/mtlocal/r2df.par b/noao/mtlocal/r2df.par new file mode 100644 index 00000000..0ccd4067 --- /dev/null +++ b/noao/mtlocal/r2df.par @@ -0,0 +1,11 @@ +# 2DF read parameters +r2df_file,f,a,mta,,,2DF data source +file_list,s,a,,,,File list +iraf_file,f,a,,,,IRAF filename +make_image,b,h,yes,,,Create an IRAF image? +long_header,b,h,no,,,Print full 2DF header? +short_header,b,h,yes,,,Print short 2DF header? +datatype,s,h,s,,,IRAF data type +standard_format,b,h,yes,,,2DF standard format? +offset,i,h,0,,,Tape offset number +mode,s,h,ql,,, 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 diff --git a/noao/mtlocal/rcamera.par b/noao/mtlocal/rcamera.par new file mode 100644 index 00000000..e7fff1db --- /dev/null +++ b/noao/mtlocal/rcamera.par @@ -0,0 +1,12 @@ +# CAMERA read parameters +camera_file,f,a,mta,,,CAMERA data source +file_list,s,a,,,,File list +iraf_file,f,a,,,,IRAF filename +make_image,b,h,yes,,,Create an IRAF image? +image_list,s,h,"1",,,Image list +long_header,b,h,no,,,Print full CAMERA header? +short_header,b,h,yes,,,Print short CAMERA header? +datatype,s,h,s,,,IRAF data type +standard_format,b,h,yes,,,CAMERA standard format? +offset,i,h,0,,,Tape offset no +mode,s,h,ql,,, diff --git a/noao/mtlocal/rdumpf.par b/noao/mtlocal/rdumpf.par new file mode 100644 index 00000000..740e2320 --- /dev/null +++ b/noao/mtlocal/rdumpf.par @@ -0,0 +1,9 @@ +#RDUMPF parameters +dumpf_file,f,a,mta,,,DUMPF data source +file_list,s,a,,,,file list +iraf_file,f,a,,,,IRAF filename +raster_list,s,h,"1-999",,,raster list +make_image,b,h,yes,,,create IRAF image? +print_header,b,h,yes,,,print IPPS headers? +data_type,s,h,,,,IRAF data type +mode,s,h,ql,,, diff --git a/noao/mtlocal/ridsfile.par b/noao/mtlocal/ridsfile.par new file mode 100644 index 00000000..bece15d0 --- /dev/null +++ b/noao/mtlocal/ridsfile.par @@ -0,0 +1,10 @@ +#Parameter file for the DUMPF IDSFILE reader +dumpf_file,f,a,mta,,,DUMPF data source +file_ordinal,s,a,,,,file list +iraf_file,f,a,,,,IRAF filename +record_numbers,s,h,"1001-9999",,,record numbers +make_image,b,h,yes,,,create IRAF image? +print_pixels,b,h,no,,,print_pixels? +long_header,b,h,no,,,print complete headers? +data_type,s,h,r,,,IRAF data type +mode,s,h,ql,,, diff --git a/noao/mtlocal/ridsmtn.par b/noao/mtlocal/ridsmtn.par new file mode 100644 index 00000000..1c056674 --- /dev/null +++ b/noao/mtlocal/ridsmtn.par @@ -0,0 +1,14 @@ +#Parameter file for the IDS mountain format reader +ids_file,f,a,mta,,,IDS data source +iraf_file,f,a,,,,IRAF filename +reduced_data,b,h,yes,,,mtn reduced data? +file_number,i,h,1,,,IDS tape file to be read +record_numbers,s,h,"1-99999",,,record numbers +make_image,b,h,yes,,,create IRAF image? +np1,i,h,0,,,Starting pixel in spectrum +np2,i,h,0,,,Ending pixel in spectrum +print_pixels,b,h,no,,,print pixel values? +long_header,b,h,no,,,print full IDS header? +data_type,s,h,r,,,IRAF data type +offset,i,h,0,,,offset added to output filename +mode,s,h,ql,,, diff --git a/noao/mtlocal/ridsout.par b/noao/mtlocal/ridsout.par new file mode 100644 index 00000000..c5fec829 --- /dev/null +++ b/noao/mtlocal/ridsout.par @@ -0,0 +1,9 @@ +#Parameter file for the IDSOUT reader +idsout_file,f,a,,,,text file of IDSOUT data +iraf_file,f,a,,,,IRAF filename +record_numbers,s,h,"1-9999",,,record numbers +make_image,b,h,yes,,,create IRAF image? +print_pixels,b,h,no,,,print_pixels? +long_header,b,h,yes,,,print complete IDS headers? +data_type,s,h,r,,,IRAF data type +mode,s,h,ql,,, diff --git a/noao/mtlocal/rpds.par b/noao/mtlocal/rpds.par new file mode 100644 index 00000000..8520188e --- /dev/null +++ b/noao/mtlocal/rpds.par @@ -0,0 +1,12 @@ +# PDS read parameters +pds_file,f,a,mta,,,PDS data source +file_list,s,a,,,,File list +iraf_file,f,a,,,,IRAF filename +make_image,b,h,yes,,,Create an IRAF image? +long_header,b,h,no,,,Print full PDS header? +short_header,b,h,yes,,,Print short PDS header? +datatype,s,h,s,,,IRAF data type +tenbit,b,h,no,,,Ten bit data? +ninetrack,b,h,yes,,,Ninetrack tape? +offset,i,h,0,,,Tape file number offset +mode,s,h,ql,,, diff --git a/noao/mtlocal/rrcopy.par b/noao/mtlocal/rrcopy.par new file mode 100644 index 00000000..6601461b --- /dev/null +++ b/noao/mtlocal/rrcopy.par @@ -0,0 +1,9 @@ +#RCOPY parameters +rcopy_file,f,a,mta,,,RCOPY data source (mta:mtb) +raster_list,s,a,,,,raster list +iraf_file,f,a,,,,IRAF filename +datafile,i,h,1,,,rrcopy datafile ordinal on tape +make_image,b,h,yes,,,create IRAF image? +print_header,b,h,yes,,,print header information? +data_type,s,h,"",,,IRAF data type +mode,s,h,ql,,, diff --git a/noao/mtlocal/x_mtlocal.x b/noao/mtlocal/x_mtlocal.x new file mode 100644 index 00000000..f3ebeeab --- /dev/null +++ b/noao/mtlocal/x_mtlocal.x @@ -0,0 +1,11 @@ +# Mtlocal package. + +task ridsmtn = t_ridsmtn, + ldumpf = t_ldumpf, + rdumpf = t_rdumpf, + ridsfile = t_ridsfile, + ridsout = t_ridsout, + rrcopy = t_rrcopy, + rcamera = t_rcamera, + rpds = t_pdsread, + r2df = t_r2df |