diff options
Diffstat (limited to 'noao/nproto')
118 files changed, 22596 insertions, 0 deletions
diff --git a/noao/nproto/README b/noao/nproto/README new file mode 100644 index 00000000..c55c8b80 --- /dev/null +++ b/noao/nproto/README @@ -0,0 +1,12 @@ +The NPROTO package provides a place in the system where users can put their +programs for others to conveniently use, without modifying the IRAF system +itself (see also LOCAL). A program or package must meet a strict set of +standards to be installed in the IRAF system as a fully supported program; +NPROTO provides a way for users to get software into the system without having +to meet the mainline IRAF standards. Programs or packages installed in NPROTO +are automatically candidates for eventual migration into the main system. +Tasks installed in NPROTO are generally expected to go away after a while. + +Only portable IRAF software should be installed in the NPROTO package. +Nonportable programs should be placed in LOCAL and will not be exported with +the system. diff --git a/noao/nproto/Revisions b/noao/nproto/Revisions new file mode 100644 index 00000000..a50e6c7e --- /dev/null +++ b/noao/nproto/Revisions @@ -0,0 +1,703 @@ +.help revisions Jun88 noao.nproto +.nf + +ace/t_acedisplay.x + The alogr() was being called without an errfcn (7/12/09, MJF) + +skysep.cl + Added an 'enum' to the 'raunit' param to enforce choices (1/12/09, MJF) + +doc/skysep.hlp + Fixed a typo. (1/12/09, MJF) + +skygroup.cl + +skysep.cl + +doc/skygroup.hlp + +doc/skysep.hlp + +nproto.cl +nproto.men +nproto.hd + Added two new script tasks. (2/10/06, Valdes) + +ace/catio.x + An extra argument to tbhgtr() was found by lint. (5/24/04, Valdes) + +======= +V2.12.2 +======= + +findgain.cl +findthresh.cl + Modified to eliminate goto statements (12/28/03, MJF) + +mkms.cl + +doc/mkms.hlp + +nproto.cl +nproto.hd +nproto.men + Added a prototype script task to create a multispec format image from + 1D spectra including the associated arrays. (1/7/03, Valdes) + +ace/skyfit.x + If a complete line is exceptionally deviant from the true sky it + will bias the sky surface. As a quick fix for the possibly common + case that the first or last lines are high due to charge transfer + effects, the lines to use was changed to start and end a half step + from the ends. This is only a quick fix and a more sophisticated + solutions is needed. (10/17/02, Valdes) + +ace/skyblock.x + There was another bug in interp2. (10/17/02, Valdes) + +ace/skyblock.x + There was a bug in interp2. (9/30/02, Valdes) + +ace/convolve.x + Fixed error when reference image does not overlap target image on + the right. (9/23/02, Valdes) + +ace/detect.x + The flux comparison in difference detection used sigma normalized + fluxes. This was changed to unnormalized fluxes which is done + by using the same sigmas for the target and reference images. + (9/23/02, Valdes) + +ace/t_acedetect.x +ace/pars.x +ace/diffdetect.pars + Made changes for diffdetect. (9/23/02, Valdes) + +ace/t_acedetect.x + Switched over to the xtools version of xt_pmmap. + (9/10/02, Valdes) + +ace/t_acedetect.x +ace/skyblock.x +ace/omwrite.x + If DATASEC is present then it is automatically applied to the + image. It is also deleted from the output sky and mask since + they will be the size of the data section. (9/10/02, Valdes) + +ace/skyfit.x + The sigma is fit by a constant to avoid potential negative sigmas. + (8/6/02, Valdes) + +ace/skyfit.x + The sigma is fit by a constant to avoid potential negative sigmas. + (8/6/02, Valdes) + +======= +V2.12.1 +======= + +ace/skyfit.x +ace/skyblock.x + Fixed a type mismatch in a min() function. (6/13/02, Valdes) + +===== +===== +V2.12 +===== +noao$nproto/ace/xtmaskname.x + Added check for optional environment variable "masktype" to force + pl files if the value is "pl". (3/1/02, Valdes) + +noao$nproto/ace/xtpmmap.x + Needed to add a new error code to catch. (2/27/02, Valdes) + +noao$nproto/ace + +noao$nproto/x_nproto.x +noao$nproto/mkpkg +noao$nproto/nproto.cl +noao$nproto/nproto.men +noao$nproto/nproto.hd + Added a prototype version of ACE with the only task being OBJMASKS. + (1/25/02, Valdes) + +noao$nproto/nproto.cl +noao$nproto/nproto.men +noao$nproto/nproto.hd + Removed FINDGAIN since a new version is in OBSUTIL. The source and + help are still in the directory for now. (11/14/01, Valdes) + +noao$nproto/t_irmosaic.x + Modified the irmosaic task to avoid a potential divide by zero error + in the range decoding software. This error was actually due to + an interface change to the xtools$ranges.x code, which has since been + changed back, but the potential for error was there. (8/22/97, Davis) + +noao$nproto/linpol + Added the PROTO package task LINPOL to NPROTO. (1/31/92, Davis) + +noao$nproto/ndprep.cl --> onedspec$ +noao$nproto/ndprep.hlp --> onedspec$ +noao$nproto/nproto.cl +noao$nproto/nproto.hd +noao$nproto/nproto.men + Moved the NDPREP task to ONEDSPEC. (1/31/92, Valdes) + +noao$nproto/findgain, findthresh + 1. The findgain and findthresh tasks in the kpno local package were + added to the nproto package. (1/31/92, Davis) + +noao$nproto/ + 1. The proto directory was renamed to nproto and all reference to proto + were replaced by nproto. + + 2. The IMEDIT, IMEXAMINE, and TVMARK tasks from NOAO.PROTO have been moved + to the IMAGES.TV package. + + 3. The IMTITLE, MKHISTOGRAM, and RADPLT tasks in NOAO.PROTO have been moved + to the OBSOLETE package. They are superseded by the HEDIT, PHISTOGRAM, and + PRADPROF tasks respectively. + + 4. The BINFIL, BSCALE, EPIX, FIELDS, FIXPIX, IMALIGN, IMCENTROID, IMCNTR, + IMFUNCTION, IMREPLACE, IMSCALE, INTERP, IRAFIL, and JOIN tasks were + moved to the new core package PROTO. + + (1/23/92, Davis Valdes) + +====================== +Package reorganization +====================== + +proto$imexamine/ievimexam.x + Corrected an error in the column limits computation in the routine + ie_get_vector that caused occasional glitches in vectors plotted + using the 'v' key. This bug may also explain occasional unrepeatable + bus errors which occurred after using the 'v' key. (12/11/91, Davis) + +proto$imedit/epcolon.x + Two calls to pargr changed to pargi. (11/13/91, Valdes) + +proto$tvmark/t_tvmark.x +proto$tvmark/mkcolon.x + Removed extra argument to mk_sets() calls. (11/13/91, Davis) + +proto$tvmark/mkppars.x + Changed two clputi calls to clputb calls. (11/13/91, Davis) + + +proto$t_fixpix.x +proto$doc/t_fixpix.x + Made the order of lower/upper columns/lines unimportant by internally + transposing the endpoints if not in increasing order. (10/31/91, Valdes) + +proto$imfuncs.gx +proto$imfuncs.x + The reference to the E macro in math.h was replaced with a reference to + the new macro BASE_E. + (9/17/91 LED) + +proto$jimexam.par +proto$proto.cl +proto$mkpkg +proto$imexamine/iejimexam.x +proto$imexamine/iecolon.x +proto$imexamine/t_imexam.x +proto$imexamine/iegcur.x +proto$imexamine/mkpkg +proto$doc/imexamine.hlp +noao$lib/scr/imexamine.key + Added new options for fitting 1D gaussians to lines and columns. + (9/2/91, Valdes) + +proto$imfunction.par +proto$imfunction.x +proto$imfuncs.gx +proto$imfuncs.x +proto$doc/imfunction.hlp + A new version of the imfunction task was installed. This new version + supports many more functions as well the double precision images. + (8/29/91 LED) + +proto$bscale.par +proto$t_bscale.x +proto$mkpkg +proto$doc/bscale.hlp + Installed a new version of the bscale task. The new task takes a list + of input images and produces a list of output images like most other + images tasks. The input images are overwritten if the output list equals + the input list, and the noact parameter was removed since it is no longer + required. Two new parameters upper and lower can be used to remove + outliers from the statistics computation. The logfile parameter was + removed and replaced with the verbose parameter. Finally the code was + modified to only use the step parameter for sampling along a particular + axis, if no reference is made to that axis in the section parameter. + (8/26/91 LED) + +proto$fixline.gx + The call to awsud had an argument type mismatch. (8/13/91, Valdes & Jacoby) + +proto$imexamine/iemw.x + +proto$imexamine/iecimexam.x +proto$imexamine/iecolon.x +proto$imexamine/iegimage.x +proto$imexamine/ielimexam.x +proto$imexamine/iepos.x +proto$imexamine/ierimexam.x +proto$imexamine/imexam.h +proto$imexamine/mkpkg +proto$imexamine/t_imexam.x +proto$imexamine.par +proto$doc/imexamine.hlp + Modified IMEXAMINE to use WCS information in axis labels and coordinate + readback. (8/13/91, Valdes) + +proto$tvmark/mkonemark.x + Moved the two salloc routines to the top of the mk_onemark routine + where they cannot be called more than once. + (7/22/91, Davis) + +proto$tvmark.par + Modified the description of the pointsize parameter. + (7/17/91, Davis) + +proto$imfit1d.par,linefit.par + Removed these defunct .par files from the PROTO package. + (10/25/90, Davis) + +proto$t_imreplace.x + Added support for pixel type USHORT to the IMREPLACE task. + (10/25/90, Davis) + +proto$imexamine/iesimexam.x + Add code for checking and warning if data is all constant, all above the + specified ceiling, or all below the specified floor when making surface + plots. (10/3/90, Valdes) + +proto$imedit/epmask.x + Added some protective changes so that if a radius of zero with a circular + aperture is used then round off will be less likely to cause missing + the pixel. (9/23/90, Valdes) + +proto$tvmark/tvmark.key +proto$tvmark/mkmark.x +proto$tvmark/doc/tvmark.hlp + At user request changed the 'd' keystroke command which marks an object + with a dot to the '.' and the 'u' keystroke command which deletes a + point to 'd'. (9/14/90 Davis) + +proto$mkpkg +proto$proto.cl +proto$proto.hd +proto$proto.men +proto$x_proto.x +proto$toonedspec.x - +proto$toonedspec.par - +proto$doc/toonedspec.hlp - + Removed TOONEDSPEC. It's replacement is ONEDSPEC.SCOPY. (8/23/90, Valdes) + +==== +V2.9 +==== + +noao$proto + Davis, June 20, 1990 + The prototype tasks IMSLICE and IMSTACK were removed from the PROTO + package. Their functionality is duplicated by tasks of the same + name in the IMAGES package. + +noao$proto/imedit/epgcur.x + Valdes, June 6, 1990 + The fixpix format input was selecting interpolation across the longer + dimension instead of the shorter. This meant that complete columns + or lines did not work at all. + +noao$proto/t_fixpix.x + Davis, May 29, 1990 + Modified fixpix so that it would work on unsigned short images. + +==== +V2.8 +==== + +noao$proto/ + Davis, April 6, 1990 + Two new tasks IMALIGN and IMCENTROID written by Rob Seaman were added + to the proto package. IMCENTROID computes a set of relative shifts + required to register a set of images. IMALIGN both computes the + shifts and aligns the images. + +noao$proto/imexamine/t_imexam.x + Valdes, Mar 29, 1990 + Even when use_display=no the task was trying to check the image display + for the name. This was fixed by adding a check for this flag in the + relevant if statement. + +noao$proto/imexamine/ievimexam.x + Valdes, Mar 22, 1990 + The pset was being closed without indicating this in the data structure. + The clcpset statement was removed. + +noao$proto/imedit/epgcur.x + Valdes, Mar 15, 1990 + The EOF condition was being screwed up for two keystroke commands leading + to a possible infinite loop when using a cursor file input. The fix + is to change the "nitems=nitems+clgcur" incrementing to simply + "nitems=clgcur". + +noao$proto/imedit/epbackground.x +noao$proto/imedit/epgcur.x + Valdes, Mar 9, 1990 + 1. The surfit pointer was incorrectly declared as real in ep_bg causing the + 'b' key to do nothing. This appears to be SPARC dependent. + 2. Fixed some more problems with cursor strings having missing coordinates + causing floating overflow errors. + +noao$proto/iralign.par,ir/t_iralign.x + Davis, Feb 27, 1990 + Changed the iralign parameter align to alignment for consistency with + the other tasks. + +noao$proto/imexamine/iecolon.x + Valdes, Feb 16, 1990 + Fixed a mistake in the the datatype of a parg call. + +noao$proto/ir/ + Davis, Feb 16, 1990 + Added a feature to the iralign code that permits the user to rerun + the iralign, irmatch1d, and irmatch2d using the first runs output + as input. This permits the user to fine tune the intensity adjustments + and shifts. + +noao$proto/proto.cl +noao$proto/proto.men +noao$proto/mkpkg +noao$proto/x_proto.x +noao$proto/t_join.x + +noao$proto/join.par + +noao$proto/join.cl - +noao$proto/doc/join.hlp + Valdes, Feb 13, 1990 + Added compiled version of the join task and updated the documentation. + Note that the parameters are now different. + +noao$proto/imedit.par +noao$proto/imedit/epcolon.x +noao$proto/imedit/epmask.x + Valdes, Jan 17, 1990 + 1. Fixed typo in prompt string for y background order. + 2. Wrong datatype in clput for order parameters resulting in setting + the user parameter file value to 0. + 3. Bug fix in epmask. The following is the correct line: + line 130: call amovi (Memi[line], Memi[ptr2+i*EP_NX(ep)], EP_NX(ep)) + +noao$proto/imedit/epdisplay.x + Valdes, Jan 7, 1990 + Added initialization to the zoom state. Without the intialization + starting IMEDIT without display and then turning display on followed by + a 'r' would cause an error (very obscure but found in a demo). + +noao$proto/tvmark/t_tvmark.x +noao$proto/tvmark/mkmark.x +noao$proto/tvmark/tvmark.key +noao$proto/doc/tvmark.hlp + Valdes, Jan 4, 1990 + Added filled rectangle command 'f'. + +noao$proto/tvmark/t_tvmark.x +noao$proto/tvmark/mktools.x +noao$proto/tvmark/mkshow.x +noao$proto/tvmark/mkcolon.x +noao$proto/tvmark/mkfind.x +noao$proto/tvmark/mkremove.x + Davis, Dec 12, 1989 + 1. Tvmark has been modified to permit deletion as well as addition of + objects to the coordinate file. Objects to be deleted are marked + with the cursor and must be within a given tolerance of an + object in the coordinate list to be deleted. + 2. The help screen no longer comes up in the text window when the task + is invoked for the sake of uniformity with all other IRAF tasks. + 3. The coordinate file is opened read_only in batch mode. In interactive + mode a warning message is issued if the user tries to append or delete + objects from a file which does not have write permission and no action + is taken. + +noao$proto/imexamine/t_imexam.x +noao$proto/imexamine/iegimage.x + Valdes, Nov 30, 1989 + The default display frame when not using an input list was changed from + 0 to 1. + +noao$proto/ir/ + Davis, Nov 28, 1989 + New versions of the proto tasks IRMOSAIC, IRALIGN, IRMATCH1D and + IRMATCH2D have been installed in the PROTO package. The routine + have been modularised and now share code in preparation for a + future database approach to the registration problem. The image i/o + has been optimized so that all the tasks, but IRMOSAIC in particular, + will run much faster. A bug in the alignment code in which errors of + alignment of up to 0.5 pixels can occur has been fixed. + There is now an option to trim each section before insertion into + the output image. Finally the actions taken by the task can optionally + be printed on the terminal. + +noao$proto/imeidt/epgcur.x + Valdes, Oct 30, 1989 + 1. There was no check against INDEF cursor coordinates. Such coordinates + will occur when reading a previous logfile output and cursor input + where the shorthand ":command" is used. The actual error occured when + attempting to add 0.5 to INDEF. + +noao$proto/imedit/epstatistics.x +noao$proto/imedit/epmove.x +noao$proto/imedit/epgsfit.x +noao$proto/imedit/epnoise.x +noao$proto/imedit/epbackground.x +noao$proto/imedit/t_imedit.x + Valdes, Aug 17, 1989 + 1. Added errchk to main cursor loop to try and prevent loss of the + user's changes if an error occurs. + 2. If no background points are found an error message is now printed + instead of aborting. + +noao$proto/tvmark/mkbmark.x + Davis, Aug 4, 1989 + Modified tvmark so that drawing to the frame buffer is more efficient + in batch mode. This involved removing a number of imflush calls + which were unnecessarily flushing the output buffer to disk and + recoding the basic routines which draw concentric circles and rectangles. + +noao$proto/imreplace.par + Valdes, July 20, 1989 + Changed mode of imaginary component value to hidden. + +=========== +Version 2.8 +=========== + +noao$proto/imexamine/* + +noao$proto/imexamine.par + +noao$proto/?imexam.par + +noao$proto/doc/imexamine.hlp + +noao$proto/proto.cl +noao$proto/proto.men +noao$proto/proto.hd +noao$proto/x_proto.x +noao$proto/mkpkg +noao$lib/scr/imexamine.key + Valdes, June 13, 1989 + New task IMEXAMINE added to the proto package. + +noao$proto/tvmark/ + Davis, June 6, 1989 + Fixed a bug in tvmark wherein circles were not being drawn if they + were partially off the image in the x dimension. + +noao$proto/tvmark/ + Davis, June1, 1989 + A labeling capability has been added to tvmark. If the label parameter + is turned on tvmark will label objects with the string in the third + column of the coordinate file. + +noao$proto/tvmark/ + Davis, May 25, 1989 + The problem reported by phil wherein TVMARK would go into an infinite + loop if it encountered a blank line has been fixed. + +noao$proto/t_imreplace.x +noao$proto/imrep.gx +noao$proto/imreplace.par +noao$proto/doc/imreplace.hlp + Valdes, May 23, 1989 + Complex images are supported with the thresholds being the magnitude + of the complex values and the replacement value specified as real + and imaginary. + +noao$proto/tvmark + Davis, May 22, 1989 + The new task TVMARK was added to the proto package. + +noao$proto/imedit/ + Davis, May 22, 1989 + The new task IMEDIT was added to the proto package. + +noao$proto/t_binfil.x + Rooke, Apr 28, 1989 + After allocating temporary storage for header bytes in IRAFIL, the code + was then reading those bytes instead into pixel storage, resulting in + a segmentation violation if header > row of pixels (found by Jim + Klavetter). + +noao$proto/epix/epgdata.x + Valdes, Mar 20, 1989 + Limit checking on the requested data region was wrong. User would get + out of bounds message if the line desired was greater than the number + of columns. + +noao$proto/t_bscale.x + Davis, Feb 7, 1989 + Fixed a memory corruption error in bscale. If a user specified a section + using the section parameter, the task was overflowing the data array + by trying to read beyond the boundary of the section. + + Fixed a floating divide by zero problem in the computation of + step sizes when a specified section was only one pixel + wide in a given dimension. + +noao$proto/ + Davis, Jan 26, 1989 + A "pixel out of bounds" error was fixed in the task IRMATCH2D. This + would occur if nxsub != nysub and for certain combination of corner + and order. This bug has been fixed. + +noao$proto/ + Davis, Nov 8, 1988 + The two prototype image intensity matching tasks IRMATCH1D and IRMATCH2D + have been added to the proto package. See the help pages for further + details. + +noao$proto/t_irmosaic.x + Davis, Jul 23, 1988 + The number of columns and rows between adjacent subrasters in the output + image produced by IRMOSAIC was incorrect if nxoverlap or nyoverlap were + less than -1. + +noao$proto/t_imslice.x + Davis, Jul 8, 1988 + A new task imslice has been added to the proto package. IMSLICE reduces + an n-dimensional image to a list of (n-1)-dimensional images. + +noao$proto/mkpkg +noao$proto/imfunction.x +noao$proto/imfuncs.gx + +noao$proto/imdex.gx - +noao$proto/imlog.gx - +noao$proto/imsqr.gx - + Valdes, Apr 8, 1988 + Added the absolute value function. Combined the different functions + into one procedure. + +noao$proto/t_mkhistogram.x + Davis, Feb 5, 1988 + A new task mkhistogram has been added to the proto package. Mkhistogram + will task a stream of data and list or plot the histogram of the data. + +noao$proto/t_irmosaic.x + Davis, Feb 3, 1988 + 1. A new parameter "subtract" has been added to the IRMOSAIC task. If + the "median" parameter is yes then IRMOSAIC will subtract the median + from each subraster before adding it to the output image mosaic. + +noao$proto + Davis, Dec 8, 1987 + 1. Two new tasks IRMOSAIC and IRALIGN have been added to the PROTO + package. IRMOSAIC takes an ordered list of input images and places them + on a grid in an output image. Options exist to order the input list + by row, column or in a raster pattern starting at any of the four + corners of the output image. Adjacent subrasters may be overlapped or + separated by a specified number of columns and rows. Positions of objects + which occur in adjacent subrasters can be marked using for example + the sun imtool facility and centered using the APPHOT center routine. + IRALIGN takes the mosaiced image and the coordinate list and produces an + output image where all the individual subrasters have been aligned with + respect to some reference subraster. These two tasks are most useful for + images which already lie approximately on a grid. + +noao$proto/t_bscale.x + +noao$proto/bscale.par + +noao$proto/doc/bscale.hlp + + Valdes, October 7, 1988 + A new task to compute to scale images by a zero point and scale factor + has been added. The zero point and scale factor can be chosen as the + mean, median, or mode of the images. + +noao$proto/doc/replicate.hlp - + Valdes, June 4, 1987 + 1. Deleted this obsolete file. + +noao$proto/toonedspec.x +noao$proto/doc/toonedspec.hlp + Valdes, April 27, 1987 + 1. The output spectra are now of type real regardless of the input + pixel type. This change was made to avoid fix point exceptions + on AOS/VS IRAF when summing enough lines to overflow the input + pixel type. On the other IRAF systems integer overflows only cause + erroneous output but no error. + +noao$proto/fixline.gx + Valdes, April 27, 1987 + 1. The interpolation weights when interpolating across lines were + being truncated and producing approximately correct values + but not correct interpolation. The weights are now not truncated. + +noao$proto/join.cl + Hammond, March 10, 1987 + 1. Added script task JOIN, which joins two lists line by line. + +noao$proto/t_imstack.x + Valdes, March 3, 1987 + 1. The input images being stacked were not being closed after they + were added to the output image. + +noao$proto/imrep.gx + Valdes, February 5, 1987 + 1. There was a problem in AOS iraf because of an attempt to convert + a real INDEF to a short value. The routine was modified to attempt + the conversion only if the value is not INDEF. + +noao$proto/t_imstack.x +noao$proto/doc/imstack.hlp + Valdes, October 8, 1986 + 1. Modified IMSTACK to use image templates instead of file templates. + All image tasks should use the image template package for consistency. + 2. Modified the help page. One of the examples was incorrect. + +noao$proto/imfunction.x + Valdes, October 8, 1986 + 1. Doug Tody added the square root function. I don't know the + details of the revision. + +noao$proto/imfunction.x +noao$proto/imfunction.par +noao$proto/imlog.gx +noao$proto/imdex.gx + +noao$proto/funcs.x - +noao$proto/doc/imfunction.hlp + Valdes, September 9, 1986 + 1. Added the "dex" function which is the inverse of the existing "log" + function. + 2. The help page was revised. + +proto$toonedspec: Valdes, June 16, 1986 + 1. Added new task TOONEDSPEC to convert columns or lines of 2D + spectra to 1D spectra. A manual page was also added. This + is a prototype. The task or it's function will eventually + move to the TWODSPEC package. + +====================== +Package reorganization +====================== + +local$dsttoiraf: Valdes, April 7, 1986 + 1. The task resides now on NOAO/VMS SKD:[LOCAL.DAOP] + +local$t_imstack.x: Valdes, April 6, 1986 +local$doc/imstack.hlp: Valdes, April 6, 1986 + 1. Removed warning message about mixed datatypes in IMSTACK. + 2. Updated help page for IMSTACK. + +local$dsttoiraf: Valdes, April 3, 1986 + 1. Added NOAO foreign task to convert DST (DAO) format images to + IRAF images. This task is only available on the NOAO/VMS cluster. + Attempting to run this on any other system will fail. + +local$irafil: Valdes, April 3, 1986 + 1. George Jacoby added the task IRAFIL to convert integer byte + pixel data to an IRAF image. It is an attempt to have a general + dataio conversion for foreign format images. + +=========== +Release 2.2 +=========== + +From Valdes Jan. 24, 1986: + +1. Removed NOTES tasks which was not useful. +------ +August 6, 1985: + +1. Imfunction modified to produce only real datatype output images. +2. Revisions script added. +.endhelp diff --git a/noao/nproto/ace/Notes b/noao/nproto/ace/Notes new file mode 100644 index 00000000..3cdd5b07 --- /dev/null +++ b/noao/nproto/ace/Notes @@ -0,0 +1,12 @@ +o Evaluate centroid in detection phase so that evaluation can + include quantities based on distance from centroid. +o Kron magnitudes +o Add partial pixel +o What to do about contaminating objects in the apertures. + +TODO + +o MapIO - match coordinates for sky fit +o match object mask as part of aceall when outobjmask is given +o reorganize to remove xap,yap,etc from detection phase +o errors in ra/dec and mags diff --git a/noao/nproto/ace/Revisions b/noao/nproto/ace/Revisions new file mode 100644 index 00000000..df309bd9 --- /dev/null +++ b/noao/nproto/ace/Revisions @@ -0,0 +1,89 @@ + +convolve.x + An amovki() call was mistakenly used as amovi() (6/3/13, MJF) + +convolve.x + The 'bpbuf' pointer was declared as TY_REAL instead of TY_INT (5/4/13) + +objs.h + Added P2R for 64-bit systems. + +skyfit.x + If a complete line is exceptionally deviant from the true sky it + will bias the sky surface. As a quick fix for the possibly common + case that the first or last lines are high due to charge transfer + effects, the lines to use was changed to start and end a half step + from the ends. This is only a quick fix and a more sophisticated + solutions is needed. (10/17/02, Valdes) + +skyblock.x + There was another bug in interp2. (10/17/02, Valdes) + +skyblock.x + There was a bug in interp2. (9/30/02, Valdes) + +convolve.x + Fixed error when reference image does not overlap target image on + the right. (9/23/02, Valdes) + +detect.x + The flux comparison in difference detection used sigma normalized + fluxes. This was changed to unnormalized fluxes which is done + by using the same sigmas for the target and reference images. + (9/23/02, Valdes) + +t_acedetect.x +pars.x +diffdetect.pars + Made changes for diffdetect. (9/23/02, Valdes) + +t_acedetect.x + Switched over to the xtools version of xt_pmmap. + (9/10/02, Valdes) + +t_acedetect.x +skyblock.x +omwrite.x + If DATASEC is present then it is automatically applied to the + image. It is also deleted from the output sky and mask since + they will be the size of the data section. (9/10/02, Valdes) + +skyfit.x + The sigma fit is now always a constant. (8/6/02, Valdes) + +skyblock.x + Fixed a type mismatch in a min() function. (6/13/02, Valdes) + +===== +V2.12 +===== + +skyblock.x + Changed algorithm for updating sky to do in place updates so that + extensions might be used. (12/21/01, Valdes) + +detect.x + The number of sky block lines was being wrong in using nc instead of nl. + (12/21/01, Valdes) + +t_acedetect.x + The check on the number of catalog definitions files did not allow + just one file when there was input list. (12/20/01, Valdes) + +t_acedetect.x + The default catalog output is now STSDAS. (5/7/01, Valdes) + +mim.x + When deleting the image name returned from imstats any image section + needed to be stripped. (5/7/01, Valdes) + +mim.x +convolve.x +skyfit.x +skyimages.x + Added error checking for calls to mim_glr. (5/7/01, Valdes) + +catdefine.x + The reference to acesrc$ was replaced with ace$src/ in order to run + standalone without additional environment definitions. (5/7/01, Valdes) + diff --git a/noao/nproto/ace/ace.h b/noao/nproto/ace/ace.h new file mode 100644 index 00000000..988ffd05 --- /dev/null +++ b/noao/nproto/ace/ace.h @@ -0,0 +1,32 @@ +define NUMSTART 11 # First object number + +# Header structure. +define HDR_SZFNAME 99 # Length of filename strings. +define HDR_LEN 101 +define HDR_MAGZERO Memr[P2R($1)] # Magnitude zero point +define HDR_IMAGE Memc[P2C($1+1)] # Image name +define HDR_MASK Memc[P2C($1+51)] # Object mask name + +# Mask Flags. +define MASK_NUM 0077777777B # Mask number +define MASK_BNDRY 0100000000B # Boundary flag +define MASK_SPLIT 0200000000B # Split flag +define MASK_DARK 0400000000B # Dark flag + +define MSETFLAG ori($1,$2) +define MUNSETFLAG andi($1,noti($2)) + +define MNUM (andi($1,MASK_NUM)) +define MNOTDARK (andi($1,MASK_DARK)==0) +define MDARK (andi($1,MASK_DARK)!=0) +define MNOTSPLIT (andi($1,MASK_SPLIT)==0) +define MSPLIT (andi($1,MASK_SPLIT)!=0) +define MNOTBNDRY (andi($1,MASK_BNDRY)==0) +define MBNDRY (andi($1,MASK_BNDRY)!=0) + +# Output object masks types. +define OM_TYPES "|boolean|numbers|colors|all|" +define OM_BOOL 1 # Boolean (0=sky, 1=object+bad) +define OM_ONUM 2 # Object number only +define OM_COLORS 3 # Bad=1, Objects=2-9 +define OM_ALL 4 # All values diff --git a/noao/nproto/ace/acedetect.h b/noao/nproto/ace/acedetect.h new file mode 100644 index 00000000..111d324e --- /dev/null +++ b/noao/nproto/ace/acedetect.h @@ -0,0 +1,27 @@ +# ACEDETECT parameter structure. +define PAR_SZSTR 199 # Length of strings in par structure +define PAR_LEN 128 # Length of parameter structure + +define PAR_IMLIST Memi[$1+$2-1] # List of images (2) +define PAR_BPMLIST Memi[$1+$2+1] # List of bad pixel masks (2) +define PAR_SKYLIST Memi[$1+$2+3] # List of skys (2) +define PAR_SIGLIST Memi[$1+$2+5] # List of sigmas (2) +define PAR_EXPLIST Memi[$1+$2+7] # List of sigmas (2) +define PAR_GAINLIST Memi[$1+$2+9] # List of measurement gain maps (2) +define PAR_SCALELIST Memi[$1+$2+11] # List of scales (2) +define PAR_OMLIST Memi[$1+14] # List of object masks +define PAR_INCATLIST Memi[$1+15] # List of input catalogs +define PAR_OUTCATLIST Memi[$1+16] # List of output catalogs +define PAR_CATDEFLIST Memi[$1+17] # List of catalog definitions +define PAR_LOGLIST Memi[$1+18] # List of log files +define PAR_OUTSKYLIST Memi[$1+19] # List of output sky images +define PAR_OUTSIGLIST Memi[$1+20] # List of output sigma images + +define PAR_SKY Memi[$1+21] # Sky parameters +define PAR_DET Memi[$1+22] # Detection parameters +define PAR_SPT Memi[$1+23] # Split parameters +define PAR_GRW Memi[$1+24] # Grow parameters +define PAR_EVL Memi[$1+25] # Evaluate parameters + +define PAR_OMTYPE Memi[$1+26] # Output object mask type +define PAR_EXTNAMES Memc[P2C($1+27)] # Extensions names diff --git a/noao/nproto/ace/aceoverlay.x b/noao/nproto/ace/aceoverlay.x new file mode 100644 index 00000000..d8622568 --- /dev/null +++ b/noao/nproto/ace/aceoverlay.x @@ -0,0 +1,76 @@ +include <error.h> +include <imhdr.h> +include <imset.h> +include <pmset.h> +include "ace.h" + + +pointer procedure overlay (ovrly, im) + +char ovrly[ARB] #I Overlay name +pointer im #I Reference image +pointer ovr #O Overlay pointer + +int i, j, nc, nl, val +long v[2] +pointer sp, fname, pm, buf + +int nowhite(), andi() +bool pm_linenotempty() +pointer ods_pmmap(), imstati() + +begin + call smark (sp) + call salloc (fname, SZ_FNAME, TY_CHAR) + + if (nowhite (ovrly, Memc[fname], SZ_FNAME) == 0) { + call sfree (sp) + return (NULL) + } + + if (Memc[fname] == '!') { + iferr (call imgstr (im, Memc[fname+1], Memc[fname], SZ_FNAME)) { + call sfree (sp) + return (NULL) + } + } + + iferr (ovr = ods_pmmap (Memc[fname], im)) { + call sfree (sp) + call erract (EA_WARN) + return (NULL) + } + + nc = IM_LEN(ovr,1) + nl = IM_LEN(ovr,2) + pm = imstati (ovr, IM_PMDES) + + call salloc (buf, nc, TY_INT) + + v[1] = 1 + do i = 1, nl { + v[2] = i + if (!pm_linenotempty(pm, v)) + next + call pmglpi (pm, v, Memi[buf], 0, nc, 0) + do j = 0, nc-1 { + val = Memi[buf+j] + if (val == 0) + next + else if (val < NUMSTART) + val = 1 + else { + val = andi (val, MASK_BNDRY) + if (val != 0) + val = mod (andi (Memi[buf+j], MASK_NUM), 9) + 2 + #val = 1 + } + Memi[buf+j] = val + } + call pmplpi (pm, v, Memi[buf], 0, nc, PIX_SRC) + } + + call sfree (sp) + + return (ovr) +end diff --git a/noao/nproto/ace/acesky.h b/noao/nproto/ace/acesky.h new file mode 100644 index 00000000..5773f1a7 --- /dev/null +++ b/noao/nproto/ace/acesky.h @@ -0,0 +1,21 @@ +# Sky parameter structure. +define SKY_LEN 5 # Length of parameter structure + +define SKY_TYPE Memi[$1] # Type of sky algorithm +define SKY_NEWSKY Memi[$1+1] # Determine a new sky sigma? +define SKY_NEWSIG Memi[$1+2] # Determine a new sky sigma? +define SKY_SURPARS Memi[$1+3] # Pointer to parameters for surface fit +define SKY_BLKPARS Memi[$1+4] # Pointer to parameters for block stat + +define SKY_TYPES "|surface|block|" +define SKY_SURFACE 1 # Surface fitting +define SKY_BLOCK 2 # Block statistics + +define SKY_SURPARSLEN 7 # Length of parameter structure +define SKY_NSKYLINES Memi[$1] # Number of sky lines to sample +define SKY_SKYBLK1D Memi[$1+1] # Sky block size for 1D averages +define SKY_SKYHCLIP Memr[P2R($1+2)] # Sky fitting high sigma clip +define SKY_SKYLCLIP Memr[P2R($1+3)] # Sky fitting low sigma clip +define SKY_SKYXORDER Memi[$1+4] # Sky fitting x order +define SKY_SKYYORDER Memi[$1+5] # Sky fitting y order +define SKY_SKYXTERMS Memi[$1+6] # Sky fitting cross terms diff --git a/noao/nproto/ace/bndry.x b/noao/nproto/ace/bndry.x new file mode 100644 index 00000000..0abb0acd --- /dev/null +++ b/noao/nproto/ace/bndry.x @@ -0,0 +1,194 @@ +include <pmset.h> +include "ace.h" + + +# BNDRY -- Flag boundary pixels of unsplit objects. +# Assume the boundary flag is not set. + +procedure bndry (om, logfd) + +pointer om #I Object mask +int logfd #I Logfile + +int i, c, c1, c2, l, nc, nl, num, bndryval, val, vallast +pointer sp, v, irl, irlptr, orl, orlptr, bufs, buf1, buf2, buf3 + +int andi(), ori() + +begin + call smark (sp) + call salloc (v, PM_MAXDIM, TY_LONG) + + if (logfd != NULL) + call fprintf (logfd, " Set boundary mask:\n") + + call pm_gsize (om, nc, Meml[v], nl) + nc = Meml[v]; nl = Meml[v+1] + Meml[v] = 1 + + # Allocate buffers. + call salloc (irl, 3+3*nc, TY_INT) + call salloc (orl, 3+3*nc, TY_INT) + call salloc (bufs, 3, TY_POINTER) + call salloc (Memi[bufs], nc, TY_INT) + call salloc (Memi[bufs+1], nc, TY_INT) + call salloc (Memi[bufs+2], nc, TY_INT) + + Memi[orl+1] = nc + + # First line. + l = 1 + buf2 = Memi[bufs+mod(l,3)] + buf3 = Memi[bufs+mod(2,3)] + + Meml[v+1] = l + 1 + call pmglpi (om, Meml[v], Memi[buf3], 0, nc, 0) + Meml[v+1] = l + call pmglpi (om, Meml[v], Memi[buf2], 0, nc, 0) + call pmglri (om, Meml[v], Memi[irl], 0, nc, 0) + + irlptr = irl + orlptr = orl + do i = 2, Memi[irl] { + irlptr = irlptr + 3 + num = Memi[irlptr+2] + + if (num < NUMSTART || MSPLIT(num)) { + orlptr = orlptr + 3 + Memi[orlptr] = Memi[irlptr] + Memi[orlptr+1] = Memi[irlptr+1] + Memi[orlptr+2] = num + next + } + + bndryval = MSETFLAG (num, MASK_BNDRY) + c1 = Memi[irlptr] - 1 + c2 = c1 + Memi[irlptr+1] - 1 + do c = c1, c2 + Memi[buf2+c] = bndryval + + orlptr = orlptr + 3 + Memi[orlptr] = Memi[irlptr] + Memi[orlptr+1] = Memi[irlptr+1] + Memi[orlptr+2] = bndryval + } + Memi[orl] = 1 + (orlptr - orl) / 3 + call pmplri (om, Meml[v], Memi[orl], 0, nc, PIX_SRC) + + # Interior lines. + do l = 2, nl-1 { + buf1 = Memi[bufs+mod(l-1,3)] + buf2 = Memi[bufs+mod(l,3)] + buf3 = Memi[bufs+mod(l+1,3)] + + Meml[v+1] = l + 1 + call pmglpi (om, Meml[v], Memi[buf3], 0, nc, 0) + Meml[v+1] = l + call pmglri (om, Meml[v], Memi[irl], 0, nc, 0) + + irlptr = irl + orlptr = orl + do i = 2, Memi[irl] { + irlptr = irlptr + 3 + num = Memi[irlptr+2] + + if (num < NUMSTART || MSPLIT(num)) { + orlptr = orlptr + 3 + Memi[orlptr] = Memi[irlptr] + Memi[orlptr+1] = Memi[irlptr+1] + Memi[orlptr+2] = num + next + } + + c1 = Memi[irlptr] - 1 + c2 = c1 + Memi[irlptr+1] - 1 + bndryval = MSETFLAG (num, MASK_BNDRY) + + Memi[buf2+c1] = bndryval + + orlptr = orlptr + 3 + Memi[orlptr] = c1 + 1 + Memi[orlptr+2] = bndryval + vallast = bndryval + + do c = c1+1, c2-1 { + val = num + if (Memi[buf3+c-1] != num) + val = bndryval + else if (Memi[buf3+c] != num) + val = bndryval + else if (Memi[buf3+c+1] != num) + val = bndryval + else if (Memi[buf1+c-1] != num && Memi[buf1+c-1]!=bndryval) + val = bndryval + else if (Memi[buf1+c] != num && Memi[buf1+c] != bndryval) + val = bndryval + else if (Memi[buf1+c+1] != num && Memi[buf1+c+1]!=bndryval) + val = bndryval + + if (val == bndryval) + Memi[buf2+c] = val + + if (val != vallast) { + Memi[orlptr+1] = c - Memi[orlptr] + 1 + orlptr = orlptr + 3 + + Memi[orlptr] = c + 1 + Memi[orlptr+2] = val + vallast = val + } + } + + Memi[buf2+c2] = bndryval + + if (vallast != bndryval) { + Memi[orlptr+1] = c2 - Memi[orlptr] + 1 + orlptr = orlptr + 3 + Memi[orlptr] = c2 + 1 + Memi[orlptr+1] = 1 + Memi[orlptr+2] = bndryval + } else + Memi[orlptr+1] = c2 - Memi[orlptr] + 2 + } + + Memi[orl] = 1 + (orlptr - orl) / 3 + call pmplri (om, Meml[v], Memi[orl], 0, nc, PIX_SRC) + } + + # Last line. + l = nl + buf2 = Memi[bufs+mod(l,3)] + + Meml[v+1] = l + call pmglri (om, Meml[v], Memi[irl], 0, nc, 0) + + irlptr = irl + orlptr = orl + do i = 2, Memi[irl] { + irlptr = irlptr + 3 + num = Memi[irlptr+2] + + if (num < NUMSTART || MSPLIT(num)) { + orlptr = orlptr + 3 + Memi[orlptr] = Memi[irlptr] + Memi[orlptr+1] = Memi[irlptr+1] + Memi[orlptr+2] = num + next + } + + bndryval = MSETFLAG (num, MASK_BNDRY) + c1 = Memi[irlptr] - 1 + c2 = c1 + Memi[irlptr+1] - 1 + do c = c1, c2 + Memi[buf2+c] = bndryval + + orlptr = orlptr + 3 + Memi[orlptr] = Memi[irlptr] + Memi[orlptr+1] = Memi[irlptr+1] + Memi[orlptr+2] = bndryval + } + Memi[orl] = 1 + (orlptr - orl) / 3 + call pmplri (om, Meml[v], Memi[orl], 0, nc, PIX_SRC) + + call sfree (sp) +end diff --git a/noao/nproto/ace/cat.h b/noao/nproto/ace/cat.h new file mode 100644 index 00000000..39a7ed8a --- /dev/null +++ b/noao/nproto/ace/cat.h @@ -0,0 +1,45 @@ +# Catalog structure. +define CAT_SZSTR 99 # Length of catalog string +define CAT_LEN 160 # Length of catalog structure +define CAT_OBJS Memi[$1] # Array of objects (ptr) +define CAT_APFLUX Memi[$1+1] # Array of aperture fluxes (ptr) +define CAT_NOBJS Memi[$1+2] # Number of objects +define CAT_NUMMAX Memi[$1+3] # Maximum object number +define CAT_FLAGS Memi[$1+4] # Catalog flags +define CAT_HDR Memi[$1+5] # Header structure +define CAT_INTBL Memi[$1+6] # Input table structure +define CAT_OUTTBL Memi[$1+7] # Output table structure +define CAT_MAGZERO Memr[P2R($1+8)] # Magnitude zero +define CAT_CATALOG Memc[P2C($1+10)] # Catalog name +define CAT_OBJID Memc[P2C($1+60)] # Default ID +define CAT_STRPTR P2C($1+110) # Working string buffer +define CAT_STR Memc[CAT_STRPTR($1)] # Working string buffer + +# Table structure. +define TBL_LEN 2 +define TBL_TP Memi[$1] # Table pointer +define TBL_STP Memi[$1+1] # Symbol table of entries + +# Entry structure. +define ENTRY_ULEN 19 # Length of units string +define ENTRY_FLEN 19 # Length of format string +define ENTRY_DLEN 99 # Length of description string +define ENTRY_LEN 95 # Length of entry structure +define ENTRY_CDEF Memi[$1] # Column descriptor +define ENTRY_ID Memi[$1+1] # Entry id +define ENTRY_TYPE Memi[$1+2] # Datatype in object record +define ENTRY_CTYPE Memi[$1+3] # Datatype in catalog +define ENTRY_FUNC Memi[$1+4] # Entry function +define ENTRY_RAP Memr[P2R($1+5)] # Entry aperture radius +define ENTRY_UNITS Memc[P2C($1+6)] # Entry units (19) +define ENTRY_FORMAT Memc[P2C($1+26)] # Entry format (19) +define ENTRY_DESC Memc[P2C($1+46)] # Entry description (99) + +define FUNCS "|MAG|" +define FUNC_MAG 1 # Magnitude + +# Catalog extensions. +define CATEXTNS "|fits|tab|" + +# Catalog Parameters. +define CATPARAMS "|image|mask|objid|catalog|nobjects|magzero|" diff --git a/noao/nproto/ace/catdef.desc b/noao/nproto/ace/catdef.desc new file mode 100644 index 00000000..2c1a989c --- /dev/null +++ b/noao/nproto/ace/catdef.desc @@ -0,0 +1,73 @@ +# This describes the currently available catalog definition entries +# available and the format. + +# Comments begining with '#' are ignored. +# Order of lines determines order in catalog. +# Case is ignored though labels in catalog will be as given in file. + +ACE_NAME [OPTIONAL USER NAME FOR CATALOG] + +# There are a few functions currently available. + +MAG(ACE_NAME) +APFLUX(radius_in_pixels) +MAG(APFLUX(radius_in_pixels)) + + +# Basic quantities. +NUM Object number +PNUM Parent number (0 if original detection) +NPIX Number of pixels +NDETECT Number of detected pixels (before growing) +FLAGS Flags (currently on M for multiple object) + +# Fluxes +FLUX Isophotal flux +FRACFLUX Apportioned flux (TOTMAG) +APFLUX(radius) Aperture fluxes (radius in pixels) +SKY Mean sky +PEAK Peak pixel value above sky +ISIGAVG Average (I - sky) / sig +ISIGMAX Maximum (I - sky) / sig + +# Positions +WX X world coordinate (requires WCS in header) +WY Y world coordinate (requires WCS in header) +X1 X centroid (pixels) +Y1 Y centroid (pixels) +XAP X aperture coordinate (centroid initially then not changed) +YAP Y aperture coordinate (centroid initially then not changed) +XMIN Minimum X (pixels) +XMAX Maxium X (pixels) +YMIN Minimum Y (pixels) +YMAX Maxium Y (pixels) + +# Miscellaneous +SIG Mean sky sigma +FRAC Apportioned fraction + +X2 X 2nd moment (pixels) +Y2 Y 2nd moment (pixels) +XY X 2nd cross moment (pixels) + +# Derived quantities. +A Semimajor axis +B Semiminor axis +THETA Position angle (degrees) +ELONG Elongation = A/B +ELLIP Ellipticity = 1 - B/A +R Second moment radius (pixels) +CXX Second moment ellipse (pixels) +CYY Second moment ellipse (pixels) +CXY Second moment ellipse (pixels) + +# Error estimates. +FLUXERR Error in flux +XERR Error in X centroid (pixels) +YERR Error in Y centroid (pixels) +AERR Error in A +BERR Error in B +THETAERR Error in THETA (degrees) +CXXERR Error in CXX (pixels) +CYYERR Error in CYY (pixels) +CXYERR Error in CXY (pixels) diff --git a/noao/nproto/ace/catdefine.x b/noao/nproto/ace/catdefine.x new file mode 100644 index 00000000..038f85d9 --- /dev/null +++ b/noao/nproto/ace/catdefine.x @@ -0,0 +1,192 @@ +include "ace.h" +include "cat.h" +include "objs.h" + + +define CATDEF "ace$lib/catdef.dat" + +# CATDEF -- Read catalog definition file and create symbol table. + +procedure catdefine (tbl, mode, catdef) + +pointer tbl #I Table pointer +int mode #I Table access mode +char catdef[ARB] #I Catalog definition file + +int i, n, fd, args, func, ncols +pointer sp, fname, name, label, str, entry, sym +pointer stp1, stp2, tp + +bool strne() +int open(), fscan(), nscan(), strncmp(), ctoi(), ctor() +int stridxs(), strldxs(), strdic() +pointer stopen(), stenter(), stfind(), sthead(), stnext(), stname() +errchk open, stopen, tbcdef1, tbcfnd1 + +define err_ 10 + +begin + call smark (sp) + call salloc (fname, SZ_FNAME, TY_CHAR) + call salloc (name, SZ_FNAME, TY_CHAR) + call salloc (label, SZ_LINE, TY_CHAR) + call salloc (str, SZ_LINE, TY_CHAR) + call salloc (entry, ENTRY_LEN, TY_STRUCT) + call aclri (Memi[entry], ENTRY_LEN) + + # Build a symbol table from ace$objs.h. + fd = open ("ace$src/objs.h", READ_ONLY, TEXT_FILE) + stp1 = stopen ("catdefine", 100, ENTRY_LEN, SZ_LINE) + while (fscan(fd) != EOF) { + Memc[fname] = EOS + call gargwrd (Memc[fname], SZ_FNAME) + if (strne (Memc[fname], "define")) + next + call gargwrd (Memc[name], SZ_FNAME) + if (strncmp (Memc[name], "ID_", 3) != 0) + next + call gargi (ENTRY_ID(entry)) + call gargwrd (Memc[label], SZ_LINE) + if (Memc[label] != '#') + next + call gargwrd (Memc[label], SZ_LINE) + call gargwrd (ENTRY_UNITS(entry), ENTRY_ULEN) + call gargwrd (ENTRY_FORMAT(entry), ENTRY_FLEN) + call gargstr (ENTRY_DESC(entry), ENTRY_DLEN) + if (nscan() < 7) + next + switch (Memc[label]) { + case 'i': + ENTRY_TYPE(entry) = TY_INT + case 'r': + ENTRY_TYPE(entry) = TY_REAL + case 'd': + ENTRY_TYPE(entry) = TY_DOUBLE + default: + i = 1 + if (ctoi (Memc[label], i, ENTRY_TYPE(entry)) == 0) + next + ENTRY_TYPE(entry) = -ENTRY_TYPE(entry) + } + ENTRY_CTYPE(entry) = ENTRY_TYPE(entry) + sym = stenter (stp1, Memc[name+3], ENTRY_LEN) + call amovi (Memi[entry], Memi[sym], ENTRY_LEN) + } + call close (fd) + + if (tbl != NULL) + tp = TBL_TP(tbl) + + # Read the definition file. + if (catdef[1] == EOS) + call strcpy (CATDEF, Memc[fname], SZ_FNAME) + else + call strcpy (catdef, Memc[fname], SZ_FNAME) + fd = open (Memc[fname], READ_ONLY, TEXT_FILE) + stp2 = stopen ("catdefine", 100, ENTRY_LEN, SZ_LINE) + ncols = 0 + while (fscan(fd) != EOF) { + call gargwrd (Memc[name], SZ_FNAME) + call gargwrd (Memc[label], SZ_LINE) + n = nscan() + if (n == 0) + next + if (Memc[name] == '#') + next + + # Parse the name. + call strcpy (Memc[name], Memc[str], SZ_LINE) + call strupr (Memc[str]) + args = stridxs ("(", Memc[str]) + 1 + if (args > 1) { + i = strldxs (")", Memc[str]) + Memc[str+args-2] = EOS + Memc[str+i-1] = EOS + func = strdic (Memc[str], Memc[fname], SZ_FNAME, FUNCS) + if (func == 0) { + call strcpy (Memc[name], Memc[str], SZ_LINE) + call strupr (Memc[str]) + } else + call strcpy (Memc[str+args-1], Memc[str], SZ_LINE) + + args = stridxs ("(", Memc[str]) + 1 + if (args > 1) { + i = strldxs (")", Memc[str]) + Memc[str+args-2] = EOS + Memc[str+i-1] = EOS + sym = stfind (stp1, Memc[str]) + } else + sym = stfind (stp1, Memc[str]) + } else { + sym = stfind (stp1, Memc[str]) + func = 0 + } + + if (sym == NULL) { +err_ + call stclose (stp1) + call stclose (stp2) + call close (fd) + call sprintf (Memc[label], SZ_LINE, + "Unknown or ambiguous catalog quantity `%s' in definition file `%s'") + call pargstr (Memc[name]) + call pargstr (Memc[fname]) + call error (1, Memc[label]) + } + ncols = ncols + 1 + if (tbl == NULL) + next + + if (n == 1) + call strcpy (Memc[name], Memc[label], SZ_LINE) + + entry = stenter (stp2, Memc[label], ENTRY_LEN) + call amovi (Memi[sym], Memi[entry], ENTRY_LEN) + ENTRY_FUNC(entry) = func + + switch (ENTRY_FUNC(entry)) { + case FUNC_MAG: + ENTRY_CTYPE(entry) = TY_REAL + call strcpy ("magnitudes", ENTRY_UNITS(entry), ENTRY_ULEN) + ENTRY_FORMAT(entry) = EOS + } + + if (mode == NEW_FILE) + call tbcdef1 (tp, ENTRY_CDEF(entry), Memc[label], + ENTRY_UNITS(sym), ENTRY_FORMAT(sym), ENTRY_CTYPE(sym), 1) + else + call tbcfnd1 (tp, Memc[label], ENTRY_CDEF(entry)) + + # Get arguments. + switch (ENTRY_ID(entry)) { + case ID_APFLUX: + if (ctor (Memc[name], args, ENTRY_RAP(entry)) == 0) + goto err_ + } + } + call close (fd) + call stclose (stp1) + + if (tbl == NULL) + return + + if (ncols == 0) { + call stclose (stp2) + call sprintf (Memc[label], SZ_LINE, + "No catalog quantity definitions in file `%s'") + call pargstr (Memc[fname]) + call error (1, Memc[label]) + } + + # Reverse order of symbol table. + stp1 = stopen ("catdef", ncols, ENTRY_LEN, SZ_LINE) + for (sym=sthead(stp2); sym!=NULL; sym=stnext(stp2,sym)) { + entry = stenter (stp1, Memc[stname(stp2,sym)], ENTRY_LEN) + call amovi (Memi[sym], Memi[entry], ENTRY_LEN) + } + call stclose (stp2) + + TBL_STP(tbl) = stp1 + + call sfree (sp) +end diff --git a/noao/nproto/ace/catio.x b/noao/nproto/ace/catio.x new file mode 100644 index 00000000..1fbae947 --- /dev/null +++ b/noao/nproto/ace/catio.x @@ -0,0 +1,931 @@ +include <imset.h> +#include <tbset.h> +define TBL_NROWS 0 +include <math.h> +include "ace.h" +include "cat.h" +include "objs.h" + + +# CATOPEN -- Open a catalog. +# This may be used just to allocate the structure or to actually open +# a catalog file. It does not read the objects. Use catrobjs. + +procedure catopen (cat, input, output, catdef) + +pointer cat #U Catalog structure +char input[ARB] #I Input catalog name +char output[ARB] #I Output catalog name +char catdef[ARB] #I Catalog definition file + +pointer tbl + +bool streq() +pointer tbtopn() + +begin + if (cat == NULL) + call calloc (cat, CAT_LEN, TY_STRUCT) + + if (input[1] == EOS && output[1] == EOS) + return + + if (streq (input, output)) { # READ_WRITE + call calloc (tbl, TBL_LEN, TY_STRUCT) + CAT_INTBL(cat) = tbl + CAT_OUTTBL(cat) = tbl + + TBL_TP(tbl) = tbtopn (input, READ_WRITE, 0) + call catdefine (tbl, READ_ONLY, catdef) + call catrhdr (cat) + } else if (output[1] == EOS) { # READ_ONLY + call calloc (tbl, TBL_LEN, TY_STRUCT) + CAT_INTBL(cat) = tbl + CAT_OUTTBL(cat) = NULL + + TBL_TP(tbl) = tbtopn (input, READ_ONLY, 0) + call catdefine (tbl, READ_ONLY, catdef) + call catrhdr (cat) + } else if (input[1] == EOS) { # NEW_FILE + call calloc (tbl, TBL_LEN, TY_STRUCT) + CAT_INTBL(cat) = NULL + CAT_OUTTBL(cat) = tbl + + TBL_TP(tbl) = tbtopn (output, NEW_FILE, 0) + call catdefine (tbl, NEW_FILE, catdef) + } else { # NEW_COPY + call calloc (tbl, TBL_LEN, TY_STRUCT) + CAT_INTBL(cat) = tbl + + TBL_TP(tbl) = tbtopn (input, READ_ONLY, 0) + call catdefine (tbl, NEW_COPY, catdef) + call catrhdr (cat) + + call calloc (tbl, TBL_LEN, TY_STRUCT) + CAT_OUTTBL(cat) = tbl + TBL_TP(tbl) = tbtopn (output, NEW_COPY, TBL_TP(CAT_INTBL(cat))) + call catdefine (tbl, NEW_COPY, catdef) + } +end + + +procedure catcreate (cat) + +pointer cat #I Catalog structure + +pointer tbl, tp + +begin + if (cat == NULL) + return + tbl = CAT_OUTTBL(cat) + if (tbl == NULL) + return + tp = TBL_TP(tbl) + if (tp == NULL) + return + if (CAT_INTBL(cat) != NULL) { + if (tp == TBL_TP(CAT_INTBL(cat))) + return + } + call tbtcre (tp) +end + + +# CATCLOSE -- Close a catalog. + +procedure catclose (cat) + +pointer cat #I Catalog pointer + +int i +pointer tbl, objs + +begin + if (cat == NULL) + return + + tbl = CAT_INTBL(cat) + if (tbl != NULL) { + if (TBL_STP(tbl) != NULL) + call stclose (TBL_STP(tbl)) + if (tbl == CAT_OUTTBL(cat)) + CAT_OUTTBL(cat) = NULL + call tbtclo (TBL_TP(tbl)) + } + tbl = CAT_OUTTBL(cat) + if (tbl != NULL) { + if (TBL_STP(tbl) != NULL) + call stclose (TBL_STP(tbl)) + call tbtclo (TBL_TP(tbl)) + } + + objs = CAT_OBJS(cat) + if (objs != NULL) { + do i = 0, CAT_NUMMAX(cat)-1 + call mfree (Memi[objs+i], TY_STRUCT) + } + + call mfree (CAT_APFLUX(cat), TY_REAL) + call mfree (CAT_OBJS(cat), TY_POINTER) + call mfree (CAT_INTBL(cat), TY_STRUCT) + call mfree (CAT_OUTTBL(cat), TY_STRUCT) + call mfree (CAT_HDR(cat), TY_STRUCT) + call mfree (cat, TY_STRUCT) +end + + +# CATGETS -- Get a string parameter from the catalog header. + +procedure catgets (cat, param, value, maxchar) + +pointer cat #I Catalog pointer +char param[ARB] #I Parameter to get +char value[ARB] #O Returned value +int maxchar #I Maximum characters in value + +int i, strdic() + +begin + value[1] = EOS + + if (cat == NULL) + return + + i = strdic (param, CAT_STR(cat), CAT_SZSTR, CATPARAMS) + switch (i) { + case 1: + if (CAT_HDR(cat) == NULL) + i = 0 + else + call strcpy (HDR_IMAGE(CAT_HDR(cat)), value, maxchar) + case 2: + if (CAT_HDR(cat) == NULL) + i = 0 + else + call strcpy (HDR_MASK(CAT_HDR(cat)), value, maxchar) + case 3: + call strcpy (CAT_OBJID(cat), value, maxchar) + case 4: + call strcpy (CAT_CATALOG(cat), value, maxchar) + default: + call sprintf (CAT_STR(cat), CAT_SZSTR, + "catgets: unknown catalog parameter `%s'") + call pargstr (param) + call error (1, CAT_STR(cat)) + } + + if (i == 0) { + call sprintf (CAT_STR(cat), CAT_SZSTR, + "catgets: parameter `%s' not found") + call pargstr (param) + call error (1, CAT_STR(cat)) + } +end + + +procedure catgeti (cat, param, value) + +pointer cat #I Catalog pointer +char param[ARB] #I Parameter to get +int value #O Returned value + +int i, strdic() + +begin + value = INDEFI + + if (cat == NULL) + return + + i = strdic (param, CAT_STR(cat), CAT_SZSTR, CATPARAMS) + switch (i) { + case 5: + value = CAT_NOBJS(cat) + default: + call sprintf (CAT_STR(cat), CAT_SZSTR, + "catgeti: unknown catalog parameter `%s'") + call pargstr (param) + call error (1, CAT_STR(cat)) + } +end + + +procedure catputs (cat, param, value) + +pointer cat #I Catalog pointer +char param[ARB] #I Parameter to get +char value[ARB] #I Value + +int i, strdic() + +begin + if (cat == NULL) + return + + i = strdic (param, CAT_STR(cat), CAT_SZSTR, CATPARAMS) + switch (i) { + case 0: + call sprintf (CAT_STR(cat), CAT_SZSTR, + "catgets: unknown catalog parameter `%s'") + call pargstr (param) + call error (1, CAT_STR(cat)) + case 1: + if (CAT_HDR(cat) == NULL) + call calloc (CAT_HDR(cat), HDR_LEN, TY_STRUCT) + call strcpy (value, HDR_IMAGE(CAT_HDR(cat)), HDR_SZFNAME) + case 2: + if (CAT_HDR(cat) == NULL) + call calloc (CAT_HDR(cat), HDR_LEN, TY_STRUCT) + call strcpy (value, HDR_MASK(CAT_HDR(cat)), HDR_SZFNAME) + case 3: + call strcpy (value, CAT_OBJID(cat), CAT_SZSTR) + case 4: + call strcpy (value, CAT_CATALOG(cat), CAT_SZSTR) + } +end + + +procedure catputr (cat, param, value) + +pointer cat #I Catalog pointer +char param[ARB] #I Parameter to get +real value #I Value + +int i, strdic() + +begin + if (cat == NULL) + return + + i = strdic (param, CAT_STR(cat), CAT_SZSTR, CATPARAMS) + switch (i) { + case 6: + if (CAT_HDR(cat) == NULL) + call calloc (CAT_HDR(cat), HDR_LEN, TY_STRUCT) + HDR_MAGZERO(CAT_HDR(cat)) = value + default: + call sprintf (CAT_STR(cat), CAT_SZSTR, + "catgetr: unknown catalog parameter `%s'") + call pargstr (param) + call error (1, CAT_STR(cat)) + } +end + + +procedure catrobjs (cat, filt) + +pointer cat #I Catalog pointer +char filt[ARB] #I Filter string + +int i, num, nrows, nobjs, nummax, nalloc, tbpsta() +pointer tbl, tp, objs, obj +bool filter() + +begin + if (cat == NULL) + return + + tbl = CAT_INTBL(cat) + if (tbl == NULL) + return + tp = TBL_TP(tbl) + + nrows = tbpsta (tp, TBL_NROWS) + nalloc = nrows + NUMSTART - 1 + call calloc (objs, nalloc, TY_POINTER) + + nobjs = 0 + nummax = 0 + obj = NULL + do i = 1, nrows { + call catrobj (cat, obj, i) + if (!filter (obj, filt)) + next + num = OBJ_NUM(obj) + if (num > nalloc) { + nalloc = nalloc + 1000 + call realloc (objs, nalloc, TY_POINTER) + call aclri (Memi[objs+nalloc-1000], 1000) + } + if (Memi[objs+num-1] == NULL) + nobjs = nobjs + 1 + nummax = max (num, nummax) + Memi[objs+num-1] = obj + obj = NULL + } + + CAT_OBJS(cat) = objs + CAT_NOBJS(cat) = nobjs + CAT_NUMMAX(cat) = nummax +end + + +procedure catrobj (cat, obj, row) + +pointer cat #I Catalog pointer +pointer obj #U Object pointer +int row #I Table row + +int id, type, ori() +pointer tbl, tp, stp, sym, cdef, sthead(), stnext() + +begin + if (cat == NULL) + return + + tbl = CAT_INTBL(cat) + if (tbl == NULL) + return + + tp = TBL_TP(tbl) + stp = TBL_STP(tbl) + + if (obj == NULL) + call calloc (obj, OBJ_LEN, TY_STRUCT) + + for (sym=sthead(stp); sym!=NULL; sym=stnext(stp,sym)) { + id = ENTRY_ID(sym) + if (id > 1000 || id == ID_APFLUX) + next + switch (id) { + case ID_FLAGS: + OBJ_FLAGS(obj) = 0 + ifnoerr (call tbegtt (tp, cdef, row, CAT_STR(cat), CAT_SZSTR)) { + if (Memc[CAT_STRPTR(cat)] == 'M') + SETFLAG(obj,OBJ_SPLIT) + } + next + } + + type = ENTRY_TYPE(sym) + cdef = ENTRY_CDEF(sym) + switch (type) { + case TY_INT: + iferr (call tbegti (tp, cdef, row, OBJI(obj,id))) + OBJI(obj,id) = INDEFI + case TY_REAL: + iferr (call tbegtr (tp, cdef, row, OBJR(obj,id))) + OBJR(obj,id) = INDEFR + case TY_DOUBLE: + iferr (call tbegtd (tp, cdef, row, OBJD(obj,id))) + OBJD(obj,id) = INDEFD + default: + iferr (call tbegtt (tp, cdef, row, OBJC(obj,id), -type)) + OBJC(obj,id) = EOS + } + } + + OBJ_ROW(obj) = row +end + + +procedure catwobj (cat, obj, row) + +pointer cat #I Catalog pointer +pointer obj #I Object pointer +int row #I Table row + +int ival +real rval +double dval +pointer sval + +int id, type, func, napr, andi() +real magzero, a, b, theta, elong, ellip, r, cxx, cyy, cxy +real aerr, berr, thetaerr, cxxerr, cyyerr, cxyerr +bool doshape +pointer tbl, tp, stp, sym, cdef, sthead(), stnext() + +begin + if (obj == NULL) + return + + tbl = CAT_OUTTBL(cat) + if (tbl == NULL) + return + tp = TBL_TP(tbl) + stp = TBL_STP(tbl) + + #call sprintf (CAT_STR(cat), CAT_SZSTR, "%s-%d") + # if (OBJ_OBJID(obj) != NULL) + # call pargstr (Memc[OBJ_OBJID(obj)]) + # else + # call pargstr (CAT_OBJID(cat)) + # call pargi (OBJ_NUM(obj)) + #call tbeptt (tp, TBL_BJID(tbl), row, CAT_STR(cat)) + #call tbeptt (tp, TBL_CLASS(tbl), row, OBJ_CLASS(obj)) + + magzero = CAT_MAGZERO(cat) + if (IS_INDEFR(magzero)) + magzero = 0. + sval = CAT_STRPTR(cat) + napr = 0 + doshape = false + for (sym=sthead(stp); sym!=NULL; sym=stnext(stp,sym)) { + id = ENTRY_ID(sym) + func = ENTRY_FUNC(sym) + type = ENTRY_TYPE(sym) + cdef = ENTRY_CDEF(sym) + if (id > 1000) { + switch (id) { + case ID_A, ID_B, ID_THETA, ID_ELONG, ID_ELLIP, ID_R, ID_CXX, + ID_CYY, ID_CXY: + if (!doshape) { + call catshape (obj, a, b, theta, elong, ellip, r, + cxx, cyy, cxy, aerr, berr, thetaerr, cxxerr, + cyyerr, cxyerr) + doshape = true + } + switch (id) { + case ID_A: + rval = a + case ID_B: + rval = b + case ID_THETA: + rval = theta + case ID_ELONG: + rval = elong + case ID_ELLIP: + rval = ellip + case ID_R: + rval = r + case ID_CXX: + rval = cxx + case ID_CYY: + rval = cyy + case ID_CXY: + rval = cxy + } + case ID_FLUXERR, ID_XERR, ID_YERR: + switch (id) { + case ID_FLUXERR: + rval = OBJ_FLUXVAR(obj) + case ID_XERR: + rval = OBJ_XVAR(obj) + case ID_YERR: + rval = OBJ_YVAR(obj) + } + if (IS_INDEFR(rval) || rval < 0.) + rval = INDEFR + else + rval = sqrt (rval) + case ID_AERR, ID_BERR, ID_THETAERR, ID_CXXERR, ID_CYYERR, + ID_CXYERR: + if (!doshape) { + call catshape (obj, a, b, theta, elong, ellip, r, + cxx, cyy, cxy, aerr, berr, thetaerr, cxxerr, + cyyerr, cxyerr) + doshape = true + } + switch (id) { + case ID_AERR: + rval = aerr + case ID_BERR: + rval = aerr + case ID_THETAERR: + rval = aerr + case ID_CXXERR: + rval = aerr + case ID_CYYERR: + rval = aerr + case ID_CXYERR: + rval = aerr + } + } + } else if (id == ID_FLAGS) { + if (SPLIT(obj)) + call strcpy ("M", Memc[sval], SZ_LINE) + else + call strcpy ("-", Memc[sval], SZ_LINE) + } else if (id == ID_APFLUX) { + if (OBJ_APFLUX(obj) == NULL) + rval = INDEFR + else { + rval = Memr[OBJ_APFLUX(obj)+napr] + napr = napr + 1 + } + } else { + switch (type) { + case TY_INT: + ival = OBJI(obj,id) + case TY_REAL: + rval = OBJR(obj,id) + case TY_DOUBLE: + dval = OBJD(obj,id) + default: + call strcpy (OBJC(obj,id), Memc[sval], SZ_LINE) + } + } + + # Apply function. + if (func > 0) { + if (ENTRY_CTYPE(sym) != type) { + # For now all function types are real. + switch (type) { + case TY_INT: + rval = ival + case TY_DOUBLE: + rval = dval + } + } + type = ENTRY_CTYPE(sym) + switch (func) { + case FUNC_MAG: + if (!IS_INDEFR(rval)) { + if (rval <= 0.) + rval = INDEFR + else + rval = -2.5 * log10 (rval) + magzero + } + } + } + + # Write to catalog. + switch (type) { + case TY_INT: + call tbepti (tp, cdef, row, ival) + case TY_REAL: + call tbeptr (tp, cdef, row, rval) + case TY_DOUBLE: + call tbeptd (tp, cdef, row, dval) + default: + call tbeptt (tp, cdef, row, Memc[sval]) + } + } + OBJ_ROW(obj) = row +end + + +# CATWCS -- Set catalog WCS information. + +procedure catwcs (cat, im) + +pointer cat #I Catalog pointer +pointer im #I IMIO pointer + +int i +pointer sp, axtype, label, units, format +pointer mw, tbl, tp, stp, sym, cdef + +bool streq() +pointer mw_openim(), sthead(), stnext(), stname() +errchk mw_openim + +begin + if (cat == NULL) + return + if (CAT_OUTTBL(cat) == NULL) + return + + call smark (sp) + call salloc (axtype, SZ_FNAME, TY_CHAR) + call salloc (label, SZ_FNAME, TY_CHAR) + call salloc (units, SZ_FNAME, TY_CHAR) + call salloc (format, SZ_FNAME, TY_CHAR) + + tbl = CAT_OUTTBL(cat) + tp = TBL_TP(tbl) + stp = TBL_STP(tbl) + + mw = mw_openim (im) + do i = 1, 2 { + iferr (call mw_gwattrs (mw, i, "axtype", Memc[axtype], SZ_FNAME)) + Memc[axtype] = EOS + iferr (call mw_gwattrs (mw, i, "label", Memc[label], SZ_FNAME)) { + if (streq (Memc[axtype], "ra")) + call strcpy ("RA", Memc[label], SZ_FNAME) + else if (streq (Memc[axtype], "dec")) + call strcpy ("DEC", Memc[label], SZ_FNAME) + else + Memc[label] = EOS + } + iferr (call mw_gwattrs (mw, i, "units", Memc[units], SZ_FNAME)) { + if (streq (Memc[axtype], "ra") || streq (Memc[axtype], "dec")) + call strcpy ("deg", Memc[units], SZ_FNAME) + else + Memc[units] = EOS + } + iferr (call mw_gwattrs (mw, i, "format", Memc[format], SZ_FNAME)) { + if (streq (Memc[axtype], "ra")) + call strcpy ("%.2H", Memc[format], SZ_FNAME) + else if (streq (Memc[axtype], "dec")) + call strcpy ("%.1h", Memc[format], SZ_FNAME) + else + Memc[format] = EOS + } + + if (i == 1) { + for (sym=sthead(stp); sym!=NULL; sym=stnext(stp,sym)) { + if (ENTRY_ID(sym) != ID_WX) + next + if (!(streq (Memc[stname(stp,sym)], "WX") || + streq (Memc[stname(stp,sym)], "wx"))) + Memc[label] = EOS + break + } + } else { + for (sym=sthead(stp); sym!=NULL; sym=stnext(stp,sym)) { + if (ENTRY_ID(sym) != ID_WY) + next + if (!(streq (Memc[stname(stp,sym)], "WY") || + streq (Memc[stname(stp,sym)], "wy"))) + Memc[label] = EOS + break + } + } + + if (sym != NULL) { + cdef = ENTRY_CDEF(sym) + if (Memc[label] != EOS) + call tbcnam (tp, cdef, Memc[label]) + if (Memc[units] != EOS) + call tbcnit (tp, cdef, Memc[units]) + if (Memc[format] != EOS) + call tbcfmt (tp, cdef, Memc[format]) + } + } + call mw_close (mw) + + call sfree (sp) +end + + +procedure catrhdr (cat) + +pointer cat #I Catalog pointer + +pointer tp, hdr + +begin + if (cat == NULL) + return + + if (CAT_HDR(cat) != NULL) + call mfree (CAT_HDR(cat), TY_STRUCT) + if (CAT_INTBL(cat) == NULL) + return + tp = TBL_TP(CAT_INTBL(cat)) + + call calloc (CAT_HDR(cat), HDR_LEN, TY_STRUCT) + hdr = CAT_HDR(cat) + + iferr (call tbhgtt (tp, "IMAGE", HDR_IMAGE(hdr), HDR_SZFNAME)) + HDR_IMAGE(hdr) = EOS + iferr (call tbhgtt (tp, "MASK", HDR_MASK(hdr), HDR_SZFNAME)) + HDR_MASK(hdr) = EOS + iferr (call tbhgtr (tp, "MAGZERO", HDR_MAGZERO(hdr))) + HDR_MAGZERO(hdr) = INDEFR +end + + +procedure catwhdr (cat, im) + +pointer cat #I Catalog pointer +pointer im #I Image pointer + +pointer tp, hdr + +begin + if (cat == NULL) + return + + tp = CAT_OUTTBL(cat) + hdr = CAT_HDR(cat) + if (tp == NULL || hdr == NULL) + return + tp = TBL_TP(tp) + + if (HDR_IMAGE(hdr) != EOS) + call tbhadt (tp, "IMAGE", HDR_IMAGE(hdr)) + if (HDR_MASK(hdr) != EOS) + call tbhadt (tp, "MASK", HDR_MASK(hdr)) + if (!IS_INDEFR(HDR_MAGZERO(hdr))) + call tbhadr (tp, "MAGZERO", HDR_MAGZERO(hdr)) +end + + +procedure catwobjs (cat) + +pointer cat #I Catalog pointer + +int i, j +pointer objs, obj + +begin + if (cat == NULL) + return + if (CAT_OUTTBL(cat) == NULL) + return + if (CAT_OBJS(cat) == NULL) + return + + objs = CAT_OBJS(cat) + j = 0 + do i = 1, CAT_NUMMAX(cat) { + obj = Memi[objs+i-1] + if (obj == NULL) + next + j = j + 1 + call catwobj (cat, obj, j) + } +end + + + +procedure catdump (cat) + +pointer cat #I Catalog pointer + +int i +pointer objs, obj + +begin + if (CAT_OBJS(cat) == NULL) + return + + objs = CAT_OBJS(cat) + do i = 1, CAT_NUMMAX(cat) { + obj = Memi[objs+i-1] + if (obj == NULL) + next + + call printf ("%d %d %g %g\n") + call pargi (OBJ_NUM(obj)) + call pargi (OBJ_NPIX(obj)) + call pargr (OBJ_XAP(obj)) + call pargr (OBJ_YAP(obj)) + } +end + + +# CATGOBJ -- Get object given the object number. +# +# Currently this relies on the object pointer array being indexed by +# object number. + +pointer procedure catgobj (cat, num) + +pointer cat #I Catalog +int num #I Object number + +begin + return (Memi[CAT_OBJS(cat)+num-1]) +end + + +# These currently work on the object number but eventually there will be +# an array of indices to allow traversing the objects in some sorted order. + +pointer procedure cathead (cat) + +pointer cat #I Catalog pointer + +int i +pointer objs, obj + +begin + objs = CAT_OBJS(cat) + do i = 0, CAT_NUMMAX(cat)-1 { + obj = Memi[objs+i] + if (obj != NULL) + return (obj) + } + return (NULL) +end + + +pointer procedure catnext (cat, obj) + +pointer cat #I Catalog pointer +pointer obj #I Input object pointer + +int i +pointer objs, objnext + +begin + if (obj == NULL) + return (NULL) + + objs = CAT_OBJS(cat) + do i = OBJ_NUM(obj), CAT_NUMMAX(cat)-1 { + objnext = Memi[objs+i] + if (objnext != NULL) + return (objnext) + } + return (NULL) +end + + +procedure catshape (obj, a, b, theta, elong, ellip, r, cxx, cyy, cxy, + aerr, berr, thetaerr, cxxerr, cyyerr, cxyerr) + +pointer obj #I Object structure +real a #O Semimajor axis based on second moments +real b #O Semiminor axis based on second moments +real theta #O Position angle based on second moments +real elong #O Elongation (A/B) +real ellip #O Ellipticity (1 - B/A) +real r #O Radius based on second moments +real cxx, cyy, cxy #O Ellipse parameters based on second moments +real aerr, berr, thetaerr #O Errors +real cxxerr, cyyerr, cxyerr #O Errors + +bool doerr +real x2, y2, xy, r2, d, f +real xvar, yvar, xycov, rvar, dvar, fvar + +begin + a = INDEFR + b = INDEFR + theta = INDEFR + elong = INDEFR + ellip = INDEFR + r = INDEFR + aerr = INDEFR + berr = INDEFR + thetaerr = INDEFR + cxxerr = INDEFR + cyyerr = INDEFR + cxyerr = INDEFR + + x2 = OBJ_X2(obj) + y2 = OBJ_Y2(obj) + xy = OBJ_XY(obj) + xvar = OBJ_XVAR(obj) + yvar = OBJ_YVAR(obj) + xycov = OBJ_XYCOV(obj) + + if (IS_INDEFR(x2) || IS_INDEFR(y2) || IS_INDEFR(xy)) + return + + r2 = x2 + y2 + if (r2 < 0.) + return + + doerr = !(IS_INDEF(xvar) || IS_INDEF(yvar) || IS_INDEF(xycov)) + if (doerr) { + rvar = xvar + yvar + if (rvar < 0.) + doerr = false + } + + r = sqrt (r2) + + d = x2 - y2 + theta = RADTODEG (atan2 (2 * xy, d) / 2.) + + if (doerr) { + dvar = xvar - yvar + thetaerr = atan2 (2 * xycov, dvar) / 2. + if (thetaerr < 0.) + thetaerr = INDEF + else + thetaerr = DEGTORAD (sqrt (thetaerr)) + } + + f = sqrt (d**2 + 4 * xy**2) + if (f > r2) + return + + if (doerr) { + fvar = sqrt (dvar**2 + 4 * xycov**2) + if (fvar > rvar) + doerr = false + } + + a = sqrt ((r2 + f) / 2) + b = sqrt ((r2 - f) / 2) + + if (doerr) { + aerr = sqrt ((rvar + fvar) / 2) + berr = sqrt ((rvar - fvar) / 2) + } + + ellip = 1 - b / a + if (b > 0.) + elong = a / b + + if (f == 0) { + cxx = 1. / (a * a) + cyy = 1. / (a * a) + cxy = 0 + } else { + cxx = y2 / f + cyy = x2 / f + cxy = -2 * xy / f + } + + if (doerr) { + if (fvar == 0) { + cxxerr = 1. / (aerr * aerr) + cyyerr = 1. / (berr * berr) + cxyerr = 0. + } else { + cxxerr = yvar / fvar + cyyerr = xvar / fvar + cxyerr = -2 * xycov / fvar + } + } + +end diff --git a/noao/nproto/ace/colors.dat b/noao/nproto/ace/colors.dat new file mode 100644 index 00000000..553ce35c --- /dev/null +++ b/noao/nproto/ace/colors.dat @@ -0,0 +1,8 @@ +black 202 +white 203 +red 204 +green 205 +blue 206 +yellow 207 +cyan 208 +magenta 209 diff --git a/noao/nproto/ace/convolve.x b/noao/nproto/ace/convolve.x new file mode 100644 index 00000000..af9734ef --- /dev/null +++ b/noao/nproto/ace/convolve.x @@ -0,0 +1,971 @@ +include <ctype.h> +include <imhdr.h> + + +# ODCNV -- Get a line of data possibly convolved. Also get the unconvolved +# data, the sky data, and the sky sigma data. +# +# This routine must be called sequentially starting with the first line. +# It is initialized when the first line. Memory is freed by using a final +# call with a line of zero. + +procedure convolve (in, bpm, sky, sig, exp, offset, scale, line, cnv, + indata, bp, cnvdata, skydata, sigdata, expdata, cnvwt, logfd) + +pointer in[2] #I Image pointers +pointer bpm[2] #I BPM pointer +pointer sky[2] #I Sky map +pointer sig[2] #I Sigma map +pointer exp[2] #I Exposure map +int offset[2] #I Offsets +real scale[2] #I Image scales +int line #I Line +char cnv[ARB] #I Convolution string +pointer indata[2] #O Pointers to unconvolved image data +pointer bp #O Bad pixel data +pointer cnvdata #O Pointer to convolved image data +pointer skydata[2] #O Pointer to sky data +pointer sigdata[2] #O Pointer to sigma data corrected by exposure map +pointer expdata[2] #O Pointer to exposure map data +real cnvwt #O Weight for convolved sigma +int logfd #I Logfile + +int i, j, k, nx, ny, nx2, ny2, nc, nl, mode, off +real wts, wts1 +pointer bpm2, kptr, ptr, symptr, symwptr +bool dobpm, overlap, fp_equalr() + +pointer kernel, sym, symbuf, symwts, buf, buf2, buf3, bpbuf, bpwts, wtsl, scales +data kernel/NULL/, sym/NULL/, symbuf/NULL/, symwts/NULL/ +data buf/NULL/, buf2/NULL/, buf3/NULL/, bpbuf/NULL/, bpwts/NULL/ +data wtsl/NULL/, scales/NULL/ + +errchk cnvparse, cnvgline2 + +begin + # If no convolution. + if (cnv[1] == EOS) { + if (line == 0) + return + + call cnvgline1 (line, offset, in, bpm, indata, bp) + call cnvgline2 (line, offset, in, sky, sig, exp, skydata, + sigdata, expdata) + cnvwt = 1 + if (in[2] == NULL) + cnvdata = indata[1] + else + call asubr_scale (Memr[indata[1]], scale[1], + Memr[indata[2]], scale[2], Memr[cnvdata], IM_LEN(in[1],1)) + return + } + + # Free memory. + if (line == 0) { + if (symbuf != NULL) { + do i = 0, ARB { + ptr = Memi[symbuf+i] + if (ptr == -1) + break + call mfree (ptr, TY_REAL) + } + } + if (symwts != NULL) { + do i = 0, ARB { + ptr = Memi[symwts+i] + if (ptr == -1) + break + call mfree (ptr, TY_REAL) + } + } + call mfree (scales, TY_REAL) + call mfree (wtsl, TY_REAL) + call mfree (kernel, TY_REAL) + call mfree (scales, TY_REAL) + call mfree (sym, TY_INT) + call mfree (symbuf, TY_POINTER) + call mfree (symwts, TY_POINTER) + call mfree (buf, TY_REAL) + call mfree (buf2, TY_REAL) + call mfree (buf3, TY_REAL) + call mfree (bpbuf, TY_INT) + call mfree (bpwts, TY_REAL) + + return + } + + # Initialize by getting the kernel coefficients, setting the + # image I/O buffers using a scrolling array, and allocate memory. + + if (line == 1 || buf == NULL) { + if (buf != NULL) { + if (symbuf != NULL) { + do i = 0, ARB { + ptr = Memi[symbuf+i] + if (ptr == -1) + break + call mfree (ptr, TY_REAL) + } + } + if (symwts != NULL) { + do i = 0, ARB { + ptr = Memi[symwts+i] + if (ptr == -1) + break + call mfree (ptr, TY_REAL) + } + } + call mfree (scales, TY_REAL) + call mfree (wtsl, TY_REAL) + call mfree (kernel, TY_REAL) + call mfree (scales, TY_REAL) + call mfree (sym, TY_INT) + call mfree (symbuf, TY_POINTER) + call mfree (symwts, TY_POINTER) + call mfree (buf, TY_REAL) + call mfree (buf2, TY_REAL) + call mfree (buf3, TY_REAL) + call mfree (bpbuf, TY_INT) + call mfree (bpwts, TY_REAL) + } + + nc = IM_LEN(in[1],1) + nl = IM_LEN(in[1],2) + + call cnvparse (cnv, kernel, nx, ny, logfd) + nx2 = nx / 2 + ny2 = ny / 2 + call malloc (scales, ny, TY_REAL) + call calloc (wtsl, ny, TY_REAL) + call amovkr (1., Memr[scales], ny) + + # Check for lines which are simple scalings of the first line. + do i = 2, ny { + kptr = kernel + (i - 1) * nx + wts = 0. + do k = 0, nx-1 { + if (Memr[kptr+k] == 0. || Memr[kernel+k] == 0.) { + wts = 0. + break + } + if (wts == 0.) + wts = Memr[kptr+k] / Memr[kernel+k] + else { + wts1 = Memr[kptr+k] / Memr[kernel+k] + if (!fp_equalr (wts, wts1)) + break + } + } + if (wts != 0. && fp_equalr (wts, wts1)) { + Memr[scales+i-1] = wts + call amovr (Memr[kernel], Memr[kptr], nx) + } + } + + wts = 0 + do i = 1, ny { + kptr = kernel + (i - 1) * nx + wts1 = 0. + do j = 1, nx { + wts1 = wts1 + Memr[kptr] + kptr = kptr + 1 + } + Memr[wtsl+i-1] = wts1 + wts = wts + wts1 + } + if (wts != 0.) { + call adivkr (Memr[wtsl], wts, Memr[wtsl], ny) + call adivkr (Memr[kernel], wts, Memr[kernel], nx*ny) + } + cnvwt = sqrt (wts) + + if (in[2] == NULL) + bpm2 = NULL + else + bpm2 = bpm[2] + if (bpm[1] == NULL && bpm2 == NULL) + dobpm = false + else + dobpm = true + if (dobpm) { + call malloc (bpbuf, nc*ny, TY_INT) + call malloc (bpwts, nc, TY_REAL) + call calloc (symwts, ny*ny+1, TY_POINTER) + Memi[symwts+ny*ny] = -1 + } + + # Check for any line symmetries in the kernel. + call malloc (sym, ny, TY_INT) + call calloc (symbuf, ny*ny+1, TY_POINTER) + Memi[symbuf+ny*ny] = -1 + do i = ny, 1, -1 { + kptr = kernel + (i - 1) * nx + do j = ny, 1, -1 { + ptr = kernel + (j - 1) * nx + do k = 0, nx-1 { + if (Memr[kptr+k] != Memr[ptr+k]) + break + } + if (k == nx) { + Memi[sym+i-1] = j + break + } + } + } + do i = ny, 1, -1 { + k = 0 + do j = ny, 1, -1 + if (Memi[sym+j-1] == i) + k = k + 1 + if (k == 1) + Memi[sym+i-1] = 0 + } + + call malloc (buf, nc*ny, TY_REAL) + if (in[2] != NULL) { + call malloc (buf2, nc*ny, TY_REAL) + call malloc (buf3, nc*ny, TY_REAL) + } + + if (in[2] != NULL) { + overlap = true + if (1-offset[1] < 1 || nc-offset[1] > IM_LEN(in[2],1)) + overlap = false + if (1-offset[2] < 1 || nl-offset[2] > IM_LEN(in[2],2)) + overlap = false + } + do i = 1, ny { + call cnvgline1 (i, offset, in, bpm, indata, bp) + off = mod (i, ny) * nc + call amovr (Memr[indata[1]], Memr[buf+off], nc) + if (in[2] != NULL) { + call amovr (Memr[indata[2]], Memr[buf2+off], nc) + call asubr_scale (Memr[buf+off], scale[1], + Memr[buf2+off], scale[2], Memr[buf3+off], nc) + } + if (dobpm) + call amovi (Memi[bp], Memi[bpbuf+off], nc) + } + } + + # Get new line. + j = line + ny2 + if (j > ny && j <= nl) { + call cnvgline1 (j, offset, in, bpm, indata, bp) + off = mod (j, ny) * nc + call amovr (Memr[indata[1]], Memr[buf+off], nc) + if (in[2] != NULL) { + call amovr (Memr[indata[2]], Memr[buf2+off], nc) + call asubr_scale (Memr[buf+off], scale[1], + Memr[buf2+off], scale[2], Memr[buf3+off], nc) + } + if (dobpm) { + ptr = bpbuf + off + call amovi (Memi[bp], Memi[ptr], nc) + } + } + + # Compute the convolution vector with boundary reflection. + # Save and reuse lines with the same kernel weights apart + # from a scale factor. + + kptr = kernel + call aclrr (Memr[cnvdata], nc) + if (dobpm) + call aclrr (Memr[bpwts], nc) + do i = 1, ny { + j = line + i - ny2 - 1 + if (j < 1) + j = 2 - j + else if (j > nl) + j = 2 * nl - j + off = mod (j, ny) * nc + if (in[2] == NULL) + ptr = buf + else + ptr = buf3 + k = Memi[sym+i-1] + if (k == 0) { + mode = 1 + symptr = ptr + symwptr = bpwts + } else { + if (k == i) + mode = 2 + else + mode = 3 + symptr = Memi[symbuf+(k-1)*ny+mod(j,ny)] + if (symptr == NULL) { + call malloc (symptr, nc, TY_REAL) + Memi[symbuf+(k-1)*ny+mod(j,ny)] = symptr + mode = 2 + } + if (dobpm) { + symwptr = Memi[symwts+(k-1)*ny+mod(j,ny)] + if (symwptr == NULL) { + call malloc (symwptr, nc, TY_REAL) + Memi[symwts+(k-1)*ny+mod(j,ny)] = symwptr + } + } + } + if (dobpm) + call convolve2 (Memr[ptr+off], Memr[cnvdata], Memr[symptr], + nc, Memr[kptr], Memr[scales+i-1], nx, Memi[bpbuf+off], + Memr[wtsl+i-1], Memr[bpwts], Memr[symwptr], mode) + else + call convolve1 (Memr[ptr+off], Memr[cnvdata], Memr[symptr], + nc, Memr[kptr], Memr[scales+i-1], nx, mode) + kptr = kptr + nx + } + if (dobpm) { + do i = 0, nc-1 + if (Memr[bpwts+i] != 0.) + Memr[cnvdata+i] = Memr[cnvdata+i] / Memr[bpwts+i] + } + + # Set the output vectors. + off = mod (line, ny) * nc + indata[1] = buf + off + if (dobpm) { + if (bpm2 == NULL) + bp = bpbuf + off + else + call amovi (Memi[bpbuf+off], Memi[bp], nc) + } + if (in[2] != NULL) { + if (overlap) + indata[2] = buf2 + off + else + call amovr (Memr[buf2+off], Memr[indata[2]], nc) + } + call cnvgline2 (line, offset, in, sky, sig, exp, skydata, sigdata, + expdata) +end + + + +# ODCNV1 -- One dimensional convolution with boundary reflection. +# +# The convolution is added to the output so that it might be used +# as part of a 2D convolution. + +procedure convolve1 (in, out, save, nc, xkernel, scale, nx, mode) + +real in[nc] #I Input data to be convolved +real out[nc] #O Output convolved data +real save[nc] #U Output saved data +int nc #I Number of data points +real xkernel[nx] #I Convolution weights +real scale #I Scale for saved vector +int nx #I Number of convolution points (must be odd) +int mode #I Mode (1=no save, 2=save, 3=use save) + +int i, j, k, nx2 +real val +bool fp_equalr() + +begin + if (mode == 1) { + nx2 = nx / 2 + do i = 1, nx2 { + val = 0 + do j = 1, nx { + k = i + j - nx2 - 1 + if (k < 1) + k = 2 - k + val = val + in[k] * xkernel[j] + } + out[i] = out[i] + val + } + do i = nx2+1, nc-nx2 { + k = i - nx2 + val = 0 + do j = 1, nx { + val = val + in[k] * xkernel[j] + k = k + 1 + } + out[i] = out[i] + val + } + do i = nc-nx2+1, nc { + val = 0 + do j = 1, nx { + k = i + j - nx2 - 1 + if (k > nc) + k = 2 * nc - k + val = val + in[k] * xkernel[j] + } + out[i] = out[i] + val + } + } else if (mode == 2) { + nx2 = nx / 2 + do i = 1, nx2 { + val = 0 + do j = 1, nx { + k = i + j - nx2 - 1 + if (k < 1) + k = 2 - k + val = val + in[k] * xkernel[j] + } + out[i] = out[i] + val + save[i] = val + } + do i = nx2+1, nc-nx2 { + k = i - nx2 + val = 0 + do j = 1, nx { + val = val + in[k] * xkernel[j] + k = k + 1 + } + out[i] = out[i] + val + save[i] = val + } + do i = nc-nx2+1, nc { + val = 0 + do j = 1, nx { + k = i + j - nx2 - 1 + if (k > nc) + k = 2 * nc - k + val = val + in[k] * xkernel[j] + } + out[i] = out[i] + val + save[i] = val + } + } else { + if (fp_equalr (1., scale)) { + do i = 1, nc + out[i] = out[i] + save[i] + } else { + do i = 1, nc + out[i] = out[i] + scale * save[i] + } + } +end + + +# ODCNV2 -- One dimensional convolution with boundary reflection and masking. +# +# The convolution is added to the output so that it might be used +# as part of a 2D convolution. + +procedure convolve2 (in, out, save, nc, xkernel, scale, nx, bp, + wtssum, wts, wtsave, mode) + +real in[nc] #I Input data to be convolved +real out[nc] #O Output convolved data +real save[nc] #U Output saved data +int nc #I Number of data points +real xkernel[nx] #I Convolution weights +real scale #I Scale for saved vector +int nx #I Number of convolution points (must be odd) +int bp[nc] #I Bad pixel data +real wtssum #I Sum of weights +real wts[nc] #I Weights +real wtsave[nc] #U Output saved weight data +int mode #I Mode (1=no save, 2=save, 3=use save) + +int i, j, k, nx2 +real val, wt +bool fp_equalr() + +begin + if (mode == 1) { + nx2 = nx / 2 + do i = 1, nx2 { + val = 0 + wt = wtssum + do j = 1, nx { + k = i + j - nx2 - 1 + if (k < 1) + k = 2 - k + if (bp[k] == 0) + val = val + in[k] * xkernel[j] + else + wt = wt - xkernel[j] + } + out[i] = out[i] + val + wts[i] = wts[i] + wt + } + do i = nx2+1, nc-nx2 { + k = i - nx2 + val = 0 + wt = wtssum + do j = 1, nx { + if (bp[k] == 0) + val = val + in[k] * xkernel[j] + else + wt = wt - xkernel[j] + k = k + 1 + } + out[i] = out[i] + val + wts[i] = wts[i] + wt + } + do i = nc-nx2+1, nc { + val = 0 + wt = wtssum + do j = 1, nx { + k = i + j - nx2 - 1 + if (k > nc) + k = 2 * nc - k + if (bp[k] == 0) + val = val + in[k] * xkernel[j] + else + wt = wt - xkernel[j] + } + out[i] = out[i] + val + wts[i] = wts[i] + wt + } + } else if (mode == 2) { + nx2 = nx / 2 + do i = 1, nx2 { + val = 0 + wt = wtssum + do j = 1, nx { + k = i + j - nx2 - 1 + if (k < 1) + k = 2 - k + if (bp[k] == 0) + val = val + in[k] * xkernel[j] + else + wt = wt - xkernel[j] + } + out[i] = out[i] + val + wts[i] = wts[i] + wt + save[i] = val + wtsave[i] = wt + } + do i = nx2+1, nc-nx2 { + k = i - nx2 + val = 0 + wt = wtssum + do j = 1, nx { + if (bp[k] == 0) + val = val + in[k] * xkernel[j] + else + wt = wt - xkernel[j] + k = k + 1 + } + out[i] = out[i] + val + wts[i] = wts[i] + wt + save[i] = val + wtsave[i] = wt + } + do i = nc-nx2+1, nc { + val = 0 + wt = wtssum + do j = 1, nx { + k = i + j - nx2 - 1 + if (k > nc) + k = 2 * nc - k + if (bp[k] == 0) + val = val + in[k] * xkernel[j] + else + wt = wt - xkernel[j] + } + out[i] = out[i] + val + wts[i] = wts[i] + wt + save[i] = val + wtsave[i] = wt + } + } else { + if (fp_equalr (1., scale)) { + do i = 1, nc { + out[i] = out[i] + save[i] + wts[i] = wts[i] + wtsave[i] + } + } else { + do i = 1, nc { + out[i] = out[i] + scale * save[i] + wts[i] = wts[i] + scale * wtsave[i] + } + } + } +end + + +# ASUBR_SCALE -- out = in1 * scale1 - in2 * scale2 + +procedure asubr_scale (in1, scale1, in2, scale2, out, n) + +real in1[n] #I Input vector +real scale1 #I Scale +real in2[n] #I Input vector +real scale2 #I Scale +real out[n] #O Output vector +int n #I Number of points + +int i + +begin + if (scale1 == 1. && scale2 == 1.) + call asubr (in1, in2, out, n) + else if (scale1 == 1.) { + do i = 1, n + out[i] = in1[i] - in2[i] * scale2 + } else if (scale2 == 1.) { + do i = 1, n + out[i] = in1[i] * scale1 - in2[i] + } else { + do i = 1, n + out[i] = in1[i] * scale1 - in2[i] * scale2 + } +end + + +procedure cnvgline1 (line, offset, im, bpm, imdata, bp) + +int line #I Line to be read +int offset[2] #I Offsets +pointer im[2] #I Image pointers +pointer bpm[2] #I Bad pixel mask pointers +pointer imdata[2] #U Image data +pointer bp #U Bad pixel data + +bool overlap +int nl1, nl2, loff, l2 +int nc1, nc2, nc3, off1, off2, off3, c1, c2 +pointer imgl2r(), imgl2i() + + +begin + # Get data for first image. Use IMIO buffers except the + # bad pixel buffer is not used if there is a second image. + + imdata[1] = imgl2r (im[1], line) + if (bpm[1] != NULL) { + if (im[2] == NULL) + bp = imgl2i (bpm[1], line) + else + call amovi (Memi[imgl2i(bpm[1],line)], Memi[bp], + IM_LEN(bpm[1],1)) + } + if (im[2] == NULL) + return + + # Initialize. + if (line == 1) { + nc1 = IM_LEN(im[1],1) + nc2 = IM_LEN(im[2],1) + nl1 = IM_LEN(im[1],2) + nl2 = IM_LEN(im[2],2) + + overlap = true + if (1-offset[1] < 1 || nc1-offset[1] > nc2) + overlap = false + if (1-offset[2] < 1 || nl1-offset[2] > nl2) + overlap = false + + off2 = -offset[1] + c1 = max (1, 1+off2) + c2 = min (nc2, nc1+off2) + nc2 = c2 - c1 + 1 + off1 = c1 - off2 - 1 + off3 = c2 - off2 + off2 = max (0, off2) + nc3 = nc1 - off3 + if (off1 > 0) { + call aclrr (Memr[imdata[2]], off1) + if (bpm[1] == NULL) + call amovki (1, Memi[bp], off1) + } + if (nc3 > 0) { + call aclrr (Memr[imdata[2]+off3], nc3) + if (bpm[1] == NULL) + call amovki (1, Memi[bp+off3], nc3) + } + + loff = -offset[2] + if (loff < 0) + call aclrr (Memr[imdata[2]], nc1) + } + + l2 = line + loff + if (l2 < 1 || l2 > nl2) { + call amovki (1, Memi[bp], nc1) + return + } + + if (overlap) { + imdata[2] = imgl2r (im[2], l2) + off2 + if (bpm[1] != NULL && bpm[2] != NULL) + call amaxi (Memi[imgl2i(bpm[2],l2)+off2], Memi[bp], Memi[bp], + nc1) + else if (bpm[2] != NULL) + call amovi (Memi[imgl2i(bpm[2],l2)+off2], Memi[bp], nc1) + } else { + # Copy the overlapping parts of the second image to the output + # buffers which must be allocated externally. Use the bad pixel + # mask to flag regions where there is no overlap. + + call amovr (Memr[imgl2r(im[2],l2)+off2], Memr[imdata[2]+off1], nc2) + if (bpm[1] != NULL && bpm[2] != NULL) { + call amaxi (Memi[imgl2i(bpm[2],l2)+off2], Memi[bp+off1], + Memi[bp+off1], nc2) + if (off1 > 0) + call amovki (1, Memi[bp], off1) + if (nc3 > 0) + call amovki (1, Memi[bp+off3], nc3) + } else if (bpm[2] != NULL) + call amovi (Memi[imgl2i(bpm[2],l2)+off2], Memi[bp+off1], nc2) + } +end + + +procedure cnvgline2 (line, offset, im, skymap, sigmap, expmap, + skydata, sigdata, expdata) + +int line #I Line to be read +int offset[2] #I Offsets +pointer im[2] #I Image pointers +pointer skymap[2] #I Sky map +pointer sigmap[2] #I Sky sigma map +pointer expmap[2] #I Exposure map +pointer skydata[2] #U Sky data +pointer sigdata[2] #U Sky sigma data +pointer expdata[2] #U Exposure map data + +bool overlap +int nl1, nl2, loff, l2 +int nc1, nc2, nc3, off1, off2, off3, c1, c2 +pointer ptr + +pointer map_glr() +errchk map_glr + +begin + # Get data for first image. + + skydata[1] = map_glr (skymap[1], line, READ_ONLY) + if (expmap[1] == NULL) + sigdata[1] = map_glr (sigmap[1], line, READ_ONLY) + else { + sigdata[1] = map_glr (sigmap[1], line, READ_WRITE) + expdata[1] = map_glr (expmap[1], line, READ_ONLY) + call expsigma (Memr[sigdata[1]], Memr[expdata[1]], + IM_LEN(im[1],1), 0) + } + if (im[2] == NULL) + return + + # Initialize. + if (line == 1) { + nc1 = IM_LEN(im[1],1) + nc2 = IM_LEN(im[2],1) + nl1 = IM_LEN(im[1],2) + nl2 = IM_LEN(im[2],2) + + overlap = true + if (1-offset[1] < 1 || nc1-offset[1] > nc2) + overlap = false + if (1-offset[2] < 1 || nl1-offset[2] > nl2) + overlap = false + + off2 = -offset[1] + c1 = max (1, 1+off2) + c2 = min (nc2, nc1+off2) + nc2 = c2 - c1 + 1 + off1 = c1 - off2 - 1 + off3 = c2 - off2 + nc3 = nc1 - off3 + if (off1 > 0) { + call aclrr (Memr[skydata[2]], off1) + call aclrr (Memr[sigdata[2]], off1) + if (expmap[2] != NULL) + call aclrr (Memr[expdata[2]], off1) + } + if (nc3 > 0) { + call aclrr (Memr[skydata[2]+off3], nc3) + call aclrr (Memr[sigdata[2]+off3], nc3) + if (expmap[2] != NULL) + call aclrr (Memr[expdata[2]+off3], nc3) + } + + loff = -offset[2] + if (loff < 0) { + call aclrr (Memr[skydata[2]], nc1) + call aclrr (Memr[sigdata[2]], nc1) + if (expmap[2] != NULL) + call aclrr (Memr[expdata[2]], nc1) + } + } + + l2 = line + loff + if (l2 < 1 || l2 > nl2) + return + + if (overlap) { + skydata[2] = map_glr (skymap[2], l2, READ_ONLY) + off2 + if (expmap[2] == NULL) + sigdata[2] = map_glr (sigmap[2], l2, READ_ONLY) + off2 + else { + sigdata[2] = map_glr (sigmap[2], l2, READ_WRITE) + off2 + expdata[2] = map_glr (expmap[2], l2, READ_ONLY) + off2 + call expsigma (Memr[sigdata[2]], Memr[expdata[2]], nc2, 0) + } + } else { + # Copy the overlapping parts of the second image to the output + # buffers which must be allocated externally. + + ptr = map_glr(skymap[2],l2,READ_ONLY) + call amovr (Memr[ptr+off2], Memr[skydata[2]+off1], nc2) + ptr = map_glr(sigmap[2],l2,READ_ONLY) + call amovr (Memr[ptr+off2], Memr[sigdata[2]+off1], nc2) + if (expmap[2] != NULL) { + ptr = map_glr(expmap[2],l2,READ_ONLY) + call amovr (Memr[ptr+off2], Memr[expdata[2]+off1], nc2) + call expsigma (Memr[sigdata[2]], Memr[expdata[2]], nc2, 0) + } + } +end + + +# CNVPARSE -- Parse convolution string. + +procedure cnvparse (cnvstr, kernel, nx, ny, logfd) + +char cnvstr[ARB] #I Convolution string +pointer kernel #O Pointer to convolution kernel elements +int nx, ny #O Convolution size +int logfd #I Log file descriptor + +int i, j, nx2, ny2 +int ip, fd, open(), fscan(), nscan(), ctor(), ctoi(), strncmp() +real val, sx, sy +pointer ptr +errchk open + +define unknown_ 10 + +begin + kernel = NULL + + for (ip=1; IS_WHITE(cnvstr[ip]); ip=ip+1) + ; + + if (cnvstr[ip] == EOS) { + nx = 1 + ny = 1 + call malloc (kernel, 1, TY_REAL) + Memr[kernel] = 1 + } else if (cnvstr[ip] == '@') { + fd = open (cnvstr[ip+1], READ_ONLY, TEXT_FILE) + call malloc (kernel, 100, TY_REAL) + i = 0 + nx = 0 + ny = 0 + while (fscan (fd) != EOF) { + do j = 1, ARB { + call gargr (val) + if (nscan() < j) + break + Memr[kernel+i] = val + i = i + 1 + if (mod (i, 100) == 0) + call realloc (kernel, i+100, TY_REAL) + } + j = j - 1 + if (nx == 0) + nx = j + else if (j != nx) { + call close (fd) + call error (1, + "Number of convolution elements inconsistent") + } + ny = ny + 1 + } + call close (fd) + } else if (IS_ALPHA(cnvstr[ip])) { + if (strncmp ("block", cnvstr[ip], 5) == 0) { + i = 6 + if (ctoi (cnvstr[ip], i, nx) == 0 || + ctoi (cnvstr[ip], i, ny) == 0) + goto unknown_ + call malloc (kernel, nx*ny, TY_REAL) + call amovkr (1., Memr[kernel], nx*ny) + } else if (strncmp ("bilinear", cnvstr[ip], 8) == 0) { + i = 9 + if (ctoi (cnvstr[ip], i, nx) == 0 || + ctoi (cnvstr[ip], i, ny) == 0) + goto unknown_ + call malloc (kernel, nx*ny, TY_REAL) + + nx2 = nx / 2 + ny2 = ny / 2 + ptr = kernel + do j = 0, ny-1 { + do i = 0, nx-1 { + Memr[ptr] = (nx2-abs(nx2-i)+1) * (ny2-abs(ny2-j)+1) + ptr = ptr + 1 + } + } + } else if (strncmp ("gauss", cnvstr[ip], 5) == 0) { + i = 6 + if (ctoi (cnvstr[ip], i, nx) == 0 || + ctoi (cnvstr[ip], i, ny) == 0) + goto unknown_ + if (ctor (cnvstr[ip], i, sx) == 0 || + ctor (cnvstr[ip], i, sy) == 0) + goto unknown_ + call malloc (kernel, nx*ny, TY_REAL) + + nx2 = nx / 2 + ny2 = ny / 2 + val = 2 * sx * sy + ptr = kernel + do j = 0, ny-1 { + do i = 0, nx-1 { + Memr[ptr] = exp (-((i-nx2)**2+(j-ny2)**2) / val) + ptr = ptr + 1 + } + } + } + } else { + call malloc (kernel, 100, TY_REAL) + i = 0 + nx = 0 + ny = 0 + while (cnvstr[ip] != EOS) { + do j = 1, ARB { + if (ctor (cnvstr, ip, val) == 0) + break + Memr[kernel+i] = val + i = i + 1 + if (mod (i, 100) == 0) + call realloc (kernel, i+100, TY_REAL) + } + j = j - 1 + if (nx == 0) + nx = j + else if (j != nx) + call error (1, + "Number of convolution elements inconsistent") + ny = ny + 1 + if (cnvstr[ip] != EOS) + ip = ip + 1 + for (; IS_WHITE(cnvstr[ip]); ip=ip+1) + ; + } + } + + if (kernel == NULL) +unknown_ call error (1, "Unrecognized convolution") + + if (mod (nx, 2) != 1 || mod (ny, 2) != 1) { + call mfree (kernel, TY_REAL) + call error (1, "Convolution size must be odd") + } + + if (logfd != NULL) { + ptr = kernel + call eprintf (" Convolution:\n") + do j = 1, ny { + call eprintf (" ") + do i = 1, nx { + call eprintf (" %7.3g") + call pargr (Memr[ptr]) + ptr = ptr + 1 + } + call eprintf ("\n") + } + } + +end diff --git a/noao/nproto/ace/detect.h b/noao/nproto/ace/detect.h new file mode 100644 index 00000000..1c807e7c --- /dev/null +++ b/noao/nproto/ace/detect.h @@ -0,0 +1,16 @@ +# Detection parameter structure. +define DET_LEN 62 # Length of parameter structure +define DET_STRLEN 99 # Length of strings in structure + +define DET_CNV P2C($1) # Convolution string +define DET_HSIG Memr[P2R($1+51)] # High detection sigma +define DET_LSIG Memr[P2R($1+52)] # Low detection sigma +define DET_HDETECT Memi[$1+53] # Detect above sky? +define DET_LDETECT Memi[$1+54] # Detect below sky? +define DET_NEIGHBORS Memi[$1+55] # Neighbor type +define DET_MINPIX Memi[$1+56] # Minimum number of pixels +define DET_SIGAVG Memr[P2R($1+57)] # Minimum average above sky in sigma +define DET_SIGPEAK Memr[P2R($1+58)] # Minimum peak above sky in sigma +define DET_FRAC2 Memr[P2R($1+59)] # Fraction of difference relative to 2 +define DET_BPVAL Memi[$1+60] # Output bad pixel value +define DET_SKB Memi[$1+61] # Parameters for sky update diff --git a/noao/nproto/ace/detect.par b/noao/nproto/ace/detect.par new file mode 100644 index 00000000..fd39b83f --- /dev/null +++ b/noao/nproto/ace/detect.par @@ -0,0 +1,65 @@ +# ACEDETECT + +images,f,a,,,,"List of images" +masks,s,h,"!BPM",,,"List of bad pixel masks" +skys,s,h,"",,,"List of sky maps" +sigmas,s,h,"",,,"List of sigma maps" +exps,s,h,"",,,"List of exposure maps" +gains,s,h,"",,,"List of gain maps" +objmasks,s,h,"",,,"List of object masks" +omtype,s,h,"all","boolean|numbers|colors|all",,"Object mask type" +catalogs,s,h,"",,,"List of catalogs" +extnames,s,h,"",,,"Extension names" +catdefs,s,h,"ace$lib/catdef.dat",,,"List of catalog definitions" +logfiles,s,h,"STDOUT",,,"List of log files + +# Steps" +dodetect,b,h,yes,,,"Detect objects?" +dosplit,b,h,yes,,,"Split merged objects?" +dogrow,b,h,yes,,,"Grow object regions?" +doevaluate,b,h,yes,,,"Evaluate objects? + +# Sky" +skytype,s,h,"block","fit|block",,"Type of sky estimation + +# Sky Fitting" +fitstep,i,h,100,1,,"Line step for sky sampling" +fitblk1d,i,h,10,,,"Block average for line fitting" +fithclip,r,h,2.,,,"High sky clipping during 1D sky estimation" +fitlclip,r,h,3.,,,"Low sky clippling during 1D sky estimation" +fitxorder,i,h,1,1,,"Sky fitting x order" +fityorder,i,h,1,1,,"Sky fitting y order" +fitxterms,s,h,"half","none|full|half",,"Sky fitting cross terms + +# Sky Blocks" +blkstep,i,h,1,1,,"Line step for sky sampling" +blksize,i,h,-10,,,"Block size (+=pixels, -=blocks)" +blknsubblks,i,h,2,1,,"Number of subblocks per axis + +# Detection" +updatesky,b,h,yes,,,"Update sky during detection?" +convolve,s,h,"block 3 3",,,"Convolution kernel" +hsigma,r,h,3.,.1,,"Sigma threshold above sky" +lsigma,r,h,10.,.1,,"Sigma threshold below sky" +hdetect,b,h,yes,,,"Detect objects above sky?" +ldetect,b,h,no,,,"Detect objects below sky?" +neighbors,s,h,"8","4|8",,Neighbor type +minpix,i,h,6,1,,"Minimum number of pixels in detected objects" +sigavg,r,h,4.,0.,,"Sigma of mean flux cutoff" +sigmax,r,h,4.,0.,,"Sigma of maximum pixel" +bpval,i,h,INDEF,,,"Output bad pixel value + +# Splitting" +splitmax,r,h,INDEF,,,"Maximum sigma above sky for splitting" +splitstep,r,h,0.4,,,"Splitting steps in convolved sigma" +splitthresh,r,h,5.,,,"Splitting threshold in sigma" +sminpix,i,h,8,1,,"Minimum number of pixels in split objects" +ssigavg,r,h,10.,0.,,"Sigma of mean flux cutoff" +ssigmax,r,h,5.,0.,,"Sigma of maximum pixel + +# Growing" +ngrow,i,h,2,0,,"Number of grow rings" +agrow,r,h,2.,0,,"Area grow factor + +# Evaluate" +magzero,s,h,"INDEF",,,"Magnitude zero point" diff --git a/noao/nproto/ace/detect.x b/noao/nproto/ace/detect.x new file mode 100644 index 00000000..681951db --- /dev/null +++ b/noao/nproto/ace/detect.x @@ -0,0 +1,795 @@ +include <imhdr.h> +include <pmset.h> +include <mach.h> +include "ace.h" +include "cat.h" +include "objs.h" +include "skyblock.h" +include "detect.h" +include "split.h" + + +# DETECT - Object detection. +# +# Get input image data (possibly convolved) and compare to sky using sky +# sigma and threshold factors. Catagorize as bad pixel, sky, above sky, and +# below sky. Write catagories to output mask. + +procedure detect (det, spt, dosky, dosig, skyname, signame, im, bpm, + skymap, sigmap, expmap, scale, offset, out, siglevmap, siglevels, + logfd, cat) + +pointer det #I Detection parameter structure +pointer spt #I Split parameter structure +bool dosky #I Do sky update? +bool dosig #I Do sigma update? +char skyname[ARB] #I Sky name for updating sky +char signame[ARB] #I Sigma name for updating sigma +pointer im[2] #I Input image pointers +pointer bpm[2] #I Bad pixel mask pointer +pointer skymap[2] #U Sky map +pointer sigmap[2] #U Sigma map +pointer expmap[2] #I Exposure map +real scale[2] #I Image scales +int offset[2] #I Offsets of second image +pointer out #I Output pixel mask (PMIO) pointer +pointer siglevmap #I Mask for sigma levels +pointer siglevels #O Sigma levels for mask +int logfd #I Verbose? +pointer cat #O Catalog of objects + +pointer cnv # Convolution string pointer +real hsig # Detection threshold +real splitstep # Minimum split step in convolved sigma +real splitthresh # Transition convolved sigma +bool hdetect # Detection above sky +bool ldetect # Detection below sky + +bool dosky1, dosig1, overlap +int i, c, l, nc, nl, nc2, siglevmax +int nobjs, nalloc, navail +long v[2] +real z, cnvwt +pointer sp, str, iptr, rptr, outdata, lastdata, orl, srl +pointer skb, objs, ids, links +pointer indata[2], bp, skydata[2], sigdata[2], expdata[2], cnvdata + +errchk convolve, drenum +errchk detect, salloc, malloc, calloc, realloc + + +begin + # Initialize parameters. + call det_pars ("open", "", det) + + # The sky update requires the doxxx parameter to be true, a filename + # to be specified and the skb pointer to be non-null. The skb + # pointer is set depending on the "updatesky" task parameter. + + dosky1 = (dosky && skyname[1] != EOS) + dosig1 = (dosig && signame[1] != EOS) + if (dosky1 || dosig1) + skb = DET_SKB(det) + else + skb = NULL + + cnv = DET_CNV(det) + hsig = DET_HSIG(det) + if (spt != NULL) { + splitstep = SPT_SPLITSTEP(spt) + splitthresh = SPT_SPLITTHRESH(spt) + } + hdetect = (DET_HDETECT(det) == YES) + ldetect = (DET_LDETECT(det) == YES) + + # Set sizes. + nc = IM_LEN(im[1],1) + nl = IM_LEN(im[1],2) + if (ldetect) + nc2 = 2 * (nc + 2) + else + nc2 = nc + 2 + + # Allocate memory. + call smark (sp) + call salloc (str, SZ_LINE, TY_CHAR) + call salloc (outdata, nc2, TY_INT) + call salloc (lastdata, nc2, TY_INT) + call salloc (orl, 3+3*nc, TY_INT) + call salloc (iptr, 1, TY_REAL) + call salloc (rptr, 1, TY_REAL) + + Memr[iptr] = INDEFI + Memr[rptr] = INDEFR + + if (siglevmap != NULL) + call salloc (srl, 3+3*nc, TY_INT) + else + srl = iptr + + if (expmap[1] == NULL) + expdata[1] = rptr + if (expmap[2] == NULL) + expdata[2] = rptr + + if (im[2] == NULL) { + indata[2] = rptr + skydata[2] = rptr + sigdata[2] = rptr + expdata[2] = rptr + if (bpm[1] == NULL) { + call salloc (bp, nc, TY_INT) + call aclri (Memi[bp], nc) + } + if (Memc[cnv] != EOS) + call salloc (cnvdata, nc, TY_REAL) + } else { + overlap = true + if (1-offset[1] < 1 || nc-offset[1] > IM_LEN(im[2],1)) + overlap = false + if (1-offset[2] < 1 || nl-offset[2] > IM_LEN(im[2],2)) + overlap = false + if (!overlap) { + call salloc (indata[2], nc, TY_REAL) + call salloc (skydata[2], nc, TY_REAL) + call salloc (sigdata[2], nc, TY_REAL) + call salloc (expdata[2], nc, TY_REAL) + } + call salloc (bp, nc, TY_INT) + call aclri (Memi[bp], nc) + call salloc (cnvdata, nc, TY_REAL) + } + + navail = (nc * nl) / 100 + call calloc (ids, navail, TY_INT) + call calloc (links, navail, TY_INT) + call calloc (objs, navail, TY_POINTER) + nalloc = 0 + + # Setup sky updating. + if (skb!=NULL && !overlap) { + l = 1 + call skb_iminit (skb, im[1], expmap, l, NULL) + } + + if (logfd != NULL) + call fprintf (logfd, " Detect objects:\n") + + # Go through image. + nobjs = NUMSTART - 1 + call aclri (Memi[outdata], nc2) + if (siglevmap == NULL) + siglevmax = INDEFI + else + siglevmax = 0 + + v[1] = 1 + do l = 1, nl { + # Get data. + call convolve (im, bpm, skymap, sigmap, expmap, offset, + scale, l, Memc[cnv], indata, bp, cnvdata, skydata, + sigdata, expdata, cnvwt, logfd) + call amovi (Memi[outdata], Memi[lastdata], nc2) + + call detect1 (det, spt, skb, Memr[indata[1]], Memr[skydata[1]], + Memr[sigdata[1]], Memr[expdata[1]], Memr[indata[2]], + Memr[skydata[2]], Memr[sigdata[2]], Memr[expdata[2]], + scale, Memi[bp], Memr[cnvdata], cnvwt, Memi[outdata], + Memi[lastdata], nc, nl, l, objs, ids, links, nobjs, + nalloc, navail, Memi[orl], Memi[srl], siglevmax) + + # Write to output masks. + v[2] = l + call pmplri (out, v, Memi[orl], 0, nc, PIX_SRC) + if (siglevmap != NULL) + call pmplri (siglevmap, v, Memi[srl], 0, nc, PIX_SRC) + } + + # Free convolution memory. + call convolve (im, bpm, skymap, sigmap, expmap, offset, + scale, 0, Memc[cnv], indata, bp, cnvdata, skydata, + sigdata, expdata, cnvwt, logfd) + + # Free extra object structures. + do c = nobjs, nalloc-1 + call mfree (Memi[objs+c], TY_STRUCT) + + # Renumber and reject objects with less than a minimum area. + call drenum (det, out, Memi[ids], Memi[objs], nobjs) + + call mfree (ids, TY_INT) + call mfree (links, TY_INT) + call realloc (objs, nobjs, TY_POINTER) + + CAT_NOBJS(cat) = nobjs + CAT_NUMMAX(cat) = nobjs + CAT_OBJS(cat) = objs + + # Set sigma levels if needed. + if (spt != NULL) { + call calloc (siglevels, siglevmax+1, TY_REAL) + do i = 1, siglevmax { + z = i * splitstep + if (z > splitthresh) { + z = z / splitthresh + z = (z + 3) / 4 + z = z * z * z * z + z = z * splitthresh + } + if (z > hsig) + Memr[siglevels+i-1] = z + } + Memr[siglevels+siglevmax] = MAX_REAL + } else + siglevels = NULL + + if (logfd != NULL) { + call fprintf (logfd, " %d objects detected\n") + call pargi (nobjs - NUMSTART + 1) + } + + if (skb != NULL) { + call skb_update (skb, dosky1, dosig1, im[1], skyname, signame, + skymap, sigmap, logfd) + call skb_imfree (skb) + } + + call sfree (sp) +end + + +procedure detect1 (det, spt, skb, in, sky, sig, exp, in2, sky2, sig2, exp2, + scale, bp, cnv, cnvwt, out, lastout, nc, nl, line, objs, ids, + links, nobjs, nalloc, navail, orl, srl, siglevmax) + +pointer det #I Parameters +pointer spt #I Parameters +pointer skb #I Sky block pointer +real in[nc] #I Image data +real sky[nc] #I Sky data +real sig[nc] #I Sky sigma data +real exp[nc] #I Exposure map data +real in2[nc] #I Image data +real sky2[nc] #I Sky data +real sig2[nc] #I Sky sigma data +real exp2[nc] #I Exposure map data +real scale[2] #I Image scales +int bp[nc] #I Bad pixel values +real cnv[nc] #I Convolved image data +real cnvwt #I Sigma weight +int out[ARB] #I Output data (extra pixel on each end) +int lastout[ARB] #I Last output data (extra pixel on each end) +int nc #I Number of columns +int nl #I Number of lines +int line #I Current line + +pointer objs #I Pointer to array of object pointers +pointer ids #I Pointer to array of IDs +pointer links #I Pointer to array links to other IDs +int nobjs #I Number of objects pointers +int nalloc #I Number of object pointers allocated +int navail #I Size of allocated arrays + +int orl[3,ARB] #O Output object mask range list +int srl[3,ARB] #O Output sigma level range list +int siglevmax #O Maximum sigma level (INDEF if not used) + +real hsig # High detection sigma +real lsig # Low detection sigma +int bpval # Output bad pixel value +real splitstep # Minimum split step in convolved sigma +real splitthresh # Transition convolved sigma +bool hdetect # Detection above sky +bool ldetect # Detection below sky +int neighbors # Neighbor type + +int i, j, c, c1, c2, clast, nc2, nc3, num, numlast, bin, binlast +int n, ncmax, nlmax, nbins, csky +real z, s, t, z1, s1, t1, z2, s2, t2, zcnv, rcnv, tcnv, low, high, binscale +real explast +bool dodiff, dosrl + +real a, b +pointer bins, skys, sigs, exps, nsky + +errchk dadd, realloc + +begin + # Parameters + hsig = DET_HSIG(det) + lsig = DET_LSIG(det) + bpval = DET_BPVAL(det) + hdetect = (DET_HDETECT(det) == YES) + ldetect = (DET_LDETECT(det) == YES) + neighbors = DET_NEIGHBORS(det) + + # Do sky updating? + nlmax = 0 + if (skb != NULL) { + ncmax = min (nc, SKB_NCSBLK(skb) * SKB_NCSPIX(skb)) + nlmax = min (nl, SKB_NLSBLK(skb) * SKB_NLSPIX(skb)) + + a = SKB_A(skb) + b = SKB_B(skb) + n = SKB_NCSPIX(skb) + nbins = SKB_NBINS(skb) + bins = SKB_BINS(skb) + skys = SKB_SKY(skb) + sigs = SKB_SIG(skb) + exps = SKB_EXP(skb) + nsky = SKB_NSKY(skb) + } + + # Do difference detection? + if (IS_INDEFR(in2[1])) { + dodiff = false + z1 = 0; s1 = 0; t1 = 1 + z2 = 0; s2 = 0; t2 = 1 + } else + dodiff = true + + # Initialize output mask range lists. + i = 1 + orl[1,i] = 0 + if (spt != NULL) { + splitstep = SPT_SPLITSTEP(spt) + splitthresh = SPT_SPLITTHRESH(spt) + binscale = splitthresh / splitstep + + j = 1 + srl[1,j] = 0 + dosrl = true + } else + dosrl = false + clast = 0 + + nc2 = nc + 2 + if (ldetect) + nc3 = nc2 + 1 + else + nc3 = 1 + + explast = INDEFR + + # Find pixels which are masked, sky, above sky, and below sky. + do c = 1, nc { + c1 = c + 1 + c2 = c + nc3 + out[c1] = 0 + out[c2] = 0 + + # Mark masked pixels if any. + if (bp[c] != 0) { + if (IS_INDEFI(bpval)) + num = min (bp[c], NUMSTART-1) + else + num = min (bpval, NUMSTART-1) + + if (num > 0) { + out[c1] = num + out[c2] = num + + if (num != numlast || c != clast) { + orl[2,i] = clast - orl[1,i] + i = i + 1 + + numlast = num + orl[1,i] = c + orl[3,i] = numlast + } + clast = c1 + } + + next + } + + # Find sky and object pixels. + if (dodiff) { + z1 = in[c] + s1 = sky[c] + t1 = sig[c] + z2 = in2[c] + s2 = sky2[c] + t2 = sig2[c] + z = scale[1] * z1 - scale[2] * z2 + s = scale[1] * s1 - scale[2] * s2 + t = sqrt ((scale[1]*t1)**2 + (scale[2]*t2)**2) + } else { + z = in[c] + s = sky[c] + t = sig[c] + } + zcnv = cnv[c] + rcnv = zcnv - s + tcnv = t / cnvwt + low = -lsig * tcnv + high = hsig * tcnv + + if (rcnv > high) { + if (hdetect) { + call dadd (c1, line, out, lastout, nc2, + Memi[ids], Memi[links], Memi[objs], nobjs, nalloc, + z, s, t, z2, s2, t2, neighbors, 0, num) + + if (nalloc == navail) { + navail = max (100*nalloc*(nl+1)/line/100, nalloc+10000) + call realloc (ids, navail, TY_INT) + call realloc (links, navail, TY_INT) + call realloc (objs, navail, TY_POINTER) + } + + # Add to output masks. + if (num != numlast || c != clast) { + orl[2,i] = clast - orl[1,i] + i = i + 1 + + numlast = num + orl[1,i] = c + orl[3,i] = numlast + } + + if (dosrl) { + rcnv = rcnv / tcnv / splitthresh + if (rcnv > 1.) + rcnv = (4 * rcnv**0.25 - 3) + bin = nint (rcnv * binscale) + if (bin != binlast || c != clast) { + srl[2,j] = clast - srl[1,j] + j = j + 1 + + binlast = bin + srl[1,j] = c + srl[3,j] = binlast + + siglevmax = max (bin, siglevmax) + } + } + clast = c1 + } + } else if (rcnv < low) { + if (ldetect) { + call dadd (c1, line, out[nc3], lastout[nc3], nc2, + Memi[ids], Memi[links], Memi[objs], nobjs, nalloc, + 2*s-z, s, t, z1, s1, t1, neighbors, OBJ_DARK, num) + + if (nalloc == navail) { + navail = max (100*nalloc*(nl+1)/line/100, nalloc+10000) + call realloc (ids, navail, TY_INT) + call realloc (links, navail, TY_INT) + call realloc (objs, navail, TY_POINTER) + } + + # Add to output masks. + if (num != numlast || c != clast) { + orl[2,i] = clast - orl[1,i] + i = i + 1 + + numlast = num + orl[1,i] = c + orl[3,i] = numlast + } + clast = c1 + } + } + + if (line <= nlmax && c <= ncmax) { + bin = a * (z - s) / t + b + if (bin >= 1 && bin <= nbins) { + csky = (c-1) / n + bin = bins + csky * nbins + bin - 1 + Memi[bin] = Memi[bin] + 1 + Memr[skys+csky] = Memr[skys+csky] + s + Memr[sigs+csky] = Memr[sigs+csky] + t + Memi[nsky+csky] = Memi[nsky+csky] + 1 + if (!IS_INDEFR(Memr[exps])) + Memr[exps+csky] = Memr[exps+csky] + exp[c] + } + } + } + + # Finish up range lists. + orl[2,i] = clast - orl[1,i] + orl[1,1] = i + orl[2,1] = nc + if (dosrl) { + srl[2,j] = clast - srl[1,j] + srl[1,1] = j + srl[2,1] = nc + } + + # Evaluate histogram sky values if all lines have been accumulated. + if (line <= nlmax) { + if (mod (line, SKB_NLSPIX(skb)) == 0) { + n = SKB_NCSBLK(skb) + call skb_blkeval (Memi[bins], nbins, a, b, Memr[skys], + Memr[sigs], Memr[exps], Memi[nsky], n, + SKB_NSKYMIN(skb), SKB_NAV(skb), SKB_HISTWT(skb), + SKB_SIGFAC(skb)) + + # Initialize for accumulation of next line of blocks. + SKB_SKY(skb) = skys + n + SKB_SIG(skb) = sigs + n + if (!IS_INDEFR(Memr[exps])) + call aclrr (Memr[exps], n) + call aclri (Memi[nsky], n) + call aclri (Memi[bins], n*nbins) + } + } +end + + +# OBJADD -- Add a pixel to the object list and set the mask value. + +procedure dadd (c, l, z, zlast, nc, ids, links, objs, nobjs, nalloc, + data, sky, sigma, data2, sky2, sigma2, neighbors, flags, num) + +int c, l #I Pixel coordinate +int z[nc] #I Pixel values for current line +int zlast[nc] #I Pixel values for last line +int nc #I Number of pixels in a line +int ids[ARB] #I Mask ids +int links[ARB] #I Link to other mask ids with same number +pointer objs[ARB] #I Objects +int nobjs #U Number of objects +int nalloc #U Number of allocated objects +real data #I Data value (not sky subtracted) +real sky #I Sky value +real sigma #I Sky sigma value +real data2 #I Data value (not sky subtracted) +real sky2 #I Sky value +real sigma2 #I Sky sigma value +int neighbors #I Neighbor type +int flags #I Flags +int num #O Object number assigned + +int i, num1, c1, c2 +real val +bool merge +pointer obj, obj1 + +begin + # Inherit number of a neighboring pixel. + num = INDEFI + merge = false + if (neighbors == 4) { + c1 = c - 1 + c2 = c + if (z[c1] >= NUMSTART) { + num = z[c1] + merge = true + } else if (zlast[c] >= NUMSTART) + num = ids[zlast[c]] + } else { + c1 = c - 1 + c2 = c + 1 + if (z[c1] >= NUMSTART) { + num = z[c1] + merge = true + } else if (zlast[c1] >= NUMSTART) + num = ids[zlast[c1]] + else if (zlast[c] >= NUMSTART) + num = ids[zlast[c]] + else if (zlast[c2] >= NUMSTART) + num = ids[zlast[c2]] + } + + # If no number assign a new number. + if (num == INDEFI) { + nobjs = nobjs + 1 + num = nobjs + ids[num] = num + links[num] = 0 + if (nalloc < nobjs) { + call calloc (objs[num], OBJ_DETLEN, TY_STRUCT) + nalloc = nobjs + } + obj = objs[num] + OBJ_XAP(obj) = 0. + OBJ_YAP(obj) = 0. + OBJ_FLUX(obj) = 0. + OBJ_NPIX(obj) = 0 + OBJ_ISIGMAX(obj) = 0. + OBJ_ISIGAVG(obj) = 0. + OBJ_ISIGAVG2(obj) = 0. + OBJ_FLAGS(obj) = flags + } + obj = objs[num] + + # Merge overlapping objects from previous line. + if (merge) { + i = zlast[c2] + if (i >= NUMSTART && num != ids[i]) { + num1 = ids[i] + + obj1 = objs[num1] + OBJ_XAP(obj) = OBJ_XAP(obj) + OBJ_XAP(obj1) + OBJ_YAP(obj) = OBJ_YAP(obj) + OBJ_YAP(obj1) + OBJ_FLUX(obj) = OBJ_FLUX(obj) + OBJ_FLUX(obj1) + OBJ_NPIX(obj) = OBJ_NPIX(obj) + OBJ_NPIX(obj1) + OBJ_ISIGMAX(obj) = max (OBJ_ISIGMAX(obj), OBJ_ISIGMAX(obj1)) + OBJ_ISIGAVG(obj) = OBJ_ISIGAVG(obj) + OBJ_ISIGAVG(obj1) + OBJ_ISIGAVG2(obj) = OBJ_ISIGAVG2(obj) + OBJ_ISIGAVG2(obj1) + + i = num + while (links[i] != 0) + i = links[i] + links[i] = num1 + repeat { + i = links[i] + ids[i] = num + } until (links[i] == 0) + + nalloc = nalloc + 1 + objs[nalloc] = obj1 + objs[num1] = NULL + } + } + + z[c] = num + OBJ_NPIX(obj) = OBJ_NPIX(obj) + 1 + val = (data - sky) / sigma + OBJ_XAP(obj) = OBJ_XAP(obj) + val * c1 + OBJ_YAP(obj) = OBJ_YAP(obj) + val * l + OBJ_FLUX(obj) = OBJ_FLUX(obj) + val + OBJ_ISIGMAX(obj) = max (OBJ_ISIGMAX(obj), val) + OBJ_ISIGAVG(obj) = OBJ_ISIGAVG(obj) + val + #OBJ_ISIGAVG2(obj) = OBJ_ISIGAVG2(obj) + (data2 - sky2) / sigma2 + OBJ_ISIGAVG2(obj) = OBJ_ISIGAVG2(obj) + (data2 - sky2) / sigma +end + + +procedure drenum (det, out, ids, objs, nobjs) + +pointer det #I Parameters +pointer out #I Output PMIO pointer +int ids[nobjs] #I Mask IDs +pointer objs[nobjs] #U Input and output object list +int nobjs #U Number of objects + +int minpix # Minimum number of pixels +real sigavg # Cutoff of SIGAVG +real sigmax # Cutoff of SIGMAX +real frac # Fraction of sigavg2 + +int i, j, n, nc, nl +real rval +pointer sp, v, rl, buf, obj + +begin + # Parameters. + minpix = DET_MINPIX(det) + sigavg = DET_SIGAVG(det) + sigmax = DET_SIGPEAK(det) + frac = DET_FRAC2(det) + + # Assign object numbers. Eliminate objects, by setting object number + # to zero, based on selection # critera (size, peak, etc.). + + j = NUMSTART - 1 + do i = NUMSTART, nobjs { + obj = objs[i] + if (obj == NULL) + next + + n = OBJ_NPIX(obj) + if (n < minpix) { + OBJ_NUM(obj) = 0 + next + } + rval = sqrt (real(n)) + OBJ_ISIGAVG(obj) = OBJ_ISIGAVG(obj) / rval + if ((OBJ_ISIGMAX(obj) < sigmax && OBJ_ISIGAVG(obj) < sigavg)) { + OBJ_NUM(obj) = 0 + next + } + OBJ_ISIGAVG2(obj) = OBJ_ISIGAVG2(obj) / rval + if (OBJ_ISIGAVG(obj) < frac * OBJ_ISIGAVG2(obj)) { + OBJ_NUM(obj) = 0 + next + } + + rval = OBJ_FLUX(obj) + if (rval > 0.) { + OBJ_XAP(obj) = OBJ_XAP(obj) / rval + OBJ_YAP(obj) = OBJ_YAP(obj) / rval + } else { + OBJ_XAP(obj) = INDEFR + OBJ_YAP(obj) = INDEFR + } + + j = j + 1 + OBJ_NUM(obj) = j + } + + # Set object mask. + call smark (sp) + call salloc (v, PM_MAXDIM, TY_LONG) + call pm_gsize (out, i, Meml[v], j) + nc = Meml[v]; nl = Meml[v+1] + call salloc (rl, 3+3*nc, TY_INT) + call salloc (buf, nc, TY_INT) + call drenum1 (out, nc, nl, ids, objs, Meml[v], Memi[rl], Memi[buf]) + call sfree (sp) + + # Reorder the arrays and expand object structures. + j = NUMSTART - 1 + do i = NUMSTART, nobjs { + obj = objs[i] + if (obj == NULL) + next + if (OBJ_NUM(obj) == 0) { + call mfree (objs[i], TY_STRUCT) + next + } + + call newobj (obj) + + j = j + 1 + objs[j] = obj + } + nobjs = j +end + + +procedure drenum1 (om, nc, nl, ids, objs, v, rl, buf) + +pointer om #I Object mask pointer +int nc, nl #I Dimensions +int ids[ARB] #I Mask IDs +pointer objs[ARB] #I Objects +long v[PM_MAXDIM] #I Work array +int rl[3,nc] #I Work array +int buf[nc] #I Work array + +int i, j, l, id, andi(), ori() +pointer obj + +begin + v[1] = 1 + do l = 1, nl { + v[2] = l + call pmglri (om, v, rl, 0, nc, 0) + j = 1 + do i = 2, rl[1,1] { + id = rl[3,i] + if (id >= NUMSTART) { + obj = objs[ids[id]] + id = OBJ_NUM(obj) + if (DARK(obj) && id > 0) + id = MSETFLAG(id, MASK_DARK) + } + if (id > 0) { + j = j + 1 + rl[1,j] = rl[1,i] + rl[2,j] = rl[2,i] + rl[3,j] = id + } + } + rl[1,1] = j + call pmplri (om, v, rl, 0, nc, PIX_SRC) + } +end + + +procedure newobj (obj) + +pointer obj #U Object structure + +begin + if (obj == NULL) + return + + call realloc (obj, OBJ_LEN, TY_STRUCT) + OBJ_FLUX(obj) = INDEFR + OBJ_SKY(obj) = INDEFR + OBJ_SIG(obj) = INDEFR + OBJ_PEAK(obj) = INDEFR + OBJ_X1(obj) = INDEFR + OBJ_Y1(obj) = INDEFR + OBJ_WX(obj) = INDEFD + OBJ_WY(obj) = INDEFD + OBJ_XMIN(obj) = INDEFI + OBJ_XMAX(obj) = INDEFI + OBJ_YMIN(obj) = INDEFI + OBJ_YMAX(obj) = INDEFI +end diff --git a/noao/nproto/ace/diffdetect.par b/noao/nproto/ace/diffdetect.par new file mode 100644 index 00000000..6a0c0084 --- /dev/null +++ b/noao/nproto/ace/diffdetect.par @@ -0,0 +1,59 @@ +images,f,a,,,,"List of images" +masks,s,h,"!BPM",,,"List of bad pixel masks" +skys,s,h,"",,,"List of sky maps" +sigmas,s,h,"",,,"List of sigma maps" +exps,s,h,"",,,"List of exposure maps" +gains,s,h,"",,,"List of gain maps" +scales,s,h,"",,,"List of image intensity scale factors + +# Reference Image(s)" +rimages,f,h,,,,"List of reference images" +rmasks,s,h,"!BPM",,,"List of reference bad pixel masks" +rskys,s,h,"",,,"List of reference skys" +rsigmas,s,h,"",,,"List of reference sky sigmas" +rexps,s,h,"",,,"List of reference exposure maps" +rscales,s,h,"",,,"List of reference intensity scale factors + +# Output" +objmasks,f,a,,,,"List of output object masks" +catalogs,f,a,,,,"List of output catalogs" +catdefs,s,h,"ace$lib/catdef.dat",,,"List of catalog definitions" +logfiles,s,h,"STDOUT",,,"List of log files + +# Sky" +skytype,s,h,"block","fit|block",,"Type of sky estimation + +# Sky Fitting" +fitstep,i,h,100,1,,"Line step for sky sampling" +fitblk1d,i,h,10,,,"Block average for line fitting" +fithclip,r,h,2.,,,"High sky clipping during 1D sky estimation" +fitlclip,r,h,3.,,,"Low sky clippling during 1D sky estimation" +fitxorder,i,h,1,1,,"Sky fitting x order" +fityorder,i,h,1,1,,"Sky fitting y order" +fitxterms,s,h,"half","none|full|half",,"Sky fitting cross terms + +# Sky Blocks" +blkstep,i,h,1,1,,"Line step for sky sampling" +blksize,i,h,-10,,,"Block size (+=pixels, -=blocks)" +blknsubblks,i,h,2,1,,"Number of subblocks per axis + +# Detection" +updatesky,b,h,yes,,,"Update sky during detection?" +convolve,s,h,"block 3 3",,,"Convolution kernel" +hsigma,r,h,3.,.1,,"Sigma threshold above sky" +lsigma,r,h,10.,.1,,"Sigma threshold below sky" +hdetect,b,h,yes,,,"Detect objects above sky?" +ldetect,b,h,no,,,"Detect objects below sky?" +neighbors,s,h,"8","4|8",,Neighbor type +minpix,i,h,6,1,,"Minimum number of pixels in detected objects" +sigavg,r,h,4.,0.,,"Sigma of mean flux cutoff" +sigmax,r,h,4.,0.,,"Sigma of maximum pixel" +bpval,i,h,INDEF,,,"Output bad pixel value" +rfrac,r,h,0.5,,,"Minimum fraction of reference flux in difference + +# Growing" +ngrow,i,h,2,0,,"Number of grow rings" +agrow,r,h,2.,0,,"Area grow factor + +# Evaluate" +magzero,s,h,"INDEF",,,"Magnitude zero point" diff --git a/noao/nproto/ace/display.h b/noao/nproto/ace/display.h new file mode 100644 index 00000000..fa89a479 --- /dev/null +++ b/noao/nproto/ace/display.h @@ -0,0 +1,42 @@ +# Display modes: + +define RGB 1 # True color mode +define FRAME 2 # Single frame mode + +# Color selections: + +define BLUE 1B # BLUE Select +define GREEN 2B # GREEN Select +define RED 4B # RED Select +define MONO 7B # RED + GREEN + BLUE + +# Size limiting parameters. + +define MAXCHAN 2 +define SAMPLE_SIZE 600 + +# If a logarithmic greyscale transformation is desired, the input range Z1:Z2 +# will be mapped into the range 1.0 to 10.0 ** MAXLOG before taking the log +# to the base 10. + +define MAXLOG 3 + +# The following parameter is used to compare display pixel coordinates for +# equality. It determines the maximum permissible magnification. The machine +# epsilon is not used because the computations are nontrivial and accumulation +# of error is a problem. + +define DS_TOL (1E-4) + +# These parameters are needed for user defined transfer functions. + +define U_MAXPTS 4096 +define U_Z1 0 +define U_Z2 4095 + +# BPDISPLAY options: + +define BPDISPLAY "|none|overlay|interpolate|" +define BPDNONE 1 # Ignore bad pixel mask +define BPDOVRLY 2 # Overlay bad pixels +define BPDINTERP 3 # Interpolate bad pixels diff --git a/noao/nproto/ace/doc/detect.hlp b/noao/nproto/ace/doc/detect.hlp new file mode 100644 index 00000000..ac18c675 --- /dev/null +++ b/noao/nproto/ace/doc/detect.hlp @@ -0,0 +1,470 @@ +.help detect Sep00 ace +.ih +NAME +detect -- detect and catalog objects in images +.ih +SYNOPSIS +.ih +USAGE +detect images objmasks catalogs +.ih +PARAMETERS +.ls images +List of images containing objects to be detected. The images should generally +have read and write permission to allow addition of header information. +However, the task will still run without write access with the consequence +that the header will not be updated. +.le +.ls masks = "!BPM" +List of bad pixel masks for the images. This may consist of no bad pixel +mask specified as the empty string "", a single bad pixel mask to apply to +all images or a list of bad pixel masks which must match the images list. +Mask names beginning with "!" are image header keywords which point to the +bad pixel mask. +.le +.ls skys = "SKYFIT" +List of sky images, constant values, sky fit names, or keyword +indirection. If only one value is specified then it applies to all input +images otherwise the list must match the images list. Values beginning +with "!" specify image header keywords containing the image name, constant +value, or sky fit name to be used. The value is first checked to see +if an image with that name exists, then if sky fit keywords are in the +header, and finally if it is a number. Sky fit keywords are formed from +the sky fit name with two digit sequence numbers and are interpreted as +surface fit coefficients. + +If none of these are found then the value is treated as the sky fit name +to be used to save sky fitting performed by this task. +.le +.ls sigmas = "SKYSIG" +List of sky sigma images, constant values, sigma fit names, or keyword +indirection. If only one value is specified then it applies to all input +images otherwise the list must match the images list. Values beginning +with "!" specify image header keywords containing the image name, constant +value, or sigma fit name to be used. The value is first checked to see +if an image with that name exists, then if sigma fit keywords are in the +header, and finally if it is a number. Sigma fit keywords are formed from +the sigma fit name with two digit sequence numbers and are interpreted as +surface fit coefficients. + +If none of these are found then the value is treated as the sigma fit name +to be used to save sky fitting performed by this task. +.le + +The following parameters specify the output. +.ls objmasks +List of output object masks. If no list is given then no object masks +will be created. Otherwise there must be one object mask name for each +input image. The object mask name will be recorded in the input image +header and in any output catalog. +.le +.ls catalogs +List of output catalogs. If no list is given then no catalogs will be +created. Otherwise there must be one catalog name for each input image. +The catalog name will be recorded in the input image header and in any +object mask. The catalog is created as a "table" (see \fBtables\fR +for information about the tables and general tools to interact with the +tables). If the name has an explicit ".fits" extension then a FITS binary +table is created otherwise an IRAF table (".tab" extension) is created. +.le +.ls logfiles = "STDOUT" +List of output log files. If no list is given then no output log information +will be produced. If only one file is specified it applies to all input +images otherwise the list of files must match the images list. Note that +the special name "STDOUT" corresponds to terminal output. +.le + +The following parameters define the initial sky fit determination. This is +only done if no sky image or sky constant value and sigma image or sigma +constant value are specified. +# Sky +.ls newsky = no +Determine new sky fit if one already exists? When the specified sky +corresponds to an existing sky fit (the sky fit coefficients are in the +image header) then this parameter is used to override that fit with a new +fit. Otherwise the fit is used and the initial sky fitting is skipped. +The sky fitting is also skipped if the specified sky is an image or +constant. +.le +.ls nskylines = 100 +Number of sky sample lines to use. This number of lines spread evenly +through the image are used to determine the initial sky fit. +.le +.ls skyblk1d = 10 +Sky block size for 1D sky estimation. +.le +.ls skyhclip = 2. +High sky clipping during 1D sky estimation +.le +.ls skylclip = 3. +Low sky clippling during 1D sky estimation +.le +.ls skyxorder = 4 +Sky fitting x order +.le +.ls skyyorder = 4 +Sky fitting y order +.le +.ls skyxterms = "half" (none|half|full) +Sky fitting y order +.le + +# Iterated Sky +.ls skyupdate = no +Update sky after detection iterations? +.le +.ls niterate = 1 +Maximum number of sky iterations +.le +.ls skyblk2d = 50 +Sky block size during detection +.le +.ls maxskyres = 0.2 +Maximum sky residual for iteration +.le + +# Detection +.ls convolve = "block 3 3" +Convolution kernel +.le +.ls hsigma = 3. +Sigma threshold above sky +.le +.ls lsigma = 10. +Sigma threshold below sky +.le +.ls hdetect = yes +Detect objects above sky? +.le +.ls ldetect = yes +Detect objects below sky? +.le +.ls minpix = 10 +Minimum number of pixels in detected objects +.le +.ls sigavg = 4. +Sigma of mean flux cutoff +.le +.ls sigmax = 4. +Sigma of maximum pixel +.le +.ls bpval = 1 +Output bad pixel value +.le + +# Splitting" +.ls split = yes +Split objects? +.le +.ls splitmax = INDEF +Maximum sigma above sky for splitting +.le +.ls splitstep = 0.4 +Splitting steps in convolved sigma +.le +.ls splitthresh = 5. +Splitting threshold in sigma +.le +.ls sminpix = 10 +Minimum number of pixels in split objects +.le +.ls ssigavg = 10. +Sigma of mean flux cutoff +.le +.ls ssigmax = 5. +Sigma of maximum pixel +.le + + +# Growing" +.ls ngrow = 2 +Number of grow rings +.le +.ls agrow = 2. +Area grow factor +.le +.ih +DESCRIPTION + +SKY DETERMINATION + +A critical part of detecting objects in astronomical images is determining +the background sky and sky sigma at each point in the image. In the +following discussion sky means both the mean sky level and the sky sigma. +\fBDetect\fR provides for either the user to specify the sky or for the +task to use a sky fitting algorithm. The user may specify a sky either as +another image or as a constant value. Note that the image name or +value may be specified either explicitly or with a keyword associated +with the image. + +If the sky is not specified by an image or constant value then a surface +fit to the sky is used. The surface fit is recorded in the image header as +a sequence of keywords with a specified name (the keyword prefix which may +be up to six characters) and two digit sequence number. The values of the +keywords contain the coefficients of the fit. The the surface fit +coefficients are defined in the SURFACE FIT section. + +Note that it is possible to specify the mean sky and the sky sigma in +different ways. When one is given as an image or constant and the other +as a fit. The one given as an image or constant will be kept fixed and +the fit determination and updating will be done only on the other. + +The sky surface fit is computed in two stages. There is an initial +determination using a subsample of image lines. Then there is an +optional update of the sky sample during the object detection step. +The detection step with sky updating may be iterated a specified number +of times until the maximum difference in the mean sky is less than some +amount. + +INITIAL SKY DETERMINATION + +If an existing surface fit is specified then the parameter \fInewsky\fR +selects whether a new surface fit is to be computed. If the value is "no" +then the initial sky determination is skipped though the detection update +may still be selected. + +The initial sky fit uses a combination of block averaging to reduce the +number of points in the fitting, one dimensional line fitting with sigma +clipping rejection to eliminate objects, and finally fitting a two +dimensional surface to the set of block averages over all the sample lines +which cover the image. + +The parameter \fInskylines\fR defines the number of sample lines across +the image to be used. The lines are evenly spaced starting with the +first line and ending with the last line. The number of lines affects +how fast the sky estimation is done. + +The pixels from the input line are initially all given unit weight. Bad +pixels identified by the input bad pixel mask are excluded by setting their +weights to zero. A weighted block average, with the weight of each block +being the sum of the weights, is computed. The size of the blocks is given +by the \fIskyblk1d\fR parameter. This is done to speed the fitting by +reducing the number of points. Note that when all pixels in a block have +zero weight due to the bad pixel mask or subsequent rejection the weight of +the composite block average point is zero. + +If only one of sky mean and sky sigma quantities is being determined with +the other quantity given by an input image, constant, or previous fit +then those values are simple block averaged with the same block size +to produce sample points for the mean sky or sky sigma. Note that the +sky sigma of the sample points also requires division by the square root +of the block size to give the sky sigma per block average point. The +line fitting described next is then skipped for this quantity. + +The weighted one dimensional line fitting to the block averages uses +Chebyshev polynomials of order given by the \fIskyxorder\fR. Note that +this order is the number of polynomial terms, which is one higher than the +maximum power of the polynomial so that a value of 3 corresponds to a +quadratic polynomial. + +When the mean sky is being determined, the line fitting is performed and +the fitted values at the block centers are evaluated. + +When the sky sigma is being determined, the absolute value of the residuals +relative to the mean sky divided by 0.7979 are computed. A gaussian noise +distribution will have a mean value of this quantity equal to the sigma of +the distribution. In other words, the mean of the absolute deviations of a +gaussian distribution is 0.7979 times sigma. By fitting a function to +these residual values a position variable estimate of the sky sigma is +obtained without needing to compute standard deviations over some set of +points. The fitted values at the block centers are evaluated to give the +sky sigmas for the block averaged data. + +With the set of block averaged data points and estimated mean skys and sky +sigmas points that deviate by more than the number of sigma given by the +\fIskyhclip\fR and \fIskylclip\fR parameters are rejected by setting their +weights to zero. The line fitting is then repeated until no points are +rejected with a maximum of 10 iterations. + +When the iteration completes the block average points for that image line +are accumulated for a two dimensional surface fit. Note that the weights +are used to exclude rejected averages and to weight blocks that had fewer +points due to bad pixels. The surface fit is a two dimensional Chebyshev +polynomial of orders given by the \fIskyxorder\fR and \fIskyyorder\fR. The +orders have the same meaning as in the one dimensional polynomial, namely +the number of terms in powers of x and y. There are also cross terms which +are a mixture of powers of both x and y. The \fIskyxterms\fR select +whether to use any cross terms, only cross terms whose total power does not +exceed the maximum of the pure x and y terms, or all combinations of +powers. + +After all the sample lines are completed the final surface fits are +computed. The coefficients of the fits are written to the image header +under the specified sky fit names and the fits are passed on to the +detection phase. Note that if the input image is read only then the +fit will not be written to the header but the task continues. + +UPDATED TO SKY DURING DETECTION + + +DETECTION + +The detection of objects in an image is conceptually quite simple. Each +pixel is compared against the expected sky at that point and if it is +more that a specified number of sky sigma above the sky it is a candidate +object pixels. Candidate object pixels are grouped into objects on the basis +of being connected along the eight neighboring directions. The candidate +object is then accepted if it satisfies the criteria of a minimum +number of pixels, a sufficiently significant maximum pixel, and a sufficiently +significant flux above sky. + +To detect faint objects where individual pixels are not significantly above +the sky but all pixels taken together are significant a detection filter is +applied. This consists of applying a convolution function to the image and +performing the detection described in the previous paragraph on the +convolved pixels with the sky sigma suitable adjusted for the convolution. +The convolution acts as an optimizing filter for objects with shapes +corresponding to the convolution weights. The remaining discussion +is in terms of the convolved pixel values. The case of no convolution +can be thought of as a convolution with a delta function though the +implementation is not done as a convolution for efficiency. + +Two other options to the detection are to also find pixels that are +significantly below sky (using an independent threshold to that used for +detecting pixels above sky) and form them into "dark" objects and to +take the remaining pixels that are not significantly above or below the +sky and use them to define a sky sample for output or for updating the +initial sky. + +We now go into more detail. The background sky and sky sigma against which +the detection is performed is initially set as described earlier. If desired +the sky pixels may be accumulated to update the sky. After updating the +sky the detection step may be repeated using the new sky. This is +discussed futher when we reach the end of the detection step description. + +The convolution is specified by the \fIconvolve\fR parameter. The values for +this parameter and the definition of the convolution are given in the +CONVOLUTION DETECTION FILTER section. The input pixel data is convolved +and the sky sigma is appropriately adjusted. + +When the central pixel in the convolution is flagged as a bad pixel by the +bad pixel mask (any non-zero value is a bad pixels) then the convolved +value is considered to be a bad pixel. If an output object masks is +specified the pixel will be marked with the value specified by the +\fIbpval\fR parameter. The value may be set to not show the bad pixel in +the object mask, to set all input bad pixels to some value, or to pass the +input bad pixel value to the object mask. Note that bad pixel masks in the +object mask must be between 1 and 10 to avoid confusion with the values +used to identify objects. If other pixels in the convolution are flagged +as bad pixels they are excluded from the convolution and the +convolved sky sigma is adjusted but the convolution value is still used +as a valid image pixel for detection. + +The sigma threshold for pixels to be detected as part of an object above +sky is given by the \fIhsigma\fR. This number is multiplied by the sky +sigma to get the deviation from sky. As noted earlier the sky sigma is +for the convolved pixels and the + + +CONVOLUTION DETECTION FILTER + + +The convolution detection filter is specified with the \fIconvolve\fR +parameter. There is only one convolution that can be specified and it applies +to all input images in a list. If a null string ("") is specified +then no convolution is performed. The task has been optimizations for +this case to avoid treating this as a 1x1 convolution and to avoid extra +memory allocations required when a convolution is done. + +The convolved value at pixel (i,j), denoted I(i,j), within an image of size +CxL is defined by + +.nf + I_convolved(i,j) = sum_kl{I_unconvolved(m,n)*W(k,l)} / sum_kl{W(k,l)} +.fi + +where I(m,n) is the unconvolved value at pixel (m,n), W(k,l) are the NX x +NY (both must be odd) convolution weights, sum_kl is the double sum over k +and l, and + +.nf + m' = i + k - (NX+1)/2 for k = 1 to NX + n' = j + l - (NY+1)/2 for l = 1 to NY + + m = m' (1<=m'<=C) m = 1-m' (m'<1) m = 2C-m' (m'>C) + n = n' (1<=n'<=L) n = 1-n' (n'<1) n = 2L-n' (m'>L) +.fi + +The last two lines represent boundary reflection at the edges of the image. + +The sky sigma of a convolved pixel is approximated by + +.nf + sigma_convolved(i,j) = sigma_unconvolved(i,j) / sum_kl{W(k,l)} +.fi + +In the presence of bad pixels identified by a bad pixel mask the convolution +weight applied to a bad pixel is set to zero. The sum of the weights +used to normalize the convolution is then modified from the situation with +no bad pixels. This will correct the convolved pixel value for the missing +data and the estimated sky sigma is appropriately larger. + +A convolution can be computational slow, especially for larger sizes. +The implementation of the convolution has been optimized to recognize +bilinear symmetries or lines which are scaled versions of other lines. +So if possible such symmetries should be used. The "block", "bilinear", +and "gauss" special convolutions described below have such symmetries. + +There is also an overhead in checking for bad pixels. The convolution +has an optimization to avoid such checks in the case where no bad pixel +mask is specified. + +The \fIconvolve\fR parameter is a string which can take one of the +following forms. + +.ls "" +There is no convolution or, equivalently, NX=1, NY=1. +.le +.ls @[filename] +The weights are given in the specified file. The format consists of lines +of whitespace separated values. The number of values on each line must be +the same and defines NX and the number of lines defines NY. +.le +.ls block [NX] [NY] +The weights are all the same and the convolution size is given by the +two numbers following the word "block". +.le +.ls bilinear [NX] [NY] +The weights are the bilinear matrix product of triangular one dimensional +matrices of sizes given by the two numbers following the word "bilinear". +The weights are described by the matrix product relation + +.nf + [1 ... (NX+1)/2 ... 1] * Transpose{[1 ... (NY+2)/2 ... 1]} +.fi + +For example for NX=5, and NY=3 the weights would be + +.nf + 1 2 3 2 1 + 2 4 6 4 2 + 1 2 3 2 1 +.fi +.le +.ls gauss [NX] [NY] [SX] [SY] +The weights are bidimensional gaussian values on a grid of size NX by NY +with sigma values SX and SY (real numbers) in units of pixel spacing. +.le +.ls [W(1,1)] ... [W(NX,1)], ..., [W(1,NY)] ... [W(NX,NY)] +The weights are specified as a string of real values. The values are +whitespace separated within each line and the lines are delimited by +comma. For example + +.nf + 1 2 1 + 1 2 1, 2 3 2, 1 2 1 ==> 2 3 2 + 1 2 1 +.le + +When a logfile is defined the weights are included in the log output. + + +OBJECT MASKS + +.ih +EXAMPLES +.ih +REVISIONS +.ih +SEE ALSO +.endhelp diff --git a/noao/nproto/ace/doc/installation.hlp b/noao/nproto/ace/doc/installation.hlp new file mode 100644 index 00000000..c399ad4c --- /dev/null +++ b/noao/nproto/ace/doc/installation.hlp @@ -0,0 +1,208 @@ +.help installation Jan01 ace + +.ce +\fBACE: Astronomical Cataloging Environment\fR +.ce +Release Notes and Installation Instructions + +.sh +SUMMARY +The ACE external package is used to catalog objects in images and manipulate +the catalogs. + +.sh +RELEASE INFORMATION +The following summary only highlights the major changes. There will also +be minor changes and bug fixes. + +.ls V0.2: January 27, 2001 +Alpha test version. +.le +.sh +INSTALLATION INSTRUCTIONS +Installation of this external package consists of obtaining the files, +creating a directory containing the package, compiling the executables or +installing precompiled executables, and defining the environment to load +and run the package. The package may be +installed for a site or as a personal installation. If you need help with +these installation instructions contact iraf@noao.edu or call the IRAF +HOTLINE at 520-318-8160. +.ls [arch] +In the following steps you will need to know the IRAF architecture +identifier for your IRAF installation. This identifier is similar to the +host operating system type. The identifiers are things like "ssun" for +Solaris, "alpha" for Dec Alpha, and "linux" or "redhat" for most Linux +systems. The IRAF architecture identifier is defined when you run IRAF. +Start the CL and then type + +.nf + cl> show arch + .ssun +.fi + +This is the value you need to know without the leading '.'; i.e. the +IRAF architecture is "ssun" in the above example. +.le +.ls [1-site] +If you are installing the package for site use, login as IRAF +and edit the IRAF file defining the packages. + +.nf + % cd $hlib +.fi + +Define the environment variable ace to be the pathname to +the ace package root directory. The '$' +character must be escaped in the VMS pathname and UNIX pathnames must be +terminated with a '/'. Edit extern.pkg to include the following. + +.nf + reset ace = /local/ace/ + task ace.pkg = ace$ace.cl +.fi + +Near the end of the hlib$extern.pkg file, update the definition of +helpdb so it includes the ace help database, copying the syntax +already used in the string. Add this line before the line +containing a closing quote: + +.nf + ,ace$lib/helpdb.mip\ +.fi +.le +.ls [1-personal] +If you are installing the package for personal use define a host +environment variable with the pathname of the directory where the package +will be located (needed in order to build the package from the source +code). Note that pathnames must end with '/'. For example: + +.nf + % setenv ace /local/ace/ +.fi + +In your login.cl or loginuser.cl file make the following definitions +somewhere before the "keep" statement. + +.nf + reset ace = /local/ace/ + task ace.pkg = ace$ace.cl + printf ("reset helpdb=%s,ace$lib/helpdb.mip\nkeep\n", + envget("helpdb")) | cl + flpr +.fi + +If you will be compiling the package, as opposed to installing a binary +distribution, then you need to define various environment variables. +The following is for Unix/csh which is the main supported environment. + +.nf + # Example + % setenv iraf /iraf/iraf/ # Path to IRAF root (example) + % source $iraf/unix/hlib/irafuser.csh # Define rest of environment + % setenv IRAFARCH ssun # IRAF architecture +.fi + +where you need to supply the appropriate path to the IRAF installation root +in the first step and the IRAF architecture identifier for your machine +in the last step. +.le +.ls [2] +Login into IRAF. Create a directory to contain the package files and the +instrument database files. These directory should be outside the standard +IRAF directory tree. + +.nf + cl> mkdir ace$ + cl> cd ace +.fi +.le +.ls [3] +The package is distributed as a tar archive for the +sources and, as an optional convenience, a tar archive of the executables +for select host computers. Note that IRAF includes a tar reader. The tar +file(s) are most commonly obtained via anonymous ftp. Below is an example +from a Unix machine where the compressed files have the ".Z" extension. +Files with ".gz" or ".tgz" can be handled similarly. + +.nf + cl> ftp iraf.noao.edu (140.252.1.1) + login: anonymous + password: [your email address] + ftp> cd iraf/extern + ftp> get ace.readme + ftp> binary + ftp> get ace.tar.Z + ftp> get ace-bin.<arch>.Z (optional) + ftp> quit + cl> !uncompress ace.tar + cl> !uncompress ace-bin.<arch> (optional) +.fi + +The readme file contains these instructions. The <arch> in the +optional executable distribution is replaced by the IRAF architecture +identification for your computer. + +Upon request the tar file(s) may be otained on tape for a service +charge. In this case you would mount the tape use rtar to extract +the tar files. +.le +.ls [4] +Extract the source files from the tar archive using 'rtar". + +.nf + cl> softools + so> rtar -xrf ace.tar + so> bye +.fi + +On some systems, an error message will appear ("Copy 'bin.generic' +to './bin fails") which can be ignored. +Sites should leave the symbolic link 'bin' in the package root +directory pointing to 'bin.generic' but can delete any of the +bin.<arch> directories that won't be used. If there is no binary +directory for the system you are installing it will be created +when the package is compiled later or when the binaries are installed. + +If the binary executables have been obtained these are now extracted +into the appropriate bin.<arch> directory. + +.nf + # Example of sparc installation. + cl> cd ace + cl> rtar -xrf ace-bin.sparc # Creates bin.sparc directory +.fi + +The various tar file can be deleted once they have been +successfully installed. +.ls [5] +For a source installation you now have to build the package +executable(s). The "tables" package must be installed first if not +already available. First you configure the package for the particular +architecture. + +.nf + cl> cd ace + cl> mkpkg <arch> # Substitute sparc, ssun, alpha, etc. +.fi + +This will change the bin link from bin.generic to bin.<arch>. The binary +directory will be created if not present. If an error occurs in setting +the architecture then you may need to add an entry to the file "mkpkg". +Just follow the examples in the file. + +To create the executables and move them to the binary directory + +.nf + cl> mkpkg -p ace # build executables + cl> mkpkg generic # optionally restore generic setting +.fi + +Check for errors. If the executables are not moved to the binary directory +then step [1] to define the path for the package was not done correctly. +The last step restores the package to a generic configuration. This is not +necessary if you will only have one architecture for the package. +.le + +This should complete the installation. You can now load the package +and begin testing and use. +.endhelp diff --git a/noao/nproto/ace/doc/objmasks.hlp b/noao/nproto/ace/doc/objmasks.hlp new file mode 100644 index 00000000..1c35c4c9 --- /dev/null +++ b/noao/nproto/ace/doc/objmasks.hlp @@ -0,0 +1,710 @@ +.help objmasks Jan02 nproto +.ih +NAME +objmasks -- detect objects in images and create masks and sky maps +.ih +SYNOPSIS +.ih +USAGE +objmasks images objmasks skys +.ih +PARAMETERS +.ls images +List of images or multiextension files for which object masks are desired. +.le +.ls objmasks +List of object masks to be created. This list must match the input list. +Multiextension input files will produce multiextension mask files. If the +input image is writable, the name of the created mask will recorded in the +image header. Note that it is possible to specify a null image to +not produce an output mask. This might be done if the background sky +or sky sigma maps are desired or to just see the log information. +.le + +.ls omtype = "numbers" (boolean|numbers|colors|all) +The type of encoding for the object mask values. In all cases non-object pixels +(that is background) have mask values of zero. The choices for the mask +values are "boolean", "numbers", "colors", and "all". These are described +in the \fIOutput Data\fR section. +.le +.ls skys = "", sigmas = "" +Optional lists of input or output sky and sigma maps. Maps are either +constant values or images which are interpolated to the size of the input +images. If a list is given it must match the input \fIimages\fR list. +If constant values or existing maps are specified then those are used +without change. If a new filename is given then an output file is created +with the values computed by the task. Multiextension input images create +or apply the same extension names to the specified sky or sigma files. +Constant input values apply to all extensions. The sigma values are +per single input image pixel. +.le +.ls masks = "!BPM" +List of bad pixel masks for the input images. Non-zero masks values are +ignored in the object detection and are passed on to the output object +masks based on the \fIomtype\fR parameter. An empty list applies no bad +pixel mask, a single mask applies to all input images, and a matching +list matches the masks with the input image. A mask is specified by a +filename or by reference to a filename given by the value of a header +keyword in the input image. A header keyword reference is made with the +syntax "!<keyword>" where <keyword> is the desired keyword with case +ignored. For multiextension files the input masks may be either a +multiextension file with matching extension names or a directory of +pixel list files with the extension names as filenames. +.le +.ls extnames = "" +Extensions to select from multiextension files. A null string matches all +extension names. Otherwise the parameter is a comma separated list of +patterns that match the entire extension name. Thus, an explicit list of +extension names may be specified or the pattern matching characters '?' for +any character or '[]' for a set of characters may be used. The set may +include ranges in ascii order by using hyphens; i.e. 1-3 matches the +characters 1, 2, and 3. +.le +.ls logfiles = "STDOUT" +List of output log files. If no list is given then no output log information +will be produced. If only one file is specified it applies to all input +images otherwise the list of files must match the images list. Note that +the special name "STDOUT" corresponds to terminal output. +.le + +.ls blkstep = 1 +The mean and sigma of the background or sky pixels are determined in a +first pass through the image. If \fIblkstep\fR is one all lines are used. +To skip lines in order to speed up this computation, the parameter may be +set to a larger value to define the increment between lines. However, the +task will enforce a preset minimum number to insure a sufficient sample. +.le +.ls blksize = -10 +The background mean sky and sky sigma are determined in a set of square +blocks from which the values are linearly interpolated to each point in the +input image. The size of the blocks may be specified as a number of blocks +spanning the smaller image dimension by using a negative integer value. +Or the size may be specified as the number of pixels across a block. +The task will enforce a preset minimum number of pixels per block which may +require using bigger blocks than specified. The background determination +algorithm is described further in the "Background Determination" section. +.le + +.ls convolve = "block 3 3" +Convolution filter to be applied prior to threshold detection. The +convolution filter is defined by a set of weights in a 2D array. These +may be specified in files or with certain forms given by special strings. +The options are described in the "Convolution Filter" section. +.le +.ls hsigma = 3., lsigma = 10. +Object pixels are identified by sigma thresholds about the mean background +based on the estimated background sigma at each point in the image. +The sigma factors are specified in terms of the "per pixel" sigma before +convolution. The \fIhsigma\fR value is the "high" or above background +limit and the \fIlsigma\fR value is the "low" or below background limit. +Typically detections are one-sided, such as detecting objects above +the background, and so the thresholds need not be equal. +.le +.ls hdetect = yes, ldetect = no +Identify objects as pixels which are above the background (\fIhdetect\fR) +and below the background (\fIldetect\fR)? If objects are detected but the +corresponding parameter is no then the output mask will not include those +objects. +.le +.ls neighbors = "8" (8|4) +The threshold selected pixels are associated with other neighboring pixels to +form an object. The criterion for a neighbor being part of the +same object is defined by this parameter. The choices are "8" for +pixels touching in any of the 8 directions or "4" to identify neighbors +as only horizontal or vertically adjacent. +.le +.ls minpix = 6 +The minimum number of neighboring pixels which define an acceptable object. +.le +.ls ngrow = 2, agrow = 2. +After an object is identified as a set of threshold detected pixels, +additional neighboring pixels may be added to the object. This allows +expanding the object into the faint wings of the light distribution. The +additional pixels are those which touch the boundary pixels. Pixels are +added in multiple passes, each time extending the previous boundary. The +parameter \fIngrow\fR (an integer value) defines the maximum number of +boundary extensions. The parameter \fIagrow\fR (a real value) specifies +the maximum increase in area (number of pixels) from the original +detection. +.le +.ih +DESCRIPTION +\fBOBJMASKS\fR is a task for creating masks covering objects in images. +An optional secondary product of this task is to produce background +and sigma maps. Objects are identified by threshold sigma detection. +These object masks may be used by other applications to exclude the object +data or focus on the objects. The detection consists of determining a +smooth, spatially variable mean background and background sigma (if no +input maps are provided), convolving the data by an optional filter to +optimize detection of faint sources, collecting pixels satisfying the +detection thresholds, assigning neighboring pixels to a common object, +applying a minimum number of pixels test to the objects, and growing +objects to extend into the wings of the object light distribution. +The last step is writing out the identified object pixels as a mask. + +1. Input Data + +The input data consists of one or more 2D images. The images are assumed +to contain a moderately smooth background and multiple sources or +objects. This task is most useful for images with large numbers of small +sources rather than one large object such as a nearby galaxy. The input +images, specified by the \fIimages\fR parameter, may be individual images +(which includes images selected from multiextension files as explicit +image extensions) or multiextension files specified by a root filename. In +the latter case the image extension names selected by the \fIextnames\fR +parameter are used. + +Background means and sigmas (specified per image pixels) may be specified +by "maps". These may be constant numerical values or images. The map +images will be linearly interpolated to the size of the input images. +For multi-extension input data, constant map values apply to all extensions +and maps are also multiextension files with map images having the same +extension names. + +Bad pixel masks may be associated with the input images to +exclude pixels from the background and object determinations. These +bad pixels are also included in the output object masks. The bad pixel +masks are specified by the \fImasks\fR parameter. This parameter may +identify a mask by a filename or a keyword. A single mask may be +specified to apply to all images or a matching list of masks may be +given. + +The masks are in one of the supported mask formats. As of IRAF V2.12 this +includes pixel list (.pl) files and FITS "type=mask" extensions. When the +input files are multiextension files, the selected extension names are +appended to the specified mask filename to select masks with the same +extension name. If a mask file of the form "name[ext]" is not found +the task will treat the filename as a directory of pixel list files and +select the pixel list file with the extension name; i.e. "name/ext.pl". + +2. Output Data + +The output of this task are object masks, sky maps, sigma maps, and log +information. The output object masks default to mask type extensions. If an +extension name is not specified explicitly the default extension name +"pl" is created. To select a pixel list output format an explicit ".pl" +extension must be used. + +When the input data are multiextension files, the output masks, mean sky +maps, and sky sigma maps will be multiextension files with the specified +rootnames and the same extension name as the input. + +The output mask values identify non-object pixels with zero. The non-zero +values are encoded as selected by the \fIomtype\fR parameter. The choices +are: + +.ls "boolean" +All object and bad pixels have a mask value of one; i.e. the output masks +consists only of the values 0 and 1. +.le +.ls "numbers" +Input bad pixels values between 1 and 10 preserve their value and all +other input mask values are mapped to 10. The object mask pixels have +object numbers starting with 11. The object numbers are assigned by +the task (roughly in order from the first line to the last line) and +all pixels from a single object have the same unique object number. +.le +.ls "colors" +Input bad pixels are mapped to output values of one. The object numbers +are modulo 8 plus 2; i.e. values between 2 and 9. The purpose of this +numbering is to allow mapping to the nine standard display colors for an +interesting overlay with the \fBdisplay\fR task and "ocolors='+203'". +.le +.ls "all" +This is the same as "numbers" except that bits 24 to 27 in the mask values +are used for various purposes. In particular bit 24 is set for the boundary +pixels. This numbering will be used in the future by special tasks. +.le + +Output mean sky and sky sigma maps consist of the mean and sigma values +in blocks as described in the "Background Determination" section. +Therefore, the size of the map images are smaller than the input data images. +These maps need to be interpolated to the size of the input image +to obtain the values used for particular pixels in the data images. +This interpolation expansion is done automatically by some tasks such +as \fBmscred.rmfringe\fR. + +The log output provides information about the files, the phase of the +processing, some of the parameters, and the convolution filter weights. +The output begins with the task identifier ACE. This is because this +prototype task is a first release piece of a major package called ACE +(Astronomical Cataloging Environment), which is under development. + +3. Background Determination + +Detection of sources in an image begins with determining the background. +By this we mean estimating the probability distribution of the background +pixel values at every pixel in the image. In practice we only estimate +the central value and width and assume a normal distribution for evaluating +the significance of deviations from the central value. Since we normally +won't have a sample of values at each pixel the distribution is +determined from a sample of nearby pixels. + +In this discussion the central value of a distribution is denoted by <I>. +It is estimated by the mean or mode of the sample. The width of the +distribution about <I> is denoted by <S> and is estimated by the absolute +mean residual converted to the standard deviation of a normal distribution +with the same absolute mean residual. The normal deviation of a value I +from the distribution is defined as R = (I - <I>) / <S>. + +The background may be specified by input maps for one or both of the +background quantities. The maps may be constant values which apply +to all pixels or a grid of values given in an image which are linearly +interpolated to the full size of the input data. For those quantities +which are not input the following algorithm is used for computing +a map. The maps may be output and used as a product of this task. + +The background and/or sigma are estimated in two initial passes through the +data. The first pass algorithm fits linear functions to a subsample of +lines using sigma clipping iteration to eliminate objects. The subsample +is used to speed up the algorithm and is reasonable since only linear +functions are used. Each sample line is block averaged in blocks of 10 +pixels and a linear function is fit by least squares to obtain an estimate +for <I> along the line. The fitting weights are the number of good pixels +in each block average after elimination of bad pixels specified by the +user in a bad pixel mask. The absolute values of the residuals are also +fit to produce a constant function for <S>. + +To exclude objects from affecting these estimates the fitting is iterated +using sigma clipping rejection on the normal deviations R. In the +first iteration the fitting function for <S> is a constant and in +subsequent steps a linear fit is used. When the sigma clipping iteration +rejects no more data, the remaining block averages, absolute residuals, and +weights are used to fit a 2D plane for both <I> and <S>. The <S> surface +is a constant in order to avoid potential negative sigma values. + +This first pass algorithm is fast and produces good estimates for the +planar approximation to the background. The second pass divides the image +into large, equal sized blocks, as specified by the \fIblksize\fR +parameter, and estimates <I> and <S> in each block. The size of the blocks +needs to be large enough to give good estimates of the statistics though +small enough to handle the scale of variations in the sky. Each block is +divided into four subblocks for independent estimates which are then +combined into a final value for the block. As with the first pass, the +second pass can be speeded up by using a subsample of lines (parameter +\fBblkstep\fR) provided some minimum number of lines per subblock is +maintained. + +The background estimates in each subblock are made using histograms of the +normal deviations R computed relative to the first pass estimates of <I> +and <S>. When pixels are added into the histogram the <I> and <S> used to +compute R are accumulated into means of these quantities in order +to convert estimates from the normalized deviation histogram back into data +values. The histograms are truncated at +/-2.5 and have bin widths +determined by requiring a specified average bin population based on the +number of pixels in the block. Typically the bin population is of order +500. The histogram truncation is essentially an object-background +discrimination. + +When all the pixels in a subblock have been accumulated, new estimates of +<I> and <S> are computed. If the number of pixels in the histogram is +less than two-thirds of the subblock pixels the estimates are set to be +indefinite. This flags the subblock as too contaminated by objects to be +used. All subblock neighbors, which may cross the full block boundaries, +are also rejected to minimize contamination by the wings of big galaxies +and very bright stars. + +If the histogram has enough pixels, the bin populations are squared to +emphasize the peak of the distribution and reduce the effects of the +truncated edges of the histogram. Because of noise and the fine binning of +the histogram, a simple mode cannot be used and squaring the bin numbers +helps to approach the mode with a centroid. Squaring the bin values and +then computing the centroid can also be thought of as a weighted centroid. + +Generally a mode is considered the best estimate to use for the central +value <I> of the sky distribution. But it is unclear how to best estimate +the mode without an infinite number of pixels. One could do something like +fit a parabola to the histogram peak. But instead we use the empirical +relation for a skewed distribution between the mean, mode, and median; +<I>=mean-3*(mean-median). The mean is the weighted centroid and the median +is obtained numerically from the histogram using linear interpolation to +get a subbin value. + +The <S> values are obtained from the absolute mean residual of the +unweighted histogram about the previously derived central value <I> of the +histogram. The conversion to a standard deviation is made by computing the +ratio between the standard deviation and mean absolute deviation of a +Gaussian distribution. The standard value over the entire distribution +cannot be used because the histogram is truncated. However, it is easy to +numerically compute the ratio with the same truncation. + +Once <I> and <S> are obtained in bin numbers it is converted to data +values by using the mean and sigma of the input pixel values used +to create the histogram. + +The averages of the subblock <I> and <S> values which are not indeterminate +in each block are computed. If any of the full blocks are indeterminate +when all the subblocks have been eliminated as contaminated, values are +obtained for them by interpolation from nearby blocks. The block values +are then linearly interpolated to get background values for every +pixel in the input image. + +Note that the background pixels used in the block algorithm before +detection are derived by simple sigma clipping of the histogram values +around the planar background. If an output map for either the mean +values or the sigmas is specified then during the object detection stage +the background and sigmas are updated using the detected sky pixels about +the initial block sampled background. This is a more sensitive selection +of sky pixels since convolution filtering can exclude pixels from faint +objects and the wings of all objects. The new set of sky pixels are +accumulated and used in the same way as described earlier. + +4. Convolution Filters + +In order to improve the detection of faint sources dominated by the +background noise, the input data may be convolved to produce filtered +values in which the noise has been suppressed. The threshold detection +is then performed on the filtered data values. + +The convolution detection filter is specified with the \fIconvolve\fR +parameter. There is only one convolution that can be specified and it +applies to all input images in a list. If a null string ("") is specified +then no convolution is performed. The task has been optimizations for this +case to avoid treating this as a 1x1 convolution and to avoid extra memory +allocations required when a convolution is done. + +The convolved value at pixel (i,j), denoted I'(i,j), is defined by + +.nf + I'(i,j) = sum_kl{I(m,n)*W(k,l)} / sum_kl{W(k,l)} +.fi + +where I(m,n) is the unconvolved value at pixel (m,n), W(k,l) are the NX x +NY (both must be odd) convolution weights, sum_kl is the double sum over k +and l, and + +.nf + m' = i + k - (NX+1)/2 for k = 1 to NX + n' = j + l - (NY+1)/2 for l = 1 to NY + + m = m' (1<=m'<=C) m = 1-m' (m'<1) m = 2C-m' (m'>C) + n = n' (1<=n'<=L) n = 1-n' (n'<1) n = 2L-n' (m'>L) +.fi + +The size of the image is C x L. The last two lines represent boundary +reflection at the edges of the image. + +The sky sigma of a convolved pixel is approximated by + +.nf + sigma'(i,j) = sigma(i,j) / sum_kl{W(k,l)} +.fi + +In the presence of bad pixels specified in the bad pixel mask the +convolution weight applied to a bad pixel is set to zero. If the central +pixel is bad then the convolved value is also considered to be bad. The +sum of the weights used to normalize the convolution is then modified from +the situation with no bad pixels. This will correct the convolved pixel +value for the missing data and the estimated sky sigma is appropriately +larger. Since there is an overhead in checking for bad pixels the +convolution has an optimization to avoid such checks in the case where no +bad pixel mask is specified. + +A convolution can be computational slow, especially for larger convolution +kernel sizes. The implementation of the convolution has been optimized to +recognize bilinear symmetries or lines which are scaled versions of other +lines. So if possible users should chose convolutions with such symmetries +to be most efficient. The "block", "bilinear", and "gauss" special +convolutions described below all have such symmetries. + +The \fIconvolve\fR parameter is a string with one of the following forms. + +.ls "" +There is no convolution or, equivalently, NX=1, NY=1. +.le +.ls @[filename] +The weights are given in the specified file. The format consists of lines +of whitespace separated values. The number of values on each line must be +the same and defines NX and the number of lines defines NY. +.le +.ls block [NX] [NY] +The weights are all the same and the convolution size is given by the +two numbers following the word "block". This is a moving block average +filter. +.le +.ls bilinear [NX] [NY] +The weights are the bilinear matrix product of triangular one dimensional +matrices of sizes given by the two numbers following the word "bilinear". +The weights are described by the matrix product relation + +.nf + [1 ... (NX+1)/2 ... 1] * Transpose{[1 ... (NY+2)/2 ... 1]} +.fi + +For example for NX=5, and NY=3 the weights would be + +.nf + 1 2 3 2 1 + 2 4 6 4 2 + 1 2 3 2 1 +.fi +.le +.ls gauss [NX] [NY] [SX] [SY] +The weights are bidimensional gaussian values on a grid of size NX by NY +with sigma values SX and SY (real numbers) in units of pixel spacing. +.le +.ls [W(1,1)] ... [W(NX,1)], ..., [W(1,NY)] ... [W(NX,NY)] +The weights are specified as a string of real values. The values are +whitespace separated within each line and the lines are delimited by +comma. For example + +.nf + 1 2 1 + 1 2 1, 2 3 2, 1 2 1 ==> 2 3 2 + 1 2 1 +.fi +.le + +When a logfile is defined the convolution weights are included in the +output. + +5. Object Detection + +The detection of objects in an image is conceptually quite simple once the +background is known. If an input pixel, before any convolution, is +identified in the bad pixel mask the output object mask pixel is also +identified as bad. Otherwise the input data is convolved as described +previously. + +Each convolved pixel is compared against the expected background at that +point and, if it is more that a specified number of convolution adjusted +background sigma above (\fIhsigma\fR) or below (\fIlsigma\fR) the +background, it is identified as a candidate object pixel. Candidate object +pixels, with the same sense of deviation, are grouped into objects on +the basis of being connected along the four or eight neighboring directions +as specified by the \fIneighbor\fR parameter. The candidate object is then +accepted if it satisfies the minimum number of pixels (\fIminpix\fR) in +an object and the \fIhdetect\fR or \fIldetect\fR parameter selects that +type of object. The accepted objects are assigned sequential numbers +beginning with 11. The object numbers are used, as described in the +section on the output data, to set the output object mask values. + +If an output mean sky or sigma map is requested, the output is that +updated by the sky pixels identified during the detection. + +6. Object Growing + +Astronomical objects do not have sharp edges but have light distributions +that merge into the background. This is due not only to the nature of +extended sources but to the atmospheric and instrument point spread function +effects on unresolved sources. In order to include pixels which extend +away from the threshold detection and contain some amount of light +apart from the background, the task provides options to extend or grow +the object boundaries. This is done by making multiple passes where +pixels which have not been identified as object pixels but which neighbor +object pixels are assigned to the object which they neighbor in any of +the eight directions. Each pass can be thought of as adding a ring +of new pixels following the boundary of the object from the previous +pass. + +When a non-object pixel neighbors two or more object pixels it is +assigned to the object with the greater "flux". The flux is the sum +of the pixel value deviations from the background. + +The parameter \fIngrow\fR selects the maximum number of growing iterations. +The parameter \fIagrow\fR selects the maximum fractional increase in +the number of original detected object pixels. The number of pixels +is called the "area" of the object. The growing of an object stops +when either maximum is exceedd at the end of a growing iteration. +.ih +EXAMPLES +1. The following is a test example with default parameters that can be run +by anyone. An artificial galaxy field image is generated with the task +\fBmkexample\fR (the \fBartdata\fR package is assumed to already be loaded) +and a mask is created with \fBobjmasks\fR. The image is displayed with +the object mask overlayed in colors. + +.nf + np> mkexample galfield galfield + Creating example galfield in image galfield ... + np> objmasks omtype=color + List of images or MEF files: galfield + List of output object masks: gfmask + ACE: + Image: galfield - Example artificial galaxy field + Set sky and sigma: + Determine sky and sigma by surface fits: + start line = 1, end line = 512, step = 51.1 + xorder = 2, yorder = 2, xterms = half + hclip = 2., lclip = 3. + Determine sky and sigma by block statistics: + Number of blocks: 5 5 + Number of pixels per block: 100 100 + Number of subblocks: 10 10 + Number of pixels per subblock: 50 50 + Detect objects: + Convolution: + 1. 1. 1. + 1. 1. 1. + 1. 1. 1. + 422 objects detected + Grow objects: ngrow = 2, agrow = 2. + Write object mask: gfmask[pl,type=mask] + np> display galfield 1 + z1=371.5644 z2=455.8792 + np> display galfield 2 overlay=gfmask[pl] ocolors="+203" + z1=371.5644 z2=455.8792 +.fi + +2. In the first example there was no input mask. The next example +creates a new object mask using the first object mask as an input +"bad pixel mask". While this is not the usual usage of the bad pixel +mask it does illustrate an interesting option. Note that the mask +values in the input mask are mapped to an output value of 1 in the +"colors" output. In this example the output is forced to be a pl +file by using the explicit extension. + +.nf + np> objmasks omtype=colors mask=gfmask[pl] + List of images or MEF files (galfield): + List of output object masks (gfmask): gfmask1.pl + ACE: + Image: galfield - Example artificial galaxy field + Bad pixel mask: gfmask.pl + Set sky and sigma: + Determine sky and sigma by surface fits: + start line = 1, end line = 512, step = 51.1 + xorder = 2, yorder = 2, xterms = half + hclip = 2., lclip = 3. + Determine sky and sigma by block statistics: + Number of blocks: 5 5 + Number of pixels per block: 100 100 + Number of subblocks: 10 10 + Number of pixels per subblock: 50 50 + Detect objects: + Convolution: + 1. 1. 1. + 1. 1. 1. + 1. 1. 1. + 44 objects detected + Grow objects: ngrow = 2, agrow = 2. + Write object mask: gfmask1.pl + np> display galfield 2 overlay=gfmask1 ocolors="+203" + z1=371.5644 z2=455.8792 +.fi + +3. The next example illustrates use with a multiextension file. The +example is two realizations of the galfield artificial data. + +.nf + np> mkexamples galfield mef.fits[im1] + Creating example galfield in image mef[im1] ... + np> mkexamples galfield mef[im2,append] oseed=2 + Creating example galfield in image mef[im2,append] ... + np> objmasks + List of images or MEF files (galfield): mef + List of output object masks (gfmask1.pl): mefmask + ACE: + Image: mef[im1] - Example artificial galaxy field + Set sky and sigma: + Determine sky and sigma by surface fits: + start line = 1, end line = 512, step = 51.1 + xorder = 2, yorder = 2, xterms = half + hclip = 2., lclip = 3. + Determine sky and sigma by block statistics: + Number of blocks: 5 5 + Number of pixels per block: 100 100 + Number of subblocks: 10 10 + Number of pixels per subblock: 50 50 + Detect objects: + Convolution: + 1. 1. 1. + 1. 1. 1. + 1. 1. 1. + 422 objects detected + Grow objects: ngrow = 2, agrow = 2. + Write object mask: mefmask[im1,append,type=mask] + ACE: + Image: mef[im2] - Example artificial galaxy field + Set sky and sigma: + Determine sky and sigma by surface fits: + start line = 1, end line = 512, step = 51.1 + xorder = 2, yorder = 2, xterms = half + hclip = 2., lclip = 3. + Determine sky and sigma by block statistics: + Number of blocks: 5 5 + Number of pixels per block: 100 100 + Number of subblocks: 10 10 + Number of pixels per subblock: 50 50 + Detect objects: + Convolution: + 1. 1. 1. + 1. 1. 1. + 1. 1. 1. + 410 objects detected + Grow objects: ngrow = 2, agrow = 2. + Write object mask: mefmask[im2,append,type=mask] + np> display mef[im1] 1 over=mefmask[im1] + z1=371.5644 z2=455.8792 + np> display mef[im2] 2 over=mefmask[im2] + z1=371.5666 z2=455.7844 +.fi + +4. This example shows outputing the sky information. + +.nf + np> objmasks galfield gfmask2 sky=gfsky2 + ACE: + Image: galfield - Example artificial galaxy field + Set sky and sigma: + Determine sky and sigma by surface fits: + start line = 1, end line = 512, step = 51.1 + xorder = 2, yorder = 2, xterms = half + hclip = 2., lclip = 3. + Determine sky and sigma by block statistics: + Number of blocks: 5 5 + Number of pixels per block: 100 100 + Number of subblocks: 10 10 + Number of pixels per subblock: 50 50 + Write sky map: gfsky2 + Detect objects: + Convolution: + 1. 1. 1. + 1. 1. 1. + 1. 1. 1. + 422 objects detected + Update sky map: gfsky2 + Grow objects: ngrow = 2, agrow = 2. + Write object mask: gfmask2[pl,append,type=mask] + np> imstat gfsky2 + # IMAGE NPIX MEAN STDDEV MIN MAX + gfsky2 25 401.1 0.4397 400.3 401.9 +.fi + +5. This examples shows specifying the sky information as constant values. +In this case we already know that the artificial image has a +constant background of 400 and a sigma of 10. + +.nf + np> objmasks galfield gfmask3 sky=400 sigma=10 + ACE: + Image: galfield - Example artificial galaxy field + Set sky and sigma: + Use constant input sky: 400. + Use constant input sigma: 10. + Detect objects: + Convolution: + 1. 1. 1. + 1. 1. 1. + 1. 1. 1. + 432 objects detected + Grow objects: ngrow = 2, agrow = 2. + Write object mask: gfmask3[pl,append,type=mask] +.fi + +.ih +REVISIONS +.le +.ih +SEE ALSO +.endhelp +266c266 +< fit to produce a function for <S>. +--- +> fit to produce a constant function for <S>. +273c273,274 +< weights are used to fit a 2D plane for both <I> and <S>. +--- +> weights are used to fit a 2D plane for both <I> and <S>. The <S> surface +> is a constant in order to avoid potential negative sigma values. + diff --git a/noao/nproto/ace/edgewts.xNEW b/noao/nproto/ace/edgewts.xNEW new file mode 100644 index 00000000..fdd8d8dd --- /dev/null +++ b/noao/nproto/ace/edgewts.xNEW @@ -0,0 +1,56 @@ +task test + +procedure test () + +double dx, dy, r[11], w[11], clgetd() +int i, nr + +begin + dx = clgetd ("dx") + dy = clgetd ("dy") + nr = 11 + + call edgewts (dx, dy, r, w, nr) + do i = 1, nr { + call eprintf ("%.2f %.4g\n") + call pargd (r[i]) + call pargd (w[i]) + } +end + +procedure edgewts (dx, dy, r, w, nr) + +double dx #I Distance from aperture center to pixel center +double dy #I Distance from aperture center to pixel center +double r[nr] #O Aperture radii +double w[nr] #O Weights +int nr #O Number of aperture radius points + +int i, j, k, n +double r2, rmin, rmax, dr, a, d, rap2, y2 + +begin + rmin = sqrt ((max(0.,dx-0.6))**2+(max(0.,dy-0.6))**2) + rmax = sqrt ((dx+0.6)**2+(dy+0.6)**2) + dr = (rmax - rmin) / nr + rmin = rmin + dr / 2 + + n = 100 + d = 1.0D0 / (2 * n + 1) + a = d * d + + do k = 1, nr { + rap2 = (rmin + (k - 1) * dr) ** 2 + r[k] = sqrt (rap2) + w[k] = 0.0D0 + do j = -n, n { + y2 = (dy + j * d) ** 2 + do i = -n, n { + r2 = y2 + (dx + i * d) ** 2 + if (r2 > rap2) + break + w[k] = w[k] + a + } + } + } +end diff --git a/noao/nproto/ace/evaluate.h b/noao/nproto/ace/evaluate.h new file mode 100644 index 00000000..e2ccf001 --- /dev/null +++ b/noao/nproto/ace/evaluate.h @@ -0,0 +1,6 @@ +# EVALUATE definitions + +define EVL_STRLEN 99 # Length of strings +define EVL_LEN 50 # Parameters structure length + +define EVL_MAGZERO Memc[P2C($1+$2-1)] # Magnitude zero point diff --git a/noao/nproto/ace/evaluate.par b/noao/nproto/ace/evaluate.par new file mode 100644 index 00000000..0fda4d32 --- /dev/null +++ b/noao/nproto/ace/evaluate.par @@ -0,0 +1,32 @@ +# ACEEVALUATE + +images,f,a,,,,"List of images" +incatalogs,s,a,"",,,"List of input catalogs" +outcatalogs,s,a,"",,,"List of output catalogs" +objmasks,s,h,"",,,"List of object masks" +catdefs,s,h,"",,,"List of catalog definitions" +skys,s,h,"",,,"List of sky maps" +sigmas,s,h,"",,,"List of sigma maps" +exps,s,h,"",,,"List of exposure maps" +gains,s,h,"",,,"List of gain maps" +logfiles,s,h,"STDOUT",,,"List of log files + +# Sky" +skytype,s,h,"block","fit|block",,"Type of sky estimation + +# Sky Fitting" +fitstep,i,h,100,1,,"Line step for sky sampling" +fitblk1d,i,h,10,,,"Block average for line fitting" +fithclip,r,h,2.,,,"High sky clipping during 1D sky estimation" +fitlclip,r,h,3.,,,"Low sky clippling during 1D sky estimation" +fitxorder,i,h,1,1,,"Sky fitting x order" +fityorder,i,h,1,1,,"Sky fitting y order" +fitxterms,s,h,"half","none|full|half",,"Sky fitting cross terms + +# Sky Blocks" +blkstep,i,h,10,1,,"Line step for sky sampling" +blksize,i,h,2,,,"Block size (+=pixels, -=blocks)" +blknsubblks,i,h,3,1,,"Number of subblocks per axis + +# Evaluate" +magzero,s,h,"INDEF",,,"Magnitude zero point" diff --git a/noao/nproto/ace/evaluate.x b/noao/nproto/ace/evaluate.x new file mode 100644 index 00000000..c3b5b608 --- /dev/null +++ b/noao/nproto/ace/evaluate.x @@ -0,0 +1,641 @@ +include <error.h> +include <imhdr.h> +include <pmset.h> +include "ace.h" +include "cat.h" +include "objs.h" +include "evaluate.h" + + +# EVALUATE -- Evaluate object parameters. + +procedure evaluate (evl, cat, im, om, skymap, sigmap, gainmap, expmap, logfd) + +pointer evl #I Parameters +pointer cat #I Catalog structure +pointer im #I Image pointer +pointer om #I Object mask pointer +pointer skymap #I Sky map +pointer sigmap #I Sigma map +pointer gainmap #I Gain map +pointer expmap #I Exposure map +int logfd #I Logfile + +int i, n, c, l, nc, nl, c1, c2, nummax, num, nobjsap +real x, x2, y, y2, s, s2, f, f2, val, sky, ssig, s2x, s2y +pointer objs, obj, rlptr +pointer data, skydata, ssigdata, gaindata, expdata, sigdata +pointer sp, v, rl, sum_s2x, sum_s2y + +int andi(), ori(), ctor() +real imgetr() +bool pm_linenotempty() +errchk salloc, calloc, malloc, evgdata + +begin + call smark (sp) + call salloc (v, PM_MAXDIM, TY_LONG) + call salloc (rl, 3+3*IM_LEN(im,1), TY_INT) + + if (logfd != NULL) + call fprintf (logfd, " Evaluate objects:\n") + + objs = CAT_OBJS(cat) + nummax = CAT_NUMMAX(cat) + + nc = IM_LEN(im,1) + nl = IM_LEN(im,2) + + # Allocate work arrays. + call salloc (sigdata, nc, TY_REAL) + call salloc (sum_s2x, nummax, TY_REAL) + call salloc (sum_s2y, nummax, TY_REAL) + call aclrr (Memr[sum_s2x], nummax) + call aclrr (Memr[sum_s2y], nummax) + + # Initialize isophotal quantities. + do i = NUMSTART-1, nummax-1 { + obj = Memi[objs+i] + if (obj == NULL) + next + OBJ_NPIX(obj) = 0 + OBJ_SKY(obj) = 0. + OBJ_PEAK(obj) = 0. + OBJ_FLUX(obj) = 0. + OBJ_X1(obj) = 0. + OBJ_Y1(obj) = 0. + OBJ_X2(obj) = 0. + OBJ_Y2(obj) = 0. + OBJ_XY(obj) = 0. + OBJ_SIG(obj) = 0. + OBJ_ISIGAVG(obj) = 0. + OBJ_ISIGAVG2(obj) = INDEFR + OBJ_FLUXVAR(obj) = 0. + OBJ_XVAR(obj) = 0. + OBJ_YVAR(obj) = 0. + OBJ_XYCOV(obj) = 0. + } + + # Initialize aperture photometry. + call evapinit (cat, nobjsap) + + # Get magnitude zero. + if (EVL_MAGZERO(evl,1) == '!') { + iferr (CAT_MAGZERO(cat) = imgetr (im, EVL_MAGZERO(evl,2))) { + call erract (EA_WARN) + CAT_MAGZERO(cat) = INDEFR + } + } else { + i = 1 + if (ctor (EVL_MAGZERO(evl,1), i, CAT_MAGZERO(cat)) == 0) + CAT_MAGZERO(cat) = INDEFR + } + call catputr (cat, "magzero", CAT_MAGZERO(cat)) + + # Go through the lines of the image accumulating the image data + # into the parameters. The data is read the first time it is + # required. + Memi[v] = 1 + do l = 1, nl { + Memi[v+1] = l + data = NULL + + # Do circular aperture photometry. Check nobjsap to avoid + # subroutine call. + if (nobjsap > 0) + call evapeval (l, im, skymap, sigmap, gainmap, expmap, + data, skydata, ssigdata, gaindata, expdata, sigdata) + + # Accumulate object region quantities if there are object + # regions in the current line. + if (!pm_linenotempty (om, Memi[v])) + next + call pmglri (om, Memi[v], Memi[rl], 0, nc, 0) + + # Go through each object region. + rlptr = rl + do i = 2, Memi[rl] { + rlptr = rlptr + 3 + c1 = Memi[rlptr] + c2 = c1 + Memi[rlptr+1] - 1 + num = MNUM(Memi[rlptr+2]) + + # Do all unevaluated objects and their parents. + while (num >= NUMSTART) { + if (data == NULL) + call evgdata (l, im, skymap, sigmap, gainmap, expmap, + data, skydata, ssigdata, gaindata, expdata, sigdata) + + obj = Memi[objs+num-1] + if (obj == NULL) + break + + if (OBJ_NPIX(obj) == 0) { + val = Memr[data+c1-1] + sky = Memr[skydata+c1-1] + ssig = Memr[ssigdata+c1-1] + + OBJ_XMIN(obj) = c1 + OBJ_XMAX(obj) = c1 + OBJ_YMIN(obj) = l + OBJ_YMAX(obj) = l + OBJ_ISIGMAX(obj) = (val - sky) / ssig + } + + s2x = Memr[sum_s2x+num-1] + s2y = Memr[sum_s2y+num-1] + do c = c1, c2 { + val = Memr[data+c-1] + sky = Memr[skydata+c-1] + ssig = Memr[ssigdata+c-1] + s = Memr[sigdata+c-1] + + x = c - OBJ_XMIN(obj) + y = l - OBJ_YMIN(obj) + x2 = x * x + y2 = y * y + s2 = s * s + + OBJ_NPIX(obj) = OBJ_NPIX(obj) + 1 + OBJ_SKY(obj) = OBJ_SKY(obj) + sky + OBJ_SIG(obj) = OBJ_SIG(obj) + ssig + val = val - sky + if (val > OBJ_PEAK(obj)) + OBJ_PEAK(obj) = val + OBJ_FLUX(obj) = OBJ_FLUX(obj) + val + OBJ_FLUXVAR(obj) = OBJ_FLUXVAR(obj) + s2 + + OBJ_XMIN(obj) = min (OBJ_XMIN(obj), c) + OBJ_XMAX(obj) = max (OBJ_XMAX(obj), c) + OBJ_X1(obj) = OBJ_X1(obj) + x * val + OBJ_X2(obj) = OBJ_X2(obj) + x2 * val + OBJ_XVAR(obj) = OBJ_XVAR(obj) + x2 * s2 + s2x = s2x + x * s2 + + OBJ_YMIN(obj) = min (OBJ_YMIN(obj), l) + OBJ_YMAX(obj) = max (OBJ_YMAX(obj), l) + OBJ_Y1(obj) = OBJ_Y1(obj) + y * val + OBJ_Y2(obj) = OBJ_Y2(obj) + y2 * val + OBJ_YVAR(obj) = OBJ_YVAR(obj) + y2 * s2 + s2y = s2y + y * s2 + + OBJ_XY(obj) = OBJ_XY(obj) + x * y * val + OBJ_XYCOV(obj) = OBJ_XYCOV(obj) + x * y * s2 + + val = val / ssig + OBJ_ISIGAVG(obj) = OBJ_ISIGAVG(obj) + val + OBJ_ISIGMAX(obj) = max (OBJ_ISIGMAX(obj), val) + + } + Memr[sum_s2x+num-1] = s2x + Memr[sum_s2y+num-1] = s2y + + num = OBJ_PNUM(obj) + } + } + } + + # Finish up the evaluations. + do i = NUMSTART-1, nummax-1 { + obj = Memi[objs+i] + if (obj == NULL) + next + n = OBJ_NPIX(obj) + if (n > 0) { + OBJ_SKY(obj) = OBJ_SKY(obj) / n + f = OBJ_FLUX(obj) + if (f > 0.) { + f2 = f * f + x = OBJ_X1(obj) / f + s2x = Memr[sum_s2x+i] + s2y = Memr[sum_s2y+i] + + OBJ_X1(obj) = x + OBJ_XMIN(obj) + OBJ_X2(obj) = OBJ_X2(obj) / f - x * x + OBJ_XVAR(obj) = (OBJ_XVAR(obj) - 2 * x * s2x + + x * x * OBJ_FLUXVAR(obj)) / f2 + + y = OBJ_Y1(obj) / f + OBJ_Y1(obj) = y + OBJ_YMIN(obj) + OBJ_Y2(obj) = OBJ_Y2(obj) / f - y * y + OBJ_YVAR(obj) = (OBJ_YVAR(obj) - 2 * y * s2y + + y * y * OBJ_FLUXVAR(obj)) / f2 + + OBJ_XY(obj) = OBJ_XY(obj) / f - x * y + OBJ_XYCOV(obj) = (OBJ_XYCOV(obj) - x * s2x - + y * s2y + x * y * OBJ_FLUXVAR(obj)) / f2 + + if (IS_INDEFR(OBJ_XAP(obj))) + OBJ_XAP(obj) = OBJ_X1(obj) + if (IS_INDEFR(OBJ_YAP(obj))) + OBJ_YAP(obj) = OBJ_Y1(obj) + } else { + OBJ_X1(obj) = INDEFR + OBJ_Y1(obj) = INDEFR + OBJ_X2(obj) = INDEFR + OBJ_Y2(obj) = INDEFR + OBJ_XY(obj) = INDEFR + OBJ_XVAR(obj) = INDEFR + OBJ_YVAR(obj) = INDEFR + OBJ_XYCOV(obj) = INDEFR + OBJ_FLUXVAR(obj) = INDEFR + } + if (OBJ_PEAK(obj) == 0.) + OBJ_PEAK(obj) = INDEFR + OBJ_SIG(obj) = OBJ_SIG(obj) / n + OBJ_ISIGAVG(obj) = OBJ_ISIGAVG(obj) / sqrt(real(n)) + } + SETFLAG (obj, OBJ_EVAL) + } + + # Do aperture photometry if we had to wait for the aperture centers + # to be defined. + if (nobjsap == 0) { + call evapinit (cat, nobjsap) + if (nobjsap > 0) { + Memi[v] = 1 + do l = 1, nl { + Memi[v+1] = l + data = NULL + call evapeval (l, im, skymap, sigmap, gainmap, expmap, + data, skydata, ssigdata, gaindata, expdata, sigdata) + } + } + } + call evapfree () + + # Set apportioned fluxes. + call evapportion (cat, Memr[sum_s2x]) + + # Set WCS coordinates. + call evalwcs (cat, im) + + call sfree (sp) +end + + +# EVAPINIT -- Initialize aperture photometry. nobjsap will signal whether +# there are any objects to evaluate. + +procedure evapinit (cat, nobjsap) + +pointer cat #I Catalog +int nobjsap #O Number of objects for aperture evaluation + +int i, nummax +pointer tbl, stp, sym, apflux, obj, sthead(), stnext() + +int ycompare() +extern ycompare +errchk calloc, malloc + +int nobjs # Number of objects to evaluate +int naps # Number of apertures per object +real rmax # Maximum aperture radius +pointer r2aps # Array of aperture radii squared (ptr) +pointer ysort # Array of Y sorted object number indices (ptr) +int ystart # Index of first object to consider +pointer objs # Array of object structure (ptr) +common /evapcom/ nobjs, naps, rmax, r2aps, ysort, ystart, objs + +begin + nobjsap = 0 + nobjs = 0 + naps = 0 + r2aps = NULL + ysort = NULL + + tbl = CAT_OUTTBL(cat) + if (tbl == NULL) + return + stp = TBL_STP(tbl) + + # Determine number of apertures. + naps = 0 + for (sym=sthead(stp); sym!=NULL; sym=stnext(stp,sym)) { + if (ENTRY_ID(sym) != ID_APFLUX) + next + } + if (naps == 0) + return + + objs = CAT_OBJS(cat) + nummax = CAT_NUMMAX(cat) + + # Allocate memory. + call calloc (CAT_APFLUX(cat), nummax*naps, TY_REAL) + call malloc (r2aps, naps, TY_REAL) + call malloc (ysort, nummax, TY_INT) + + # Get the maximum radius since that will define the line + # limits needed for each object. Compute array of radius squared + # for the apertures. Pixels are checked for being in the aperture + # in r^2 to avoid square roots. + rmax = 0. + naps = 0 + for (sym=sthead(stp); sym!=NULL; sym=stnext(stp,sym)) { + if (ENTRY_ID(sym) != ID_APFLUX) + next + rmax = max (ENTRY_RAP(sym), rmax) + Memr[r2aps+naps] = ENTRY_RAP(sym) ** 2 + naps = naps + 1 + } + + # Allocate regions of the apflux array to objects with + # defined aperture centers. For the objects create a sorted + # index array by YAP so that we can quickly find objects + # which include a particular line in their apertures. + + apflux = CAT_APFLUX(cat) + do i = NUMSTART-1, nummax-1 { + obj = Memi[objs+i] + if (obj == NULL) + next + if (IS_INDEFR(OBJ_XAP(obj)) || IS_INDEFR(OBJ_YAP(obj))) + next + OBJ_APFLUX(obj) = apflux + apflux = apflux + naps + Memi[ysort+nobjsap] = i + nobjsap = nobjsap + 1 + } + + if (nobjsap > 1) + call gqsort (Memi[ysort], nobjsap, ycompare, objs) + + if (nobjsap == 0) { + call mfree (CAT_APFLUX(cat), TY_REAL) + call evapfree () + } +end + + +# EVAPFREE -- Free aperture photometry memory. + +procedure evapfree () + +int nobjs # Number of objects to evaluate +int naps # Number of apertures per object +real rmax # Maximum aperture radius +pointer r2aps # Array of aperture radii squared (ptr) +pointer ysort # Array of Y sorted object number indices (ptr) +int ystart # Index of first object to consider +pointer objs # Array of object structure (ptr) +common /evapcom/ nobjs, naps, rmax, r2aps, ysort, ystart, objs + +begin + call mfree (r2aps, TY_REAL) + call mfree (ysort, TY_INT) +end + + +# EVAPEVAL -- Do circular aperture photometry. Maintain i1 as the +# first entry in the sorted index array to be considered. All +# earlier entries will have all aperture lines less than the +# current line. Break on the first object whose minimum aperture +# line is greater than the current line. + +procedure evapeval (l, im, skymap, sigmap, gainmap, expmap, data, skydata, + ssigdata, gaindata, expdata, sigdata) + +int l #I Line +pointer im #I Image +pointer skymap #I Sky map +pointer sigmap #I Sigma map +pointer gainmap #I Gain map +pointer expmap #I Exposure map +pointer data #O Image data +pointer skydata #O Sky data +pointer ssigdata #O Sky sigma data +pointer gaindata #O Gain data +pointer expdata #O Exposure data +pointer sigdata #O Total sigma data + +int i, j, nc, c +real x, y, l2, r2, val, sky +pointer obj, apflux + +int nobjs # Number of objects to evaluate +int naps # Number of apertures per object +real rmax # Maximum aperture radius +pointer r2aps # Array of aperture radii squared (ptr) +pointer ysort # Array of Y sorted object number indices (ptr) +int ystart # Index of first object to consider +pointer objs # Array of object structure (ptr) +common /evapcom/ nobjs, naps, rmax, r2aps, ysort, ystart, objs + +begin + nc = IM_LEN(im,1) + do i = ystart, nobjs { + obj = Memi[objs+Memi[ysort+i-1]] + y = OBJ_YAP(obj) + if (y - rmax > l) + break + if (y + rmax < l) { + ystart = ystart + 1 + next + } + x = OBJ_XAP(obj) + apflux = OBJ_APFLUX(obj) + if (data == NULL) + call evgdata (l, im, skymap, sigmap, gainmap, expmap, + data, skydata, ssigdata, gaindata, expdata, sigdata) + + # Accumulate data within in the apertures using the r^2 + # values. Currently partial pixels are not considered and + # errors are not evaluated. + # Note that bad pixels or object overlaps are not excluded + # in the apertures. + l2 = (l - y) ** 2 + do c = max (0, int(x-rmax)), min (nc, int(x+rmax+1)) { + r2 = (c - x) ** 2 + l2 + do j = 0, naps-1 { + if (r2 < Memr[r2aps+j]) { + val = Memr[data+c-1] + sky = Memr[skydata+c-1] + Memr[apflux+j] = Memr[apflux+j] + (val - sky) + } + } + } + } +end + + +# EVAPPORTION -- Compute apportioned fluxes after the object isophotoal +# fluxes have been computed. + +procedure evapportion (cat, sum_flux) + +pointer cat #I Catalog +real sum_flux[ARB] #I Work array of size NUMMAX + +int nummax, num, pnum, nindef +pointer objs, obj, pobj + +begin + objs = CAT_OBJS(cat) + nummax = CAT_NUMMAX(cat) + + call aclrr (sum_flux, nummax) + do num = NUMSTART, nummax { + obj = Memi[objs+num-1] + if (obj == NULL) + next + pnum = OBJ_PNUM(obj) + if (pnum == 0) { + OBJ_FRAC(obj) = 1. + OBJ_FRACFLUX(obj) = OBJ_FLUX(obj) + next + } + + sum_flux[pnum] = sum_flux[pnum] + max (0., OBJ_FLUX(obj)) + OBJ_FRACFLUX(obj) = INDEFR + } + + nindef = 0 + do num = NUMSTART, nummax { + obj = Memi[objs+num-1] + if (obj == NULL) + next + pnum = OBJ_PNUM(obj) + if (pnum == 0) + next + pobj = Memi[objs+pnum-1] + + if (sum_flux[pnum] > 0.) { + OBJ_FRAC(obj) = max (0., OBJ_FLUX(obj)) / sum_flux[pnum] + if (IS_INDEFR(OBJ_FRACFLUX(pobj))) + nindef = nindef + 1 + else + OBJ_FRACFLUX(obj) = OBJ_FRACFLUX(pobj) * OBJ_FRAC(obj) + } else { + OBJ_FRAC(obj) = INDEFR + OBJ_FRACFLUX(obj) = OBJ_FLUX(obj) + } + } + + while (nindef > 0) { + nindef = 0 + do num = NUMSTART, nummax { + obj = Memi[objs+num-1] + if (obj == NULL) + next + pnum = OBJ_PNUM(obj) + if (pnum == 0) + next + + pobj = Memi[objs+pnum-1] + if (IS_INDEFR(OBJ_FRACFLUX(pobj))) + nindef = nindef + 1 + else { + if (IS_INDEFR(OBJ_FRAC(obj))) + OBJ_FRACFLUX(obj) = OBJ_FLUX(obj) + else + OBJ_FRACFLUX(obj) = OBJ_FRACFLUX(pobj) * OBJ_FRAC(obj) + } + } + } +end + + +# EVALWCS -- Set WCS coordinates. + +procedure evalwcs (cat, im) + +pointer cat #I Catalog structure +pointer im #I IMIO pointer + +int i +pointer mw, ct, objs, obj, mw_openim(), mw_sctran() +errchk mw_openim + +begin + mw = mw_openim (im) + ct = mw_sctran (mw, "logical", "world", 03B) + + objs = CAT_OBJS(cat) + do i = NUMSTART-1, CAT_NUMMAX(cat)-1 { + obj = Memi[objs+i] + if (obj == NULL) + next + if (IS_INDEFR(OBJ_XAP(obj)) || IS_INDEFR(OBJ_YAP(obj))) { + OBJ_WX(obj) = INDEFD + OBJ_WY(obj) = INDEFD + } else + call mw_c2trand (ct, double(OBJ_XAP(obj)), + double(OBJ_YAP(obj)), OBJ_WX(obj), OBJ_WY(obj)) + } + + call mw_ctfree (ct) + call mw_close (mw) +end + + +# YCOMPARE -- Compare Y values of two objects for sorting. + +int procedure ycompare (objs, i1, i2) + +pointer objs #I Pointer to array of objects +int i1 #I Index of first object to compare +int i2 #I Index of second object to compare + +real y1, y2 + +begin + y1 = OBJ_YAP(Memi[objs+i1]) + y2 = OBJ_YAP(Memi[objs+i2]) + if (y1 < y2) + return (-1) + else if (y1 > y2) + return (1) + else + return (0) +end + + +# EVGDATA -- Get evaluation data for an image line. + +procedure evgdata (l, im, skymap, sigmap, gainmap, expmap, data, skydata, + ssigdata, gaindata, expdata, sigdata) + +int l #I Line +pointer im #I Image +pointer skymap #I Sky map +pointer sigmap #I Sigma map +pointer gainmap #I Gain map +pointer expmap #I Exposure map +pointer data #O Image data +pointer skydata #O Sky data +pointer ssigdata #O Sky sigma data +pointer gaindata #O Gain data +pointer expdata #O Exposure data +pointer sigdata #O Total sigma data + +int nc +pointer imgl2r(), map_glr() +errchk imgl2r, map_glr, noisemodel + +begin + nc = IM_LEN(im,1) + data = imgl2r (im, l) + skydata = map_glr (skymap, l, READ_ONLY) + ssigdata = map_glr (sigmap, l, READ_ONLY) + if (gainmap == NULL && expmap == NULL) + sigdata = ssigdata + else if (expmap == NULL) { + gaindata = map_glr (gainmap, l, READ_ONLY) + call noisemodel (Memr[data], Memr[skydata], + Memr[ssigdata], Memr[gaindata], INDEFR, + Memr[sigdata], nc) + } else if (gainmap == NULL) { + expdata = map_glr (expmap, l, READ_WRITE) + call noisemodel (Memr[data], Memr[skydata], + Memr[ssigdata], INDEFR, Memr[expdata], + Memr[sigdata], nc) + } else { + gaindata = map_glr (gainmap, l, READ_ONLY) + expdata = map_glr (expmap, l, READ_WRITE) + call noisemodel (Memr[data], Memr[skydata], + Memr[ssigdata], Memr[gaindata], + Memr[expdata], Memr[sigdata], nc) + } +end diff --git a/noao/nproto/ace/filter.h b/noao/nproto/ace/filter.h new file mode 100644 index 00000000..c61382b2 --- /dev/null +++ b/noao/nproto/ace/filter.h @@ -0,0 +1,14 @@ +# Filter operand names. +define FILT_NAMES "|id|number|x|y|wx|wy|npix|flux|peak|" +define FILT_OBJID 1 +define FILT_NUM 2 +define FILT_X 3 +define FILT_Y 4 +define FILT_WX 5 +define FILT_WY 6 +define FILT_NPIX 7 +define FILT_FLUX 8 +define FILT_PEAK 9 + +# Filter functions. +define FILT_FUNCS "|dummy|" diff --git a/noao/nproto/ace/filter.x b/noao/nproto/ace/filter.x new file mode 100644 index 00000000..b43e3de0 --- /dev/null +++ b/noao/nproto/ace/filter.x @@ -0,0 +1,134 @@ +include <evvexpr.h> +include "ace.h" +include "objs.h" +include "filter.h" + + +procedure t_filter () + +pointer catalog #I Catalog name +pointer filt #I Filter + +pointer sp, cat, obj, cathead(), catnext() +errchk catopen + +begin + call smark (sp) + call salloc (catalog, SZ_FNAME, TY_CHAR) + call salloc (filt, SZ_LINE, TY_CHAR) + + call clgstr ("catalog", Memc[catalog], SZ_FNAME) + call clgstr ("filter", Memc[filt], SZ_FNAME) + + call catopen (cat, Memc[catalog], Memc[catalog], "") + + for (obj=cathead(cat); obj!=NULL; obj=catnext(cat,obj)) { + call printf ("%d\n") + call pargi (OBJ_ROW(obj)) + } + + call catclose (cat) + + call sfree (sp) +end + + +bool procedure filter (obj, filt) + +pointer obj #I Object structure +char filt[ARB] #I Filter string +bool match #O Filter return value + +int type, locpr() +pointer o, evvexpr() +extern filt_op(), filt_func() +errchk evvexpr + +begin + if (obj == NULL) + return (false) + if (filt[1] == EOS) + return (true) + + # Evaluate filter. + o = evvexpr (filt, locpr (filt_op), obj, locpr (filt_func), obj, 0) + if (o == NULL) + return (false) + + type = O_TYPE(o) + if (O_TYPE(o) == TY_BOOL) + match = (O_VALI(o) == YES) + + call mfree (o, TY_STRUCT) + if (type != TY_BOOL) + call error (1, "Filter expression is not boolean") + + return (match) +end + + +procedure filt_op (obj, name, o) + +pointer obj #I Object structure +char name[ARB] #I Operand name +pointer o #O Pointer to output operand + +char lname[SZ_FNAME] +int i, strdic() + +begin + call strcpy (name, lname, SZ_FNAME) + call strlwr (lname) + i = strdic (lname, lname, SZ_FNAME, FILT_NAMES) + switch (i) { + case FILT_NUM: + call xvv_initop (o, 0, TY_INT) + O_VALI(o) = OBJ_NUM(obj) + case FILT_X: + call xvv_initop (o, 0, TY_DOUBLE) + O_VALD(o) = OBJ_XAP(obj) + case FILT_Y: + call xvv_initop (o, 0, TY_DOUBLE) + O_VALD(o) = OBJ_YAP(obj) + case FILT_WX: + call xvv_initop (o, 0, TY_DOUBLE) + O_VALD(o) = OBJ_WX(obj) + case FILT_WY: + call xvv_initop (o, 0, TY_DOUBLE) + O_VALD(o) = OBJ_WY(obj) + case FILT_NPIX: + call xvv_initop (o, 0, TY_INT) + O_VALI(o) = OBJ_NPIX(obj) + case FILT_FLUX: + call xvv_initop (o, 0, TY_DOUBLE) + O_VALD(o) = OBJ_FLUX(obj) + case FILT_PEAK: + call xvv_initop (o, 0, TY_DOUBLE) + O_VALD(o) = OBJ_PEAK(obj) + default: + call xvv_error1 ("quantity `%s' not found", name) + } +end + + + +procedure filt_func (obj, func, args, nargs, o) + +pointer obj #I Object structure +char func[ARB] #I Function +pointer args[ARB] #I Arguments +int nargs #I Number of arguments +pointer o #O Function value operand + +int ifunc, strdic() +pointer sp, buf +bool strne() + +begin + call smark (sp) + call salloc (buf, SZ_LINE, TY_CHAR) + + ifunc = strdic (func, Memc[buf], SZ_LINE, FILT_FUNCS) + if (ifunc == 0 || strne (func, Memc[buf])) + call xvv_error1 ("unknown function `%s'", func) +end diff --git a/noao/nproto/ace/grow.h b/noao/nproto/ace/grow.h new file mode 100644 index 00000000..ff91542e --- /dev/null +++ b/noao/nproto/ace/grow.h @@ -0,0 +1,6 @@ +# Grow parameter structure + +define GRW_LEN 2 # Length of parameter structure + +define GRW_NGROW Memi[$1] # Number of grow passes +define GRW_AGROW Memr[P2R($1+1)] # Grow area factor diff --git a/noao/nproto/ace/grow.x b/noao/nproto/ace/grow.x new file mode 100644 index 00000000..a9c84cd2 --- /dev/null +++ b/noao/nproto/ace/grow.x @@ -0,0 +1,959 @@ +include <pmset.h> +include "ace.h" +include "cat.h" +include "objs.h" +include "grow.h" + + +procedure grow (grw, cat, objmask, logfd) + +pointer grw #I Grow parameter structure +pointer cat #I Catalog of objects +pointer objmask #I Object mask +int logfd #I Logfile + +int ngrow #I Number of pixels to grow +real agrow #I Area factor grow + +int i, j, nc, nl, m, n +pointer sp, v, bufs, obuf +pointer buf1, buf2, buf3, obj + +int grow1(), grow2(), grow3(), andi(), ori(), noti() +pointer cathead(), catnext() + +begin + call grw_pars ("open", "", grw) + ngrow = GRW_NGROW(grw) + agrow = GRW_AGROW(grw) + + if (ngrow < 1 && agrow <= 1.) + return + + if (logfd != NULL) { + call fprintf (logfd, " Grow objects: ngrow = %d, agrow = %g\n") + call pargi (ngrow) + call pargr (agrow) + } + + call smark (sp) + call salloc (v, PM_MAXDIM, TY_LONG) + + call pm_gsize (objmask, i, Meml[v], n) + nc = Meml[v]; nl = Meml[v+1] + Meml[v] = 1 + + call salloc (bufs, 3, TY_POINTER) + do i = 1, 3 + call salloc (Memi[bufs+i-1], nc, TY_INT) + call salloc (obuf, nc, TY_INT) + + for (obj=cathead(cat); obj!=NULL; obj=catnext(cat,obj)) { + if (GROWN(obj)) + next + UNSETFLAG (obj, OBJ_EVAL) + OBJ_NDETECT(obj) = OBJ_NPIX(obj) + } + + do j = 1, ngrow { + m = 0 + buf2 = NULL; buf3 = NULL + do i = 1, nl { + buf1 = buf2 + buf2 = buf3 + buf3 = NULL + + if (i != 1 && buf1 == NULL) { + Meml[v+1] = i - 1 + buf1 = Memi[bufs+mod(Meml[v+1],3)] + call pmglpi (objmask, Meml[v], Memi[buf1], 0, nc, 0) + } + if (buf2 == NULL) { + Meml[v+1] = i + buf2 = Memi[bufs+mod(Meml[v+1],3)] + call pmglpi (objmask, Meml[v], Memi[buf2], 0, nc, 0) + } + if (i != nl && buf3 == NULL) { + Meml[v+1] = i+1 + buf3 = Memi[bufs+mod(Meml[v+1],3)] + call pmglpi (objmask, Meml[v], Memi[buf3], 0, nc, 0) + } + + if (i == 1) + n = grow1 (cat, i, Memi[buf2], Memi[buf3], + Memi[obuf], nc, nl) + else if (i == nl) + n = grow3 (cat, i, Memi[buf1], Memi[buf2], + Memi[obuf], nc, nl) + else + n = grow2 (cat, i, Memi[buf1], Memi[buf2], Memi[buf3], + Memi[obuf], nc, nl) + + if (n > 0) { + Meml[v+1] = i + call pmplpi (objmask, Meml[v], Memi[obuf], 0, nc, PIX_SRC) + m = m + n + } + } + + n = 0 + for (obj=cathead(cat); obj!=NULL; obj=catnext(cat,obj)) { + if (GROWN(obj)) + next + if (real (OBJ_NPIX(obj)) / OBJ_NDETECT(obj) >= agrow) + SETFLAG (obj, OBJ_GROW) + else + n = n + 1 + } + + if (n == 0 || m == 0) + break + } + + if (n != 0) { + for (obj=cathead(cat); obj!=NULL; obj=catnext(cat,obj)) { + if (GROWN(obj)) + next + SETFLAG (obj, OBJ_GROW) + } + } + + call sfree (sp) +end + + +int procedure grow1 (cat, line, in2, in3, out, nc, nl) + +pointer cat #I Catalog +int line #I Line +int in2[nc] #I Current line +int in3[nc] #I Next line +int out[nc] #I Output line +int nc, nl #I Dimension of image + +int i, j, n, id, id0, id1, num1, andi() +bool grow +pointer objs, obj, obj1 + +begin + objs = CAT_OBJS(cat) - 1 + obj1 = NULL + n = 0 + do i = 1, nc { + id0 = in2[i] + if (id0 != 0 && MNOTSPLIT(id0)) { + out[i] = id0 + next + } + + id = 0 + j = i - 1 + if (i > 1) { + id1 = in2[j] + num1 = MNUM(id1) + if (num1 >= NUMSTART) { + if (MNOTSPLIT(id1)) { + if (obj1 == NULL) { + obj1 = Memi[objs+num1] + grow = NOTGROWN(obj1) + } else if (OBJ_NUM(obj1) != num1) { + obj1 = Memi[objs+num1] + grow = NOTGROWN(obj1) + } + if (grow) { + if (id == 0) { + id = id1 + obj = obj1 + } else if (id != id1) { + if (OBJ_FLUX(obj) < OBJ_FLUX(obj1)) { + id = id1 + obj = obj1 + } + } + } + } + } + id1 = in3[j] + num1 = MNUM(id1) + if (num1 >= NUMSTART) { + if (MNOTSPLIT(id1)) { + if (obj1 == NULL) { + obj1 = Memi[objs+num1] + grow = NOTGROWN(obj1) + } else if (OBJ_NUM(obj1) != num1) { + obj1 = Memi[objs+num1] + grow = NOTGROWN(obj1) + } + if (grow) { + if (id == 0) { + id = id1 + obj = obj1 + } else if (id != id1) { + if (OBJ_FLUX(obj) < OBJ_FLUX(obj1)) { + id = id1 + obj = obj1 + } + } + } + } + } + } + id1 = in3[i] + num1 = MNUM(id1) + if (num1 >= NUMSTART) { + if (MNOTSPLIT(id1)) { + if (obj1 == NULL) { + obj1 = Memi[objs+num1] + grow = NOTGROWN(obj1) + } else if (OBJ_NUM(obj1) != num1) { + obj1 = Memi[objs+num1] + grow = NOTGROWN(obj1) + } + if (grow) { + if (id == 0) { + id = id1 + obj = obj1 + } else if (id != id1) { + if (OBJ_FLUX(obj) < OBJ_FLUX(obj1)) { + id = id1 + obj = obj1 + } + } + } + } + } + j = i + 1 + if (i < nc) { + id1 = in2[j] + num1 = MNUM(id1) + if (num1 >= NUMSTART) { + if (MNOTSPLIT(id1)) { + if (obj1 == NULL) { + obj1 = Memi[objs+num1] + grow = NOTGROWN(obj1) + } else if (OBJ_NUM(obj1) != num1) { + obj1 = Memi[objs+num1] + grow = NOTGROWN(obj1) + } + if (grow) { + if (id == 0) { + id = id1 + obj = obj1 + } else if (id != id1) { + if (OBJ_FLUX(obj) < OBJ_FLUX(obj1)) { + id = id1 + obj = obj1 + } + } + } + } + } + id1 = in3[j] + num1 = MNUM(id1) + if (num1 >= NUMSTART) { + if (MNOTSPLIT(id1)) { + if (obj1 == NULL) { + obj1 = Memi[objs+num1] + grow = NOTGROWN(obj1) + } else if (OBJ_NUM(obj1) != num1) { + obj1 = Memi[objs+num1] + grow = NOTGROWN(obj1) + } + if (grow) { + if (id == 0) { + id = id1 + obj = obj1 + } else if (id != id1) { + if (OBJ_FLUX(obj) < OBJ_FLUX(obj1)) { + id = id1 + obj = obj1 + } + } + } + } + } + } + + if (id == 0) + out[i] = in2[i] + else { + out[i] = id + OBJ_NPIX(obj) = OBJ_NPIX(obj) + 1 + n = n + 1 + } + } + + return (n) +end + + +int procedure grow2 (cat, line, in1, in2, in3, out, nc, nl) + +pointer cat #I Catalog +int line #I Line +int in1[nc] #I Previous line +int in2[nc] #I Current line +int in3[nc] #I Next line +int out[nc] #I Output line +int nc, nl #I Dimension of image + +int i, j, n, id, id0, id1, num1, andi() +bool grow +pointer objs, obj, obj1 + +begin + objs = CAT_OBJS(cat) - 1 + obj1 = NULL + n = 0 + do i = 2, nc-1 { + id0 = in2[i] + if (id0 != 0 && MNOTSPLIT(id0)) { + out[i] = id0 + next + } + + id = 0 + j = i - 1 + id1 = in1[j] + num1 = MNUM(id1) + if (num1 >= NUMSTART) { + if (MNOTSPLIT(id1)) { + if (obj1 == NULL) { + obj1 = Memi[objs+num1] + grow = NOTGROWN(obj1) + } else if (OBJ_NUM(obj1) != num1) { + obj1 = Memi[objs+num1] + grow = NOTGROWN(obj1) + } + if (grow) { + if (id == 0) { + id = id1 + obj = obj1 + } else if (id != id1) { + if (OBJ_FLUX(obj) < OBJ_FLUX(obj1)) { + id = id1 + obj = obj1 + } + } + } + } + } + id1 = in2[j] + num1 = MNUM(id1) + if (num1 >= NUMSTART) { + if (MNOTSPLIT(id1)) { + if (obj1 == NULL) { + obj1 = Memi[objs+num1] + grow = NOTGROWN(obj1) + } else if (OBJ_NUM(obj1) != num1) { + obj1 = Memi[objs+num1] + grow = NOTGROWN(obj1) + } + if (grow) { + if (id == 0) { + id = id1 + obj = obj1 + } else if (id != id1) { + if (OBJ_FLUX(obj) < OBJ_FLUX(obj1)) { + id = id1 + obj = obj1 + } + } + } + } + } + id1 = in3[j] + num1 = MNUM(id1) + if (num1 >= NUMSTART) { + if (MNOTSPLIT(id1)) { + if (obj1 == NULL) { + obj1 = Memi[objs+num1] + grow = NOTGROWN(obj1) + } else if (OBJ_NUM(obj1) != num1) { + obj1 = Memi[objs+num1] + grow = NOTGROWN(obj1) + } + if (grow) { + if (id == 0) { + id = id1 + obj = obj1 + } else if (id != id1) { + if (OBJ_FLUX(obj) < OBJ_FLUX(obj1)) { + id = id1 + obj = obj1 + } + } + } + } + } + id1 = in1[i] + num1 = MNUM(id1) + if (num1 >= NUMSTART) { + if (MNOTSPLIT(id1)) { + if (obj1 == NULL) { + obj1 = Memi[objs+num1] + grow = NOTGROWN(obj1) + } else if (OBJ_NUM(obj1) != num1) { + obj1 = Memi[objs+num1] + grow = NOTGROWN(obj1) + } + if (grow) { + if (id == 0) { + id = id1 + obj = obj1 + } else if (id != id1) { + if (OBJ_FLUX(obj) < OBJ_FLUX(obj1)) { + id = id1 + obj = obj1 + } + } + } + } + } + id1 = in3[i] + num1 = MNUM(id1) + if (num1 >= NUMSTART) { + if (MNOTSPLIT(id1)) { + if (obj1 == NULL) { + obj1 = Memi[objs+num1] + grow = NOTGROWN(obj1) + } else if (OBJ_NUM(obj1) != num1) { + obj1 = Memi[objs+num1] + grow = NOTGROWN(obj1) + } + if (grow) { + if (id == 0) { + id = id1 + obj = obj1 + } else if (id != id1) { + if (OBJ_FLUX(obj) < OBJ_FLUX(obj1)) { + id = id1 + obj = obj1 + } + } + } + } + } + j = i + 1 + id1 = in1[j] + num1 = MNUM(id1) + if (num1 >= NUMSTART) { + if (MNOTSPLIT(id1)) { + if (obj1 == NULL) { + obj1 = Memi[objs+num1] + grow = NOTGROWN(obj1) + } else if (OBJ_NUM(obj1) != num1) { + obj1 = Memi[objs+num1] + grow = NOTGROWN(obj1) + } + if (grow) { + if (id == 0) { + id = id1 + obj = obj1 + } else if (id != id1) { + if (OBJ_FLUX(obj) < OBJ_FLUX(obj1)) { + id = id1 + obj = obj1 + } + } + } + } + } + id1 = in2[j] + num1 = MNUM(id1) + if (num1 >= NUMSTART) { + if (MNOTSPLIT(id1)) { + if (obj1 == NULL) { + obj1 = Memi[objs+num1] + grow = NOTGROWN(obj1) + } else if (OBJ_NUM(obj1) != num1) { + obj1 = Memi[objs+num1] + grow = NOTGROWN(obj1) + } + if (grow) { + if (id == 0) { + id = id1 + obj = obj1 + } else if (id != id1) { + if (OBJ_FLUX(obj) < OBJ_FLUX(obj1)) { + id = id1 + obj = obj1 + } + } + } + } + } + id1 = in3[j] + num1 = MNUM(id1) + if (num1 >= NUMSTART) { + if (MNOTSPLIT(id1)) { + if (obj1 == NULL) { + obj1 = Memi[objs+num1] + grow = NOTGROWN(obj1) + } else if (OBJ_NUM(obj1) != num1) { + obj1 = Memi[objs+num1] + grow = NOTGROWN(obj1) + } + if (grow) { + if (id == 0) { + id = id1 + obj = obj1 + } else if (id != id1) { + if (OBJ_FLUX(obj) < OBJ_FLUX(obj1)) { + id = id1 + obj = obj1 + } + } + } + } + } + + if (id == 0) + out[i] = in2[i] + else { + out[i] = id + OBJ_NPIX(obj) = OBJ_NPIX(obj) + 1 + n = n + 1 + } + } + + # First pixel + id0 = in2[1] + if (id0 != 0 && MNOTSPLIT(id0)) + out[1] = id0 + else { + id = 0 + id1 = in1[1] + num1 = MNUM(id1) + if (num1 >= NUMSTART) { + if (MNOTSPLIT(id1)) { + if (obj1 == NULL) { + obj1 = Memi[objs+num1] + grow = NOTGROWN(obj1) + } else if (OBJ_NUM(obj1) != num1) { + obj1 = Memi[objs+num1] + grow = NOTGROWN(obj1) + } + if (grow) { + if (id == 0) { + id = id1 + obj = obj1 + } else if (id != id1) { + if (OBJ_FLUX(obj) < OBJ_FLUX(obj1)) { + id = id1 + obj = obj1 + } + } + } + } + } + id1 = in3[1] + num1 = MNUM(id1) + if (num1 >= NUMSTART) { + if (MNOTSPLIT(id1)) { + if (obj1 == NULL) { + obj1 = Memi[objs+num1] + grow = NOTGROWN(obj1) + } else if (OBJ_NUM(obj1) != num1) { + obj1 = Memi[objs+num1] + grow = NOTGROWN(obj1) + } + if (grow) { + if (id == 0) { + id = id1 + obj = obj1 + } else if (id != id1) { + if (OBJ_FLUX(obj) < OBJ_FLUX(obj1)) { + id = id1 + obj = obj1 + } + } + } + } + } + id1 = in1[2] + num1 = MNUM(id1) + if (num1 >= NUMSTART) { + if (MNOTSPLIT(id1)) { + if (obj1 == NULL) { + obj1 = Memi[objs+num1] + grow = NOTGROWN(obj1) + } else if (OBJ_NUM(obj1) != num1) { + obj1 = Memi[objs+num1] + grow = NOTGROWN(obj1) + } + if (grow) { + if (id == 0) { + id = id1 + obj = obj1 + } else if (id != id1) { + if (OBJ_FLUX(obj) < OBJ_FLUX(obj1)) { + id = id1 + obj = obj1 + } + } + } + } + } + id1 = in2[2] + num1 = MNUM(id1) + if (num1 >= NUMSTART) { + if (MNOTSPLIT(id1)) { + if (obj1 == NULL) { + obj1 = Memi[objs+num1] + grow = NOTGROWN(obj1) + } else if (OBJ_NUM(obj1) != num1) { + obj1 = Memi[objs+num1] + grow = NOTGROWN(obj1) + } + if (grow) { + if (id == 0) { + id = id1 + obj = obj1 + } else if (id != id1) { + if (OBJ_FLUX(obj) < OBJ_FLUX(obj1)) { + id = id1 + obj = obj1 + } + } + } + } + } + id1 = in3[2] + num1 = MNUM(id1) + if (num1 >= NUMSTART) { + if (MNOTSPLIT(id1)) { + if (obj1 == NULL) { + obj1 = Memi[objs+num1] + grow = NOTGROWN(obj1) + } else if (OBJ_NUM(obj1) != num1) { + obj1 = Memi[objs+num1] + grow = NOTGROWN(obj1) + } + if (grow) { + if (id == 0) { + id = id1 + obj = obj1 + } else if (id != id1) { + if (OBJ_FLUX(obj) < OBJ_FLUX(obj1)) { + id = id1 + obj = obj1 + } + } + } + } + } + + if (id == 0) + out[1] = in2[1] + else { + out[1] = id + OBJ_NPIX(obj) = OBJ_NPIX(obj) + 1 + n = n + 1 + } + } + + # Last pixel + id0 = in2[nc] + if (id0 != 0 && MNOTSPLIT(id0)) + out[nc] = id0 + else { + id = 0 + j = nc - 1 + id1 = in1[j] + num1 = MNUM(id1) + if (num1 >= NUMSTART) { + if (MNOTSPLIT(id1)) { + if (obj1 == NULL) { + obj1 = Memi[objs+num1] + grow = NOTGROWN(obj1) + } else if (OBJ_NUM(obj1) != num1) { + obj1 = Memi[objs+num1] + grow = NOTGROWN(obj1) + } + if (grow) { + if (id == 0) { + id = id1 + obj = obj1 + } else if (id != id1) { + if (OBJ_FLUX(obj) < OBJ_FLUX(obj1)) { + id = id1 + obj = obj1 + } + } + } + } + } + id1 = in2[j] + num1 = MNUM(id1) + if (num1 >= NUMSTART) { + if (MNOTSPLIT(id1)) { + if (obj1 == NULL) { + obj1 = Memi[objs+num1] + grow = NOTGROWN(obj1) + } else if (OBJ_NUM(obj1) != num1) { + obj1 = Memi[objs+num1] + grow = NOTGROWN(obj1) + } + if (grow) { + if (id == 0) { + id = id1 + obj = obj1 + } else if (id != id1) { + if (OBJ_FLUX(obj) < OBJ_FLUX(obj1)) { + id = id1 + obj = obj1 + } + } + } + } + } + id1 = in3[j] + num1 = MNUM(id1) + if (num1 >= NUMSTART) { + if (MNOTSPLIT(id1)) { + if (obj1 == NULL) { + obj1 = Memi[objs+num1] + grow = NOTGROWN(obj1) + } else if (OBJ_NUM(obj1) != num1) { + obj1 = Memi[objs+num1] + grow = NOTGROWN(obj1) + } + if (grow) { + if (id == 0) { + id = id1 + obj = obj1 + } else if (id != id1) { + if (OBJ_FLUX(obj) < OBJ_FLUX(obj1)) { + id = id1 + obj = obj1 + } + } + } + } + } + id1 = in1[nc] + num1 = MNUM(id1) + if (num1 >= NUMSTART) { + if (MNOTSPLIT(id1)) { + if (obj1 == NULL) { + obj1 = Memi[objs+num1] + grow = NOTGROWN(obj1) + } else if (OBJ_NUM(obj1) != num1) { + obj1 = Memi[objs+num1] + grow = NOTGROWN(obj1) + } + if (grow) { + if (id == 0) { + id = id1 + obj = obj1 + } else if (id != id1) { + if (OBJ_FLUX(obj) < OBJ_FLUX(obj1)) { + id = id1 + obj = obj1 + } + } + } + } + } + id1 = in3[nc] + num1 = MNUM(id1) + if (num1 >= NUMSTART) { + if (MNOTSPLIT(id1)) { + if (obj1 == NULL) { + obj1 = Memi[objs+num1] + grow = NOTGROWN(obj1) + } else if (OBJ_NUM(obj1) != num1) { + obj1 = Memi[objs+num1] + grow = NOTGROWN(obj1) + } + if (grow) { + if (id == 0) { + id = id1 + obj = obj1 + } else if (id != id1) { + if (OBJ_FLUX(obj) < OBJ_FLUX(obj1)) { + id = id1 + obj = obj1 + } + } + } + } + } + + if (id == 0) + out[nc] = in2[nc] + else { + out[nc] = id + OBJ_NPIX(obj) = OBJ_NPIX(obj) + 1 + n = n + 1 + } + } + + return (n) +end + + +int procedure grow3 (cat, line, in1, in2, out, nc, nl) + +pointer cat #I Catalog +int line #I Line +int in1[nc] #I Previous line +int in2[nc] #I Current line +int out[nc] #I Output line +int nc, nl #I Dimension of image + +int i, j, n, id, id0, id1, num1, andi() +bool grow +pointer objs, obj, obj1 + +begin + objs = CAT_OBJS(cat) - 1 + obj1 = NULL + n = 0 + do i = 1, nc { + id0 = in2[i] + if (id0 != 0 && MNOTSPLIT(id0)) { + out[i] = id0 + next + } + + id = 0 + j = i - 1 + if (i > 1) { + id1 = in1[j] + num1 = MNUM(id1) + if (num1 >= NUMSTART) { + if (MNOTSPLIT(id1)) { + if (obj1 == NULL) { + obj1 = Memi[objs+num1] + grow = NOTGROWN(obj1) + } else if (OBJ_NUM(obj1) != num1) { + obj1 = Memi[objs+num1] + grow = NOTGROWN(obj1) + } + if (grow) { + if (id == 0) { + id = id1 + obj = obj1 + } else if (id != id1) { + if (OBJ_FLUX(obj) < OBJ_FLUX(obj1)) { + id = id1 + obj = obj1 + } + } + } + } + } + id1 = in2[j] + num1 = MNUM(id1) + if (num1 >= NUMSTART) { + if (MNOTSPLIT(id1)) { + if (obj1 == NULL) { + obj1 = Memi[objs+num1] + grow = NOTGROWN(obj1) + } else if (OBJ_NUM(obj1) != num1) { + obj1 = Memi[objs+num1] + grow = NOTGROWN(obj1) + } + if (grow) { + if (id == 0) { + id = id1 + obj = obj1 + } else if (id != id1) { + if (OBJ_FLUX(obj) < OBJ_FLUX(obj1)) { + id = id1 + obj = obj1 + } + } + } + } + } + } + id1 = in1[i] + num1 = MNUM(id1) + if (num1 >= NUMSTART) { + if (MNOTSPLIT(id1)) { + if (obj1 == NULL) { + obj1 = Memi[objs+num1] + grow = NOTGROWN(obj1) + } else if (OBJ_NUM(obj1) != num1) { + obj1 = Memi[objs+num1] + grow = NOTGROWN(obj1) + } + if (grow) { + if (id == 0) { + id = id1 + obj = obj1 + } else if (id != id1) { + if (OBJ_FLUX(obj) < OBJ_FLUX(obj1)) { + id = id1 + obj = obj1 + } + } + } + } + } + j = i + 1 + if (i < nc) { + id1 = in1[j] + num1 = MNUM(id1) + if (num1 >= NUMSTART) { + if (MNOTSPLIT(id1)) { + if (obj1 == NULL) { + obj1 = Memi[objs+num1] + grow = NOTGROWN(obj1) + } else if (OBJ_NUM(obj1) != num1) { + obj1 = Memi[objs+num1] + grow = NOTGROWN(obj1) + } + if (grow) { + if (id == 0) { + id = id1 + obj = obj1 + } else if (id != id1) { + if (OBJ_FLUX(obj) < OBJ_FLUX(obj1)) { + id = id1 + obj = obj1 + } + } + } + } + } + id1 = in2[j] + num1 = MNUM(id1) + if (num1 >= NUMSTART) { + if (MNOTSPLIT(id1)) { + if (obj1 == NULL) { + obj1 = Memi[objs+num1] + grow = NOTGROWN(obj1) + } else if (OBJ_NUM(obj1) != num1) { + obj1 = Memi[objs+num1] + grow = NOTGROWN(obj1) + } + if (grow) { + if (id == 0) { + id = id1 + obj = obj1 + } else if (id != id1) { + if (OBJ_FLUX(obj) < OBJ_FLUX(obj1)) { + id = id1 + obj = obj1 + } + } + } + } + } + } + + if (id == 0) + out[i] = in2[i] + else { + out[i] = id + OBJ_NPIX(obj) = OBJ_NPIX(obj) + 1 + n = n + 1 + } + } + + return (n) +end diff --git a/noao/nproto/ace/gwindow.h b/noao/nproto/ace/gwindow.h new file mode 100644 index 00000000..ae91e2ea --- /dev/null +++ b/noao/nproto/ace/gwindow.h @@ -0,0 +1,49 @@ +# Window descriptor structure. + +define LEN_WDES (210+(W_MAXWC+1)*LEN_WC) +define LEN_WC 10 # 4=[XbXeYbYe]+2=tr_type[xy] +define W_MAXWC 5 # max world coord systems +define W_SZSTRING 99 # size of strings +define W_SZIMSECT W_SZSTRING # image section string + +define W_DEVICE Memi[$1] +define W_FRAME Memi[$1+1] # device frame number +define W_XRES Memi[$1+2] # device resolution, x +define W_YRES Memi[$1+3] # device resolution, y +define W_BPDISP Memi[$1+4] # bad pixel display option +define W_BPCOLORS Memi[$1+5] # overlay colors +define W_OCOLORS Memi[$1+6] # badpixel colors +define W_IMSECT Memc[P2C($1+10)] # image section +define W_OVRLY Memc[P2C($1+60)] # overlay mask +define W_BPM Memc[P2C($1+110)] # bad pixel mask +define W_ZPM Memc[P2C($1+160)] # Z scaling pixel mask +define W_WC ($1+$2*LEN_WC+210) # ptr to coord descriptor + +# Fields of the WC coordinate descriptor, a substructure of the window +# descriptor. "W_XB(W_WC(w,0))" is the XB field of wc 0 of window W. + +define W_XS Memr[P2R($1)] # starting X value +define W_XE Memr[P2R($1+1)] # ending X value +define W_XT Memi[$1+2] # X transformation type +define W_YS Memr[P2R($1+3)] # starting Y value +define W_YE Memr[P2R($1+4)] # ending Y value +define W_YT Memi[$1+5] # Y transformation type +define W_ZS Memr[P2R($1+6)] # starting Z value (greyscale) +define W_ZE Memr[P2R($1+7)] # ending Z value +define W_ZT Memi[$1+8] # Z transformation type +define W_UPTR Memi[$1+9] # LUT when ZT=USER + +# WC types. + +define W_NWIN 0 # Display window in NDC coordinates +define W_DWIN 1 # Display window in image pixel coordinates +define W_WWIN 2 # Display window in image world coordinates +define W_IPIX 3 # Image pixel coordinates (in pixels) +define W_DPIX 4 # Display pixel coordinates (in pixels) + +# Types of coordinate and greyscale transformations. + +define W_UNITARY 0 # values map without change +define W_LINEAR 1 # linear mapping +define W_LOG 2 # logarithmic mapping +define W_USER 3 # user specifies transformation diff --git a/noao/nproto/ace/mapio.x b/noao/nproto/ace/mapio.x new file mode 100644 index 00000000..d8f9f9de --- /dev/null +++ b/noao/nproto/ace/mapio.x @@ -0,0 +1,406 @@ +include <error.h> +include <imhdr.h> + +define MAP_LENSTR 99 # Length of strings + +# Map data structure. +define MAP_LEN 64 # Length of map structure +define MAP_NAME Memc[P2C($1)] # Name of map +define MAP_TYPE Memi[$1+51] # Type of map +define MAP_MAP Memi[$1+52] # Structure pointer +define MAP_COPY Memi[$1+53] # Data buffer for copy +define MAP_NC Memi[$1+54] # Number of columns +define MAP_NL Memi[$1+55] # Number of columns +define MAP_SAMPLE Memi[$1+56] # Sample size for lines +define MAP_BUF Memi[$1+57] # Data buffer for constant or sampling +define MAP_BUF1 Memi[$1+58] # Data buffer for sampling +define MAP_BUF2 Memi[$1+59] # Data buffer for sampling +define MAP_LINE1 Memi[$1+60] # Sampling line number +define MAP_LINE2 Memi[$1+61] # Sampling line number +define MAP_LASTLINE Memi[$1+62] # Last line +define MAP_LASTBUF Memi[$1+63] # Data buffer last returned + +# Types of maps allowed. +define MAP_CONST 1 # Constant +define MAP_IMAGE 2 # Image +define MAP_GSURFIT 3 # GSURFIT + + +# MAP_GLR -- Get a line of map data. + +pointer procedure map_glr (map, line, mode) + +pointer map #I Map pointer +int line #I Line +int mode #I Access mode (READ_ONLY, READ_WRITE) + +int i, nc, nl, sample, line1, line2 +real a, b +pointer buf, buf1, buf2, mim_glr(), mgs_glr() +errchk malloc, mim_glr, mgs_glr + +begin + # Check for repeated request. + if (line == MAP_LASTLINE(map)) { + buf = MAP_LASTBUF(map) + if (mode == READ_WRITE) { + nc = MAP_NC(map) + if (MAP_COPY(map) == NULL) + call malloc (MAP_COPY(map), nc, TY_REAL) + call amovr (Memr[buf], Memr[MAP_COPY(map)], nc) + buf = MAP_COPY(map) + } + return (buf) + } + + nc = MAP_NC(map) + nl = MAP_NL(map) + sample = MAP_SAMPLE(map) + + # Check for subsampling. A constant map will never be sampled. + if (sample > 1) { + if (MAP_BUF1(map) == NULL) { + call malloc (MAP_BUF(map), nc, TY_REAL) + call malloc (MAP_BUF1(map), nc, TY_REAL) + call malloc (MAP_BUF2(map), nc, TY_REAL) + } + line1 = (line-1) / sample * sample + 1 + line2 = min (nl, line1 + sample) + buf1 = MAP_BUF1(map) + buf2 = MAP_BUF2(map) + if (line1 == MAP_LINE2(map)) { + MAP_BUF2(map) = buf1 + MAP_BUF1(map) = buf2 + MAP_LINE2(map) = MAP_LINE1(map) + MAP_LINE1(map) = line1 + buf1 = MAP_BUF1(map) + buf2 = MAP_BUF2(map) + } else if (line2 == MAP_LINE1(map)) { + MAP_BUF1(map) = buf2 + MAP_BUF2(map) = buf1 + MAP_LINE1(map) = MAP_LINE2(map) + MAP_LINE2(map) = line2 + buf1 = MAP_BUF1(map) + buf2 = MAP_BUF2(map) + } + if (line1 != MAP_LINE1(map)) { + switch (MAP_TYPE(map)) { + case MAP_IMAGE: + buf = mim_glr (MAP_MAP(map), line1) + case MAP_GSURFIT: + buf = mgs_glr (MAP_MAP(map), line1) + } + call amovr (Memr[buf], Memr[buf1], nc) + MAP_LINE1(map) = line1 + } + if (line2 != MAP_LINE2(map)) { + switch (MAP_TYPE(map)) { + case MAP_IMAGE: + buf = mim_glr (MAP_MAP(map), line2) + case MAP_GSURFIT: + buf = mgs_glr (MAP_MAP(map), line2) + } + call amovr (Memr[buf], Memr[buf2], nc) + MAP_LINE2(map) = line2 + } + if (line == line1) + buf = buf1 + else if (line == line2) + buf = buf2 + else { + buf = MAP_BUF(map) + b = real (line - line1) / sample + a = 1 - b + do i = 0, nc-1 + Memr[buf+i] = a * Memr[buf1+i] + b * Memr[buf2+i] + } + } else { + switch (MAP_TYPE(map)) { + case MAP_IMAGE: + buf = mim_glr (MAP_MAP(map), line) + case MAP_GSURFIT: + buf = mgs_glr (MAP_MAP(map), line) + case MAP_CONST: + buf = MAP_BUF(map) + } + } + MAP_LASTLINE(map) = line + MAP_LASTBUF(map) = buf + + # Make a copy which might be modified by the caller. + if (mode == READ_WRITE) { + nc = MAP_NC(map) + if (MAP_COPY(map) == NULL) + call malloc (MAP_COPY(map), nc, TY_REAL) + call amovr (Memr[buf], Memr[MAP_COPY(map)], nc) + buf = MAP_COPY(map) + } + + return (buf) +end + + +# MAP_OPEN -- Open map. Return NULL if no map is found. + +pointer procedure map_open (name, refim) + +char name[ARB] #I Name +pointer refim #I Reference image +pointer map #O Map pointer returned + +int i, nc, nl, nowhite(), ctor() +real const +pointer sp, mapstr, im, gs, immap(), mim_open(), mgs_open() +errchk calloc, malloc, imgstr, mim_open, mgs_open + +begin + call smark (sp) + call salloc (mapstr, SZ_FNAME, TY_CHAR) + + i = 1 + nc = IM_LEN(refim,1) + nl = IM_LEN(refim,2) + + call calloc (map, MAP_LEN, TY_STRUCT) + MAP_NC(map) = nc + MAP_NL(map) = nl + + iferr { + # Check for missing map name, and keyword redirection. + if (nowhite (name, Memc[mapstr], SZ_FNAME) == 0) + call error (1, "No map specified") + if (Memc[mapstr] == '!') + call imgstr (refim, Memc[mapstr+1], Memc[mapstr], SZ_FNAME) + call strcpy (Memc[mapstr], MAP_NAME(map), MAP_LENSTR) + + ifnoerr (im = immap (MAP_NAME(map), READ_ONLY, 0)) { + call imunmap (im) + MAP_TYPE(map) = MAP_IMAGE + MAP_MAP(map) = mim_open (MAP_NAME(map), refim) + } else ifnoerr (call mgs_ggs (refim, MAP_NAME(map), gs)) { + MAP_TYPE(map) = MAP_GSURFIT + MAP_MAP(map) = mgs_open (MAP_NAME(map), refim, gs) + } else if (ctor (MAP_NAME(map), i, const) > 0) { + MAP_TYPE(map) = MAP_CONST + call malloc (MAP_BUF(map), nc, TY_REAL) + call amovkr (const, Memr[MAP_BUF(map)], nc) + } else { + call mfree (map, TY_STRUCT) + call sprintf (Memc[mapstr], SZ_FNAME, "Can't open map (%s)") + call pargstr (name) + call error (2, Memc[mapstr]) + } + } then { + call map_close (map) + call erract (EA_ERROR) + } + + call sfree (sp) + return (map) +end + + +# MAP_OPENGS -- Open GSURFIT map given the GSURFIT pointer. + +pointer procedure map_opengs (gs, refim) + +pointer gs #I GSURFIT pointer +pointer refim #I Reference image +pointer map #O Map pointer returned + +pointer mgs_open() +errchk calloc, mgs_open + +begin + iferr { + call calloc (map, MAP_LEN, TY_STRUCT) + MAP_NC(map) = IM_LEN(refim,1) + MAP_NL(map) = IM_LEN(refim,2) + MAP_TYPE(map) = MAP_GSURFIT + MAP_MAP(map) = mgs_open (MAP_NAME(map), refim, gs) + } then { + call map_close (map) + call erract (EA_ERROR) + } + + return (map) +end + + +# MAP_CLOSE -- Unmap map structure. + +procedure map_close (map) + +pointer map #I Map pointer + +begin + if (map == NULL) + return + + switch (MAP_TYPE(map)) { + case MAP_IMAGE: + call mim_close (MAP_MAP(map)) + case MAP_GSURFIT: + call mgs_close (MAP_MAP(map)) + } + + call mfree (MAP_COPY(map), TY_REAL) + call mfree (MAP_BUF(map), TY_REAL) + call mfree (MAP_BUF1(map), TY_REAL) + call mfree (MAP_BUF2(map), TY_REAL) + call mfree (map, TY_STRUCT) +end + + +# MAP_GETS -- Get string parameter. + +procedure map_gets (map, param, val, maxchar) + +pointer map #I Map pointer +char param[ARB] #I Parameter +char val[ARB] #O Parameter string value +int maxchar #I Maximum number of characters to return + +bool streq() +errchk mim_gets(), mgs_gets() + +begin + if (streq (param, "mapname")) + call strcpy (MAP_NAME(map), val, maxchar) + else { + switch (MAP_TYPE(map)) { + case MAP_IMAGE: + call mim_gets (MAP_MAP(map), param, val, maxchar) + case MAP_GSURFIT: + call mgs_gets (MAP_MAP(map), param, val, maxchar) + default: + call error (1, "map_gets: unknown parameter") + } + } +end + + +# MAP_GETI -- Get integer parameter. + +procedure map_geti (map, param, val) + +pointer map #I Map pointer +char param[ARB] #I Parameter +int val #O Value + +errchk mim_geti(), mgs_geti() + +begin + switch (MAP_TYPE(map)) { + case MAP_IMAGE: + call mim_geti (MAP_MAP(map), param, val) + case MAP_GSURFIT: + call mgs_geti (MAP_MAP(map), param, val) + default: + call error (1, "map_geti: unknown parameter") + } +end + + +# MAP_GETR -- Get real parameter. + +procedure map_getr (map, param, val) + +pointer map #I Map pointer +char param[ARB] #I Parameter +real val #O Value + +bool streq() +errchk mim_getr(), mgs_getr() + +begin + if (streq (param, "constant")) { + if (MAP_TYPE(map) == MAP_CONST) { + val = Memr[MAP_BUF(map)] + return + } else + call error (1, "map_getr: map is not constant") + } + + switch (MAP_TYPE(map)) { + case MAP_IMAGE: + call mim_getr (MAP_MAP(map), param, val) + case MAP_GSURFIT: + call mgs_getr (MAP_MAP(map), param, val) + default: + call error (1, "map_getr: unknown parameter") + } +end + + +# MAP_SETI -- Set integer parameter. + +procedure map_seti (map, param, val) + +pointer map #I Map pointer +char param[ARB] #I Parameter +int val #I Value + +bool streq() +errchk mim_seti(), mgs_seti + +begin + switch (MAP_TYPE(map)) { + case MAP_CONST: + ; + case MAP_IMAGE: + if (streq (param, "sample")) + MAP_SAMPLE(map) = max (1, val) + else + call mim_seti (MAP_MAP(map), param, val) + case MAP_GSURFIT: + if (streq (param, "sample")) + MAP_SAMPLE(map) = max (1, val) + else + call mgs_seti (MAP_MAP(map), param, val) + } +end + + +# MAP_SETR -- Set real parameter. + +procedure map_setr (map, param, val) + +pointer map #I Map pointer +char param[ARB] #I Parameter +real val #I Value + +errchk mim_setr(), mgs_setr + +begin + switch (MAP_TYPE(map)) { + case MAP_IMAGE: + call mim_setr (MAP_MAP(map), param, val) + case MAP_GSURFIT: + call mgs_setr (MAP_MAP(map), param, val) + default: + call error (1, "map_setr: unknown parameter") + } +end + + +# MAP_SETS -- Set string parameter. + +procedure map_sets (map, param, val) + +pointer map #I Map pointer +char param[ARB] #I Parameter +char val[ARB] #I Value + +errchk mim_sets(), mgs_sets + +begin + switch (MAP_TYPE(map)) { + case MAP_IMAGE: + call mim_sets (MAP_MAP(map), param, val) + case MAP_GSURFIT: + call mgs_sets (MAP_MAP(map), param, val) + default: + call error (1, "map_sets: unknown parameter") + } +end diff --git a/noao/nproto/ace/maskcolor.x b/noao/nproto/ace/maskcolor.x new file mode 100644 index 00000000..29e25e55 --- /dev/null +++ b/noao/nproto/ace/maskcolor.x @@ -0,0 +1,54 @@ +# MASKCOLOR -- A color for a mask value. + +procedure mcolors (colors, maskval, dataval) + +pointer colors #I Mask colormap object +int maskval #I Mask value +short dataval #U Data value to be set + +int i, j, offset, color + +begin + color = Memi[colors+2] + offset = Memi[colors+3] + do i = 2, Memi[colors] { + j = 4 * i - 4 + if (maskval >= Memi[colors+j] && maskval <= Memi[colors+j+1]) { + color = Memi[colors+j+2] + offset = Memi[colors+j+3] + break + } + } + + if (offset == YES) + color = maskval + color + if (color >= 0) + dataval = color +end + + +procedure mcolorr (colors, maskval, dataval) + +pointer colors #I Mask colormap object +int maskval #I Mask value +real dataval #U Data value to be set + +int i, j, offset, color + +begin + color = Memi[colors+2] + offset = Memi[colors+3] + do i = 2, Memi[colors] { + j = 4 * i - 4 + if (maskval >= Memi[colors+j] && maskval <= Memi[colors+j+1]) { + color = Memi[colors+j+2] + offset = Memi[colors+j+3] + break + } + } + + if (offset == YES) + color = maskval + color + if (color >= 0) + dataval = color +end diff --git a/noao/nproto/ace/mgs.x b/noao/nproto/ace/mgs.x new file mode 100644 index 00000000..2e11cab7 --- /dev/null +++ b/noao/nproto/ace/mgs.x @@ -0,0 +1,321 @@ +include <error.h> +include <imhdr.h> +include <imio.h> +include <math/gsurfit.h> + +# Data structure. +define MGS_SZNAME 99 # Length of mgs name string +define MGS_LEN 56 # Length of structure +define MGS_GS Memi[$1] # GSURFIT pointer +define MGS_X Memi[$1+1] # Pointer to line of x values +define MGS_Y Memi[$1+2] # Pointer to line of y values +define MGS_Z Memi[$1+3] # Pointer to line of z values +define MGS_NC Memi[$1+4] # Number of columns +define MGS_REFIM Memi[$1+5] # Reference image pointer +define MGS_NAME Memc[P2C($1+6)] # Map name + + +# MGS_GLR -- Get a line of data. + +pointer procedure mgs_glr (mgs, line) + +pointer mgs #I Map pointer +int line #I Line + +int nc +pointer x, y, z, gs + +begin + if (mgs == NULL) + call error (1, "Map is undefined") + + gs = MGS_GS(mgs) + x = MGS_X(mgs) + y = MGS_Y(mgs) + z = MGS_Z(mgs) + nc = MGS_NC(mgs) + + call amovkr (real(line), Memr[y], nc) + call gsvector (gs, Memr[x], Memr[y], Memr[z], nc) + + return (z) +end + + +# MGS_OPEN -- Open mgs. + +pointer procedure mgs_open (name, refim, gsin) + +char name[ARB] #I Name +pointer refim #I Reference image +pointer gsin #I GSURFIT pointer +pointer mgs #O Map pointer returned + +int i, nc, nl +real gsgetr() +pointer gs +errchk mgs_ggs + +begin + nc = IM_LEN(refim,1) + nl = IM_LEN(refim,2) + + call calloc (mgs, MGS_LEN, TY_STRUCT) + MGS_REFIM(mgs) = refim + call strcpy (name, MGS_NAME(mgs), MGS_SZNAME) + MGS_NC(mgs) = nc + + iferr { + gs = gsin + if (gs == NULL) { + call mgs_ggs (refim, name, gs) + MGS_GS(mgs) = gs + } + + if (1 < gsgetr (gs, GSXMIN) || nc > gsgetr (gs, GSXMAX) || + 1 < gsgetr (gs, GSYMIN) || nl > gsgetr (gs, GSYMAX)) + call error (2, "Map and data images have different sizes") + + MGS_GS(mgs) = gs + call malloc (MGS_X(mgs), nc, TY_REAL) + call malloc (MGS_Y(mgs), nc, TY_REAL) + call malloc (MGS_Z(mgs), nc, TY_REAL) + do i = 1, nc + Memr[MGS_X(mgs)+i-1] = i + } then { + call mgs_close (mgs) + call erract (EA_ERROR) + } + + return (mgs) +end + + +# MGS_CLOSE -- Close mgs. + +procedure mgs_close (mgs) + +pointer mgs #I Map pointer + +begin + if (mgs == NULL) + return + + if (MGS_GS(mgs) != NULL) + call gsfree (MGS_GS(mgs)) + call mfree (MGS_X(mgs), TY_REAL) + call mfree (MGS_Y(mgs), TY_REAL) + call mfree (MGS_Z(mgs), TY_REAL) + call mfree (mgs, TY_STRUCT) +end + + +# MGS_GETS -- Get string parameter. + +procedure mgs_gets (mgs, param, val, maxchar) + +pointer mgs #I Map pointer +char param[ARB] #I Parameter +char val[ARB] #O Parameter string value +int maxchar #I Maximum number of characters to return + +begin + call error (1, "mgs_gets: unknown parameter") +end + + +# MGS_SETS -- Set string parameter. + +procedure mgs_sets (mgs, param, val) + +pointer mgs #I Map pointer +char param[ARB] #I Parameter +char val[ARB] #O Parameter string value + +begin + call error (1, "mgs_sets: unknown parameter") +end + + +# MGS_GETI -- Get integer parameter. + +procedure mgs_geti (mgs, param, val) + +pointer mgs #I Map pointer +char param[ARB] #I Parameter +int val #O Value + +bool streq() + +begin + if (streq (param, "gsurfit")) + val = MGS_GS(mgs) + else + call error (1, "mgs_geti: unknown parameter") +end + + +# MGS_SETI -- Set integer parameter. + +procedure mgs_seti (mgs, param, val) + +pointer mgs #I Map pointer +char param[ARB] #I Parameter +int val #I Value + +bool streq() + +begin + if (streq (param, "gsurfit")) { + call mgs_pgs (MGS_REFIM(mgs), MGS_NAME(mgs), val) + call gsfree (MGS_GS(mgs)) + MGS_GS(mgs) = val + } else + call error (1, "mgs_seti: unknown parameter") +end + + +# MGS_GETR -- Get real parameter. + +procedure mgs_getr (mgs, param, val) + +pointer mgs #I Map pointer +char param[ARB] #I Parameter +real val #O Value + +begin + call error (1, "mgs_getr: unknown parameter") +end + + +# MGS_SETR -- Set real parameter. + +procedure mgs_setr (mgs, param, val) + +pointer mgs #I Map pointer +char param[ARB] #I Parameter +real val #I Value + +begin + call error (1, "mgs_setr: unknown parameter") +end + + +# MAP_PGS -- Put mgs surface fit. + +procedure mgs_pgs (im, key, gs) + +pointer im #I Image pointer +char key[ARB] #I Keyword root +pointer gs #I Surface fit pointer + +int i, nc, fd, gsgeti(), stropen() +pointer sp, kw, card, coeffs, strbuf, cp, cp1, cp2 + +begin + if (IM_SECTUSED(im) == YES) + return + + call smark (sp) + call salloc (kw, 80, TY_CHAR) + call salloc (card, 68, TY_CHAR) + + nc = gsgeti (gs, GSNSAVE) + call salloc (coeffs, nc, TY_REAL) + call gssave (gs, Memr[coeffs]) + + # Convert coeffs to a string. Last character will be space. + call salloc (strbuf, 20*nc, TY_CHAR) + call aclrc (Memc[strbuf], 20*nc) + fd = stropen (Memc[strbuf], 20*nc, WRITE_ONLY) + do i = 1, nc { + call fprintf (fd, "%g ") + call pargr (Memr[coeffs+i-1]) + } + call close (fd) + + i = 1 + cp1 = strbuf + for (cp=cp1; Memc[cp] != EOS; cp=cp+1) { + if (Memc[cp] == ' ') + cp2 = cp + if (cp - cp1 + 1 == 68) { + call sprintf (Memc[kw], 8, "%.6s%02d") + call pargstr (key) + call pargi (i) + i = i + 1 + Memc[cp2] = EOS + call imastr (im, Memc[kw], Memc[cp1]) + cp1 = cp2 + 1 + cp = cp1 + } + } + if (cp - cp1 + 1 > 0) { + call sprintf (Memc[kw], 8, "%.6s%02d") + call pargstr (key) + call pargi (i) + i = i + 1 + Memc[cp2] = EOS + call imastr (im, Memc[kw], Memc[cp1]) + } + repeat { + call sprintf (Memc[kw], 8, "%.6s%02d") + call pargstr (key) + call pargi (i) + i = i + 1 + iferr (call imdelf (im, Memc[kw])) + break + } + + call sfree (sp) +end + + +# MAP_GGS -- Get mgs surface fit. + +procedure mgs_ggs (im, key, gs) + +pointer im #I Image pointer +char key[ARB] #I Keyword root +pointer gs #O Surface fit pointer + +int i, j, nc, ctor() +pointer sp, kw, card, coeffs + +begin + if (IM_SECTUSED(im) == YES) + call error (1, "No surface fit with an image section") + + call smark (sp) + call salloc (kw, 8, TY_CHAR) + call salloc (card, 68, TY_CHAR) + + call malloc (coeffs, 100, TY_REAL) + iferr { + nc = 0 + do i = 1, ARB { + call sprintf (Memc[kw], 8, "%.6s%02d") + call pargstr (key) + call pargi (i) + iferr (call imgstr (im, Memc[kw], Memc[card], 68)) + break + j = 1 + while (ctor (Memc[card], j, Memr[coeffs+nc]) != 0) { + nc = nc + 1 + if (mod (nc, 100) == 0) + call realloc (coeffs, nc+100, TY_REAL) + } + } + + if (nc == 0) + call error (1, "Surface fit not found") + + call gsrestore (gs, Memr[coeffs]) + call mfree (coeffs, TY_REAL) + } then { + call mfree (coeffs, TY_REAL) + call erract (EA_ERROR) + } + + call sfree (sp) +end diff --git a/noao/nproto/ace/mim.x b/noao/nproto/ace/mim.x new file mode 100644 index 00000000..9a621e40 --- /dev/null +++ b/noao/nproto/ace/mim.x @@ -0,0 +1,544 @@ +# MIM (Match IMage) -- Match a 2D image to a 2D reference image. +# +# These routines provide an I/O interface to get data from a 2D image which +# matches a line of a 2D reference image. The two common uses are to get a +# subraster of the image which matches the reference image and to interpolate +# an image which is blocked to a lower resolution than the reference image. +# The matching is done in physical pixel coordinates. It is completely +# general in allowing any linear transformation between the physical +# coordinates. But in most cases the reference image and the input image +# will be related either by an image section or some kind of blocking factor +# without rotation. Any relative rotation of the two in physical pixels is +# likely to be slow for large images (either the reference image or the mim +# image). Interpolation (if any is required) is done with the MSI library. +# Extrapolation outside of the input image uses the nearest edge value. +# +# mim = mim_open (input, refim) +# buf = mim_glr (mim, refline) +# mim_close (mim) +# +# Parameters may be queried and set by the following routines. +# +# mim_geti (mim, param, val) +# mim_getr (mim, param, val) +# mim_gets (mim, param, str, maxchar) +# mim_seti (mim, param, val) +# mim_setr (mim, param, val) +# mim_sets (mim, param, str) +# +# The parameters are specified by strings as given below. The default values +# are in parentheses. Currently there are only integer parameters. +# +# msitype - interpolation type defined by the MSI library +# (II_BISPLINE3) +# msiedge - number of additional lines at each edge to include +# in interpolation (3) +# msimax - maximum number of pixels to allow in MSIFIT calls (500000) + + +include <error.h> +include <imhdr.h> +include <imset.h> +include <math/iminterp.h> + +# Data structure. +define MIM_LEN 18 +define MIM_INTERP Memi[$1] # Use interpolation? +define MIM_ROTATE Memi[$1+1] # Is there any rotation? +define MIM_IM Memi[$1+2] # IMIO mim pointer +define MIM_MSI Memi[$1+3] # MSI interpolation pointer +define MIM_NCREF Memi[$1+4] # Number of columns in ref image +define MIM_NC Memi[$1+5] # Number of columns in input image +define MIM_NL Memi[$1+6] # Number of lines in input image +define MIM_LINE1 Memi[$1+7] # First line in msi fit +define MIM_LINE2 Memi[$1+8] # Last line in msi fit +define MIM_X Memi[$1+9] # Pointer to line of x values +define MIM_Y Memi[$1+10] # Pointer to line of y values +define MIM_Z Memi[$1+11] # Pointer to line of z values +define MIM_MW Memi[$1+12] # MWCS pointer +define MIM_CT Memi[$1+13] # CT from ref logical to input logical +define MIM_MSITYPE Memi[$1+14] # MSI interpolation type +define MIM_MSIEDGE Memi[$1+15] # Number of edge pixels to reserve +define MIM_MSIMAX Memi[$1+16] # Maximum number of pixels in msi fit +define MIM_DELETE Memi[$1+17] # Delete image after closing? + +# Defaults +define MIM_MSITYPEDEF II_BISPLINE3 +define MIM_MSIEDGEDEF 3 +define MIM_MSIMAXDEF 500000 + + +# MIM_GL -- Get a line of data matching a line of the reference image. +# A pointer to the data is returned. The data buffer is assumed to be +# read-only and not to be modified by the calling routine. + +pointer procedure mim_glr (mim, line) + +pointer mim #I Map pointer +int line #I Reference image line + +int i, j, nc, nl, ncref, line1, line2, nlines +pointer msi, ct, x, y, z, imname, ptr +real rnl, val + +real mw_c1tranr() +pointer imgl2r(), imgs2r() + +errchk imgl2r, msiinit, msifit, imdelete + +begin + if (mim == NULL) + call error (1, "Map is undefined") + + # If interpolation is not needed return the IMIO buffer. + if (MIM_INTERP(mim) == NO) { + ptr = imgl2r (MIM_IM(mim), line) + return (ptr) + } + + nc = MIM_NC(mim) + nl = MIM_NL(mim) + ncref = MIM_NCREF(mim) + rnl = nl + msi = MIM_MSI(mim) + ct = MIM_CT(mim) + x = MIM_X(mim) + y = MIM_Y(mim) + z = MIM_Z(mim) + + # Set the interpolation coordinates in the input image logical pixels. + # This is limited to be within the input image. Therefore, requests + # outside the input image will use the nearest edge value. + # Also set the minimum range of input lines required. + + if (MIM_ROTATE(mim) == NO) { + val = mw_c1tranr (ct, real(line)) + val = max (1., min (rnl, val)) + call amovkr (val, Memr[y], ncref) + line1 = max (1., val - 1) + line2 = min (rnl, val + 1) + } else { + call amovkr (real(line), Memr[y], ncref) + call mw_v2tranr (ct, Memr[x], Memr[y], Memr[z], Memr[y], ncref) + x = z + + # Limit the x range to within the input image. + ptr = x + val = nc + do i = 1, ncref { + Memr[ptr] = max (1., min (val, Memr[ptr])) + ptr = ptr + 1 + } + + # Limit the y range to within the input image and find the range + # of lines required. + j = nint (Memr[y]) + line1 = max (1, min (nl, j)) + line2 = line1 + ptr = y + rnl = nl + do i = 1, ncref { + val = max (1., min (rnl, Memr[ptr])) + j = nint (val) + line1 = min (j, line1) + line2 = max (j, line2) + Memr[ptr] = val + ptr = ptr + 1 + } + line1 = max (1, line1 - 1) + line2 = min (nl, line2 + 1) + } + + # Set or reset image interpolator. For small input interpolation + # images read the entire image, fit the interpolator, and free the + # image. For larger input images determine the range of lines + # required including edge space and fit the interpolator to those + # lines. Providing the reference lines are requested sequentially + # this is about as efficient as we can make it. + + if (line1 < MIM_LINE1(mim) || line2 > MIM_LINE2(mim)) { + if (msi != NULL) + call msifree (MIM_MSI(mim)) + if (min (nc, nl) > 3) + call msiinit (MIM_MSI(mim), MIM_MSITYPE(mim)) + else if (min (nc, nl) > 1) + call msiinit (MIM_MSI(mim), II_BILINEAR) + else + call msiinit (MIM_MSI(mim), II_BINEAREST) + msi = MIM_MSI(mim) + if (nc * nl <= MIM_MSIMAX(mim)) { + nlines = nl + line1 = 1 + line2 = nlines + ptr = imgs2r (MIM_IM(mim), 1, nc, line1, line2) + call msifit (msi, Memr[ptr], nc, nlines, nc) + if (MIM_DELETE(mim) == YES) { + call malloc (imname, SZ_FNAME, TY_CHAR) + call imstats (MIM_IM(mim), IM_IMAGENAME, Memc[imname], + SZ_FNAME) + call imgimage (Memc[imname], Memc[imname], SZ_FNAME) + call imunmap (MIM_IM(mim)) + call imdelete (Memc[imname]) + call mfree (imname, TY_CHAR) + } else + call imunmap (MIM_IM(mim)) + } else { + nlines = max (2*MIM_MSIEDGE(mim)+(line2-line1+1), + MIM_MSIMAX(mim) / nc) + line1 = max (1, min (nl, line1 - MIM_MSIEDGE(mim))) + line2 = max (1, min (nl, line1 + nlines - 1)) + line1 = max (1, min (nl, line2 - nlines + 1)) + nlines = line2 - line1 + 1 + ptr = imgs2r (MIM_IM(mim), 1, nc, line1, line2) + call msifit (msi, Memr[ptr], nc, nlines, nc) + } + MIM_LINE1(mim) = line1 + MIM_LINE2(mim) = line2 + } + + # Interpolate input image to a line in the reference image. + call msivector (msi, Memr[x], Memr[y], Memr[z], ncref) + + return (z) +end + + +# MIM_OPEN -- Open an image matched to a reference image. +# +# Fitting of any interpolator is later. This allows calls to reset +# the interpolation type, edge buffer, and maximum size to fit. + +pointer procedure mim_open (input, refim) + +char input[ARB] #I Input image name +pointer refim #I Reference image +pointer mim #O Map pointer returned + +bool interp, rotate +int i, nc, nl, ncref, nlref, ilt[6] +double lt[6], ltref[6], ltin[6] +pointer sp, section, im, mw, ct, x, ptr + +int strlen(), btoi() +pointer immap(), mw_openim(), mw_sctran() +errchk calloc, malloc +errchk immap +errchk mw_openim, mw_invertd, mw_sctran + +begin + call smark (sp) + call salloc (section, SZ_FNAME, TY_CHAR) + + iferr { + mim = NULL; im = NULL; mw = NULL + + call calloc (mim, MIM_LEN, TY_STRUCT) + MIM_DELETE(mim) = NO + + call imgimage (input, Memc[section], SZ_FNAME) + ptr = immap (Memc[section], READ_ONLY, 0); im = ptr + nc = IM_LEN(im,1) + nl = IM_LEN(im,2) + ncref = IM_LEN(refim,1) + nlref = IM_LEN(refim,2) + + # Check relationship between reference and input images in physical + # coordinates. + + ptr = mw_openim (refim); mw = ptr + call mw_gltermd (mw, lt, lt[5], 2) + call mw_close (mw) + + mw = mw_openim (im) + call mw_gltermd (mw, ltin, ltin[5], 2) + + # Combine lterms. + call mw_invertd (lt, ltref, 2) + call mw_mmuld (ltref, ltin, lt, 2) + call mw_vmuld (lt, lt[5], lt[5], 2) + lt[5] = ltin[5] - lt[5] + lt[6] = ltin[6] - lt[6] + do i = 1, 6 + lt[i] = nint (1D6 * lt[i]) / 1D6 + + # Check if interpolation is required. + interp = false + do i = 1, 6 { + ilt[i] = nint (lt[i]) + if (lt[i] - ilt[i] > 1D-3) { + interp = true + break + } + } + if (lt[2] != 0. || lt[3] != 0.) + rotate = true + else + rotate = false + if (!interp && rotate) + interp = true + + if (interp) { + # Use IMIO to extract a smaller section if possible to + # minimize the requirements for the interpolation. + # This could be more general if we deal with a section + # of a rotated image. + + if (!rotate) { + ilt[1] = lt[1] + lt[5] + ilt[2] = lt[1] * ncref + lt[5] + 0.999 + ilt[3] = lt[3] + lt[4] + lt[6] + ilt[4] = lt[4] * nlref + lt[6] + 0.999 + ilt[1] = max (1, min (nc, ilt[1])) + ilt[2] = max (1, min (nc, ilt[2])) + ilt[3] = max (1, min (nl, ilt[3])) + ilt[4] = max (1, min (nl, ilt[4])) + if (ilt[1]!=1 || ilt[2]!=nc ||ilt[1]!=1 || ilt[2]!=nl) { + i = strlen(Memc[section]) + 1 + call sprintf (Memc[section+i-1], SZ_FNAME-i, + "[%d:%d,%d:%d]") + call pargi (ilt[1]) + call pargi (ilt[2]) + call pargi (ilt[3]) + call pargi (ilt[4]) + call imunmap (im) + im = immap (Memc[section], READ_ONLY, 0) + nc = IM_LEN(im,1) + nl = IM_LEN(im,2) + lt[5] = lt[5] - ilt[1] + 1 + lt[6] = lt[6] - ilt[3] + 1 + } + } + + # Set reference logical to input logical transformation. + # The reference logical coordinates are the physical + # coordinates of the transformation. + + call mw_sltermd (mw, lt, lt[5], 2) + + # If there are cross terms set the x array to the reference + # logical coordinates (physical transformation coordinates). + # Otherwise we only need to evalute x array once in the + # input logical coordinates to be interpolated. + + call malloc (x, ncref, TY_REAL) + do i = 1, ncref + Memr[x+i-1] = i + if (rotate) + ct = mw_sctran (mw, "physical", "logical", 3B) + else { + ct = mw_sctran (mw, "physical", "logical", 1B) + call mw_v1tranr (ct, Memr[x], Memr[x], ncref) + ptr = x + do i = 1, ncref { + Memr[ptr] = max (1., min (real(nc), Memr[ptr])) + ptr = ptr + 1 + } + call mw_ctfree (ct) + ct = mw_sctran (mw, "physical", "logical", 2B) + } + + MIM_X(mim) = x + call malloc (MIM_Y(mim), ncref, TY_REAL) + call malloc (MIM_Z(mim), ncref, TY_REAL) + MIM_MW(mim) = mw + MIM_CT(mim) = ct + MIM_MSITYPE(mim) = MIM_MSITYPEDEF + MIM_MSIEDGE(mim) = MIM_MSIEDGEDEF + MIM_MSIMAX(mim) = MIM_MSIMAXDEF + + } else { + # If ref is a subraster of the input use IMIO section to match. + if (ilt[1]!=1 || ilt[4]!=1 || ilt[5]!=0 || ilt[6]!=0) { + i = strlen(Memc[section]) + 1 + call sprintf (Memc[section+i-1], SZ_FNAME-i, + "[%d:%d:%d,%d:%d:%d]") + call pargi (ilt[1]+ilt[5]) + call pargi (ilt[1]*ncref+ilt[5]) + call pargi (ilt[1]) + call pargi (ilt[4]+ilt[6]) + call pargi (ilt[4]*nlref+ilt[6]) + call pargi (ilt[4]) + call imunmap (im) + im = immap (Memc[section], READ_ONLY, 0) + nc = IM_LEN(im,1) + nl = IM_LEN(im,2) + } + call mw_close (mw) + } + + MIM_IM(mim) = im + MIM_INTERP(mim) = btoi (interp) + MIM_ROTATE(mim) = btoi (rotate) + MIM_NC(mim) = nc + MIM_NL(mim) = nl + MIM_NCREF(mim) = ncref + } then { + if (mw != NULL) + call mw_close (mw) + if (im != NULL) + call imunmap (im) + call mim_close (mim) + call sfree (sp) + call erract (EA_ERROR) + } + + call sfree (sp) + return (mim) +end + + +# MIM_CLOSE -- Close mim structure. + +procedure mim_close (mim) + +pointer mim #I MIM pointer + +pointer imname +errchk imdelete + +begin + if (mim == NULL) + return + + if (MIM_IM(mim) != NULL) { + if (MIM_DELETE(mim) == YES) { + call malloc (imname, SZ_FNAME, TY_CHAR) + call imstats (MIM_IM(mim), IM_IMAGENAME, Memc[imname], SZ_FNAME) + call imgimage (Memc[imname], Memc[imname], SZ_FNAME) + call imunmap (MIM_IM(mim)) + call imdelete (Memc[imname]) + call mfree (imname, TY_CHAR) + } else + call imunmap (MIM_IM(mim)) + } + if (MIM_MSI(mim) != NULL) + call msifree (MIM_MSI(mim)) + if (MIM_MW(mim) != NULL) + call mw_close (MIM_MW(mim)) + call mfree (MIM_X(mim), TY_REAL) + call mfree (MIM_Y(mim), TY_REAL) + call mfree (MIM_Z(mim), TY_REAL) + call mfree (mim, TY_STRUCT) +end + + +# MIM_GETS -- Get string parameter. + +procedure mim_gets (mim, param, val, maxchar) + +pointer mim #I MIM pointer +char param[ARB] #I Parameter +char val[ARB] #O Parameter string value +int maxchar #I Maximum number of characters to return + +begin + call error (1, "mim_gets: unknown parameter") +end + + +# MIM_GETI -- Get integer parameter. + +procedure mim_geti (mim, param, val) + +pointer mim #I MIM pointer +char param[ARB] #I Parameter +int val #O Value + +bool streq() + +begin + if (streq (param, "msitype")) + val = MIM_MSITYPE(mim) + else if (streq (param, "msiedge")) + val = MIM_MSIEDGE(mim) + else if (streq (param, "msimax")) + val = MIM_MSIMAX(mim) + else if (streq (param, "delete")) + val = MIM_DELETE(mim) + else + call error (1, "mim_geti: unknown parameter") +end + + +# MIM_GETR -- Get real parameter. + +procedure mim_getr (mim, param, val) + +pointer mim #I MIM pointer +char param[ARB] #I Parameter +real val #O Value + +begin + call error (1, "mim_getr: unknown parameter") +end + + +# MIM_SETS -- Set string parameter. + +procedure mim_sets (mim, param, val) + +pointer mim #I MIM pointer +char param[ARB] #I Parameter +char val[ARB] #I Value + +begin + call error (1, "mim_sets: unknown parameter") +end + + +# MIM_SETI -- Set integer parameter. + +procedure mim_seti (mim, param, val) + +pointer mim #I MIM pointer +char param[ARB] #I Parameter +int val #I Value + +bool streq() + +begin + if (streq (param, "msitype")) { + if (val != MIM_MSITYPE(mim)) { + MIM_MSITYPE(mim) = val + if (MIM_MSI(mim) != NULL) { + call msifree (MIM_MSI(mim)) + MIM_LINE1(mim) = 0 + MIM_LINE2(mim) = 0 + } + } + } else if (streq (param, "msiedge")) { + if (val != max (3, MIM_MSIEDGE(mim))) { + MIM_MSIEDGE(mim) = val + if (MIM_MSI(mim) != NULL) { + call msifree (MIM_MSI(mim)) + MIM_LINE1(mim) = 0 + MIM_LINE2(mim) = 0 + } + } + } else if (streq (param, "msimax")) { + if (val != max (64000, MIM_MSIMAX(mim))) { + MIM_MSIMAX(mim) = val + if (MIM_MSI(mim) != NULL) { + call msifree (MIM_MSI(mim)) + MIM_LINE1(mim) = 0 + MIM_LINE2(mim) = 0 + } + } + } else if (streq (param, "delete")) + MIM_DELETE(mim) = val + else + call error (1, "mim_setr: unknown parameter") +end + + +# MIM_SETR -- Set real parameter. + +procedure mim_setr (mim, param, val) + +pointer mim #I MIM pointer +char param[ARB] #I Parameter +real val #I Value + +begin + call error (1, "mim_setr: unknown parameter") +end diff --git a/noao/nproto/ace/mkpkg b/noao/nproto/ace/mkpkg new file mode 100644 index 00000000..d385a296 --- /dev/null +++ b/noao/nproto/ace/mkpkg @@ -0,0 +1,60 @@ +# Make ACE. + +$call relink +$exit + +update: + $call relink + $call install + ; + +relink: + $update libpkg.a + $omake x_ace.x + $link x_ace.o libpkg.a -lds -lgsurfit -lcurfit -lxtools -liminterp\ + -ltbtables -o xx_ace.e + ; + +install: + $move xx_ace.e acebin$x_ace.e + ; + +libpkg.a: + aceoverlay.x ace.h <error.h> <imhdr.h> <imset.h> <pmset.h> + bndry.x ace.h <pmset.h> + catdefine.x ace.h cat.h objs.h + catio.x ace.h cat.h <imset.h> <math.h> objs.h + convolve.x <ctype.h> <imhdr.h> + detect.x ace.h cat.h detect.h <imhdr.h> <mach.h> objs.h\ + <pmset.h> skyblock.h split.h + evaluate.x ace.h cat.h <error.h> evaluate.h <imhdr.h> objs.h\ + <pmset.h> + filter.x ace.h <evvexpr.h> filter.h objs.h + grow.x ace.h cat.h grow.h objs.h <pmset.h> + mapio.x <error.h> <imhdr.h> + maskcolor.x + mgs.x <error.h> <imhdr.h> <imio.h> <math/gsurfit.h> + mim.x <error.h> <imhdr.h> <imset.h> <math/iminterp.h> + noisemodel.x + omwrite.x <imhdr.h> <pmset.h> ace.h + pars.x <ctype.h> detect.h evaluate.h grow.h <math/curfit.h>\ + <math/gsurfit.h> skyblock.h skyfit.h sky.h split.h + skyblock.x <ctype.h> <error.h> <imhdr.h> <imset.h> <mach.h>\ + skyblock.h + skyfit.x <imhdr.h> <math/curfit.h> <math/gsurfit.h> skyfit.h + skyimages.x <error.h> <imhdr.h> + sky.x <error.h> sky.h + split.x ace.h cat.h <mach.h> objs.h <pmset.h> split.h + tables.x + t_acedetect.x ace.h acedetect.h cat.h <error.h> <fset.h> <imhdr.h>\ + <imset.h> <pmset.h> + t_acedisplay.x <ctype.h> display.h <error.h> gwindow.h <imhdr.h>\ + <imhdr.h> <imset.h> <imset.h> <mach.h> <mach.h>\ + <pmset.h> + t_imext.x <ctype.h> <error.h> <imhdr.h> <imset.h> <mach.h> + t_mscext.x <error.h> <imhdr.h> <imset.h> + x_ace.x + xtmaskname.x + xtpmmap.x <ctype.h> <error.h> <imhdr.h> <imset.h> <mach.h>\ + <mwset.h> <pmset.h> + ; diff --git a/noao/nproto/ace/noisemodel.x b/noao/nproto/ace/noisemodel.x new file mode 100644 index 00000000..0503c4a1 --- /dev/null +++ b/noao/nproto/ace/noisemodel.x @@ -0,0 +1,102 @@ +# NOISEMODEL -- Compute noise model. +# +# var = (var(sky) + (image-sky)/gain) / sqrt (exposure) +# +# What is actually returned is the square root of the variance. +# The variance of the sky and the effective gain are for a unit +# exposure in the exposure map. + +procedure noisemodel (image, sky, sig, gain, exp, sigma, npix) + +real image[npix] #I Image +real sky[npix] #I Sky +real sig[npix] #I Sky sigma +real gain[npix] #I Gain +real exp[npix] #I Exposure +real sigma[npix] #O Sigma +int npix #I Number of pixels + +int i +real e, elast, sqrte + +begin + if (IS_INDEFR(exp[1])) { + if (IS_INDEFR(gain[1])) + call amovr (sig, sigma, npix) + else { + do i = 1, npix + sigma[i] = sqrt (sig[i] * sig[1] + + (image[i] - sky[i]) / gain[i]) + } + } else if (IS_INDEFR(gain[1])) { + elast = INDEFR + do i = 1, npix { + e = exp[i] + if (e == 0.) { + sigma[i] = sig[i] + next + } + if (e != elast) { + sqrte = sqrt (e) + elast = e + } + sigma[i] = sig[i] / sqrte + } + } else { + do i = 1, npix { + e = exp[i] + if (e == 0.) { + sigma[i] = sqrt (sig[i] * sig[i] + + (image[i] - sky[i]) / gain[i]) + next + } + sigma[i] = sqrt ((sig[i] * sig[i] + + (image[i] - sky[i]) / gain[i]) / e) + } + } +end + + +# EXPSIGMA -- Apply exposure map to correct sky sigma. +# Assume the exposure map has region of contiguous constant values so +# that the number of square roots can be minimized. An exposure map +# value of zero leaves the sigma unchanged. + +procedure expsigma (sigma, expmap, npix, mode) + +real sigma[npix] #U Sigma values +real expmap[npix] #I Exposure map values +int npix #I Number of pixels +int mode #I 0=divide, 1=multiply + +int i +real exp, lastexp, scale + +begin + switch (mode) { + case 0: + lastexp = INDEFR + do i = 1, npix { + exp = expmap[i] + if (exp == 0.) + next + if (exp != lastexp) { + scale = sqrt (exp) + lastexp = exp + } + sigma[i] = sigma[i] / scale + } + case 1: + lastexp = INDEFR + do i = 1, npix { + exp = expmap[i] + if (exp == 0.) + next + if (exp != lastexp) { + scale = sqrt (exp) + lastexp = exp + } + sigma[i] = sigma[i] * scale + } + } +end diff --git a/noao/nproto/ace/objmasks.cl b/noao/nproto/ace/objmasks.cl new file mode 100644 index 00000000..2ff5e201 --- /dev/null +++ b/noao/nproto/ace/objmasks.cl @@ -0,0 +1,28 @@ +# OBJMASK -- Make object masks from image data. + +procedure objmasks () + +begin + detect (images, objmasks=objmasks, masks=masks, omtype=omtype, + skys=skys, sigmas=sigmas, + extnames=extnames, logfiles=logfiles, blkstep=blkstep, + blksize=blksize, convolve=convolve, hsigma=hsigma, + lsigma=lsigma, hdetect=hdetect, ldetect=ldetect, + neighbors=neighbors, minpix=minpix, ngrow=ngrow, agrow=agrow, + exps=objmasks1.exps, gains=objmasks1.gains, + catalogs=objmasks1.catalogs, catdefs=objmasks1.catdefs, + dodetect=objmasks1.dodetect, dosplit=objmasks1.dosplit, + dogrow=objmasks1.dogrow, doevaluate=objmasks1.doevaluate, + skytype=objmasks1.skytype, fitstep=objmasks1.fitstep, + fitblk1d=objmasks1.fitblk1d, fithclip=objmasks1.fithclip, + fitlclip=objmasks1.fitlclip, fitxorder=objmasks1.fitxorder, + fityorder=objmasks1.fityorder, fitxterms=objmasks1.fitxterms, + blknsubblks=objmasks1.blknsubblks, + updatesky=objmasks1.updatesky, sigavg=objmasks1.sigavg, + sigmax=objmasks1.sigmax, bpval=objmasks1.bpval, + splitmax=objmasks1.splitmax, splitstep=objmasks1.splitstep, + splitthresh=objmasks1.splitthresh, sminpix=objmasks1.sminpix, + ssigavg=objmasks1.ssigavg, ssigmax=objmasks1.ssigmax, + magzero=objmasks1.magzero) + +end diff --git a/noao/nproto/ace/objmasks.par b/noao/nproto/ace/objmasks.par new file mode 100644 index 00000000..d77ceffe --- /dev/null +++ b/noao/nproto/ace/objmasks.par @@ -0,0 +1,22 @@ +# OBJMASKS + +images,f,a,,,,"List of images or MEF files" +objmasks,s,a,"",,,"List of output object masks" +omtype,s,h,"numbers","boolean|numbers|colors|all",,"Object mask type" +skys,s,h,"",,,"List of input/output sky maps" +sigmas,s,h,"",,,"List of input/output sigma maps" +masks,s,h,"!BPM",,,"List of input bad pixel masks" +extnames,s,h,"",,,"Extension names" +logfiles,s,h,"STDOUT",,,"List of log files +" +blkstep,i,h,1,1,,"Line step for sky sampling" +blksize,i,h,-10,,,"Sky block size (+=pixels, -=blocks)" +convolve,s,h,"block 3 3",,,"Convolution kernel" +hsigma,r,h,3.,.1,,"Sigma threshold above sky" +lsigma,r,h,10.,.1,,"Sigma threshold below sky" +hdetect,b,h,yes,,,"Detect objects above sky?" +ldetect,b,h,no,,,"Detect objects below sky?" +neighbors,s,h,"8","4|8",,Neighbor type" +minpix,i,h,6,1,,"Minimum number of pixels in detected objects" +ngrow,i,h,2,0,,"Number of grow rings" +agrow,r,h,2.,0,,"Area grow factor" diff --git a/noao/nproto/ace/objmasks1.par b/noao/nproto/ace/objmasks1.par new file mode 100644 index 00000000..9d822a88 --- /dev/null +++ b/noao/nproto/ace/objmasks1.par @@ -0,0 +1,30 @@ +# OBJMASKS1 + +exps,s,h,"",,,"List of exposure maps" +gains,s,h,"",,,"List of gain maps" +catalogs,s,h,"",,,"List of catalogs" +catdefs,s,h,"",,,"List of catalog definitions" +dodetect,b,h,yes,,,"Detect objects?" +dosplit,b,h,no,,,"Split merged objects?" +dogrow,b,h,yes,,,"Grow object regions?" +doevaluate,b,h,no,,,"Evaluate objects?" +skytype,s,h,"block","fit|block",,"Type of sky estimation" +fitstep,i,h,100,1,,"Line step for sky sampling" +fitblk1d,i,h,10,,,"Block average for line fitting" +fithclip,r,h,2.,,,"High sky clipping during 1D sky estimation" +fitlclip,r,h,3.,,,"Low sky clippling during 1D sky estimation" +fitxorder,i,h,2,1,,"Sky fitting x order" +fityorder,i,h,2,1,,"Sky fitting y order" +fitxterms,s,h,"half","none|full|half",,"Sky fitting cross terms" +blknsubblks,i,h,2,1,,"Number of subblocks per axis" +updatesky,b,h,yes,,,"Update sky during detection?" +sigavg,r,h,4.,0.,,"Sigma of mean flux cutoff" +sigmax,r,h,4.,0.,,"Sigma of maximum pixel" +bpval,i,h,INDEF,,,"Output bad pixel value" +splitmax,r,h,INDEF,,,"Maximum sigma above sky for splitting" +splitstep,r,h,0.4,,,"Splitting steps in convolved sigma" +splitthresh,r,h,5.,,,"Splitting threshold in sigma" +sminpix,i,h,8,1,,"Minimum number of pixels in split objects" +ssigavg,r,h,10.,0.,,"Sigma of mean flux cutoff" +ssigmax,r,h,5.,0.,,"Sigma of maximum pixel" +magzero,s,h,"INDEF",,,"Magnitude zero point" diff --git a/noao/nproto/ace/objs.h b/noao/nproto/ace/objs.h new file mode 100644 index 00000000..20dff95a --- /dev/null +++ b/noao/nproto/ace/objs.h @@ -0,0 +1,139 @@ +# This file defines the object parameters. + +# The following are the parameter ids which are the offsets into the object +# data structure. Note that the first group of parameters are those +# determined during detection for potential objects. The second group +# are parameters added after an object has been accepted. + +define ID_ROW 0 # i "" "" "Catalog row" +define ID_NUM 1 # i "" "" "Object number" +define ID_PNUM 2 # i "" "" "Parent number" +define ID_XAP 3 # r pixels %.2f "X aperture coordinate" +define ID_YAP 4 # r pixels %.2f "Y aperture coordinate" +define ID_FLUX 5 # r counts "" "Isophotal flux (I - sky)" +define ID_NPIX 6 # i pixels "" "Number of pixels" +define ID_NDETECT 7 # i pixels "" "Number of detected pixels" +define ID_ISIGAVG 8 # r sigma "" "Average (I - sky) / sig" +define ID_ISIGMAX 9 # r sigma "" "Maximum (I - sky) / sig" +define ID_ISIGAVG2 10 # r sigma "" "*Ref average (I - sky) / sig" +define ID_FLAGS 11 # 8 "" "" "Flags" + +define ID_SKY 12 # r counts "" "Mean sky" +define ID_SIG 13 # r counts "" "Sky sigma" +define ID_PEAK 14 # r counts "" "Peak pixel value above sky" +define ID_APFLUX 15 # r counts "" "Aperture fluxes" +define ID_FRACFLUX 16 # r counts "" "Apportioned flux" +define ID_FRAC 17 # r "" "" "Apportioned fraction" +define ID_XMIN 18 # i pixels "" "Minimum X" +define ID_XMAX 19 # i pixels "" "Maxium X" +define ID_YMIN 20 # i pixels "" "Minimum Y" +define ID_YMAX 21 # i pixels "" "Maxium Y" +define ID_WX 22 # d pixels %.2f "X world coordinate" +define ID_WY 24 # d pixels %.2f "Y world coordinate" +define ID_X1 26 # r pixels %.2f "X centroid" +define ID_Y1 27 # r pixels %.2f "Y centroid" +define ID_X2 28 # r pixels "" "X 2nd moment" +define ID_Y2 29 # r pixels "" "Y 2nd moment" +define ID_XY 30 # r pixels "" "X 2nd cross moment" + +define ID_FLUXVAR 31 # r counts "" "*Variance in the flux" +define ID_XVAR 32 # r pixels "" "*Variance in X centroid" +define ID_YVAR 33 # r pixels "" "*Variance in Y centroid" +define ID_XYCOV 34 # r pixels "" "*Covariance of X and Y" + +# The following are derived quantities which have ids above 1000. + +define ID_A 1001 # r pixels "" "Semimajor axis" +define ID_B 1002 # r pixels "" "Semiminor axis" +define ID_THETA 1003 # r degrees "" "Position angle" +define ID_ELONG 1004 # r "" "" "Elongation = A/B" +define ID_ELLIP 1005 # r "" "" "Ellipticity = 1 - B/A" +define ID_R 1006 # r pixels "" "Second moment radius" +define ID_CXX 1007 # r pixels "" "Second moment ellipse" +define ID_CYY 1008 # r pixels "" "Second moment ellipse" +define ID_CXY 1009 # r pixels "" "Second moment ellipse" + +define ID_FLUXERR 1011 # r counts "" "Error in flux" +define ID_XERR 1012 # r pixels "" "Error in X centroid" +define ID_YERR 1013 # r pixels "" "Error in Y centroid" +define ID_AERR 1014 # r "" "" "Error in A" +define ID_BERR 1015 # r "" "" "Error in B" +define ID_THETAERR 1016 # r degrees "" "Error in THETA" +define ID_CXXERR 1017 # r pixels "" "Error in CXX" +define ID_CYYERR 1018 # r pixels "" "Error in CYY" +define ID_CXYERR 1019 # r pixels "" "Error in CXY" + + +# Reference to elements of the object data structure may be made with +# the generic OBJ[IRDC] macros or with the individual structure macros. + +define OBJI Memi[$1+$2] # Reference integer parameter +define OBJR Memr[P2R($1+$2)] # Reference real parameter +define OBJD Memd[P2D($1+$2)] # Reference double parameter +define OBJC Memc[P2C($1+$2)] # Reference char parameter + +define OBJ_DETLEN 12 # Length for candidate objects +define OBJ_LEN 35 # Length for accepted objects + +# Detection pass parameters. +define OBJ_ROW OBJI($1,ID_ROW) # Catalog row +define OBJ_NUM OBJI($1,ID_NUM) # Object number +define OBJ_PNUM OBJI($1,ID_PNUM) # Parent object number +define OBJ_XAP OBJR($1,ID_XAP) # X aperture coordinate +define OBJ_YAP OBJR($1,ID_YAP) # Y aperture coordinate +define OBJ_NPIX OBJI($1,ID_NPIX) # Number of pixels +define OBJ_NDETECT OBJI($1,ID_NDETECT) # Number of detected pixels +define OBJ_ISIGAVG OBJR($1,ID_ISIGAVG) # Average (I - sky) / sig +define OBJ_ISIGMAX OBJR($1,ID_ISIGMAX) # Maximum (I - sky) / sig +define OBJ_ISIGAVG2 OBJR($1,ID_ISIGAVG2) # Ref average (I - sky) / sig +define OBJ_FLAGS OBJI($1,ID_FLAGS) # Flags + +define OBJ_SKY OBJR($1,ID_SKY) # Mean sky +define OBJ_SIG OBJR($1,ID_SIG) # Sky sigma +define OBJ_PEAK OBJR($1,ID_PEAK) # Peak pixel value above sky +define OBJ_FLUX OBJR($1,ID_FLUX) # Isophotal flux (I - sky) +define OBJ_APFLUX OBJI($1,ID_APFLUX) # Array of aperture fluxes (ptr) +define OBJ_FRACFLUX OBJR($1,ID_FRACFLUX) # Apportioned flux +define OBJ_FRAC OBJR($1,ID_FRAC) # Approtioned fraction +define OBJ_XMIN OBJI($1,ID_XMIN) # Minimum X +define OBJ_XMAX OBJI($1,ID_XMAX) # Maxium X +define OBJ_YMIN OBJI($1,ID_YMIN) # Minimum Y +define OBJ_YMAX OBJI($1,ID_YMAX) # Maxium Y +define OBJ_WX OBJD($1,ID_WX) # X world coordinate +define OBJ_WY OBJD($1,ID_WY) # Y world coordinate +define OBJ_X1 OBJR($1,ID_X1) # X centroid +define OBJ_Y1 OBJR($1,ID_Y1) # Y centroid +define OBJ_X2 OBJR($1,ID_X2) # X centroid +define OBJ_Y2 OBJR($1,ID_Y2) # Y centroid +define OBJ_XY OBJR($1,ID_XY) # X centroid + +define OBJ_FLUXVAR OBJR($1,ID_FLUXVAR) # Variance in flux +define OBJ_XVAR OBJR($1,ID_XVAR) # Variance in X centroid +define OBJ_YVAR OBJR($1,ID_YVAR) # Variance in Y centroid +define OBJ_XYCOV OBJR($1,ID_XYCOV) # Covariance of X and Y centroid + + + + +# Object flags. +define OBJ_EVAL 001B # Object was evaluated +define OBJ_GROW 002B # Object was grown +define OBJ_SPLIT 004B # Object was split +define OBJ_SINGLE 010B # Object was not split +define OBJ_DARK 020B # Object was below sky + +define FLAGSET (andi(OBJ_FLAGS($1),$2)!=0) +define FLAGNOTSET (andi(OBJ_FLAGS($1),$2)==0) +define SETFLAG OBJ_FLAGS($1)=ori(OBJ_FLAGS($1),$2) +define UNSETFLAG OBJ_FLAGS($1)=andi(OBJ_FLAGS($1),noti($2)) + +define DARK (andi(OBJ_FLAGS($1),OBJ_DARK)!=0) +define EVAL (andi(OBJ_FLAGS($1),OBJ_EVAL)!=0) +define SPLIT (andi(OBJ_FLAGS($1),OBJ_SPLIT)!=0) +define NOTSPLIT (andi(OBJ_FLAGS($1),OBJ_SPLIT)==0) +define SINGLE (andi(OBJ_FLAGS($1),OBJ_SINGLE)!=0) +define NOTSINGLE (andi(OBJ_FLAGS($1),OBJ_SINGLE)==0) +define GROWN (andi(OBJ_FLAGS($1),OBJ_GROW)!=0) +define NOTGROWN (andi(OBJ_FLAGS($1),OBJ_GROW)==0) + +define SZ_FLAGS 5 # Size of flag string diff --git a/noao/nproto/ace/omwrite.x b/noao/nproto/ace/omwrite.x new file mode 100644 index 00000000..83b96d2f --- /dev/null +++ b/noao/nproto/ace/omwrite.x @@ -0,0 +1,98 @@ +include <imhdr.h> +include <pmset.h> +include "ace.h" + + +procedure omwrite (pm, fname, omtype, refim, cat, catalog, objid, logfd) + +pointer pm #I Pixel mask pointer to save +char fname[ARB] #I Filename +int omtype #I Type of mask values +pointer refim #I Reference image pointer +pointer cat #I Catalog pointer +char catalog[ARB] #I Catalog filename +char objid[ARB] #I Object ID string +int logfd #I Logfile + +int i, j, k, nc, nl, stridxs(), andi() +long v[2] +pointer sp, str, im, buf, immap(), impl2i() + +errchk immap + +begin + call smark (sp) + call salloc (str, SZ_LINE, TY_CHAR) + + # Remove output only fields. + call strcpy (fname, Memc[str], SZ_LINE) + i = stridxs (",", fname) + if (i > 0) { + Memc[str+i-1] = ']' + Memc[str+i] = EOS + } + + if (logfd != NULL) { + call fprintf (logfd, " Write object mask: %s\n") + call pargstr (Memc[str]) + } + + im = immap (fname, NEW_COPY, refim) + IM_PIXTYPE(im) = TY_INT + + nc = IM_LEN(refim,1) + nl = IM_LEN(refim,2) + + v[1] = 1 + switch (omtype) { + case OM_BOOL: + do i = 1, nl { + v[2] = i + buf = impl2i (im, i) + call pmglpi (pm, v, Memi[buf], 0, nc, PIX_SRC) + call aminki (Memi[buf], 1, Memi[buf], nc) + } + case OM_ONUM: + do i = 1, nl { + v[2] = i + buf = impl2i (im, i) + call pmglpi (pm, v, Memi[buf], 0, nc, PIX_SRC) + do j = buf, buf+nc-1 + Memi[j] = MNUM(Memi[j]) + } + case OM_COLORS: + do i = 1, nl { + v[2] = i + buf = impl2i (im, i) + call pmglpi (pm, v, Memi[buf], 0, nc, PIX_SRC) + do j = buf, buf+nc-1 { + k = MNUM(Memi[j]) + if (k > 0) { + if (k < NUMSTART) + k = 1 + else + k = mod (k, 8) + 2 + } + Memi[j] = k + } + } + default: + do i = 1, nl { + v[2] = i + call pmglpi (pm, v, Memi[impl2i(im,i)], 0, nc, PIX_SRC) + } + } + + iferr (call imdelf (im, "DATASEC")) + ; + iferr (call imdelf (im, "TRIMSEC")) + ; + if (catalog[1] != EOS) + call imastr (im, "CATALOG", catalog) + if (objid[1] != EOS) + call imastr (im, "OBJID", objid) + + call imastr (refim, "OBJMASK", Memc[str]) + + call imunmap (im) +end diff --git a/noao/nproto/ace/overlay.par b/noao/nproto/ace/overlay.par new file mode 100644 index 00000000..a5fad3f5 --- /dev/null +++ b/noao/nproto/ace/overlay.par @@ -0,0 +1,30 @@ +# Parameter file for DISPLAY + +image,f,a,,,,image to be displayed +frame,i,a,1,1,4,frame to be written into +bpmask,f,h,"",,,bad pixel mask +bpdisplay,s,h,"none","none|overlay|interpolate",,bad pixel display (none|overlay|interpolate) +bpcolors,s,h,"red",,,bad pixel colors +overlay,f,h,"!objmask",,,overlay mask +ocolors,s,h,"1=red,green",,,overlay colors +erase,b,h,yes,,,erase frame +border_erase,b,h,no,,,erase unfilled area of window +select_frame,b,h,yes,,,display frame being loaded +repeat,b,h,no,,,repeat previous display parameters +fill,b,h,no,,,scale image to fit display window +zscale,b,h,yes,,,display range of greylevels near median +contrast,r,h,0.25,,,contrast adjustment for zscale algorithm +zrange,b,h,yes,,,display full image intensity range +zmask,f,h,"",,,sample mask +nsample,i,h,1000,100,,maximum number of sample pixels to use +xcenter,r,h,0.5,0,1,display window horizontal center +ycenter,r,h,0.5,0,1,display window vertical center +xsize,r,h,1,0,1,display window horizontal size +ysize,r,h,1,0,1,display window vertical size +xmag,r,h,1.,,,display window horizontal magnification +ymag,r,h,1.,,,display window vertical magnification +order,i,h,0,0,1,"spatial interpolator order (0=replicate, 1=linear)" +z1,r,h,,,,minimum greylevel to be displayed +z2,r,h,,,,maximum greylevel to be displayed +ztrans,s,h,linear,,,greylevel transformation (linear|log|none|user) +lutfile,f,h,"",,,file containing user defined look up table diff --git a/noao/nproto/ace/pars.x b/noao/nproto/ace/pars.x new file mode 100644 index 00000000..516a8b7d --- /dev/null +++ b/noao/nproto/ace/pars.x @@ -0,0 +1,375 @@ +include <ctype.h> +include <math/curfit.h> +include <math/gsurfit.h> +include "sky.h" +include "skyfit.h" +include "skyblock.h" +include "detect.h" +include "split.h" +include "grow.h" +include "evaluate.h" + + + +# SKY_PARS -- Sky parameters. + +procedure sky_pars (option, pset, pars) + +char option[ARB] #I Option +char pset[ARB] #I Pset +pointer pars #U Parameter structure + +pointer pp + +int strdic() +pointer clopset() + +errchk calloc + +begin + switch (option[1]) { + case 'o': + if (pars != NULL) + return + call calloc (pars, SKY_LEN, TY_STRUCT) + + pp = clopset (pset) + call clgpseta (pp, "skytype", SKY_STR(pars), SKY_STRLEN) + SKY_TYPE(pars) = strdic (SKY_STR(pars), SKY_STR(pars), SKY_STRLEN, + SKY_TYPES) + call clcpset (pp) + case 'c': + if (pars != NULL) { + call skf_pars ("close", "", SKY_SKF(pars)) + call skb_pars ("close", "", SKY_SKB(pars)) + } + call mfree (pars, TY_STRUCT) + } +end + + +# SKF_PARS -- Sky fit parameters. + +procedure skf_pars (option, pset, pars) + +char option[ARB] #I Option +char pset[ARB] #I Pset +pointer pars #U Parameter structure + +pointer pp + +int clgpseti(), strdic() +real clgpsetr() +pointer clopset() + +errchk calloc + +begin + switch (option[1]) { + case 'o': + if (pars != NULL) + return + call calloc (pars, SKF_LEN, TY_STRUCT) + + pp = clopset (pset) + + SKF_STEP(pars) = clgpsetr (pp, "fitstep") + SKF_BLK1D(pars) = clgpseti (pp, "fitblk1d") + SKF_HCLIP(pars) = clgpsetr (pp, "fithclip") + SKF_LCLIP(pars) = clgpsetr (pp, "fitlclip") + SKF_XORDER(pars) = clgpseti (pp, "fitxorder") + SKF_YORDER(pars) = clgpseti (pp, "fityorder") + + SKF_LMIN(pars) = SKFLMIN + SKF_FUNC1D(pars) = strdic (SKFFUNC1D, SKF_STR(pars), + SKF_STRLEN, CV_FUNCTIONS) + SKF_FUNC2D(pars) = strdic (SKFFUNC2D, SKF_STR(pars), + SKF_STRLEN, GS_FUNCTIONS) + SKF_XTERMS(pars) = strdic (SKFXTERMS, SKF_STR(pars), + SKF_STRLEN, GS_XTYPES) - 1 + SKF_NITER(pars) = SKFNITER + + call clcpset (pp) + case 'c': + call mfree (pars, TY_STRUCT) + } +end + + +# SKB_PARS -- Sky block parameters. + +procedure skb_pars (option, pset, pars) + +char option[ARB] #I Option +char pset[ARB] #I Pset +pointer pars #U Parameter structure + +pointer pp, cp +double x, y, sum1, sum2 + +int clgpseti() +pointer clopset() + +errchk calloc + +begin + switch (option[1]) { + case 'o': + if (pars != NULL) + return + + call calloc (pars, SKB_LEN, TY_STRUCT) + + pp = clopset (pset) + SKB_BLKSTEP(pars) = clgpseti (pp, "blkstep") + SKB_BLKSIZE(pars) = clgpseti (pp, "blksize") + SKB_NSUBBLKS(pars) = max (1, clgpseti (pp, "blknsubblks")) + + call strcpy (SKBCNV, Memc[SKB_CNV(pars)], SKB_STRLEN) + SKB_SKYMIN(pars) = SKBSKYMIN + SKB_FRAC(pars) = SKBFRAC + SKB_GROW(pars) = SKBGROW + SKB_SIGBIN(pars) = SKBSIGBIN + SKB_NMINPIX(pars) = SKBNMINPIX + SKB_NMINBINS(pars) = SKBNMINBINS + SKB_HISTWT(pars) = SKBHISTWT + #SKB_HISTWT(pars) = 1 + SKB_A(pars) = 1. / SKBA + #SKB_A(pars) = 1. / .05 + SKB_NBINS(pars) = nint (2 * SKB_SIGBIN(pars) * SKB_A(pars)) + SKB_NBINS(pars) = SKB_NBINS(pars) + mod (SKB_NBINS(pars)+1, 2) + SKB_B(pars) = SKB_NBINS(pars) / 2. + 1 + + for (cp=SKB_CNV(pars); IS_WHITE(Memc[cp]); cp=cp+1) + ; + call strcpy (Memc[cp], Memc[SKB_CNV(pars)], SKB_STRLEN) + + # Compute sigma correction factor from mean absolute deviation. + sum1 = 0. + sum2 = 0. + for (x=-SKB_SIGBIN(pars); x<=SKB_SIGBIN(pars); x=x+0.01) { + y = exp (-x*x/2.) + sum1 = sum1 + abs(x)*y + sum2 = sum2 + y + } + SKB_SIGFAC(pars) = sum2 / sum1 + + call clcpset (pp) + case 'c': + call mfree (pars, TY_STRUCT) + } +end + + +# DET_PARS -- Detect parameters. + +procedure det_pars (option, pset, pars) + +char option[ARB] #I Option +char pset[ARB] #I Pset +pointer pars #U Parameter structure + +pointer pp + +int i, j +pointer cp, ptr +bool clgpsetb() +int clgpseti(), btoi() +real clgpsetr() +pointer clopset() + +errchk calloc + +begin + switch (option[1]) { + case 'o': + if (pars != NULL) + return + call calloc (pars, DET_LEN, TY_STRUCT) + + pp = clopset (pset) + + call clgpseta (pp, "convolve", Memc[DET_CNV(pars)], DET_STRLEN) + DET_HSIG(pars) = clgpsetr (pp, "hsigma") + DET_LSIG(pars) = clgpsetr (pp, "lsigma") + DET_HDETECT(pars) = btoi (clgpsetb (pp, "hdetect")) + DET_LDETECT(pars) = btoi (clgpsetb (pp, "ldetect")) + DET_NEIGHBORS(pars) = clgpseti (pp, "neighbors") + DET_MINPIX(pars) = clgpseti (pp, "minpix") + DET_SIGAVG(pars) = clgpsetr (pp, "sigavg") + DET_SIGPEAK(pars) = clgpsetr (pp, "sigmax") + DET_BPVAL(pars) = clgpseti (pp, "bpval") + if (clgpsetb (pp, "updatesky")) + call skb_pars ("open", pset, DET_SKB(pars)) + + # Check convolution kernel. + for (cp=DET_CNV(pars); IS_WHITE(Memc[cp]); cp=cp+1) + ; + call strcpy (Memc[cp], Memc[DET_CNV(pars)], DET_STRLEN) + if (Memc[DET_CNV(pars)] != EOS) { + call cnvparse (Memc[DET_CNV(pars)], ptr, i, j, NULL) + call mfree (ptr, TY_REAL) + if (i == 1 && j == 1) + Memc[DET_CNV(pars)] = EOS + } + + call clcpset (pp) + case 'd': + if (pars != NULL) + return + call calloc (pars, DET_LEN, TY_STRUCT) + + pp = clopset (pset) + + call clgpseta (pp, "convolve", Memc[DET_CNV(pars)], DET_STRLEN) + DET_HSIG(pars) = clgpsetr (pp, "hsigma") + DET_LSIG(pars) = clgpsetr (pp, "lsigma") + DET_HDETECT(pars) = btoi (clgpsetb (pp, "hdetect")) + DET_LDETECT(pars) = btoi (clgpsetb (pp, "ldetect")) + DET_NEIGHBORS(pars) = clgpseti (pp, "neighbors") + DET_MINPIX(pars) = clgpseti (pp, "minpix") + DET_SIGAVG(pars) = clgpsetr (pp, "sigavg") + DET_SIGPEAK(pars) = clgpsetr (pp, "sigmax") + DET_BPVAL(pars) = clgpseti (pp, "bpval") + if (clgpsetb (pp, "updatesky")) + call skb_pars ("open", pset, DET_SKB(pars)) + + # Check convolution kernel. + for (cp=DET_CNV(pars); IS_WHITE(Memc[cp]); cp=cp+1) + ; + call strcpy (Memc[cp], Memc[DET_CNV(pars)], DET_STRLEN) + if (Memc[DET_CNV(pars)] != EOS) { + call cnvparse (Memc[DET_CNV(pars)], ptr, i, j, NULL) + call mfree (ptr, TY_REAL) + if (i == 1 && j == 1) + Memc[DET_CNV(pars)] = EOS + } + + # The following are unique to diffdetect. + DET_FRAC2(pars) = clgpsetr (pp, "rfrac") + + call clcpset (pp) + case 'c': + if (pars != NULL) + call skb_pars ("close", "", DET_SKB(pars)) + call mfree (pars, TY_STRUCT) + } + +end + + +# SPT_PARS -- Split parameters. + +procedure spt_pars (option, pset, pars) + +char option[ARB] #I Option +char pset[ARB] #I Pset +pointer pars #U Parameter structure + +pointer pp + +int clgpseti() +real clgpsetr() +pointer clopset() + +errchk calloc + +begin + switch (option[1]) { + case 'o': + if (pars != NULL) + return + call calloc (pars, SPT_LEN, TY_STRUCT) + + pp = clopset (pset) + + SPT_NEIGHBORS(pars) = clgpseti (pp, "neighbors") + SPT_SPLITMAX(pars) = clgpsetr (pp, "splitmax") + SPT_SPLITSTEP(pars) = clgpsetr (pp, "splitstep") + SPT_SPLITTHRESH(pars) = clgpsetr (pp, "splitthresh") + SPT_MINPIX(pars) = clgpseti (pp, "minpix") + SPT_SIGAVG(pars) = clgpsetr (pp, "sigavg") + SPT_SIGPEAK(pars) = clgpsetr (pp, "sigmax") + SPT_SMINPIX(pars) = clgpseti (pp, "sminpix") + SPT_SSIGAVG(pars) = clgpsetr (pp, "ssigavg") + SPT_SSIGPEAK(pars) = clgpsetr (pp, "ssigmax") + + call clcpset (pp) + case 'c': + call mfree (pars, TY_STRUCT) + } + +end + + +# GRW_PARS -- Grow parameters. + +procedure grw_pars (option, pset, pars) + +char option[ARB] #I Option +char pset[ARB] #I Pset +pointer pars #U Parameter structure + +pointer pp + +int clgpseti() +real clgpsetr() +pointer clopset() + +errchk calloc + +begin + switch (option[1]) { + case 'o': + if (pars != NULL) + return + call calloc (pars, GRW_LEN, TY_STRUCT) + + pp = clopset (pset) + GRW_NGROW(pars) = clgpseti (pp, "ngrow") + GRW_AGROW(pars) = clgpsetr (pp, "agrow") + call clcpset (pp) + case 'c': + call mfree (pars, TY_STRUCT) + } + +end + + +# EVL_PARS -- Evaluate parameters. + +procedure evl_pars (option, pset, pars) + +char option[ARB] #I Option +char pset[ARB] #I Pset +pointer pars #U Parameter structure + +int i, nowhite(), ctor() +real magzero +pointer pp + +pointer clopset() + +errchk calloc + +begin + switch (option[1]) { + case 'o': + if (pars != NULL) + return + call calloc (pars, EVL_LEN, TY_STRUCT) + + pp = clopset (pset) + call clgpseta (pp, "magzero", EVL_MAGZERO(pars,1), EVL_STRLEN) + if (nowhite(EVL_MAGZERO(pars,1),EVL_MAGZERO(pars,1),EVL_STRLEN)==0) + call strcpy ("INDEF", EVL_MAGZERO(pars,1), EVL_STRLEN) + if (EVL_MAGZERO(pars,1) != '!') { + i = 1 + if (ctor (EVL_MAGZERO(pars,1), i, magzero) == 0) + call error (1, "Magnitude zero point parameter syntax") + } + call clcpset (pp) + case 'c': + call mfree (pars, TY_STRUCT) + } +end diff --git a/noao/nproto/ace/reviewproto.cl b/noao/nproto/ace/reviewproto.cl new file mode 100644 index 00000000..2af722de --- /dev/null +++ b/noao/nproto/ace/reviewproto.cl @@ -0,0 +1,215 @@ +# REVIEWPROTO + +procedure reviewproto (catalog) + +string catalog {prompt="Catalog"} +bool nooverlay = yes {prompt="Display image without overlays"} +bool overlay = yes {prompt="Display image with overlays"} +bool comparison = yes {prompt="Display comparison image"} +file compimage = "" {prompt="Comparison image"} +int box = 200 {prompt="Box size (pixels)"} +string ocolors = "green" {prompt="Object mask color"} +string lcolor = "red" {prompt="Label color"} + +struct *fd + +begin + file cat, im, mask, coords, compim, temp + int naxis1, naxis2, icolor, frame, nframe, x1, x2, y1, y2 + real r, d, x, y, xt, yt + bool pause + string key, imsec + struct title + + coords = mktemp ("tmp$iraf") + temp = mktemp ("tmp$iraf") + + # Get query parameters. + cat = catalog + + # Get header and coordinates. + tdump (cat, cdfile="", pfile=temp, datafile=coords, + columns="ra,dec", rows="", pwidth=80) + match ("IMAGE", temp, stop-) | scan (im, im, im) + match ("MASK", temp, stop-) | scan (mask, mask, mask) + delete (temp, verify-) + + # Set image size. + sections (im, option="root") | scan (im) + hselect (im, "naxis1,naxis2", yes) | scan (naxis1, naxis2) + + # Set comparison. + sections (compimage, option="root") | scan (compim) + + # Translate color specification. + match (lcolor, "ace$colors.dat", stop-) | scan (lcolor, icolor) + if (nscan() != 2) + icolor = 200 + + # Number of frames. + nframe = 0 + if (nooverlay) + nframe = nframe + 1 + if (overlay) + nframe = nframe + 1 + if (comparison && compim != "") + nframe = nframe + 1 + + # Loop through the list of catalog coordinates. + pause = NO + fd = coords + while (fscan (fd, r, d) != EOF) { + if (nscan() < 2) + next + if (r == INDEF ||d == INDEF) + next + + # Pause with cursor read if there is more than one coordinate. + if (pause) { + printf ("q to quit any other key to continue...\n") + if (fscan (imcur, x, y, i, key) == EOF) + break + if (key == 'q') + break + pause = NO + } + + # Display. + frame = nframe + + if (comparison && compim != "") { + # Convert world coordinate to image section. + print (r, d) | wcsctran ("STDIN", "STDOUT", compim, "world", + "logical", columns="1 2", units="native native", + formats="", min_sigdigit=9, verbose=no) | scan (x, y) + x = nint (x); y = nint (y) + x1 = max (1, nint (x-box/2.)) + x2 = min (naxis1, nint (x+box/2.)) + y1 = max (1, nint (y-box/2.)) + y2 = min (naxis2, nint (y+box/2.)) + if (x2 > x1 && y2 > y1) { + # Display section. + printf ("%s[%d:%d,%d:%d]\n", compim, x1, x2, y1, y2) | + scan (imsec) + acedisplay (imsec, frame, bpmask="", bpdisplay="none", + bpcolors="red", overlay="", ocolors=ocolors, + erase=yes, border_erase=no, select_frame=yes, + repeat=no, fill=no, zscale=yes, contrast=0.25, + zrange=yes, zmask="", nsample=1000, xcenter=0.5, + ycenter=0.5, xsize=1., ysize=1., xmag=2., ymag=2., + order=0, z1=0., z2=0., ztrans="linear", lutfile="", + >> "dev$null") + + # Mark. + printf ("%g %g\n", x, y, >> temp) + tvmark (frame, temp, logfile="", autolog=no, + outimage="", deletions="", commands="", + mark="circle", radii="10", lengths="0", + font="raster", color=icolor, label=no, + number=no, nxoffset=0, nyoffset=0, pointsize=1, + txsize=1, tolerance=1.5, interactive=no) + delete (temp, verify-) + + # Label. + xt = x1 + 10 + yt = y2 + 10 + printf ("%g %g '%.2H %.1h'\n", xt, yt, r, d, >> temp) + tvmark (frame, temp, logfile="", autolog=no, + outimage="", deletions="", commands="", + mark="none", radii="0", lengths="0", + font="raster", color=icolor, label=yes, + number=no, nxoffset=0, nyoffset=0, pointsize=1, + txsize=2, tolerance=1.5, interactive=no) + delete (temp, verify-) + } + frame = frame - 1 + } + + # Convert world coordinate to image section. + print (r, d) | wcsctran ("STDIN", "STDOUT", im, "world", + "logical", columns="1 2", units="native native", + formats="", min_sigdigit=9, verbose=no) | scan (x, y) + x = nint (x); y = nint (y) + x1 = max (1, nint (x-box/2.)) + x2 = min (naxis1, nint (x+box/2.)) + y1 = max (1, nint (y-box/2.)) + y2 = min (naxis2, nint (y+box/2.)) + if (x2 <= x1 || y2 <= y1) + next + + # Display. + if (overlay) { + printf ("%s[%d:%d,%d:%d]\n", im, x1, x2, y1, y2) | scan (imsec) + acedisplay (imsec, frame, bpmask="", bpdisplay="none", + bpcolors="red", overlay=mask, ocolors=ocolors, + erase=yes, border_erase=no, select_frame=yes, + repeat=no, fill=no, zscale=yes, contrast=0.25, + zrange=yes, zmask="", nsample=1000, xcenter=0.5, + ycenter=0.5, xsize=1., ysize=1., xmag=2., ymag=2., + order=0, z1=0., z2=0., ztrans="linear", lutfile="", + >> "dev$null") + + # Mark + printf ("%g %g\n", x, y, >> temp) + tvmark (frame, temp, logfile="", autolog=no, + outimage="", deletions="", commands="", + mark="circle", radii="10", lengths="0", + font="raster", color=icolor, label=no, + number=no, nxoffset=0, nyoffset=0, pointsize=1, + txsize=1, tolerance=1.5, interactive=no) + delete (temp, verify-) + + xt = x1 + 10 + yt = y2 + 10 + printf ("%g %g '%.2H %.1h'\n", xt, yt, r, d, >> temp) + tvmark (frame, temp, logfile="", autolog=no, + outimage="", deletions="", commands="", + mark="none", radii="0", lengths="0", + font="raster", color=icolor, label=yes, + number=no, nxoffset=0, nyoffset=0, pointsize=1, + txsize=2, tolerance=1.5, interactive=no) + delete (temp, verify-) + + frame = frame - 1 + } + + # Display. + if (nooverlay) { + printf ("%s[%d:%d,%d:%d]\n", im, x1, x2, y1, y2) | scan (imsec) + acedisplay (imsec, frame, bpmask="", bpdisplay="none", + bpcolors="red", overlay="", ocolors=ocolors, + erase=yes, border_erase=no, select_frame=yes, + repeat=no, fill=no, zscale=yes, contrast=0.25, + zrange=yes, zmask="", nsample=1000, xcenter=0.5, + ycenter=0.5, xsize=1., ysize=1., xmag=2., ymag=2., + order=0, z1=0., z2=0., ztrans="linear", lutfile="", + >> "dev$null") + + # Mark + printf ("%g %g\n", x, y, >> temp) + tvmark (frame, temp, logfile="", autolog=no, + outimage="", deletions="", commands="", + mark="circle", radii="10", lengths="0", + font="raster", color=icolor, label=no, + number=no, nxoffset=0, nyoffset=0, pointsize=1, + txsize=1, tolerance=1.5, interactive=no) + delete (temp, verify-) + + xt = x1 + 10 + yt = y2 + 10 + printf ("%g %g '%.2H %.1h'\n", xt, yt, r, d, >> temp) + tvmark (frame, temp, logfile="", autolog=no, + outimage="", deletions="", commands="", + mark="none", radii="0", lengths="0", + font="raster", color=icolor, label=yes, + number=no, nxoffset=0, nyoffset=0, pointsize=1, + txsize=2, tolerance=1.5, interactive=no) + delete (temp, verify-) + + frame = frame - 1 + } + + pause = YES + } + fd = ""; delete (coords, verify-) +end diff --git a/noao/nproto/ace/sky.h b/noao/nproto/ace/sky.h new file mode 100644 index 00000000..4aca7214 --- /dev/null +++ b/noao/nproto/ace/sky.h @@ -0,0 +1,14 @@ +# Grow parameter structure + +define SKY_LEN 8 # Length of parameter structure +define SKY_STRLEN 9 # Length of string + +define SKY_TYPE Memi[$1] # Type of sky +define SKY_SKF Memi[$1+1] # Sky fit parameters +define SKY_SKB Memi[$1+2] # Sky block parameters +define SKY_STR Memc[P2C($1+3)] # String + + +define SKY_TYPES "|fit|block|" +define SKY_FIT 1 # Sky fitting algorithm +define SKY_BLOCK 2 # Sky block algorithm diff --git a/noao/nproto/ace/sky.x b/noao/nproto/ace/sky.x new file mode 100644 index 00000000..c713a437 --- /dev/null +++ b/noao/nproto/ace/sky.x @@ -0,0 +1,118 @@ +include <error.h> +include "sky.h" + + +# SKY -- Determine sky and sky sigma in an image. +# +# Get the sky and sigma map pointers. This is layered on the MAPIO routines +# and lower level sky algorithms. The sky parameter structure will be +# allocated if needed and must be freed by the calling program. +# +# If they are not defined compute an initial +# sky and/or sky sigma surface fit using a subset of the input lines. +# Whether the sky and/or the sigma are fit is determined by whether the input +# sky and sky sigma pointers are NULL. The initial data for the surface fit +# is measured at a subset of lines with any masked pixels excluded. Objects +# are removed by fitting a 1D curve to each line, rejection points with large +# residuals and iterating until only sky is left. The sky points are then +# accumulated for a 2D surface fit and the residuals are added to a +# histogram. The absolute deviations, scaled by 0.7979 to convert to an +# gausian sigma, are accumulated for a sky sigma surface fit. After all the +# sample lines are accumulated the surface fits are computed. The histogram +# of residuals is then fit by a gaussian to estimate an offset from the sky +# fit to the sky mode caused by unrejected object light. The offset is +# applied to the sky surface. + +procedure sky (par, im, bpm, expmap, skyname, signame, skymap, sigmap, + dosky, dosig, logfd) + +pointer par #I Parameters +pointer im #I Input image +pointer bpm #I Input mask +pointer expmap #I Exposure map +char skyname[ARB] #I Sky map name +char signame[ARB] #I Sigma map name +pointer skymap #O Sky map +pointer sigmap #O Sigma map +bool dosky #O Sky computed? +bool dosig #O Sigma computed? +int logfd #I Verbose? + +real rval +pointer sp, namesky, namesig + +int errcode() +pointer map_open() +errchk map_open, sky_fit, sky_block + +begin + call smark (sp) + call salloc (namesky, SZ_FNAME, TY_CHAR) + call salloc (namesig, SZ_FNAME, TY_CHAR) + + if (logfd != NULL) + call fprintf (logfd, " Set sky and sigma:\n") + + # Check whether to compute a sky. + skymap = NULL + if (skyname[1] != EOS) { + iferr (skymap = map_open (skyname, im)) { + skymap = NULL + if (errcode() != 2) + call erract (EA_ERROR) + } + if (logfd != NULL && skymap != NULL) { + ifnoerr (call map_getr (skymap, "constant", rval)) { + call fprintf (logfd, " Use constant input sky: %g\n") + call pargr (rval) + } else { + call fprintf (logfd, " Use input sky: %s\n") + call pargstr (skyname) + } + } + } + dosky = (skymap == NULL) + + # Check whether to compute a sky sigma. + sigmap = NULL + if (signame[1] != EOS) { + iferr (sigmap = map_open (signame, im)) { + sigmap = NULL + if (errcode() != 2) + call erract (EA_ERROR) + } + if (logfd != NULL && sigmap != NULL) { + ifnoerr (call map_getr (sigmap, "constant", rval)) { + call fprintf (logfd, " Use constant input sigma: %g\n") + call pargr (rval) + } else { + call fprintf (logfd, " Use input sigma: %s\n") + call pargstr (signame) + } + } + } + dosig = (sigmap == NULL) + + # Compute the sky. + if (dosky || dosig) { + # Set parameters. + call sky_pars ("open", "", par) + + switch (SKY_TYPE(par)) { + case SKY_FIT: + call sky_fit (SKY_SKF(par), dosky, dosig, im, bpm, expmap, + skyname, signame, skymap, sigmap, logfd) + case SKY_BLOCK: + call sky_fit (SKY_SKF(par), dosky, dosig, im, bpm, expmap, + "", "", skymap, sigmap, logfd) + call map_seti (skymap, "sample", 5) + call map_seti (sigmap, "sample", 5) + call sky_block (SKY_SKB(par), dosky, dosig, im, bpm, expmap, + skyname, signame, skymap, sigmap, logfd) + default: + call error (1, "Unknown sky type") + } + } + + call sfree (sp) +end diff --git a/noao/nproto/ace/skyblock.h b/noao/nproto/ace/skyblock.h new file mode 100644 index 00000000..40f5758d --- /dev/null +++ b/noao/nproto/ace/skyblock.h @@ -0,0 +1,50 @@ +# Definitions for SKYBLOCK algorithm. + +define SKBSKYMIN 10000 # Minimum number of sky pixels in subblock +define SKBFRAC 0.66 # Frac of sky pix in subblock for sky estimate +define SKBGROW 1.5 # Grow for rejected subblocks +define SKBSIGBIN 2.5 # Sigma width of histogram +define SKBA 0.01 # Histogram resolution +define SKBNMINPIX 50 # Minimum number of pixels/subblock/side +define SKBNMINBINS 500 # Minimum average bin population +define SKBHISTWT 2 # Default histogram weighting power +define SKBCNV "" # Convolution + +define SKB_STRLEN 99 # String length in parameters +define SKB_LEN 82 # Sky block structure length + +# The following apply to all images. +define SKB_BLKSTEP Memi[$1] # Step size +define SKB_BLKSIZE Memi[$1+1] # Number of pixels or blocks +define SKB_NSUBBLKS Memi[$1+2] # Number of subblocks per block +define SKB_SKYMIN Memi[$1+3] # Minimum number of sky pixels +define SKB_NMINPIX Memi[$1+4] # Min pixels/subblock/side +define SKB_SIGBIN Memr[P2R($1+5)] # Histogram sigma limit +define SKB_A Memr[P2R($1+6)] # Histogram resolution +define SKB_B Memr[P2R($1+7)] # Bin start +define SKB_NBINS Memi[$1+8] # Number of bins +define SKB_NMINBINS Memi[$1+9] # Min avg bin population +define SKB_HISTWT Memi[$1+10] # Histogram weighting power +define SKB_SIGFAC Memr[P2R($1+11)] # Sigma correction factor +define SKB_FRAC Memr[P2R($1+12)] # Frac of sky pix in subblock +define SKB_GROW Memr[P2R($1+13)] # Grow for rejected subblocks +define SKB_CNV P2C($1+14) # Pointer to convolution string (99) + +# The following are set for each image. +define SKB_NCBLK Memi[$1+65] # Number of blocks across image +define SKB_NLBLK Memi[$1+66] # Number of blocks across image +define SKB_NCPIX Memi[$1+67] # Number of pixels in blocks +define SKB_NLPIX Memi[$1+68] # Number of pixels in blocks +define SKB_NCSBLK Memi[$1+69] # Number of subblocks across image +define SKB_NLSBLK Memi[$1+70] # Number of subblocks across image +define SKB_NCSPIX Memi[$1+71] # Number of pixels in subblocks +define SKB_NLSPIX Memi[$1+72] # Number of pixels in subblocks +define SKB_NSKYMIN Memi[$1+73] # Minimum pixels to evaluate histogram +define SKB_BINS Memi[$1+74] # Pointer to bins +define SKB_NAV Memi[$1+75] # Number of bins to average for weights +define SKB_NSKY Memi[$1+76] # Pointer to num sky pix +define SKB_EXP Memi[$1+77] # Pointer to exposure values +define SKB_SKYS Memi[$1+78] # Pointer to sky block values +define SKB_SIGS Memi[$1+79] # Pointer to sigma block values +define SKB_SKY Memi[$1+80] # Pointer to current sky block line +define SKB_SIG Memi[$1+81] # Pointer to current sigma block line diff --git a/noao/nproto/ace/skyblock.x b/noao/nproto/ace/skyblock.x new file mode 100644 index 00000000..5e3eb5f9 --- /dev/null +++ b/noao/nproto/ace/skyblock.x @@ -0,0 +1,1039 @@ +include <error.h> +include <ctype.h> +include <imhdr.h> +include <imset.h> +include <mach.h> +include "skyblock.h" + + +# SKY_BLOCK - Determine sky and sky sigma in blocks. +# +# This is layered on MAPIO and CONVOLVE. + +procedure sky_block (skb, dosky, dosig, in, bpm, expmap, skyname, signame, + skymap, sigmap, logfd) + +pointer skb #U Sky block structure +bool dosky #I Compute sky +bool dosig #I Compute sigma +pointer in #I Input image pointer +pointer bpm #I Input mask +pointer expmap #I Exposure map +char skyname[ARB] #I Sky map name (if none then no output) +char signame[ARB] #I Sigma map name (if none then no output) +pointer skymap #U Sky map +pointer sigmap #U Sigma map +int logfd #I Verbose? + +int l, blkstep, nc, nl +real cnvwt +pointer sp, cnv, cnvdata, bp +pointer im[2], indata, skydata, sigdata, expdata +errchk skb_pars, skb_iminit, convolve, skb_accum, skb_update + +begin + if (!(dosky||dosig)) + return + + call smark (sp) + + # Log operation. + if (logfd != NULL) { + if (dosky && dosig) + call fprintf (logfd, + " Determine sky and sigma by block statistics:\n") + else if (dosky) + call fprintf (logfd, " Determine sky by block statistics:\n") + else + call fprintf (logfd, + " Determine sigma by block statistics:\n") + } + + # Set parameters if not set in a previous call or set externally. + if (skb == NULL) + call skb_pars ("open", "", skb) + + # Set parameters for the image. + blkstep = SKB_BLKSTEP(skb) + call skb_iminit (skb, in, expmap, blkstep, logfd) + + # Set maximum number of image columns and lines to use. + nc = SKB_NCSBLK(skb) * SKB_NCSPIX(skb) + nl = SKB_NLSBLK(skb) * SKB_NLSPIX(skb) + + # Set up convolution. Note we can't use convolution with a blkstep. + cnv = SKB_CNV(skb) + if (Memc[cnv] != EOS) { + if (blkstep > 1) { + call salloc (cnv, 1, TY_CHAR) + Memc[cnv] = EOS + } else + call salloc (cnvdata, nc, TY_REAL) + } + + # Setup bad pixel mask. + if (bpm == NULL) { + call salloc (bp, nc, TY_INT) + call aclri (Memi[bp], nc) + } + + # Go through image creating low resolution sky blocks. + im[1] = in; im[2] = NULL + do l = 1, nl, blkstep { + call convolve (im, bpm, skymap, sigmap, expmap, 0, + 1., l, Memc[cnv], indata, bp, cnvdata, skydata, + sigdata, expdata, cnvwt, logfd) + call skb_accum (skb, l, blkstep, Memr[cnvdata], Memr[skydata], + Memr[sigdata], Memr[expdata], Memi[bp], nc, cnvwt) + } + + # Free convolution memory. + call convolve (im, bpm, skymap, sigmap, expmap, 0, + 1., 0, Memc[cnv], indata, bp, cnvdata, skydata, + sigdata, expdata, cnvwt, logfd) + + # Turn the sky blocks into sky maps. + call skb_update (skb, dosky, dosig, in, skyname, signame, + skymap, sigmap, logfd) + + # Free memory. + call skb_imfree (skb) + call sfree (sp) +end + + +# SKB_IMINIT -- Initialize parameters and allocate memory for an image. + +procedure skb_iminit (skb, im, expmap, blkstep, logfd) + +pointer skb #U Sky block structure +pointer im #I Image pointer +pointer expmap #I Exposure map pointer +int blkstep #U Line step for speed +int logfd #I Log file descriptor + +int nc, nl + +begin + # Number of pixels per subblock. + nc = IM_LEN(im,1) + nl = IM_LEN(im,2) + if (SKB_BLKSIZE(skb) < 0) { + if (nc < nl) { + SKB_NCSPIX(skb) = max (SKB_NMINPIX(skb), + nc / (SKB_NSUBBLKS(skb) * max(1,-SKB_BLKSIZE(skb)))) + SKB_NLSPIX(skb) = SKB_NCSPIX(skb) + } else { + SKB_NLSPIX(skb) = max (SKB_NMINPIX(skb), + nl / (SKB_NSUBBLKS(skb) * max(1,-SKB_BLKSIZE(skb)))) + SKB_NCSPIX(skb) = SKB_NLSPIX(skb) + } + } else { + SKB_NCSPIX(skb) = max (SKB_NMINPIX(skb), + min (nc, SKB_BLKSIZE(skb)) / SKB_NSUBBLKS(skb)) + SKB_NLSPIX(skb) = max (SKB_NMINPIX(skb), + min (nl, SKB_BLKSIZE(skb)) / SKB_NSUBBLKS(skb)) + } + + # Number of subblocks, blocks, and number of pixels per block. + SKB_NCSBLK(skb) = max (1, nc / SKB_NCSPIX(skb)) + SKB_NLSBLK(skb) = max (1, nl / SKB_NLSPIX(skb)) + SKB_NCBLK(skb) = (SKB_NCSBLK(skb)+SKB_NSUBBLKS(skb)-1)/SKB_NSUBBLKS(skb) + SKB_NLBLK(skb) = (SKB_NLSBLK(skb)+SKB_NSUBBLKS(skb)-1)/SKB_NSUBBLKS(skb) + SKB_NCPIX(skb) = SKB_NCSPIX(skb) * SKB_NSUBBLKS(skb) + SKB_NLPIX(skb) = SKB_NLSPIX(skb) * SKB_NSUBBLKS(skb) + + # Each subblock must have at least SKYMIN or FRAC sky pixels. + SKB_NSKYMIN(skb) = min (SKB_SKYMIN(skb), + nint (SKB_FRAC(skb) * SKB_NCSPIX(skb) * SKB_NLSPIX(skb))) + + # Histogram parameters. + SKB_NAV(skb) = nint (real(SKB_NBINS(skb)) / (min (SKB_NBINS(skb), + SKB_NCSPIX(skb) * SKB_NLSPIX(skb) / SKB_NMINBINS(skb)))) + SKB_NAV(skb) = SKB_NAV(skb) + mod (SKB_NAV(skb)+1, 2) + #SKB_NAV(skb) = 1 + + # Set line subsampling for speed. + if (blkstep > 1) { + blkstep = min (1 + SKB_NLSPIX(skb) / 30, blkstep) + SKB_NSKYMIN(skb) = SKB_NSKYMIN(skb) / blkstep + } + + # Allocate and initialize memory. + call calloc (SKB_BINS(skb), SKB_NBINS(skb)*(SKB_NCSBLK(skb)+1), TY_INT) + call calloc (SKB_NSKY(skb), SKB_NCSBLK(skb), TY_INT) + call calloc (SKB_SKYS(skb), SKB_NCSBLK(skb)*SKB_NLSBLK(skb), TY_REAL) + call calloc (SKB_SIGS(skb), SKB_NCSBLK(skb)*SKB_NLSBLK(skb), TY_REAL) + if (expmap == NULL) { + call malloc (SKB_EXP(skb), 1, TY_REAL) + Memr[SKB_EXP(skb)] = INDEFR + } else + call calloc (SKB_EXP(skb), SKB_NCSBLK(skb), TY_REAL) + + # Set pointers to first line of blocks. + SKB_SKY(skb) = SKB_SKYS(skb) + SKB_SIG(skb) = SKB_SIGS(skb) + + if (logfd != NULL) { + call fprintf (logfd, " Number of blocks: %d %d\n") + call pargi (SKB_NCBLK(skb)) + call pargi (SKB_NLBLK(skb)) + call fprintf (logfd, " Number of pixels per block: %d %d\n") + call pargi (SKB_NCPIX(skb)) + call pargi (SKB_NLPIX(skb)) + call fprintf (logfd, " Number of subblocks: %d %d\n") + call pargi (SKB_NCSBLK(skb)) + call pargi (SKB_NLSBLK(skb)) + call fprintf (logfd, " Number of pixels per subblock: %d %d\n") + call pargi (SKB_NCSPIX(skb)) + call pargi (SKB_NLSPIX(skb)) + if (blkstep > 1) { + call fprintf (logfd, " Line sampling step: %d\n") + call pargi (blkstep) + } + } +end + + +# SKB_IMFREE -- Free memory for an image. + +procedure skb_imfree (skb) + +pointer skb #I Sky block structure + +begin + call mfree (SKB_BINS(skb), TY_INT) + call mfree (SKB_NSKY(skb), TY_INT) + call mfree (SKB_SKYS(skb), TY_REAL) + call mfree (SKB_SIGS(skb), TY_REAL) + call mfree (SKB_EXP(skb), TY_REAL) +end + + +# SKB_ACCUM -- Accumulate sky pixels in block histograms. +# Evaluate histograms when a block is complete. + +procedure skb_accum (skb, line, blkstep, cnv, sky, sig, exp, bp, nc, cnvwt) + +pointer skb #I Sky block structure +int line #I Line +int blkstep #I Line step +real cnv[nc] #I Convolved image data +real sky[nc] #I Sky data +real sig[nc] #I Sky sigma data +real exp[nc] #I Exposure data +int bp[nc] #I Bad pixel values +int nc #I Number of columns +real cnvwt #I Sigma weight + +real a, b, s, t, rcnv, tcnv +int c, n, ncmax, nbins, bin, csky +pointer bins, skys, sigs, exps, nsky + +begin + if (line > SKB_NLSBLK(skb) * SKB_NLSPIX(skb)) + return + ncmax = min (nc, SKB_NCSBLK(skb) * SKB_NCSPIX(skb)) + + a = SKB_A(skb) + b = SKB_B(skb) + n = SKB_NCSPIX(skb) + nbins = SKB_NBINS(skb) + bins = SKB_BINS(skb) + skys = SKB_SKY(skb) + sigs = SKB_SIG(skb) + exps = SKB_EXP(skb) + nsky = SKB_NSKY(skb) + + if (IS_INDEFR(Memr[exps])) { + do c = 1, ncmax { + if (bp[c] != 0) + next + + s = sky[c] + t = sig[c] + rcnv = cnv[c] - s + tcnv = t / cnvwt + bin = a * rcnv / tcnv + b + if (bin < 1 || bin > nbins) + next + + csky = (c-1) / n + bin = bins + csky * nbins + bin - 1 + Memi[bin] = Memi[bin] + 1 + Memr[skys+csky] = Memr[skys+csky] + s + Memr[sigs+csky] = Memr[sigs+csky] + t + Memi[nsky+csky] = Memi[nsky+csky] + 1 + } + } else { + do c = 1, ncmax { + if (bp[c] != 0) + next + + s = sky[c] + t = sig[c] + rcnv = cnv[c] - s + tcnv = t / cnvwt + bin = a * rcnv / tcnv + b + if (bin < 1 || bin > nbins) + next + + csky = (c-1) / n + bin = bins + csky * nbins + bin - 1 + Memi[bin] = Memi[bin] + 1 + Memr[skys+csky] = Memr[skys+csky] + s + Memr[sigs+csky] = Memr[sigs+csky] + t + Memr[exps+csky] = Memr[exps+csky] + exp[c] + Memi[nsky+csky] = Memi[nsky+csky] + 1 + } + } + + # Evaluate histogram sky values if all lines have been accumulated. + n = mod (line, SKB_NLSPIX(skb)) + if (n == 0 || n + blkstep > SKB_NLSPIX(skb)) { + n = SKB_NCSBLK(skb) + call skb_blkeval (Memi[bins], nbins, a, b, Memr[skys], Memr[sigs], + Memr[exps], Memi[nsky], n, SKB_NSKYMIN(skb), SKB_NAV(skb), + SKB_HISTWT(skb), SKB_SIGFAC(skb)) + + # Initialize for accumulation of next line of blocks. + SKB_SKY(skb) = skys + n + SKB_SIG(skb) = sigs + n + if (!IS_INDEFR(Memr[exps])) + call aclrr (Memr[exps], n) + call aclri (Memi[nsky], n) + call aclri (Memi[bins], n*nbins) + } +end + + +# SKB_BLKEVAL -- Evaluate sky and sigma for each histogram in line of blocks. +# Set to INDEF if there are not enough pixels in the histogram. + +procedure skb_blkeval (bins, nbins, a, b, skys, sigs, exps, nsky, ncsblk, + nskymin, nav, histwt, sigfac) + +int bins[nbins,ncsblk] #I Sky subblock bins +int nbins #I Number of bins +real a, b #I Binning coefficients +real skys[ncsblk] #U Sky sum in, sky estimate out +real sigs[ncsblk] #U Sigma sum in, sigma estimate out +real exps[ncsblk] #I Exposure sum +int nsky[ncsblk] #I Number of values in bin +int ncsblk #I Number of sky pixels per subblock +int nskymin #I Minimum number of sky pixels for good sky +int nav #I Number of bins to average +int histwt #I Histogram weighting power +real sigfac #I Sigma conversion factor from mean abs dev. + +int i, j, k, l, m, n +double sky, sig, exp, x, wt, skymean, skymed, skybin, sigbin +double sum1, sum2, sum3 + +begin +# do i = 1, ncsblk { +# do j = 1, nbins { +# call printf ("%d\n") +# call pargi (bins[j,i]) +# } +# } + m = nav / 2 + do i = 1, ncsblk { + n = nsky[i] + if (n < nskymin) { + skys[i] = INDEFR + sigs[i] = INDEFR + next + } + + sky = skys[i] / n + sig = sigs[i] / n + if (!IS_INDEFR(exps[1])) { + exp = exps[i] / n + exps[i] = exp + } else + exp = 1 + + # Compute mean and median using a power weighting of the histogram. + sum1 = 0. + sum2 = 0. + sum3 = 0. + k = ncsblk + 1 + call aclri (bins[1,k], nbins) + do j = 1, nbins { + n = bins[j,i] + do l = max(1,j-m), min (nbins,j+m) + bins[l,k] = bins[l,k] + n + } + n = nsky[i] + switch (histwt) { + case 1: + do j = 1, nbins { + wt = real (bins[j,k]) / n + x = j + sum1 = sum1 + wt * x + sum2 = sum2 + wt + } + sum2 = sum2 + x = 0 + do j = 1, nbins { + wt = real (bins[j,k]) / n + sum3 = sum3 + wt + x + if (sum3 >= sum2) + break + x = wt + } + case 2: + do j = 1, nbins { + wt = real (bins[j,k]) / n + wt = wt * wt + x = j + sum1 = sum1 + wt * x + sum2 = sum2 + wt + } + sum2 = sum2 + x = 0 + do j = 1, nbins { + wt = real (bins[j,k]) / n + wt = wt * wt + sum3 = sum3 + wt + x + if (sum3 >= sum2) + break + x = wt + } + case 3: + do j = 1, nbins { + wt = real (bins[j,k]) / n + wt = wt * wt * wt + x = j + sum1 = sum1 + wt * x + sum2 = sum2 + wt + } + sum2 = sum2 + x = 0 + do j = 1, nbins { + wt = real (bins[j,k]) / n + wt = wt * wt * wt + sum3 = sum3 + wt + x + if (sum3 >= sum2) + break + x = wt + } + case 4: + do j = 1, nbins { + wt = real (bins[j,k]) / n + wt = wt * wt + wt = wt * wt + x = j + sum1 = sum1 + wt * x + sum2 = sum2 + wt + } + sum2 = sum2 + x = 0 + do j = 1, nbins { + wt = real (bins[j,k]) / n + wt = wt * wt + wt = wt * wt + sum3 = sum3 + wt + x + if (sum3 >= sum2) + break + x = wt + } + default: + do j = 1, nbins { + wt = real (bins[j,k]) / n + wt = wt ** histwt + x = j + sum1 = sum1 + wt * x + sum2 = sum2 + wt + } + sum2 = sum2 + x = 0 + do j = 1, nbins { + wt = real (bins[j,k]) / n + wt = wt ** histwt + sum3 = sum3 + wt + x + if (sum3 >= sum2) + break + x = wt + } + } + skymean = sum1 / sum2 + skymed = j - (sum3 - sum2) / (wt + x) + #skybin = skymean - max (0D0, 3 * (skymean - skymed)) + skybin = skymean - 3 * (skymean - skymed) + #skybin = skymean + skys[i] = ((skybin + 0.5 - b) / a) * sig + sky + + sum1 = 0. + sum2 = 0. + do j = 1, nbins { + wt = bins[j,k] + x = abs (j - skybin) + sum1 = sum1 + wt * x + sum2 = sum2 + wt + } + sigbin = sum1 / sum2 + sigs[i] = sigbin / a * sig * sqrt (exp) * sigfac + } +end + + +# SKB_UPDATE -- Update the sky and sigma maps using the block values. + +procedure skb_update (skb, dosky, dosig, im, skyname, signame, + skymap, sigmap, logfd) + +pointer skb #I Sky block structure +bool dosky #I Compute sky +bool dosig #I Compute sigma +pointer im #I Image pointer +char skyname[ARB] #I Output sky map name +char signame[ARB] #I Output sigma map name +pointer skymap #U Sky map pointer +pointer sigmap #U Sigma map pointer +int logfd #I Log file descriptor + +bool skydebug, sigdebug +pointer sp, fname, tmp, map_open() +errchk skb_wmap, skb_grow, skb_merge, skb_wmap, map_close, map_open + +begin + call smark (sp) + call salloc (fname, SZ_FNAME, TY_CHAR) + + + if (dosky) { + skydebug = false + if (skydebug) + call skb_wmap ("skydebug.fits", im, SKB_SKYS(skb), + SKB_NCSBLK(skb), SKB_NLSBLK(skb), SKB_NCSPIX(skb), + SKB_NLSPIX(skb), 0., NULL) + + # Grow subblocks contaminated by large objects. + call skb_grow (SKB_SKYS(skb), SKB_NCSBLK(skb), SKB_NLSBLK(skb), + SKB_GROW(skb)) + + if (skydebug) + call skb_wmap ("skydebug.fits", im, SKB_SKYS(skb), + SKB_NCSBLK(skb), SKB_NLSBLK(skb), SKB_NCSPIX(skb), + SKB_NLSPIX(skb), 0., NULL) + + # Merge sky from subblocks and interpolate missing regions. + call skb_merge (Memr[SKB_SKYS(skb)], SKB_NCSBLK(skb), + SKB_NLSBLK(skb), Memr[SKB_SKYS(skb)], SKB_NCBLK(skb), + SKB_NLBLK(skb)) + + # Write block maps and map them with the MAPIO interface. + # If no name is given then use a temporary image. + if (skyname[1] == EOS) { + call mktemp ("tmpsky", Memc[fname], SZ_FNAME) + call skb_wmap (Memc[fname], im, SKB_SKYS(skb), + SKB_NCBLK(skb), SKB_NLBLK(skb), SKB_NCPIX(skb), + SKB_NLPIX(skb), INDEFR, NULL) + } else { + call strcpy (skyname, Memc[fname], SZ_FNAME) + call skb_wmap (Memc[fname], im, SKB_SKYS(skb), + SKB_NCBLK(skb), SKB_NLBLK(skb), SKB_NCPIX(skb), + SKB_NLPIX(skb), INDEFR, logfd) + } + tmp = skymap + iferr (skymap = map_open (Memc[fname], im)) + skymap = NULL + if (skymap == NULL) { + skymap = tmp + call error (1, "Could not update sky") + } + call map_close (tmp) + if (skyname[1] == EOS) + call map_seti (skymap, "delete", YES) + } + + if (dosig) { + sigdebug = false + if (sigdebug) + call skb_wmap ("sigdebug.fits", im, SKB_SIGS(skb), + SKB_NCSBLK(skb), SKB_NLSBLK(skb), SKB_NCSPIX(skb), + SKB_NLSPIX(skb), 0., NULL) + + # Grow subblocks contaminated by large objects. + call skb_grow (SKB_SIGS(skb), SKB_NCSBLK(skb), SKB_NLSBLK(skb), + SKB_GROW(skb)) + + if (sigdebug) + call skb_wmap ("sigdebug.fits", im, SKB_SIGS(skb), + SKB_NCSBLK(skb), SKB_NLSBLK(skb), SKB_NCSPIX(skb), + SKB_NLSPIX(skb), 0., NULL) + + # Merge sky sigma from subblocks and interpolate missing regions. + call skb_merge (Memr[SKB_SIGS(skb)], SKB_NCSBLK(skb), + SKB_NLSBLK(skb), Memr[SKB_SIGS(skb)], SKB_NCBLK(skb), + SKB_NLBLK(skb)) + + # Write block maps and map them with the MAPIO interface. + # If no name is given then use a temporary image. + if (signame[1] == EOS) { + call mktemp ("tmpsig", Memc[fname], SZ_FNAME) + call skb_wmap (Memc[fname], im, SKB_SIGS(skb), + SKB_NCBLK(skb), SKB_NLBLK(skb), SKB_NCPIX(skb), + SKB_NLPIX(skb), INDEFR, NULL) + } else { + call strcpy (signame, Memc[fname], SZ_FNAME) + call skb_wmap (Memc[fname], im, SKB_SIGS(skb), + SKB_NCBLK(skb), SKB_NLBLK(skb), SKB_NCPIX(skb), + SKB_NLPIX(skb), INDEFR, logfd) + } + tmp = sigmap + iferr (sigmap = map_open (Memc[fname], im)) + sigmap = NULL + if (sigmap == NULL) { + sigmap = tmp + call error (1, "Could not update sky sigma") + } + call map_close (tmp) + if (signame[1] == EOS) + call map_seti (sigmap, "delete", YES) + } + + call sfree (sp) +end + + +# SKB_GROW -- Grow around subblocks with insufficient data. + +procedure skb_grow (sky, nc, nl, grow) + +pointer sky # Pointer to real sky array to be grown +int nc, nl # Size of sky array +real grow # Grow radius + +int i, j, k, l1, l2, ngrow, nbufs +real grow2, val1, val2, y2 +pointer buf, buf1, buf2, ptr +errchk calloc + +begin + # Initialize. + ngrow = int (grow) + grow2 = grow * grow + nbufs = min (1 + 2 * ngrow, nl) + call calloc (buf, nc*nbufs, TY_REAL) + + l1 = 1; l2 = 1 + while (l1 <= nl) { + buf1 = sky + (l1 - 1) * nc + buf2 = buf + mod (l1, nbufs) * nc + do i = 1, nc { + val1 = Memr[buf1] + val2 = Memr[buf2] + if (IS_INDEFR(val1)) { + do j = max(1,l1-ngrow), min (nl,l1+ngrow) { + ptr = buf + mod (j, nbufs) * nc - 1 + y2 = (j - l1) ** 2 + do k = max(1,i-ngrow), min (nc,i+ngrow) { + if ((k-i)**2 + y2 > grow2) + next + Memr[ptr+k] = INDEFR + } + } + } else if (!IS_INDEFR(val2)) + Memr[buf2] = val1 + buf1 = buf1 + 1 + buf2 = buf2 + 1 + } + + if (l1 > ngrow) { + while (l2 <= nl) { + buf1 = sky + (l2 - 1) * nc + buf2 = buf + mod (l2, nbufs) * nc + do i = 1, nc { + Memr[buf1] = Memr[buf2] + Memr[buf2] = 0 + buf1 = buf1 + 1 + buf2 = buf2 + 1 + } + l2 = l2 + 1 + if (l1 != nl) + break + } + } + l1 = l1 + 1 + } + + call mfree (buf, TY_REAL) +end + + +# SKB_MERGE -- Merge subblock into blocks. +# Use average of subblocks with minimum and maximum excluded. + +procedure skb_merge (in, ncin, nlin, out, ncout, nlout) + +real in[ncin,nlin] +int ncin, nlin +real out[ncout,nlout] +int ncout, nlout + +int ncs, nls +int i, i1, i2, iout, j, j1, j2, jout, n, nindef +real val, sum, minval, maxval +pointer work + +begin + # Number of input subblocks per output block. + ncs = nint (real (ncin) / ncout) + nls = nint (real (nlin) / nlout) + + nindef = 0 + j2 = 0; jout = 0 + do j1 = 1, nlin, nls { + jout = jout + 1 + j2 = min (nlin, j2 + nls) + i2 = 0; iout = 0 + do i1 = 1, ncin, ncs { + iout = iout + 1 + i2 = min (ncin, i2 + ncs) + + n = 0 + sum = 0. + minval = MAX_REAL + maxval = -MAX_REAL + do j = j1, j2 { + do i = i1, i2 { + if (IS_INDEFR(in[i,j])) + next + val = in[i,j] + sum = sum + val + minval = min (val, minval) + maxval = max (val, maxval) + n = n + 1 + } + } + if (n > 2) + out[iout,jout] = (sum - minval - maxval) / (n - 2) + else if (n >= min (ncs, nls)) + out[iout,jout] = sum / n + else { + out[iout,jout] = INDEFR + nindef = nindef + 1 + } + } + } + + # Interpolate to fill in blocks with no sky data. + if (nindef > 0) { + call malloc (work, ncout*nlout, TY_REAL) + call interp2 (out, Memr[work], ncout, nlout) + call amovr (Memr[work], out, ncout*nlout) + call mfree (work, TY_REAL) + } +end + + +## SKB_ESTIMATE -- Estimate of sky in block from subblocks. +## Use order selection. +# +#procedure skb_merge (in, ncin, nlin, out, ncout, nlout, select) +# +#real in[ncin,nlin] +#int ncin, nlin +#real out[ncout,nlout] +#int ncout, nlout +#real select # Selection fraction +# +#int ncs, nls +#int i, i1, i2, iout, j, j1, j2, jout, n, nindef, nselect +#pointer sp, work, ptr +#real asokr() +# +#begin +# # Number of input subblocks per output block. +# ncs = nint (real (ncin) / ncout) +# nls = nint (real (nlin) / nlout) +# +# call smark (sp) +# call salloc (work, ncs*nls, TY_REAL) +# +# nindef = 0 +# j2 = 0; jout = 0 +# do j1 = 1, nlin, nls { +# jout = jout + 1 +# j2 = min (nlin, j2 + nls) +# i2 = 0; iout = 0 +# do i1 = 1, ncin, ncs { +# iout = iout + 1 +# i2 = min (ncin, i2 + ncs) +# ptr = work +# do j = j1, j2 { +# do i = i1, i2 { +# if (IS_INDEFR(in[i,j])) +# next +# Memr[ptr] = in[i,j] +# ptr = ptr + 1 +# } +# } +# n = ptr - work +# if (n >= min (ncs, nls)) { +# nselect = nint (select * (n - 1)) + 1 +# out[iout,jout] = asokr (Memr[work], n, nselect) +# } else { +# out[iout,jout] = INDEFR +# nindef = nindef + 1 +# } +# } +# } +# +# # Interpolate to fill in blocks with no sky data. +# if (nindef > 0) { +# call salloc (work, ncout*nlout, TY_REAL) +# call interp2 (out, Memr[work], ncout, nlout) +# call amovr (Memr[work], out, ncout*nlout) +# } +# +# call sfree (sp) +#end + + +# SKB_WMAP -- Write map from block data. + +procedure skb_wmap (name, imref, data, ncblk, nlblk, ncpix, nlpix, blank, logfd) + +char name[ARB] #I Output name +pointer imref #I Reference image pointer +pointer data #I Block image data +int ncblk, nlblk #I Block image dimensions +int ncpix, nlpix #I Number of reference image pixels per block +real blank #I Blank value +int logfd #I Log file descriptor + +bool strne() +int i, j, imaccess(), strlen(), stridxs() +real a[2] +pointer sp, title, str +pointer im, mw, buf, immap(), impl2r(), mw_openim() +errchk immap, imrename + +begin + call smark (sp) + call salloc (title, SZ_IMTITLE, TY_CHAR) + call salloc (str, SZ_FNAME, TY_CHAR) + + # Create title for new image or to check for updating. + call sprintf (Memc[title], SZ_IMTITLE, "Sky for ") + i = strlen (Memc[title]) + call imstats (imref, IM_IMAGENAME, Memc[title+i], SZ_IMTITLE-i) + + iferr { + im = NULL; mw = NULL + +# # Check for existing image and rename. +# if (imaccess (name, 0) == YES) { +# j = strlen (name) +# call malloc (fname, j+SZ_FNAME, TY_CHAR) +# i = strldxs (".", name) - 1 +# if (i < 0) +# i = j +# do j = 1, ARB { +# call strcpy (name, Memc[fname], i) +# call sprintf (Memc[fname+i], SZ_FNAME, "%d%s") +# call pargi (j) +# call pargstr (name[i+1]) +# if (imaccess (Memc[fname], 0) == YES) +# next +# call imrename (name, Memc[fname]) +# break +# } +# call mfree (fname, TY_CHAR) +# } + + if (imaccess (name, 0) == NO) { + if (logfd != NULL) { + call strcpy (name, Memc[str], SZ_FNAME) + i = stridxs (",", Memc[str]) + if (i > 0) { + Memc[str+i-1] = ']' + Memc[str+i] = EOS + } + call fprintf (logfd, " Write sky map: %s\n") + call pargstr (Memc[str]) + } + buf = immap (name, NEW_COPY, imref); im = buf + IM_PIXTYPE(im) = TY_REAL + IM_LEN(im,1) = ncblk + IM_LEN(im,2) = nlblk + call strcpy (Memc[title], IM_TITLE(im), SZ_IMTITLE) + iferr (call imdelf (im, "BPM")) + ; + iferr (call imdelf (im, "DATASEC")) + ; + iferr (call imdelf (im, "TRIMSEC")) + ; + + do i = 1, nlblk { + buf = impl2r(im,i) + call amovr (Memr[data+(i-1)*ncblk], Memr[buf], ncblk) + if (!IS_INDEFR(blank)) { + do j = 1, ncblk + if (IS_INDEFR(Memr[buf+j-1])) + Memr[buf+j-1] = blank + } + } + + # Update the WCS. + mw = mw_openim (imref) + a[1] = 1. / ncpix + a[2] = 1. / nlpix + call mw_scale (mw, a, 3) + a[1] = 0.5 + a[2] = 0.5 + call mw_shift (mw, a, 3) + call mw_saveim (mw, im) + } else { + if (logfd != NULL) { + call strcpy (name, Memc[str], SZ_FNAME) + i = stridxs (",", Memc[str]) + if (i > 0) { + Memc[str+i-1] = ']' + Memc[str+i] = EOS + } + call fprintf (logfd, " Update sky map: %s\n") + call pargstr (Memc[str]) + } + buf = immap (name, READ_WRITE, 0); im = buf + if (strne (IM_TITLE(im), Memc[title]) || + IM_LEN(im,1) != ncblk || IM_LEN(im,2) != nlblk) + call error (1, "Cannot update sky map") + + do i = 1, nlblk { + buf = impl2r(im,i) + call amovr (Memr[data+(i-1)*ncblk], Memr[buf], ncblk) + if (!IS_INDEFR(blank)) { + do j = 1, ncblk + if (IS_INDEFR(Memr[buf+j-1])) + Memr[buf+j-1] = blank + } + } + } + } then + call erract (EA_WARN) + + if (mw != NULL) + call mw_close (mw) + if (im != NULL) + call imunmap (im) + call sfree (sp) +end + + +# INTERP2 -- Interpolate 2D array by averaging 1D interpolations along lines +# and columns. It is an error if there is no data to interpolate. + +procedure interp2 (in, out, nc, nl) + +real in[nc,nl] # Input data +real out[nc,nl] # Output data (not the same as input) +int nc, nl # Size of data + +int i, j, k1, k2, nerr +pointer sp, flags, buf + +begin + call smark (sp) + call salloc (flags, nl, TY_INT) + call salloc (buf, nl, TY_REAL) + + call amovki (OK, Memi[flags], nl) + + # Interpolate along lines. Flag lines with no data. + nerr = 0 + do i = 1, nl + iferr (call interp1 (in[1,i], out[1,i], nc)) { + Memi[flags+i-1] = ERR + nerr = nerr + 1 + } + + if (nerr == nl) + call error (1, "No data to interpolate") + + # Interpolate along columns. Check for columns and lines with no data. + do j = 1, nc { + do i = 1, nl + Memr[buf+i-1] = in[j,i] + + ifnoerr (call interp1 (Memr[buf], Memr[buf], nl)) { + do i = 1, nl { + if (Memi[flags+i-1] == OK) + out[j,i] = (out[j,i] + Memr[buf+i-1]) / 2. + else + out[j,i] = Memr[buf+i-1] + } + } else { + do i = 1, nl { + if (Memi[flags+i-1] == ERR) { + # Find nearest line with good data. + do k1 = i-1, 1, -1 + if (Memi[flags+k1-1] == OK) + break + do k2 = i+1, nl + if (Memi[flags+k2-1] == OK) + break + if (k1 >= 1 & k2 <= nl) { + if (i - k1 < k2 - i) + out[j,i] = out[j,k1] + else + out[j,i] = out[j,k2] + } else if (k1 >= 1) + out[j,i] = out[j,k1] + else if (k2 <= nl) + out[j,i] = out[j,k2] + } + } + } + } + call sfree (sp) +end + + +# INTERP1 -- Interpolate 1D vectors. +# An error is generated if there is no data to interpolate. + +procedure interp1 (in, out, npts) + +real in[npts] # Input line +real out[npts] # Output line (may be the same as input) +int npts # Number of points in line + +int i, i1, i2, j +real v, v1, dv + +begin + i1 = 0 + i2 = 1 + do i = 1, npts { + v = in[i] + if (IS_INDEFR(v)) + next + if (i > i2) { + if (i1 > 0) { + dv = (v - v1) / (i - i1) + do j = i2, i-1 + out[j] = v + dv * (j - i) + } else { + do j = i2, i-1 + out[j] = v + } + } + out[i] = v + v1 = v + i1 = i + i2 = i1+1 + } + + if (i1 == 0) + call error (1, "No data to interpolate") + else if (i2 <= npts) { + do j = i2, npts + out[j] = v1 + } + +end diff --git a/noao/nproto/ace/skyfit.h b/noao/nproto/ace/skyfit.h new file mode 100644 index 00000000..585d1c95 --- /dev/null +++ b/noao/nproto/ace/skyfit.h @@ -0,0 +1,24 @@ +# Sky surface algorithm definitions. + +define SKF_LEN 16 # Length of parameter structure +define SKF_STRLEN 9 # Length of string + +define SKF_STEP Memr[P2R($1)] # Number of sky lines to sample +define SKF_LMIN Memr[P2R($1+1)] # Minimum number of lines to fit +define SKF_FUNC1D Memi[$1+2] # 1D Fitting function +define SKF_FUNC2D Memi[$1+3] # 2D Fitting function +define SKF_XORDER Memi[$1+4] # Sky fitting x order +define SKF_YORDER Memi[$1+5] # Sky fitting y order +define SKF_XTERMS Memi[$1+6] # Sky fitting cross terms +define SKF_BLK1D Memi[$1+7] # Sky block size for 1D averages +define SKF_HCLIP Memr[P2R($1+8)] # Sky fitting high sigma clip +define SKF_LCLIP Memr[P2R($1+9)] # Sky fitting low sigma clip +define SKF_NITER Memi[$1+10] # Number of iterations +define SKF_STR Memc[P2C($1+11)] # String + + +define SKFLMIN 10 # Minimum number of lines to fit +define SKFFUNC1D "chebyshev" # 1D fitting function +define SKFFUNC2D "chebyshev" # 2D fitting function +define SKFXTERMS "half" # Cross terms +define SKFNITER 5 # Number of iterations diff --git a/noao/nproto/ace/skyfit.x b/noao/nproto/ace/skyfit.x new file mode 100644 index 00000000..0b295e8e --- /dev/null +++ b/noao/nproto/ace/skyfit.x @@ -0,0 +1,393 @@ +include <imhdr.h> +include <math/curfit.h> +include <math/gsurfit.h> +include "skyfit.h" + + +# SKY_FIT -- Fit sky surface. +# +# Compute a sky and/or sky sigma surface fit using a subset of the input +# lines. the input sky and sky sigma pointers are NULL. The initial data +# for the surface fit is measured at a subset of lines with any masked +# pixels excluded. Objects are removed by fitting a 1D curve to each line, +# rejection points with large residuals and iterating until only sky is left. +# The sky points are then accumulated for a 2D surface fit and the residuals +# are added to a histogram. The absolute deviations, scaled by 0.7979 to +# convert to an gausian sigma, are accumulated for a sky sigma surface fit. +# After all the sample lines are accumulated the surface fits are computed. +# The histogram of residuals is then fit by a gaussian to estimate an +# offset from the sky fit to the sky mode caused by unrejected object light. +# The offset is applied to the sky surface. + +procedure sky_fit (par, dosky, dosig, im, bpm, expmap, skyname, signame, + skymap, sigmap, logfd) + +pointer par #U Sky parameters +bool dosky #I Compute sky +bool dosig #I Compute sigma +pointer im #I Input image +pointer bpm #I Input mask +pointer expmap #I Exposure map +char skyname[ARB] #I Sky map name +char signame[ARB] #I Sigma map name +pointer skymap #U Sky map +pointer sigmap #U Sigma map +int logfd #I Verbose? + +# Parameters +real step # Line sample step +int lmin # Minimum number of lines to fit +int func1d # 1D fitting function +int func2d # 2D fitting function +int xorder # Sky fitting x order +int yorder # Sky fitting y order +int xterms # Sky fitting cross terms +int blk1d # Block average +real hclip # Sky fitting high sigma clip +real lclip # Sky fitting low sigma clip +int niter # Number of clipping iterations + +int l1, l2 +int i, j, c, l, n, nc, nl, nskyblk, ier +real res, sigma +pointer sp, x, y, z, r, a, x1, w1, w2, skydata, sigdata, expdata, w, ptr +pointer cvsky, cvsig, gssky, gssig + +pointer imgl2r(), imgl2i(), map_opengs(), map_glr() +bool im_pmlne2() +real amedr() +errchk map_opengs, map_glr + +begin + if (!(dosky||dosig)) + return + + # Set parameters. + if (par == NULL) + call skf_pars ("open", "", par) + step = SKF_STEP(par) + lmin = SKF_LMIN(par) + xorder = SKF_XORDER(par) + yorder = SKF_YORDER(par) + xterms = SKF_XTERMS(par) + blk1d = SKF_BLK1D(par) + hclip = SKF_HCLIP(par) + lclip = SKF_LCLIP(par) + func1d = SKF_FUNC1D(par) + func2d = SKF_FUNC2D(par) + niter = SKF_NITER(par) + + nc = IM_LEN(im,1) + nl = IM_LEN(im,2) + l1 = 1 + step / 2 + l2 = nl - step / 2 + step = real (l2-l1) / max (nint((l2-l1)/step),xorder+2,lmin) + + if (logfd != NULL) { + if (dosky && dosig) + call fprintf (logfd, + " Determine sky and sigma by surface fits:\n") + else if (dosky) + call fprintf (logfd, " Determine sky by surface fit:\n") + else + call fprintf (logfd, " Determine sigma by surface fit:\n") + call fprintf (logfd, + " start line = %d, end line = %d, step = %.1f\n") + call pargi (l1) + call pargi (l2) + call pargr (step) + call fprintf (logfd, + " xorder = %d, yorder = %d, xterms = %s\n") + call pargi (xorder) + call pargi (yorder) + switch (xterms) { + case GS_XNONE: + call pargstr ("none") + case GS_XFULL: + call pargstr ("full") + case GS_XHALF: + call pargstr ("half") + } + call fprintf (logfd, " hclip = %g, lclip = %g\n") + call pargr (hclip) + call pargr (lclip) + } + + # Allocate memory and initialize. + call smark (sp) + call salloc (x1, nc, TY_REAL) + call salloc (w1, nc, TY_REAL) + call salloc (w2, nc, TY_REAL) + + nskyblk = nc / blk1d + call salloc (x, nskyblk, TY_REAL) + call salloc (y, nskyblk, TY_REAL) + call salloc (z, nskyblk, TY_REAL) + call salloc (r, nskyblk, TY_REAL) + call salloc (a, nskyblk, TY_REAL) + call salloc (skydata, nskyblk, TY_REAL) + call salloc (sigdata, nskyblk, TY_REAL) + if (expmap != NULL) + call salloc (expdata, nskyblk, TY_REAL) + + do c = 1, nc + Memr[x1+c-1] = c + call amovkr (1., Memr[w1], nc) + + # Initialize the 1D and 2D fitting pointers as needed. + if (dosky) { + call cvinit (cvsky, func1d, xorder, Memr[x1], + Memr[x1+nc-1]) + call gsinit (gssky, func2d, xorder, yorder, + xterms, 1., real(nc), 1., real(nl)) + } + if (dosig) { + call cvinit (cvsig, CHEBYSHEV, 1, Memr[x1], Memr[x1+nc-1]) + call gsinit (gssig, GS_CHEBYSHEV, 1, 1, xterms, + 1., real(nc), 1., real(nl)) + } + + # For each sample line find sky points by 1D fitting and sigma + # rejection and then accumulate 2D surface fitting points. + do j = 0, ARB { + l = nint (l1 + j * step) + if (l > l2) + break + + # Get input data and block average. + if (bpm == NULL) + w = w1 + else if (!im_pmlne2 (bpm, l)) + w = w1 + else { + w = imgl2i (bpm, l) + n = nc + do c = 0, nc-1 { + if (Memi[w+c] != 0) { + Memr[w2+c] = 0 + n = n - 1 + } else + Memr[w2+c] = Memr[w1+c] + } + w = w2 + if (n < 10) + next + } + + # Block average. + if (skymap != NULL) { + ptr = map_glr (skymap, l, READ_ONLY) + call blkavg1 (Memr[ptr], Memr[w], nc, Memr[skydata], + nskyblk, blk1d) + } + if (expmap != NULL) { + ptr = map_glr (expmap, l, READ_ONLY) + call blkavg1 (Memr[ptr], Memr[w], nc, Memr[expdata], + nskyblk, blk1d) + } + if (sigmap != NULL) { + ptr = map_glr (sigmap, l, READ_ONLY) + call blkavg1 (Memr[ptr], Memr[w], nc, Memr[sigdata], + nskyblk, blk1d) + call adivkr (Memr[sigdata], sqrt(real(blk1d)), Memr[sigdata], + nskyblk) + if (expmap != NULL) + call expsigma (Memr[sigdata], Memr[expdata], nskyblk, 0) + } + call blkavg (Memr[x1], Memr[imgl2r(im,l)], Memr[w], nc, + Memr[x], Memr[z], Memr[w2], nskyblk, blk1d) + w = w2 + + # Iterate using line fitting. + do i = 1, niter { + + # Fit sky. + if (dosky) { + call cvfit (cvsky, Memr[x], Memr[z], Memr[w], nskyblk, + WTS_USER, ier) + if (ier == NO_DEG_FREEDOM) + call error (1, "Fitting error") + call cvvector (cvsky, Memr[x], Memr[skydata], nskyblk) + } + + # Compute residuals. + call asubr (Memr[z], Memr[skydata], Memr[r], nskyblk) + + # Fit sky sigma. + if (dosig) { + do c = 0, nskyblk-1 + Memr[a+c] = abs(Memr[r+c]) / 0.7979 + if (expmap != NULL) + call expsigma (Memr[a], Memr[expdata], nskyblk, 1) + if (i == 1) + call amovkr (amedr(Memr[a],nskyblk), Memr[sigdata], + nskyblk) + else { + call cvfit (cvsig, Memr[x], Memr[a], Memr[w], nskyblk, + WTS_USER, ier) + if (ier == NO_DEG_FREEDOM) + call error (1, "Fitting error") + call cvvector (cvsig, Memr[x], Memr[sigdata], nskyblk) + } + if (expmap != NULL) + call expsigma (Memr[sigdata], Memr[expdata], nskyblk, 0) + } + + # Reject deviant points. + n = 0 + do c = 0, nskyblk-1 { + if (Memr[w+c] == 0.) + next + res = Memr[r+c] + sigma = Memr[sigdata+c] + if (res > hclip * sigma || res < -lclip * sigma) { + Memr[w+c] = 0. + n = n + 1 + } + } + if (n == 0) { + if (i == 1 && dosig) { + call cvfit (cvsig, Memr[x], Memr[a], Memr[w], nskyblk, + WTS_USER, ier) + if (ier == NO_DEG_FREEDOM) + call error (1, "Fitting error") + } + break + } + } + + # Accumulate the sky data for the line. + call amovkr (real(l), Memr[y], nskyblk) + if (dosky && dosig) { + call amulkr (Memr[a], sqrt(real(blk1d)), Memr[a], nskyblk) + call gsacpts (gssky, Memr[x], Memr[y], Memr[z], Memr[w], + nskyblk, WTS_USER) + call gsacpts (gssig, Memr[x], Memr[y], Memr[a], Memr[w], + nskyblk, WTS_USER) + } else if (dosky) { + call gsacpts (gssky, Memr[x], Memr[y], Memr[z], Memr[w], + nskyblk, WTS_USER) + } else { + call amulkr (Memr[a], sqrt(real(blk1d)), Memr[a], nskyblk) + call gsacpts (gssig, Memr[x], Memr[y], Memr[a], + Memr[w], nskyblk, WTS_USER) + } + } + + # Compute the surface fits, store in header, and set output pointers. + if (dosky) { + if (skymap != NULL) + call map_close (skymap) + call cvfree (cvsky) + call gssolve (gssky, ier) + if (ier == NO_DEG_FREEDOM) + call error (1, "Fitting error") + if (skyname[1] != EOS) + call mgs_pgs (im, skyname, gssky) + skydata = map_opengs (gssky, im); skymap = skydata + } + if (dosig) { + if (sigmap != NULL) + call map_close (sigmap) + call cvfree (cvsig) + call gssolve (gssig, ier) + if (ier == NO_DEG_FREEDOM) + call error (1, "Fitting error") + if (signame[1] != EOS) + call mgs_pgs (im, signame, gssig) + sigdata = map_opengs (gssig, im); sigmap = sigdata + } + + call sfree (sp) +end + + +procedure blkavg (xin, yin, win, nin, xout, yout, wout, nout, blksize) + +real xin[nin] #I Input values +real yin[nin] #I Input values +real win[nin] #I Input weights +int nin #I Number of input values +real xout[nout] #O Output values +real yout[nout] #O Output values +real wout[nout] #O Output weights +int nout #O Number of output values +int blksize #I Block size + +int i, j, n, imax +real xavg, yavg, wsum, w + +begin + if (blksize == 1) { + nout = nin + call amovr (xin, xout, nout) + call amovr (yin, yout, nout) + call amovr (win, wout, nout) + return + } + + n = blksize + imax = nin - 2 * blksize + 1 + nout = 0 + for (i=1; i<=nin; ) { + if (i > imax) + n = nin - i + 1 + xavg = 0. + yavg = 0. + wsum = 0. + do j = 1, n { + w = win[i] + xavg = xavg + w * xin[i] + yavg = yavg + w * yin[i] + wsum = wsum + w + i = i + 1 + } + if (wsum > 0.) { + nout = nout + 1 + xout[nout] = xavg / wsum + yout[nout] = yavg / wsum + wout[nout] = wsum + } + } +end + + +procedure blkavg1 (in, win, nin, out, nout, blksize) + +real in[nin] #I Input values +real win[nin] #I Input weights +int nin #I Number of input values +real out[nout] #O Output values +int nout #O Number of output values +int blksize #I Block size + +int i, j, n, imax +real avg, wsum, w + +begin + if (blksize == 1) { + nout = nin + call amovr (in, out, nout) + return + } + + n = blksize + imax = nin - 2 * blksize + 1 + nout = 0 + for (i=1; i<=nin; ) { + if (i > imax) + n = nin - i + 1 + avg = 0. + wsum = 0. + do j = 1, n { + w = win[i] + avg = avg + w * in[i] + wsum = wsum + w + i = i + 1 + } + if (wsum > 0.) { + nout = nout + 1 + out[nout] = avg / wsum + } + } +end diff --git a/noao/nproto/ace/skygrow.xNEW b/noao/nproto/ace/skygrow.xNEW new file mode 100644 index 00000000..8c78a4bc --- /dev/null +++ b/noao/nproto/ace/skygrow.xNEW @@ -0,0 +1,89 @@ +include <imhdr.h> + +task skygrow = t_skygrow + +procedure t_skygrow () + +int nc, nl +pointer im, sky, immap(), imps2r(), imgs2r() + +begin + im = immap ("skyblk", READ_WRITE, 0) + nc = IM_LEN(im,1) + nl = IM_LEN(im,2) + sky = imps2r (im, 1, nc, 1, nl) + call amovr (Memr[imgs2r(im,1,nc,1,nl)], Memr[sky], nc*nl) + call skygrow (sky, nc, nl, 1.5, 0.) + call imunmap (im) +end + + +procedure skygrow (sky, nc, nl, grow, growval) + +pointer sky # Pointer tor eal sky array to be grown +int nc, nl # Size of sky array +real grow # Grow radius +real growval # Value to be grown + +int i, j, k, l1, l2, ngrow, nbufs +real grow2, growval1, val1, val2, y2 +pointer buf, buf1, buf2, ptr +errchk calloc + +begin + # Initialize. + ngrow = int (grow) + grow2 = grow * grow + nbufs = min (1 + 2 * ngrow, nl) + if (growval == 0.) { + growval1 = 1. + call malloc (buf, nc*nbufs, TY_REAL) + call amovkr (growval1, Memr[buf], nc*nbufs) + } else { + growval1 = 0. + call calloc (buf, nc*nbufs, TY_REAL) + } + + l1 = 1; l2 = 1 + while (l1 <= nl) { + buf1 = sky + (l1 - 1) * nc + buf2 = buf + mod (l1, nbufs) * nc + do i = 1, nc { + val1 = Memr[buf1] + val2 = Memr[buf2] + if (val1 == growval) { + do j = max(1,l1-ngrow), min (nl,l1+ngrow) { + ptr = buf + mod (j, nbufs) * nc - 1 + y2 = (j - l1) ** 2 + do k = max(1,i-ngrow), min (nc,i+ngrow) { + if ((k-i)**2 + y2 > grow2) + next + Memr[ptr+k] = growval + } + } + } else if (val2 != growval) + Memr[buf2] = val1 + buf1 = buf1 + 1 + buf2 = buf2 + 1 + } + + if (l1 > ngrow) { + while (l2 <= nl) { + buf1 = sky + (l2 - 1) * nc + buf2 = buf + mod (l2, nbufs) * nc + do i = 1, nc { + Memr[buf1] = Memr[buf2] + Memr[buf2] = growval1 + buf1 = buf1 + 1 + buf2 = buf2 + 1 + } + l2 = l2 + 1 + if (l1 != nl) + break + } + } + l1 = l1 + 1 + } + + call mfree (buf, TY_REAL) +end diff --git a/noao/nproto/ace/skyimages.par b/noao/nproto/ace/skyimages.par new file mode 100644 index 00000000..a1458d39 --- /dev/null +++ b/noao/nproto/ace/skyimages.par @@ -0,0 +1,10 @@ +# SKYIMAGES + +images,f,a,,,,"List of images" +skyimages,f,a,,,,"List of output sky images" +sigmaimages,f,a,,,,"List of output sigma images" +skys,s,h,"",,,"List of sky maps" +sigmas,s,h,"",,,"List of sigma maps" +exps,s,h,"",,,"List of exposure maps" +gains,s,h,"",,,"List of gain maps" +logfiles,s,h,"STDOUT",,,"List of log files" diff --git a/noao/nproto/ace/skyimages.x b/noao/nproto/ace/skyimages.x new file mode 100644 index 00000000..899fc5da --- /dev/null +++ b/noao/nproto/ace/skyimages.x @@ -0,0 +1,120 @@ +include <error.h> +include <imhdr.h> + + +# SKYIMAGES -- Write out sky images. + +procedure skyimages (outsky, outsig, im, skymap, sigmap, gainmap, expmap, logfd) + +char outsky[ARB] #I Output sky image name +char outsig[ARB] #I Output sigma image name +pointer im #I Image pointer +pointer skymap #I Sky map +pointer sigmap #I Sigma map +pointer gainmap #I Gain map +pointer expmap #I Exposure map +int logfd #I Logfile + +int l, nc, nl +pointer skyim, sigim, data, skydata, ssigdata, gaindata, expdata, sigdata, ptr + +pointer immap(), imgl2r(), impl2r(), map_glr() +errchk immap, map_glr + +begin + # Return no output is needed. + if (outsky[1] == EOS && outsig[1] == EOS) + return + + # Write log information. + if (logfd != NULL) { + call fprintf (logfd, " Output sky images:") + if (outsky[1] != EOS) { + call fprintf (logfd, " sky = %s") + call pargstr (outsky) + } + if (outsig[1] != EOS) { + call fprintf (logfd, " sigma = %s") + call pargstr (outsig) + } + call fprintf (logfd, "\n") + } + + iferr { + skyim = NULL; sigim = NULL + + # Map output image(s) + if (outsky[1] != EOS) { + ptr = immap (outsky, NEW_COPY, im) + skyim = ptr + } + if (outsig[1] != EOS) { + ptr = immap (outsig, NEW_COPY, im) + sigim = ptr + } + + # Output the sky image data. + nc = IM_LEN(im,1) + nl = IM_LEN(im,2) + do l = 1, nl { + data = NULL + skydata = NULL + if (skyim != NULL) { + skydata = map_glr (skymap, l, READ_ONLY) + call amovr (Memr[skydata], Memr[impl2r(skyim,l)], nc) + } + if (sigim != NULL) { + ssigdata = map_glr (sigmap, l, READ_ONLY) + if (gainmap == NULL && expmap == NULL) + sigdata = ssigdata + else if (expmap == NULL) { + if (data == NULL) + data = imgl2r (im, l) + if (skydata == NULL) + skydata = map_glr (skymap, l, READ_ONLY) + gaindata = map_glr (gainmap, l, READ_ONLY) + call noisemodel (Memr[data], Memr[skydata], + Memr[ssigdata], Memr[gaindata], INDEFR, + Memr[sigdata], nc) + } else if (gainmap == NULL) { + expdata = map_glr (expmap, l, READ_WRITE) + call noisemodel (Memr[expdata], Memr[expdata], + Memr[ssigdata], INDEFR, Memr[expdata], + Memr[sigdata], nc) + } else { + if (data == NULL) + data = imgl2r (im, l) + if (skydata == NULL) + skydata = map_glr (skymap, l, READ_ONLY) + gaindata = map_glr (gainmap, l, READ_ONLY) + expdata = map_glr (expmap, l, READ_WRITE) + call noisemodel (Memr[data], Memr[skydata], + Memr[ssigdata], Memr[gaindata], + Memr[expdata], Memr[sigdata], nc) + } + if (skyim != NULL) + call amovr (Memr[sigdata], Memr[impl2r(sigim,l)], nc) + } + } + + # Finish up. + if (skyim != NULL) + call imunmap (skyim) + if (sigim != NULL) + call imunmap (sigim) + } then { + call erract (EA_WARN) + + # Close and delete output images on an errror. + if (skyim != NULL) { + call imunmap (skyim) + iferr (call imdelete (outsky)) + ; + } + if (sigim != NULL) { + call imunmap (sigim) + iferr (call imdelete (outsig)) + ; + } + } +end diff --git a/noao/nproto/ace/split.h b/noao/nproto/ace/split.h new file mode 100644 index 00000000..db9589a1 --- /dev/null +++ b/noao/nproto/ace/split.h @@ -0,0 +1,13 @@ +# Detection parameter structure. +define SPT_LEN 10 # Length of parameter structure + +define SPT_NEIGHBORS Memi[$1] # Neighbor type +define SPT_SPLITMAX Memr[P2R($1+1)] # Maximum convolved sigma for splitting +define SPT_SPLITSTEP Memr[P2R($1+2)] # Minimum split step in convolved sigma +define SPT_SPLITTHRESH Memr[P2R($1+3)] # Transition convolved sigma +define SPT_MINPIX Memi[$1+4] # Minimum number of pixels +define SPT_SIGAVG Memr[P2R($1+5)] # Minimum average above sky in sigma +define SPT_SIGPEAK Memr[P2R($1+6)] # Minimum peak above sky in sigma +define SPT_SMINPIX Memi[$1+7] # Minimum number of split pixels +define SPT_SSIGAVG Memr[P2R($1+8)] # Minimum split avg above sky in sigma +define SPT_SSIGPEAK Memr[P2R($1+9)] # Minimum split peak above sky in sigma diff --git a/noao/nproto/ace/split.x b/noao/nproto/ace/split.x new file mode 100644 index 00000000..a0d564e4 --- /dev/null +++ b/noao/nproto/ace/split.x @@ -0,0 +1,625 @@ +include <pmset.h> +include <mach.h> +include "ace.h" +include "cat.h" +include "objs.h" +include "split.h" + + +# SPLIT - Split detected objects. +# +# Note that the sigma level map is modified and will be empty when done. + +procedure split (spt, cat, objmask, siglevel, siglevels, logfd) + +pointer spt #I Split parameters +pointer cat #U Catalog structure +pointer objmask #I Input and modified object mask +pointer siglevel #I Sigma level mask. +real siglevels[ARB] #I Sigma levels +int logfd #I Logfile + +int neighbors # Neighbor type +int dminpix # Minimum number of pixels for split object +int sminpix # Minimum number of split pixels +real sigavg # Minimum average above sky in sigma +real sigmax # Minimum peak above sky in sigma +real ssigavg # Minimum split average above sky in sigma +real ssigmax # Minimum split peak above sky in sigma +real splitmax # Maximum convolved sigma for splitting +real splitstep # Minimum split step in convolved sigma +real splitthresh # Transition convolved sigma + +int i, c, c1, c2, cs, clast, l, nc, nc1, nl +int level, nsobjs, navail, nalloc, nummax, val, num, pnum, oval, sval +long v[PM_MAXDIM] +real threshold +pointer sp, pnums, buf1, buf2, irl, orl, srl, outbuf, lastbuf +pointer objs, obj, splitmask, irlptr, orlptr, srlptr +pointer flags, ids, sobjs, links + +int andi(), ori() +bool pm_linenotempty() +pointer pm_create() + +begin + # Check for splitting map. + if (siglevel == NULL) + return + + # Set parameters. + call spt_pars ("open", "", spt) + + neighbors = SPT_NEIGHBORS(spt) + dminpix = SPT_MINPIX(spt) + sminpix = SPT_SMINPIX(spt) + sigavg = SPT_SIGAVG(spt) + sigmax = SPT_SIGPEAK(spt) + ssigavg = SPT_SSIGAVG(spt) + ssigmax = SPT_SSIGPEAK(spt) + splitmax = SPT_SPLITMAX(spt) + splitstep = SPT_SPLITSTEP(spt) + splitthresh = SPT_SPLITTHRESH(spt) + + if (logfd != NULL) { + call fprintf (logfd, " Split objects: sminpix = %d\n") + call pargi (sminpix) + } + + if (IS_INDEFR(splitmax)) + splitmax = MAX_REAL + + call pm_gsize (objmask, c, v, l) + splitmask = pm_create (c, v, l) + nc = v[1] + nl = v[2] + + call smark (sp) + call salloc (pnums, nc, TY_INT) + call salloc (buf1, nc+2, TY_INT) + call salloc (buf2, nc+2, TY_INT) + call salloc (irl, 3+3*nc, TY_INT) + call salloc (orl, 3+3*nc, TY_INT) + call salloc (srl, 3+3*nc, TY_INT) + + navail = 2 * CAT_NUMMAX(cat) + call calloc (ids, navail, TY_INT) + call calloc (links, navail, TY_INT) + call calloc (sobjs, navail, TY_POINTER) + nalloc = 0 + + # Go through sigma levels. + do level = 1, ARB { + + # Check if sigma value is in splitting range. + threshold = siglevels[level] + if (threshold == 0.) + next + if (threshold > splitmax) + break + + # Initialize flags. + nummax = CAT_NUMMAX(cat) + objs = CAT_OBJS(cat) + call calloc (flags, nummax+1, TY_SHORT) + do l = NUMSTART, nummax { + obj = Memi[objs+l-1] + if (obj == NULL) + next + if (SPLIT(obj) || SINGLE(obj)) + next + if (OBJ_NPIX(obj) < 2 * sminpix) { + SETFLAG (obj, OBJ_SINGLE) + next + } + Mems[flags+l] = 1 + } + + # Clear the mask. + call pm_clear (splitmask) + + outbuf = NULL + nsobjs = NUMSTART - 1 + do l = 1, nl { + v[1] = 1 + v[2] = l + if (!pm_linenotempty (siglevel, v)) { + outbuf = NULL + next + } + + lastbuf = outbuf + if (lastbuf == buf1) + outbuf = buf2 + else + outbuf = buf1 + + # Get sigma level mask. + call pmglri (siglevel, v, Memi[irl], 0, nc, 0) + + # Get parent object mask. Skip end regions not in siglev mask. + i = Memi[irl] - 1 + cs = Memi[irl+3] + nc1 = Memi[irl+3*i] + Memi[irl+3*i+1] - cs + v[1] = cs + call pmglpi (objmask, v, Memi[pnums], 0, nc1, 0) + v[1] = 1 + + # Initialize output range lists. + orlptr = orl; Memi[orlptr] = 0 + srlptr = srl + 3; sval = 0 + clast = 0 + + call aclri (Memi[outbuf], nc+2) + irlptr = irl + do i = 2, Memi[irl] { + irlptr = irlptr + 3 + val = Memi[irlptr+2] + if (val < level) + next + c1 = Memi[irlptr] + c2 = c1 + Memi[irlptr+1] - 1 + do c = c1, c2 { + pnum = Memi[pnums+c-cs] + if (MSPLIT(pnum)) + next + pnum = MNUM (pnum) + if (Mems[flags+pnum] == 0) + next + + if (lastbuf == NULL) + call sadd (c+1, l, Memi[outbuf], INDEFI, nc+2, + Memi[ids], Memi[links], Memi[sobjs], + nsobjs, nalloc, pnum, siglevels[val], + threshold, neighbors, num) + else + call sadd (c+1, l, Memi[outbuf], Memi[lastbuf], + nc+2, Memi[ids], Memi[links], Memi[sobjs], + nsobjs, nalloc, pnum, siglevels[val], + threshold, neighbors, num) + + if (nalloc == navail) { + navail = max (100*nalloc*(nl+1)/l/100, nalloc+10000) + call realloc (ids, navail, TY_INT) + call realloc (links, navail, TY_INT) + call realloc (sobjs, navail, TY_POINTER) + } + + # Update split object mask. + if (num != oval || c != clast) { + Memi[orlptr+1] = clast - Memi[orlptr] + orlptr = orlptr + 3 + + oval = num + Memi[orlptr] = c + Memi[orlptr+2] = oval + } + + # Update sigma level mask. + if (val != sval || c != clast) { + if (sval > level) { + Memi[srlptr+1] = clast - Memi[srlptr] + srlptr = srlptr + 3 + } + + sval = val + if (sval > level) { + Memi[srlptr] = c + Memi[srlptr+2] = sval + } + } + + clast = c + 1 + } + } + + # Update masks. + i = 1 + (orlptr - orl) / 3 + if (i > 1) { + Memi[orlptr+1] = clast - Memi[orlptr] + Memi[orl] = i + Memi[orl+1] = nc + call pmplri (splitmask, v, Memi[orl], 0, nc, PIX_SRC) + } + + if (sval > level) { + Memi[srlptr+1] = clast - Memi[srlptr] + Memi[srl] = 1 + (srlptr - srl) / 3 + } else + Memi[srl] = (srlptr - srl) / 3 + Memi[srl+1] = nc + call pmplri (siglevel, v, Memi[srl], 0, nc, PIX_SRC) + } + if (nsobjs < NUMSTART) + break + + if (threshold <= splitthresh) + call srenum (cat, objmask, splitmask, Memi[ids], Memi[sobjs], + nsobjs, dminpix, sigavg, sigmax) + else + call srenum (cat, objmask, splitmask, Memi[ids], Memi[sobjs], + nsobjs, sminpix, ssigavg, ssigmax) + + # Reuse object structures. + nsobjs = nalloc + nalloc = NUMSTART-1 + do i = NUMSTART-1, nsobjs-1 { + obj = Memi[sobjs+i] + if (obj != NULL) { + Memi[sobjs+nalloc] = Memi[sobjs+i] + nalloc = nalloc + 1 + } + } + + call mfree (flags, TY_SHORT) + } + + do i = 0, nalloc-1 + call mfree (Memi[sobjs+i], TY_POINTER) + call mfree (ids, TY_INT) + call mfree (links, TY_INT) + call mfree (sobjs, TY_POINTER) + + call pm_close (splitmask) + + call sfree (sp) +end + + +# SPLITADD -- Add a pixel to the object list and set the mask value. + +procedure sadd (c, l, z, zlast, nc, ids, links, objs, nobjs, nalloc, + pnum, data, threshold, neighbors, num) + +int c, l #I Pixel coordinate +int z[nc] #I Pixel values for current line +int zlast[nc] #I Pixel values for last line +int nc #I Number of pixels in a line +int ids[ARB] #I Mask ids +int links[ARB] #I Link to other mask ids with same number +int objs[ARB] #I Object numbers +int nobjs #U Number of objects +int nalloc #U Number of allocated objects +int pnum #I Parent number +real data #I Approximate (I(convolved) - sky) / sigma(convolved) +real threshold #I Threshold above sky in sigma units +int neighbors #I Neighbor type +int num #O Assigned mask value. + +int i, num1, c1, c2 +real val +bool merge +pointer obj, obj1 + +begin + # Inherit number of a neighboring pixel. + num = INDEFI + merge = false + if (neighbors == 4) { + c1 = c - 1 + c2 = c + if (IS_INDEFI(zlast[1])) { + if (z[c1] >= NUMSTART) + num = z[c1] + } else { + if (z[c1] >= NUMSTART) { + num = z[c1] + merge = true + } else if (zlast[c] >= NUMSTART) + num = ids[zlast[c]] + } + } else { + c1 = c - 1 + c2 = c + 1 + if (IS_INDEFI(zlast[1])) { + if (z[c1] >= NUMSTART) + num = z[c1] + } else { + if (z[c1] >= NUMSTART) { + num = z[c1] + merge = true + } else if (zlast[c1] >= NUMSTART) + num = ids[zlast[c1]] + else if (zlast[c] >= NUMSTART) + num = ids[zlast[c]] + else if (zlast[c2] >= NUMSTART) + num = ids[zlast[c2]] + } + } + + # If no number assign a new number. + if (num == INDEFI) { + nobjs = nobjs + 1 + num = nobjs + ids[num] = num + links[num] = 0 + if (nalloc < nobjs) { + call malloc (objs[num], OBJ_DETLEN, TY_STRUCT) + nalloc = nobjs + OBJ_FLAGS(objs[num]) = 0 + } + obj = objs[num] + OBJ_PNUM(obj) = pnum + OBJ_XAP(obj) = 0. + OBJ_YAP(obj) = 0. + OBJ_FLUX(obj) = 0. + OBJ_NPIX(obj) = 0 + OBJ_ISIGAVG(obj) = 0. + OBJ_ISIGMAX(obj) = 0. + } + obj = objs[num] + + # Merge overlapping objects from previous line. + if (merge) { + i = zlast[c2] + if (i >= NUMSTART && num != ids[i]) { + num1 = ids[i] + + obj1 = objs[num1] + OBJ_XAP(obj) = OBJ_XAP(obj) + OBJ_XAP(obj1) + OBJ_YAP(obj) = OBJ_YAP(obj) + OBJ_YAP(obj1) + OBJ_FLUX(obj) = OBJ_FLUX(obj) + OBJ_FLUX(obj1) + OBJ_NPIX(obj) = OBJ_NPIX(obj) + OBJ_NPIX(obj1) + OBJ_ISIGAVG(obj) = OBJ_ISIGAVG(obj) + OBJ_ISIGAVG(obj1) + OBJ_ISIGMAX(obj) = max (OBJ_ISIGMAX(obj), OBJ_ISIGMAX(obj1)) + + i = num + while (links[i] != 0) + i = links[i] + links[i] = num1 + repeat { + i = links[i] + ids[i] = num + } until (links[i] == 0) + + nalloc = nalloc + 1 + objs[nalloc] = obj1 + objs[num1] = NULL + } + } + + z[c] = num + OBJ_NPIX(obj) = OBJ_NPIX(obj) + 1 + val = data - threshold + OBJ_XAP(obj) = OBJ_XAP(obj) + val * c1 + OBJ_YAP(obj) = OBJ_YAP(obj) + val * l + OBJ_FLUX(obj) = OBJ_FLUX(obj) + val + OBJ_ISIGAVG(obj) = OBJ_ISIGAVG(obj) + val + OBJ_ISIGMAX(obj) = max (OBJ_ISIGMAX(obj), val) +end + + +# SRENUM -- Find detected pieces with a common parent and add to the +# catalog and the object mask. + +procedure srenum (cat, om, sm, ids, sobjs, nsobjs, minpix, + sigavg, sigmax) + +pointer cat #I Catalog structure +pointer om #I Object mask +pointer sm #I Split mask +int ids[nsobjs] #I Mask IDs +pointer sobjs[nsobjs] #U Input and output object list +int nsobjs #U Number of objects +int minpix #I Minimum number of pixels +real sigavg #I Cutoff of SIGAVG +real sigmax #I Cutoff of SIGMAX + +int i, j, n, nummax, nc, nl +real rval +pointer sp, nsplit, v, irl, srl, orl +pointer objs, obj, pobj +int ori() + +begin + nummax = CAT_NUMMAX(cat) + objs = CAT_OBJS(cat) + + call smark (sp) + call salloc (nsplit, nummax, TY_INT) + call aclri (Memi[nsplit], nummax) + + # Eliminate objects, by setting ids to zero, which don't satisfy + # the selection criteria (size, peak value, etc). Find objects + # that have split by counting, in the nsplit array, how many pieces + # belong to each parent. + + do i = NUMSTART, nsobjs { + obj = sobjs[i] + if (obj == NULL) + next + + n = OBJ_NPIX(obj) + rval = sqrt (real(n)) + OBJ_ISIGAVG(obj) = OBJ_ISIGAVG(obj) / rval + if (n < minpix || + (OBJ_ISIGMAX(obj) < sigmax && OBJ_ISIGAVG(obj) < sigavg)) { + ids[i] = 0 + next + } + + rval = OBJ_FLUX(obj) + if (rval > 0.) { + OBJ_XAP(obj) = OBJ_XAP(obj) / rval + OBJ_YAP(obj) = OBJ_YAP(obj) / rval + } else { + OBJ_XAP(obj) = INDEFR + OBJ_YAP(obj) = INDEFR + } + + n = OBJ_PNUM(obj) + Memi[nsplit+n-1] = Memi[nsplit+n-1] + 1 + } + + # Count objects that have a common parent (nsplit > 1) and assign + # new object numbers. Those not split are eliminated by setting + # ids to zero. Mark those unsplit objects whose parent objects + # are too small at the current size threshold as single to eliminate + # them from future attempts to split. + + j = nummax + do i = NUMSTART, nsobjs { + obj = sobjs[i] + if (obj == NULL || ids[i] == 0) + next + + n = OBJ_PNUM(obj) + if (Memi[nsplit+n-1] < 2) { + pobj = Memi[objs+n-1] + if (pobj != NULL) { + if (OBJ_NPIX(obj) < 2 * minpix) + SETFLAG (pobj, OBJ_SINGLE) + } + ids[i] = 0 + } else { + j = j + 1 + OBJ_NUM(obj) = j + nummax = nummax + 1 + } + } + + # If there are no split objects return. + if (nummax == CAT_NUMMAX(cat)) { + call sfree (sp) + return + } + + # Update the object mask for the split objects. + call salloc (v, PM_MAXDIM, TY_LONG) + call pm_gsize (om, i, Meml[v], j) + nc = Meml[v]; nl = Meml[v+1] + call salloc (irl, 3+3*nc, TY_INT) + call salloc (srl, 3+3*nc, TY_INT) + call salloc (orl, 3+3*nc, TY_INT) + + call srenum1 (om, sm, nc, nl, ids, sobjs, Memi[nsplit], + Meml[v], Memi[irl], Memi[srl], Memi[orl]) + + # Add split objects to catalog. Expand object structure. + call realloc (objs, nummax, TY_POINTER) + j = CAT_NUMMAX(cat) + do i = NUMSTART, nsobjs { + obj = sobjs[i] + if (obj == NULL || ids[i] == 0) + next + + call newobj (obj) + + sobjs[i] = NULL + Memi[objs+j] = obj + j = j + 1 + } + + # Set split flags for the split parent objects. + do i = NUMSTART, CAT_NUMMAX(cat)-1 { + obj = Memi[objs+i-1] + if (obj == NULL) + next + if (Memi[nsplit+i-1] > 1) + SETFLAG (obj, OBJ_SPLIT) + } + + # Update catalog info. + CAT_NOBJS(cat) = nummax + CAT_NUMMAX(cat) = nummax + CAT_OBJS(cat) = objs + + call sfree (sp) +end + + +procedure srenum1 (om, sm, nc, nl, ids, objs, nsplit, v, irl, srl, orl) + +pointer om #I Object mask pointer +pointer sm #I Split mask pointer +int nc, nl #I Dimensions +int ids[ARB] #I Mask IDs +pointer objs[ARB] #I Split objects +int nsplit[ARB] #I Number of split pieces +long v[PM_MAXDIM] #I Work array for line index +int irl[3,nc] #I Work array for input range list +int srl[3,nc] #I Work array for split range list +int orl[3,nc] #I Work array for output range list + +int i, j, k, l, n, c1, c2, sc1, id, sid, andi(), ori() + +begin + v[1] = 1 + do l = 1, nl { + v[2] = l + call pmglri (om, v, irl, 0, nc, 0) + call pmglri (sm, v, srl, 0, nc, 0) + + srl[1,srl[1,1]+1] = nc + 1 + sc1 = srl[1,2] + + j = 1 + k = 2 + do i = 2, irl[1,1] { + sid = irl[3,i] + id = MNUM(sid) + + # Unsplit object. + if (id < NUMSTART || nsplit[id] < 2) { + j = j + 1 + orl[1,j] = irl[1,i] + orl[2,j] = irl[2,i] + orl[3,j] = sid + next + } + + c1 = irl[1,i] + c2 = c1 + irl[2,i] - 1 + id = MSETFLAG (id, MASK_SPLIT) + + while (sc1 < c1) { + k = k + 1 + sc1 = srl[1,k] + } + + while (sc1 <= c2) { + sid = ids[srl[3,k]] + + # Check for split piece that was eliminated. + if (sid == 0) { + k = k + 1 + sc1 = srl[1,k] + next + } + sid = ids[sid] + if (sid == 0) { + k = k + 1 + sc1 = srl[1,k] + next + } + + # Add split piece to output. + if (sc1 > c1) { + j = j + 1 + orl[1,j] = c1 + orl[2,j] = sc1 - c1 + orl[3,j] = id + } + n = srl[2,k] + j = j + 1 + orl[1,j] = sc1 + orl[2,j] = n + orl[3,j] = OBJ_NUM(objs[sid]) + c1 = sc1 + n + + k = k + 1 + sc1 = srl[1,k] + } + + if (c1 <= c2) { + j = j + 1 + orl[1,j] = c1 + orl[2,j] = c2 - c1 + 1 + orl[3,j] = id + } + } + orl[1,1] = j + orl[2,1] = nc + call pmplri (om, v, orl, 0, nc, PIX_SRC) + } +end diff --git a/noao/nproto/ace/t_acedetect.x b/noao/nproto/ace/t_acedetect.x new file mode 100644 index 00000000..8c211cef --- /dev/null +++ b/noao/nproto/ace/t_acedetect.x @@ -0,0 +1,1195 @@ +include <error.h> +include <fset.h> +include <imset.h> +include <pmset.h> +include <imhdr.h> +include "ace.h" +include "acedetect.h" +include "cat.h" + + +# T_ACEDETECT -- Detect objects in images. +# This entry procedure simply sets up the parameters. + +procedure t_acedetect () + +pointer par # Parameters + +pointer sp, str + +bool clgetb() +int clgwrd(), imtopenp(), imtopen(), clpopnu(), fntopnb() + +begin + call smark (sp) + call salloc (par, PAR_LEN, TY_STRUCT) + call salloc (str, SZ_LINE, TY_CHAR) + call aclri (Memi[par], PAR_LEN) + + # Get list parameters. + PAR_IMLIST(par,1) = imtopenp ("images") + PAR_BPMLIST(par,1) = imtopenp ("masks") + PAR_SKYLIST(par,1) = imtopenp ("skys") + PAR_SIGLIST(par,1) = imtopenp ("sigmas") + PAR_EXPLIST(par,1) = imtopenp ("exps") + PAR_GAINLIST(par,1) = imtopenp ("gains") + PAR_SCALELIST(par,1) = fntopnb ("", NO) + + PAR_IMLIST(par,2) = imtopen ("") + PAR_BPMLIST(par,2) = imtopen ("") + PAR_SKYLIST(par,2) = imtopen ("") + PAR_SIGLIST(par,2) = imtopen ("") + PAR_EXPLIST(par,2) = imtopen ("") + PAR_GAINLIST(par,2) = imtopen ("") + PAR_SCALELIST(par,2) = fntopnb ("", NO) + + PAR_OMLIST(par) = imtopenp ("objmasks") + PAR_OMTYPE(par) = clgwrd ("omtype", Memc[str], SZ_LINE, OM_TYPES) + PAR_INCATLIST(par) = imtopen ("") + PAR_OUTCATLIST(par) = imtopenp ("catalogs") + PAR_CATDEFLIST(par) = clpopnu ("catdefs") + PAR_LOGLIST(par) = clpopnu ("logfiles") + + PAR_OUTSKYLIST(par) = imtopen ("") + PAR_OUTSIGLIST(par) = imtopen ("") + + call clgstr ("extnames", PAR_EXTNAMES(par), PAR_SZSTR) + + # Get other parameters. + # The parameter structures flag whether an operation is requested. + #if (clgetb ("dosky")) + call sky_pars ("open", "", PAR_SKY(par)) + if (clgetb ("dodetect")) + call det_pars ("open", "", PAR_DET(par)) + if (clgetb ("dosplit")) + call spt_pars ("open", "", PAR_SPT(par)) + if (clgetb ("dogrow")) + call grw_pars ("open", "", PAR_GRW(par)) + if (clgetb ("doevaluate")) + call evl_pars ("open", "", PAR_EVL(par)) + + # Do the detection. + call aceall (par) + + # Finish up. + call sky_pars ("close", "", PAR_SKY(par)) + call det_pars ("close", "", PAR_DET(par)) + call spt_pars ("close", "", PAR_SPT(par)) + call grw_pars ("close", "", PAR_GRW(par)) + call evl_pars ("close", "", PAR_EVL(par)) + + call imtclose (PAR_OUTSIGLIST(par)) + call imtclose (PAR_OUTSKYLIST(par)) + + call clpcls (PAR_LOGLIST(par)) + call imtclose (PAR_OMLIST(par)) + call clpcls (PAR_CATDEFLIST(par)) + call imtclose (PAR_OUTCATLIST(par)) + call imtclose (PAR_INCATLIST(par)) + + call clpcls (PAR_SCALELIST(par,2)) + call imtclose (PAR_GAINLIST(par,2)) + call imtclose (PAR_EXPLIST(par,2)) + call imtclose (PAR_SIGLIST(par,2)) + call imtclose (PAR_SKYLIST(par,2)) + call imtclose (PAR_BPMLIST(par,2)) + call imtclose (PAR_IMLIST(par,2)) + + call clpcls (PAR_SCALELIST(par,1)) + call imtclose (PAR_GAINLIST(par,1)) + call imtclose (PAR_EXPLIST(par,1)) + call imtclose (PAR_SIGLIST(par,1)) + call imtclose (PAR_SKYLIST(par,1)) + call imtclose (PAR_BPMLIST(par,1)) + call imtclose (PAR_IMLIST(par,1)) + + call sfree (sp) +end + + +# T_ACEEVALUATE -- Evaluate objects. +# This entry procedure simply sets up the parameters. + +procedure t_aceevaluate () + +pointer par # Parameters + +pointer sp, str + +int imtopenp(), imtopen(), clpopnu(), fntopnb() + +begin + call smark (sp) + call salloc (par, PAR_LEN, TY_STRUCT) + call salloc (str, SZ_LINE, TY_CHAR) + call aclri (Memi[par], PAR_LEN) + + # Get list parameters. + PAR_IMLIST(par,1) = imtopenp ("images") + PAR_BPMLIST(par,1) = imtopen ("") + PAR_SKYLIST(par,1) = imtopenp ("skys") + PAR_SIGLIST(par,1) = imtopenp ("sigmas") + PAR_EXPLIST(par,1) = imtopenp ("exps") + PAR_GAINLIST(par,1) = imtopenp ("gains") + PAR_SCALELIST(par,1) = fntopnb ("", NO) + + PAR_IMLIST(par,2) = imtopen ("") + PAR_BPMLIST(par,2) = imtopen ("") + PAR_SKYLIST(par,2) = imtopen ("") + PAR_SIGLIST(par,2) = imtopen ("") + PAR_EXPLIST(par,2) = imtopen ("") + PAR_GAINLIST(par,2) = imtopen ("") + PAR_SCALELIST(par,2) = fntopnb ("", NO) + + PAR_OMLIST(par) = imtopenp ("objmasks") + PAR_OMTYPE(par) = OM_ALL + PAR_INCATLIST(par) = imtopenp ("incatalogs") + PAR_OUTCATLIST(par) = imtopenp ("outcatalogs") + PAR_CATDEFLIST(par) = clpopnu ("catdefs") + PAR_LOGLIST(par) = clpopnu ("logfiles") + + PAR_OUTSKYLIST(par) = imtopen ("") + PAR_OUTSIGLIST(par) = imtopen ("") + + # Get other parameters. + # The parameter structures flag whether an operation is requested. + call sky_pars ("open", "", PAR_SKY(par)) + call evl_pars ("open", "", PAR_EVL(par)) + + # Do the detection. + call aceall (par) + + # Finish up. + call sky_pars ("close", "", PAR_SKY(par)) + call det_pars ("close", "", PAR_DET(par)) + call spt_pars ("close", "", PAR_SPT(par)) + call grw_pars ("close", "", PAR_GRW(par)) + call evl_pars ("close", "", PAR_EVL(par)) + + call imtclose (PAR_OUTSIGLIST(par)) + call imtclose (PAR_OUTSKYLIST(par)) + + call clpcls (PAR_LOGLIST(par)) + call imtclose (PAR_OMLIST(par)) + call clpcls (PAR_CATDEFLIST(par)) + call imtclose (PAR_INCATLIST(par)) + call imtclose (PAR_OUTCATLIST(par)) + + call clpcls (PAR_SCALELIST(par,2)) + call imtclose (PAR_GAINLIST(par,2)) + call imtclose (PAR_EXPLIST(par,2)) + call imtclose (PAR_SIGLIST(par,2)) + call imtclose (PAR_SKYLIST(par,2)) + call imtclose (PAR_BPMLIST(par,2)) + call imtclose (PAR_IMLIST(par,2)) + + call clpcls (PAR_SCALELIST(par,1)) + call imtclose (PAR_GAINLIST(par,1)) + call imtclose (PAR_EXPLIST(par,1)) + call imtclose (PAR_SIGLIST(par,1)) + call imtclose (PAR_SKYLIST(par,1)) + call imtclose (PAR_BPMLIST(par,1)) + call imtclose (PAR_IMLIST(par,1)) + + call sfree (sp) +end + + +# T_ACESKY -- Output sky images. +# This entry procedure simply sets up the parameters. + +procedure t_acesky () + +pointer par # Parameters + +pointer sp, str + +int imtopenp(), imtopen(), clpopnu(), fntopnb() + +begin + call smark (sp) + call salloc (par, PAR_LEN, TY_STRUCT) + call salloc (str, SZ_LINE, TY_CHAR) + call aclri (Memi[par], PAR_LEN) + + # Get list parameters. + PAR_IMLIST(par,1) = imtopenp ("images") + PAR_OUTSKYLIST(par) = imtopenp ("skyimages") + PAR_OUTSIGLIST(par) = imtopenp ("sigmaimages") + PAR_BPMLIST(par,1) = imtopen ("") + PAR_SKYLIST(par,1) = imtopenp ("skys") + PAR_SIGLIST(par,1) = imtopenp ("sigmas") + PAR_EXPLIST(par,1) = imtopenp ("exps") + PAR_GAINLIST(par,1) = imtopenp ("gains") + PAR_SCALELIST(par,1) = fntopnb ("", NO) + + PAR_IMLIST(par,2) = imtopen ("") + PAR_BPMLIST(par,2) = imtopen ("") + PAR_SKYLIST(par,2) = imtopen ("") + PAR_SIGLIST(par,2) = imtopen ("") + PAR_EXPLIST(par,2) = imtopen ("") + PAR_GAINLIST(par,2) = imtopen ("") + PAR_SCALELIST(par,2) = fntopnb ("", NO) + + PAR_OMLIST(par) = imtopen ("") + PAR_OMTYPE(par) = OM_ALL + PAR_INCATLIST(par) = imtopen ("") + PAR_OUTCATLIST(par) = imtopen ("") + PAR_CATDEFLIST(par) = fntopnb ("", NO) + PAR_LOGLIST(par) = clpopnu ("logfiles") + + # Do the detection. + call aceall (par) + + # Finish up. + call sky_pars ("close", "", PAR_SKY(par)) + call det_pars ("close", "", PAR_DET(par)) + call spt_pars ("close", "", PAR_SPT(par)) + call grw_pars ("close", "", PAR_GRW(par)) + call evl_pars ("close", "", PAR_EVL(par)) + + call imtclose (PAR_OUTSIGLIST(par)) + call imtclose (PAR_OUTSKYLIST(par)) + + call clpcls (PAR_LOGLIST(par)) + call imtclose (PAR_OMLIST(par)) + call clpcls (PAR_CATDEFLIST(par)) + call imtclose (PAR_INCATLIST(par)) + call imtclose (PAR_OUTCATLIST(par)) + + call clpcls (PAR_SCALELIST(par,2)) + call imtclose (PAR_GAINLIST(par,2)) + call imtclose (PAR_EXPLIST(par,2)) + call imtclose (PAR_SIGLIST(par,2)) + call imtclose (PAR_SKYLIST(par,2)) + call imtclose (PAR_BPMLIST(par,2)) + call imtclose (PAR_IMLIST(par,2)) + + call clpcls (PAR_SCALELIST(par,1)) + call imtclose (PAR_GAINLIST(par,1)) + call imtclose (PAR_EXPLIST(par,1)) + call imtclose (PAR_SIGLIST(par,1)) + call imtclose (PAR_SKYLIST(par,1)) + call imtclose (PAR_BPMLIST(par,1)) + call imtclose (PAR_IMLIST(par,1)) + + call sfree (sp) +end + + +# T_DIFFDETECT -- Detect objects in the difference of images. + +procedure t_diffdetect () + +pointer par # Parameters + +pointer sp, str + +int imtopenp(), imtopen(), clpopnu() + +begin + call smark (sp) + call salloc (par, PAR_LEN, TY_STRUCT) + call salloc (str, SZ_LINE, TY_CHAR) + call aclri (Memi[par], PAR_LEN) + + # Get list parameters. + PAR_IMLIST(par,1) = imtopenp ("images") + PAR_BPMLIST(par,1) = imtopenp ("masks") + PAR_SKYLIST(par,1) = imtopenp ("skys") + PAR_SIGLIST(par,1) = imtopenp ("sigmas") + PAR_EXPLIST(par,1) = imtopenp ("exps") + PAR_GAINLIST(par,1) = imtopenp ("gains") + PAR_SCALELIST(par,1) = clpopnu ("scales") + + PAR_IMLIST(par,2) = imtopenp ("rimages") + PAR_BPMLIST(par,2) = imtopenp ("rmasks") + PAR_SKYLIST(par,2) = imtopenp ("rskys") + PAR_SIGLIST(par,2) = imtopenp ("rsigmas") + PAR_EXPLIST(par,2) = imtopenp ("rexps") + PAR_GAINLIST(par,2) = imtopen ("") + PAR_SCALELIST(par,2) = clpopnu ("rscales") + + PAR_OMLIST(par) = imtopenp ("objmasks") + PAR_OMTYPE(par) = OM_ALL + PAR_INCATLIST(par) = imtopen ("") + PAR_OUTCATLIST(par) = imtopenp ("catalogs") + PAR_CATDEFLIST(par) = clpopnu ("catdefs") + PAR_LOGLIST(par) = clpopnu ("logfiles") + + PAR_OUTSKYLIST(par) = imtopen ("") + PAR_OUTSIGLIST(par) = imtopen ("") + + # Get other parameters. + call sky_pars ("open", "", PAR_SKY(par)) + call det_pars ("diff", "", PAR_DET(par)) + call grw_pars ("open", "", PAR_GRW(par)) + call evl_pars ("open", "", PAR_EVL(par)) + + # Do the detection. + call aceall (par) + + # Finish up. + call sky_pars ("close", "", PAR_SKY(par)) + call det_pars ("close", "", PAR_DET(par)) + call spt_pars ("close", "", PAR_SPT(par)) + call grw_pars ("close", "", PAR_GRW(par)) + call evl_pars ("close", "", PAR_EVL(par)) + + call imtclose (PAR_OUTSIGLIST(par)) + call imtclose (PAR_OUTSKYLIST(par)) + + call clpcls (PAR_LOGLIST(par)) + call imtclose (PAR_OMLIST(par)) + call clpcls (PAR_CATDEFLIST(par)) + call imtclose (PAR_INCATLIST(par)) + call imtclose (PAR_OUTCATLIST(par)) + + call clpcls (PAR_SCALELIST(par,2)) + call imtclose (PAR_GAINLIST(par,2)) + call imtclose (PAR_EXPLIST(par,2)) + call imtclose (PAR_SIGLIST(par,2)) + call imtclose (PAR_SKYLIST(par,2)) + call imtclose (PAR_BPMLIST(par,2)) + call imtclose (PAR_IMLIST(par,2)) + + call clpcls (PAR_SCALELIST(par,1)) + call imtclose (PAR_GAINLIST(par,1)) + call imtclose (PAR_EXPLIST(par,1)) + call imtclose (PAR_SIGLIST(par,1)) + call imtclose (PAR_SKYLIST(par,1)) + call imtclose (PAR_BPMLIST(par,1)) + call imtclose (PAR_IMLIST(par,1)) + + call sfree (sp) +end + + + +# ACEALL -- Expand input list and set filenames. +# This calls ACE for each image to be analyzed. + +procedure aceall (par) + +pointer par #I Parameters + +int i, j, k, list, imext +pointer sp, str +pointer image[4], bpmask[4], skyname[4], signame[4], expname[4], gainname[4] +pointer incat[2], outcat[2], objmask[2], outsky[2], outsig[2], scalestr[2] +pointer catdef, logfile +pointer im, ptr + +int nowhite(), mscextensions(), strldxs(), strlen() +int imtlen(), imtgetim(), clplen(), clgfil() +pointer immap() +errchk immap + +begin + call smark (sp) + + # Allocate memory for all the file names. The first half of each + # array of names is for image names including extensions and the + # second half is for cluster names. The names are initialized + # to EOS and are only filled in if specified. + + do j = 1, 4 { + call salloc (image[j], SZ_FNAME, TY_CHAR) + call salloc (bpmask[j], SZ_FNAME, TY_CHAR) + call salloc (skyname[j], SZ_FNAME, TY_CHAR) + call salloc (signame[j], SZ_FNAME, TY_CHAR) + call salloc (expname[j], SZ_FNAME, TY_CHAR) + call salloc (gainname[j], SZ_FNAME, TY_CHAR) + Memc[image[j]] = EOS + Memc[bpmask[j]] = EOS + Memc[skyname[j]] = EOS + Memc[signame[j]] = EOS + Memc[expname[j]] = EOS + Memc[gainname[j]] = EOS + } + do j = 1, 2 { + call salloc (objmask[j], SZ_FNAME, TY_CHAR) + call salloc (incat[j], SZ_FNAME, TY_CHAR) + call salloc (outcat[j], SZ_FNAME, TY_CHAR) + call salloc (outsky[j], SZ_FNAME, TY_CHAR) + call salloc (outsig[j], SZ_FNAME, TY_CHAR) + call salloc (scalestr[j], SZ_FNAME, TY_CHAR) + Memc[objmask[j]] = EOS + Memc[incat[j]] = EOS + Memc[outcat[j]] = EOS + Memc[outsky[j]] = EOS + Memc[outsig[j]] = EOS + Memc[scalestr[j]] = EOS + } + call salloc (catdef, SZ_FNAME, TY_CHAR) + call salloc (logfile, SZ_FNAME, TY_CHAR) + Memc[catdef] = EOS + Memc[logfile] = EOS + + call salloc (str, SZ_LINE, TY_CHAR) + + # Check lists match. + j = imtlen (PAR_IMLIST(par,1)) + i = imtlen (PAR_BPMLIST(par,1)) + if (i > 1 && i != j) + call error (1, + "Image and bad pixel mask lists do not match") + i = imtlen (PAR_SKYLIST(par,1)) + if (i > 1 && i != j) + call error (1, + "Image and sky lists do not match") + i = imtlen (PAR_SIGLIST(par,1)) + if (i > 1 && i != j) + call error (1, + "Image and sky sigma lists do not match") + i = imtlen (PAR_EXPLIST(par,1)) + if (i > 1 && i != j) + call error (1, + "Image and exposure map lists do not match") + i = imtlen (PAR_GAINLIST(par,1)) + if (i > 1 && i != j) + call error (1, + "Image and measurement gain lists do not match") + i = clplen (PAR_SCALELIST(par,1)) + if (i > 1 && i != j) + call error (1, + "Image and scale lists do not match") + + k = imtlen (PAR_IMLIST(par,2)) + if (k > 1 && i != j) + call error (1, + "Image and reference lists do not match") + i = imtlen (PAR_BPMLIST(par,2)) + if (i > 1 && i != k) + call error (1, + "Reference image bad pixel mask lists do not match") + i = imtlen (PAR_SKYLIST(par,2)) + if (i > 1 && i != k) + call error (1, + "Reference image and sky lists do not match") + i = imtlen (PAR_SIGLIST(par,2)) + if (i > 1 && i != k) + call error (1, + "Reference image and sky sigma lists do not match") + i = imtlen (PAR_EXPLIST(par,2)) + if (i > 1 && i != k) + call error (1, + "Reference image and exposure map lists do not match") + i = imtlen (PAR_GAINLIST(par,2)) + if (i > 1 && i != j) + call error (1, + "Reference image and measurement gain lists do not match") + i = clplen (PAR_SCALELIST(par,2)) + if (i > 1 && i != k) + call error (1, + "Reference image and scale lists do not match") + + i = clplen (PAR_INCATLIST(par)) + if (i > 0 && i != j) + call error (1, + "Input image and input catalog lists do not match") + i = clplen (PAR_OUTCATLIST(par)) + if (i > 0 && i != j) + call error (1, + "Input image and output catalog lists do not match") + i = clplen (PAR_CATDEFLIST(par)) + if (i > 1 && i != j) + call error (1, + "Input image and catalog definition lists do not match") + i = imtlen (PAR_OMLIST(par)) + if (i > 0 && i != j) + call error (1, + "Input image and object mask lists do not match") + i = clplen (PAR_LOGLIST(par)) + if (i > 1 && i != j) + call error (1, + "Input image and logfile lists do not match") + i = imtlen (PAR_OUTSKYLIST(par)) + if (i > 0 && i != j) + call error (1, + "Input image and output sky lists do not match") + i = imtlen (PAR_OUTSIGLIST(par)) + if (i > 0 && i != j) + call error (1, + "Input image and output sigma lists do not match") + + # Do each input image cluster. + while (imtgetim (PAR_IMLIST(par,1), Memc[image[1]], SZ_FNAME) != EOF) { + if (imtgetim (PAR_IMLIST(par,2), Memc[str], SZ_LINE) != EOF) + call strcpy (Memc[str], Memc[image[2]], SZ_FNAME) + + # Get associated cluster names. + # Initialize image names to the cluster names. + # Strip whitespace to check for no name. + do j = 1, 2 { + if (imtgetim (PAR_BPMLIST(par,j), Memc[str], SZ_LINE) != EOF) + call strcpy (Memc[str], Memc[bpmask[j]], SZ_FNAME) + if (imtgetim (PAR_SKYLIST(par,j), Memc[str], SZ_LINE) != EOF) + call strcpy (Memc[str], Memc[skyname[j]], SZ_FNAME) + if (imtgetim (PAR_SIGLIST(par,j), Memc[str], SZ_LINE) != EOF) + call strcpy (Memc[str], Memc[signame[j]], SZ_FNAME) + if (imtgetim (PAR_EXPLIST(par,j), Memc[str], SZ_LINE) != EOF) + call strcpy (Memc[str], Memc[expname[j]], SZ_FNAME) + if (imtgetim (PAR_GAINLIST(par,j), Memc[str], SZ_LINE) != EOF) + call strcpy (Memc[str], Memc[gainname[j]], SZ_FNAME) + if (clgfil (PAR_SCALELIST(par,j), Memc[str], SZ_LINE) != EOF) + call strcpy (Memc[str], Memc[scalestr[j]], SZ_FNAME) + + i = nowhite (Memc[bpmask[j]], Memc[bpmask[j]], SZ_FNAME) + i = nowhite (Memc[skyname[j]], Memc[skyname[j]], SZ_FNAME) + i = nowhite (Memc[signame[j]], Memc[signame[j]], SZ_FNAME) + i = nowhite (Memc[expname[j]], Memc[expname[j]], SZ_FNAME) + i = nowhite (Memc[gainname[j]], Memc[gainname[j]], SZ_FNAME) + i = nowhite (Memc[scalestr[j]], Memc[scalestr[j]], SZ_FNAME) + } + + if (clgfil (PAR_INCATLIST(par), Memc[str], SZ_LINE) != EOF) + call strcpy (Memc[str], Memc[incat[1]], SZ_FNAME) + if (clgfil (PAR_OUTCATLIST(par), Memc[str], SZ_LINE) != EOF) + call strcpy (Memc[str], Memc[outcat[1]], SZ_FNAME) + if (imtgetim (PAR_OMLIST(par), Memc[str], SZ_LINE) != EOF) + call strcpy (Memc[str], Memc[objmask[1]], SZ_FNAME) + if (imtgetim (PAR_OUTSKYLIST(par), Memc[str], SZ_LINE) != EOF) + call strcpy (Memc[str], Memc[outsky[1]], SZ_FNAME) + if (imtgetim (PAR_OUTSIGLIST(par), Memc[str], SZ_LINE) != EOF) + call strcpy (Memc[str], Memc[outsig[1]], SZ_FNAME) + if (clgfil (PAR_CATDEFLIST(par), Memc[str], SZ_LINE) != EOF) + call strcpy (Memc[str], Memc[catdef], SZ_FNAME) + if (clgfil (PAR_LOGLIST(par), Memc[str], SZ_LINE) != EOF) + call strcpy (Memc[str], Memc[logfile], SZ_FNAME) + + i = nowhite (Memc[incat[1]], Memc[incat[1]], SZ_FNAME) + i = nowhite (Memc[outcat[1]], Memc[outcat[1]], SZ_FNAME) + i = nowhite (Memc[objmask[1]], Memc[objmask[1]], SZ_FNAME) + i = nowhite (Memc[outsky[1]], Memc[outsky[1]], SZ_FNAME) + i = nowhite (Memc[outsig[1]], Memc[outsig[1]], SZ_FNAME) + i = nowhite (Memc[catdef], Memc[catdef], SZ_FNAME) + i = nowhite (Memc[logfile], Memc[logfile], SZ_FNAME) + + # Expand clusters to images. As a special case, if the input is + # an explicit extension image then don't treat the filenames as MEF. + list = mscextensions (Memc[image[1]], "0-", PAR_EXTNAMES(par), + "", NO, YES, NO, "", NO, imext) + if (strldxs ("[", Memc[image[1]]) != 0) + imext = NO + while (imtgetim (list, Memc[image[3]], SZ_FNAME) != EOF) { + call strcpy (Memc[image[2]], Memc[image[4]], SZ_FNAME) + do j = 1, 2 { + call strcpy (Memc[bpmask[j]], Memc[bpmask[j+2]], SZ_FNAME) + call strcpy (Memc[skyname[j]], Memc[skyname[j+2]], SZ_FNAME) + call strcpy (Memc[signame[j]], Memc[signame[j+2]], SZ_FNAME) + call strcpy (Memc[expname[j]], Memc[expname[j+2]], SZ_FNAME) + call strcpy (Memc[gainname[j]],Memc[gainname[j+2]],SZ_FNAME) + } + call strcpy (Memc[incat[1]], Memc[incat[2]], SZ_FNAME) + call strcpy (Memc[outcat[1]], Memc[outcat[2]], SZ_FNAME) + call strcpy (Memc[objmask[1]], Memc[objmask[2]], SZ_FNAME) + call strcpy (Memc[outsky[1]], Memc[outsky[2]], SZ_FNAME) + call strcpy (Memc[outsig[1]], Memc[outsig[2]], SZ_FNAME) + + # Add extensions if needed. + i = strldxs ("[", Memc[image[3]]) + if (imext == YES && i > 0) { + i = image[3]+i-1 + call strcpy (Memc[i], Memc[str], SZ_LINE) + Memc[str+strldxs ("]", Memc[str])-1] = EOS + call strcat (",append]", Memc[str], SZ_LINE) + + if (Memc[image[2]]!=EOS && + strldxs ("[", Memc[image[2]]) == 0) + call strcat (Memc[i], Memc[image[4]], SZ_FNAME) + do j = 1, 2 { + if (Memc[bpmask[j]]!=EOS && Memc[bpmask[j]]!='!' && + strldxs ("[", Memc[bpmask[j]]) == 0) + call strcat (Memc[i], Memc[bpmask[j+2]], SZ_FNAME) + if (Memc[skyname[j]]!=EOS && Memc[skyname[j]]!='!' && + strldxs ("[", Memc[skyname[j]]) == 0) + call strcat (Memc[str], Memc[skyname[j+2]], + SZ_FNAME) + if (Memc[signame[j]]!=EOS && Memc[signame[j]]!='!' && + strldxs ("[", Memc[signame[j]]) == 0) + call strcat (Memc[str], Memc[signame[j+2]], + SZ_FNAME) + if (Memc[expname[j]]!=EOS && Memc[expname[j]]!='!' && + strldxs ("[", Memc[expname[j]]) == 0) + call strcat (Memc[i], Memc[expname[j+2]], SZ_FNAME) + if (Memc[gainname[j]]!=EOS && Memc[gainname[j]]!='!' && + strldxs ("[", Memc[gainname[j]]) == 0) + call strcat (Memc[i], Memc[gainname[j+2]], SZ_FNAME) + } + if (Memc[incat[1]]!=EOS && Memc[incat[1]]!='!' && + strldxs ("[", Memc[incat[1]]) == 0) + call strcat (Memc[i], Memc[incat[2]], SZ_FNAME) + if (Memc[outcat[1]]!=EOS && Memc[outcat[1]]!='!' && + strldxs ("[", Memc[outcat[1]]) == 0) + call strcat (Memc[i], Memc[outcat[2]], SZ_FNAME) + if (Memc[outsky[1]]!=EOS && Memc[outsky[1]]!='!' && + strldxs ("[", Memc[outsky[1]]) == 0) + call strcat (Memc[str], Memc[outsky[2]], SZ_FNAME) + if (Memc[outsig[1]]!=EOS && Memc[outsig[1]]!='!' && + strldxs ("[", Memc[outsig[1]]) == 0) + call strcat (Memc[str], Memc[outsig[2]], SZ_FNAME) + if (Memc[objmask[1]]!=EOS && Memc[objmask[1]]!='!' && + strldxs ("[", Memc[objmask[1]]) == 0) + call strcat (Memc[str], Memc[objmask[2]], SZ_FNAME) + } + + # Append DATASEC. + do i = 3, 4 { + if (Memc[image[i]] == EOS) + next + iferr { + im = NULL + ptr = immap (Memc[image[i]], READ_ONLY, 0); im = ptr + j = strlen (Memc[image[i]]) + call imgstr (im, "DATASEC", Memc[image[i]+j], + SZ_FNAME-j) + } then + ; + if (im != NULL) + call imunmap (im) + } + + # Process the image. + call ace (par, image[3], bpmask[3], skyname[3], signame[3], + expname[3], gainname[3], scalestr, Memc[incat[2]], + Memc[outcat[2]], Memc[objmask[2]], Memc[outsky[2]], + Memc[outsig[2]], Memc[catdef], Memc[logfile]) + + } + call imtclose (list) + } + + call sfree (sp) +end + + +# ACE -- Do all the primary steps for a single input image/catalog. + +procedure ace (par, image, bpmask, skyname, signame, expname, gainname, + scalestr, incat, outcat, objmask, outsky, outsig, catdef, logfile) + +pointer par #I Parameters +pointer image[2], bpmask[2], skyname[2], signame[2], expname[2] +pointer gainname[2], scalestr[2] +char incat[ARB], outcat[ARB], objmask[ARB], outsky[ARB], outsig[ARB] +char catdef[ARB], logfile[ARB] + +bool dosky[2], dosig[2] +int i, j, logfd, offset[2,2] +real scale[2] +pointer sp, bpname[2], str +pointer im[2], bpm[2], skymap[2], sigmap[2], expmap[2], gainmap[2] +pointer ptr, cat, om, omim, siglevmap, siglevels + +bool strne() +real imgetr() +int ctor(), strdic(), fnextn(), imstati() +int open(), access(), imaccess() +pointer immap(), xt_pmmap(), pm_open(), map_open() + +errchk open, immap, xt_pmmap, pm_newmask +errchk cnvparse, sky, detect, split, grow, evaluate, map_open +errchk catdefine, catopen, catgets + +#pointer bpm1, im_pmmapo() + +begin + call smark (sp) + call salloc (bpname[1], SZ_FNAME, TY_CHAR) + call salloc (bpname[2], SZ_FNAME, TY_CHAR) + call salloc (str, SZ_LINE, TY_CHAR) + + # Deal with image types if needed. + if (Memc[bpmask[1]] != EOS && Memc[bpmask[1]] != '!') + call xt_maskname (Memc[bpmask[1]], "pl", READ_ONLY, Memc[bpmask[1]], + SZ_FNAME) + if (Memc[bpmask[2]] != EOS && Memc[bpmask[2]] != '!') + call xt_maskname (Memc[bpmask[2]], "pl", READ_ONLY, Memc[bpmask[2]], + SZ_FNAME) + if (objmask[1] != EOS && objmask[1] != '!') + call xt_maskname (objmask, "pl", NEW_IMAGE, objmask, SZ_FNAME) + if (incat[1] != EOS) { + i = fnextn (incat, Memc[str], SZ_LINE) + if (i > 0) + i = strdic (Memc[str], Memc[str], SZ_LINE, CATEXTNS) + #if (i == 0) + # call strcat (".fits", incat, SZ_FNAME) + } + if (outcat[1] != EOS) { + i = fnextn (outcat, Memc[str], SZ_LINE) + if (i > 0) + i = strdic (Memc[str], Memc[str], SZ_LINE, CATEXTNS) + #if (i == 0) + # call strcat (".fits", outcat, SZ_FNAME) + } + + iferr { + # Initialize for error recovery. + do j = 1, 2 { + im[j] = NULL; bpm[j] = NULL; skymap[j] = NULL + sigmap[j] = NULL; expmap[j] = NULL; gainmap[j] = NULL + } + cat = NULL; logfd = NULL + + # Log file. + if (logfile[1] != EOS) { + ptr = open (logfile, APPEND, TEXT_FILE) + logfd = ptr + call fseti (logfd, F_FLUSHNL, YES) + } + + # Open images. + if (PAR_DET(par) == NULL && PAR_EVL(par) == NULL) + ptr = immap (Memc[image[1]], READ_ONLY, 0) + else { + iferr (ptr = immap (Memc[image[1]], READ_WRITE, 0)) + ptr = immap (Memc[image[1]], READ_ONLY, 0) + } + im[1] = ptr + + # Open input catalog and object mask. + if (PAR_DET(par) == NULL && PAR_EVL(par) == NULL) + ; + else if (PAR_DET(par) == NULL) { + if (incat[1] == EOS) { + call sprintf (Memc[str], SZ_LINE, + "No input catalog for image (%s)") + call pargstr (Memc[image[1]]) + call error (1, Memc[str]) + } else { + if (access (incat, 0, 0) != YES) { + call sprintf (Memc[str], SZ_LINE, + "Catalog does not exist (%s)") + call pargstr (incat) + call error (1, Memc[str]) + } + } + if (outcat[1]!=EOS && strne(incat,outcat)) { + if (access (outcat, 0, 0) == YES) { + call sprintf (Memc[str], SZ_LINE, + "Catalog already exists (%s)") + call pargstr (outcat) + call error (1, Memc[str]) + } + } + call catopen (cat, incat, outcat, catdef) + call catrobjs (cat, "") + if (objmask[1] == EOS) + call catgets (cat, "mask", objmask, SZ_FNAME) + omim = xt_pmmap (objmask, im[1], objmask, SZ_FNAME) + om = imstati (omim, IM_PMDES) + } else { + # Check for existing catalog. Check catalog definitions. + if (outcat[1] != EOS) { + if (access (outcat, 0, 0) == YES) { + call sprintf (Memc[str], SZ_LINE, + "Catalog already exists (%s)") + call pargstr (outcat) + call error (1, Memc[str]) + } + call catdefine (NULL, NULL, catdef) + } + call catopen (cat, "", "", "") + + # Check for existing mask and initialize. + if (objmask[1] != EOS) { + if (imaccess (objmask, 0) == YES) { + call sprintf (Memc[str], SZ_LINE, + "Object mask already exists (%s)") + call pargstr (objmask) + call error (1, Memc[str]) + } + } + } + + # Open bad pixel mask. + ptr = xt_pmmap (Memc[bpmask[1]], im[1], Memc[bpname[1]], + SZ_FNAME) + bpm[1] = ptr + + # Do reference image. + if (Memc[image[2]] != EOS) { +# if (Memc[bpmask[2]] == EOS) +# call imgimage (Memc[image[2]], Memc[image[2]], SZ_FNAME) + + iferr (ptr = immap (Memc[image[2]], READ_WRITE, 0)) + ptr = immap (Memc[image[2]], READ_ONLY, 0) + im[2] = ptr + + # Set offsets. + call get_offsets (im, 2, "world", offset) + offset[1,2] = offset[1,2] - offset[1,1] + offset[2,2] = offset[2,2] - offset[2,1] + +# # Attempt to make an overlapping image section if +# # there is no bad pixel mask. This is a kludge. +# if (Memc[bpmask[2]] == EOS) { +# c1 = max (1, 1-offset[1,2]) +# c2 = min (IM_LEN(im[2],1), IM_LEN(im[1],1)-offset[1,2]) +# l1 = max (1, 1-offset[2,2]) +# l2 = min (IM_LEN(im[2],2), IM_LEN(im[1],2)-offset[2,2]) +# if (c1!=1 || c2!=IM_LEN(im[2],1) || +# l1!=1 || l2!=IM_LEN(im[2],2)) { +# call sprintf (Memc[str], SZ_LINE, "%s[%d:%d,%d:%d]") +# call pargstr (Memc[image[2]]) +# call pargi (c1) +# call pargi (c2) +# call pargi (l1) +# call pargi (l2) +# call strcpy (Memc[str], Memc[image[2]], SZ_FNAME) +# call imunmap (im[2]) +# iferr (ptr = immap (Memc[image[2]], READ_WRITE, 0)) +# ptr = immap (Memc[image[2]], READ_ONLY, 0) +# im[2] = ptr +# +# call get_offsets (im, 2, "world", offset) +# offset[1,2] = offset[1,2] - offset[1,1] +# offset[2,2] = offset[2,2] - offset[2,1] +# PAR_OFFSET(par,1) = offset[1,2] +# PAR_OFFSET(par,2) = offset[2,2] +# } +# } + + ptr = xt_pmmap (Memc[bpmask[2]], im[2], Memc[bpname[2]], + SZ_FNAME) + bpm[2] = ptr + + i = 1 + if (Memc[scalestr[1]] == EOS) + scale[1] = 1. + else if (Memc[scalestr[1]] == '!') { + iferr (scale[1] = imgetr (im[1], Memc[scalestr[1]+1])) + call error (1, "Bad scale for input image") + } else if (ctor (Memc[scalestr[1]], i, scale[1]) == 0) + call error (1, "Bad scale for image") + + i = 1 + if (Memc[scalestr[2]] == EOS) + scale[2] = 1. + else if (Memc[scalestr[2]] == '!') { + iferr (scale[2] = imgetr (im[2], Memc[scalestr[2]+1])) + call error (1, "Bad scale for reference image") + } else if (ctor (Memc[scalestr[2]], i, scale[2]) == 0) + call error (1, "Bad scale for reference image") + } + + if (logfd != NULL) { + call sysid (Memc[str], SZ_LINE) + call fprintf (logfd, "ACE: %s\n") + call pargstr (Memc[str]) + call fprintf (logfd, " Image: %s - %s\n") + call pargstr (Memc[image[1]]) + call pargstr (IM_TITLE(im[1])) + if (bpm[1] != NULL) { + call fprintf (logfd, " Bad pixel mask: %s\n") + call pargstr (Memc[bpname[1]]) + } + if (im[2] != EOS) { + call fprintf (logfd, " Reference image: %s - %s\n") + call pargstr (Memc[image[2]]) + call pargstr (IM_TITLE(im[2])) + if (bpm[2] != NULL) { + call fprintf (logfd, + " Reference bad pixel mask: %s\n") + call pargstr (Memc[bpname[2]]) + } + } + } + + # Open optional maps. + do j = 1, 2 { + if (im[j] == NULL) + next + if (Memc[expname[j]] != EOS) + expmap[j] = map_open (Memc[expname[j]], im[j]) + } + do j = 1, 2 { + if (im[j] == NULL) + next + if (Memc[gainname[j]] != EOS) + gainmap[j] = map_open (Memc[gainname[j]], im[j]) + } + + # Get sky and sky sigma. + do j = 1, 2 { + dosky[j] = false + dosig[j] = false + if (im[j] == NULL) + next + if (PAR_SKY(par) == NULL) { + if (Memc[skyname[j]] != EOS) + skymap[j] = map_open (Memc[skyname[j]], im[j]) + if (Memc[signame[j]] != EOS) + sigmap[j] = map_open (Memc[signame[j]], im[j]) + } else { + if (j == 1 && om != NULL) + call sky (PAR_SKY(par), im[j], omim, expmap[j], + Memc[skyname[j]], Memc[signame[j]], + skymap[j], sigmap[j], dosky[j], dosig[j], logfd) + else + call sky (PAR_SKY(par), im[j], bpm[j], expmap[j], + Memc[skyname[j]], Memc[signame[j]], + skymap[j], sigmap[j], dosky[j], dosig[j], logfd) + } + if (skymap[j] != NULL) + call map_seti (skymap[j], "sample", 5) + if (sigmap[j] != NULL) + call map_seti (sigmap[j], "sample", 5) + } + + # Detect objects. + if (PAR_DET(par) != NULL) { + # Open object mask. + om = pm_open (NULL) + call pm_ssize (om, IM_NDIM(im[1]), IM_LEN(im[1],1), 27) + + # Initialize splitting map if needed. + if (PAR_SPT(par) != NULL) { + siglevmap = pm_open (NULL) + call pm_ssize (siglevmap, IM_NDIM(im[1]), + IM_LEN(im[1],1), 27) + } else + siglevmap = NULL + + # Detect objects. + call detect (PAR_DET(par), PAR_SPT(par), dosky, dosig, + Memc[skyname[1]], Memc[signame[1]], im, bpm, skymap, + sigmap, expmap, scale, offset[1,2], om, siglevmap, + siglevels, logfd, cat) + + # Split objects. + if (PAR_SPT(par) != NULL) + call split (PAR_SPT(par), cat, om, siglevmap, + Memr[siglevels], logfd) + + # Grow objects. + if (PAR_GRW(par) != NULL) + call grow (PAR_GRW(par), cat, om, logfd) + + # Set boundary flags and write out the object mask. + if (objmask[1] != EOS) { + if (PAR_OMTYPE(par) == OM_ALL) + call bndry (om, NULL) + call omwrite (om, objmask, PAR_OMTYPE(par), im[1], cat, + outcat, outcat, logfd) + } + } + + # Evaluate and write out the catalog. + if (PAR_EVL(par) != NULL && outcat[1] != EOS) { + if (incat[1] == EOS) + call catopen (cat, "", outcat, catdef) + call catputs (cat, "image", Memc[image[1]]) + if (objmask[1] != EOS) + call catputs (cat, "mask", objmask) + call catputs (cat, "catalog", outcat) + call catputs (cat, "objid", outcat) + + # Evaluate objects. + call evaluate (PAR_EVL(par), cat, im[1], om, skymap[1], + sigmap[1], gainmap[1], expmap[1], logfd) + + if (logfd != NULL) { + call fprintf (logfd, + " Write catalog: catalog = %s\n") + call pargstr (outcat) + } + + call catcreate (cat) + call catwcs (cat, im) + call catwhdr (cat, im) + call catwobjs (cat) + + call imastr (im[1], "CATALOG", outcat) + } + + # Output sky images. + call skyimages (outsky, outsig, im[1], skymap[1], + sigmap[1], gainmap[1], expmap[1], logfd) + + } then + call erract (EA_WARN) + + if (logfd != NULL) + call close (logfd) + if (cat != NULL) + call catclose (cat) + if (siglevmap != NULL) { + call pm_close (siglevmap) + call mfree (siglevels, TY_REAL) + } + if (omim != NULL) { + call imunmap (omim) + om = NULL + } else if (om != NULL) + call pm_close (om) + + do j = 1, 2 { + if (gainmap[j] != NULL) + call map_close (gainmap[j]) + if (expmap[j] != NULL) + call map_close (expmap[j]) + if (sigmap[j] != NULL) + call map_close (sigmap[j]) + if (skymap[j] != NULL) + call map_close (skymap[j]) + if (bpm[j] != NULL) + call imunmap (bpm[j]) + if (im[j] != NULL) + call imunmap (im[j]) + } + + call sfree (sp) +end + + +define OFFTYPES "|none|wcs|world|physical|" +define FILE 0 +define NONE 1 +define WCS 2 +define WORLD 3 +define PHYSICAL 4 + +# GET_OFFSETS -- Get offsets. + +procedure get_offsets (in, nimages, param, offsets) + +pointer in[nimages] #I Input image pointers +int nimages #I Number of images +char param[ARB] #I Offset parameter string +int offsets[2,nimages] #O Offsets + +int i, j, fd, offtype, off +real val +bool flip, streq(), fp_equald() +pointer sp, str, fname +pointer pref, lref, wref, cd, ltm, coord, section +pointer mw, ct, mw_openim(), mw_sctran(), immap() +int open(), fscan(), nscan(), strlen(), strdic() +errchk mw_openim, mw_gwtermd, mw_gltermd, mw_gaxmap +errchk mw_sctran, mw_ctrand, open, immap + +begin + call smark (sp) + call salloc (str, SZ_LINE, TY_CHAR) + call salloc (fname, SZ_LINE, TY_CHAR) + call salloc (lref, 2, TY_DOUBLE) + call salloc (wref, 2, TY_DOUBLE) + call salloc (cd, 2*2, TY_DOUBLE) + call salloc (coord, 2, TY_DOUBLE) + + call aclri (offsets, 2*nimages) + + # Parse the user offset string. If "none" then there are no offsets. + # If "world" or "wcs" then set the offsets based on the world WCS. + # If "physical" then set the offsets based on the physical WCS. + # If a file scan the offsets. + + call sscan (param) + call gargwrd (Memc[str], SZ_LINE) + if (nscan() == 0) + offtype = NONE + else { + offtype = strdic (Memc[str], Memc[fname], SZ_LINE, OFFTYPES) + if (offtype > 0 && !streq (Memc[str], Memc[fname])) + offtype = 0 + } + if (offtype == 0) + offtype = FILE + + switch (offtype) { + case NONE: + ; + case WORLD, WCS: + mw = mw_openim (in[1]) + call mw_gwtermd (mw, Memd[lref], Memd[wref], Memd[cd], 2) + ct = mw_sctran (mw, "world", "logical", 0) + call mw_ctrand (ct, Memd[wref], Memd[lref], 2) + call mw_close (mw) + + do i = 2, nimages { + mw = mw_openim (in[i]) + ct = mw_sctran (mw, "world", "logical", 0) + call mw_ctrand (ct, Memd[wref], Memd[coord], 2) + do j = 1, 2 + offsets[j,i] = nint (Memd[lref+j-1] - Memd[coord+j-1]) + call mw_close (mw) + } + case PHYSICAL: + call salloc (pref, 2, TY_DOUBLE) + call salloc (ltm, 4, TY_DOUBLE) + call salloc (section, SZ_FNAME, TY_CHAR) + + mw = mw_openim (in[1]) + call mw_gltermd (mw, Memd[ltm], Memd[coord], 2) + call mw_close (mw) + do i = 2, nimages { + mw = mw_openim (in[i]) + call mw_gltermd (mw, Memd[cd], Memd[coord], 2) + call strcpy ("[", Memc[section], SZ_FNAME) + flip = false + do j = 0, 3, 3 { + if (Memd[ltm+j] * Memd[cd+j] >= 0.) + call strcat ("*,", Memc[section], SZ_FNAME) + else { + call strcat ("-*,", Memc[section], SZ_FNAME) + flip = true + } + } + Memc[section+strlen(Memc[section])-1] = ']' + if (flip) { + call imstats (in[i], IM_IMAGENAME, Memc[fname], SZ_LINE) + call strcat (Memc[section], Memc[fname], SZ_LINE) + call imunmap (in[i]) + in[i] = immap (Memc[fname], READ_ONLY, TY_CHAR) + call mw_close (mw) + mw = mw_openim (in[i]) + call mw_gltermd (mw, Memd[cd], Memd[coord], 2) + do j = 0, 3 + if (!fp_equald (Memd[ltm+j], Memd[cd+j])) + call error (1, + "Cannot match physical coordinates") + } + call mw_close (mw) + } + + mw = mw_openim (in[1]) + ct = mw_sctran (mw, "logical", "physical", 0) + call mw_ctrand (ct, Memd[lref], Memd[pref], 2) + call mw_close (mw) + do i = 2, nimages { + mw = mw_openim (in[i]) + ct = mw_sctran (mw, "physical", "logical", 0) + call mw_ctrand (ct, Memd[pref], Memd[coord], 2) + do j = 1, 2 + offsets[j,i] = nint (Memd[lref+j-1] - Memd[coord+j-1]) + call mw_close (mw) + } + case FILE: + fd = open (Memc[str], READ_ONLY, TEXT_FILE) + i = 1 + while (fscan (fd) != EOF) { + do j = 1, 2 { + call gargr (val) + offsets[j,i] = nint (val) + } + if (nscan() == 2) + i = i + 1 + } + call close (fd) + if (i <= nimages) + call error (1, "offset file incomplete") + } + + # Adjust offsets to be positive. + do j = 1, 2 { + off = offsets[j,1] + do i = 2, nimages + off = min (off, offsets[j,i]) + do i = 1, nimages + offsets[j,i] = offsets[j,i] - off + } + + call sfree (sp) +end diff --git a/noao/nproto/ace/t_acedisplay.x b/noao/nproto/ace/t_acedisplay.x new file mode 100644 index 00000000..7b19851b --- /dev/null +++ b/noao/nproto/ace/t_acedisplay.x @@ -0,0 +1,639 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <mach.h> +include <imset.h> +include <imhdr.h> +include <error.h> +include <pmset.h> +include "display.h" +include "gwindow.h" + +# DISPLAY - Display an image. The specified image section is mapped into +# the specified section of an image display frame. The mapping involves +# a linear transformation in X and Y and a linear or logarithmic transformation +# in Z (greyscale). Images of all pixel datatypes are supported, and there +# no upper limit on the size of an image. The display device is interfaced +# to FIO as a file and is accessed herein via IMIO as just another imagefile. +# The physical characteristics of the display (i.e., X, Y, and Z resolution) +# are taken from the image header. The display frame buffer is the pixel +# storage "file". + +# This is a version of the standard display that allows the overlay mask +# to be manipuated in memory prior to displaying. + +procedure t_acedisplay() + +char image[SZ_FNAME] # Image to display +int frame # Display frame +int erase # Erase frame? + +int i +pointer sp, wdes, im, ds, ovrly + +bool clgetb() +int clgeti(), btoi() +pointer immap(), imd_mapframe1(), overlay() +errchk immap, imd_mapframe1 +errchk ds_getparams, ds_setwcs, ds_load_display, ds_erase_border + +begin + call smark (sp) + call salloc (wdes, LEN_WDES, TY_STRUCT) + call aclri (Memi[wdes], LEN_WDES) + + # Open input imagefile. + call clgstr ("image", image, SZ_FNAME) + im = immap (image, READ_ONLY, 0) + if (IM_NDIM(im) <= 0) + call error (1, "image has no pixels") + + # Open display device as an image. + frame = clgeti ("frame") + erase = btoi (clgetb ("erase")) + if (erase == YES) + ds = imd_mapframe1 (frame, WRITE_ONLY, + btoi (clgetb ("select_frame")), erase) + else + ds = imd_mapframe1 (frame, READ_WRITE, + btoi (clgetb ("select_frame")), erase) + + # Get display parameters and set up transformation. + call ds_getparams (im, ds, wdes) + + # Compute and output the screen to image pixel WCS. + call ds_setwcs (im, ds, wdes, image, frame) + + # Setup the overlay. + ovrly = overlay (W_OVRLY(wdes), im) + + # Display the image and zero the border if necessary. + call ods_load_display (im, ds, wdes, ovrly) + if (!clgetb ("erase") && clgetb ("border_erase")) + call ds_erase_border (im, ds, wdes) + + # Free storage. + call maskcolor_free (W_OCOLORS(wdes)) + call maskcolor_free (W_BPCOLORS(wdes)) + do i = 0, W_MAXWC + if (W_UPTR(W_WC(wdes,i)) != NULL) + call ds_ulutfree (W_UPTR(W_WC(wdes,i))) + if (ovrly != NULL) + call imunmap (ovrly) + call imunmap (ds) + call imunmap (im) + + call sfree (sp) +end + + +# DS_LOAD_DISPLAY -- Map an image into the display window. In general this +# involves independent linear transformations in the X, Y, and Z (greyscale) +# dimensions. If a spatial dimension is larger than the display window then +# the image is block averaged. If a spatial dimension or a block averaged +# dimension is smaller than the display window then linear interpolation is +# used to expand the image. Both the input image and the output device appear +# to us as images, accessed via IMIO. All spatial scaling is +# handled by the "scaled input" package, i.e., SIGM2[SR]. Our task is to +# get lines from the scaled input image, transform the greyscale if necessary, +# and write the lines to the output device. + +# This version passes the overlay mask pointer rather than mapping it. +# Otherwise this is unchanged from the standard version. + +procedure ods_load_display (im, ds, wdes, ovrly) + +pointer im # input image +pointer ds # output image +pointer wdes # graphics window descriptor +pointer ovrly # overlay pointer + +real z1, z2, dz1, dz2, px1, px2, py1, py2 +int i, order, zt, wx1, wx2, wy1, wy2, wy, nx, ny, xblk, yblk +pointer wdwin, wipix, wdpix, bpm, pm, uptr +pointer in, out, si, si_ovrly, si_bpovrly, ocolors, bpcolors, rtemp +bool unitary_greyscale_transformation +short lut1, lut2, dz1_s, dz2_s, z1_s, z2_s + +bool fp_equalr() +int imstati() +real if_elogr() +pointer ds_pmmap(), imps2s(), imps2r(), sigm2s(), sigm2r(), sigm2_setup() +errchk ds_pmmap, imps2s, imps2r, sigm2s, sigm2r, sigm2_setup + +extern if_elogr + +begin + wdwin = W_WC(wdes,W_DWIN) + wipix = W_WC(wdes,W_IPIX) + wdpix = W_WC(wdes,W_DPIX) + + # Set image and display pixels. + px1 = nint (W_XS(wipix)) + px2 = nint (W_XE(wipix)) + py1 = nint (W_YS(wipix)) + py2 = nint (W_YE(wipix)) + wx1 = nint (W_XS(wdpix)) + wx2 = nint (W_XE(wdpix)) + wy1 = nint (W_YS(wdpix)) + wy2 = nint (W_YE(wdpix)) + + z1 = W_ZS(wdwin) + z2 = W_ZE(wdwin) + zt = W_ZT(wdwin) + uptr = W_UPTR(wdwin) + order = max (W_XT(wdwin), W_YT(wdwin)) + + # Setup scaled input and masks. + si = NULL + si_ovrly = NULL + si_bpovrly = NULL + nx = wx2 - wx1 + 1 + ny = wy2 - wy1 + 1 + xblk = INDEFI + yblk = INDEFI + + ocolors = W_OCOLORS(wdes) +# iferr (ovrly = ds_pmmap (W_OVRLY(wdes), im)) { +# call erract (EA_WARN) +# ovrly = NULL +# } + if (ovrly != NULL) { + xblk = INDEFI + yblk = INDEFI + si_ovrly = sigm2_setup (ovrly, NULL, px1,px2,nx,xblk, + py1,py2,ny,yblk, -1) + } + + bpcolors = W_BPCOLORS(wdes) + switch (W_BPDISP(wdes)) { + case BPDNONE: + si = sigm2_setup (im, NULL, px1,px2,nx,xblk, py1,py2,ny,yblk, order) + case BPDOVRLY: + si = sigm2_setup (im, NULL, px1,px2,nx,xblk, py1,py2,ny,yblk, order) + iferr (bpm = ds_pmmap (W_BPM(wdes), im)) + bpm = NULL + if (bpm != NULL) + si_bpovrly = sigm2_setup (bpm, NULL, px1,px2,nx,xblk, + py1,py2,ny,yblk, -1) + case BPDINTERP: + iferr (bpm = ds_pmmap (W_BPM(wdes), im)) + bpm = NULL + if (bpm != NULL) + pm = imstati (bpm, IM_PMDES) + else + pm = NULL + si = sigm2_setup (im, pm, px1,px2,nx,xblk, py1,py2,ny,yblk, order) + } + + # The device IM_MIN and IM_MAX parameters define the acceptable range + # of greyscale values for the output device (e.g., 0-255 for most 8-bit + # display devices). Values Z1 and Z2 are mapped linearly or + # logarithmically into IM_MIN and IM_MAX. + + dz1 = IM_MIN(ds) + dz2 = IM_MAX(ds) + if (fp_equalr (z1, z2)) { + z1 = z1 - 1 + z2 = z2 + 1 + } + + # If the user specifies the transfer function, verify that the + # intensity and greyscale are in range. + + if (zt == W_USER) { + call alims (Mems[uptr], U_MAXPTS, lut1, lut2) + dz1_s = short (dz1) + dz2_s = short (dz2) + if (lut2 < dz1_s || lut1 > dz2_s) + call eprintf ("User specified greyscales out of range\n") + if (z2 < IM_MIN(im) || z1 > IM_MAX(im)) + call eprintf ("User specified intensities out of range\n") + } + + # Type short pixels are treated as a special case to minimize vector + # operations for such images (which are common). If the image pixels + # are either short or real then only the ALTR (greyscale transformation) + # vector operation is required. The ALTR operator linearly maps + # greylevels in the range Z1:Z2 to DZ1:DZ2, and does a floor ceiling + # of DZ1:DZ2 on all pixels outside the range. If unity mapping is + # employed the data is simply copied, i.e., floor ceiling constraints + # are not applied. This is very fast and will produce a contoured + # image on the display which will be adequate for some applications. + + if (zt == W_UNITARY) { + unitary_greyscale_transformation = true + } else if (zt == W_LINEAR) { + unitary_greyscale_transformation = + (fp_equalr(z1,dz1) && fp_equalr(z2,dz2)) + } else + unitary_greyscale_transformation = false + + if (IM_PIXTYPE(im) == TY_SHORT && zt != W_LOG) { + z1_s = z1; z2_s = z2 + if (z1_s == z2_s) { + z1_s = z1_s - 1 + z2_s = z2_s + 1 + } + + for (wy=wy1; wy <= wy2; wy=wy+1) { + in = sigm2s (si, wy - wy1 + 1) + out = imps2s (ds, wx1, wx2, wy, wy) + + if (unitary_greyscale_transformation) { + call amovs (Mems[in], Mems[out], nx) + } else if (zt == W_USER) { + dz1_s = U_Z1; dz2_s = U_Z2 + call amaps (Mems[in],Mems[out],nx, z1_s,z2_s, dz1_s,dz2_s) + call aluts (Mems[out], Mems[out], nx, Mems[uptr]) + } else { + dz1_s = dz1; dz2_s = dz2 + call amaps (Mems[in],Mems[out],nx, z1_s,z2_s, dz1_s,dz2_s) + } + + if (si_ovrly != NULL) { + in = sigm2s (si_ovrly, wy - wy1 + 1) + do i = 0, nx-1 { + if (Mems[in+i] != 0) + call mcolors (ocolors, int(Mems[in+i]), + Mems[out+i]) + } + } + if (si_bpovrly != NULL) { + in = sigm2s (si_bpovrly, wy - wy1 + 1) + do i = 0, nx-1 { + if (Mems[in+i] != 0) + call mcolors (bpcolors, int(Mems[in+i]), + Mems[out+i]) + } + } + } + + } else if (zt == W_USER) { + call salloc (rtemp, nx, TY_REAL) + + for (wy=wy1; wy <= wy2; wy=wy+1) { + in = sigm2r (si, wy - wy1 + 1) + out = imps2s (ds, wx1, wx2, wy, wy) + + call amapr (Memr[in], Memr[rtemp], nx, z1, z2, + real(U_Z1), real(U_Z2)) + call achtrs (Memr[rtemp], Mems[out], nx) + call aluts (Mems[out], Mems[out], nx, Mems[uptr]) + + if (si_ovrly != NULL) { + in = sigm2s (si_ovrly, wy - wy1 + 1) + do i = 0, nx-1 { + if (Mems[in+i] != 0) + call mcolors (ocolors, int(Mems[in+i]), + Mems[out+i]) + } + } + if (si_bpovrly != NULL) { + in = sigm2s (si_bpovrly, wy - wy1 + 1) + do i = 0, nx-1 { + if (Mems[in+i] != 0) + call mcolors (bpcolors, int(Mems[in+i]), + Mems[out+i]) + } + } + } + + } else { + for (wy=wy1; wy <= wy2; wy=wy+1) { + in = sigm2r (si, wy - wy1 + 1) + out = imps2r (ds, wx1, wx2, wy, wy) + + if (unitary_greyscale_transformation) { + call amovr (Memr[in], Memr[out], nx) + } else if (zt == W_LOG) { + call amapr (Memr[in], Memr[out], nx, + z1, z2, 1.0, 10.0 ** MAXLOG) + call alogr (Memr[out], Memr[out], nx, if_elogr) + call amapr (Memr[out], Memr[out], nx, + 0.0, real(MAXLOG), dz1, dz2) + } else + call amapr (Memr[in], Memr[out], nx, z1, z2, dz1, dz2) + + if (si_ovrly != NULL) { + in = sigm2s (si_ovrly, wy - wy1 + 1) + do i = 0, nx-1 { + if (Mems[in+i] != 0) + call mcolorr (ocolors, int(Mems[in+i]), + Memr[out+i]) + } + } + if (si_bpovrly != NULL) { + in = sigm2s (si_bpovrly, wy - wy1 + 1) + do i = 0, nx-1 { + if (Mems[in+i] != 0) + call mcolorr (bpcolors, int(Mems[in+i]), + Memr[out+i]) + } + } + } + } + + call sigm2_free (si) + if (si_ovrly != NULL) + call sigm2_free (si_ovrly) + if (si_bpovrly != NULL) + call sigm2_free (si_bpovrly) +# if (ovrly != NULL) +# call imunmap (ovrly) + if (bpm != NULL) + call imunmap (bpm) +end + + +# The ds_pmmap routines needed to be modified for 27 bit masks. + +include <mach.h> +include <ctype.h> +include <error.h> +include <imhdr.h> +include <imset.h> +include <pmset.h> +include <syserr.h> + + +# DS_PMMAP -- Open a pixel mask READ_ONLY. +# +# Open the pixel mask. If a regular image is specified convert it to +# a pixel mask. Match the mask to the reference image based on the +# physical coordinates. A null filename is allowed and returns NULL. + +pointer procedure ods_pmmap (pmname, refim) + +char pmname[ARB] #I Pixel mask name +pointer refim #I Reference image pointer + +pointer im +char fname[SZ_FNAME] +int nowhite(), errcode() +bool streq() +pointer im_pmmap(), ods_immap() +errchk ods_immap, ods_match + +begin + if (nowhite (pmname, fname, SZ_FNAME) == 0) + return (NULL) + if (streq (fname, "EMPTY")) + return (NULL) + if (streq (fname, "BPM")) { + iferr (call imgstr (refim, "BPM", fname, SZ_FNAME)) + return (NULL) + } + + iferr (im = im_pmmap (fname, READ_ONLY, NULL)) { + switch (errcode()) { + case SYS_FOPNNEXFIL, SYS_PLBADSAVEF: + im = ods_immap (fname, refim) + default: + call erract (EA_ERROR) + } + } + + iferr (call ods_match (im, refim)) + call erract (EA_WARN) + + return (im) +end + + +# DS_PMIMMAP -- Open a pixel mask from a non-pixel list image. +# Return error if the image cannot be opened. + +pointer procedure ods_immap (pmname, refim) + +char pmname[ARB] #I Image name +pointer refim #I Reference image pointer + +short val +int i, ndim, npix +pointer sp, v1, v2, im_in, im_out, pm, mw, data + +int imgnli() +pointer immap(), pm_newmask(), im_pmmapo(), imgl1i(), mw_openim() +errchk immap, mw_openim + +begin + call smark (sp) + call salloc (v1, IM_MAXDIM, TY_LONG) + call salloc (v2, IM_MAXDIM, TY_LONG) + + call amovkl (long(1), Meml[v1], IM_MAXDIM) + call amovkl (long(1), Meml[v2], IM_MAXDIM) + + im_in = immap (pmname, READ_ONLY, 0) + pm = pm_newmask (im_in, 16) + + ndim = IM_NDIM(im_in) + npix = IM_LEN(im_in,1) + + while (imgnli (im_in, data, Meml[v1]) != EOF) { + do i = 0, npix-1 { + val = Memi[data+i] + if (val < 0) + Memi[data+i] = 0 + } + call pmplpi (pm, Meml[v2], Memi[data], 0, npix, PIX_SRC) + call amovl (Meml[v1], Meml[v2], ndim) + } + + im_out = im_pmmapo (pm, im_in) + data = imgl1i (im_out) # Force I/O to set header + mw = mw_openim (im_in) # Set WCS + call mw_saveim (mw, im_out) + call mw_close (mw) + + call imunmap (im_in) + call sfree (sp) + return (im_out) +end + + +# DS_MATCH -- Set the pixel mask to match the reference image. +# This matches sizes and physical coordinates and allows the +# original mask to be smaller or larger than the reference image. +# Subsequent use of the pixel mask can then work in the logical +# coordinates of the reference image. A null input returns a null output. + +procedure ods_match (im, refim) + +pointer im #U Pixel mask image pointer +pointer refim #I Reference image pointer + +int i, j, k, nc, nl, ncpm, nlpm, c1, c2, l1, l2, nref, npm +int steptype, xoffset, xstep, yoffset, ystep +double x1, x2, y1, y2 +long vold[IM_MAXDIM], vnew[IM_MAXDIM] +pointer mwref, mwpm, ctref, ctpm, pm, pmnew, imnew, bufref, bufpm + +int imstati() +pointer pm_open(), mw_openim(), im_pmmapo(), imgl1i(), mw_sctran() +bool pm_empty(), pm_linenotempty() +errchk pm_open, mw_openim + +begin + if (im == NULL) + return + + # Set sizes. + pm = imstati (im, IM_PMDES) + nc = IM_LEN(refim,1) + nl = IM_LEN(refim,2) + ncpm = IM_LEN(im,1) + nlpm = IM_LEN(im,2) + + # Check if the two are the same logical size and the mask is empty. + if (nc == ncpm && nl == nlpm && pm_empty (pm)) + return + + # Check coordinate transformations. + mwref = mw_openim (refim) + mwpm = mw_openim (im) + + steptype = 1 + ctref = mw_sctran (mwref, "logical", "physical", 3) + ctpm = mw_sctran (mwpm, "physical", "logical", 3) + call mw_c2trand (ctref, 1D0, 1D0, x1, y1) + call mw_c2trand (ctpm, x1, y1, x1, y1) + call mw_c2trand (ctref, 2D0, 1D0, x2, y2) + call mw_c2trand (ctpm, x2, y2, x2, y2) + if (abs(x2-x1) < 1.) { + steptype = 2 + call mw_ctfree (ctref) + call mw_ctfree (ctpm) + ctref = mw_sctran (mwref, "physical", "logical", 3) + ctpm = mw_sctran (mwpm, "logical", "physical", 3) + call mw_c2trand (ctpm, 1D0, 1D0, x1, y1) + call mw_c2trand (ctref, x1, y1, x1, y1) + call mw_c2trand (ctpm, 2D0, 1D0, x2, y2) + call mw_c2trand (ctref, x2, y2, x2, y2) + } + x2 = x2 - x1 + if (abs(y1-y2) > 10*EPSILONR) + call error (0, "Image and mask have a relative rotation") + if (abs(x1-nint(x1)) > 10*EPSILONR && + abs(x1-nint(x1))-0.5 > 10*EPSILONR) + call error (0, "Image and mask have non-integer relative offsets") + if (abs(x2-nint(x2)) > 10*EPSILONR) + call error (0, "Image and mask have non-integer relative steps") + xoffset = nint (x1 - 1D0) + xstep = nint (x2) + + if (steptype == 1) { + call mw_c2trand (ctref, 1D0, 1D0, x1, y1) + call mw_c2trand (ctpm, x1, y1, x1, y1) + call mw_c2trand (ctref, 1D0, 2D0, x2, y2) + call mw_c2trand (ctpm, x2, y2, x2, y2) + } else { + call mw_c2trand (ctpm, 1D0, 1D0, x1, y1) + call mw_c2trand (ctref, x1, y1, x1, y1) + call mw_c2trand (ctpm, 1D0, 2D0, x2, y2) + call mw_c2trand (ctref, x2, y2, x2, y2) + } + y2 = y2 - y1 + if (abs(x1-x2) > 10*EPSILONR) + call error (0, "Image and mask have a relative rotation") + if (abs(y1-nint(y1)) > 10*EPSILONR && + abs(y1-nint(y1))-0.5 > 10*EPSILONR) + call error (0, "Image and mask have non-integer relative offsets") + if (abs(y2-nint(y2)) > 10*EPSILONR) + call error (0, "Image and mask have non-integer relative steps") + yoffset = nint (y1 - 1D0) + ystep = nint (y2) + + call mw_ctfree (ctref) + call mw_ctfree (ctpm) + call mw_close (mwref) + call mw_close (mwpm) + + # Check if the two have the same coordinate system. + if (nc==ncpm && nl==nlpm && xoffset==0 && yoffset==0 && xstep==ystep) + return + + # Create a new pixel mask of the required size and offset. + pmnew = pm_open (NULL) + call pm_ssize (pmnew, 2, IM_LEN(refim,1), 27) + imnew = im_pmmapo (pmnew, NULL) + bufref = imgl1i (imnew) + + if (steptype == 1) { + c1 = 1 + xoffset + max (0, (xstep - 1 - xoffset) / xstep) * xstep + c2 = 1 + xoffset + min (nc-1, (ncpm - 1 - xoffset) / xstep) * xstep + l1 = 1 + yoffset + max (0, (ystep - 1 - yoffset) / ystep) * ystep + l2 = 1 + yoffset + min (nl-1, (nlpm - 1 - yoffset) / ystep) * ystep + npm = c2 - c1 + 1 + nref = npm / xstep + if (nref > 0) { + call malloc (bufpm, npm, TY_INT) + call malloc (bufref, nref, TY_INT) + call amovkl (long(1), vold, IM_MAXDIM) + call amovkl (long(1), vnew, IM_MAXDIM) + vold[1] = c1 + vnew[1] = c1 - xoffset + do i = l1, l2, ystep { + vold[2] = i + if (!pm_linenotempty (pm, vold)) + next + call pmglpi (pm, vold, Memi[bufpm], 0, npm, 0) + vnew[2] = l1 - yoffset + (i - l1) / ystep + j = 0 + do k = 0, npm-1, xstep { + Memi[bufref+j] = Memi[bufpm+k] + j = j + 1 + } + call pmplpi (pmnew, vnew, Memi[bufref], 0, nref, PIX_SRC) + } + } + } else { + c1 = max (1, 1 - xoffset) + c2 = min (ncpm, nc / xstep - xoffset) + l1 = max (1, 1 - yoffset) + l2 = min (nlpm, nl / ystep - yoffset) + npm = c2 - c1 + 1 + nref = npm * xstep + if (nref > 0) { + call malloc (bufpm, npm, TY_INT) + call malloc (bufref, nref, TY_INT) + call amovkl (long(1), vold, IM_MAXDIM) + call amovkl (long(1), vnew, IM_MAXDIM) + vold[1] = c1 + vnew[1] = c1 + xoffset + do i = l1, l2 { + vold[2] = i + if (!pm_linenotempty (pm, vold)) + next + call pmglpi (pm, vold, Memi[bufpm], 0, npm, 0) + call aclri (Memi[bufref], nref) + do j = 0, npm-1 { + k = j * xstep + Memi[bufref+k] = Memi[bufpm+j] + } + vnew[2] = l1 + yoffset + (i - l1) * ystep + call pmplpi (pmnew, vnew, Memi[bufref], 0, nref, PIX_SRC) + } + } + call mfree (bufpm, TY_INT) + call mfree (bufref, TY_INT) + } + + # Update the IMIO descriptor. + call imunmap (im) + im = imnew + call imseti (im, IM_PMDES, pmnew) +end + + +# IF_ELOG -- The error function for log10. Note that MAX_EXPONENT is +# currently an integer so it is converted to the appropriate data type +# before being returned. + +real procedure if_elogr (x) + +real x # the input pixel value + +begin + return (real(-MAX_EXPONENT)) +end diff --git a/noao/nproto/ace/t_imext.x b/noao/nproto/ace/t_imext.x new file mode 100644 index 00000000..178f6937 --- /dev/null +++ b/noao/nproto/ace/t_imext.x @@ -0,0 +1,533 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <error.h> +include <syserr.h> +include <imhdr.h> +include <imset.h> + +define OUTPUTS "|none|list|file|" +define NONE 1 # No output +define LIST 2 # List output +define FILE 3 # File output + +define SZ_RANGE 100 # Size of range list +define SZ_LISTOUT 255 # Size of output list + + +# T_IMEXTENSIONS -- Expand a template of FITS files into a list of image +# extensions on the standard output and record the number image extensions +# in a parameter. + +procedure t_imextensions() + +pointer input # List of ME file names +int output # Output list (none|list|file) +pointer index # Range list of extension indexes +pointer extname # Patterns for extension names +pointer extver # Range list of extension versions +int lindex # List index number? +int lname # List extension name? +int lver # List extension version? +pointer ikparams # Image kernel parameters + +pointer sp, image, listout +int list, nimages, fd +int clgwrd(), btoi(), imextensions(), stropen() +int imtgetim(), imtlen() +bool clgetb() +errchk stropen, fprintf, strclose + +begin + call smark (sp) + call salloc (input, SZ_LINE, TY_CHAR) + call salloc (index, SZ_LINE, TY_CHAR) + call salloc (extname, SZ_LINE, TY_CHAR) + call salloc (extver, SZ_LINE, TY_CHAR) + call salloc (ikparams, SZ_LINE, TY_CHAR) + call salloc (image, SZ_FNAME, TY_CHAR) + + # Task parameters + call clgstr ("input", Memc[input], SZ_LINE) + output = clgwrd ("output", Memc[image], SZ_FNAME, OUTPUTS) + call clgstr ("index", Memc[index], SZ_LINE) + call clgstr ("extname", Memc[extname], SZ_LINE) + call clgstr ("extver", Memc[extver], SZ_LINE) + lindex = btoi (clgetb ("lindex")) + lname = btoi (clgetb ("lname")) + lver = btoi (clgetb ("lver")) + call clgstr ("ikparams", Memc[ikparams], SZ_LINE) + + # Get the list. + list = imextensions (Memc[input], Memc[index], Memc[extname], + Memc[extver], lindex, lname, lver, Memc[ikparams], YES) + + # Format the output and set the number of images. + switch (output) { + case LIST: + call salloc (listout, SZ_LISTOUT, TY_CHAR) + iferr { + fd = stropen (Memc[listout], SZ_LISTOUT, WRITE_ONLY) + nimages = 0 + while (imtgetim (list, Memc[image], SZ_FNAME) != EOF) { + nimages = nimages + 1 + if (nimages == 1) { + call fprintf (fd, "%s") + call pargstr (Memc[image]) + } else { + call fprintf (fd, ",%s") + call pargstr (Memc[image]) + } + } + call strclose (fd) + call printf ("%s\n") + call pargstr (Memc[listout]) + } then { + call imtclose (list) + call sfree (sp) + call error (1, "Output list format is too long") + } + case FILE: + while (imtgetim (list, Memc[image], SZ_FNAME) != EOF) { + call printf ("%s\n") + call pargstr (Memc[image]) + } + } + call clputi ("nimages", imtlen (list)) + + call imtclose (list) + call sfree (sp) +end + + +# IMEXTENSIONS -- Expand a template of ME files into a list of image extensions. + +int procedure imextensions (files, index, extname, extver, lindex, lname, lver, + ikparams, err) + +char files[ARB] #I List of ME files +char index[ARB] #I Range list of extension indexes +char extname[ARB] #I Patterns for extension names +char extver[ARB] #I Range list of extension versions +int lindex #I List index number? +int lname #I List extension name? +int lver #I List extension version? +char ikparams[ARB] #I Image kernel parameters +int err #I Print errors? +int list #O Image list + +int i, fd +pointer sp, temp, fname, imname, section, rindex, rextver, ikp, str +int imtopen(), imtgetim() +int ix_decode_ranges(), nowhite(), open() +errchk open, imextension, delete + +begin + call smark (sp) + call salloc (temp, SZ_FNAME, TY_CHAR) + call salloc (fname, SZ_FNAME, TY_CHAR) + call salloc (imname, SZ_FNAME, TY_CHAR) + call salloc (section, SZ_FNAME, TY_CHAR) + call salloc (ikp, SZ_LINE, TY_CHAR) + call salloc (str, SZ_LINE, TY_CHAR) + + # Expand parameters. + list = imtopen (files) + call salloc (rindex, 3*SZ_RANGE, TY_INT) + if (ix_decode_ranges (index, Memi[rindex], SZ_RANGE, i) == ERR) + call error (1, "Bad index range list") + + rextver = NULL + if (nowhite (extver, Memc[str], SZ_LINE) > 0) { + call salloc (rextver, 3*SZ_RANGE, TY_INT) + if (ix_decode_ranges (Memc[str], Memi[rextver], SZ_RANGE, i)==ERR) + call error (1, "Bad extension version range list") + } + i = nowhite (ikparams, Memc[ikp], SZ_LINE) + + # Expand ME files into list of image extensions in a temp file. + call mktemp ("@tmp$iraf", Memc[temp], SZ_FNAME) + fd = open (Memc[temp+1], NEW_FILE, TEXT_FILE) + while (imtgetim (list, Memc[fname], SZ_FNAME) != EOF) { + call imgimage (Memc[fname], Memc[imname], SZ_FNAME) + call imgsection (Memc[fname], Memc[section], SZ_FNAME) + call imextension (fd, Memc[imname], rindex, extname, rextver, + lindex, lname, lver, Memc[ikp], Memc[section], err) + } + call imtclose (list) + call close (fd) + + # Return list. + list = imtopen (Memc[temp]) + call delete (Memc[temp+1]) + call sfree (sp) + return (list) +end + + +# IMEXTENSION -- Expand a single ME file into a list of image extensions. +# The image extensions are written to the input file descriptor. + +procedure imextension (fd, fname, index, extname, extver, lindex, lname, lver, + ikparams, section, err) + +int fd #I File descriptor for list +char fname[SZ_FNAME] #I File image name (without kernel or image sec) +pointer index #I Range list of extension indexes +char extname[ARB] #I Pattern for extension names +pointer extver #I Range list of extension versions +int lindex #I List index number? +int lname #I List extension name? +int lver #I List extension version? +char ikparams[ARB] #I Image kernel parameters +char section[ARB] #I Image section +int err #I Print errors? + +bool extmatch() +int i, j, ver, ix_get_next_number(), errcode(), imgeti(), stridxs() +pointer sp, image, name, str, im, immap() +bool is_in_range() + +begin + call smark (sp) + call salloc (image, SZ_FNAME, TY_CHAR) + call salloc (name, SZ_LINE, TY_CHAR) + call salloc (str, SZ_LINE, TY_CHAR) + + i = -1 + while (ix_get_next_number (Memi[index], i) != EOF) { + j = stridxs ("[", fname) + if (j > 0) { + if (i > 0) + break + call strcpy (fname, Memc[image], SZ_FNAME) + } else { + call sprintf (Memc[image], SZ_FNAME, "%s[%d]") + call pargstr (fname) + call pargi (i) + } + iferr (im = immap (Memc[image], READ_ONLY, 0)) { + switch (errcode()) { + case SYS_FXFRFEOF: + break + case SYS_IKIEXTN: + next + case SYS_IKIOPEN: + switch (i) { + case 0: + next + case 1: + if (err == YES) + call erract (EA_WARN) + break + default: + break + } + default: + call erract (EA_ERROR) + } + } + + # Check the extension name. + if (extname[1] != EOS) { + iferr (call imgstr (im, "extname", Memc[name], SZ_LINE)) { + Memc[name] = EOS + #call imunmap (im) + #next + } + if (!extmatch (Memc[name], extname)) { + call imunmap (im) + next + } + } + + # Check the extension version. + if (extver != NULL) { + iferr (ver = imgeti (im, "extver")) { + call imunmap (im) + next + } + if (!is_in_range (Memi[extver], ver)) { + call imunmap (im) + next + } + } + + # Set the extension name and version. + if (lname == YES) { + iferr (call imgstr (im, "extname", Memc[name], SZ_LINE)) + Memc[name] = EOS + } else + Memc[name] = EOS + if (lver == YES) { + iferr (ver = imgeti (im, "extver")) + ver = INDEFI + } else + ver = INDEFI + + # Write the image name. + call fprintf (fd, fname) + if (j == 0) { + if (lindex == YES || (Memc[name] == EOS && IS_INDEFI(ver))) { + call fprintf (fd, "[%d]") + call pargi (i) + } + if (Memc[name] != EOS) { + call fprintf (fd, "[%s") + call pargstr (Memc[name]) + if (!IS_INDEFI(ver)) { + call fprintf (fd, ",%d") + call pargi (ver) + } + if (ikparams[1] != EOS) { + call fprintf (fd, ",%s") + call pargstr (ikparams) + } + call fprintf (fd, "]") + } else if (!IS_INDEFI(ver)) { + call fprintf (fd, "[extver=%d") + call pargi (ver) + if (ikparams[1] != EOS) { + call fprintf (fd, ",%s") + call pargstr (ikparams) + } + call fprintf (fd, "]") + } else if (ikparams[1] != EOS) { + call fprintf (fd, "[%s]") + call pargstr (ikparams) + } + } + call fprintf (fd, "%s") + call pargstr (section) + call fprintf (fd, "\n") + + call imunmap (im) + } + + call sfree (sp) +end + + +include <mach.h> +include <ctype.h> + +define FIRST 1 # Default starting range +define LAST MAX_INT # Default ending range +define STEP 1 # Default step +define EOLIST -1 # End of list + +# IX_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 EOLIST. + +int procedure ix_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 nonnegative 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] = EOLIST + nvalues = MAX_INT + return (OK) + } else { + ranges[1, nrange] = EOLIST + 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) + ; + if (step == 0) + return (ERR) + } 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 + + +# IX_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 ix_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] != EOLIST; ip=ip+3) { + first = min (ranges[ip], ranges[ip+1]) + last = max (ranges[ip], ranges[ip+1]) + step = ranges[ip+2] + if (step == 0) + call error (1, "Step size of zero in range list") + 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 + + +# EXTMATCH -- Match extname against a comma-delimited list of patterns. + +bool procedure extmatch (extname, patterns) + +char extname[ARB] #I Extension name to match +char patterns[ARB] #I Comma-delimited list of patterns +bool stat #O Match? + +int i, j, k, sz_pat, strlen(), patmake(), patmatch(), nowhite() +pointer sp, patstr, patbuf + +begin + stat = false + + sz_pat = strlen (patterns) + if (sz_pat == 0) + return (stat) + sz_pat = sz_pat + SZ_LINE + + call smark (sp) + call salloc (patstr, sz_pat, TY_CHAR) + call salloc (patbuf, sz_pat, TY_CHAR) + + i = nowhite (patterns, Memc[patstr], sz_pat) + if (i == 0) + stat = true + else if (i == 1 && Memc[patstr] == '*') + stat = true + else { + i = 1 + for (j=i;; j=j+1) { + if (patterns[j] != ',' && patterns[j] != EOS) + next + if (j - i > 0) { + if (j-i == 1 && patterns[i] == '*') { + stat = true + break + } + call strcpy (patterns[i], Memc[patstr+1], j-i) + Memc[patstr] = '^' + Memc[patstr+j-i+1] = '$' + Memc[patstr+j-i+2] = EOS + k = patmake (Memc[patstr], Memc[patbuf], sz_pat) + if (patmatch (extname, Memc[patbuf]) > 0) { + stat = true + break + } + } + if (patterns[j] == EOS) + break + i = j + 1 + } + } + + call sfree (sp) + return (stat) +end diff --git a/noao/nproto/ace/t_mscext.x b/noao/nproto/ace/t_mscext.x new file mode 100644 index 00000000..b57ba5cf --- /dev/null +++ b/noao/nproto/ace/t_mscext.x @@ -0,0 +1,180 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <error.h> +include <syserr.h> +include <imhdr.h> +include <imset.h> + +define OUTPUTS "|none|list|file|" +define NONE 1 # No output +define LIST 2 # List output +define FILE 3 # File output + +define SZ_RANGE 100 # Size of range list +define SZ_LISTOUT 255 # Size of output list + + +# T_MSCEXTENSIONS -- Expand a template of FITS files into a list of image +# extensions on the standard output and record the number image extensions +# in a parameter. +# +# This differs from IMEXTENSIONS in that extension zero is not returned +# unless it is a simple image and, in that case, the extension is removed. +# Also a parameter is written indicating if the list contains image extensions. + +procedure t_mscextensions() + +pointer input # List of ME file names +int output # Output list (none|list|file) +pointer index # Range list of extension indexes +pointer extname # Patterns for extension names +pointer extver # Range list of extension versions +int lindex # List index number? +int lname # List extension name? +int lver # List extension version? +pointer ikparams # Image kernel parameters + +pointer sp, image, listout +int list, nimages, fd, imext +int clgwrd(), btoi(), mscextensions(), stropen() +int imtgetim(), imtlen() +bool clgetb() +errchk stropen, fprintf, strclose + +begin + call smark (sp) + call salloc (input, SZ_LINE, TY_CHAR) + call salloc (index, SZ_LINE, TY_CHAR) + call salloc (extname, SZ_LINE, TY_CHAR) + call salloc (extver, SZ_LINE, TY_CHAR) + call salloc (ikparams, SZ_LINE, TY_CHAR) + call salloc (image, SZ_FNAME, TY_CHAR) + + # Task parameters + call clgstr ("input", Memc[input], SZ_LINE) + output = clgwrd ("output", Memc[image], SZ_FNAME, OUTPUTS) + call clgstr ("index", Memc[index], SZ_LINE) + call clgstr ("extname", Memc[extname], SZ_LINE) + call clgstr ("extver", Memc[extver], SZ_LINE) + lindex = btoi (clgetb ("lindex")) + lname = btoi (clgetb ("lname")) + lver = btoi (clgetb ("lver")) + call clgstr ("ikparams", Memc[ikparams], SZ_LINE) + + # Get the list. + list = mscextensions (Memc[input], Memc[index], Memc[extname], + Memc[extver], lindex, lname, lver, Memc[ikparams], NO, imext) + + # Format the output and set the number of images. + switch (output) { + case LIST: + call salloc (listout, SZ_LISTOUT, TY_CHAR) + iferr { + fd = stropen (Memc[listout], SZ_LISTOUT, WRITE_ONLY) + nimages = 0 + while (imtgetim (list, Memc[image], SZ_FNAME) != EOF) { + nimages = nimages + 1 + if (nimages == 1) { + call fprintf (fd, "%s") + call pargstr (Memc[image]) + } else { + call fprintf (fd, ",%s") + call pargstr (Memc[image]) + } + } + call strclose (fd) + call printf ("%s\n") + call pargstr (Memc[listout]) + } then { + call imtclose (list) + call sfree (sp) + call error (1, "Output list format is too long") + } + case FILE: + while (imtgetim (list, Memc[image], SZ_FNAME) != EOF) { + call printf ("%s\n") + call pargstr (Memc[image]) + } + } + call clputi ("nimages", imtlen (list)) + call clputb ("imext", (imext==YES)) + + call imtclose (list) + call sfree (sp) +end + + +# MSCEXTENSIONS -- Expand template of files into a list of image extensions. +# +# This differs from IMEXTENSIONS in that extension zero is not returned +# unless it is a simple image and, in that case, the extension is removed. + +int procedure mscextensions (files, index, extname, extver, lindex, lname, lver, + ikparams, err, imext) + +char files[ARB] #I List of ME files +char index[ARB] #I Range list of extension indexes +char extname[ARB] #I Patterns for extension names +char extver[ARB] #I Range list of extension versions +int lindex #I List index number? +int lname #I List extension name? +int lver #I List extension version? +char ikparams[ARB] #I Image kernel parameters +int err #I Print errors? +int imext #O Image extensions? +int list #O Image list + +int i, j, nphu, nimages, fd +pointer sp, temp, image, im, immap() +int imextensions(), gstrmatch(), imtopen(), imtgetim(), open() +errchk imextensions, open, immap, delete + +begin + call smark (sp) + call salloc (temp, SZ_FNAME, TY_CHAR) + call salloc (image, SZ_FNAME, TY_CHAR) + + # Get the list. + list = imextensions (files, index, extname, extver, lindex, lname, + lver, ikparams, err) + + # Check and edit the list. + nphu = 0 + nimages = 0 + call mktemp ("@tmp$iraf", Memc[temp], SZ_FNAME) + fd = open (Memc[temp+1], NEW_FILE, TEXT_FILE) + while (imtgetim (list, Memc[image], SZ_FNAME) != EOF) { + if (gstrmatch (Memc[image], "\[0\]", i, j) > 0) { + call strcpy (Memc[image+j], Memc[image+i-1], SZ_FNAME) + ifnoerr (im = immap (Memc[image], READ_ONLY, 0)) { + call imunmap (im) + nphu = nphu + 1 + } else + next + } else if (gstrmatch (Memc[image], "\[1\]", i, j) > 0) { + Memc[image+i] = '0' + iferr { + im = immap (Memc[image], READ_ONLY, 0) + call imunmap (im) + Memc[image+i] = '1' + } then { + nphu = nphu + 1 + call strcpy (Memc[image+j], Memc[image+i-1], SZ_FNAME) + } + } + nimages = nimages + 1 + call fprintf (fd, "%s\n") + call pargstr (Memc[image]) + } + call close (fd) + + # Return new list and extension flag. + imext = YES + if (nphu == nimages) + imext = NO + call imtclose (list) + list = imtopen (Memc[temp]) + call delete (Memc[temp+1]) + call sfree (sp) + return (list) +end diff --git a/noao/nproto/ace/tables.x b/noao/nproto/ace/tables.x new file mode 100644 index 00000000..53a0d48b --- /dev/null +++ b/noao/nproto/ace/tables.x @@ -0,0 +1,197 @@ +procedure tbcfmt (tp, cdef, str) + +pointer tp +pointer cdef +char str[ARB] + +begin +end + +procedure tbcnam (tp, cdef, str) + +pointer tp +pointer cdef +char str[ARB] + +begin +end + +procedure tbcnit (tp, cdef, str) + +pointer tp +pointer cdef +char str[ARB] + +begin +end + +procedure tbegtd (tp, cdef, row, val) + +pointer tp +pointer cdef +int row +double val + +begin +end + +procedure tbegtr (tp, cdef, row, val) + +pointer tp +pointer cdef +int row +real val + +begin +end + +procedure tbegti (tp, cdef, row, val) + +pointer tp +pointer cdef +int row +int val + +begin +end + +procedure tbegtt (tp, cdef, row, val, len) + +pointer tp +pointer cdef +int row +char val[ARB] +int len + +begin +end + +procedure tbeptd (tp, cdef, row, val) + +pointer tp +pointer cdef +int row +double val + +begin +end + +procedure tbeptr (tp, cdef, row, val) + +pointer tp +pointer cdef +int row +real val + +begin +end + +procedure tbepti (tp, cdef, row, val) + +pointer tp +pointer cdef +int row +int val + +begin +end + +procedure tbeptt (tp, cdef, row, val) + +pointer tp +pointer cdef +int row +char val[ARB] + +begin +end + +procedure tbhgtr (tp, key, val) + +pointer tp +char key[ARB] +char val[ARB] + +begin +end + +procedure tbhgtt (tp, key, val, maxchar) + +pointer tp +char key[ARB] +char val[ARB] +int maxchar + +begin +end + +procedure tbhadr (tp, key, val) + +pointer tp +char key[ARB] +char val[ARB] + +begin +end + +procedure tbhadt (tp, key, val) + +pointer tp +char key[ARB] +char val[ARB] + +begin +end + +procedure tbpsta (tp, par) + +pointer tp +int par + +begin +end + +procedure tbtclo (tp) + +pointer tp + +begin +end + +procedure tbtcre (tp) + +pointer tp + +begin +end + +pointer procedure tbtopn (fname, mode, arg) + +char fname[ARB] +int mode +pointer arg + +begin +end + +procedure tbcdef1 (tp, cdef, label, units, format, type, n) + +pointer tp +pointer cdef +char label[ARB] +char units[ARB] +char format[ARB] +int type +int n + +begin +end + +procedure tbcfnd1 (tp, label, cdef) + +pointer tp +char label[ARB] +pointer cdef + +begin +end diff --git a/noao/nproto/ace/x_ace.x b/noao/nproto/ace/x_ace.x new file mode 100644 index 00000000..c7b257b7 --- /dev/null +++ b/noao/nproto/ace/x_ace.x @@ -0,0 +1,4 @@ +task detect = t_acedetect, + evaluate = t_aceevaluate, + overlay = t_acedisplay, + skyimages = t_acesky diff --git a/noao/nproto/ace/xtmaskname.x b/noao/nproto/ace/xtmaskname.x new file mode 100644 index 00000000..9a55fb29 --- /dev/null +++ b/noao/nproto/ace/xtmaskname.x @@ -0,0 +1,114 @@ +#task test +#procedure test() +#char fname[SZ_FNAME] +#begin +# call clgstr ("fname", fname, SZ_FNAME) +# #call xt_maskname (fname, "im1", READ_ONLY, fname, SZ_FNAME) +# call xt_maskname (fname, "im1", NEW_IMAGE, fname, SZ_FNAME) +# call printf ("mname = %s\n") +# call pargstr (fname) +#end + +# MASKNAME -- Make a mask name. This creates a FITS mask extension if +# possible, otherwise it creates a pixel list file. To create a FITS +# extension the filename must explicitly select the FITS kernel or the +# default image type must be a FITS file. The input and output strings +# may be the same. + +procedure xt_maskname (fname, extname, mode, mname, maxchar) + +char fname[ARB] #I File name +char extname[ARB] #I Default pixel mask extension name +int mode #I Mode +char mname[maxchar] #O Output mask name +int maxchar #I Maximum characters in mask name + +int i, fits +pointer sp, temp + +bool streq() +int strmatch(), stridxs(), strldxs(), strncmp() +int envfind(), access(), imaccess() + +begin + call smark (sp) + call salloc (temp, maxchar, TY_CHAR) + + # Determine whether to use FITS pixel mask extensions. One may set + # fits=NO to force use of pl even when FITS mask extensions are + # supported. + fits = access ("iraf$sys/imio/iki/fxf/fxfplwrite.x", 0, 0) + if (fits == YES && envfind ("masktype", Memc[temp], maxchar) > 0) { + if (streq (Memc[temp], "pl")) + fits = NO + } + i = strldxs ("]", fname) + + # Check for explicit .pl extension. + if (strmatch (fname, ".pl$") > 0) + call strcpy (fname, mname, maxchar) + + # Check for explicit mask extension. + else if (strmatch (fname, "type=mask") > 0) + call strcpy (fname, mname, maxchar) + else if (strmatch (fname, "type\\\=mask") > 0) + call strcpy (fname, mname, maxchar) + + # Check for kernel section and add mask type. + else if (i > 0) { + if (mode != READ_ONLY) { + call strcpy (fname[i], Memc[temp], maxchar) + call sprintf (mname[i], maxchar-i, ",type=mask%s") + call pargstr (Memc[temp]) + } + + # Create output from rootname name. + } else if (fits == YES) { + call strcpy (fname, Memc[temp], SZ_FNAME) + if (mode == READ_ONLY) { + call sprintf (mname, maxchar, "%s[%s]") + call pargstr (Memc[temp]) + call pargstr (extname) + } else { + call sprintf (mname, maxchar, "%s[%s,type=mask]") + call pargstr (Memc[temp]) + call pargstr (extname) + } + } else + call strcat (".pl", mname, maxchar) + + # Convert to pl form if required. + i = stridxs ("[", mname) + if (i > 0 && mode == READ_ONLY) + fits = imaccess (mname, mode) + if (fits == NO && i > 0) { + mname[i] = EOS + if (mode == NEW_IMAGE) { + if (access (mname, 0, 0) == NO) { + ifnoerr (call fmkdir (mname)) + mname[i] = '/' + else + mname[i] = '.' + } else + mname[i] = '/' + } else { + if (access (mname, 0, 0) == NO) + mname[i] = '.' + else + mname[i] = '/' + } + + if (strncmp (mname[i+1], "type", 4) == 0 || + strncmp (mname[i+1], "append", 6) == 0 || + strncmp (mname[i+1], "inherit", 7) == 0) { + mname[i+1] = EOS + call strcat (extname, mname, maxchar) + } else { + i = stridxs (",]", mname) + mname[i] = EOS + } + call strcat (".pl", mname, maxchar) + } + + call sfree (sp) +end diff --git a/noao/nproto/ace/xtpmmap.x b/noao/nproto/ace/xtpmmap.x new file mode 100644 index 00000000..17fcf934 --- /dev/null +++ b/noao/nproto/ace/xtpmmap.x @@ -0,0 +1,603 @@ +include <mach.h> +include <ctype.h> +include <error.h> +include <imhdr.h> +include <imset.h> +include <pmset.h> +include <mwset.h> +include <syserr.h> + + +# XT_PMMAP -- Open a pixel mask READ_ONLY. +# +# This routine maps multiple types of mask files and designations. +# It matches the mask coordinates to the reference image based on the +# physical coordinate system so the mask may be of a different size. +# The mask name is returned so that the task has the name pointed to by "BPM". +# A null filename is allowed and returns NULL. + +pointer procedure yt_pmmap (pmname, refim, mname, sz_mname) + +char pmname[ARB] #I Pixel mask name +pointer refim #I Reference image pointer +char mname[ARB] #O Expanded mask name +int sz_mname #O Size of expanded mask name + +int i, flag, nowhite() +pointer sp, fname, im, ref, yt_pmmap1() +bool streq() +errchk yt_pmmap1 + +begin + call smark (sp) + call salloc (fname, SZ_FNAME, TY_CHAR) + + im = NULL + i = nowhite (pmname, Memc[fname], SZ_FNAME) + if (Memc[fname] == '!') { + iferr (call imgstr (refim, Memc[fname+1], Memc[fname], SZ_FNAME)) + Memc[fname] = EOS + } else if (streq (Memc[fname], "BPM")) { + iferr (call imgstr (refim, "BPM", Memc[fname], SZ_FNAME)) + Memc[fname] = EOS + } else if (streq (Memc[fname], "^BPM")) { + flag = INVERT_MASK + iferr (call imgstr (refim, "BPM", Memc[fname+1], SZ_FNAME)) + Memc[fname] = EOS + } + + if (Memc[fname] == '^') { + flag = INVERT_MASK + call strcpy (Memc[fname+1], Memc[fname], SZ_FNAME) + } else + flag = NO + + if (streq (Memc[fname], "EMPTY")) + ref = refim + else + ref = NULL + + if (Memc[fname] != EOS) + im = yt_pmmap1 (Memc[fname], ref, refim, flag) + call strcpy (Memc[fname], mname, sz_mname) + + call sfree (sp) + return (im) +end + + +# XT_PMUNMAP -- Unmap a mask image. +# Note that the imio pointer may be purely an internal pointer opened +# with im_pmmapo so we need to free the pl pointer explicitly. + +procedure yt_pmunmap (im) + +pointer im #I IMIO pointer for mask + +pointer pm +int imstati() + +begin + pm = imstati (im, IM_PMDES) + call pm_close (pm) + call imseti (im, IM_PMDES, NULL) + call imunmap (im) +end + + +# XT_PMMAP1 -- Open a pixel mask READ_ONLY. The input mask may be +# a pixel list image, a non-pixel list image, or a text file. +# Return error if the pixel mask cannot be opened. For pixel masks +# or image masks match the WCS. + +pointer procedure yt_pmmap1 (pmname, ref, refim, flag) + +char pmname[ARB] #I Pixel mask name +pointer ref #I Reference image for pixel mask +pointer refim #I Reference image for image or text +int flag #I Mask flag + +int imstati(), errcode() +pointer im, pm +pointer im_pmmap(), yt_pmimmap(), yt_pmtext(), yt_pmsection() +bool streq() +errchk yt_match + +begin + im = NULL + + if (streq (pmname, "STDIN")) + im = yt_pmtext (pmname, refim, flag) + + else if (pmname[1] == '[') + im = yt_pmsection (pmname, refim, flag) + + else { + ifnoerr (im = im_pmmap (pmname, READ_ONLY, ref)) { + call yt_match (im, refim) + if (flag == INVERT_MASK) { + pm = imstati (im, IM_PMDES) + call yt_pminvert (pm) + call imseti (im, IM_PMDES, pm) + } + } else { + switch (errcode()) { + case SYS_IKIOPEN, SYS_FOPNNEXFIL, SYS_PLBADSAVEF, SYS_FOPEN: + ifnoerr (im = yt_pmimmap (pmname, refim, flag)) + call yt_match (im, refim) + else { + switch (errcode()) { + case SYS_IKIOPEN: + im = yt_pmtext (pmname, refim, flag) + default: + call erract (EA_ERROR) + } + } + default: + call erract (EA_ERROR) + } + } + } + + return (im) +end + + +# XT_PMIMMAP -- Open a pixel mask from a non-pixel list image. +# Return error if the image cannot be opened. + +pointer procedure yt_pmimmap (pmname, refim, flag) + +char pmname[ARB] #I Image name +pointer refim #I Reference image pointer +int flag #I Mask flag + +int i, ndim, npix, rop, val +pointer sp, v1, v2, im_in, im_out, pm, mw, data + +int imstati(), imgnli() +pointer immap(), pm_newmask(), im_pmmapo(), imgl1i(), mw_openim() +errchk immap, mw_openim + +begin + call smark (sp) + call salloc (v1, IM_MAXDIM, TY_LONG) + call salloc (v2, IM_MAXDIM, TY_LONG) + + call amovkl (long(1), Meml[v1], IM_MAXDIM) + call amovkl (long(1), Meml[v2], IM_MAXDIM) + + im_in = immap (pmname, READ_ONLY, 0) + pm = imstati (im_in, IM_PMDES) + if (pm != NULL) + return (im_in) + + pm = pm_newmask (im_in, 16) + + ndim = IM_NDIM(im_in) + npix = IM_LEN(im_in,1) + + if (flag == INVERT_MASK) + rop = PIX_NOT(PIX_SRC) + else + rop = PIX_SRC + + while (imgnli (im_in, data, Meml[v1]) != EOF) { + if (flag == INVERT_MASK) { + do i = 0, npix-1 { + val = Memi[data+i] + if (val <= 0) + Memi[data+i] = 1 + else + Memi[data+i] = 0 + } + } else { + do i = 0, npix-1 { + val = Memi[data+i] + if (val < 0) + Memi[data+i] = 0 + } + } + call pmplpi (pm, Meml[v2], Memi[data], 0, npix, rop) + call amovl (Meml[v1], Meml[v2], ndim) + } + + im_out = im_pmmapo (pm, im_in) + data = imgl1i (im_out) # Force I/O to set header + mw = mw_openim (im_in) # Set WCS + call mw_saveim (mw, im_out) + call mw_close (mw) + + #call imunmap (im_in) + call yt_pmunmap (im_in) + call sfree (sp) + return (im_out) +end + + +# XT_PMTEXT -- Create a pixel mask from a text file of rectangles. +# Return error if the file cannot be opened. +# This routine only applies to the first 2D plane. + +pointer procedure yt_pmtext (pmname, refim, flag) + +char pmname[ARB] #I Image name +pointer refim #I Reference image pointer +int flag #I Mask flag + +int fd, nc, nl, c1, c2, l1, l2, nc1, nl1, rop +pointer pm, im, mw, dummy + +int open(), fscan(), nscan() +pointer pm_newmask(), im_pmmapo(), imgl1i(), mw_openim() +errchk open + +begin + fd = open (pmname, READ_ONLY, TEXT_FILE) + pm = pm_newmask (refim, 16) + + nc = IM_LEN(refim,1) + nl = IM_LEN(refim,2) + + if (flag == INVERT_MASK) + call pl_box (pm, 1, 1, nc, nl, PIX_SET+PIX_VALUE(1)) + + while (fscan (fd) != EOF) { + call gargi (c1) + call gargi (c2) + call gargi (l1) + call gargi (l2) + if (nscan() != 4) { + if (nscan() == 2) { + l1 = c2 + c2 = c1 + l2 = l1 + } else + next + } + + c1 = max (1, c1) + c2 = min (nc, c2) + l1 = max (1, l1) + l2 = min (nl, l2) + nc1 = c2 - c1 + 1 + nl1 = l2 - l1 + 1 + if (nc1 < 1 || nl1 < 1) + next + + # Select mask value based on shape of rectangle. + if (flag == INVERT_MASK) + rop = PIX_CLR + else if (nc1 <= nl1) + rop = PIX_SET+PIX_VALUE(2) + else + rop = PIX_SET+PIX_VALUE(3) + + # Set mask rectangle. + call pm_box (pm, c1, l1, c2, l2, rop) + } + + call close (fd) + im = im_pmmapo (pm, refim) + dummy = imgl1i (im) # Force I/O to set header + mw = mw_openim (refim) # Set WCS + call mw_saveim (mw, im) + call mw_close (mw) + + return (im) +end + + +# XT_PMSECTION -- Create a pixel mask from an image section. +# This only applies the mask to the first plane of the image. + +pointer procedure yt_pmsection (section, refim, flag) + +char section[ARB] #I Image section +pointer refim #I Reference image pointer +int flag #I Mask flag + +int i, j, ip, temp, a[2], b[2], c[2], rop, ctoi() +pointer pm, im, mw, dummy, pm_newmask(), im_pmmapo(), imgl1i(), mw_openim() +define error_ 99 + +begin + # This is currently only for 1D and 2D images. + if (IM_NDIM(refim) > 2) + call error (1, "Image sections only allowed for 1D and 2D images") + + # Decode the section string. + call amovki (1, a, 2) + call amovki (1, b, 2) + call amovki (1, c, 2) + do i = 1, IM_NDIM(refim) + b[i] = IM_LEN(refim,i) + + ip = 1 + while (IS_WHITE(section[ip])) + ip = ip + 1 + if (section[ip] == '[') { + ip = ip + 1 + + do i = 1, IM_NDIM(refim) { + while (IS_WHITE(section[ip])) + ip = ip + 1 + + # Get a:b:c. Allow notation such as "-*:c" + # (or even "-:c") where the step is obviously negative. + + if (ctoi (section, ip, temp) > 0) { # a + a[i] = temp + if (section[ip] == ':') { + ip = ip + 1 + if (ctoi (section, ip, b[i]) == 0) # a:b + goto error_ + } else + b[i] = a[i] + } else if (section[ip] == '-') { # -* + temp = a[i] + a[i] = b[i] + b[i] = temp + ip = ip + 1 + if (section[ip] == '*') + ip = ip + 1 + } else if (section[ip] == '*') # * + ip = ip + 1 + if (section[ip] == ':') { # ..:step + ip = ip + 1 + if (ctoi (section, ip, c[i]) == 0) + goto error_ + else if (c[i] == 0) + goto error_ + } + if (a[i] > b[i] && c[i] > 0) + c[i] = -c[i] + + while (IS_WHITE(section[ip])) + ip = ip + 1 + if (i < IM_NDIM(refim)) { + if (section[ip] != ',') + goto error_ + } else { + if (section[ip] != ']') + goto error_ + } + ip = ip + 1 + } + } + + # In this case make the values be increasing only. + do i = 1, IM_NDIM(refim) + if (c[i] < 0) { + temp = a[i] + a[i] = b[i] + b[i] = temp + c[i] = -c[i] + } + + # Make the mask. + pm = pm_newmask (refim, 16) + + if (flag == INVERT_MASK) { + rop = PIX_SET+PIX_VALUE(1) + call pm_box (pm, 1, 1, IM_LEN(refim,1), IM_LEN(refim,2), rop) + rop = PIX_CLR + } else + rop = PIX_SET+PIX_VALUE(1) + + if (c[1] == 1 && c[2] == 1) + call pm_box (pm, a[1], a[2], b[1], b[2], rop) + + else if (c[1] == 1) + for (i=a[2]; i<=b[2]; i=i+c[2]) + call pm_box (pm, a[1], i, b[1], i, rop) + + else + for (i=a[2]; i<=b[2]; i=i+c[2]) + for (j=a[1]; j<=b[1]; j=j+c[1]) + call pm_point (pm, j, i, rop) + + im = im_pmmapo (pm, refim) + dummy = imgl1i (im) # Force I/O to set header + mw = mw_openim (refim) # Set WCS + call mw_saveim (mw, im) + call mw_close (mw) + + return (im) + +error_ + call error (1, "Error in image section specification") +end + + +# XT_PMINVERT -- Invert a pixel mask by changing 0 to 1 and non-zero to zero. + +procedure yt_pminvert (pm) + +pointer pm #I Pixel mask to be inverted + +int i, naxes, axlen[IM_MAXDIM], depth, npix, val +pointer sp, v, buf, one +bool pm_linenotempty() + +begin + call pm_gsize (pm, naxes, axlen, depth) + + call smark (sp) + call salloc (v, IM_MAXDIM, TY_LONG) + call salloc (buf, axlen[1], TY_INT) + call salloc (one, 6, TY_INT) + + npix = axlen[1] + RLI_LEN(one) = 2 + RLI_AXLEN(one) = npix + Memi[one+3] = 1 + Memi[one+4] = npix + Memi[one+5] = 1 + + call amovkl (long(1), Meml[v], IM_MAXDIM) + repeat { + if (pm_linenotempty (pm, Meml[v])) { + call pmglpi (pm, Meml[v], Memi[buf], 0, npix, 0) + do i = 0, npix-1 { + val = Memi[buf+i] + if (val == 0) + Memi[buf+i] = 1 + else + Memi[buf+i] = 0 + } + call pmplpi (pm, Meml[v], Memi[buf], 0, npix, PIX_SRC) + } else + call pmplri (pm, Meml[v], Memi[one], 0, npix, PIX_SRC) + + do i = 2, naxes { + Meml[v+i-1] = Meml[v+i-1] + 1 + if (Meml[v+i-1] <= axlen[i]) + break + else if (i < naxes) + Meml[v+i-1] = 1 + } + } until (Meml[v+naxes-1] > axlen[naxes]) + + call sfree (sp) +end + + +# XT_MATCH -- Set the pixel mask to match the reference image. +# This matches sizes and physical coordinates and allows the +# original mask to be smaller or larger than the reference image. +# Subsequent use of the pixel mask can then work in the logical +# coordinates of the reference image. The mask values are the maximum +# of the mask values which overlap each reference image pixel. +# A null input returns a null output. + +procedure yt_match (im, refim) + +pointer im #U Pixel mask image pointer +pointer refim #I Reference image pointer + +int i, j, k, l, i1, i2, j1, j2, nc, nl, ncpm, nlpm, nx, val +double x1, x2, y1, y2, lt[6], lt1[6], lt2[6] +long vold[IM_MAXDIM], vnew[IM_MAXDIM] +pointer pm, pmnew, imnew, mw, ctx, cty, bufref, bufpm + +int imstati() +double mw_c1trand() +pointer pm_open(), mw_openim(), im_pmmapo(), imgl1i(), mw_sctran() +bool pm_empty(), pm_linenotempty() +errchk pm_open, mw_openim + +begin + if (im == NULL) + return + + # Set sizes. + nc = IM_LEN(refim,1) + nl = IM_LEN(refim,2) + ncpm = IM_LEN(im,1) + nlpm = IM_LEN(im,2) + + # If the mask is empty and the sizes are the same then it does not + # matter if the two are actually matched in physical coordinates. + pm = imstati (im, IM_PMDES) + if (pm_empty(pm) && nc == ncpm && nl == nlpm) + return + + # Compute transformation between reference (logical) coordinates + # and mask (physical) coordinates. + + mw = mw_openim (im) + call mw_gltermd (mw, lt, lt[5], 2) + call mw_close (mw) + + mw = mw_openim (refim) + call mw_gltermd (mw, lt2, lt2[5], 2) + call mw_close (mw) + + # Combine lterms. + call mw_invertd (lt, lt1, 2) + call mw_mmuld (lt1, lt2, lt, 2) + call mw_vmuld (lt, lt[5], lt[5], 2) + lt[5] = lt2[5] - lt[5] + lt[6] = lt2[6] - lt[6] + do i = 1, 6 + lt[i] = nint (1D6 * (lt[i]-int(lt[i]))) / 1D6 + int(lt[i]) + + # Check for a rotation. For now don't allow any rotation. + if (lt[2] != 0. || lt[3] != 0.) + call error (1, "Image and mask have a relative rotation") + + # Check for an exact match. + if (lt[1] == 1D0 && lt[4] == 1D0 && lt[5] == 0D0 && lt[6] == 0D0) + return + + # Set reference to mask coordinates. + mw = mw_openim (im) + call mw_sltermd (mw, lt, lt[5], 2) + ctx = mw_sctran (mw, "logical", "physical", 1) + cty = mw_sctran (mw, "logical", "physical", 2) + + # Create a new pixel mask of the required size and offset. + # Do dummy image I/O to set the header. + pmnew = pm_open (NULL) + call pm_ssize (pmnew, 2, IM_LEN(refim,1), 27) + imnew = im_pmmapo (pmnew, NULL) + bufref = imgl1i (imnew) + + # Compute region of mask overlapping the reference image. + x1 = mw_c1trand (ctx, 1-0.5D0) + x2 = mw_c1trand (ctx, nc+0.5D0) + i1 = max (1, nint(min(x1,x2)+1D-5)) + i2 = min (ncpm, nint(max(x1,x2)-1D-5)) + y1 = mw_c1trand (cty, 1-0.5D0) + y2 = mw_c1trand (cty, nl+0.5D0) + j1 = max (1, nint(min(y1,y2)+1D-5)) + j2 = min (nlpm, nint(max(y1,y2)-1D-5)) + + # Set the new mask values to the maximum of all mask values falling + # within each reference pixel in the overlap region. + if (i1 >= i2 && j1 >= j2) { + nx = i2 - i1 + 1 + call malloc (bufpm, nx, TY_INT) + call malloc (bufref, nc, TY_INT) + vold[1] = i1 + vnew[1] = 1 + do j = 1, nl { + y1 = mw_c1trand (cty, j-0.5D0) + y2 = mw_c1trand (cty, j+0.5D0) + j1 = max (1, nint(min(y1,y2)+1D-5)) + j2 = min (nlpm, nint(max(y1,y2)-1D-5)) + if (j2 < j1) + next + + vnew[2] = j + call aclri (Memi[bufref], nc) + do l = j1, j2 { + vold[2] = l + if (!pm_linenotempty (pm, vold)) + next + call pmglpi (pm, vold, Memi[bufpm], 0, nx, 0) + do i = 1, nc { + x1 = mw_c1trand (ctx, i-0.5D0) + x2 = mw_c1trand (ctx, i+0.5D0) + i1 = max (1, nint(min(x1,x2)+1D-5)) + i2 = min (ncpm, nint(max(x1,x2)-1D-5)) + if (i2 < i1) + next + val = Memi[bufref+i-1] + do k = i1-vold[1], i2-vold[1] + val = max (val, Memi[bufpm+k]) + Memi[bufref+i-1] = val + } + } + call pmplpi (pmnew, vnew, Memi[bufref], 0, nc, PIX_SRC) + } + call mfree (bufref, TY_INT) + call mfree (bufpm, TY_INT) + } + + call mw_close (mw) + call yt_pmunmap (im) + im = imnew + call imseti (im, IM_PMDES, pmnew) +end diff --git a/noao/nproto/binpairs.par b/noao/nproto/binpairs.par new file mode 100644 index 00000000..1bdb1ed3 --- /dev/null +++ b/noao/nproto/binpairs.par @@ -0,0 +1,8 @@ +# BINPAIRS -- Bin data points by log separation + +file1,f,a,,,,"File containing (x,y) points to be paired" +file2,f,a,,,,"File containing (x,y) points to be paired" +rmin,r,a,,,,Minimum separation for bins +rmax,r,a,,,,Maximum separation for bins +nbins,i,a,,,,Number of separation bins +verbose,b,h,no,,,Print progress information? diff --git a/noao/nproto/doc/binpairs.hlp b/noao/nproto/doc/binpairs.hlp new file mode 100644 index 00000000..09a019d0 --- /dev/null +++ b/noao/nproto/doc/binpairs.hlp @@ -0,0 +1,54 @@ +.help binpairs Oct84 noao.nproto +.ih +NAME +binpairs -- Bin pairs of (x,y) points in log separation +.ih +USAGE +binpairs file1 file2 rmin rmax nbins +.ih +PARAMETERS +.ls file1 +File containing (x,y) points to be paired. +.le +.ls file2 +File containing (x,y) points to be paired. This file may be the same +as file1. +.le +.ls rmin +The minimum separation to be binned. +.le +.ls rmax +The maximum separation to be binned. +.le +.ls nbins +The number of log separation bins to be computed. +.le +.ls verbose = no +Print progress information? +.le +.ih +DESCRIPTION +The (x,y) points in the specified files are paired and the number of pairs +in each bin of log separation is computed and output. The two files may +be the same. There are +\fInbins\fR separation bins between the separations \fIrmin\fR and \fIrmax\fR. +If the verbose parameter is yes then progress information is printed on the +standard error output at intervals of 5% of the time. +The output consists of the lower limit of the separation bin, the number of +pairs in the bin, the number of pairs divided by the total number of pairs, +and the annular area of the bin. + +This task is useful for computing two point correlation functions. +.ih +EXAMPLES + +.nf + cl> binpairs data1 data2 .01 1 20 >> result + + or + + cl> binpairs data data .01 1 20 >> result +.fi +.ih +SEE ALSO +.endhelp diff --git a/noao/nproto/doc/findgain.hlp b/noao/nproto/doc/findgain.hlp new file mode 100644 index 00000000..3c730007 --- /dev/null +++ b/noao/nproto/doc/findgain.hlp @@ -0,0 +1,131 @@ +.help findgain Apr92 noao.nproto +.ih +NAME +findgain -- calculate the gain and readout noise of a CCD +.ih +USAGE +findgain flat1 flat2 bias1 bias2 +.ih +PARAMETERS +.ls flat1, flat2 +First and second dome flats. +.le +.ls bias1, bias2 +First and second bias frames (zero length dark exposures). +.le +.ls section = "[*,*]" +The selected image section for the statistics. This should be chosen +to exclude bad columns or rows, cosmic rays and other blemishes, and +the overscan region. The flat field iillumination should be constant +over this section. Special care should be taken with spectral data! +.le +.ls center = "mean" +The statistical measure of central tendency that is used to estimate +the data level of each image. This can have the values: \fBmean\fR, +\fBmidpt\fR, or \fBmode\fR. These are calculated using the same +algorithm as the IMSTATISTICS task. +.le +.ls binwidth = 0.1 +The bin width of the histogram (in sigma) that is used to estimate the +\fBmidpt\fR or \fBmode\fR of the data section in each image. +The default case of center=\fBmean\fR does not use this parameter. +.le +.ls verbose = yes +Label the gain and readnoise on output, rather than print them two per +line? +.le +.ih +DESCRIPTION +FINDGAIN uses Janesick's method for determining the gain and read noise +of a CCD from a pair of dome flats and a pair of bias frames (zero +length dark exposures). The task requires that the flats and biases be +unprocessed and uncoadded so that the noise characteristics of the data +are preserved. Note, however, that the frames may be bias subtracted +if the average of many bias frames is used, and that the overscan +region may be removed prior to using this task. + +The section over which the statistics are computed should be chosen +carefully. The frames may be displayed and perhaps blinked, and +IMSTATISTICS, IMHISTOGRAM, IMPLOT, and other tasks may be used to +compare the statistics of sections of various flats and biases directly. +.ih +ALGORITHM +The formulae used by the task are: + +.nf + flatdif = flat1 - flat2 + + biasdif = bias1 - bias2 + + gain = ((mean(flat1) + mean(flat2)) - (mean(bias1) + mean(bias2))) / + ((sigma(flatdif))**2 - (sigma(biasdif))**2 ) + + readnoise = gain * sigma(biasdif) / sqrt(2) +.fi + +Where the gain is given in electrons per ADU and the readnoise in +electrons. Pairs of each type of comparison frame are used to reduce +the effects of gain variations from pixel to pixel. The derivation +follows from the definition of the gain (N(e) = gain * N(ADU)) and from +simple error propagation. Also note that the measured variance +(sigma**2) is related to the exposure level and read-noise variance +(sigma(readout)**2) as follows: + +.nf + variance(e) = N(e) + variance(readout) +.fi + +Where N(e) is the number of electrons (above the bias level) in a +given duration exposure. + +In our implementation, the \fBmean\fR used in the formula for the gain +may actually be any of the \fBmean\fR, \fBmidpt\fR (an estimate of the +median), or \fBmode\fR as determined by the \fBcenter\fR parameter. +For the \fBmidpt\fR or \fBmode\fR choices only, the value of the +\fBbinwidth\fR parameter determines the bin width (in sigma) of the +histogram that is used in the calculation. FINDGAIN uses the +IMSTATISTICS task to compute the statistics. +.ih +EXAMPLES +To calculate the gain and readnoise within a 100x100 section: + +.nf + lo> findgain flat1 flat2 bias1 bias2 section="[271:370,361:460]" +.fi + +To calculate the gain and readnoise using the mode to estimate the data +level for each image section: + +.nf + lo> findgain.section="[271:370,361:460]" + lo> findgain flat1 flat2 bias1 bias2 center=mode +.fi + +To calculate the gain and readnoise from several frames and accumulate +the results in a file for graphing: + +.nf + lo> findgain.section = "[41:140,171:270]" + lo> findgain flat1 flat2 bias1 bias2 verbose- > gain.list + lo> findgain flat3 flat4 bias3 bias4 verbose- >> gain.list + lo> findgain flat5 flat6 bias5 bias6 verbose- >> gain.list + lo> findgain flat7 flat8 bias7 bias8 verbose- >> gain.list + lo> findgain flat9 flat10 bias9 bias10 verbose- >> gain.list + lo> plot + pl> graph gain.list point+ +.fi + +It is not obvious what to do with all the other combinations of flats +and biases. Note that the values in gain.list could have been averaged +or fit as well. +.ih +BUGS +The image headers are not checked to see if the frames have been +processed. + +There is no provision for finding the "best" values and their errors +from several flats and biases. +.ih +SEE ALSO +findthresh, imstatistics, imhistogram, implot +.endhelp diff --git a/noao/nproto/doc/findthresh.hlp b/noao/nproto/doc/findthresh.hlp new file mode 100644 index 00000000..386d25c1 --- /dev/null +++ b/noao/nproto/doc/findthresh.hlp @@ -0,0 +1,128 @@ +.help findthresh Apr92 noao.nproto +.ih +NAME +findthresh -- Estimate the background noise level of a CCD +.ih +USAGE +findthresh data +.ih +PARAMETERS +.ls data +The level of the sky (or any other data level, for that matter) in A/D +units, for which the random error is to be estimated. If this is not +given on the command line and a list of \fBimages\fR is specified then +the data level will be measured from the images. +.le +.ls images = "" +If not NULL ("") and if \fBdata\fR is not specified, this is a list of +images whose random background error per pixel is to be estimated. +.le +.ls section = "[*,*]" +The selected image section for the statistics. This should be chosen +to exclude bad columns or rows, cosmic rays, and other blemishes. +.le +.ls gain +The CCD gain in electrons/ADU. +This may be estimated using the FINDGAIN task. +.le +.ls readnoise +The CCD read noise in electrons. +This may be estimated using the FINDGAIN task. +.le +.ls nframes = 1 +The number of raw data frames that were coadded or averaged +to produce the \fBimages\fR. If this is not set to 1, the +\fBcoaddtype\fR parameter must also be set to the proper value. +.le +.ls coaddtype = "average" +For coadded frames (\fBnframes\fR > 1) the type of combination +that was done, either "average" or "sum". +.le +.ls center = "mean" +The statistical measure of central tendency that is used to estimate +the data level of each image. This can have the values: \fBmean\fR, +\fBmidpt\fR, or \fBmode\fR. These are calculated using the same +algorithm as the IMSTATISTICS task. +.le +.ls binwidth = 0.1 +The bin width of the histogram (in sigma) that is used to estimate the +\fBmidpt\fR or \fBmode\fR of the data section in each image. +The default case of center=\fBmean\fR does not use this parameter. +.le +.ls verbose = yes +Label the computed and measured background noise on output, +rather than print them two per line? +.le +.ih +DESCRIPTION +FINDTHRESH can be used to estimate the expected random error per pixel +(in ADU) of the sky background of a CCD image, given the \fBgain\fR (in +electrons per ADU) and \fBreadnoise\fR (in electrons) of the CCD. The +sky background (or any other data level of interest) can be specified +directly with the \fBdata\fR parameter, or the representative values can +be measured from a specified list of \fBimages\fR as also governed by +the \fBsection\fR, \fBcenter\fR, and \fBbinwidth\fR parameters. +FINDTHRESH can be used with processed frames that are the coaddition or +average of several raw images by choosing the correct values for the +\fBnframes\fR and \fBcoaddtype\fR parameters. In this case +(\fBnframes\fR > 1), the effective gain and effective readnoise of the +coadded frames will also be printed out. + +The section over which the statistics of the \fBimages\fR are computed +should be chosen carefully. The frames may be displayed and perhaps +blinked, and IMSTATISTICS, IMHISTOGRAM, IMPLOT, and other tasks may be +used to compare the statistics of various sections of the images directly. +.ih +ALGORITHM +The formula used by the task is: + +.nf + random error in 1 pixel = sqrt (data*p(N) + r(N)**2) / p(N) +.fi + +Where the effective gain, p(N), is given in electrons per ADU and +the effective readnoise, r(N), is given in electrons. The effective +gain and readnoise are calculated from the intrinsic \fBgain\fR and +\fBreadnoise\fR, specified as parameters to the task, by the relations: + +.nf + p(N) = N * \fBgain\fR (only if the frames were \fBaveraged\fR) + r(N) = sqrt(N) * \fBreadnoise\fR (whether averaged \fBor\fR summed frames) +.fi + +In our implementation, the level of the sky can be calculated using any +of the \fBmean\fR, \fBmidpt\fR (an estimate of the median), or \fBmode\fR +as determined by the \fBcenter\fR parameter. For the \fBmidpt\fR or +\fBmode\fR choices only, the value of the \fBbinwidth\fR parameter +determines the bin width (in sigma) of the histogram that is used in +the calculation. FINDTHRESH uses the IMSTATISTICS task to measure the +statistics. +.ih +EXAMPLES +To estimate the CCD background noise at a specified data level, gain and +readnoise (note that you will be prompted for the gain and the readnoise +if you don't set them either explicitly on the command line, or previously +using, for example, eparam): + +.nf + lo> findthresh 100 gain=2.3 readnoise=13. +.fi + +To estimate the CCD background noise within a 100x100 section +of a list of images, data*.imh: + +.nf + lo> findthresh data*.imh section="[271:370,361:460]" +.fi + +To estimate the CCD background noise using the mode to estimate the +sky level for each image section: + +.nf + lo> findthresh.section="[271:370,361:460]" + lo> findthresh data*.imh center=mode +.fi +.ih +SEE ALSO +findgain, imstatistics, imhistogram +.endhelp diff --git a/noao/nproto/doc/iralign.hlp b/noao/nproto/doc/iralign.hlp new file mode 100644 index 00000000..34ec5a5a --- /dev/null +++ b/noao/nproto/doc/iralign.hlp @@ -0,0 +1,220 @@ +.help iralign Sep93 noao.nproto +.ih +NAME +iralign -- align the elements of the mosaiced image +.ih +USAGE +iralign input output database coords +.ih +PARAMETERS +.ls input +The mosaiced image written by IRMOSAIC. +.le +.ls output +The output aligned image. +.le +.ls database +The database file written by IRMOSAIC. +.le +.ls coords +If \fIalignment\fR = "coords", then \fBcoords\fR is +a text file containing the x and y coordinates, measured in the input +mosaiced image, of reference objects common +to adjacent subrasters in the input mosaiced +image. The reference coordinates are written with the following format: +line 1) the x and y coordinates of an object in the any subraster, +line 2) the x and y coordinates of the same object in any adjacent subraster, +line 3) the x and y coordinates of another object in the any subraster, +line 4) the x and y coordinates of the same object in any adjacent subraster, +etc. +If \fIalignment\fR = "file", then \fBcoords\fR is a text file containing +the x and y shifts in columns 1 and 2 respectively, +of each subraster relative to the reference subraster, in the order +in which the subrasters were written into the mosaiced input image. +This option can be used to make fine adjustments to the output aligned image +by manually editing the computed shifts and rerunning +IRALIGN with the new shifts. +.le +.ls xshift +The x shift in pixels used if \fIalignment\fR = "shifts". +.le +.ls yshift +The y shift in pixels used if \fIalignment\fR = "shifts". +.le +.ls alignment = "coords" +The method of aligning the subraster. +.ls coords +The x and y positions of the reference points common to adjacent subrasters +in the input mosaiced image are listed in a text file as described +under the help for the \fIcoords\fR parameter. +.le +.ls shifts +The x and y shifts of each subraster with respect to its neighbour are +set to \fIxshift\fR and \fIyshift\fR. +.le +.ls file +The x and y shifts of each input subraster with respect to the +reference subraster image are listed in a text file as described +under the help for the \fIcoords\fR parameter. +.le +.le +.ls nxrsub = INDEF, ls nyrsub = INDEF +The column and row index of the reference subraster. +The default reference subraster is the central subraster. +.le +.ls xref = 0, yref = 0 +The x and y offset of the reference +subraster in the output aligned image. +By default the reference subraster occupies the same position in +the output image that it does in the input image. +.le +.ls trimlimits = "[1:1,1:1]" +The number of columns or rows to trim off each edge of each input subraster +before inserting it in the output image, specified in image section notation. +The default action is to trim 1 column or line at each edge of the subraster. +.le +.ls nimcols = INDEF, nimlines = INDEF +The number of columns and lines in the output image. The defaults are the +number of columns and lines in the input image. +.le +.ls oval = INDEF +The value of undefined pixels in the output image. The default is the value +stored in the database file written by IRMOSAIC. +.le +.ls interpolant = linear +The type of interpolant used to shift the subrasters. The options are: +.ls nearest +Nearest neighbour interpolation. +.le +.ls linear +Bilinear interpolation. +.le +.ls poly3 +Bicubic polynomial interpolation. +.le +.ls poly5 +Biquintic polynomial interpolation. +.le +.ls spline3 +Bicubic spline interpolation. +.le +.le +.ls verbose = yes +Print messages on the terminal describing the progress of the task? +.le +.ih +DESCRIPTION +IRALIGN takes the mosaiced image \fIinput\fR and database +\fIdatabase\fR files +written by IRMOSAIC, and a list of reference object +coordinates \fIcoords\fR created by the user, and writes +an output image \fIoutput\fR in which all the subrasters are aligned +with respect to a reference subraster. + +If \fIalignment\fR = "coords", IRALIGN accumulates the relative shifts +between adjacent subrasters defined by the data in \fIcoords\fR, +into a total shift for each subraster with respect to the reference subraster. +Relative shifts defined for non-adjacent subrasters are ignored. +For those subrasters which have no relative shift information, +IRALIGN makes a best guess at the relative x and y shifts +based on the relative x andy shifts of nearby subrasters +which do have relative shift information. If the x and y shifts +are sufficiently uniform over the whole input image the user may set +\fIalignment\fR to "shifts" and supply values for +\fIxshift\fR and \fIyshift\fR. +Alternatively the total shifts may be read directly from the file \fIcoords\fR +if \fIalignment\fR = "file". + +Coordinate lists for the \fIalignment\fR = "coords" option, +may be generated interactively using the RIMCURSOR, +or APPHOT package CENTER and APSELECT tasks. For example a coordinate list +written by RIMCURSOR for a +4 by 4 mosaic of 51 by 51 pixel square images containing a single +reference object common to all the subrasters might look like the following. + +.nf +41.3 42.6 1 \40 # coordinates of ref object in subraster 1 +62.0 38.5 1 \40 # coordinates of ref object in subraster 2 +41.3 42.6 1 \40 # coordinates of ref object in subraster 1 +38.1 95.8 1 \40 # coordinates of ref object in subraster 3 +62.0 38.5 1 \40 # coordinates of ref object in subraster 2 +70.3 89.0 1 \40 # coordinates of ref object in subraster 4 +38.1 95.8 1 \40 # coordinates of ref object in subraster 3 +70.3 89.0 1 \40 # coordinates of ref object in subraster 4 +.fi + +In this example subrasters 1 and 2 are in the lower-left and +lower-right hand corners of +the mosaiced image respectively, while subrasters 3 and 4 are in the +upper-left and upper- right hand corner of the mosaiced image. +Any number of reference objects may be used. + +The subrasters are inserted into the output image using the +interpolation scheme defined by +\fIinterpolant\fR, and aligned with reference to the subraster defined +by \fInxrsub\fR and \fInyrsub\fR, using the shifts defined by +the data in the file \fIcoords\fR or defined by \fIxshift\fR and +\fIyshift\fR. Subrasters are inserted into the output image in the order +they were placed in the original mosaic with pixels in the most recently +placed subrasters replacing those in earlier placed ones in the overlap regions. +Undefined pixels in the output image +are assigned the value \fIoval\fR. The position of the reference subraster +in the output image may be adjusted by setting the offset parameters +\fIxref\fR and \fIyref\fR. The edges of each subraster may be trimmed +before insertion into the output image by setting the \fItrimlimits\fR +parameter. + +.ih +EXAMPLES + +1. Align an 8 by 8 mosaic with respect to subraster 6, 5. + +.nf + pr> iralign mosaic mosaic.al mosaic.db coords nxrsub=6 \ + nyrsub=5 +.fi + +2. Align an 8 by 8 mosaic as in example 1 above but shift the position of the +reference subraster in the output image by 2 pixels in x and 3 pixels +in y. + +.nf + pr> iralign mosaic mosaic.al mosaic.db coords nxrsub=6 \ + nyrsub=5 xref=2 yref=3 +.fi + +3. Align an 8 by 8 mosaic as 1 above but trim 2 rows and columns off +of each input subraster before inserting it into the output image. + +.nf + pr> iralign mosaic mosaic.al mosaic.db coords nxrsub=6 \ + nyrsub=5 trimlimits="[2:2,2:2]" +.fi + +4. Rerun the above example saving the verbose output in a file. Use the +PROTO package FIELDS task to select the xshift, yshift and intensity +shift fields, edit the shifts manually and rerun IRALIGN with the +new shifts. + +.nf + pr> iralign mosaic mosaic.al mosaic.db coords nxrsub=6 \ + nyrsub=5 trimlimits="[2:2,2:2]" > shifts1 + + pr> fields shifts1 3,4,6 > shifts2 + + pr> edit shifts2 + + ... make whatever changes are desired + + pr> iralign mosaic mosaic.al.2 mosaic.db shifts2 align=file \ + nxrsub=6 nyrsub=5 trimlimits="[2:2,2:2]" +.fi + +.ih +TIME REQUIREMENTS +.ih +BUGS +.ih +SEE ALSO +irmosaic, apphot.center, apphot.apselect, irmatch1d, irmatch2d +.endhelp diff --git a/noao/nproto/doc/irmatch1d.hlp b/noao/nproto/doc/irmatch1d.hlp new file mode 100644 index 00000000..221d75cd --- /dev/null +++ b/noao/nproto/doc/irmatch1d.hlp @@ -0,0 +1,211 @@ +.help irmatch1d Jan90 noao.nproto +.ih +NAME +irmatch1d -- align and match the elements of the mosaiced image +.ih +USAGE +irmatch1d input output database coords +.ih +PARAMETERS +.ls input +The mosaiced image to be aligned. This image must have been produced by +the IRMOSAIC task and have an accompanying database file specified by +\fIdatabase\fR. +.le +.ls output +The aligned image produced by IRMATCH1D. +.le +.ls database +The database file from the IRMOSAIC task. +.le +.ls coords +If \fIalignment\fR = "coords", then \fBcoords\fR is +a text file listing the coordinates of objects in the input +image one object per line in the following +format: 1) the x and y coordinates of the object in the first subraster +2) the x and y coordinates of the same object in the second subraster +3) the x and y coordinates of the next object in the first subraster +etc. +If \fIalignment\fR = "file", then \fBcoords\fR is a text file listing +the x, y and intensity shifts in columns 1, 2 and 3 respectively, +of each input subraster relative to the reference subraster. The +most common use of this option is to make fine adjustments by hand +to the output of IRMATCH1D by editing the computed shifts slightly and +rerunning IRMATCH1D with the new shifts. +.le +.ls xshift +The x shift in pixel units if \fIalignment\fR = "shifts". +.le +.ls yshift +The y shift in pixel units if \fIalignment\fR = "shifts". +.le +.ls alignment = "coords" +The method of aligning the subraster. +.ls coords +The x and y positions of the marker points are listed in a file in the +format specified by the \fIcoords\fR parameter. +.le +.ls shifts +The x and y shifts of a subraster with respect to its neighbour are +set to \fIxshift\fR and \fIyshift\fR. +.le +.ls file +The x, y and intensity shifts of each input subraster with respect to the +reference subraster image. +.le +.le +.ls match = "*" +Match intensities using the overlap region between adjacent subrasters. The +median intensity is computed in the overlap region +and the intensity scale of the current subraster is scaled to that of +the previous subraster. Intensities are matched in one dimension in the order +in which they +are placed in the output image. The default is match everything. +Those subrasters to be matched must be listed by number. For example to +match intensities for subrasters 1 to 5 and 10 to 20 set match = "1-5,10-20". +To match all the subrasters set match = "1-999" or match="*". +.le +.ls nxrsub = INDEF, ls nyrsub = INDEF +The column and line index of the reference subraster. +This will default to the central subraster. +.le +.ls xref = 0, yref = 0 +The x and y offset of the position of the reference subraster in the +output image. The default action is to place the reference subraster +in the same position in the output image as it has in the input image. +.le +.ls trimlimits = "[1:1,1:1]" +The number of columns and rows to be trimmed off each edge of the +input subraster before it is inserted in the output image in section +notation. The default is to trim 1 column or row in each direction. +.le +.ls nimcols = INDEF, ls nimlines = INDEF +The number of columns and rows in the output image. The default is the +number of columns and rows in the input image. +.le +.ls oval = INDEF +The value of undefined pixels in the output image. The default is the value +in the database file from IRMOSAIC. +.le +.ls interpolant = linear +The type of interpolant used to shift the subrasters. The options are: +.ls nearest +Nearest neighbour interpolation. +.le +.ls linear +Bilinear interpolation. +.le +.ls poly3 +Bicubic polynomial interpolation. +.le +.ls poly5 +Biquintic polynomial interpolation. +.le +.ls spline3 +Bicubic spline interpolation. +.le +.le +.ls verbose = no +Print messages on the terminal describing the progress of the task. +.le +.ih +DESCRIPTION +IRMATCH1D takes the mosaiced image \fIinput\fR, the database file \fIdatabase\fR +generated by IRMOSAIC and a list of coordinates \fIcoords\fR and computes +an output image \fIoutput\fR in which all the individual subrasters are aligned. +If \fIalignment\fR = "coords", IRMATCH1D accumulates the relative shifts +between adjacent subrasters +into a total shift with respect to the reference subraster. Shifts which +do not correspond to adjacent subrasters are ignored. +For subrasters which have no direct shift information, IRMATCH1D makes a best +guess at the x and y shift based on the shifts of nearby subrasters which +do have direct shift information. +If the x and y shifts are sufficiently uniform over the whole input image +the user may set \fIalignment\fR += shifts and input values of \fIxshift\fR and \fIyshift\fR. +Alternatively the shifts may be read from the file \fIcoords\fR if +\fIalignment\fR = "file". + +Coordinate lists may be generated interactively on the Sun workstations +using the IRAF imtool facility and centered using the APPHOT CENTER +and APSELECT tasks. + +The subrasters are inserted into the output image +using the interpolation scheme defined by +\fIinterpolant\fR and is made with reference to the subraster defined +by \fInxrsub\fR and \fInyrsub\fR, using the shifts defined by +the coordinates in the file \fIcoords\fR or defined by \fIxshift\fR and +\fIyshift\fR. Subrasters are placed in the output image in the order +they were inserted into the original mosaic with pixels in the most +recently placed subrasters replacing those placed earlier in the overlap +regions. Undefined pixels in the output image +are given the value \fIoval\fR. The position of the reference image in the +output image can be adjusted by setting the parameters \fIxref\fR and +\fIyref\fR. The edges of each subraster may be trimmed before +insertion into the output image by setting the \fItrimlimits\fR parameter. + +Intensities of adjacent subrasters can be matched using the \fImatch\fR +parameters. At present matching is done by computing the median in the +overlap region between adjacent subrasters and applying difference in +these two numbers to the subraster in question. Intensity matching is +done in one dimension only with the direction of matching following +the order that the individual subrasters were inserted into the mosaic. +For example if IRMOSAIC was run with \fIcorner\fR = "ll", \fIdirection\fR +="row" and \fIraster\fR = "no", then the matching would start in the +lower-left corner, proceed along the first row, move to the star of the +second row and so on. + +.ih +EXAMPLES + +1. Align an 8 by 8 mosaic with respect to subraster 6, 5. + +.nf + pr> irmatch1d mosaic mosaic.al mosaic.db coords nxrsub=6 \ + nyrsub=5 +.fi + +2. Align an 8 by 8 mosaic as 1 above but shift the position of the +reference subraster in the output image by 2 pixels in x and 3 pixels +in y. + +.nf + pr> irmatch1d mosaic mosaic.al mosaic.db coords nxrsub=6 \ + nyrsub=5 xref=2 yref=3 +.fi + +3. Align an 8 by 8 mosaic as 1 above but trim 2 rows and columns off +of each input image before inserting into the output image. + +.nf + pr> irmatch1d mosaic mosaic.al mosaic.db coords nxrsub=6 \ + nyrsub=5 trimlimits="[2:2,2:2]" +.fi + +4. Rerun the above example saving the verbose output in a file. Use the +PROTO package fields task to select the xshift, yshift and intensity +shift fields, edit the shifts slightly and rerun irmatch1d with the +new shifts. + +.nf + pr> irmatch1d mosaic mosaic.al mosaic.db coords nxrsub=6 \ + nyrsub=5 trimlimits="[2:2,2:2]" > shifts1 + + pr> fields shifts1 3,4,6 > shifts2 + + pr> edit shifts2 + + ... make whatever changes are desired + + pr> irmatch1d mosaic mosaic.al mosaic.db shifts2 align=file \ + nxrsub=6 nyrsub=5 trimlimits="[2:2,2:2]" +.fi + +.ih +TIME REQUIREMENTS +.ih +BUGS +.ih +SEE ALSO +irmosaic, iralign, irmatch2d, apphot.center, apphot.apselect +.endhelp diff --git a/noao/nproto/doc/irmatch2d.hlp b/noao/nproto/doc/irmatch2d.hlp new file mode 100644 index 00000000..80f8b42e --- /dev/null +++ b/noao/nproto/doc/irmatch2d.hlp @@ -0,0 +1,212 @@ +.help irmatch2d Jan90 noao.nproto +.ih +NAME +irmatch2d -- align and match the elements of the mosaiced image +.ih +USAGE +irmatch2d input output database coords +.ih +PARAMETERS +.ls input +The mosaiced image to be aligned. This image must have been produced by +the IRMOSAIC task and have an accompanying database file specified by +\fIdatabase\fR. +.le +.ls output +The aligned and matched image produced by IRMATCH2D. +.le +.ls database +The database file from the IRMOSAIC task. +.le +.ls coords +If \fIalignment\fR = "coords", then \fBcoords\fR is +the text file listing the coordinates of objects in the input +image one object per line in the following +format: 1) the x and y coordinates of the object in the first subraster +2) the x and y coordinates of the same object in the second subraster +3) the x and y coordinates of the next object in the first subraster +etc. +If \fIalignment\fR = "file", then \fBcoords\fR is the text file listing +the x, y and intensity shifts in columns 1, 2 and 3 respectively, +of each input subraster relative to the reference subraster. The +most common use of this option is to make fine adjustments by hand +to the output of IRMATCH2D by editing the computed shifts slightly and rerunning +IRMATCH2D with the new shifts. +.le +.ls xshift +The x shift in pixel units if \fIalignment\fR = "shifts". +.le +.ls yshift +The x shift in pixel units if \fIalignment\fR = "shifts". +.le +.ls alignment = "coords" +The method of aligning the subraster. +.ls coords +The x and y positions of the marker points are listed in a file in the +format specified by the \fIcoords\fR parameter. +.le +.ls shifts +The x and y shifts of a subraster with respect to its neighbour are +set to \fIxshift\fR and \fIyshift\fR. +.le +.ls file +The x, y and intensity shifts of each input subraster with respect to the +reference subraster image. +.le +.le +.ls match = "*" +Match intensities using the overlap region between adjacent subrasters. The +median intensity is computed in the overlap region +and the intensity scale of the current subraster is scaled to that of +the previous subraster. Intensities are matched in two dimensions, first +in the order in which they +were placed in the output image and then in the orthogonal dimension. +The default is match everything. +Those subrasters to be matched must be listed by number. For example to +match intensities for subrasters 1 to 5 and 10 to 20 set match = "1-5,10-20". +To match all the subrasters set match = "1-999" or match="*". +.le +.ls nxrsub = INDEF, nyrsub = INDEF +The column and row index of the reference subraster. This will default +to the central subraster. +.le +.ls xref = 0, yref = 0 +The x and y offset of the reference subraster in the output image. By default +the reference subraster is placed in the same position in the output image +that it occupied in the input image. +.le +.ls trimlimits = "[1:1,1:1]" +The number of rows and columns to be trimmed off each input subraster +before it is copied to the output image in section notation. +The default is to trim 1 row and column off each edge of the input +subraster. +.le +.ls nimcols = INDEF, nimlines = INDEF +The number of columns and lines in the output image. The default is the +number of lines and columns in the input image. +.le +.ls oval = INDEF +The value of undefined pixels in the output image. The default is the value +in the database file from IRMOSAIC. +.le +.ls interpolant = linear +The type of interpolant used to shift the subrasters. The options are: +.ls nearest +Nearest neighbour interpolation. +.le +.ls linear +Bilinear interpolation. +.le +.ls poly3 +Bicubic polynomial interpolation. +.le +.ls poly5 +Biquintic polynomial interpolation. +.le +.ls spline3 +Bicubic spline interpolation. +.le +.le +.ls verbose = yes +Print messages on the terminal describing the progress of the task. +.le +.ih +DESCRIPTION +IRMATCH2D takes the mosaiced image \fIinput\fR, the database file \fIdatabase\fR +generated by IRMOSAIC and a list of coordinates \fIcoords\fR and computes +an output image \fIoutput\fR in which all the individual subrasters are aligned. +If \fIalignment\fR = "coords", IRMATCH2D accumulates the relative shifts +between adjacent subrasters +into a total shift with respect to the reference subraster. Shifts which +do not correspond to adjacent subrasters are ignored. +For subrasters which have no direct shift information, IRMATCH2D makes +a best guess at the x and y shift based on the shifts of nearby subrasters +which do have direct shift information. If the x and y shifts +are sufficiently uniform over the whole input image the user may set +\fIalignment\fR = shifts and input values of \fIxshift\fR and \fIyshift\fR. +Alternatively the shifts may be read for the file \fIcoords\fR if +\fIalignment\fR = "file". + +Coordinate lists may be generated interactively on the Sun workstations +using the IRAF imtool facility and centered using the APPHOT CENTER +and APSELECT tasks. + +The subrasters are inserted into the output image using the +interpolation scheme defined by +\fIinterpolant\fR and is made with reference to the subraster defined +by \fInxrsub\fR and \fInyrsub\fR, using the shifts defined by +the coordinates in the file \fIcoords\fR. +Subrasters are inserted into the output image in the order they were +inserted into the original mosaic with pixels in the most recently +placed subrasters replacing those placed earlier in the overlap regions. +Undefined pixels in the output image +are given the value \fIoval\fR. The position of the reference subraster +in the output image can be shifted by setting the parameters \fIxref\fR and +\fIyref\fR. The \fItrimlimits\fR parameter can be used to trim each +input subraster before it is inserted into the output image. + +Intensities of adjacent subrasters can be matched using the \fImatch\fR +parameter. At present matching is done by computing the median in the +overlap region between adjacent subrasters and applying difference in +these two numbers to the subraster in question. Intensity matching is +done in two dimensions, first along the direction in which subrasters +were inserted into the mosaic and then in the orthogonal dimension. +For example if IRMOSAIC was run with \fIcorner\fR = "ll", \fIdirection\fR = +"row" and \fIraster\fR = "no", then the matching would proceed along +each row starting with the lower-left hand corner and then along +each column beginning again in the lower-left corner. + +.ih +EXAMPLES + +1. Align an 8 by 8 mosaic with respect to subraster 6, 5. + +.nf + pr> irmatch2d mosaic mosaic.al mosaic.db coords nxrsub=6 \ + nyrsub=5 +.fi + +2. Align an 8 by 8 mosaic as 1 above but shift the position of the +reference subraster in the output image by 2 pixels in x and 3 pixels +in y. + +.nf + pr> irmatch2d mosaic mosaic.al mosaic.db coords nxrsub=6 \ + nyrsub=5 xref=2 yref=3 +.fi + +3. Align an 8 by 8 mosaic as 1 above but trim 2 rows and columns off +of each input image before inserting into the output image. + +.nf + pr> irmatch2d mosaic mosaic.al mosaic.db coords nxrsub=6 \ + nyrsub=5 trimlimits="[2:2,2:2]" +.fi + +4. Rerun the above example saving the verbose output in a file. Use the +PROTO package fields task to select the xshift, yshift and intensity +shift fields, edit the shifts slightly and rerun irmatch2d with the +new shifts. + +.nf + pr> irmatch2d mosaic mosaic.al mosaic.db coords nxrsub=6 \ + nyrsub=5 trimlimits="[2:2,2:2]" > shifts1 + + pr> fields shifts1 3,4,6 > shifts2 + + pr> edit shifts2 + + ... make whatever changes are desired + + pr> irmatch2d mosaic mosaic.al mosaic.db shifts2 align=file \ + nxrsub=6 nyrsub=5 trimlimits="[2:2,2:2]" +.fi + +.ih +TIME REQUIREMENTS +.ih +BUGS +.ih +SEE ALSO +irmosaic, iralign, irmatch1d, apphot.center, apphot.apselect +.endhelp diff --git a/noao/nproto/doc/irmosaic.hlp b/noao/nproto/doc/irmosaic.hlp new file mode 100644 index 00000000..6cdd400c --- /dev/null +++ b/noao/nproto/doc/irmosaic.hlp @@ -0,0 +1,157 @@ +.help irmosaic Oct89 noao.nproto +.ih +NAME +irmosaic -- mosaic a set of infrared ccd images +.ih +USAGE +mosaic input output database nxsub nysub +.ih +PARAMETERS +.ls input +The list of input images to be mosaiced. The images are +assumed to be ordered either by row, +column, or in a raster pattern. If the image list is not in +order then the iraf files task plus the editor must be used +to construct an image list. The images in the input list +are assumed to all be the same size. +.le +.ls output +The name of the output image. +.le +.ls database +The name of the text file listing the operations performed by irmosaic. +This list can be used as input for iralign. +.le +.ls nxsub +The number of subrasters along a row of the output image. +.le +.ls nysub +The number of subrasters along a column of the output image. +.le +.ls trim_section = "[*,*]" +The section of the input images to be mosaiced into the output image. +Section can be used to flip and/or trim the individual subrasters before adding +them to the mosaic. For example if we want to flip each subraster around the +y axis before adding it to the mosaic, then \fItrim_section\fR = "[*,-*]". +.le +.ls null_input = "" +The list of unobserved subrasters. For example if the subrasters 3 to 5 and +10 of a sequence of observations were not observed then +\fInull_input\fR = "3-5,10". +This parameter follows the ranges notation convention. The number of unobserved +subrasters plus the number of images must equal \fInxsub\fR * +\fInysub\fR. +.le +.ls corner = "ll" +The starting position in the output image. +The four options are "ll" for lower left corner, "lr" for lower right corner, +"ul" for upper left corner and "ur" for upper right corner. +.le +.ls direction = "row" +Add subrasters to the output image in row or column order. The options are +"row" for row order and "column" for column order. +.le +.ls raster = no +Add subrasters to the output image in a raster pattern or return to the start +of a column or a row? +.le +.ls median_section = "" +The section of each input subraster for which the median is computed. If +\fImedian_section\fR is the null string then the medians are not computed. +If \fImedian_section\fR is "[*,*]" the whole input subraster is used to +compute the median. +.le +.ls subtract = no +Subtract the median value from each input subraster before placing the +subraster in the output image. +.le +.ls nimcols = INDEF +The number of columns in the output image. If \fInimcols\fR is INDEF then +the program will compute the number of columns using the size of the input +subrasters, \fInxsub\fR and \fInxoverlap\fR. +.le +.ls nimrows = INDEF +The number of rows in the output image. If \fInimrows\fR is INDEF then +the program will compute the number of rows using the size of the input +subrasters, \fInysub\fR and \fInyoverlap\fR. +.le +.ls nxoverlap = -1 +The number of columns between adjacent frames. A negative value specifies +the amount of column space between adjacent subrasters. +A positive value specifies the amount of column overlap on adjacent +subrasters. +.le +.ls nyoverlap = -1 +The number of rows between adjacent frames. A negative value specifies +the amount of row space between adjacent subrasters. +A positive value specifies the amount of row overlap on adjacent subrasters. +.le +.ls oval = 0.0 +The output image pixel value in regions undefined by the by the list of input +images. +.le +.ls opixtype = "r" +The pixel type of the output image. The options are "s" (short integer), +"i" (integer), "l" (long integer), "r" (real) and "d" for double +precision. +.le +.ls verbose = yes +Print messages about task progress and actions taken. +.le +.ih +DESCRIPTION + +IRMOSAIC takes a the list of subrasters of identical dimensions specified +by \fIinput\fR and combines them into a single +output image \fIoutput\fR. The order in which the subrasters are placed +in the output image is determined by the parameters \fIcorner\fR, +\fIdirection\fR and \fIraster\fR. The orientation of each individual +subraster in the output image may be altered by setting the \fItrim_section\fR +parameter. + +IRMOSAIC uses the subraster size, the number of subrasters, the \fInxoverlap\fR +and \fRnyoverlap\fI parameters and the \fInxsub\fR and \fInysub\fR partmeters +to compute the size of the output image. An image of size larger than the +minimum required can be specified by setting \fInimcols\fR and \fInimrows\fR. +The pixel type of the output image is specified by \fIopixtype\fR and undefined +regions of the output image are given the value \fIoval\fR. + +The median of a section each subraster may be optionally computed +and placed in the database file by setting \fImedian_section\fR. +The computed median will be subtracted from the input subrasters if +\fIsubtract\fR is set to yes. +Task action messages will be printed on the standard output +if \fIverbose\fR is set to yes. +.ih +EXAMPLES + +1. Mosaic a list of 64 infrared images onto an 8 by 8 grid in column order +starting in the upper right hand corner. Allow one blank column and row +between each subraster. + +.nf + pr> irmosaic @imlist mosaic mosaic.dat nxsub=8 nysub=8 \ + nxoverlap=-1 nyoverlap=-1 corner="ur" direct="column" +.fi + +2. Mosaic a list of 62 infrared images onto an 8 by 8 grid in column order +starting in the upper right hand corner. Allow one blank column and row +between each subraster. Subrasters 3 and 9 in the sequence do not exist +and are to be replaced in the output image with an unknown value of -1.0. + +.nf + pr> irmosaic @imlist mosaic mosaic.dat nxsub=8 nysub=8 \ + nxoverlap=-1 nyoverlap=-1 corner="ur" direct="column"\ + null_input="3,9", oval=-1.0 +.fi + +.ih +TIME REQUIREMENTS +.ih +BUGS +At present only integral pixel overlaps are allowed in this routine. +Fine tuning of the alignments can be done with iralign. +.ih +SEE ALSO +iralign, irmatch1d, irmatch2d +.endhelp diff --git a/noao/nproto/doc/linpol.hlp b/noao/nproto/doc/linpol.hlp new file mode 100644 index 00000000..5cde0e60 --- /dev/null +++ b/noao/nproto/doc/linpol.hlp @@ -0,0 +1,164 @@ +.help linpol Apr92 noao.nproto +.ih +NAME +linpol -- Calculate linear polarization, angle, and Stokes images +.ih +USAGE +linpol input output +.ih +PARAMETERS +.ls input +A list of input images. There must be either three or four input +images taken with the polarizer at even multiples of a 45 degree +position angle. +.le +.ls output +The output data cube which will contain as separate bands the +fractional linear polarization and angle frames, and optionally the +Stokes parameter frames. +.le +.ls degrees = yes +Report the polarization angle in degrees? If \fBdegrees\fR = no, the +polarization angle will be reported in radians. +.le +.ls stokes = yes +Output the Stokes parameter images? If \fBstokes\fR = yes, the three +linear Stokes parameters, I, Q, and U, will be included in the +\fBoutput\fR data cube as separate bands. If \fBstokes\fR = no, only +the fractional linear polarization and angle frames will appear in the +output. +.le +.ls normalize = no +Normalize the Q and U frames? This is appropriate when using a tool +such as VELVECT to plot the polarization vectors. If \fBnormalize\fR = +yes, the Q and U Stokes parameter frames will be normalized by dividing +by the I parameter frame. This parameter has no effect on either the +fractional polarization or angle frames. +.le +.ls keyword = "polangle" +This must be set to the name of a header keyword that contains the +polarizer angle for each of the \fBinput\fR images. LINPOL will only +accept polarizer angles at even 45 degree separations. Either four such +frames, at 0-45-90-135 degrees, or three frames with any one of the +0-45-90-135 degree frames omitted, may be specified. +.le +.ih +DESCRIPTION +LINPOL calculates the pixel-by-pixel fractional linear polarization and +polarization angle for a set of either three or four images taken with +polarizer set at even multiples of a 45 degree position angle. At least +three different frames with the header \fBkeyword\fR set to one of +0, 45, 90, or 135 degrees must be specified in the \fBinput\fR list. + +If \fBdegrees\fR = yes, the output polarization angle band of the image +will be in units of degrees, if \fBdegrees\fR = no, the angle will be +reported as radians. If \fBstokes\fR = yes, the output image +will consist of five separate bands, one each for the pixel-by-pixel +fractional linear polarization and the corresponding polarization angle, +and one for each of the I, Q, and U pixel-by-pixel Stokes parameters. +If \fBstokes\fR = no, only the fractional polarization and the polarization +angle will be saved in the output. + +The \fBnormalize\fR parameter is useful for plotting purposes. +If \fBnormalize\fR = yes, the Q and U Stokes parameter frames will be +normalized by dividing by the I parameter frame. This may be appropriate +when using a tool such as VELVECT to plot the polarization vectors. +This parameter has no effect on either the fractional polarization or +angle frames. + +Each input image must contain the corresponding polarizer angle +in the header keyword specified by the parameter \fBkeyword\fR +Linpol will only accept polarizer angles at even 45 degree separations. +Either four such frames, at 0-45-90-135 degrees, or three frames with +any one of the 0-45-90-135 degree frames omitted, may be specified. + +The output image header will include information describing the particular +input images that went into its generation and the particular nature of +each band of the output. +.ih +EXAMPLES +An observer obtained four exposures of a particular field through a +polarizer set at a position angle of 0-45-90-135 degrees. The first +step in producing a good map of the polarized light from (extended +or point-like) sources in the field is always to register these frames +very precisely. A slight mismatch in the positioning of each pixel +relative to the shoulders of nearby sources or extended emission will +result in large errors in the determination of the polarization quantities. + +Another preprocessing step that may be desirable is to match the PSFs +(Point Spread Functions) of the various frames. Ideally, these are +stable in the raw data (i.e., the seeing at the telescope was constant), +but if not they must be matched to avoid the same errors as above. Note +that it may also be a good idea to "smooth" the raw images before +applying linpol to increase the signal-to-noise of the output. + +After guaranteeing the integrity of the input images, the image header +\fBkeyword\fR must be created to contain the position angle. The hedit +task can be used to do this: + +.nf + hedit im.00 polangle 0 add+ + hedit im.45 polangle 45 add+ + hedit im.90 polangle 90 add+ + hedit im.135 polangle 135 add+ +.fi + +At this point, the input images are ready to be processed by linpol. + +To generate an output image containing the fractional linear +polarization and polarization angle in separate bands, along with the +pixel-by-pixel Stokes parameter frames: + +.nf + np> linpol im.*.imh polar +.fi + +To omit the Stokes parameter frames: + +.nf + np> linpol im.*.imh polar stokes- +.fi + +To represent the pixel-by-pixel polarization angle in radians, rather +than degrees: + +.nf + np> linpol im.*.imh polar degrees- +.fi + +To normalize the Q and U Stokes frames and plot the result with velvect: + +.nf + np> linpol im.*.imh polar normalize+ + np> imhead polar lo+ + polar[100,100,5][short]: Linear polarization image + No bad pixels, no histogram, min=unknown, max=unknown + Line storage mode, physdim [100,100,5], length of user area 2147 s.u. + Created Wed 10:15:05 29-Apr-92, Last modified Wed 10:15:05 29-Apr-92 + Pixel file 'ursa!/ursa/scr3/iraf/seaman/polar.pix' [ok] + ... + + POL0 = 'im.00.imh' + POL45 = 'im.45.imh' + POL90 = 'im.90.imh' + POL135 = 'im.135.imh' + POLAR = 'Band 1 is the percent polarization' + ANGLE = 'Band 2 is the polarization angle' + I-STOKES= 'Band 3 is the Stokes I parameter' + Q-STOKES= 'Band 4 is the normalized Stokes Q parameter' + U-STOKES= 'Band 5 is the normalized Stokes U parameter' + np> velvect polar[*,*,4] polar[*,*,5] +.fi + +Note that the current version of the velvect task is not particularly +appropriate for this use. It has no support for reducing the pixel +resolution of the output plot: each pixel will generate a plotted vector +so that to produce an uncrowded (and low "noise") plot, the input images +or output bands must be manually block averaged or otherwise smoothed. +In addition, the plotted vectors are directed (little arrows) not +undirected line segments, and the length of the vectors are not easily +adjusted. +.ih +SEE ALSO +velvect, imalign, hedit +.endhelp diff --git a/noao/nproto/doc/mkms.hlp b/noao/nproto/doc/mkms.hlp new file mode 100644 index 00000000..078480a4 --- /dev/null +++ b/noao/nproto/doc/mkms.hlp @@ -0,0 +1,63 @@ +.help mkms Jan03 noao.nproto +.ih +NAME +mkms -- make multispec format from 1D arrays with associated bands +.ih +USAGE +mkms output spectra raw background sigma +.ih +PARAMETERS +.ls output +Name of output multispec image. +.le +.ls spectra +List of primary 1D spectra to be included in multispec image. +.le +.ls raw +List of 1D raw or secondary spectra. If none specify "" otherwise +the list must match the list of primary spectra. +.le +.ls background +List of 1D background spectra. If none specify "" otherwise +the list must match the list of primary spectra. +.le +.ls sigma +List of 1D sigma spectra. If none specify "" otherwise +the list must match the list of primary spectra. +.le +.ih +DESCRIPTION +MKMS creates a multispec format from 1D spectra. Unlike SCOPY it +can include associated spectra. There can be any number of primary 1D +spectra and the associated spectra are optional. However, when +associated spectra are specified the list must match the primary spectra +list and the arrays must have the same number of pixels and dispersion +as the primary spectrum. The different spectra may have different +dispersions. + +This is a simple script using SCOPY and IMSTACK. It has minimal error +checking. In particular, if the set of input is not consistent the +task will abort with an error leaving temporary files behind. +.ih +EXAMPLES +1. To create an image with one spectrum and each of the associated types: + +.nf + cl> mkms out.ms spec rawspec bkgspec sigspec +.fi + +2. To create an image with three primary spectra and error arrays: + +.nf + cl> mkms out.ms spec1,spec2,spec3 "" "" err1,err2,err3 +.fi + +.ih +REVISIONS +.ls MKMS V2.12.2 +This prototype task added for this release. +.le +.ih +SEE ALSO +scopy, imstack +.endhelp diff --git a/noao/nproto/doc/skygroup.hlp b/noao/nproto/doc/skygroup.hlp new file mode 100644 index 00000000..7b5dfed9 --- /dev/null +++ b/noao/nproto/doc/skygroup.hlp @@ -0,0 +1,131 @@ +.help skygroup Feb06 noao.nproto +.ih +NAME +skygroup -- Group a list containing RA and Dec into spatial sublists +.ih +SYNOPSIS +A list with RA and Dec in the first two columns followed by user data +is grouped into sublist based on spatial proximity. A separation parameter +defines the grouping by looking for gaps in both RA and Dec that are +bigger than the specified amount. The output sublists may or may not +include the RA and Dec columns. A typical example of user data might be +image names. +.ih +USAGE +skygroup input output +.ih +PARAMETERS +.ls input +Input tabular text file containing RA and Dec in the first two whitespace +separated columns and user data in the remaining columns. The RA may +be in hours or degrees while the Dec must be in degrees. The RA values +must lie in the range 0h to 24h or 0d to 360d and the Dec values +must lie in the range -90d to 90d. +.le +.ls output +Output root filename. The root filename itself will contain a list of +the sublists. The sublists will have _NNN appended to the root name +where NNN is a three digit number. If there are more than 999 sublists +the number of digits will increase. A check is made for any pre-existing +filenames with this root, sequence pattern, and optional extension and +an error will result if any are found. +.le +.ls extn = "" +Optional output extension. This string is appended to the output files +noted previously. Note that an period must be given explicitly if a +".XXX" style extension is desired. +.le +.ls sep = 60 (arcsec) +The maximum separation in arcseconds in RA and Dec, applied separately, which +defines the start of a new group. +.le +.ls raunit = "hr" (hr|deg) +The input RA unit where "hr" is hours and "deg" is degrees. +.le +.ls keepcoords = yes +Keep the input coordinate columns in the output lists? If no then only +the user data will be placed in the output lists. This option allows +taking a list of RA, Dec, and filenames and producing only lists of +filenames to be used as @files. +.le +.ls raformat = "%.2h", decformat = "%.1h" +The format for printing the RA and Dec in the output lists if +\fIkeepcoords\fR is yes. See the help for \fBprintf\fR for the formats. +Note that the raformat may be given in %H format to convert input RA +in degrees into output hours. The default produces sexagesimal format +keeping the RA in the same units as the input. +.le +.ih +DESCRIPTION +This task groups a list of user data with RA and Dec coordinates +into sublists where all points in a group have at least one member with +celestial distance in RA or Dec separately less than or equal to the +specified separation. In other words, groups are defined by gaps in RA +and Dec. + +The input format is a text table where each line consists of an RA, +a Dec, and arbitrary user data. Whitespace separates these three parts. +The RA and Dec have certain restrictions on units and ranges as described +in the parameters. However, the RA may be given either in hours or degrees +and may be output in hours if given in degrees. + +The output is a set of sublists as well as a file containing the set +of sublist filenames. The sublists contain the input user data with +or without the input coordinates. + +The grouping algorithm is summarized as follows. The input list is +sorted by declination. The declination ordered list is traversed +to form groups with consecutive declination intervals less than or +equal to the specified separation. These groups are then +sorted in RA and these are traversed to form the final groups with +consecutive RA intervals less than or equal to the specified separation. +Note that the RA intervals are actually computed by \fBskysep\fR and +make use of both the RA and Dec. + +A challenge is dealing with the wrap around in RA at the zero meridian. +This is handled by duplicating points near 0 beyond 24h or 360d. This is +the reason the input is required to only be in a specific range. This +duplication can result in entries appearing in more than one output group. +A merging step handles this situation. +.ih +EXAMPLES +1. A set of images is to be grouped based on their FITS tangent point +coordinates. Note this make most sense when the tangent point pixel +coordinates are the same in the image. The image will then be grouped +to find those that overlap by some amount. If the images have 10 arc +minute fields of view and we want to group those that overlap by at least +50% then the separation parameter should be something like 5 arc minutes. +We want to the output to a list of only the file names which will then +be passed on to an image stacking program. + +.nf + cl> hselect *.fits crval1,crval2,title yes > coords + cl> skygroup coords group extn=".lis" sep=300 rau=deg keep- + cl> type group.lis + group_001.lis + group_002.lis + ... + cl> type group_001.lis + obj4325.fits + obj4329.fits + ... + cl> count @group.lis + cl> count @group + 1 3 85 group_001.lis + 2 6 170 group_002.lis + 102 306 8670 group_003.lis + 133 399 11438 group_004.lis + 31 93 2666 group_005.lis + 7 21 595 group_006.lis + 5 15 425 group_007.lis + 281 843 24049 Total +.fi + +The CRVAL values are for the RA and Dec world axes respectively. Because +the FITS reference values must be in degrees the input RA unit is specified +as degrees. Because we want only the output file names we use keepcoords=no. +The output lists will be group_001.lis, group_002.lis, etc. +.ih +SEE ALSO +skysep, astradius, astcalc +.endhelp diff --git a/noao/nproto/doc/skysep.hlp b/noao/nproto/doc/skysep.hlp new file mode 100644 index 00000000..db2c7c89 --- /dev/null +++ b/noao/nproto/doc/skysep.hlp @@ -0,0 +1,64 @@ +.help skysep Feb06 noao.nproto +.ih +NAME +skysep -- Compute arc separation of two RA/Dec values +.ih +SYNOPSIS +Given two RA/Dec value pairs the spherical separation is computed. This +task can be used in scripts and has both text and parameter output. +.ih +USAGE +skysep ra1 dec1 ra2 dec2 +.ih +PARAMETERS +.ls ra1, dec1, ra2, dec2 +The RA and Dec of two points on the sky for which a separation is to be +computed. The RA may be in hours or degrees and the Dec is in degrees. +The values may be in decimal or sexagesimal format. +.le +.ls raunit = "hr" +Units for right ascension. The value "hr" selects hours and "deg" +selects degrees. +.le +.ls verbose = no +Print a verbose output to the standard output? +.le +.ls sep +This output parameter will contain the separation in arc seconds after +the task is run. It may then be referenced as the variable skysep.sep. +.le +.ih +DESCRIPTION +This simple script task computes the separation between two celestial +coordinates given as RA and Dec. The RA units may be hours or degrees, +as selected by a parameter, and the Dec units must be degrees. The result +may be printed to the standard output (in restricted precision) and is +also record in a task parameter for later use. +.ih +EXAMPLES +1. The verbose output appears as follows: + +.nf + cl> skysep 12:12:12 32:32:32 12:12:24 32:32:52 verb+ + 153.05 arcsec = (12:12:12.00, 32:32:32.0) - (12:12:24.00, 32:32:52.0) + cl> = skysep.sep + 153.04686934468 +.fi + +2. To use in a script: + +.nf + cache skysep # Cache to avoid problems with updating par files + + # To use scan to get the value. + skysep (r1, d1, r2, d2, raunit="deg", verbose+) | scan (sep) + printf ("The separation is %f\n", sep) + + # To use the saved value. + skysep (r1, d1, r2, d2, raunit="deg", verbose-) + printf ("The separation is %.5f\n", skysep.sep) +.fi +.ih +SEE ALSO +astcalc, asthedit +.endhelp diff --git a/noao/nproto/doc/slitpic.hlp b/noao/nproto/doc/slitpic.hlp new file mode 100644 index 00000000..859a0ee0 --- /dev/null +++ b/noao/nproto/doc/slitpic.hlp @@ -0,0 +1,63 @@ +.help slitpic May85 noao.nproto +.ih +NAME +slitpic -- generate IRAF image of slit mask for aperture plates. +.ih +USAGE +slitpic serial_numbers output_root +.ih +PARAMETERS +.ls serial_numbers +A range of serial numbers to be searched for in \fItape1\fR. One +mask is generated for each \fIserial_number\fR. +.le +.ls output_root +The rootname of the output image file. The \fIserial_number\fR is appended to +this \fIoutput_root\fR if more than one image is begin created. +.le +.ls tape1 = "slitsave" +A text file containing solutions generated by program SLITS. This file +essentially contains x,y positions of slits to be included on the mask. +.le +.ls slit_width = 2.5 +The slit width in seconds of arc. +.le +.ls site = "kpno" +The telescope site where the output mask will be used. Current choices +are "kpno" and "ctio". +.le +.ls pixel_scale = 0.4157 +The scale of the output image in arcseconds per pixel +.le +.ls pixel_scale_date = "14feb84" +The date from which \fIpixel_scale\fR is valid. The output \fBcrtpict\fR +print will be annotated with this date. +.le +.ls crtpict = no +This boolean parameter controls whether or not a file of commands is written +to drive program \fBcrtpict\fR. +.le +.ls cmd_file = "cmd" +If \fIcrtpict\fR = yes, this parameter specifies the root name of the output +command file. This command file is read by task \fBcrtpict\fR. +.le +.ih +DESCRIPTION +Task \fBslitpic\fR reads a file of slit positions and generates an IRAF +image for use as a slit mask for aperture plate observing. +.ih +EXAMPLES +The following example creates an IRAF image from the "SERIAL = 67" entry +in file "mask67.dat"; the output image is named "mask": +.sp +.nf + cl> slitpic 67 mask tape1=mask67.dat +.fi +.ih +TIME REQUIREMENTS +Task \fBslitpic\fR takes 8 cp seconds to create a 780 x 780 mask; a +1184 x 1184 image requires about 16 cp seconds. +.ih +SEE ALSO +crtpict +.endhelp diff --git a/noao/nproto/findgain.cl b/noao/nproto/findgain.cl new file mode 100644 index 00000000..6552c8c2 --- /dev/null +++ b/noao/nproto/findgain.cl @@ -0,0 +1,93 @@ +# FINDGAIN - calculate the gain and readnoise given two flats and two +# bias frames. Algorithm (method of Janesick) courtesy Phil Massey. +# +# flatdif = flat1 - flat2 +# biasdif = bias1 - bias2 +# +# e_per_adu = ((mean(flat1)+mean(flat2)) - (mean(bias1)+mean(bias2))) / +# ((rms(flatdif))**2 - (rms(biasdif))**2) +# +# readnoise = e_per_adu * rms(biasdif) / sqrt(2) +# +# In our implementation, `mean' may actually be any of `mean', +# `midpt', or `mode' as in the IMSTATISTICS task. + + +procedure findgain (flat1, flat2, bias1, bias2) + +string flat1 {prompt="First flat frame"} +string flat2 {prompt="Second flat frame"} +string bias1 {prompt="First bias frame"} +string bias2 {prompt="Second bias frame"} + +string section = "[*,*]" {prompt="Selected image section"} + +string center = "mean" {prompt="Central statistical measure", + enum="mean|midpt|mode"} +real binwidth = 0.1 {prompt="Bin width of histogram in sigma"} + +bool verbose = yes {prompt="Verbose output?"} + +string *list + +begin + string lflat1, lflat2, lbias1, lbias2, flatdif, biasdif, statsfile + real e_per_adu, readnoise, m_f1, m_f2, m_b1, m_b2, s_fd, s_bd, junk + bool sc_err + + flatdif = mktemp ("tmp$FG") + biasdif = mktemp ("tmp$FG") + statsfile = mktemp ("tmp$FG") + + lflat1 = flat1 // section + lflat2 = flat2 // section + lbias1 = bias1 // section + lbias2 = bias2 // section + + imarith (lflat1, "-", lflat2, flatdif) + imarith (lbias1, "-", lbias2, biasdif) + + imstatistics (lflat1//","//lflat2//","//lbias1//","//lbias2// + ","//flatdif//","//biasdif, fields=center//",stddev", + lower=INDEF, upper=INDEF, binwidth=binwidth, format-, > statsfile) + + list = statsfile + sc_err = no + + if (fscan (list, m_f1, junk) != 2) + sc_err = yes + if (fscan (list, m_f2, junk) != 2) + sc_err = yes + if (fscan (list, m_b1, junk) != 2) + sc_err = yes + if (fscan (list, m_b2, junk) != 2) + sc_err = yes + if (fscan (list, junk, s_fd) != 2) + sc_err = yes + if (fscan (list, junk, s_bd) != 2) + sc_err = yes + list = "" + + if (! sc_err) { + e_per_adu = ((m_f1 + m_f2) - (m_b1 + m_b2)) / (s_fd**2 - s_bd**2) + readnoise = e_per_adu * s_bd / sqrt(2) + + # round to three decimal places + e_per_adu = real (nint (e_per_adu * 1000.)) / 1000. + readnoise = real (nint (readnoise * 1000.)) / 1000. + + if (verbose) { + print ("Gain = ", e_per_adu, " electrons per ADU") + print ("Read noise = ", readnoise, " electrons\n") + + print ("Flats = ", lflat1, " & ", lflat2) + print ("Biases = ", lbias1, " & ", lbias2) + } else { + print (e_per_adu, "\t", readnoise) + } + } + + delete (statsfile, ver-, >& "dev$null") + imdelete (flatdif, ver-, >& "dev$null") + imdelete (biasdif, ver-, >& "dev$null") +end diff --git a/noao/nproto/findthresh.cl b/noao/nproto/findthresh.cl new file mode 100644 index 00000000..efa26b8c --- /dev/null +++ b/noao/nproto/findthresh.cl @@ -0,0 +1,98 @@ +# FINDTHRESH - estimate the expected random error per pixel (in ADU) of +# the background, given the gain and read noise (in electrons) of a CCD. +# +# random error in 1 pixel = sqrt (sky*p(N) + r(N)**2) / p(N) +# +# r(N) is the effective read noise (electrons), corrected for N frames +# p(N) is the effective gain (electrons/ADU), corrected for N frames +# +# In our implementation, the `mean' used to estimate the sky may actually +# be any of `mean', `midpt', or `mode' as in the IMSTATISTICS task. + + +procedure findthresh (data) + +real data {prompt="Sky level (ADU)"} + +string images = "" {prompt="List of images"} +string section = "[*,*]" {prompt="Selected image section"} +string center = "mean" {prompt="Central statistical measure", + enum="mean|midpt|mode"} +real binwidth = 0.1 {prompt="Bin width of histogram in sigma\n"} + +real gain {prompt="CCD gain in electrons/ADU"} +real readnoise {prompt="CCD read noise in electrons"} +int nframes = 1 {prompt="Number of coadded frames", + min=1} +string coaddtype = "average" {prompt="Type of coaddition", + enum="average|sum"} + +bool verbose = yes {prompt="Verbose output?\n"} + +string *list1 +string *list2 + +begin + string img, tmpfile, statsfile + real reff, peff, mean, stddev, random + + peff = gain + reff = readnoise + + if (nframes > 1) { + reff *= sqrt (nframes) + + if (coaddtype == "average") + peff *= nframes + + if (verbose) { + print ("effective gain = ", peff, " (electrons/ADU)") + print ("effective readnoise = ", reff, " (electrons)\n") + } + } + + if (images != "" && $nargs == 0) { + statsfile = mktemp ("tmp$junk") + tmpfile = mktemp ("tmp$junk") + sections (images, > tmpfile) + + list1 = tmpfile + while (fscan (list1, img) != EOF) { + imstatistics (img//section, fields=center//",stddev", + lower=INDEF, upper=INDEF, binwidth=binwidth, format-, + > statsfile) + + list2 = statsfile + if (fscan (list2, mean, stddev) != 2) + break + list2 = ""; delete (statsfile, ver-, >& "dev$null") + + random = sqrt (mean*peff + reff**2) / peff + + # round to three decimal places + stddev = real (nint (stddev * 1000.)) / 1000. + random = real (nint (random * 1000.)) / 1000. + + if (verbose) { + print (" sigma (computed) = ", random, " (ADU)") + print (" (measured) = ", stddev, " (ADU)\n") + } else + print (random, "\t", stddev) + } + + list1 = ""; delete (tmpfile, ver-, >& "dev$null") + list2 = ""; delete (statsfile, ver-, >& "dev$null") + + } else { + mean = data + random = sqrt (mean*peff + reff**2) / peff + + # round to three decimal places + random = real (nint (random * 1000.)) / 1000. + + if (verbose) + print (" sigma (computed) = ", random, " (ADU)") + else + print (random) + } +end diff --git a/noao/nproto/ir/iralign.h b/noao/nproto/ir/iralign.h new file mode 100644 index 00000000..77cab3d4 --- /dev/null +++ b/noao/nproto/ir/iralign.h @@ -0,0 +1,55 @@ +# Header file for IR Mosaicing Routines + +# Define the structure + +define LEN_IRSTRUCT 35 + +define IR_NCOLS Memi[$1] # x length of single subraster +define IR_NROWS Memi[$1+1] # y length of a single subrasters +define IR_NXOVERLAP Memi[$1+2] # x overlap between subrasters +define IR_NYOVERLAP Memi[$1+3] # y overlap between subrasters +define IR_NXSUB Memi[$1+4] # number of subrasters in x dimension +define IR_NYSUB Memi[$1+5] # number of subrasters in y dimension +define IR_NXRSUB Memi[$1+6] # x index of reference subraster +define IR_NYRSUB Memi[$1+7] # y index of reference subraster +define IR_XREF Memi[$1+8] # x offset of reference subraster +define IR_YREF Memi[$1+9] # y offset of reference subraster +define IR_CORNER Memi[$1+10] # starting corner for insertion +define IR_ORDER Memi[$1+11] # row or column insertion +define IR_RASTER Memi[$1+12] # raster order +define IR_OVAL Memr[P2R($1+13)] # undefined value + +define IR_IC1 Memi[$1+14] # input image lower column limit +define IR_IC2 Memi[$1+15] # input image upper column limit +define IR_IL1 Memi[$1+16] # input image lower line limit +define IR_IL2 Memi[$1+17] # input image upper line limit +define IR_OC1 Memi[$1+18] # output image lower column limit +define IR_OC2 Memi[$1+19] # output image upper column limit +define IR_OL1 Memi[$1+20] # output image lower line limit +define IR_OL2 Memi[$1+21] # output image upper line limit +define IR_DELTAX Memi[$1+22] # x shifts +define IR_DELTAY Memi[$1+23] # y shifts +define IR_DELTAI Memi[$1+24] # intensity shifts + +define IR_XRSHIFTS Memi[$1+25] # x row links +define IR_YRSHIFTS Memi[$1+26] # y row links +define IR_NRSHIFTS Memi[$1+27] # number of row links +define IR_XCSHIFTS Memi[$1+28] # x column links +define IR_YCSHIFTS Memi[$1+29] # y column links +define IR_NCSHIFTS Memi[$1+30] # number of column links + +# Define some useful constants + +define IR_LL 1 +define IR_LR 2 +define IR_UL 3 +define IR_UR 4 + +define IR_ROW 1 +define IR_COLUMN 2 + +define IR_COORDS 1 +define IR_SHIFTS 2 +define IR_FILE 3 + +define MAX_NRANGES 100 diff --git a/noao/nproto/ir/iralign.x b/noao/nproto/ir/iralign.x new file mode 100644 index 00000000..a1a431d5 --- /dev/null +++ b/noao/nproto/ir/iralign.x @@ -0,0 +1,376 @@ +include <imhdr.h> +include "iralign.h" + +define NYOUT 16 +define NMARGIN 4 + +# IR_SHIFTS -- Compute the input and output image column limits and the +# x and y shifts. + +procedure ir_shifts (ir, im, outim, xrshifts, yrshifts, xcshifts, + ycshifts, ic1, ic2, il1, il2, oc1, oc2, ol1, ol2, deltax, deltay) + +pointer ir # pointer to the ir structure +pointer im # pointer to the input image +pointer outim # pointer to the output image +real xrshifts[ARB] # x row shifts +real yrshifts[ARB] # y row shifts +real xcshifts[ARB] # x column shifts +real ycshifts[ARB] # y column shifts +int ic1[ARB] # input beginning column limits +int ic2[ARB] # input ending column limits +int il1[ARB] # input beginning line limits +int il2[ARB] # input ending line limits +int oc1[ARB] # output beginning column limits +int oc2[ARB] # output ending column limits +int ol1[ARB] # output beginning line limits +int ol2[ARB] # output ending line limits +real deltax[ARB] # x shifts +real deltay[ARB] # x shifts + + +int i, j, k, nimages, nxsize, nysize, nimcols, nimlines +int c1ref, c2ref, l1ref, l2ref, ideltax, ideltay + +begin + # Find the position in the output image of the reference subraster. + nxsize = IR_NCOLS(ir) - IR_NXOVERLAP(ir) + nysize = IR_NROWS(ir) - IR_NYOVERLAP(ir) + c1ref = (IR_NXRSUB(ir) - 1) * nxsize + 1 + IR_XREF(ir) + c2ref = c1ref + IR_NCOLS(ir) - 1 + l1ref = (IR_NYRSUB(ir) - 1) * nysize + 1 + IR_YREF(ir) + l2ref = l1ref + IR_NROWS(ir) - 1 + nimages = IR_NXSUB(ir) * IR_NYSUB(ir) + + # Extract the subrasters one by one. + do i = 1, nimages { + + # Compute the indices of each subraster. + call ir_indices (i, j, k, IR_NXSUB(ir), IR_NYSUB(ir), + IR_CORNER(ir), IR_RASTER(ir), IR_ORDER(ir)) + + # Compute the indices of the input subraster. + nimcols = IM_LEN(im,1) + nimlines = IM_LEN(im,2) + ic1[i] = max (1, min (1 + (j - 1) * nxsize, nimcols)) + ic2[i] = min (nimcols, max (1, ic1[i] + IR_NCOLS(ir) - 1)) + il1[i] = max (1, min (1 + (k - 1) * nysize, nimlines)) + il2[i] = min (nimlines, max (1, il1[i] + IR_NROWS(ir) - 1)) + + # Compute the shift relative to the input subraster. + call ir_mkshift (xrshifts, yrshifts, xcshifts, ycshifts, + IR_NXSUB(ir), IR_NYSUB(ir), j, k, IR_NXRSUB(ir), + IR_NYRSUB(ir), IR_ORDER(ir), deltax[i], deltay[i]) + ideltax = nint (deltax[i]) + ideltay = nint (deltay[i]) + + # Get the output buffer. + oc1[i] = c1ref + (j - IR_NXRSUB(ir)) * IR_NCOLS(ir) + + ideltax + oc2[i] = c2ref + (j - IR_NXRSUB(ir)) * IR_NCOLS(ir) + + ideltax + ol1[i] = l1ref + (k - IR_NYRSUB(ir)) * IR_NROWS(ir) + + ideltay + ol2[i] = l2ref + (k - IR_NYRSUB(ir)) * IR_NROWS(ir) + + ideltay + } +end + + +# IR_FSHIFTS -- Compute the input and output column limits. + +procedure ir_fshifts (ir, im, outim, deltax, deltay, ic1, ic2, il1, il2, + oc1, oc2, ol1, ol2) + +pointer ir # pointer to the ir structure +pointer im # pointer to the input image +pointer outim # pointer to the output image +real deltax[ARB] # x shifts +real deltay[ARB] # x shifts +int ic1[ARB] # input beginning column limits +int ic2[ARB] # input ending column limits +int il1[ARB] # input beginning line limits +int il2[ARB] # input ending line limits +int oc1[ARB] # output beginning column limits +int oc2[ARB] # output ending column limits +int ol1[ARB] # output beginning line limits +int ol2[ARB] # output ending line limits + + +int i, j, k, nimages, nxsize, nysize, nimcols, nimlines +int c1ref, c2ref, l1ref, l2ref, ideltax, ideltay + +begin + # Find the position in the output image of the reference subraster. + nxsize = IR_NCOLS(ir) - IR_NXOVERLAP(ir) + nysize = IR_NROWS(ir) - IR_NYOVERLAP(ir) + c1ref = (IR_NXRSUB(ir) - 1) * nxsize + 1 + IR_XREF(ir) + c2ref = c1ref + IR_NCOLS(ir) - 1 + l1ref = (IR_NYRSUB(ir) - 1) * nysize + 1 + IR_YREF(ir) + l2ref = l1ref + IR_NROWS(ir) - 1 + nimages = IR_NXSUB(ir) * IR_NYSUB(ir) + + # Extract the subrasters one by one. + do i = 1, nimages { + + # Compute the indices of each subraster. + call ir_indices (i, j, k, IR_NXSUB(ir), IR_NYSUB(ir), + IR_CORNER(ir), IR_RASTER(ir), IR_ORDER(ir)) + + # Compute the indices of the input subraster. + nimcols = IM_LEN(im,1) + nimlines = IM_LEN(im,2) + ic1[i] = max (1, min (1 + (j - 1) * nxsize, nimcols)) + ic2[i] = min (nimcols, max (1, ic1[i] + IR_NCOLS(ir) - 1)) + il1[i] = max (1, min (1 + (k - 1) * nysize, nimlines)) + il2[i] = min (nimlines, max (1, il1[i] + IR_NROWS(ir) - 1)) + + # Compute the shift relative to the input subraster. + ideltax = nint (deltax[i]) + ideltay = nint (deltay[i]) + + # Get the output buffer. + oc1[i] = c1ref + (j - IR_NXRSUB(ir)) * IR_NCOLS(ir) + + ideltax + oc2[i] = c2ref + (j - IR_NXRSUB(ir)) * IR_NCOLS(ir) + + ideltax + ol1[i] = l1ref + (k - IR_NYRSUB(ir)) * IR_NROWS(ir) + + ideltay + ol2[i] = l2ref + (k - IR_NYRSUB(ir)) * IR_NROWS(ir) + + ideltay + } +end + + +# IR_SUBALIGN -- Align all the subrasters. + +procedure ir_subalign (ir, im, outim, trimlimits, ic1, ic2, il1, il2, + oc1, oc2, ol1, ol2, deltax, deltay, deltai, match, interp, verbose) + +pointer ir # pointer to the ir structure +pointer im # pointer to the input image +pointer outim # pointer to the output image +char trimlimits[ARB] # compute the trim section +int ic1[ARB] # input image beginning columns +int ic2[ARB] # input image ending columns +int il1[ARB] # input image beginning rows +int il2[ARB] # input image ending rows +int oc1[ARB] # output image beginning columns +int oc2[ARB] # output image ending columns +int ol1[ARB] # output image beginning rows +int ol2[ARB] # output image ending rows +real deltax[ARB] # array of x shifts +real deltay[ARB] # array of y shifts +real deltai[ARB] # array of intensity shifts +int match # match intensities ? +int interp # type of interpolant +int verbose # print messages + +int i, k, tl1, tl2, tc1, tc2, nimcols, nimlines, nimages +int ideltax, ideltay, lxoffset, hxoffset, lyoffset, hyoffset +int ixoffset, iyoffset, nocols, norows, cin1, cin2, nicols +int tlin1, lin1, lin2, nilines, lout1, lout2, nyout, fstline, lstline +pointer sp, x, y, msi, inbuf, outbuf, ptr +real dx, dy, ytemp +int ir_decode_section() +pointer imps2r() + +begin + # Allocate temporary space. + call smark (sp) + call salloc (x, IR_NCOLS(ir), TY_REAL) + call salloc (y, IR_NCOLS(ir), TY_REAL) + + # Decode the trimsection. + if (ir_decode_section (trimlimits, IR_NCOLS(ir), IR_NROWS(ir), + tc1, tc2, tl1, tl2) == ERR) { + tc1 = 0 + tc2 = 0 + tl1 = 0 + tl2 = 0 + } else { + tc1 = max (0, min (tc1, IR_NCOLS(ir))) + tc2 = max (0, min (tc2, IR_NCOLS(ir))) + tl1 = max (0, min (tl1, IR_NROWS(ir))) + tl2 = max (0, min (tl2, IR_NROWS(ir))) + } + + # Initialize the interpolant. + call msiinit (msi, interp) + + nimcols = IM_LEN(outim,1) + nimlines = IM_LEN(outim,2) + + # Extract the subrasters one by one. + nimages = IR_NXSUB(ir) * IR_NYSUB(ir) + do i = 1, nimages { + + inbuf = NULL + + # Reject and subraster which is off the image. + if (oc1[i] > nimcols || oc2[i] < 1 || ol1[i] > nimlines || + ol2[i] < 1) + next + + # Compute the integer and fractional part of the shift. + ideltax = nint (deltax[i]) + ideltay = nint (deltay[i]) + dx = deltax[i] - ideltax + dy = deltay[i] - ideltay + + # Compute the output image limits. + lxoffset = max (1 - oc1[i], tc1) + hxoffset = max (oc2[i] - nimcols, tc2) + oc1[i] = max (1, min (nimcols, oc1[i] + lxoffset)) + oc2[i] = min (nimcols, max (1, oc2[i] - hxoffset)) + nocols = oc2[i] - oc1[i] + 1 + lyoffset = max (1 - ol1[i], tl1) + hyoffset = max (ol2[i] - nimlines, tl2) + ol1[i] = max (1, min (nimlines, ol1[i] + lyoffset)) + ol2[i] = min (nimlines, max (1, ol2[i] - hyoffset)) + norows = ol2[i] - ol1[i] + 1 + + # Compute some input image parameters. + cin1 = max (ic1[i], min (ic1[i] + lxoffset - NMARGIN, ic2[i])) + cin2 = min (ic2[i], max (ic2[i] - hxoffset + NMARGIN, ic1[i])) + nicols = cin2 - cin1 + 1 + + # Compute the x offset and x interpolation coordinates. + ixoffset = min (lxoffset, NMARGIN) + do k = 1, nicols + Memr[x+k-1] = max (1.0, min (real (nicols), real (k + ixoffset - + dx))) + + # Subdivide the image and do the shifting. + for (lout1 = ol1[i]; lout1 <= ol2[i]; lout1 = lout1 + NYOUT) { + + # Compute the output image limits. + lout2 = min (ol2[i], lout1 + NYOUT - 1) + nyout = lout2 - lout1 + 1 + + # Compute the input image limits. + tlin1 = il1[i] + lyoffset + lout1 - ol1[i] + lin2 = min (il2[i], max (tlin1 + nyout + NMARGIN - 1, il1[i])) + lin1 = max (il1[i], min (tlin1 - NMARGIN, il2[i])) + nilines = lin2 - lin1 + 1 + + # Get the appropriate input image section and fit the + # interpolant. + if ((inbuf == NULL) || (lin1 < fstline) || (lin2 > lstline)) { + fstline = lin1 + lstline = lin2 + call ir_buf (im, cin1, cin2, lin1, lin2, inbuf) + call msifit (msi, Memr[inbuf], nicols, nilines, nicols) + } + + # Get the y offset and y interpolation coordinates. + #iyoffset = max (0, lout1 - ideltay - lin1) + if (lout1 == ol1[i]) + iyoffset = min (lyoffset, NMARGIN) + else + iyoffset = tlin1 - lin1 + + # Shift the input images. + outbuf = imps2r (outim, oc1[i], oc2[i], lout1, lout2) + ptr = outbuf + do k = 1, nyout { + ytemp = max (1.0, min (real (nilines), real (k + iyoffset - + dy))) + call amovkr (ytemp, Memr[y], nocols) + call msivector (msi, Memr[x], Memr[y], Memr[ptr], nocols) + ptr = ptr + nocols + } + + # Shift the intensities. + if (match == YES && ! IS_INDEFR(deltai[i])) + call aaddkr (Memr[outbuf], deltai[i], Memr[outbuf], + nocols * nyout) + } + + if (inbuf != NULL) + call mfree (inbuf, TY_REAL) + inbuf = NULL + + # Print a message. + if (verbose == YES) { + call printf (" %s[%d:%d,%d:%d] [%d:%d,%d:%d] %g %g") + call pargstr (IM_HDRFILE(im)) + call pargi (ic1[i]) + call pargi (ic2[i]) + call pargi (il1[i]) + call pargi (il2[i]) + call pargi (lxoffset + 1) + call pargi (lxoffset + nocols) + call pargi (lyoffset + 1) + call pargi (lyoffset + norows) + call pargr (deltax[i]) + call pargr (deltay[i]) + call printf (" %s[%d:%d,%d:%d] %g\n") + call pargstr (IM_HDRFILE(outim)) + call pargi (oc1[i]) + call pargi (oc2[i]) + call pargi (ol1[i]) + call pargi (ol2[i]) + call pargr (deltai[i]) + } + + } + + call msifree (msi) + call sfree (sp) +end + + +# IR_BUF -- Procedure to provide a buffer of image lines with minimum reads. + +procedure ir_buf (im, col1, col2, line1, line2, buf) + +pointer im # pointer to input image +int col1, col2 # column range of input buffer +int line1, line2 # line range of input buffer +pointer buf # buffer + +int i, ncols, nlines, nclast, llast1, llast2, nllast +pointer buf1, buf2 + +pointer imgs2r() + +begin + ncols = col2 - col1 + 1 + nlines = line2 - line1 + 1 + + if (buf == NULL) { + call malloc (buf, ncols * nlines, TY_REAL) + llast1 = line1 - nlines + llast2 = line2 - nlines + } else if ((nlines != nllast) || (ncols != nclast)) { + call realloc (buf, ncols * nlines, TY_REAL) + llast1 = line1 - nlines + llast2 = line2 - nlines + } + + if (line1 < llast1) { + do i = line2, line1, -1 { + if (i > llast1) + buf1 = buf + (i - llast1) * ncols + else + buf1 = imgs2r (im, col1, col2, i, i) + buf2 = buf + (i - line1) * ncols + call amovr (Memr[buf1], Memr[buf2], ncols) + } + } else if (line2 > llast2) { + do i = line1, line2 { + if (i < llast2) + buf1 = buf + (i - llast1) * ncols + else + buf1 = imgs2r (im, col1, col2, i, i) + buf2 = buf + (i - line1) * ncols + call amovr (Memr[buf1], Memr[buf2], ncols) + } + } + + llast1 = line1 + llast2 = line2 + nclast = ncols + nllast = nlines +end diff --git a/noao/nproto/ir/irdbio.x b/noao/nproto/ir/irdbio.x new file mode 100644 index 00000000..00e40532 --- /dev/null +++ b/noao/nproto/ir/irdbio.x @@ -0,0 +1,117 @@ +include "iralign.h" + +# IR_DTRPARAMS -- Procedure to read in the parameters from the database file. + +procedure ir_dtrparams (dt, image, ir) + +pointer dt # pointer to the database file +char image[ARB] # input image +pointer ir # pointer to the ir structure + +int recnum, nsubrasters +pointer sp, str +int dtlocate(), dtgeti(), strmatch() +real dtgetr() + +begin + call smark (sp) + call salloc (str, SZ_FNAME, TY_CHAR) + recnum = dtlocate (dt, image) + + IR_NCOLS(ir) = dtgeti (dt, recnum, "ncols") + IR_NROWS(ir) = dtgeti (dt, recnum, "nrows") + IR_NXSUB(ir) = dtgeti (dt, recnum, "nxsub") + IR_NYSUB(ir) = dtgeti (dt, recnum, "nysub") + IR_NXOVERLAP(ir) = dtgeti (dt, recnum, "nxoverlap") + IR_NYOVERLAP(ir) = dtgeti (dt, recnum, "nyoverlap") + + call dtgstr (dt, recnum, "corner", Memc[str], SZ_FNAME) + if (strmatch (Memc[str], "ll") != 0) + IR_CORNER(ir) = IR_LL + else if (strmatch (Memc[str], "lr") != 0) + IR_CORNER(ir) = IR_LR + else if (strmatch (Memc[str], "ul") != 0) + IR_CORNER(ir) = IR_UL + else if (strmatch (Memc[str], "ur") != 0) + IR_CORNER(ir) = IR_UR + else + IR_CORNER(ir) = IR_LL + + call dtgstr (dt, recnum, "order", Memc[str], SZ_FNAME) + if (strmatch (Memc[str], "column") != 0) + IR_ORDER(ir) = IR_COLUMN + else if (strmatch (Memc[str], "row") != 0) + IR_ORDER(ir) = IR_ROW + else + IR_ORDER(ir) = IR_ROW + + call dtgstr (dt, recnum, "raster", Memc[str], SZ_FNAME) + if (strmatch (Memc[str], "yes") != 0) + IR_RASTER(ir) = YES + else if (strmatch (Memc[str], "no") != 0) + IR_RASTER(ir) = NO + else + IR_RASTER(ir) = NO + + IR_OVAL(ir) = dtgetr (dt, recnum, "oval") + nsubrasters = dtgeti (dt, recnum, "nsubrasters") + + call sfree (sp) +end + + +# IR_DTWPARAMS -- Procedure to write out the parameters to the output file + +procedure ir_dtwparams (dt, outimage, trimsection, medsection, ir) + +pointer dt # pointer to the database file +char outimage[ARB] # name of the output image +char trimsection[ARB]# input subraster section +char medsection[ARB] # section for computing the median +pointer ir # pointer to the ir structure + +bool itob() + +begin + call dtptime (dt) + call dtput (dt, "begin\t%s\n") + call pargstr (outimage) + call dtput (dt, "\ttrimsection\t%s\n") + call pargstr (trimsection) + call dtput (dt, "\tmedsection\t\t%s\n") + call pargstr (medsection) + call dtput (dt, "\tncols\t\t%d\n") + call pargi (IR_NCOLS(ir)) + call dtput (dt, "\tnrows\t\t%d\n") + call pargi (IR_NROWS(ir)) + call dtput (dt, "\tnxsub\t\t%d\n") + call pargi (IR_NXSUB(ir)) + call dtput (dt, "\tnysub\t\t%d\n") + call pargi (IR_NYSUB(ir)) + call dtput (dt, "\tnxoverlap\t%d\n") + call pargi (IR_NXOVERLAP(ir)) + call dtput (dt, "\tnyoverlap\t%d\n") + call pargi (IR_NYOVERLAP(ir)) + call dtput (dt, "\tcorner\t\t%s\n") + switch (IR_CORNER(ir)) { + case IR_LL: + call pargstr ("ll") + case IR_LR: + call pargstr ("lr") + case IR_UL: + call pargstr ("ul") + case IR_UR: + call pargstr ("ur") + } + call dtput (dt, "\torder\t\t%s\n") + switch (IR_ORDER(ir)) { + case IR_ROW: + call pargstr ("row") + case IR_COLUMN: + call pargstr ("column") + } + call dtput (dt, "\traster\t\t%b\n") + call pargb (itob (IR_RASTER(ir))) + call dtput (dt, "\toval\t\t%g\n") + call pargr (IR_OVAL(ir)) +end diff --git a/noao/nproto/ir/iriinit.x b/noao/nproto/ir/iriinit.x new file mode 100644 index 00000000..a97ade8e --- /dev/null +++ b/noao/nproto/ir/iriinit.x @@ -0,0 +1,28 @@ +# IR_VECINIT -- Procedure to initialize the intensity matching algorithm. +# If the ranges are undefined and no matching is to take place the +# ishifts are set to INDEFR and the routine returns. Otherwise the shifts +# are all initialized to zero and shifts for the missing subrasters are +# set to INDEFR. + +procedure ir_vecinit (deltai, nsubrasters, ranges) + +real deltai[ARB] # intensity shifts +int nsubrasters # number of subrasters +int ranges[ARB] # ranges of missing subrasters + +int num +int get_next_number() + +begin + # Initialize the shifts to INDEFR. + call amovkr (INDEFR, deltai, nsubrasters) + if (ranges[1] == NULL) + return + + num = 0 + while (get_next_number (ranges, num) != EOF) { + if (num > nsubrasters) + break + deltai[num] = 0.0 + } +end diff --git a/noao/nproto/ir/irimisec.x b/noao/nproto/ir/irimisec.x new file mode 100644 index 00000000..1b6936db --- /dev/null +++ b/noao/nproto/ir/irimisec.x @@ -0,0 +1,105 @@ +include <ctype.h> + +# IR_DECODE_SECTION -- Procedure to decode the reference section. + +int procedure ir_decode_section (section, ncols, nrows, c1ref, c2ref, l1ref, + l2ref) + +char section[ARB] # reference subraster section +int ncols # number of columns in the image +int nrows # number of rows in the image +int c1ref # initial column +int c2ref # final reference column +int l1ref # initial reference line +int l2ref # final reference line + +char leftbkt +int index, ip, step +int ir_decode_subscript(), stridx() + +begin + leftbkt = '[' + index = stridx (leftbkt, section) + if (index == 0) + return (ERR) + ip = index + 1 + if (ir_decode_subscript (section, ip, ncols, c1ref, c2ref, step) == ERR) + return (ERR) + if (ir_decode_subscript (section, ip, nrows, l1ref, l2ref, step) == ERR) + return (ERR) + return (OK) +end + + +# IR_DECODE_SUBSCRIPT -- Decode a single subscript expression to produce the +# range of values for that subscript (X1:X2), and the sampling step size, STEP. +# Note that X1 may be less than, greater than, or equal to X2, and STEP may +# be a positive or negative nonzero integer. Various shorthand notations are +# permitted, as is embedded whitespace. + +int procedure ir_decode_subscript (section, ip, maxnumber, x1, x2, step) + +char section[ARB] +int ip +int maxnumber +long x1, x2, step, temp +int ctol() + +begin + x1 = 1 + x2 = maxnumber + step = 1 + + while (IS_WHITE(section[ip])) + ip = ip + 1 + + # Get X1, X2. + if (ctol (section, ip, temp) > 0) { # [x1 + x1 = temp + if (section[ip] == ':') { + ip = ip + 1 + if (ctol (section, ip, x2) == 0) # [x1:x2 + return (ERR) + } else + x2 = x1 + + } else if (section[ip] == '-') { + x1 = maxnumber # [-* + x2 = 1 + ip = ip + 1 + if (section[ip] == '*') + ip = ip + 1 + + } else if (section[ip] == '*') # [* + ip = ip + 1 + + while (IS_WHITE(section[ip])) + ip = ip + 1 + + # Get sample step size, if give. + if (section[ip] == ':') { # ..:step + ip = ip + 1 + if (ctol (section, ip, step) == 0) + return (ERR) + else if (step == 0) + return (ERR) + } + + # Allow notation such as "-*:5", (or even "-:5") where the step + # is obviously supposed to be negative. + + if (x1 > x2 && step > 0) + step = -step + + while (IS_WHITE(section[ip])) + ip = ip + 1 + + if (section[ip] == ',') { + ip = ip + 1 + return (OK) + } else if (section[ip] == ']') + return (OK) + else + return (ERR) + +end diff --git a/noao/nproto/ir/irimzero.x b/noao/nproto/ir/irimzero.x new file mode 100644 index 00000000..013ab2d6 --- /dev/null +++ b/noao/nproto/ir/irimzero.x @@ -0,0 +1,22 @@ + +# IR_IMZERO -- Fill the output image with a constant value. + +procedure ir_imzero (im, ncols, nlines, value) + +pointer im # pointer to the output image +int ncols # number of columns +int nlines # number of lines +real value # default blank value + +int i +pointer obuf +pointer impl2r() + +begin + do i = 1, nlines { + obuf = impl2r (im, i) + if (obuf == EOF) + call error (0, "Error writing output image.") + call amovkr (value, Memr[obuf], ncols) + } +end diff --git a/noao/nproto/ir/irindices.x b/noao/nproto/ir/irindices.x new file mode 100644 index 00000000..2ff94d81 --- /dev/null +++ b/noao/nproto/ir/irindices.x @@ -0,0 +1,139 @@ +include "iralign.h" + +# IR_INDICES -- Given the number in the list for a missing subraster and +# information about how the subrasters were written return the i and j +# indices of the specified subrasters. + +procedure ir_indices (num, i, j, nxsub, nysub, corner, raster, order) + +int num # number of the subraster +int i,j # indices of the subraster +int nxsub,nysub # number of subrasters in x and y +int corner # starting corner +int raster # raster order +int order # column or row order + +begin + switch (corner) { + case IR_LL: + if (order == IR_ROW) { + if (mod (num, nxsub) == 0) { + j = num / nxsub + if (raster == YES && mod (j,2) == 0) + i = 1 + else + i = nxsub + } else { + j = num / nxsub + 1 + if (raster == YES && mod (j,2) == 0) + i = nxsub - mod (num, nxsub) + 1 + else + i = mod (num, nxsub) + } + } else if (order == IR_COLUMN) { + if (mod (num, nysub) == 0) { + i = num / nysub + if (raster == YES && mod (i,2) == 0) + j = 1 + else + j = nysub + } else { + i = num / nysub + 1 + if (raster == YES && mod (i,2) == 0) + j = nysub - mod (num, nysub) + 1 + else + j = mod (num, nysub) + } + } + case IR_LR: + if (order == IR_ROW) { + if (mod (num, nxsub) == 0) { + j = num / nxsub + if (raster == YES && mod (j,2) == 0) + i = nxsub + else + i = 1 + } else { + j = num / nxsub + 1 + if (raster == YES && mod (j,2) == 0) + i = mod (num, nxsub) + else + i = nxsub - mod (num, nxsub) + 1 + } + } else if (order == IR_COLUMN) { + if (mod (num, nysub) == 0) { + i = nxsub - num / nysub + 1 + if (raster == YES && mod (i,2) != 0) + j = 1 + else + j = nysub + } else { + i = nxsub - num / nysub + if (raster == YES && mod (i,2) != 0) + j = nysub - mod (num, nysub) + 1 + else + j = mod (num, nysub) + } + } + case IR_UL: + if (order == IR_ROW) { + if (mod (num, nxsub) == 0) { + j = nysub - num / nxsub + 1 + if (raster == YES && mod (j,2) != 0) + i = 1 + else + i = nxsub + } else { + j = nysub - num / nxsub + if (raster == YES && mod (j,2) != 0) + i = nxsub - mod (num, nxsub) + 1 + else + i = mod (num, nxsub) + } + } else if (order == IR_COLUMN) { + if (mod (num, nysub) == 0) { + i = num / nysub + if (raster == YES && mod (i,2) == 0) + j = nysub + else + j = 1 + } else { + i = num / nysub + 1 + if (raster == YES && mod (i,2) == 0) + j = mod (num, nysub) + else + j = nysub - mod (num, nysub) + 1 + } + } + case IR_UR: + if (order == IR_ROW) { + if (mod (num, nxsub) == 0) { + j = nysub - num / nxsub + 1 + if (raster == YES && mod (j,2) != 0) + i = nxsub + else + i = 1 + } else { + j = nysub - num / nxsub + if (raster == YES && mod (j,2) != 0) + i = mod (num, nxsub) + else + i = nxsub - mod (num, nxsub) + 1 + } + } else if (order == IR_COLUMN) { + if (mod (num, nysub) == 0) { + i = nxsub - num / nysub + 1 + if (raster == YES && mod (i,2) != 0) + j = nysub + else + j = 1 + } else { + i = nxsub - num / nysub + if (raster == YES && mod (i,2) != 0) + j = mod (num, nysub) + else + j = nysub - mod (num, nysub) + 1 + } + } + } +end diff --git a/noao/nproto/ir/irlinks.x b/noao/nproto/ir/irlinks.x new file mode 100644 index 00000000..2b8b3a4a --- /dev/null +++ b/noao/nproto/ir/irlinks.x @@ -0,0 +1,496 @@ +include "iralign.h" + +# IR_LINKS -- Procedure to compute the shifts for each subraster. + +int procedure ir_links (cl, xrshift, yrshift, xcshift, ycshift, nrshift, + ncshift, ncols, nrows, nxrsub, nyrsub, nxsub, nysub, nxoverlap, + nyoverlap, order) + +int cl # coordinate list descriptor +real xrshift[nxsub,ARB] # x row shifts +real yrshift[nxsub,ARB] # y row shifts +real xcshift[nxsub,ARB] # x column shifts +real ycshift[nxsub,ARB] # y column shifts +int nrshift[nxsub,ARB] # number of row shifts +int ncshift[nxsub,ARB] # number of column shifts +int ncols # number of columns per subraster +int nrows # number of rows per subraster +int nxrsub # column index of reference subraster +int nyrsub # row index of reference subraster +int nxsub # number of subrasters in x +int nysub # number of subrasters in y +int nxoverlap # number of columns of overlap +int nyoverlap # number of rows of overlap +int order # row or column order + +int i, j, nxsize, nysize, ilimit, olimit, nshifts +pointer sp, xcolavg, ycolavg, xrowavg, yrowavg, nrowavg, ncolavg +real isign, jsign, xrmed, yrmed, xcmed, ycmed +int ir_decode_shifts() +real irmedr() + +begin + # Allocate temporary space. + if (order == IR_COLUMN) { + ilimit = nysub + olimit = nxsub + } else { + ilimit = nxsub + olimit = nysub + } + + # Clear the shift arrays. + call aclrr (xrshift, nxsub * nysub) + call aclrr (yrshift, nxsub * nysub) + call aclrr (xcshift, nxsub * nysub) + call aclrr (ycshift, nxsub * nysub) + call aclri (nrshift, nxsub * nysub) + call aclri (ncshift, nxsub * nysub) + + # Accumulate the shifts. + nxsize = ncols - nxoverlap + nysize = nrows - nyoverlap + nshifts = ir_decode_shifts (cl, xrshift, yrshift, nrshift, xcshift, + ycshift, ncshift, nxsub, nysub, nxrsub, nyrsub, nxoverlap, + nyoverlap, nxsize, nysize) + if (nshifts == 0) + return (0) + + # Allocate working space. + call smark (sp) + call salloc (xcolavg, olimit, TY_REAL) + call salloc (ycolavg, olimit, TY_REAL) + call salloc (ncolavg, olimit, TY_INT) + call salloc (xrowavg, olimit, TY_REAL) + call salloc (yrowavg, olimit, TY_REAL) + call salloc (nrowavg, olimit, TY_INT) + + # Clear the accumulator arrays. + call aclrr (Memr[xcolavg], olimit) + call aclrr (Memr[ycolavg], olimit) + call aclri (Memi[ncolavg], olimit) + call aclrr (Memr[xrowavg], olimit) + call aclrr (Memr[yrowavg], olimit) + call aclri (Memi[nrowavg], olimit) + + # Compute the row or column sums. + if (order == IR_COLUMN) { + do i = 1, nxsub { + do j = 1, nysub { + if (nrshift[i,j] > 0) { + Memr[xrowavg+i-1] = Memr[xrowavg+i-1] + + abs (xrshift[i,j]) + Memr[yrowavg+i-1] = Memr[yrowavg+i-1] + + abs (yrshift[i,j]) + Memi[nrowavg+i-1] = Memi[nrowavg+i-1] + 1 + } + if (ncshift[i,j] > 0) { + Memr[xcolavg+i-1] = Memr[xcolavg+i-1] + + abs (xcshift[i,j]) + Memr[ycolavg+i-1] = Memr[ycolavg+i-1] + + abs (ycshift[i,j]) + Memi[ncolavg+i-1] = Memi[ncolavg+i-1] + 1 + } + } + } + } else { + do i = 1, nysub { + do j = 1, nxsub { + if (nrshift[j,i] > 0) { + Memr[xrowavg+i-1] = Memr[xrowavg+i-1] + + abs (xrshift[j,i]) + Memr[yrowavg+i-1] = Memr[yrowavg+i-1] + + abs (yrshift[j,i]) + Memi[nrowavg+i-1] = Memi[nrowavg+i-1] + 1 + } + if (ncshift[j,i] > 0) { + Memr[xcolavg+i-1] = Memr[xcolavg+i-1] + + abs (xcshift[j,i]) + Memr[ycolavg+i-1] = Memr[ycolavg+i-1] + + abs (ycshift[j,i]) + Memi[ncolavg+i-1] = Memi[ncolavg+i-1] + 1 + } + } + } + } + + # Compute the averages. + do i = 1, olimit { + if (Memi[nrowavg+i-1] > 0) { + Memr[xrowavg+i-1] = Memr[xrowavg+i-1] / Memi[nrowavg+i-1] + Memr[yrowavg+i-1] = Memr[yrowavg+i-1] / Memi[nrowavg+i-1] + } + if (Memi[ncolavg+i-1] > 0) { + Memr[xcolavg+i-1] = Memr[xcolavg+i-1] / Memi[ncolavg+i-1] + Memr[ycolavg+i-1] = Memr[ycolavg+i-1] / Memi[ncolavg+i-1] + } + } + + # Compute the medians of the row and column averages. + xrmed = irmedr (Memr[xrowavg], Memi[nrowavg], olimit) + yrmed = irmedr (Memr[yrowavg], Memi[nrowavg], olimit) + xcmed = irmedr (Memr[xcolavg], Memi[ncolavg], olimit) + ycmed = irmedr (Memr[ycolavg], Memi[ncolavg], olimit) + + # Use the average shifts for subrasters with no information. + do j = 1, nysub { + + if (j == nyrsub) + jsign = 0.0 + else if (j < nyrsub) + jsign = 1.0 + else + jsign = -1.0 + + do i = 1, nxsub { + + if (i == nxrsub) + isign = 0.0 + else if (i < nxrsub) + isign = 1.0 + else + isign = -1.0 + + if (nrshift[i,j] <= 0) { + if (Memi[nrowavg+i-1] <= 0) { + xrshift[i,j] = isign * xrmed + yrshift[i,j] = jsign * yrmed + } else if (order == IR_COLUMN) { + xrshift[i,j] = isign * Memr[xrowavg+i-1] + yrshift[i,j] = jsign * Memr[yrowavg+i-1] + } else { + xrshift[i,j] = isign * Memr[xrowavg+j-1] + yrshift[i,j] = jsign * Memr[yrowavg+j-1] + } + } + + if (ncshift[i,j] <= 0) { + if (Memi[ncolavg+i-1] <= 0) { + xcshift[i,j] = isign * xcmed + ycshift[i,j] = jsign * ycmed + } else if (order == IR_COLUMN) { + xcshift[i,j] = isign * Memr[xcolavg+i-1] + ycshift[i,j] = jsign * Memr[ycolavg+i-1] + } else { + xcshift[i,j] = isign * Memr[xcolavg+j-1] + ycshift[i,j] = jsign * Memr[ycolavg+j-1] + } + } + } + } + + call sfree (sp) + return (nshifts) +end + + +# IR_DECODE_SHIFTS -- Procedure to accumulate shifts for each subraster. + +int procedure ir_decode_shifts (cl, xrshift, yrshift, nrshift, xcshift, + ycshift, ncshift, nxsub, nysub, nxrsub, nyrsub, nxoverlap, + nyoverlap, nxsize, nysize) + +int cl # coordinate list descriptor +real xrshift[nxsub,ARB] # x row shifts +real yrshift[nxsub,ARB] # y row shifts +int nrshift[nxsub,ARB] # number of row shifts +real xcshift[nxsub,ARB] # x column shifts +real ycshift[nxsub,ARB] # y column shifts +int ncshift[nxsub,ARB] # number of column shifts +int nxsub # number of subrasters in x +int nysub # number of subrasters in y +int nxrsub # column index of reference subraster +int nyrsub # row index of reference subraster +int nxoverlap # number of columns of overlap +int nyoverlap # number of rows of overlap +int nxsize # size of unoverlapped region +int nysize # size of unoverlapped region + +int i, j, nx1, ny1, nx2, ny2, r21, r22, stat, nshifts +real x1, y1, x2, y2, xdif, xdifm, ydif, ydifm +int fscan(), nscan() + +begin + nshifts = 0 + while (fscan (cl) != EOF) { + + # Get the first coordinate pair. + call gargr (x1) + call gargr (y1) + if (nscan () != 2) + next + + # Compute which subraster 1 belongs to. + if (mod (int (x1), nxsize) == 0) + nx1 = int (x1) / nxsize + else + nx1 = int (x1) / nxsize + 1 + + if (mod (int (y1), nysize) == 0) + ny1 = int (y1) / nysize + else + ny1 = int (y1) / nysize + 1 + + # Get the second coordinate pair. + repeat { + + stat = fscan (cl) + if (stat == EOF) + break + call gargr (x2) + call gargr (y2) + + # Compute which subraster 2 belongs to. + if (nscan () == 2) { + if (mod (int (x2), nxsize) == 0) + nx2 = int (x2) / nxsize + else + nx2 = int (x2) / nxsize + 1 + if (mod (int (y2), nysize) == 0) + ny2 = int (y2) / nysize + else + ny2 = int (y2) / nysize + 1 + } + + } until (nscan () == 2) + if (stat == EOF || nscan() != 2) + break + + r21 = (nx1 - nxrsub) ** 2 + (ny1 - nyrsub) ** 2 + r22 = (nx2 - nxrsub) ** 2 + (ny2 - nyrsub) ** 2 + + # Illegal shift + if (r21 == r22) + next + + # Compute the shift for the first subraster. + else if (r21 > r22) { + + xdif = x2 - x1 + if (nxoverlap < 0) { + if (xdif < 0.0) + xdifm = xdif - nxoverlap + else if (xdif > 0.0) + xdifm = xdif + nxoverlap + } else + xdifm = xdif + + ydif = y2 - y1 + if (nyoverlap < 0) { + if (ydif < 0.0) + ydifm = ydif - nyoverlap + else if (ydif > 0.0) + ydifm = ydif + nyoverlap + } else + ydifm = ydif + + if (nx1 == nx2) { + xcshift[nx1,ny1] = xcshift[nx1,ny1] + xdif + ycshift[nx1,ny1] = ycshift[nx1,ny1] + ydifm + ncshift[nx1,ny1] = ncshift[nx1,ny1] + 1 + } else if (ny1 == ny2) { + xrshift[nx1,ny1] = xrshift[nx1,ny1] + xdifm + yrshift[nx1,ny1] = yrshift[nx1,ny1] + ydif + nrshift[nx1,ny1] = nrshift[nx1,ny1] + 1 + } else + next + + # Compute the shift for the second subraster. + } else { + + xdif = x1 - x2 + if (nxoverlap < 0) { + if (xdif < 0.0) + xdifm = xdif - nxoverlap + else if (xdif > 0.0) + xdifm = xdif + nxoverlap + } else + xdifm = xdif + + ydif = y1 - y2 + if (nyoverlap < 0) { + if (ydif < 0.0) + ydifm = ydif - nyoverlap + else if (ydif > 0.0) + ydifm = ydif + nyoverlap + } else + ydifm = ydif + + if (nx1 == nx2) { + xcshift[nx2,ny2] = xcshift[nx2,ny2] + xdif + ycshift[nx2,ny2] = ycshift[nx2,ny2] + ydifm + ncshift[nx2,ny2] = ncshift[nx2,ny2] + 1 + } else if (ny1 == ny2) { + xrshift[nx2,ny2] = xrshift[nx2,ny2] + xdifm + yrshift[nx2,ny2] = yrshift[nx2,ny2] + ydif + nrshift[nx2,ny2] = nrshift[nx2,ny2] + 1 + } else + next + } + + nshifts = nshifts + 1 + } + + # Compute the final shifts. + do j = 1, nysub { + do i = 1, nxsub { + if (nrshift[i,j] > 0) { + xrshift[i,j] = xrshift[i,j] / nrshift[i,j] + yrshift[i,j] = yrshift[i,j] / nrshift[i,j] + } + if (ncshift[i,j] > 0) { + xcshift[i,j] = xcshift[i,j] / ncshift[i,j] + ycshift[i,j] = ycshift[i,j] / ncshift[i,j] + } + } + } + + return (nshifts) +end + + +# IR_CLINKS -- Procedure to compute the shifts for each subraster. + +int procedure ir_clinks (xrshift, yrshift, xcshift, ycshift, nxrsub, nyrsub, + nxsub, nysub, xshift, yshift) + +real xrshift[nxsub,ARB] # x row shifts +real yrshift[nxsub,ARB] # y row shifts +real xcshift[nxsub,ARB] # x column shifts +real ycshift[nxsub,ARB] # y column shifts +int nxrsub # x index of reference subraster +int nyrsub # y index of reference subraster +int nxsub # number of subrasters in x direction +int nysub # number of subrasters in y direction +real xshift # xshift of the coordinates +real yshift # yshift of the coordinates + +int i, j, isign, jsign + +begin + do j = 1, nysub { + if (j == nyrsub) + jsign = 0 + else if (j < nyrsub) + jsign = 1 + else + jsign = -1 + + do i = 1, nxsub { + if (i == nxrsub) + isign = 0 + else if (i < nxrsub) + isign = 1 + else + isign = -1 + + xrshift[i,j] = isign * abs (xshift) + yrshift[i,j] = 0.0 + xcshift[i,j] = 0.0 + ycshift[i,j] = jsign * abs (yshift) + } + } + + return (1) +end + + +# IR_FLINKS -- Routine to fetch the shifts directly + +int procedure ir_flinks (cl, deltax, deltay, deltai, max_nshifts) + +int cl # shifts file descriptor +real deltax[ARB] # x shifts +real deltay[ARB] # y shifts +real deltai[ARB] # intensity shifts +int max_nshifts # maximum number of shifts + +int nshifts +int fscan(), nscan() + +begin + nshifts = 0 + while ((fscan (cl) != EOF) && (nshifts < max_nshifts)) { + call gargr (deltax[nshifts+1]) + call gargr (deltay[nshifts+1]) + call gargr (deltai[nshifts+1]) + if (nscan() < 2) + next + if (nscan() < 3) + deltai[nshifts+1] = 0.0 + nshifts = nshifts + 1 + } + + return (nshifts) +end + + +# IR_MKSHIFT -- Routine to compute the total shift for each subraster. + +procedure ir_mkshift (xrshift, yrshift, xcshift, ycshift, nxsub, nysub, + xsubindex, ysubindex, nxrsub, nyrsub, order, deltax, deltay) + +real xrshift[nxsub,ARB] # x row shifts +real yrshift[nxsub,ARB] # y row shifts +real xcshift[nxsub,ARB] # x column shifts +real ycshift[nxsub,ARB] # y column shifts +int nxsub # number of subrasters in x direction +int nysub # number of subrasters in y direction +int xsubindex # x index of the subraster +int ysubindex # y index of the subraster +int nxrsub # x index of reference subraster +int nyrsub # y index of reference subraster +int order # row or column order +real deltax # total x shift +real deltay # total y shift + +int j + +begin + deltax = 0.0 + deltay = 0.0 + + if (order == IR_COLUMN) { + if (ysubindex < nyrsub) + do j = ysubindex, nyrsub - 1 { + deltax = deltax + xcshift[xsubindex,j] + deltay = deltay + ycshift[xsubindex,j] + } + else if (ysubindex > nyrsub) + do j = nyrsub + 1, ysubindex { + deltax = deltax + xcshift[xsubindex,j] + deltay = deltay + ycshift[xsubindex,j] + } + if (xsubindex < nxrsub) + do j = xsubindex, nxrsub - 1 { + deltax = deltax + xrshift[j,nyrsub] + deltay = deltay + yrshift[j,nyrsub] + } + else if (xsubindex > nxrsub) + do j = nxrsub + 1, xsubindex { + deltax = deltax + xrshift[j,nyrsub] + deltay = deltay + yrshift[j,nyrsub] + } + } else { + if (xsubindex < nxrsub) + do j = xsubindex, nxrsub - 1{ + deltax = deltax + xrshift[j,ysubindex] + deltay = deltay + yrshift[j,ysubindex] + } + else if (xsubindex > nxrsub) + do j = nxrsub + 1, xsubindex { + deltax = deltax + xrshift[j,ysubindex] + deltay = deltay + yrshift[j,ysubindex] + } + if (ysubindex < nyrsub) + do j = ysubindex, nyrsub - 1 { + deltax = deltax + xcshift[nxrsub,j] + deltay = deltay + ycshift[nxrsub,j] + } + else if (ysubindex > nyrsub) + do j = nyrsub + 1, ysubindex { + deltax = deltax + xcshift[nxrsub,j] + deltay = deltay + ycshift[nxrsub,j] + } + } +end diff --git a/noao/nproto/ir/irmatch1d.x b/noao/nproto/ir/irmatch1d.x new file mode 100644 index 00000000..b3c6cdfb --- /dev/null +++ b/noao/nproto/ir/irmatch1d.x @@ -0,0 +1,122 @@ +include <imhdr.h> +include <pkg/dttext.h> +include "iralign.h" + +# IR_M1MATCH -- Procedure to match images in the direction of observation +# direction. + +procedure ir_m1match (ir, im, ranges, ic1, ic2, il1, il2, deltax, deltay, + deltai) + +pointer ir # pointer to the ir strucuture +pointer im # pointer to the input image +int ranges[ARB] # array elements to be skipped +int ic1[ARB] # input beginning column limits +int ic2[ARB] # output beginning column limits +int il1[ARB] # input beginning line limits +int il2[ARB] # output beginning line limits +real deltax[ARB] # x shifts +real deltay[ARB] # y shifts +real deltai[ARB] # intensity shifts + +int num, nmod, turn_corner +int pc1, pc2, pl1, pl2, c1, c2, l1, l2 +int pideltax, pideltay, ideltax, ideltay +int oc1, oc2, ol1, ol2, clim1, clim2, llim1, llim2 +pointer buf +real pmedian, median, dif + +int ir_overlap() +pointer imgs2r() +real amedr() + +begin + # Initialize the intensity subraster. + call ir_vecinit (deltai, IR_NXSUB(ir) * IR_NYSUB(ir), ranges) + + if (IR_ORDER(ir) == IR_ROW) + nmod = IR_NXSUB(ir) + else + nmod = IR_NYSUB(ir) + + # Loop over the subrasters to be matched. + for (num = 1; num <= IR_NXSUB(ir) * IR_NYSUB(ir); num = num + 1) { + + if (num == 1) { + + # Get the position and shift for the first subraster. + pideltax = nint (deltax[num]) + pideltay = nint (deltay[num]) + pc1 = ic1[num] + pc2 = ic2[num] + pl1 = il1[num] + pl2 = il2[num] + num = num + 1 + dif = 0.0 + turn_corner = NO + + } else if ((IR_RASTER(ir)) == NO && (mod (num, nmod) == 1)) { + + # Get the position and shift for the first subraster. + pideltax = nint (deltax[num-nmod]) + pideltay = nint (deltay[num-nmod]) + pc1 = ic1[num-nmod] + pc2 = ic2[num-nmod] + pl1 = il1[num-nmod] + pl2 = il2[num-nmod] + dif = -deltai[num-nmod] + turn_corner = YES + + } else { + + # Reset the coordinates of the previous subraster. + pc1 = c1 + pc2 = c2 + pl1 = l1 + pl2 = l2 + pideltax = ideltax + pideltay = ideltay + turn_corner = NO + } + + # Get the positions and shifts of the next subraster. + ideltax = nint (deltax[num]) + ideltay = nint (deltay[num]) + c1 = ic1[num] + c2 = ic2[num] + l1 = il1[num] + l2 = il2[num] + + # Compute the overlap region. + if (ir_overlap (pc1 + pideltax, pc2 + pideltax, pl1 + pideltay, + pl2 + pideltay, c1 + ideltax, c2 + ideltax, l1 + ideltay, + l2 + ideltay, oc1, oc2, ol1, ol2) == YES) { + + clim1 = max (pc1, min (oc1 - pideltax, pc2)) + clim2 = min (pc2, max (oc2 - pideltax, pc1)) + llim1 = max (pl1, min (ol1 - pideltay, pl2)) + llim2 = min (pl2, max (ol2 - pideltay, pl1)) + buf = imgs2r (im, clim1, clim2, llim1, llim2) + pmedian = amedr (Memr[buf], (clim2 - clim1 + 1) * (llim2 - + llim1 + 1)) + + clim1 = max (c1, min (oc1 - ideltax, c2)) + clim2 = min (c2, max (oc2 - ideltax, c1)) + llim1 = max (l1, min (ol1 - ideltay, l2)) + llim2 = min (l2, max (ol2 - ideltay, l1)) + buf = imgs2r (im, clim1, clim2, llim1, llim2) + median = amedr (Memr[buf], (clim2 - clim1 + 1) * (llim2 - + llim1 + 1)) + + dif = dif + median - pmedian + if (turn_corner == YES) { + if (! IS_INDEFR (deltai[num])) + deltai[num] = deltai[num-nmod] - median + pmedian + } else { + if (! IS_INDEFR (deltai[num])) + deltai[num] = deltai[num] - dif + } + } + + } +end diff --git a/noao/nproto/ir/irmatch2d.x b/noao/nproto/ir/irmatch2d.x new file mode 100644 index 00000000..6e1bcd50 --- /dev/null +++ b/noao/nproto/ir/irmatch2d.x @@ -0,0 +1,276 @@ +include <imhdr.h> +include "iralign.h" + +# IR_M2MATCH -- Compute the intensity matching parameters. + +procedure ir_m2match (ir, im, ranges, ic1, ic2, il1, il2, deltax, deltay, + deltai) + +pointer ir # pointer to the ir structure +pointer im # pointer to the input image +int ranges[ARB] # ranges of data to align +int ic1[ARB] # array of input begin columns +int ic2[ARB] # array of input end columns +int il1[ARB] # array of input begin lines +int il2[ARB] # array of input end lines +real deltax[ARB] # array of x shifts +real deltay[ARB] # array of y shifts +real deltai[ARB] # array of i shifts + +begin + # Initialize the intensity subraster. + call ir_vecinit (deltai, IR_NXSUB(ir) * IR_NYSUB(ir), ranges) + if (ranges[1] == NULL) + return + + # Match the intensities in the direction of observation. + call ir_omatch (ir, im, ic1, ic2, il1, il2, deltax, deltay, deltai) + + # Match the intensities in the other direction. + call ir_nmatch (ir, im, ic1, ic2, il1, il2, deltax, deltay, deltai) +end + + +# IR_OMATCH -- Procedure to match images in the direction of observation +# direction. + +procedure ir_omatch (ir, im, ic1, ic2, il1, il2, deltax, deltay, deltai) + +pointer ir # pointer to the ir structure +pointer im # pointer to the input image +int ic1[ARB] # beginning column limits +int ic2[ARB] # ending column limits +int il1[ARB] # beginning line limits +int il2[ARB] # ending line limits +real deltax[ARB] # array of x shifts +real deltay[ARB] # array of y shifts +real deltai[ARB] # array of intensity shifts + +int num, nimages, nrasters +int pc1, pc2, pl1, pl2, c1, c2, l1, l2 +int pideltax, pideltay, ideltax, ideltay +int oc1, oc2, ol1, ol2, clim1, clim2, llim1, llim2 +pointer buf +real pmedian, median, dif + +int ir_overlap() +pointer imgs2r() +real amedr() + +begin + # Compute the do loop parameters. + nimages = IR_NXSUB(ir) * IR_NYSUB(ir) + if (IR_ORDER(ir) == IR_ROW) + nrasters = IR_NXSUB(ir) + else + nrasters = IR_NYSUB(ir) + + # Loop over the subrasters to be matched. + for (num = 1; num <= nimages; num = num + 1) { + + if (mod (num, nrasters) == 1) { + + # Get the position and shift for the first subraster in + # the column. + pideltax = nint (deltax[num]) + pideltay = nint (deltay[num]) + pc1 = ic1[num] + pc2 = ic2[num] + pl1 = il1[num] + pl2 = il2[num] + num = num + 1 + dif = 0.0 + + # Get the the position and shift for the next subraster in + # the column.to be + ideltax = nint (deltax[num]) + ideltay = nint (deltay[num]) + c1 = ic1[num] + c2 = ic2[num] + l1 = il1[num] + l2 = il2[num] + + } else { + + # Reset the coordinates of the previous subraster. + pc1 = c1 + pc2 = c2 + pl1 = l1 + pl2 = l2 + pideltax = ideltax + pideltay = ideltay + + # Get the positions and shifts of the next subraster. + ideltax = nint (deltax[num]) + ideltay = nint (deltay[num]) + c1 = ic1[num] + c2 = ic2[num] + l1 = il1[num] + l2 = il2[num] + + } + + # Compute the overlap region. + if (ir_overlap (pc1 + pideltax, pc2 + pideltax, pl1 + pideltay, + pl2 + pideltay, c1 + ideltax, c2 + ideltax, l1 + ideltay, + l2 + ideltay, oc1, oc2, ol1, ol2) == YES) { + + clim1 = max (pc1, min (oc1 - pideltax, pc2)) + clim2 = min (pc2, max (oc2 - pideltax, pc1)) + llim1 = max (pl1, min (ol1 - pideltay, pl2)) + llim2 = min (pl2, max (ol2 - pideltay, pl1)) + buf = imgs2r (im, clim1, clim2, llim1, llim2) + pmedian = amedr (Memr[buf], (clim2 - clim1 + 1) * (llim2 - + llim1 + 1)) + + clim1 = max (c1, min (oc1 - ideltax, c2)) + clim2 = min (c2, max (oc2 - ideltax, c1)) + llim1 = max (l1, min (ol1 - ideltay, l2)) + llim2 = min (l2, max (ol2 - ideltay, l1)) + buf = imgs2r (im, clim1, clim2, llim1, llim2) + median = amedr (Memr[buf], (clim2 - clim1 + 1) * (llim2 - + llim1 + 1)) + + dif = dif + median - pmedian + if (! IS_INDEFR (deltai[num])) + deltai[num] = deltai[num] - dif + } + } +end + + +# IR_NMATCH -- Procedure to match images in the other direction. + +procedure ir_nmatch (ir, im, ic1, ic2, il1, il2, deltax, deltay, deltai) + +pointer ir # pointer to the ir structure +pointer im # pointer to the input image +int ic1[ARB] # array of beginning columns +int ic2[ARB] # array of ending columns +int il1[ARB] # array of beginning lines +int il2[ARB] # array of ending lines +real deltax[ARB] # array of x shifts +real deltay[ARB] # array of y shifts +real deltai[ARB] # array of intensity shifts + +int num, nrasters, fac, nimages, count +int pc1, pc2, pl1, pl2, c1, c2, l1, l2 +int pideltax, pideltay, ideltax, ideltay +int oc1, oc2, ol1, ol2, clim1, clim2, llim1, llim2 +pointer buf +real pmedian, median, pdif, dif, tdif + +int ir_overlap() +pointer imgs2r() +real amedr() + +begin + # Compute the do loop parameters. + nimages = IR_NXSUB(ir) * IR_NYSUB(ir) + if (IR_ORDER(ir) == IR_ROW) + nrasters = IR_NXSUB(ir) + else + nrasters = IR_NYSUB(ir) + fac = 2 * nrasters + + # Loop over the subrasters to be matched. + num = 1 + count = 1 + repeat { + + # Get the position and shift for the first subraster. + if (num <= nrasters) { + + pideltax = nint (deltax[num]) + pideltay = nint (deltay[num]) + pc1 = ic1[num] + pc2 = ic2[num] + pl1 = il1[num] + pl2 = il2[num] + if (IS_INDEFR(deltai[num])) + pdif = 0.0 + else + pdif = deltai[num] + tdif = 0.0 + if (IR_RASTER(ir) == YES) { + num = fac - num + 1 + fac = fac + fac + } else + num = num + nrasters + + # Get the the position and shift for the next. + ideltax = nint (deltax[num]) + ideltay = nint (deltay[num]) + c1 = ic1[num] + c2 = ic2[num] + l1 = il1[num] + l2 = il2[num] + if (IS_INDEFR(deltai[num])) + dif = 0.0 + else + dif = deltai[num] + + } else { + + # Reset the coordinates of the previous subraster. + pc1 = c1 + pc2 = c2 + pl1 = l1 + pl2 = l2 + pideltax = ideltax + pideltay = ideltay + pdif = dif + + # Get the positions and shifts of the subraster to be adjusted. + ideltax = nint (deltax[num]) + ideltay = nint (deltay[num]) + c1 = ic1[num] + c2 = ic2[num] + l1 = il1[num] + l2 = il2[num] + if (IS_INDEFR(deltai[num])) + dif = 0.0 + else + dif = deltai[num] + + } + + # Compute the overlap region. + if (ir_overlap (pc1 + pideltax, pc2 + pideltax, pl1 + pideltay, + pl2 + pideltay, c1 + ideltax, c2 + ideltax, l1 + ideltay, + l2 + ideltay, oc1, oc2, ol1, ol2) == YES) { + + clim1 = max (pc1, oc1 - pideltax) + clim2 = min (pc2, oc2 - pideltax) + llim1 = max (pl1, ol1 - pideltay) + llim2 = min (pl2, ol2 - pideltay) + buf = imgs2r (im, clim1, clim2, llim1, llim2) + pmedian = amedr (Memr[buf], (clim2 - clim1 + 1) * (llim2 - + llim1 + 1)) + + clim1 = max (c1, oc1 - ideltax) + clim2 = min (c2, oc2 - ideltax) + llim1 = max (l1, ol1 - ideltay) + llim2 = min (l2, ol2 - ideltay) + buf = imgs2r (im, clim1, clim2, llim1, llim2) + median = amedr (Memr[buf], (clim2 - clim1 + 1) * (llim2 - + llim1 + 1)) + + tdif = tdif + median + dif - pmedian - pdif + if (! IS_INDEFR (deltai[num])) + deltai[num] = deltai[num] - tdif + } + + if (IR_RASTER(ir) == YES) { + num = fac - num + 1 + fac = fac + fac + } else + num = num + nrasters + if (num > nimages) { + count = count + 1 + num = count + fac = 2 * nrasters + } + + } until (count > nrasters) +end diff --git a/noao/nproto/ir/irmedr.x b/noao/nproto/ir/irmedr.x new file mode 100644 index 00000000..436a3673 --- /dev/null +++ b/noao/nproto/ir/irmedr.x @@ -0,0 +1,35 @@ +# IRMEDR -- Procedure to compute the median of an array in which some +# elements are undefined. + +real procedure irmedr (a, aindex, npts) + +real a[ARB] # input array +int aindex[ARB] # definition array +int npts # number of points + +int i, n +pointer sp, b +real med +real asokr() + +begin + call smark (sp) + call salloc (b, npts, TY_REAL) + + n = 0 + do i = 1, npts { + if (aindex[i] > 0) { + Memr[b+n] = a[i] + n = n + 1 + } + } + + if (n == 0) + med = INDEFR + else + med = asokr (Memr[b], n, (n + 1) / 2) + + call sfree (sp) + + return (med) +end diff --git a/noao/nproto/ir/iroverlap.x b/noao/nproto/ir/iroverlap.x new file mode 100644 index 00000000..822e6e99 --- /dev/null +++ b/noao/nproto/ir/iroverlap.x @@ -0,0 +1,40 @@ +# IR_OVERLAP -- Procedure to compute the overlap between two rectangles. + +int procedure ir_overlap (pc1out, pc2out, pl1out, pl2out, c1out, c2out, + l1out, l2out, oc1out, oc2out, ol1out, ol2out) + +int pc1out, pc2out # previous subraster column limits +int pl1out, pl2out # previous subraster line limits +int c1out, c2out # current subraster column limits +int l1out, l2out # current subraster line limits +int oc1out, oc2out # overlap column limits +int ol1out, ol2out # overlap line limits + +begin + # Check for the case where no intersection is present. + if (c1out > pc2out || c2out < pc1out || l1out > pl2out || + l2out < pl1out) + return (NO) + + # Compute the column overlap limits. + if (pc1out <= c1out) + oc1out = c1out + else + oc1out = pc1out + if (pc2out <= c2out) + oc2out = pc2out + else + oc2out = c2out + + # Compute the line overlap limits. + if (pl1out <= l1out) + ol1out = l1out + else + ol1out = pl1out + if (pl2out <= l2out) + ol2out = pl2out + else + ol2out = l2out + + return (YES) +end diff --git a/noao/nproto/ir/irqsort.x b/noao/nproto/ir/irqsort.x new file mode 100644 index 00000000..3c8b710c --- /dev/null +++ b/noao/nproto/ir/irqsort.x @@ -0,0 +1,215 @@ +define LOGPTR 20 # log2(maxpts) (1e6) + +# IR_QSORT -- Vector Quicksort. In this version the index array is +# sorted. + +procedure ir_qsortr (data, a, b, npix) + +real data[ARB] # data array +int a[ARB], b[ARB] # index array +int npix # number of pixels + +int i, j, lv[LOGPTR], p, uv[LOGPTR], temp +real pivot + +begin + # Initialize the indices for an inplace sort. + do i = 1, npix + a[i] = i + call amovi (a, b, npix) + + p = 1 + lv[1] = 1 + uv[1] = npix + while (p > 0) { + + # If only one elem in subset pop stack otherwise pivot line. + if (lv[p] >= uv[p]) + p = p - 1 + else { + i = lv[p] - 1 + j = uv[p] + pivot = data[b[j]] + + while (i < j) { + for (i=i+1; data[b[i]] < pivot; i=i+1) + ; + for (j=j-1; j > i; j=j-1) + if (data[b[j]] <= pivot) + break + if (i < j) { # out of order pair + temp = b[j] # interchange elements + b[j] = b[i] + b[i] = temp + } + } + + j = uv[p] # move pivot to position i + temp = b[j] # interchange elements + b[j] = b[i] + b[i] = temp + + if (i-lv[p] < uv[p] - i) { # stack so shorter done first + lv[p+1] = lv[p] + uv[p+1] = i - 1 + lv[p] = i + 1 + } else { + lv[p+1] = i + 1 + uv[p+1] = uv[p] + uv[p] = i - 1 + } + + p = p + 1 # push onto stack + } + } +end + + +# IR_QSORT -- Vector Quicksort. In this version the index array is +# sorted. + +procedure ir_qsorti (data, a, b, npix) + +int data[ARB] # data array +int a[ARB], b[ARB] # index array +int npix # number of pixels + +int i, j, lv[LOGPTR], p, uv[LOGPTR], temp +int pivot + +begin + # Initialize the indices for an inplace sort. + do i = 1, npix + a[i] = i + call amovi (a, b, npix) + + p = 1 + lv[1] = 1 + uv[1] = npix + while (p > 0) { + + # If only one elem in subset pop stack otherwise pivot line. + if (lv[p] >= uv[p]) + p = p - 1 + else { + i = lv[p] - 1 + j = uv[p] + pivot = data[b[j]] + + while (i < j) { + for (i=i+1; data[b[i]] < pivot; i=i+1) + ; + for (j=j-1; j > i; j=j-1) + if (data[b[j]] <= pivot) + break + if (i < j) { # out of order pair + temp = b[j] # interchange elements + b[j] = b[i] + b[i] = temp + } + } + + j = uv[p] # move pivot to position i + temp = b[j] # interchange elements + b[j] = b[i] + b[i] = temp + + if (i-lv[p] < uv[p] - i) { # stack so shorter done first + lv[p+1] = lv[p] + uv[p+1] = i - 1 + lv[p] = i + 1 + } else { + lv[p+1] = i + 1 + uv[p+1] = uv[p] + uv[p] = i - 1 + } + + p = p + 1 # push onto stack + } + } +end + + +# IR_QSORT -- Vector Quicksort. In this version the index array is +# sorted. + +procedure ir_qsortb (data, a, b, npix) + +bool data[ARB] # data array +int a[ARB], b[ARB] # index array +int npix # number of pixels + +int i, j, lv[LOGPTR], p, uv[LOGPTR], temp +bool pivot +int ir_compareb() + +begin + # Initialize the indices for an inplace sort. + do i = 1, npix + a[i] = i + call amovi (a, b, npix) + + p = 1 + lv[1] = 1 + uv[1] = npix + while (p > 0) { + + # If only one elem in subset pop stack otherwise pivot line. + if (lv[p] >= uv[p]) + p = p - 1 + else { + i = lv[p] - 1 + j = uv[p] + pivot = data[b[j]] + + while (i < j) { + #for (i=i+1; data[b[i]] != pivot; i=i+1) + for (i=i+1; ir_compareb (data[b[i]], pivot) < 0; i=i+1) + ; + for (j=j-1; j > i; j=j-1) + #if (data[b[j]] != pivot) + if (ir_compareb (data[b[j]], pivot) <= 0) + break + if (i < j) { # out of order pair + temp = b[j] # interchange elements + b[j] = b[i] + b[i] = temp + } + } + + j = uv[p] # move pivot to position i + temp = b[j] # interchange elements + b[j] = b[i] + b[i] = temp + + if (i-lv[p] < uv[p] - i) { # stack so shorter done first + lv[p+1] = lv[p] + uv[p+1] = i - 1 + lv[p] = i + 1 + } else { + lv[p+1] = i + 1 + uv[p+1] = uv[p] + uv[p] = i - 1 + } + + p = p + 1 # push onto stack + } + } +end + + +# IR_COMPAREB -- Compare to booleans for the sort routine. + +int procedure ir_compareb (a, b) + +bool a # first boolean +bool b # second boolean + +begin + if (! a && b) + return (-1) + else if (a && ! b) + return (1) + else + return (0) +end diff --git a/noao/nproto/ir/irtools.x b/noao/nproto/ir/irtools.x new file mode 100644 index 00000000..50367440 --- /dev/null +++ b/noao/nproto/ir/irtools.x @@ -0,0 +1,147 @@ +include <imhdr.h> +include "iralign.h" + +# IR_INIT -- Initialize the ir structure + +procedure ir_init (ir) + +pointer ir # pointer to the ir strucuture + +begin + call malloc (ir, LEN_IRSTRUCT, TY_STRUCT) + + IR_IC1(ir) = NULL + IR_IC2(ir) = NULL + IR_IL1(ir) = NULL + IR_IL2(ir) = NULL + IR_OC1(ir) = NULL + IR_OC2(ir) = NULL + IR_OL1(ir) = NULL + IR_OL2(ir) = NULL + IR_DELTAX(ir) = NULL + IR_DELTAY(ir) = NULL + IR_DELTAI(ir) = NULL + IR_XRSHIFTS(ir) = NULL + IR_YRSHIFTS(ir) = NULL + IR_NRSHIFTS(ir) = NULL + IR_XCSHIFTS(ir) = NULL + IR_YCSHIFTS(ir) = NULL + IR_NCSHIFTS(ir) = NULL +end + + +# IR_PARAMS -- Get the ir structure parameters + +procedure ir_params (ir, im, outim) + +pointer ir # pointer to the ir strucuture +pointer im # pointer to the input image +pointer outim # pointer to the output image + +int nimcols, nimlines +real rval +int clgeti() +real clgetr() + +begin + IR_NXRSUB(ir) = clgeti ("nxrsub") + if (IS_INDEFI(IR_NXRSUB(ir)) || IR_NXRSUB(ir) < 1 || IR_NXRSUB(ir) > + IR_NXSUB(ir)) + IR_NXRSUB(ir) = (IR_NXSUB(ir) + 1) / 2 + IR_NYRSUB(ir) = clgeti ("nyrsub") + if (IS_INDEFI(IR_NYRSUB(ir)) || IR_NYRSUB(ir) < 1 || IR_NYRSUB(ir) > + IR_NYSUB(ir)) + IR_NYRSUB(ir) = (IR_NYSUB(ir) + 1) / 2 + + IR_XREF(ir) = clgeti ("xref") + IR_YREF(ir) = clgeti ("yref") + + nimcols = clgeti ("nimcols") + if (! IS_INDEFI(nimcols) && nimcols > 0 && nimcols >= IM_LEN(im,1)) + IM_LEN(outim,1) = nimcols + nimlines = clgeti ("nimlines") + if (! IS_INDEFI(nimlines) && nimlines > 0 && nimlines >= IM_LEN(im,2)) + IM_LEN(outim,2) = nimlines + + rval = clgetr ("oval") + if (! IS_INDEFR(rval)) + IR_OVAL(ir) = rval +end + + +# IR_ARRAYS -- Setup the ir structure arrays. + +procedure ir_arrays (ir, nimages) + +pointer ir # pointer to the ir strucuture +int nimages # number of images to be mosaiced + +begin + call malloc (IR_IC1(ir), nimages, TY_INT) + call malloc (IR_IC2(ir), nimages, TY_INT) + call malloc (IR_IL1(ir), nimages, TY_INT) + call malloc (IR_IL2(ir), nimages, TY_INT) + call malloc (IR_OC1(ir), nimages, TY_INT) + call malloc (IR_OC2(ir), nimages, TY_INT) + call malloc (IR_OL1(ir), nimages, TY_INT) + call malloc (IR_OL2(ir), nimages, TY_INT) + call malloc (IR_DELTAX(ir), nimages, TY_REAL) + call malloc (IR_DELTAY(ir), nimages, TY_REAL) + call malloc (IR_DELTAI(ir), nimages, TY_REAL) + + call malloc (IR_XRSHIFTS(ir), nimages, TY_REAL) + call malloc (IR_YRSHIFTS(ir), nimages, TY_REAL) + call malloc (IR_NRSHIFTS(ir), nimages, TY_INT) + call malloc (IR_XCSHIFTS(ir), nimages, TY_REAL) + call malloc (IR_YCSHIFTS(ir), nimages, TY_REAL) + call malloc (IR_NCSHIFTS(ir), nimages, TY_INT) +end + + +# IR_FREE -- Free the ir strucuture. + +procedure ir_free (ir) + +pointer ir # pointer to the ir strucuture + +begin + if (IR_IC1(ir) != NULL) + call mfree (IR_IC1(ir), TY_INT) + if (IR_IC2(ir) != NULL) + call mfree (IR_IC2(ir), TY_INT) + if (IR_IL1(ir) != NULL) + call mfree (IR_IL1(ir), TY_INT) + if (IR_IL2(ir) != NULL) + call mfree (IR_IL2(ir), TY_INT) + if (IR_OC1(ir) != NULL) + call mfree (IR_OC1(ir), TY_INT) + if (IR_OC2(ir) != NULL) + call mfree (IR_OC2(ir), TY_INT) + if (IR_OL1(ir) != NULL) + call mfree (IR_OL1(ir), TY_INT) + if (IR_OL2(ir) != NULL) + call mfree (IR_OL2(ir), TY_INT) + + if (IR_DELTAX(ir) != NULL) + call mfree (IR_DELTAX(ir), TY_REAL) + if (IR_DELTAY(ir) != NULL) + call mfree (IR_DELTAY(ir), TY_REAL) + if (IR_DELTAI(ir) != NULL) + call mfree (IR_DELTAI(ir), TY_REAL) + + if (IR_XRSHIFTS(ir) != NULL) + call mfree (IR_XRSHIFTS(ir), TY_REAL) + if (IR_YRSHIFTS(ir) != NULL) + call mfree (IR_YRSHIFTS(ir), TY_REAL) + if (IR_NRSHIFTS(ir) != NULL) + call mfree (IR_NRSHIFTS(ir), TY_INT) + if (IR_XCSHIFTS(ir) != NULL) + call mfree (IR_XCSHIFTS(ir), TY_REAL) + if (IR_YCSHIFTS(ir) != NULL) + call mfree (IR_YCSHIFTS(ir), TY_REAL) + if (IR_NCSHIFTS(ir) != NULL) + call mfree (IR_NCSHIFTS(ir), TY_INT) + + if (ir != NULL) + call mfree (ir, TY_STRUCT) +end diff --git a/noao/nproto/ir/mkpkg b/noao/nproto/ir/mkpkg new file mode 100644 index 00000000..7297fa37 --- /dev/null +++ b/noao/nproto/ir/mkpkg @@ -0,0 +1,24 @@ +$checkout libpkg.a ../ +$update libpkg.a +$checkin libpkg.a ../ +$exit + +libpkg.a: + iralign.x "iralign.h" <imhdr.h> + irdbio.x "iralign.h" + iriinit.x + irindices.x "iralign.h" + irimisec.x <ctype.h> + irimzero.x + irmatch1d.x "iralign.h" <imhdr.h> <pkg/dttext.h> + irmatch2d.x "iralign.h" <imhdr.h> + irmedr.x + iroverlap.x + irqsort.x + irlinks.x "iralign.h" + irtools.x "iralign.h" <imhdr.h> + t_iralign.x "iralign.h" <imhdr.h> <fset.h> + t_irmatch1d.x "iralign.h" <imhdr.h> <fset.h> + t_irmatch2d.x "iralign.h" <imhdr.h> <fset.h> + t_irmosaic.x "iralign.h" <imhdr.h> <fset.h> + ; diff --git a/noao/nproto/ir/t_iralign.x b/noao/nproto/ir/t_iralign.x new file mode 100644 index 00000000..03f97b32 --- /dev/null +++ b/noao/nproto/ir/t_iralign.x @@ -0,0 +1,134 @@ +include <imhdr.h> +include <fset.h> +include "iralign.h" + +# T_IRALIGN -- Align the individual subraster elements in the input image. +# In order to run this program the user should have created the output image +# and the database file with the IRMOSAIC task. In addition the user should +# supply a coordinate list consisting of pairs of coordinates of identical +# objects or features in two adjacent subrasters. + +procedure t_iralign () + +int cl, nimages, interp, align, verbose +pointer ir, sp, inimage, outimage, database, coords, trimlimits, str +pointer im, outim, dt + +bool clgetb() +int open(), clgwrd(), btoi() +int ir_links(), ir_clinks(), ir_flinks() +pointer immap(), dtmap() +real clgetr() + +begin + # Allocate sapce for the ir strucuture. + call ir_init (ir) + + # Set the standard output to flush on a new line. + call fseti (STDOUT, F_FLUSHNL, YES) + + # Allocate temporary working space. + call smark (sp) + call salloc (inimage, SZ_FNAME, TY_CHAR) + call salloc (outimage, SZ_FNAME, TY_CHAR) + call salloc (coords, SZ_FNAME, TY_CHAR) + call salloc (database, SZ_FNAME, TY_CHAR) + call salloc (trimlimits, SZ_FNAME, TY_CHAR) + call salloc (str, SZ_LINE, TY_CHAR) + + # Get the input and output images and the coordinate list. + call clgstr ("input", Memc[inimage], SZ_FNAME) + call clgstr ("output", Memc[outimage], SZ_FNAME) + call clgstr ("database", Memc[database], SZ_FNAME) + call clgstr ("coords", Memc[coords], SZ_FNAME) + align = clgwrd ("alignment", Memc[str], SZ_LINE, ",coords,shifts,file,") + call clgstr ("trimlimits", Memc[trimlimits], SZ_FNAME) + + # Open the images and files. + im = immap (Memc[inimage], READ_ONLY, 0) + outim = immap (Memc[outimage], NEW_COPY, im) + dt = dtmap (Memc[database], READ_ONLY) + + # Get the data base parameters. + call ir_dtrparams (dt, Memc[inimage], ir) + + # Get the rest of the parameters. + call ir_params (ir, im, outim) + interp = clgwrd ("interpolant", Memc[str], SZ_LINE, + ",nearest,linear,poly3,poly5,spline3,") + verbose = btoi (clgetb ("verbose")) + + # Allocate array space. + nimages = IR_NXSUB(ir) * IR_NYSUB(ir) + call ir_arrays (ir, nimages) + + # Compute the shifts for each subraster. + switch (align) { + case IR_COORDS: + cl = open (Memc[coords], READ_ONLY, TEXT_FILE) + if (ir_links (cl, Memr[IR_XRSHIFTS(ir)], Memr[IR_YRSHIFTS(ir)], + Memr[IR_XCSHIFTS(ir)], Memr[IR_YCSHIFTS(ir)], + Memi[IR_NRSHIFTS(ir)], Memi[IR_NCSHIFTS(ir)], + IR_NCOLS(ir), IR_NROWS(ir), IR_NXRSUB(ir), IR_NYRSUB(ir), + IR_NXSUB(ir), IR_NYSUB(ir), IR_NXOVERLAP(ir), IR_NYOVERLAP(ir), + IR_ORDER(ir)) > 0) { + call ir_shifts (ir, im, outim, Memr[IR_XRSHIFTS(ir)], + Memr[IR_YRSHIFTS(ir)], Memr[IR_XCSHIFTS(ir)], + Memr[IR_YCSHIFTS(ir)], Memi[IR_IC1(ir)], + Memi[IR_IC2(ir)], Memi[IR_IL1(ir)], Memi[IR_IL2(ir)], + Memi[IR_OC1(ir)], Memi[IR_OC2(ir)], Memi[IR_OL1(ir)], + Memi[IR_OL2(ir)], Memr[IR_DELTAX(ir)], Memr[IR_DELTAY(ir)]) + } else + call error (0, "There are no legal shifts in the coords file.") + call close (cl) + + case IR_SHIFTS: + if (ir_clinks (Memr[IR_XRSHIFTS(ir)], Memr[IR_YRSHIFTS(ir)], + Memr[IR_XCSHIFTS(ir)], Memr[IR_YCSHIFTS(Ir)], IR_NXRSUB(ir), + IR_NYRSUB(ir), IR_NXSUB(ir), IR_NYSUB(ir), clgetr ("xshift"), + clgetr ("yshift")) > 0) { + call ir_shifts (ir, im, outim, Memr[IR_XRSHIFTS(ir)], + Memr[IR_YRSHIFTS(ir)], Memr[IR_XCSHIFTS(ir)], + Memr[IR_YCSHIFTS(ir)], Memi[IR_IC1(ir)], + Memi[IR_IC2(ir)], Memi[IR_IL1(ir)], Memi[IR_IL2(ir)], + Memi[IR_OC1(ir)], Memi[IR_OC2(ir)], Memi[IR_OL1(ir)], + Memi[IR_OL2(ir)], Memr[IR_DELTAX(ir)], Memr[IR_DELTAY(ir)]) + } else + call error (0, "There are no legal shifts in the coords file.") + + case IR_FILE: + + cl = open (Memc[coords], READ_ONLY, TEXT_FILE) + if (ir_flinks (cl, Memr[IR_DELTAX(ir)], Memr[IR_DELTAY(ir)], + Memr[IR_DELTAI(ir)], nimages) >= nimages) { + call ir_fshifts (ir, im, outim, Memr[IR_DELTAX(ir)], + Memr[IR_DELTAY(ir)], Memi[IR_IC1(ir)], Memi[IR_IC2(ir)], + Memi[IR_IL1(ir)], Memi[IR_IL2(ir)], Memi[IR_OC1(ir)], + Memi[IR_OC2(ir)], Memi[IR_OL1(ir)], Memi[IR_OL2(ir)]) + } else + call error (0, "There are fewer shifts than subraster.") + call close (cl) + + default: + call error (0, "T_IRALIGN: Undefined alignment algorithm") + } + + # Fill the output image with the undefined value. + call ir_imzero (outim, int (IM_LEN(outim,1)), int (IM_LEN(outim,2)), + IR_OVAL(ir)) + + # Shift all the subrasters. + call amovkr (0.0, Memr[IR_DELTAI(ir)], nimages) + call ir_subalign (ir, im, outim, Memc[trimlimits], Memi[IR_IC1(ir)], + Memi[IR_IC2(ir)], Memi[IR_IL1(ir)], Memi[IR_IL2(ir)], + Memi[IR_OC1(ir)], Memi[IR_OC2(ir)], Memi[IR_OL1(ir)], + Memi[IR_OL2(ir)], Memr[IR_DELTAX(ir)], Memr[IR_DELTAY(ir)], + Memr[IR_DELTAI(ir)], NO, interp, verbose) + + # Close up files + call imunmap (im) + call imunmap (outim) + call dtunmap (dt) + call sfree (sp) + call ir_free (ir) +end diff --git a/noao/nproto/ir/t_irmatch1d.x b/noao/nproto/ir/t_irmatch1d.x new file mode 100644 index 00000000..05e89e0a --- /dev/null +++ b/noao/nproto/ir/t_irmatch1d.x @@ -0,0 +1,159 @@ +include <imhdr.h> +include <fset.h> +include "iralign.h" + +# T_IRMATCHD1 -- Align the individual subraster elements in the input image. +# In order to run this program the user should have created the output image +# and the database file with the IRMOSAIC task. In addition the user should +# supply a coordinate list consisting of pairs of coordinates of identical +# objects or features in two adjacent subrasters. + +procedure t_irmatchd1 () + +int cl, interp, align, verbose, nmatch, nimages +pointer sp, inimage, outimage, database, coords, matchlist, trimlimits, ranges +pointer str, ir, im, outim, dt + +bool clgetb() +int open(), clgwrd(), btoi(), ir_links(), ir_clinks, ir_flinks() +int decode_ranges() +pointer immap(), dtmap() +real clgetr() + +begin + # Allocate space for the ir strucuture. + call ir_init (ir) + + # Set the standard output to flush on a new line. + call fseti (STDOUT, F_FLUSHNL, YES) + + # Allocate temporary working space. + call smark (sp) + call salloc (inimage, SZ_FNAME, TY_CHAR) + call salloc (outimage, SZ_FNAME, TY_CHAR) + call salloc (coords, SZ_FNAME, TY_CHAR) + call salloc (database, SZ_FNAME, TY_CHAR) + call salloc (matchlist, SZ_LINE, TY_CHAR) + call salloc (trimlimits, SZ_FNAME, TY_CHAR) + call salloc (ranges, 3 * MAX_NRANGES + 1, TY_INT) + call salloc (str, SZ_LINE, TY_CHAR) + + # Get the input and output images and the coordinate list. + call clgstr ("input", Memc[inimage], SZ_FNAME) + call clgstr ("output", Memc[outimage], SZ_FNAME) + call clgstr ("database", Memc[database], SZ_FNAME) + call clgstr ("coords", Memc[coords], SZ_FNAME) + align = clgwrd ("alignment", Memc[str], SZ_LINE, ",coords,shifts,file,") + call clgstr ("match", Memc[matchlist], SZ_LINE) + call clgstr ("trimlimits", Memc[trimlimits], SZ_LINE) + + # Open the images and files. + im = immap (Memc[inimage], READ_ONLY, 0) + outim = immap (Memc[outimage], NEW_COPY, im) + dt = dtmap (Memc[database], READ_ONLY) + + # Get the data base parameters. + call ir_dtrparams (dt, Memc[inimage], ir) + + # Get the remaining parameters. + call ir_params (ir, im, outim) + + interp = clgwrd ("interpolant", Memc[str], SZ_LINE, + ",nearest,linear,poly3,poly5,spline3,") + verbose = btoi (clgetb ("verbose")) + + # Decode the list of input images to be intensity matched. + nimages = IR_NXSUB(ir) * IR_NYSUB(ir) + if (Memc[matchlist] == EOS) { + Memi[ranges] = NULL + } else if (Memc[matchlist] == '*') { + Memi[ranges] = 1 + Memi[ranges+1] = nimages + Memi[ranges+2] = 1 + Memi[ranges+3] = NULL + } else if (decode_ranges (Memc[matchlist], Memi[ranges], MAX_NRANGES, + nmatch) == ERR) { + call error (0, + "Cannot decode list of rasters to be intensity matched.") + + } + + # Allocate space for the ir arrays. + call ir_arrays (ir, nimages) + + # Compute the shifts for each subraster. + switch (align) { + case IR_COORDS: + cl = open (Memc[coords], READ_ONLY, TEXT_FILE) + if (ir_links (cl, Memr[IR_XRSHIFTS(ir)], Memr[IR_YRSHIFTS(ir)], + Memr[IR_XCSHIFTS(ir)], Memr[IR_YCSHIFTS(ir)], + Memi[IR_NRSHIFTS(ir)], Memi[IR_NCSHIFTS(ir)], + IR_NCOLS(ir), IR_NROWS(ir), IR_NXRSUB(ir), IR_NYRSUB(ir), + IR_NXSUB(ir), IR_NYSUB(ir), IR_NXOVERLAP(ir), IR_NYOVERLAP(ir), + IR_ORDER(ir)) > 0) { + call ir_shifts (ir, im, outim, Memr[IR_XRSHIFTS(ir)], + Memr[IR_YRSHIFTS(ir)], Memr[IR_XCSHIFTS(ir)], + Memr[IR_YCSHIFTS(ir)], Memi[IR_IC1(ir)], Memi[IR_IC2(ir)], + Memi[IR_IL1(ir)], Memi[IR_IL2(ir)], Memi[IR_OC1(ir)], + Memi[IR_OC2(ir)], Memi[IR_OL1(ir)], Memi[IR_OL2(ir)], + Memr[IR_DELTAX(ir)], Memr[IR_DELTAY(ir)]) + call ir_m1match (ir, im, Memi[ranges], Memi[IR_IC1(ir)], + Memi[IR_IC2(ir)], Memi[IR_IL1(ir)], Memi[IR_IL2(ir)], + Memr[IR_DELTAX(ir)], Memr[IR_DELTAY(ir)], + Memr[IR_DELTAI(ir)]) + } else + call error (0, "There are no legal shifts in the coords file.") + call close (cl) + + case IR_SHIFTS: + if (ir_clinks (Memr[IR_XRSHIFTS(ir)], Memr[IR_YRSHIFTS(ir)], + Memr[IR_XCSHIFTS(ir)], Memr[IR_YCSHIFTS(ir)], IR_NXRSUB(ir), + IR_NYRSUB(ir), IR_NXSUB(ir), IR_NYSUB(ir), clgetr ("xshift"), + clgetr ("yshift")) > 0) { + call ir_shifts (ir, im, outim, Memr[IR_XRSHIFTS(ir)], + Memr[IR_YRSHIFTS(ir)], Memr[IR_XCSHIFTS(ir)], + Memr[IR_YCSHIFTS(ir)], Memi[IR_IC1(ir)], Memi[IR_IC2(ir)], + Memi[IR_IL1(ir)], Memi[IR_IL2(ir)], Memi[IR_OC1(ir)], + Memi[IR_OC2(ir)], Memi[IR_OL1(ir)], Memi[IR_OL2(ir)], + Memr[IR_DELTAX(ir)], Memr[IR_DELTAY(ir)]) + call ir_m1match (ir, im, Memi[ranges], Memi[IR_IC1(ir)], + Memi[IR_IC2(ir)], Memi[IR_IL1(ir)], Memi[IR_IL2(ir)], + Memr[IR_DELTAX(ir)], Memr[IR_DELTAY(ir)], + Memr[IR_DELTAI(ir)]) + } else + call error (0, "There are no legal shifts in the coords file.") + + case IR_FILE: + cl = open (Memc[coords], READ_ONLY, TEXT_FILE) + if (ir_flinks (cl, Memr[IR_DELTAX(ir)], Memr[IR_DELTAY(ir)], + Memr[IR_DELTAI(ir)], nimages) >= nimages) { + call ir_fshifts (ir, im, outim, Memr[IR_DELTAX(ir)], + Memr[IR_DELTAY(ir)], Memi[IR_IC1(ir)], Memi[IR_IC2(ir)], + Memi[IR_IL1(ir)], Memi[IR_IL2(ir)], Memi[IR_OC1(ir)], + Memi[IR_OC2(ir)], Memi[IR_OL1(ir)], Memi[IR_OL2(ir)]) + } else + call error (0, "There are fewer shifts than subrasters.") + call close (cl) + + default: + call error (0, "T_IRALIGN: Undefined alignment algorithm") + } + + # Fill the output image with undefined values. + call ir_imzero (outim, int (IM_LEN(outim,1)), int (IM_LEN(outim,2)), + IR_OVAL(ir)) + + # Shift all the subrasters. + call ir_subalign (ir, im, outim, Memc[trimlimits], Memi[IR_IC1(ir)], + Memi[IR_IC2(ir)], Memi[IR_IL1(ir)], Memi[IR_IL2(ir)], + Memi[IR_OC1(ir)], Memi[IR_OC2(ir)], Memi[IR_OL1(ir)], + Memi[IR_OL2(ir)], Memr[IR_DELTAX(ir)], Memr[IR_DELTAY(ir)], + Memr[IR_DELTAI(ir)], YES, interp, verbose) + + # Close up files + call imunmap (im) + call imunmap (outim) + call dtunmap (dt) + call sfree (sp) + call ir_free (ir) +end diff --git a/noao/nproto/ir/t_irmatch2d.x b/noao/nproto/ir/t_irmatch2d.x new file mode 100644 index 00000000..38c6feb3 --- /dev/null +++ b/noao/nproto/ir/t_irmatch2d.x @@ -0,0 +1,159 @@ +include <imhdr.h> +include <fset.h> +include "iralign.h" + +# T_IRMATCHD2 -- Align the individual subraster elements in the input image. +# In order to run this program the user should have created the output image +# and the database file with the IRMOSAIC task. In addition the user should +# supply a coordinate list consisting of pairs of coordinates of identical +# objects or features in two adjacent subrasters. + +procedure t_irmatchd2 () + +int cl, interp, align, verbose, nimages, nmatch +pointer sp, inimage, outimage, database, coords, matchlist, trimlimits, ranges +pointer str, ir, im, outim, dt + +bool clgetb() +int open(), clgwrd(), btoi(), ir_links(), ir_clinks(), ir_flinks() +int decode_ranges() +pointer immap(), dtmap() +real clgetr() + +begin + # Allocate space for the ir strucuture. + call ir_init (ir) + + # Set the standard output to flush on a new line. + call fseti (STDOUT, F_FLUSHNL, YES) + + # Allocate temporary working space. + call smark (sp) + call salloc (inimage, SZ_FNAME, TY_CHAR) + call salloc (outimage, SZ_FNAME, TY_CHAR) + call salloc (coords, SZ_FNAME, TY_CHAR) + call salloc (database, SZ_FNAME, TY_CHAR) + call salloc (matchlist, SZ_LINE, TY_CHAR) + call salloc (trimlimits, SZ_FNAME, TY_CHAR) + call salloc (ranges, 3 * MAX_NRANGES + 1, TY_INT) + call salloc (str, SZ_LINE, TY_CHAR) + + # Get the input and output images and the coordinate list. + call clgstr ("input", Memc[inimage], SZ_FNAME) + call clgstr ("output", Memc[outimage], SZ_FNAME) + call clgstr ("database", Memc[database], SZ_FNAME) + call clgstr ("coords", Memc[coords], SZ_FNAME) + align = clgwrd ("alignment", Memc[str], SZ_LINE, ",coords,shifts,file,") + call clgstr ("match", Memc[matchlist], SZ_LINE) + call clgstr ("trimlimits", Memc[trimlimits], SZ_FNAME) + + # Open the images and files. + im = immap (Memc[inimage], READ_ONLY, 0) + outim = immap (Memc[outimage], NEW_COPY, im) + dt = dtmap (Memc[database], READ_ONLY) + + # Get the data base parameters. + call ir_dtrparams (dt, Memc[inimage], ir) + + call ir_params (ir, im, outim) + + interp = clgwrd ("interpolant", Memc[str], SZ_LINE, + ",nearest,linear,poly3,poly5,spline3,") + verbose = btoi (clgetb ("verbose")) + + # Decode the list of input images to be intensity matched. + nimages = IR_NXSUB(ir) * IR_NYSUB(ir) + if (Memc[matchlist] == EOS) { + Memi[ranges] = NULL + } else if (Memc[matchlist] == '*') { + Memi[ranges] = 1 + Memi[ranges+1] = nimages + Memi[ranges+2] = 1 + Memi[ranges+3] = NULL + } else if (decode_ranges (Memc[matchlist], Memi[ranges], MAX_NRANGES, + nmatch) == ERR) { + call error (0, + "Cannot decode list of rasters to be intensity matched.") + + } + + # Allocate working space. + call ir_arrays (ir, nimages) + + # Compute the shifts for each subraster. + switch (align) { + case IR_COORDS: + cl = open (Memc[coords], READ_ONLY, TEXT_FILE) + if (ir_links (cl, Memr[IR_XRSHIFTS(ir)], Memr[IR_YRSHIFTS(ir)], + Memr[IR_XCSHIFTS(ir)], Memr[IR_YCSHIFTS(ir)], + Memi[IR_NRSHIFTS(ir)], Memi[IR_NCSHIFTS(ir)], + IR_NCOLS(ir), IR_NROWS(ir), IR_NXRSUB(ir), IR_NYRSUB(ir), + IR_NXSUB(ir), IR_NYSUB(ir), IR_NXOVERLAP(ir), IR_NYOVERLAP(ir), + IR_ORDER(ir)) > 0) { + call ir_shifts (ir, im, outim, Memr[IR_XRSHIFTS(ir)], + Memr[IR_YRSHIFTS(ir)], Memr[IR_XCSHIFTS(ir)], + Memr[IR_YCSHIFTS(ir)], Memi[IR_IC1(ir)], Memi[IR_IC2(ir)], + Memi[IR_IL1(ir)], Memi[IR_IL2(ir)], Memi[IR_OC1(ir)], + Memi[IR_OC2(ir)], Memi[IR_OL1(ir)], Memi[IR_OL2(ir)], + Memr[IR_DELTAX(ir)], Memr[IR_DELTAY(ir)]) + call ir_m2match (ir, im, Memi[ranges], Memi[IR_IC1(ir)], + Memi[IR_IC2(ir)], Memi[IR_IL1(ir)], Memi[IR_IL2(ir)], + Memr[IR_DELTAX(ir)], Memr[IR_DELTAY(ir)], + Memr[IR_DELTAI(ir)]) + } else + call error (0, "There are no legal shifts in the coords file.") + call close (cl) + + case IR_SHIFTS: + if (ir_clinks (Memr[IR_XRSHIFTS(ir)], Memr[IR_YRSHIFTS(ir)], + Memr[IR_XCSHIFTS(ir)], Memr[IR_YCSHIFTS(ir)], IR_NXRSUB(ir), + IR_NYRSUB(ir), IR_NXSUB(ir), IR_NYSUB(ir), clgetr ("xshift"), + clgetr ("yshift")) > 0) { + call ir_shifts (ir, im, outim, Memr[IR_XRSHIFTS(ir)], + Memr[IR_YRSHIFTS(ir)], Memr[IR_XCSHIFTS(ir)], + Memr[IR_YCSHIFTS(ir)], Memi[IR_IC1(ir)], Memi[IR_IC2(ir)], + Memi[IR_IL1(ir)], Memi[IR_IL2(ir)], Memi[IR_OC1(ir)], + Memi[IR_OC2(ir)], Memi[IR_OL1(ir)], Memi[IR_OL2(ir)], + Memr[IR_DELTAX(ir)], Memr[IR_DELTAY(ir)]) + call ir_m2match (ir, im, Memi[ranges], Memi[IR_IC1(ir)], + Memi[IR_IC2(ir)], Memi[IR_IL1(ir)], Memi[IR_IL2(ir)], + Memr[IR_DELTAX(ir)], Memr[IR_DELTAY(ir)], + Memr[IR_DELTAI(ir)]) + } else + call error (0, "There are no legal shifts in the coords file.") + + case IR_FILE: + cl = open (Memc[coords], READ_ONLY, TEXT_FILE) + if (ir_flinks (cl, Memr[IR_DELTAX(ir)], Memr[IR_DELTAY(ir)], + Memr[IR_DELTAI(ir)], nimages) >= nimages) { + call ir_fshifts (ir, im, outim, Memr[IR_DELTAX(ir)], + Memr[IR_DELTAY(ir)], Memi[IR_IC1(ir)], Memi[IR_IC2(ir)], + Memi[IR_IL1(ir)], Memi[IR_IL2(ir)], Memi[IR_OC1(ir)], + Memi[IR_OC2(ir)], Memi[IR_OL1(ir)], Memi[IR_OL2(ir)]) + } else + call error (0, "There are fewer shifts than input subrasters.") + call close (cl) + + default: + call error (0, "T_IRALIGN: Undefined alignment algorithm") + } + + + # Fill the output image with the unknown value. + call ir_imzero (outim, int (IM_LEN(outim,1)), int (IM_LEN(outim, 2)), + IR_OVAL(ir)) + + # Shift and match all the subrasters. + call ir_subalign (ir, im, outim, Memc[trimlimits], Memi[IR_IC1(ir)], + Memi[IR_IC2(ir)], Memi[IR_IL1(ir)], Memi[IR_IL2(ir)], + Memi[IR_OC1(ir)], Memi[IR_OC2(ir)], Memi[IR_OL1(ir)], + Memi[IR_OL2(ir)], Memr[IR_DELTAX(ir)], Memr[IR_DELTAY(ir)], + Memr[IR_DELTAI(ir)], YES, interp, verbose) + + # Close up files. + call imunmap (im) + call imunmap (outim) + call dtunmap (dt) + call sfree (sp) + call ir_free (ir) +end diff --git a/noao/nproto/ir/t_irmosaic.x b/noao/nproto/ir/t_irmosaic.x new file mode 100644 index 00000000..86dee342 --- /dev/null +++ b/noao/nproto/ir/t_irmosaic.x @@ -0,0 +1,498 @@ +include <imhdr.h> +include <fset.h> +include "iralign.h" + + +# T_IRMOSAIC -- Procedure to combine a list of subrasters into a single large +# image. + +procedure t_irmosaic () + +int nimages, nmissing, verbose, subtract +pointer ir, sp, outimage, database, trimsection, medsection, nullinput, ranges +pointer str, index, c1, c2, l1, l2, isnull, median, imlist, outim, dt + +bool clgetb() +char clgetc() +int btoi(), clgwrd(), imtlen(), clgeti(), decode_ranges(), ir_get_imtype() +pointer imtopenp(), ir_setim(), dtmap() +real clgetr() + +begin + call fseti (STDOUT, F_FLUSHNL, YES) + call malloc (ir, LEN_IRSTRUCT, TY_STRUCT) + + # Allocate temporary working space. + call smark (sp) + call salloc (outimage, SZ_FNAME, TY_CHAR) + call salloc (database, SZ_FNAME, TY_CHAR) + call salloc (trimsection, SZ_FNAME, TY_CHAR) + call salloc (medsection, SZ_FNAME, TY_CHAR) + call salloc (nullinput, SZ_FNAME, TY_CHAR) + call salloc (ranges, 3 * MAX_NRANGES + 1, TY_INT) + call salloc (str, SZ_FNAME, TY_CHAR) + + # Get the image list, output image name and database file name. + imlist = imtopenp ("input") + call clgstr ("output", Memc[outimage], SZ_FNAME) + call clgstr ("database", Memc[database], SZ_FNAME) + call clgstr ("trim_section", Memc[trimsection], SZ_FNAME) + call clgstr ("null_input", Memc[nullinput], SZ_FNAME) + call clgstr ("median_section", Memc[medsection], SZ_FNAME) + if (Memc[medsection] == EOS) + subtract = NO + else + subtract = btoi (clgetb ("subtract")) + verbose = btoi (clgetb ("verbose")) + + # Get the mosaicing parameters. + IR_NXSUB(ir) = clgeti ("nxsub") + IR_NYSUB(ir) = clgeti ("nysub") + IR_CORNER(ir) = clgwrd ("corner", Memc[str], SZ_FNAME, ",ll,lr,ul,ur,") + IR_ORDER(ir) = clgwrd ("direction", Memc[str], SZ_FNAME, ",row,column,") + IR_RASTER(ir) = btoi (clgetb ("raster")) + IR_NXOVERLAP(ir) = clgeti ("nxoverlap") + IR_NYOVERLAP(ir) = clgeti ("nyoverlap") + IR_OVAL(ir) = clgetr ("oval") + + # Check that the number of observed and missing images matches + # the number of specified subrasters. + if (Memc[nullinput] == EOS) { + nmissing = 0 + Memi[ranges] = 0 + Memi[ranges+1] = 0 + Memi[ranges+2] = 1 + Memi[ranges+3] = NULL + } else { + if (decode_ranges (Memc[nullinput], Memi[ranges], MAX_NRANGES, + nmissing) == ERR) + call error (0, "Error decoding list of unobserved rasters.") + } + nimages = imtlen (imlist) + nmissing + if (nimages != (IR_NXSUB(ir) * IR_NYSUB(ir))) + call error (0, + "The number of input images is not equal to nxsub * nysub.") + + # Compute the output image characteristics and open the output image. + outim = ir_setim (ir, imlist, Memc[trimsection], Memc[outimage], + clgeti ("nimcols"), clgeti ("nimrows"), ir_get_imtype (clgetc ( + "opixtype"))) + + # Open the database file. + dt = dtmap (Memc[database], APPEND) + + # Allocate space for and setup the database. + call salloc (index, nimages, TY_INT) + call salloc (c1, nimages, TY_INT) + call salloc (c2, nimages, TY_INT) + call salloc (l1, nimages, TY_INT) + call salloc (l2, nimages, TY_INT) + call salloc (isnull, nimages, TY_INT) + call salloc (median, nimages, TY_REAL) + + call ir_setup (ir, imlist, Memi[ranges], Memc[trimsection], + Memc[medsection], outim, Memi[index], Memi[c1], Memi[c2], + Memi[l1], Memi[l2], Memi[isnull], Memr[median]) + + # Write the parameters to the database file. + call ir_dtwparams (dt, Memc[outimage], Memc[trimsection], + Memc[medsection], ir) + + # Make the output image. + call ir_mkmosaic (imlist, Memc[trimsection], outim, Memi[index], + Memi[c1], Memi[c2], Memi[l1], Memi[l2], Memi[isnull], + Memr[median], IR_NXSUB(ir), IR_NYSUB(ir), IR_OVAL(ir), subtract) + + # Write the database file. + call ir_dtwinput (imlist, Memc[trimsection], Memc[outimage], dt, + Memi[index], Memi[c1], Memi[c2], Memi[l1], Memi[l2], Memi[isnull], + Memr[median], IR_NXSUB(ir) * IR_NYSUB(ir), subtract, verbose) + + # Close up files and free space. + call dtunmap (dt) + call imunmap (outim) + call clpcls (imlist) + call sfree (sp) + call mfree (ir, TY_STRUCT) +end + + +define NTYPES 7 + +# IR_GET_IMTYPE -- Procedure to get the image type. + +int procedure ir_get_imtype (c) + +char c # character denoting the image type + +int i, typecodes[NTYPES] +int stridx() +string types "usilrdx" +data typecodes /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 (typecodes[i]) +end + + +# IR_SETUP -- Setup the data base parameters for the images. + +procedure ir_setup (ir, imlist, ranges, trimsection, medsection, outim, + index, c1, c2, l1, l2, isnull, median) + +pointer ir # pointer to the ir structure +pointer imlist # pointer to the list of input images +int ranges[ARB] # list of missing subrasters +char trimsection[ARB] # input image section for output +char medsection[ARB] # input image section for median computation +pointer outim # pointer to the output image +int index[ARB] # index array +int c1[ARB] # array of beginning column limits +int c2[ARB] # array of ending column limits +int l1[ARB] # array of beginning line limits +int l2[ARB] # array of ending line limits +int isnull[ARB] # output input image order number +real median[ARB] # output median of input image + +int i, j, k, nimrows, nimcols, imcount, next_null +pointer sp, imname, im, buf +int get_next_number(), imtgetim() +pointer immap(), imgs2r() +real amedr() + +begin + nimcols = IM_LEN(outim,1) + nimrows = IM_LEN(outim,2) + + call smark (sp) + call salloc (imname, SZ_FNAME, TY_CHAR) + + imcount = 1 + next_null = 0 + if (get_next_number (ranges, next_null) == EOF) + next_null = IR_NXSUB(ir) * IR_NYSUB(ir) + 1 + + # Loop over the input images. + do i = 1, IR_NXSUB(ir) * IR_NYSUB(ir) { + + # Set the indices array. + call ir_indices (i, j, k, IR_NXSUB(ir), IR_NYSUB(ir), + IR_CORNER(ir), IR_RASTER(ir), IR_ORDER(ir)) + index[i] = i + c1[i] = max (1, min (1 + (j - 1) * (IR_NCOLS(ir) - + IR_NXOVERLAP(ir)), nimcols)) + c2[i] = min (nimcols, max (1, c1[i] + IR_NCOLS(ir) - 1)) + l1[i] = max (1, min (1 + (k - 1) * (IR_NROWS(ir) - + IR_NYOVERLAP(ir)), nimrows)) + l2[i] = min (nimrows, max (1, l1[i] + IR_NROWS(ir) - 1)) + + # Set the index of each image in the image template + # and compute the median of the subraster. + if (i < next_null) { + isnull[i] = imcount + if (medsection[1] != EOS) { + if (imtgetim (imlist, Memc[imname], SZ_FNAME) == EOF) + call error (0, "Error reading input image list.") + call strcat (medsection, Memc[imname], SZ_FNAME) + im = immap (Memc[imname], READ_ONLY, TY_CHAR) + buf = imgs2r (im, 1, int (IM_LEN(im,1)), 1, int (IM_LEN(im, + 2))) + median[i] = amedr (Memr[buf], int (IM_LEN(im,1)) * + int (IM_LEN(im,2))) + call imunmap (im) + } else + median[i] = INDEFR + imcount = imcount + 1 + } else { + isnull[i] = 0 + if (medsection[1] == EOS) + median[i] = INDEFR + else + median[i] = IR_OVAL(ir) + if (get_next_number (ranges, next_null) == EOF) + next_null = IR_NXSUB(ir) * IR_NYSUB(ir) + 1 + } + + } + + call imtrew (imlist) + call sfree (sp) +end + + +# IR_SETIM -- Procedure to set up the output image characteristics. + +pointer procedure ir_setim (ir, list, trimsection, outimage, nimcols, nimrows, + opixtype) + +pointer ir # pointer to the ir structure +pointer list # pointer to list of input images +char trimsection[ARB]# input image section +char outimage[ARB] # name of the output image +int nimcols # number of output image columns +int nimrows # number of output image rows +int opixtype # output image pixel type + +int ijunk, nc, nr +pointer sp, imname, im, outim +pointer imtgetim(), immap() + +begin + call smark (sp) + call salloc (imname, SZ_FNAME, TY_CHAR) + + # Get the size of the first subraster. + if (imtgetim (list, Memc[imname], SZ_FNAME) != EOF) { + call strcat (trimsection, Memc[imname], SZ_FNAME) + im = immap (Memc[imname], READ_ONLY, 0) + IR_NCOLS(ir) = IM_LEN(im,1) + IR_NROWS(ir) = IM_LEN(im,2) + call imunmap (im) + call imtrew (list) + } else + call error (0, "Error reading first input image.\n") + + # Compute the size of the output image. + ijunk = IR_NXSUB(ir) * IR_NCOLS(ir) - (IR_NXSUB(ir) - 1) * + IR_NXOVERLAP(ir) + if (IS_INDEFI(nimcols)) + nc = ijunk + else + nc = max (nimcols, ijunk) + ijunk = IR_NYSUB(ir) * IR_NROWS(ir) - (IR_NYSUB(ir) - 1) * + IR_NYOVERLAP(ir) + if (IS_INDEFI(ijunk)) + nr = ijunk + else + nr = max (nimrows, ijunk) + + # Set the output pixel type. + if (opixtype == ERR) + opixtype = TY_REAL + + # Open output image and set the parameters. + outim = immap (outimage, NEW_IMAGE, 0) + IM_NDIM(outim) = 2 + IM_LEN(outim,1) = nc + IM_LEN(outim,2) = nr + IM_PIXTYPE(outim) = opixtype + + call sfree (sp) + + return (outim) +end + + +# IR_MKMOSAIC -- Procedure to make the mosaiced image. + +procedure ir_mkmosaic (imlist, trimsection, outim, index, c1, c2, l1, l2, + isnull, median, nxsub, nysub, oval, subtract) + +pointer imlist # pointer to input image list +char trimsection[ARB]# input image section +pointer outim # pointer to the output image +int index[ARB] # index array for sorting the images +int c1[ARB] # array of column beginnings +int c2[ARB] # array of column endings +int l1[ARB] # array of line beginnings +int l2[ARB] # array of line endings +int isnull[ARB] # index of input image in the template +real median[ARB] # array of input image median values +int nxsub # number of subrasters per output image column +int nysub # number of subrasters per output image row +real oval # pixel value of undefined output image regions +int subtract # subtract the median off each subraster + +int i, j, noutcols, noutlines, olineptr, ll1, ll2 +pointer sp, inimage, imptrs, buf +pointer imtrgetim(), immap(), impl2r() + +begin + # Allocate temporary space. + call smark (sp) + call salloc (imptrs, nxsub, TY_POINTER) + call salloc (inimage, SZ_FNAME, TY_CHAR) + + # Sort the subrasters on the yindex. + call ir_qsorti (l1, index, index, nxsub * nysub) + + noutcols = IM_LEN(outim,1) + noutlines = IM_LEN(outim,2) + + # Loop over the input images. + olineptr = 1 + do i = 1, nxsub * nysub, nxsub { + + # Compute the line and column limits. + ll1 = l1[index[i]] + ll2 = l2[index[i]] + + # Open the nxsub input images. + do j = i, i + nxsub - 1 { + if (isnull[index[j]] <= 0) { + Memc[inimage] = EOS + Memi[imptrs+j-i] = NULL + } else { + if (imtrgetim (imlist, isnull[index[j]], Memc[inimage], + SZ_FNAME) == EOF) + Memi[imptrs+j-i] = NULL + else { + call strcat (trimsection, Memc[inimage], SZ_FNAME) + Memi[imptrs+j-i] = immap (Memc[inimage], READ_ONLY, 0) + } + } + } + + # Write out the undefined lines. + while (olineptr < ll1) { + buf = impl2r (outim, olineptr) + call amovkr (oval, Memr[buf], noutcols) + olineptr = olineptr + 1 + } + + # Write the output lines. + call ir_mklines (Memi[imptrs], outim, index, c1, c2, ll1, ll2, + median, i, nxsub, oval, subtract) + olineptr = ll2 + 1 + + # Close up the images. + # Open the nxsub input images. + do j = i, i + nxsub - 1 { + if (Memi[imptrs+j-i] != NULL) + call imunmap (Memi[imptrs+j-i]) + } + + } + + # Write out the remaining undefined lines. + while (olineptr < noutlines) { + buf = impl2r (outim, olineptr) + call amovkr (oval, Memr[buf], noutcols) + olineptr = olineptr + 1 + } + + call sfree (sp) +end + + +# IR_MKLINES -- Construct and output image lines. + +procedure ir_mklines (imptrs, outim, index, c1, c2, l1, l2, meds, init, nsub, + oval, subtract) + +pointer imptrs[ARB] # array of input image pointers +pointer outim # output imnage pointer +int index[ARB] # array of indices +int c1[ARB] # array of beginning columns +int c2[ARB] # array of ending columns +int l1 # beginning line +int l2 # ending line +real meds[ARB] # array of median values +int init # first index +int nsub # number of subrasters +real oval # output value +int subtract # subtract the median value + +int i, j, jj, noutcols +pointer obuf, ibuf +pointer impl2r(), imgl2r() + +begin + noutcols = IM_LEN(outim, 1) + do i = l1, l2 { + obuf = impl2r (outim, i) + call amovkr (oval, Memr[obuf], noutcols) + do j = 1, nsub { + jj = index[j+init-1] + if (imptrs[j] != NULL) { + ibuf = imgl2r (imptrs[j], i - l1 + 1) + if (subtract == YES) + call asubkr (Memr[ibuf], meds[jj], Memr[obuf+c1[jj]-1], + c2[jj] - c1[jj] + 1) + else + call amovr (Memr[ibuf], Memr[obuf+c1[jj]-1], c2[jj] - + c1[jj] + 1) + } + } + } +end + + +# IR_DTWINPUT -- Procedure to write the output database file. + +procedure ir_dtwinput (imlist, trimsection, outimage, dt, index, c1, c2, l1, + l2, isnull, median, nsub, subtract, verbose) + +int imlist # input image list +char trimsection[ARB]# trim section of input image +char outimage[ARB] # output image +pointer dt # pointer to the database file +int index[ARB] # array of sorted indices (not used at present) +int c1[ARB] # array of beginning column limits +int c2[ARB] # array of ending column limits +int l1[ARB] # array of beginning line limits +int l2[ARB] # array of ending line limits +int isnull[ARB] # image name index +real median[ARB] # array of medians +int nsub # number of subrasters +int subtract # subtract the median from the subraster +int verbose # print verbose messages + +int i +pointer sp, imname +int imtrgetim() + +begin + call smark (sp) + call salloc (imname, SZ_FNAME, TY_CHAR) + + # Write out the number of subrasters. + call dtput (dt, "\tnsubrasters\t%d\n") + call pargi (nsub) + + do i = 1, nsub { + + if (isnull[i] <= 0) + call strcpy ("nullimage", Memc[imname], SZ_FNAME) + else if (imtrgetim (imlist, isnull[i], Memc[imname], + SZ_FNAME) != EOF) + call strcat (trimsection, Memc[imname], SZ_FNAME) + else + Memc[imname] = EOS + + call dtput (dt,"\t%s %s[%d:%d,%d:%d] %g %g\n") + call pargstr (Memc[imname]) + call pargstr (outimage) + call pargi (c1[i]) + call pargi (c2[i]) + call pargi (l1[i]) + call pargi (l2[i]) + call pargr (median[i]) + if (subtract == YES) + call pargr (-median[i]) + else + call pargr (0.0) + + if (verbose == YES) { + call printf ("imcopy %s %s[%d:%d,%d:%d] %g %g\n") + call pargstr (Memc[imname]) + call pargstr (outimage) + call pargi (c1[i]) + call pargi (c2[i]) + call pargi (l1[i]) + call pargi (l2[i]) + call pargr (median[i]) + if (subtract == YES) + call pargr (-median[i]) + else + call pargr (0.0) + } + } + + call sfree (sp) +end diff --git a/noao/nproto/iralign.par b/noao/nproto/iralign.par new file mode 100644 index 00000000..0865c07d --- /dev/null +++ b/noao/nproto/iralign.par @@ -0,0 +1,20 @@ +# IRALIGN + +input,f,a,,,,Input image +output,f,a,,,,Output image +database,f,a,,,,Database file +coords,f,a,,,,Coordinate file +xshift,r,a,0.0,,,Xshift for align by shifts +yshift,r,a,0.0,,,Yshift for align by shifts +alignment,s,h,"coords",,,'Alignment technique (coords|shifts|file)' +nxrsub,i,h,INDEF,,,Row index of reference subraster +nyrsub,i,h,INDEF,,,Column index of reference subraster +xref,i,h,0,,,X offset of reference subraster in pixels +yref,i,h,0,,,Y offset of reference subraster in pixels +trimlimits,s,h,"[1:1,1:1]",,,Trim limits for each subraster +nimcols,i,h,INDEF,,,Number of column in the output image +nimlines,i,h,INDEF,,,Number of lines in the output image +oval,r,h,INDEF,,,The value of undefined regions the image +interpolant,s,h,'linear',,,'Interpolant (nearest|linear|poly3|poly5,spline3)' +verbose,b,h,yes,,,Print messages +mode,s,h,'ql' diff --git a/noao/nproto/irmatch1d.par b/noao/nproto/irmatch1d.par new file mode 100644 index 00000000..a9c40ff6 --- /dev/null +++ b/noao/nproto/irmatch1d.par @@ -0,0 +1,21 @@ +# IRMATCH1D + +input,f,a,,,,Input image +output,f,a,,,,Output image +database,f,a,,,,Database file +coords,f,a,,,,Coordinate file +xshift,r,a,0.0,,,Xshift for align by shifts +yshift,r,a,0.0,,,Yshift for align by shifts +alignment,s,h,"coords",,,'Alignment technique (coords|shifts|file)' +match,s,h,"*",,,Intensity match the following subrastrers +nxrsub,i,h,INDEF,,,Row index of reference subraster +nyrsub,i,h,INDEF,,,Column index of reference subraster +xref,i,h,0,,,Column offset of reference subraster +yref,i,h,0,,,Line offset of reference subraster +trimlimits,s,h,"[1:1,1:1]",,,Trim limits for the input subraster +nimcols,i,h,INDEF,,,Number of column in the output image +nimlines,i,h,INDEF,,,Number of lines in the output image +oval,r,h,INDEF,,,The value of undefined regions the image +interpolant,s,h,'linear',,,'Interpolant (nearest|linear|poly3|poly5,spline3)' +verbose,b,h,yes,,,Print messages +mode,s,h,'ql' diff --git a/noao/nproto/irmatch2d.par b/noao/nproto/irmatch2d.par new file mode 100644 index 00000000..7a159eba --- /dev/null +++ b/noao/nproto/irmatch2d.par @@ -0,0 +1,21 @@ +# IRMATCH2D + +input,f,a,,,,Input image +output,f,a,,,,Output image +database,f,a,,,,Database file +coords,f,a,,,,Coordinate file +xshift,r,a,0.0,,,Xshift for align by shifts +yshift,r,a,0.0,,,Yshift for align by shifts +alignment,s,h,"coords",,,'Alignment technique (coords|shifts|file)' +match,s,h,"*",,,Intensity match the following subrastrers +nxrsub,i,h,INDEF,,,Row index of reference subraster +nyrsub,i,h,INDEF,,,Column index of reference subraster +xref,i,h,0,,,Column offset of the reference subraster +yref,i,h,0,,,Line offset of the reference subraster +trimlimits,s,h,"[1:1,1:1]",,,Trim limits for the input subraster +nimcols,i,h,INDEF,,,Number of column in the output image +nimlines,i,h,INDEF,,,Number of lines in the output image +oval,r,h,INDEF,,,The value of undefined regions the image +interpolant,s,h,'linear',,,'Interpolant (nearest|linear|poly3|poly5,spline3)' +verbose,b,h,yes,,,Print messages +mode,s,h,'ql' diff --git a/noao/nproto/irmosaic.par b/noao/nproto/irmosaic.par new file mode 100644 index 00000000..7fc573ff --- /dev/null +++ b/noao/nproto/irmosaic.par @@ -0,0 +1,22 @@ +# IRMOSAIC + +input,f,a,,,,List of input images +output,f,a,,,,Output image +database,f,a,,,,Output database file +nxsub,i,a,,,,Number of input images along the x direction +nysub,i,a,,,,Number of input images along the y direction +trim_section,s,h,"[*,*]",,,Input image section written to the output image +null_input,s,h,"",,,List of missing input images +corner,s,h,"ll",,,Position of first subraster +direction,s,h,"row",,,Row or column order placement +raster,b,h,no,,,Raster scan mode +median_section,s,h,"",,,Input image section used to compute the median +subtract,b,h,no,,,Subtract median from each input image +nimcols,i,h,INDEF,,,The number of columns in the output image +nimrows,i,h,INDEF,,,The number of rows in the output image +nxoverlap,i,h,-1,,,Number of columns of overlap between input images +nyoverlap,i,h,-1,,,Number of rows of overlap between input images +opixtype,s,h,"r",,,Output image pixel type +oval,r,h,0.0,,,Value of undefined output image pixels +verbose,b,h,yes,,,Print out messages +mode,s,h,'ql' diff --git a/noao/nproto/linpol.par b/noao/nproto/linpol.par new file mode 100644 index 00000000..211e9321 --- /dev/null +++ b/noao/nproto/linpol.par @@ -0,0 +1,6 @@ +input,s,a,,,,Input images +output,s,a,,,,Output polarization image stack +degrees,b,h,yes,,,Report the polarization angle in degrees? +stokes,b,h,yes,,,Output the Stokes parameter images? +normalize,b,h,no,,,Normalize the Q and U frames? +keyword,s,h,"polangle",,,Header keyword for polarizer angle diff --git a/noao/nproto/mkms.cl b/noao/nproto/mkms.cl new file mode 100644 index 00000000..2944bca1 --- /dev/null +++ b/noao/nproto/mkms.cl @@ -0,0 +1,104 @@ +# MKMS -- Simple script to make a multispec file from separate 1D spectra. +# The task SCOPY will make a multispec file but it does not handle associated +# arrays such as background and errors. This task builds on SCOPY by adding +# the associated arrays in the proper format. +# +# This task does very little error checking. The various lists are assumed +# to be null (i.e. "") or have the same number of spectra. The associated +# spectra are also assumed to have matching dispersions with their primary +# spectrum. +# +# To install MKMS copy the script to your home or other directory. Load the +# onedspec package. Add the task with the command "task mkms=home$mkms.cl". +# Note you can replace the home$ with the full or logical path to another +# directory if the script is not in your home directory. The steps of +# loading onedspec and defining the script task may be done in the login.cl +# or loginuser.cl file for permanent use. + +procedure mkms (output, spectra, raw, background, sigma) + +file output {prompt="Output multispec file"} +string spectra {prompt="List of primary spectra"} +string raw {prompt="List of raw (secondary) spectra"} +string background {prompt="List of background spectra"} +string sigma {prompt="List of sigma spectra"} + +begin + file out, temp1, temp2, temp3, temp4, temp5 + string in, outlist, bandid + int nspec, nbands + + # Temporary files in the current directory. + temp1 = mktemp ("temp") + temp2 = mktemp ("temp") + temp3 = mktemp ("temp") + temp4 = mktemp ("temp") + temp5 = mktemp ("temp") + + # Get query parameters once and do a simple check for input. + out = output + in = spectra + if (in == "") + error (1, "No primary spectra specified") + + # Load ONEDSPEC if not already loaded. + if (!defpac ("onedspec")) + onedspec + + # Create the primary multispec format from 1D spectra using SCOPY. + scopy (in, temp1, w1=INDEF, w2=INDEF, apertures="", bands="", + beams="", apmodulus=0, format="multispec", renumber=yes, + offset=0, clobber=no, merge=no, rebin=yes, verbose=no) + hedit (temp1, "bandid1", "spectrum", add+, verify-, show-, update+) + + # Determine the number of spectra and initialize the bands accumulators. + nspec = 1 + hselect (temp1, "naxis2", yes) | scan (nspec) + nbands = 1 + outlist = temp1 + + # Create bands if specified. Don't worry about headers since the + # header of the primary multispec format will be inherited. + + in = raw + if (in != "") { + imstack (in, temp2, title="*", pixtype="*") + outlist = outlist // "," // temp2 + nbands = nbands + 1 + printf ("bandid%d\n", nbands) | scan (bandid) + hedit (temp1, bandid, "raw", add+, verify-, show-, update+) + } + in = background + if (in != "") { + imstack (in, temp3, title="*", pixtype="*") + outlist = outlist // "," // temp3 + nbands = nbands + 1 + printf ("bandid%d\n", nbands) | scan (bandid) + hedit (temp1, bandid, "background", add+, verify-, show-, update+) + } + in = sigma + if (in != "") { + imstack (in, temp4, title="*", pixtype="*") + outlist = outlist // "," // temp4 + nbands = nbands + 1 + printf ("bandid%d\n", nbands) | scan (bandid) + hedit (temp1, bandid, "sigma", add+, verify-, show-, update+) + } + + # Make the final output format. Adjust dimensions are needed. + # A multispec file maybe 1D, 2D, or 3D depending on the content. + + if (nbands == 1) + imcopy (temp1, out, verbose-) + else { + if (nspec == 1) { + imrename (temp1, temp5, verbose-) + imstack (temp5, temp1, title="*", pixtype="*") + imdelete (temp5, verify-) + } + imstack (outlist, out, title="*", pixtype="*") + } + + # Finish up. + imdelete (outlist, verify-) +end diff --git a/noao/nproto/mkpkg b/noao/nproto/mkpkg new file mode 100644 index 00000000..319373a9 --- /dev/null +++ b/noao/nproto/mkpkg @@ -0,0 +1,28 @@ +# Make the NPROTO package. + +$call relink +$exit + +update: + $call relink + $call install + ; + +relink: + $set LIBS="-lxtools -liminterp -lcurfit -lgsurfit -lds" + $update libpkg.a + $omake x_nproto.x + $link x_nproto.o libpkg.a $(LIBS) -o xx_nproto.e + ; + +install: + $move xx_nproto.e noaobin$x_nproto.e + ; + +libpkg.a: + @ace + @ir + t_binpairs.x + t_linpol.x <imhdr.h> <error.h> + t_slitpic.x <ctype.h> <imhdr.h> slitpic.h + ; diff --git a/noao/nproto/nproto.cl b/noao/nproto/nproto.cl new file mode 100644 index 00000000..1aa05fc6 --- /dev/null +++ b/noao/nproto/nproto.cl @@ -0,0 +1,26 @@ +#{ Package script task for the NPROTO package. + +images # for the script tasks findthresh, ndprep + +package nproto + +task binpairs, + iralign, + irmatch1d, + irmatch2d, + irmosaic, + linpol, + slitpic = nproto$x_nproto.e + +task findthresh = "nproto$findthresh.cl" +task mkms = "nproto$mkms.cl" + +task detect = "nproto$ace/x_nproto.e" +task objmasks = "nproto$ace/objmasks.cl" +task objmasks1 = "nproto$ace/objmasks1.par" +hidetask detect, objmasks1 + +task skysep = "nproto$skysep.cl" +task skygroup = "nproto$skygroup.cl" + +clbye diff --git a/noao/nproto/nproto.hd b/noao/nproto/nproto.hd new file mode 100644 index 00000000..14b3245b --- /dev/null +++ b/noao/nproto/nproto.hd @@ -0,0 +1,21 @@ +# Help directory for the NPROTO package. + +$doc = "noao$nproto/doc/" +$ace = "noao$nproto/ace/" +$acedoc = "noao$nproto/ace/doc/" +$ir = "noao$nproto/ir/" + +binpairs hlp =doc$binpairs.hlp, src = x_binpairs.x +findthresh hlp =doc$findthresh.hlp, src = findthresh.cl +iralign hlp =doc$iralign.hlp, src = ir$t_iralign.x +irmatch1d hlp =doc$irmatch1d.hlp, src = ir$t_irmatch1d.x +irmatch2d hlp =doc$irmatch2d.hlp, src = ir$t_irmatch2d.x +irmosaic hlp =doc$irmosaic.hlp, src = ir$t_irmosaic.x +linpol hlp =doc$linpol.hlp, src = t_linpol.x +mkms hlp =doc$mkms.hlp, src = mkms.cl +objmasks hlp =acedoc$objmasks.hlp, src = ace$t_objmasks.cl +slitpic hlp =doc$slitpic.hlp, src = t_slitpic.x +skygroup hlp =doc$skygroup.hlp, src = skygroup.cl +skysep hlp =doc$skysep.hlp, src = skysep.cl +revisions sys =Revisions + diff --git a/noao/nproto/nproto.men b/noao/nproto/nproto.men new file mode 100644 index 00000000..7f77ba7f --- /dev/null +++ b/noao/nproto/nproto.men @@ -0,0 +1,12 @@ + binpairs - Bin pairs of (x,y) points in log separation + findthresh - Estimate a CCD's sky noise from the gain and readnoise + iralign - Align the mosaiced image produced by irmosaic + irmatch1d - Align and intensity match image produced by irmosaic (1D) + irmatch2d - Align and intensity match image produced by irmosaic (2D) + irmosaic - Mosaic an ordered list of images onto a grid + linpol - Calculate polarization frames and Stoke's parameters + mkms - Create multispec from 1D spectra including associated bands + objmasks - Detect objects in images and make masks + slitpic - Generate IRAF image of aperture slit mask + skygroup - Group a list containing RA and Dec into spatial sublists + skysep - Compute arc separation of two RA/Dec values diff --git a/noao/nproto/nproto.par b/noao/nproto/nproto.par new file mode 100644 index 00000000..f9b24d03 --- /dev/null +++ b/noao/nproto/nproto.par @@ -0,0 +1,3 @@ +# NPROTO package parameter file. + +version,s,h,"January 1992" diff --git a/noao/nproto/skygroup.cl b/noao/nproto/skygroup.cl new file mode 100644 index 00000000..24fa05aa --- /dev/null +++ b/noao/nproto/skygroup.cl @@ -0,0 +1,195 @@ +# SKYGROUP -- Group coordinate list on the sky. +# +# The input is list of ra (0h-24h or 0d-360d) and dec (-90d to 90d) in the +# first two columns followed by arbitrary data (usually a filename). +# This is complicated by the periodicities at 0h. + +procedure skygroup (input, output) + +file input {prompt="Input list"} +string output {prompt="Output rootname"} +string extn = "" {prompt="Optional output extension"} +real sep = 60 {prompt="Separation between groups (arcsec)"} +string raunit = "hr" {prompt="RA unit (hr|deg)"} +bool keepcoords = yes {prompt="Keep coordinates in output?"} +string raformat = "%.2h" {prompt="Output RA format"} +string decformat = "%.1h" {prompt="Output DEC format"} + +struct *fd1, *fd2 + +begin + file in, out, fname, temp1, temp2, temp3 + int i, j, n, n1 + real dra, r1, d1, r2, d2, r3, d3, r4 + struct fmtstr, data1, data2, data3 + + # Temporary files. + fname = mktemp ("tmp") + in = fname // "in" + temp1 = fname // "1" + temp2 = fname // "2" + temp3 = fname // "3" + + # Set parameters. + fname = input + out = output + + # Check for existing output files. + files (out//"_[0-9][0-9][0-9][0-9]*"//extn, > temp1) + count (temp1) | scan (n); delete (temp1, verify-) + if (access(out) || n > 0) + error (1, "Output files already exist") + + if (raunit == "hr") + dra = 24 + else + dra = 360 + + if (keepcoords) + fmtstr = "%d " // raformat // " " // decformat // " %s" + else + fmtstr = "%d %s" + fmtstr += "\n" + + # We start by sorting in dec. + sort (fname, col=2, num+, > in) + + # Find jumps in dec bigger than the separation and then sort + # in ra and find jumps in ra bigger than separation. Handle + # the wrap around at 0h by duplicating to extend beyond 24h. + # The duplicates will be eliminated during the merging process. + + n = 1 + fd1 = in + if (fscan (fd1, r1, d1, data1) == EOF) + error (1, "No data or badly formated data") + while (fscan (fd1, r2, d2, data2) != EOF) { + print (r1, d1, data1, >> temp1) + if (r1 / max (0.001, dcos(d1)) * 3600 <= sep) { + r4 = r1 + dra + print (r4, d1, data1, >> temp1) + } + if (abs(d2-d1) <= sep) { + r1 = r2; d1 = d2; data1 = data2 + next + } + + r3 = r2; d3 = d2; data3 = data2 + + sort (temp1, col=1, num+, > temp2) + delete (temp1, verify-) + + fd2 = temp2 + if (fscan (fd2, r1, d1, data1) == EOF); + while (fscan (fd2, r2, d2, data2) != EOF) { + if (keepcoords) + printf (fmtstr, n, r1, d1, data1, >> temp3) + else + printf (fmtstr, n, data1, >> temp3) + skysep (r1, d1, r2, d2, raunit=raunit, verb-) + if (skysep.sep <= sep) { + r1 = r2; d1 = d2; data1 = data2 + next + } + + n += 1 + r1 = r2; d1 = d2; data1 = data2 + } + fd2 = ""; delete (temp2, verify-) + + if (keepcoords) + printf (fmtstr, n, r1, d1, data1, >> temp3) + else + printf (fmtstr, n, data1, >> temp3) + n += 1 + + r1 = r3; d1 = d3; data1 = data3 + } + fd1 = ""; delete (in, verify-) + + print (r1, d1, data1, >> temp1) + if (r1 / max (0.001, dcos(d1)) * 3600 <= sep) { + r4 = r1 + dra + print (r4, d1, data1, >> temp1) + } + + sort (temp1, col=1, num+, > temp2) + delete (temp1, verify-) + + fd2 = temp2 + if (fscan (fd2, r1, d1, data1) == EOF); + while (fscan (fd2, r2, d2, data2) != EOF) { + if (keepcoords) + printf (fmtstr, n, r1, d1, data1, >> temp3) + else + printf (fmtstr, n, data1, >> temp3) + skysep (r1, d1, r2, d2, raunit=raunit, verb-) + if (skysep.sep <= sep) { + r1 = r2; d1 = d2; data1 = data2 + next + } + + n += 1 + r1 = r2; d1 = d2; data1 = data2 + } + fd2 = ""; delete (temp2, verify-) + + if (keepcoords) + printf (fmtstr, n, r1, d1, data1, >> temp3) + else + printf (fmtstr, n, data1, >> temp3) + + # Now write out the lists and check for duplicate which must be + # merged. + + sort (temp3, col=1, num+, > temp1); delete (temp3, verify-) + touch (temp2) + fd1 = temp1 + if (fscan (fd1, i, data1) == EOF); + while (fscan (fd1, j, data2) != EOF) { + if (data1 == data2) { + print (j, i, >> temp2) + next + } + printf ("%s_%03d%s\n", out, i, extn) | scan (fname) + print (data1, >> fname) + i = j; data1 = data2 + } + fd1 = ""; delete (temp1, verify-) + printf ("%s_%03d%s\n", out, i, extn) | scan (fname) + print (data1, >> fname) + sort (temp2, col=1, num+, rev+) | unique (> temp1) + delete (temp2, verify-) + + # Merge the lists. + n1 = n + fd1 = temp1 + while (fscan (fd1, j, i) != EOF) { + printf ("%s_%03d%s\n", out, j, extn) | scan (fname) + if (access (fname)) { + printf ("%s_%03d%s\n", out, i, extn) | scan (in) + concat (in, fname, append+) + delete (in, verify-) + n1 -= 1 + } + } + fd1 = ""; delete (temp1, verify-) + + # Renumber if needed. + if (n1 != n) { + i = 1 + for (j=1; j<=n; j+=1) { + printf ("%s_%03d%s\n", out, j, extn) | scan (fname) + if (access(fname)) { + if (i != j) { + printf ("%s_%03d%s\n", out, i, extn) | scan (in) + rename (fname, in) + } + i += 1 + } + } + } + + # Create the final output list of lists. + files (out//"_[0-9]*", > out//extn) +end diff --git a/noao/nproto/skysep.cl b/noao/nproto/skysep.cl new file mode 100644 index 00000000..d70742d5 --- /dev/null +++ b/noao/nproto/skysep.cl @@ -0,0 +1,41 @@ +# SEP -- Separation between two celestial coordinates. + +procedure sep (ra1, dec1, ra2, dec2) + +real ra1 { prompt="RA (hr|deg)"} +real dec1 { prompt="DEC (deg)"} +real ra2 { prompt="RA (hr|deg)"} +real dec2 { prompt="DEC (deg)"} +string raunit = "hr" { prompt="RA unit (hr|deg)", enum="hr|deg" } +bool verbose = no { prompt="Verbose?"} +real sep { prompt="Separation (arcsec)"} + +begin + real r1, d1, r2, d2 + real c1, c2, x, y, z + + if (raunit == "hr") { + r1 = ra1 * 15. + d1 = dec1 + r2 = ra2 * 15. + d2 = dec2 + } else { + r1 = ra1 + d1 = dec1 + r2 = ra2 + d2 = dec2 + } + + c1 = dcos(d1) + c2 = dcos(d2) + x = dcos(r1) * c1 - dcos(r2) * c2 + y = dsin(r1) * c1 - dsin(r2) * c2 + z = dsin(d1) - dsin(d2) + c1 = (x*x + y*y + z*z) / 4. + c2 = max (0., 1.-c1) + sep = 2 * datan2(sqrt(c1),sqrt(c2)) * 3600 + + if (verbose) + printf ("%.2f arcsec = (%.2H, %.1h) - (%.2H, %.1h)\n", + sep, r1, d1, r2, d2) +end diff --git a/noao/nproto/slitpic.h b/noao/nproto/slitpic.h new file mode 100644 index 00000000..26cc7f2a --- /dev/null +++ b/noao/nproto/slitpic.h @@ -0,0 +1,12 @@ +define MAX_RANGES 100 +define PSCALE 6.624 # KPNO plate scale arcsec/mm +define CPSCALE 6.560 # CTIO plate scale arcsec/mm +define XY_ZERO_PT 24.5 # xy zero points +define MAX_SLITS 100 # Maximum number of slits allowed +define N_PARAMS 5 # Number of parameters defining each slit +define START_COLUMN 49 # First column containing slit information +define LEN_USER_AREA 0 +define LEN_KEYWORD 8 +define CLEAR 255 +define SATURATE 0 +define LEN_IDSTRING 20 diff --git a/noao/nproto/slitpic.par b/noao/nproto/slitpic.par new file mode 100644 index 00000000..2645f3ba --- /dev/null +++ b/noao/nproto/slitpic.par @@ -0,0 +1,11 @@ +# Task parameters for slitpic are as follows: + +serial_numbers,s,a,"",,,Range of serial numbers to process +output_root,s,a,"mask",,,Root name of output image +tape1,s,h,"slitsave",,,Name of file containing slit solutions +site,s,h,"kpno",,,Observing site - kpno/ctio +slit_width,r,h,2.5,,,Width of slit +pixel_scale,r,h,0.4157,,,Scale of image in arcsec/pixel +pix_date,s,h,"14feb84",,,Date on which pixel_scale (above) was valid +crtpict,b,h,no,,,Generate command file for crtpict input? +cmd_file,s,h,"cmd",,,Root name of output command file for crtpict diff --git a/noao/nproto/t_binpairs.x b/noao/nproto/t_binpairs.x new file mode 100644 index 00000000..2efe380d --- /dev/null +++ b/noao/nproto/t_binpairs.x @@ -0,0 +1,234 @@ +define MAXNBINS 100 # Maximum number of bins +define MAXNPTS 10000 # Maximum number of data points + + +# T_BIN_PAIRS -- Bin pairs in separation +# +# The data points in two files, given as (x,y) values, are binned as a +# function of log separation. The number of bins and the separation range +# are specified. A list of separation, number of pairs in the bin, +# the number of pairs normalized by the total number of input pairs, and +# the area of the bin are output. + +procedure t_binpairs () + +char file1[SZ_FNAME] # Data file1 +char file2[SZ_FNAME] # Data file2 +real rmin # Minimum separation +real rmax # Maximum separation +int nbins # Number of separation bins +bool verbose # Verbose output + +real x1[MAXNPTS], y1[MAXNPTS] # Data coordinates +real x2[MAXNPTS], y2[MAXNPTS] # Data coordinates +int npts1, npts2 # Number of data points +int npairs[MAXNBINS] # Number of pairs + +int fd, i, nall +real r1, r2 + +bool clgetb(), strne() +real clgetr() +int clgeti(), open(), get_data() + +begin + # Get the pairs from file1. + call clgstr ("file1", file1, SZ_FNAME) + fd = open (file1, READ_ONLY, TEXT_FILE) + npts1 = get_data (fd, x1, y1, MAXNPTS) + call close (fd) + + # Get the pairs from file2 if different from file1. + call clgstr ("file2", file2, SZ_FNAME) + if (strne (file1, file2)) { + fd = open (file2, READ_ONLY, TEXT_FILE) + npts2 = get_data (fd, x2, y2, MAXNPTS) + call close (fd) + } else + npts2 = 0 + + # Get the separation bin parameters. + rmin = clgetr ("rmin") + rmax = clgetr ("rmax") + nbins = min (clgeti ("nbins"), MAXNBINS) + verbose = clgetb ("verbose") + + # Compute the pairs. + call setbins (rmin, rmax, nbins) + call bin_pairs (x1, y1, npts1, x2, y2, npts2, npairs, nbins, verbose) + if (npts2 == 0) + nall = npts1 * (npts1 - 1) + else + nall = npts1 * npts2 + + # Print the results. + call binr (1, r1) + do i = 1, nbins { + call binr (i + 1, r2) + call printf ("%g %d %g %g\n") + call pargr (r1) + call pargi (npairs[i]) + call pargr (real (npairs[i]) / nall) + call pargr (3.14159 * (r2 ** 2 - r1 ** 2)) + r1 = r2 + } +end + + +# GET_DATA -- Get a list of x,y coordinates from a file and return the number +# of points. + +int procedure get_data (fd, x, y, maxnpts) + +int fd # Input file descriptor +real x[maxnpts] # X data coordinate +real y[maxnpts] # Y data coordinate +int maxnpts # Maximum number of data points to get +int npts # Return number of points + +int fscan(), nscan() + +begin + # Read the data + npts = 0 + while (npts < MAXNPTS) { + if (fscan (fd) == EOF) + break + npts = npts + 1 + call gargr (x[npts]) + call gargr (y[npts]) + if (nscan() != 2) + npts = npts - 1 + } + return (npts) +end + + +# BIN_PAIRS -- Bin pairs in the input vectors. +# +# The points in the input vector(s) are binned according to the +# binnum procedure. If npts2 is zero then the first vector is paired +# against itself (autocorrelation). + +procedure bin_pairs (x1, y1, npts1, x2, y2, npts2, npairs, nbins, verbose) + +real x1[npts1], y1[npts1] # Coordinates of points +int npts1 # Number of points +real x2[npts2], y2[npts2] # Coordinates of points +int npts2 # Number of points +int npairs[nbins] # Number of pairs +int nbins # Number of separation bins +bool verbose # Verbose output + +int i, j, k, bin + +begin + # Initialize bins + do bin = 1, nbins + npairs[bin] = 0 + + # Set printing interval + if (verbose) + k = max (1, npts1 / 20) + + # Loop through all pairs of points + do i = 1, npts1 { + + # If npts2 is zero then pair the points in the first vector + # otherwise pair the points between the two vectors. + + if (npts2 == 0) { + do j = i + 1, npts1 { + call binnum (x1[i], y1[i], x1[j], y1[j], bin) + if (bin > 0) + npairs[bin] = npairs[bin] + 2 + } + } else { + do j = 1, npts2 { + call binnum (x1[i], y1[i], x2[j], y2[j], bin) + if (bin > 0) + npairs[bin] = npairs[bin] + 1 + } + } + + if (verbose) { + if (mod (i, k) == 0) { + call eprintf ("%5.1f%%...\n") + call pargr (100. * i / npts1) + } + } + } +end + + +define R2BINS 100 # Maximum number of r2 bins +define HASHBINS 1000 # Size of r2 hash table + +# SETBINS -- Set the mapping between separation and bin +# BINNUM -- Return bin number for the given data points +# BINR -- Return separation for the given bin + +procedure setbins (rmin, rmax, nr) + +real rmin # Minimum separation +real rmax # Maximum separation +int nr # Number of separation bins + +real x1, y1 # Data coordinate +real x2, y2 # Data coordinate +int bin # Correlation Bin +real r # Separation + +real r2bins[R2BINS] # r2 bins +int hash[HASHBINS] # Hash table + +int i, j, nbins +real r2, dr2, r2zero +real logr2, dlogr2, logr2zero + +begin + r2 = rmin ** 2 + dr2 = (rmax ** 2 - r2) / HASHBINS + r2zero = 1 - r2 / dr2 + + logr2 = 2 * log10 (rmin) + dlogr2 = (2 * log10 (rmax) - logr2) / nr + logr2zero = 1 - logr2 / dlogr2 + + do i = 1, HASHBINS { + hash[i] = log10 (r2) / dlogr2 + logr2zero + r2 = r2 + dr2 + } + + nbins = nr + 1 + do i = 1, nbins { + r2bins[i] = 10 ** logr2 + logr2 = logr2 + dlogr2 + } + + return + +entry binnum (x1, y1, x2, y2, bin) + + r2 = (x1 - x2) ** 2 + (y1 - y2) ** 2 + i = r2 / dr2 + r2zero + + if ((i < 1) || (i > HASHBINS)) + bin = 0 + + else { + j = hash[i] + do i = j + 1, nbins { + if (r2 < r2bins[i]) { + bin = i - 1 + return + } + } + } + + return + +entry binr (bin, r) + + r = sqrt (r2bins[bin]) +end diff --git a/noao/nproto/t_linpol.x b/noao/nproto/t_linpol.x new file mode 100644 index 00000000..d41270ec --- /dev/null +++ b/noao/nproto/t_linpol.x @@ -0,0 +1,547 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> +include <error.h> + +define MAX_IMAGES 4 + +define LP_TITLE "Linear polarization image" +define LP_IMKEY "POL" # keyword prefix for input images + +define LP_PBAND 1 +define LP_PKEY "POLAR" +define LP_PSTR "Band 1 is the percent polarization" + +define LP_ABAND 2 +define LP_AKEY "ANGLE" +define LP_ASTR "Band 2 is the polarization angle" + +define LP_IBAND 3 +define LP_IKEY "I-STOKES" +define LP_ISTR "Band 3 is the Stokes I parameter" + +define LP_QBAND 4 +define LP_QKEY "Q-STOKES" +define LP_QSTR "Band 4 is the Stokes Q parameter" +define LP_QSTRN "Band 4 is the normalized Stokes Q parameter" + +define LP_UBAND 5 +define LP_UKEY "U-STOKES" +define LP_USTR "Band 5 is the Stokes U parameter" +define LP_USTRN "Band 5 is the normalized Stokes U parameter" + + +# LINPOL -- Calculate the percent polarization and the polarization +# angle images for the simplest linear polarization cases, 0-45-90 or +# 0-45-90-135 polarizer positions. + +procedure t_linpol () + +pointer inlist, output, in[MAX_IMAGES], out, key, sp +bool dflag, sflag, nflag +int len + +int imtopenp(), imtlen() +bool clgetb() + +errchk lp_map, lp_polarize + +begin + call smark (sp) + call salloc (output, SZ_FNAME, TY_CHAR) + call salloc (key, SZ_FNAME, TY_CHAR) + + # get the input image template + inlist = imtopenp ("input") + len = imtlen (inlist) + if (len != 3 && len != 4) { + call imtclose (inlist) + call sfree (sp) + call error (1, "Must supply either three or four images.") + } + + # get the output image stack name + call clgstr ("output", Memc[output], SZ_FNAME) + + sflag = clgetb ("stokes") + dflag = clgetb ("degrees") + nflag = clgetb ("normalize") + + # keyword for polarizer angle - UPPERcase for neatness + call clgstr ("keyword", Memc[key], SZ_FNAME) + call strupr (Memc[key]) + + iferr { + # pass the number of possible frames (4) explicitly in + # hopes of later relaxing the 45 degree restriction + call lp_map (inlist, in, MAX_IMAGES, + Memc[key], Memc[output], out, sflag, nflag) + call lp_polarize (in, MAX_IMAGES, out, dflag, sflag, nflag) + } then { + call lp_unmap (in, MAX_IMAGES, out) + call imtclose (inlist) + call sfree (sp) + call erract (EA_ERROR) + } + + call lp_unmap (in, MAX_IMAGES, out) + call imtclose (inlist) + call sfree (sp) +end + + +# LP_MAP -- map the set of input images. + +procedure lp_map (inlist, in, nin, key, output, out, sflag, nflag) + +pointer inlist #I input image template +pointer in[nin] #O input image descriptor array +int nin #I size of the array (4) +char key[ARB] #I keyword for polarizer angle +char output[ARB] #I output image name +pointer out #O output image descriptor +bool sflag #I include stokes frames in output? +bool nflag #I normalize the stokes frames? + +pointer input, im_tmp, sp +real pol +int i, j, ipol, ndim +long axis[IM_MAXDIM] +bool firsttime + +int imtgetim() +real imgetr() +pointer immap() +bool fp_equalr() + +errchk immap, imgetr, imdelf + +begin + # for graceful error recovery + im_tmp = NULL + out = NULL + do i = 1, nin + in[i] = NULL + + + call smark (sp) + call salloc (input, SZ_FNAME, TY_CHAR) + + iferr { + while (imtgetim (inlist, Memc[input], SZ_FNAME) != EOF) { + im_tmp = immap (Memc[input], READ_ONLY, 0) + + if (IM_NDIM(im_tmp) > 2) + call error (1, "only 1 or 2 dimensional images allowed") + + pol = imgetr (im_tmp, key) + + if (pol < 0 || pol > 135 || mod (nint(pol), 45) != 0 || + ! fp_equalr (pol, real(nint(pol)))) { + call eprintf ("image %s, %s must be 0,45,90,135 degrees\n") + call pargstr (Memc[input]) + call pargstr (key) + call flush (STDERR) + call error (1, "task LINPOL") + } + + # index into in pointer array + ipol = max (1, min (nin, 1 + int(pol) / 45)) + + if (in[ipol] == NULL) { + in[ipol] = im_tmp + im_tmp = NULL + } else { + call eprintf ("multiple images specified at %d degrees\n") + call pargi ((ipol-1) * 45) + call flush (STDERR) + call error (1, "task JOIN") + } + } + + # check dimensionality + firsttime = true + do i = 1, nin { + if (in[i] == NULL) + next + + if (firsttime) { + ndim = IM_NDIM(in[i]) + do j = 1, IM_MAXDIM + axis[j] = IM_LEN(in[i],j) + firsttime = false + next + } + + if (IM_NDIM(in[i]) != ndim) + call error (1, "images are different sizes") + + do j = 1, ndim + if (IM_LEN(in[i],j) != axis[j]) + call error (1, "images are different sizes") + } + + # create the output polarization (hyper) cube + # just copy header from first image available + do i = 1, nin + if (in[i] != NULL) { + out = immap (output, NEW_COPY, in[i]) + break + } + + # increase the image's girth + IM_NDIM(out) = ndim + 1 + for (i=1; i <= ndim; i=i+1) + IM_LEN(out,i) = axis[i] + + if (sflag) + IM_LEN(out,i) = 5 + else + IM_LEN(out,i) = 2 + + call strcpy (LP_TITLE, IM_TITLE(out), SZ_IMTITLE) + + # delete the polarizer angle keyword + call imdelf (out, key) + + # add keywords naming the input images + do i = 1, nin { + if (in[i] == NULL) + next + + call sprintf (Memc[input], SZ_FNAME, "%s%d") + call pargstr (LP_IMKEY) + call pargi (45*(i-1)) + + call imastr (out, Memc[input], IM_HDRFILE(in[i])) + } + + # add keywords to index output frames + call imastr (out, LP_PKEY, LP_PSTR) + call imastr (out, LP_AKEY, LP_ASTR) + + if (sflag) { + call imastr (out, LP_IKEY, LP_ISTR) + if (nflag) { + call imastr (out, LP_QKEY, LP_QSTRN) + call imastr (out, LP_UKEY, LP_USTRN) + } else { + call imastr (out, LP_QKEY, LP_QSTR) + call imastr (out, LP_UKEY, LP_USTR) + } + } + + } then { + if (im_tmp != NULL) + call imunmap (im_tmp) + call sfree (sp) + call erract (EA_ERROR) + } + + # start off with a clean slate + call imflush (out) + call sfree (sp) +end + + +# LP_UNMAP -- unmap the set of input images. + +procedure lp_unmap (in, nin, out) + +pointer in[nin] #U input image pointer array +int nin #I size of the array (4) +pointer out #U output image pointer + +int i + +begin + do i = 1, nin + if (in[i] != NULL) + call imunmap (in[i]) + + if (out != NULL) + call imunmap (out) +end + + +# LP_POLARIZE -- calculate the polarization given at least 3 of the 4 +# possible frames taken with the polarizer at 45 degree increments. + +procedure lp_polarize (in, nin, out, dflag, sflag, nflag) + +pointer in[nin] #I input image pointer array +int nin #I size of the array (4) +pointer out #I output image pointer +bool dflag #I report the angle in degrees? +bool sflag #I include stokes frames in output? +bool nflag #I normalize the stokes frames? + +pointer ibuf, qbuf, ubuf, sp +pointer buf1, buf2, buf3, buf4 +long v1[IM_MAXDIM], v2[IM_MAXDIM], v3[IM_MAXDIM], v4[IM_MAXDIM] +int line, npix, skip, i + +int imgnlr() + +begin + npix = IM_LEN(out,1) + + call smark (sp) + call salloc (ibuf, npix, TY_REAL) + call salloc (qbuf, npix, TY_REAL) + call salloc (ubuf, npix, TY_REAL) + + call amovkl (long(1), v1, IM_MAXDIM) + call amovkl (long(1), v2, IM_MAXDIM) + call amovkl (long(1), v3, IM_MAXDIM) + call amovkl (long(1), v4, IM_MAXDIM) + + # choose the combining scheme + skip = 0 + do i = 1, nin + if (in[i] == NULL) { + skip = i + break + } + + # not worth generalizing the method, just duplicate the code... + switch (skip) { + + case 0: + # I = (im0 + im45 + im90 + im135) / 4 + # Q = (im0 - im90) / 2 + # U = (im45 - im135) / 2 + while (imgnlr (in[1], buf1, v1) != EOF && + imgnlr (in[2], buf2, v2) != EOF && + imgnlr (in[3], buf3, v3) != EOF && + imgnlr (in[4], buf4, v4) != EOF) { + + call aaddr (Memr[buf1], Memr[buf2], Memr[ibuf], npix) + call aaddr (Memr[buf3], Memr[ibuf], Memr[ibuf], npix) + call aaddr (Memr[buf4], Memr[ibuf], Memr[ibuf], npix) + call adivkr (Memr[ibuf], 4., Memr[ibuf], npix) + + call asubr (Memr[buf1], Memr[buf3], Memr[qbuf], npix) + call adivkr (Memr[qbuf], 2., Memr[qbuf], npix) + + call asubr (Memr[buf2], Memr[buf4], Memr[ubuf], npix) + call adivkr (Memr[ubuf], 2., Memr[ubuf], npix) + + line = int(v1[2]) - 1 + call lp_stokes (Memr[ibuf], Memr[qbuf], Memr[ubuf], + npix, out, line, dflag, sflag, nflag) + } + + case 1: + # I = (im45 + im135) / 2 + # Q = I - im90 + # U = (im45 - im135) / 2 + while (imgnlr (in[2], buf2, v2) != EOF && + imgnlr (in[3], buf3, v3) != EOF && + imgnlr (in[4], buf4, v4) != EOF) { + + call aaddr (Memr[buf2], Memr[buf4], Memr[ibuf], npix) + call adivkr (Memr[ibuf], 2., Memr[ibuf], npix) + + call asubr (Memr[ibuf], Memr[buf3], Memr[qbuf], npix) + + call asubr (Memr[buf2], Memr[buf4], Memr[ubuf], npix) + call adivkr (Memr[ubuf], 2., Memr[ubuf], npix) + + line = int(v2[2]) - 1 + call lp_stokes (Memr[ibuf], Memr[qbuf], Memr[ubuf], + npix, out, line, dflag, sflag, nflag) + } + + case 2: + # I = (im0 + im90) / 2 + # Q = (im0 - im90) / 2 + # U = I - im135 + while (imgnlr (in[1], buf1, v1) != EOF && + imgnlr (in[3], buf3, v3) != EOF && + imgnlr (in[4], buf4, v4) != EOF) { + + call aaddr (Memr[buf1], Memr[buf3], Memr[ibuf], npix) + call adivkr (Memr[ibuf], 2., Memr[ibuf], npix) + + call asubr (Memr[buf1], Memr[buf3], Memr[qbuf], npix) + call adivkr (Memr[qbuf], 2., Memr[qbuf], npix) + + call asubr (Memr[ibuf], Memr[buf4], Memr[ubuf], npix) + + line = int(v1[2]) - 1 + call lp_stokes (Memr[ibuf], Memr[qbuf], Memr[ubuf], + npix, out, line, dflag, sflag, nflag) + } + + case 3: + # I = (im45 + im135) / 2 + # Q = im0 - I + # U = (im45 - im135) / 2 + while (imgnlr (in[1], buf1, v1) != EOF && + imgnlr (in[2], buf2, v2) != EOF && + imgnlr (in[4], buf4, v4) != EOF) { + + call aaddr (Memr[buf2], Memr[buf4], Memr[ibuf], npix) + call adivkr (Memr[ibuf], 2., Memr[ibuf], npix) + + call asubr (Memr[buf1], Memr[ibuf], Memr[qbuf], npix) + + call asubr (Memr[buf2], Memr[buf4], Memr[ubuf], npix) + call adivkr (Memr[ubuf], 2., Memr[ubuf], npix) + + line = int(v1[2]) - 1 + call lp_stokes (Memr[ibuf], Memr[qbuf], Memr[ubuf], + npix, out, line, dflag, sflag, nflag) + } + + case 4: + # I = (im0 + im90) / 2 + # Q = (im0 - im90) / 2 + # U = im45 - I + while (imgnlr (in[1], buf1, v1) != EOF && + imgnlr (in[2], buf2, v2) != EOF && + imgnlr (in[3], buf3, v3) != EOF) { + + call aaddr (Memr[buf1], Memr[buf3], Memr[ibuf], npix) + call adivkr (Memr[ibuf], 2., Memr[ibuf], npix) + + call asubr (Memr[buf1], Memr[buf3], Memr[qbuf], npix) + call adivkr (Memr[qbuf], 2., Memr[qbuf], npix) + + call asubr (Memr[buf2], Memr[ibuf], Memr[ubuf], npix) + + line = int(v1[2]) - 1 + call lp_stokes (Memr[ibuf], Memr[qbuf], Memr[ubuf], + npix, out, line, dflag, sflag, nflag) + } + + } + + call sfree(sp) +end + + +# LP_STOKES -- calculate the fractional polarization and angle for a +# specific line (from the stokes parameters) and output the results. + +procedure lp_stokes (i, q, u, npix, out, line, dflag, sflag, nflag) + +real i[ARB] #I Stokes I vector +real q[ARB] #I Stokes Q vector +real u[ARB] #I Stokes U vector +int npix #I length of the vectors +pointer out #I output image descriptor +int line #I line number +bool dflag #I convert to degrees? +bool sflag #I include stokes frames in output? +bool nflag #I normalize the stokes frames? + +pointer pbuf, abuf, sp + +pointer impl3r() +real lp_errfcn() +extern lp_errfcn + +begin + call smark (sp) + call salloc (pbuf, npix, TY_REAL) + call salloc (abuf, npix, TY_REAL) + + call lp_pol (i, q, u, Memr[pbuf], npix) + call lp_ang (q, u, Memr[abuf], npix, dflag) + + call amovr (Memr[pbuf], Memr[impl3r (out, line, LP_PBAND)], npix) + call amovr (Memr[abuf], Memr[impl3r (out, line, LP_ABAND)], npix) + + if (sflag) { + call amovr (i, Memr[impl3r (out, line, LP_IBAND)], npix) + if (nflag) { + call advzr (q, i, q, npix, lp_errfcn) + call advzr (u, i, u, npix, lp_errfcn) + } + call amovr (q, Memr[impl3r (out, line, LP_QBAND)], npix) + call amovr (u, Memr[impl3r (out, line, LP_UBAND)], npix) + } + + call sfree (sp) +end + + +# LP_POL -- calculate the fractional linear polarization for a vector, +# given the stokes I, Q, and U vectors. + +procedure lp_pol (i, q, u, p, npix) + +real i[ARB] #I Stokes I vector +real q[ARB] #I Stokes Q vector +real u[ARB] #I Stokes U vector +real p[ARB] #O fractional polarization vector +int npix #I length of the vectors + +pointer tmp, sp + +real lp_errfcn() +extern lp_errfcn + +begin + call smark (sp) + call salloc (tmp, npix, TY_REAL) + + call amulr (q, q, p, npix) + call amulr (u, u, Memr[tmp], npix) + call aaddr (p, Memr[tmp], p, npix) + call asqrr (p, p, npix, lp_errfcn) + call advzr (p, i, p, npix, lp_errfcn) + + call sfree (sp) +end + + +# LP_ERRFCN -- error function for the square root of negative numbers. + +real procedure lp_errfcn (x) + +real x + +begin + return (0.) +end + + +# LP_ANG -- calculate the polarization angle, given the Stokes params. + +procedure lp_ang (q, u, a, npix, dflag) + +real q[ARB] #I Stokes Q vector +real u[ARB] #I Stokes U vector +real a[ARB] #O polarization angle vector +int npix #I length of the vectors +bool dflag #I convert to degrees? + +define PI 3.14159265358979 +define RAD2DEG (180./PI) + +begin + call lp_aatn2r (u, q, a, npix) + call adivkr (a, 2., a, npix) + + if (dflag) + call amulkr (a, RAD2DEG, a, npix) +end + + +# LP_AATN2R -- calculate the arctangent in the proper quadrant. + +procedure lp_aatn2r (y, x, a, npix) + +real y[ARB], x[ARB] #I numerator and denominator, respectively +real a[ARB] #O arctangent vector (radians) + +int npix, i + +begin + do i = 1, npix { + a[i] = atan2 (y[i], x[i]) + } +end diff --git a/noao/nproto/t_slitpic.x b/noao/nproto/t_slitpic.x new file mode 100644 index 00000000..e35a5575 --- /dev/null +++ b/noao/nproto/t_slitpic.x @@ -0,0 +1,286 @@ +include <ctype.h> +include <imhdr.h> +include "slitpic.h" + +# T_SLITPIC -- generates image to be used as a mask for making aperture plates. +# Positions of slits have already been calculated and are read from "tape1". +# If the user wants to generate a dicomed print of the mask with crtpict, a +# command file to be used as input to task crtpict can be generated. + +procedure t_slitpic () + +pointer im +char site[SZ_LINE], pix_date[SZ_LINE], output_root[SZ_FNAME], tape1[SZ_FNAME] +char serial_numbers[SZ_LINE], cmd_root[SZ_FNAME], cmd_file[SZ_FNAME] +char id_string[LEN_IDSTRING], suffix[SZ_LINE], image_name[SZ_FNAME] +int serial[3, MAX_RANGES], stat, find_slits(), jj, junk +int nserial, fd, this_number, n_slits, slits[MAX_SLITS, N_PARAMS] +real pixel_scale, plate_scale, slit_width + +pointer immap() +bool clgetb() +int decode_ranges(), strncmp(), open(), itoc() +real clgetr() + +begin + # Get parameters from cl + call clgstr ("site", site, SZ_LINE) + if (strncmp (site, "kpno", 1) == 0 || strncmp (site, "KPNO", 1) == 0) + plate_scale = PSCALE + else if (strncmp (site, "ctio",1) == 0 || strncmp (site, "CTIO",1) == 0) + plate_scale = CPSCALE + else { + call eprintf ("Unknown site: %s Try again.\n") + call pargstr (site) + return + } + + call clgstr ("output_root", output_root, SZ_FNAME) + call clgstr ("pix_date", pix_date, SZ_LINE) + pixel_scale = clgetr ("pixel_scale") + slit_width = clgetr ("slit_width") + call clgstr ("tape1", tape1, SZ_FNAME) + fd = open (tape1, READ_ONLY, TEXT_FILE) + + # Serial numbers to be processed are entered as a range. + call clgstr ("serial_numbers", serial_numbers, SZ_LINE) + if (decode_ranges (serial_numbers, serial, MAX_RANGES, nserial) == ERR) + call error (0, "Error in specifying range of serial numbers") + + for (jj = 1; jj <= nserial; jj = jj + 1) { + stat = find_slits (fd, serial, pixel_scale, plate_scale, + slit_width, slits, n_slits, id_string, this_number) + + if (stat == EOF) + return + + # Generate unique output file names if more than one serial number + call strcpy (output_root, image_name, SZ_FNAME) + call strcpy (cmd_root, cmd_file, SZ_FNAME) + if (nserial > 1) { + junk = itoc (this_number, suffix, SZ_LINE) + call strcat (suffix, image_name, SZ_FNAME) + call strcat (suffix, cmd_file, SZ_FNAME) + } + + im = immap (image_name, NEW_IMAGE, LEN_USER_AREA) + call strupr (pix_date) + call sprintf (IM_TITLE(im), SZ_LINE, + "SN=%d, SW=%0.2f, PS=%0.4f, PD=%s, %s") + call pargi (this_number) + call pargr (slit_width) + call pargr (pixel_scale) + call pargstr (pix_date) + call pargstr (id_string) + call write_image (im, slits, n_slits, plate_scale, pixel_scale) + if (clgetb ("crtpict")) + call write_crtpict_cards (cmd_file, site, this_number, + slit_width, image_name, pixel_scale, pix_date) + call imunmap (im) + } +end + + +int procedure find_slits (fd, serial, pixel_scale, plate_scale, slit_width, + slits, n_slits, id_string, this_number) + +int fd +int serial[ARB] +int slits[MAX_SLITS, N_PARAMS] +real slit_width +int this_number + +char keyword[LEN_KEYWORD], card_image[SZ_LINE], equal[LEN_KEYWORD] +char id_string[LEN_IDSTRING] +int serial_number, i, n_slits, ip, dummy, limit, j, jnext +real xpos_lo, xpos_hi, ypos, pixel_scale, plate_scale +bool streq(), is_in_range() +int fscan(), ctor() + +begin + # Read card images until a SERIAL keyword is found: + repeat { + if (fscan (fd) == EOF) + return (EOF) + call gargwrd (keyword, LEN_KEYWORD) + if (streq (keyword, "SERIAL")) { + call gargwrd (equal, LEN_KEYWORD) + call gargi (serial_number) + call printf ("Serial number %d seen\n") + call pargi (serial_number) + call flush (STDOUT) + if (is_in_range (serial, serial_number)) { + this_number = serial_number + break + } + } + } + + # Now positioned at proper entry, find NS2 keyword and slit locations: + # This assumes keyword OBJECT always preceedes NS2. + repeat { + if (fscan (fd) == EOF) + return (EOF) + call gargwrd (keyword, LEN_KEYWORD) + if (streq (keyword, "OBJECT")) { + call gargwrd (equal, LEN_KEYWORD) + call gargwrd (id_string, LEN_IDSTRING) + next + } + if (streq (keyword, "NS2")) { + call gargwrd (equal, LEN_KEYWORD) + call gargi (n_slits) + break + } + } + + do i = 1, n_slits { + if (fscan (fd) == EOF) + return (EOF) + else + call gargstr (card_image, SZ_LINE) + + ip = START_COLUMN + dummy = ctor (card_image, ip, xpos_lo) + ip = ip + 8 + dummy = ctor (card_image, ip, xpos_hi) + dummy = ctor (card_image, ip, ypos) + call calculate_slit_pos (xpos_lo, xpos_hi, ypos, slits, i, + pixel_scale, plate_scale, slit_width) + } + + # Sort slits array in order of increasing x - bubble sort + for (limit = n_slits - 1; limit >= 1; limit = limit - 1) { + do j = 1, limit { + jnext = j + 1 + if (slits [j,2] >= slits [jnext, 2]) + call swap (jnext, j, slits) + } + } +end + + +# CALCULATE_SLIT_POS -- calculate position of slit and store results +# in array "slits". This procedure is called once for each slit. + +procedure calculate_slit_pos (xplo, xphi, yp, slits, slit_num, pixel_scale, + plate_scale, slit_width) + +real xplo, xphi, yp +int slits[MAX_SLITS, N_PARAMS], slit_num + +int x_lo, x_hi, ycen, ys, y_lo, y_hi +int upper_ys, lower_ys +real pixel_scale, plate_scale, slit_width + +begin + x_lo = int ((XY_ZERO_PT + xplo) / pixel_scale * plate_scale + 0.5) + 1 + x_hi = int ((XY_ZERO_PT + xphi) / pixel_scale * plate_scale + 0.5) - 1 + ycen = int ((XY_ZERO_PT + yp) / pixel_scale * plate_scale + 0.5) + ys = int ((slit_width / pixel_scale) + 0.5) + + # The following 4 statements were added june25,1985 at Jim's request, + # and are intended to correct for rounding problems with slit width. + lower_ys = ys / 2 + upper_ys = lower_ys + if ((ys - lower_ys) > lower_ys) + upper_ys = lower_ys + 1 + + # Next 2 statements modified at time of above change + #y_lo = ycen - ys + #y_hi = ycen + ys - 1 + y_lo = ycen - lower_ys + y_hi = ycen + upper_ys - 1 + + slits [slit_num, 1] = slit_num + slits [slit_num, 2] = x_lo + slits [slit_num, 3] = x_hi + slits [slit_num, 4] = y_lo + slits [slit_num, 5] = y_hi +end + + +# SWAP -- swaps entries in input array; used for bubble sort. + +procedure swap (new, old, slits) + +int new, old # New and old indices to be swapped +int slits [MAX_SLITS, N_PARAMS] # Array of slit endpoints and index + +int n +real temp[N_PARAMS] + +begin + do n = 1, N_PARAMS { + temp[n] = slits [new, n] + slits [new, n] = slits [old, n] + slits [old, n] = temp[n] + } +end + + +# WRITE_IMAGE -- writes two dimensional image of slit mask. Slits and the +# area outside the circular field are clear; other mask areas are saturated. +# All pixel values are either clear (0) or saturated (255). + +procedure write_image (im, slits, n_slits, plate_scale, pixel_scale) + +pointer im, sp, row +int slits[MAX_SLITS, N_PARAMS] +int n_slits +real plate_scale, pixel_scale + +int center, size, n, mask_radius, edge_1, edge_2, k, i +pointer impl2s() + +begin + # First, set some image header parameters + call smark (sp) + size = int ((XY_ZERO_PT * 2.0 * plate_scale / pixel_scale) + 2.0 + 0.5) + call salloc (row, size, TY_SHORT) + IM_PIXTYPE(im) = TY_SHORT + IM_LEN(im, 1) = size + IM_LEN(im, 2) = size + + center = (size / 2) + 1 + do n = 1, size { + mask_radius = int (sqrt (real ((center**2) - ((center - n)**2)))) + edge_1 = center - mask_radius + edge_2 = center + mask_radius + + do i = 1, edge_1 - 1 + Mems[row+i-1] = CLEAR + + do i = edge_2 + 1, size + Mems[row+i-1] = CLEAR + + do i = edge_1, edge_2 + Mems[row+i-1] = SATURATE + + do i = 1, n_slits { + if ((n >= slits[i,2]) && (n <= slits[i,3])) { + # Set slitlet area to 0 + edge_1 = slits [i, 4] + edge_2 = slits [i, 5] + do k = edge_1, edge_2 - 1 + Mems[row+k-1] = CLEAR + } + } + + # Now output accumulated row to IRAF image + call amovs (Mems[row], Mems[impl2s(im, n)], size) + } + call sfree (sp) +end + + +procedure write_crtpict_cards (cmd_file, site, this_number, slit_width, + image_name, pixel_scale, date) + +char cmd_file[SZ_FNAME], site[SZ_LINE], image_name[SZ_FNAME], date[SZ_LINE] +int this_number +real slit_width, pixel_scale + +begin + # Generate command cards for execution of crtpict +end diff --git a/noao/nproto/x_nproto.x b/noao/nproto/x_nproto.x new file mode 100644 index 00000000..b2ba14fa --- /dev/null +++ b/noao/nproto/x_nproto.x @@ -0,0 +1,10 @@ +# Task declaration for the LOCAL package. + +task binpairs = t_binpairs, + detect = t_acedetect, + iralign = t_iralign, + irmatch1d = t_irmatchd1, + irmatch2d = t_irmatchd2, + irmosaic = t_irmosaic, + linpol = t_linpol, + slitpic = t_slitpic |