diff options
| author | Joe Hunkeler <jhunkeler@gmail.com> | 2015-08-11 16:51:37 -0400 |
|---|---|---|
| committer | Joe Hunkeler <jhunkeler@gmail.com> | 2015-08-11 16:51:37 -0400 |
| commit | 40e5a5811c6ffce9b0974e93cdd927cbcf60c157 (patch) | |
| tree | 4464880c571602d54f6ae114729bf62a89518057 /noao/imred/ccdred | |
| download | iraf-osx-40e5a5811c6ffce9b0974e93cdd927cbcf60c157.tar.gz | |
Repatch (from linux) of OSX IRAF
Diffstat (limited to 'noao/imred/ccdred')
260 files changed, 47950 insertions, 0 deletions
diff --git a/noao/imred/ccdred/Revisions b/noao/imred/ccdred/Revisions new file mode 100644 index 00000000..982ed391 --- /dev/null +++ b/noao/imred/ccdred/Revisions @@ -0,0 +1,1236 @@ +.help revisions Jun88 noao.imred.ccdred +.nf +t_ccdgroups.x +t_ccdhedit.x +t_ccdinst.x +t_ccdlist.x +t_ccdproc.x +t_combine.x +t_mkfringe.x +t_mkillumcor.x +t_mkillumft.x +t_mkskycor.x +t_mkskyflat.x + Added a check that the filename given to the hdmopen() procedure wasn't + empty. This provides a more informative error message than the "floating + invalid operation' one gets now when e.g. no 'instrument' file is + specified (10/12/13, MJF) + +src/ccdcache.x + The 'bufs' pointer was declared as TY_REAL instead of TY_SHORT (5/4/13) + +t_cosmicrays.x + A pointer to a an array of pointers was used in one place as a real. This + is an error when integer and real arrays are not of the same size; i.e. + on 64-bit architectures. (8/2/12, Valdes) + +======= +V2.16.1 +======= + +various + Separated the generic combine code to a subdirectory as is done + for imcombine, mscred, etc. This is only a partial step towards + sharing the standard imcombine code. Because this is really old, + working code that has diverged significantly it will take some time + to update/merge the new imcombine code. (1/6/11, Valdes) + +===== +V2.15 +===== + +src/icstat.gx + Fixed type declarations for the asum() procedures (8/25/09, MJF) + +doc/ccdproc.hlp + Removed the statements that calibration images are not reprocessed + if they have CCDPROC even if they lack the keywords for specific + operations. I looked at the code and did not see much dependence + on CCDPROC though there could be something I'm missing. For now, + since a user reported this, I will assume the behavior reported by + the user is correct and the documentation is wrong for some historical + reason. (5/27/08, Valdes) + +x_ccdred.x + Added the alias qccdproc for use in the quadred.quadproc task. + (3/12/08, Valdes) + +===== +V2.14 +===== + +======= +V2.12.2 +======= + +ccdred/ccdred.hd + Hooked up help pages for ccdtest package. (2/14/04, Valdes) + +ccdred/ccdtest/t_mkimage.x + Removed unused variable. (8/8/02, Valdes) + +ccdred/src/icscale.x + Error dereferencing a string pointer. (8/8/02, Valdes) + +ccdred/src/t_mkfringe.x +ccdred/src/t_mkillumcor.x +ccdred/src/t_mkillumft.x +ccdred/src/t_mkskycor.x +ccdred/src/t_mkskyflat.x + There was a confusion with the "output" parameter which is also in + the ccdproc pset. Each task now explicitly calls its own output + parameter. (7/31/02, Valdes) + +======= +V2.12.1 +======= + +===== +V2.12 +===== + +ccdred/src/icsetout.x + When computing offsets the registration point was the reference pixel + returned by mw_gwterm for the first image. The code then went on to + assume this was a logical pixel when comparing with the other images, + which is not true when there is a physical coordinate system. The + algorithm was fixed by converting the reference point to logical + coordinates. (4/18/02, Valdes) + +ccdred/src/t_ccdmask.x + Fixed bug where the if the last line or last column had a bad pixel + without a neighboring interior pixel then the mask value would be + some number corresponding to the number of pixels in that last line + or column. (2/28/02, Valdes) + +ccdred/ccdred.cl +ccdred/ccdred.men +ccdred/ccdred.hd +ccdred/src/mkpkg +ccdred/x_ccdred.x + Removed COSMICRAYS from package tasks. The source is still not + removed. (8/22/01, Valdes) + +ccdred/src/setdark.x + Added a check for a zero divide in calculating the dark time scaling + which results in an appropriate error message. (7/5/01, Valdes) + +======== +V2.11.3b +======== + +t_combine.x + Modified the conversion of pclip from a fraction to a number of images + because for even number of images the number above/below the median + is one too small. (9/26/00, Valdes) + +ccdred/src/icmedian.gx + Replaced with faster Wirth algorithm. (5/16/00, Valdes) + +ccdred/src/icgdata.gx +ccdred/src/iclog.x +ccdred/src/icmask.x +ccdred/src/icombine.gx +ccdred/src/icscale.x +ccdred/src/icsetout.x + Changed declarations for the array "out" to be ARB rather than 3 in + some places (because it was not changed when another element was added) + or 4. This will insure that any future output elements added will + no require changing these arguments for the sake of cosmetic correctness. + (1/13/99, Valdes) + +ccdred/src/t_combine.x + Added workaround for error recovery problem that loses the error + message. (10/21/99, Valdes) + +ccdred$doc/ccdproc.hlp + The overscan type name was incorrectly given as "average" instead of + "mean". This was corrected in the documentation. (10/15/99, Valdes) + +ccdred$src/generic/mkpkg +ccdred$src/cosmic/mkpkg +ccdred$src/mkpkg + Added missing dependencies. (10/11/99, Valdes) + +======= +V2.11.2 +======= + +ccdred$src/t_ccdlist.x + Date accidentally changed. File not modified. (5/13/99, Valdes) + +ccdred$doc/ccdproc.hlp +ccdred$doc/mkskyflat.hlp + Fixed minor formating problems. (4/22/99, Valdes) + +ccdred$src/imcombine/icsetout.x + The updating of the WCS for offset images was not being done correctly. + (10/6/98, Valdes) + +ccdred$src/t_ccdmask.x + The overlapping of groups of columns was not quite working because + you can't overlap imp... calls. (9/10/98, Valdes) + +ccdred$src/t_ccdproc.x +ccdred$ccdproc.par +ccdred$doc/ccdproc.hlp +ccdred$darkcombine.cl +ccdred$flatcombine.cl +ccdred$zerocombine.cl + 1. Added output image option to CCDPROC. + 2. The combine scripts all still do in place processing. + (6/19/98, Valdes) + +ccdred$doc/ccdproc.hlp + Fixed font change typo in Revisions section. (6/16/98, Valdes) + +ccdred$src/t_ccdmask.x + The test for a bad pixel used && instead of ||. (4/24/98, Valdes) + +======= +V2.11.1 +======= + +ccdred$src/icscale.x +ccdred$doc/combine.hlp + When zero offsets or weights are specified in a file the weights + are not modified for zero offsets. (10/3/97, Valdes) + +ccdred$src/setoutput.x + It is now allowed to go from ushort input to short output. + (9/29/97, Valdes) + +ccdred$src/t_combine.x + Fixed a segmentation violation caused by attempting to close the + mask data structures during error recovery when the error occurs + before the data structures are defined. (8/14/97, Valdes) + +ccdred$src/cosmic/crfind.x +ccdred$src/cosmic/crlist.x + Changed arguments with adjustable arrays to use ARB. (8/6/97, Valdes) + +ccdred$src/setsections. + Generalized the LTERM update to work with arbitrary WCSDIM. + (7/24/97, Valdes) + +ccdred$src/ccdcheck.x + No change except date modified. + (7/17/97, Valdes) + +===== +V2.11 +===== + +ccdred$src/setoverscan.x +ccdred$src/proc.gx +ccdred$src/ccdred.h +ccdred$doc/ccdproc.hlp + The overscan fitting function now allows "average", "median", and "minmax" + for line-by-line overscan determination. + (2/21/97, Valdes) + +ccdred$src/setfixpix.x +ccdred$src/setproc.x +ccdred$src/proc.gx +ccdred$src/setsections.x +ccdred$src/setheader.x +ccdred$src/ccdred.h +ccdred$src/corinput.gx - +ccdred$src/generic/corinput.x - +ccdred$src/mkpkg +ccdred$src/generic/mkpkg +ccdred$doc/ccdproc.hlp + The bad pixel fixing is now done with the new fixpix routines from xtools. + As part of this the physical coordinate system is set to be that of + the CCD. + (2/21/97, Valdes) + +ccdred$src/t_ccdmask.x + +ccdred$ccdmask.par + +ccdred$doc/ccdmask.hlp + +ccdred$src/mkpkg +ccdred$ccdred.cl +ccdred$ccdred.hd +ccdred$ccdred.men +ccdred$x_ccdred.x + A new task, CCDMASK, has been added. This task finds deviant pixels + in CCD data and creates a pixel mask. (2/21/97, Valdes) + +ccdred$src/icscale.x + The ccdmean keyword is now updated rather than deleted. However + the ccdmeant keyword is delete to force a later computation if needed. + (1/7/97, Valdes) + +ccdred$src/icsetout.x +ccdred$doc/combine.hlp + A new option for computing offsets from the image WCS has been added. + (1/7/97, Valdes) + +ccdred$src/icmask.x +ccdred$src/iclog.x +ccdred$src/icombine.com +ccdred$src/icmask.h + +ccdred$src/icmask.com - + Changed to use a mask structure. (1/7/97, Valdes) + +ccdred$src/t_combine.x +ccdred$src/icombine.gx +ccdred$src/icimstack.x + +ccdred$src/iclog.x +ccdred$src/mkpkg +ccdred$doc/combine.hlp + The limit on the maximum number of images that can be combined, set by + the maximum number of logical file descriptors, has been removed. If + the condition of too many files is detected the task now automatically + stacks all the images in a temporary image and then combines them with + the project option. + + The project option probably did not work previously. May not still + work. + (1/7/97, Valdes) + +ccdred$src/icsort.gx + There was an error in the ic_2sort routine when there are exactly + three images that one of the explicit cases did not properly keep + the image identifications. See buglog 344. (1/17/97, Valdes) + +ccdred$src/calimage.x + The use of SZ_SUBSET-1 can cause problems because the names are + unique to SZ_SUBSET but if unique part is the SZ_SUBSET character + this causes problems. (1/17/97, Valdes) + +========== +V2.10.4-p2 +========== + +ccdred$src/icpclip.gx + Fixed a bug where a variable was improperly used for two different + purposes causing the algorithm to fail (bug 316). (10/19/95, Valdes) + +ccdred$src/cosmic/crlist.x + The output bad pixel data accidentally included some extra fields + making it incorrect to use the file directly with BADPIXIMAGE. + The extra diagnostic fields were removed. (9/25/95, Valdes) + +ccdred$src/cosmic/t_cosmicrays.x + Added a test for interactive mode before opening the graphics + stream and whether to call the training routine. This change + was needed to allow the task to run non-interactively on + dumb, non-graphics terminals. (7/24/95, Valdes) + +======= +V2.10.4 +======= + +ccdred$src/t_combine.x + If an error occurs while opening an input image header the error + recovery will close all open images and then propagate the error. + For the case of running out of file descriptors with STF format + images this will allow the error message to be printed rather + than the error code. (4/3/95, Valdes) + +ccdred$src/icscale.x +ccdred$doc/combine.hlp + The behavior of the weights when using both multiplicative and zero + point scaling was incorrect; the zero levels have to account for + the scaling. (3/27/95, Valdes) + +ccdred$src/cosmic/t_cosmicrays.x + There was an error in setting the x,y coordinates of the window + such that it left some of the coordinates undefined. This causes + an FPE on the Alpha. (2/17/94, Valdes) + +ctype.h +ccdred$src/ccdsubsets.x + Change the test for non-filename characters to map all characters + but alphabetic, numbers, and period to '_'. (2/17/95, Valdes) + +ccdred$src/proc.gx + The asum$t function was not properly declared. (9/13/94, Valdes) + +ccdred$src/t_mkfringe.x +ccdred$src/t_mkillumcor.x +ccdred$src/t_mkillumft.x +ccdred$src/t_mkskycor.x +ccdred$src/t_mkskyflat.x + Added calls to ccd_open/ccd_close in order to initialize the image + caching even if images are not actually cached. (9/13/94, Valdes) + +ccdred$src/cosmic/t_cosmicrays.x +ccdred$src/cosmic/crexamine.x +ccdred$doc/cosmicrays.hlp + 1. A new parameter was added to the crexamine subroutine in the + previous modification for "training" the program. In the + subroutine the parameter was used as a modifyable parameter but it + was being called with a fixed constant. The effect was the costant + value was no longer correct after the first execution and the + program would act as if a 'q' was typed after the first interactive + execution. This was fixed to treat the input argument as input + only. + 2. The help page now emphasizes that the "answer" parameter is not + to be used on the command line and if it is then the task will + ignored the value and act as if the user always responds with + "yes". + (8/17/94, Valdes) + +ccdred/src/cosmic/t_cosmicrays.x +ccdred/src/cosmic/crfind.x +ccdred/src/cosmic/crexamine.x +ccdred/src/cosmic/crlist.x +ccdred/src/cosmic/crlist.h +ccdred/cosmicrays.par +ccdred/doc/cosmicrays.hlp +noao$lib/scr/cosmicrays.key + Added some new parameters and a new functionality to allow setting + the flux ratio threshold by training with respect to a user supplied + list of classifications. Normally the list would be the image + display cursor. (6/29/94, Valdes) + +ccdred/src/cosmic/t_cosmicrays.x + Added an imflush() and imseti() after the initial copy of the input + image to the output is done and before the random access to replace + the detected cosmic rays. The imseti sets the image I/O advice to + RANDOM. (6/24/94, Valdes) + +ccdred/src/ccdcheck.x +ccdred/src/ccdmean.x +ccdred/src/setheader.x +ccdred/src/scancor.x +ccdred/src/setillum.x +ccdred/src/t_mkillumcor.x +ccdred/src/t_mkfringe.x +ccdred/src/t_mkskycor.x +ccdred/src/t_mkillumft.x +ccdred/src/t_mkskyflat.x +ccdred/doc/ccdproc.hlp +ccdred/doc/ccdinst.hlp + Added a CCDMEANT keyword giving the time when the CCDMEAN value was + calculated. Routines that later access this keyword check this time + against the image modify time to determine whether to invalidate + the value and recompute it. This solves the problem of people + modifying the image outside the CCDRED package and possibly using + an incorrect scaling value. For backwards compatiblity if the + new keyword is missing it is assumed to be same as the modify time; + i.e. the CCDMEAN keyword is valid. (6/22/94, Valdes) + +ccdred/src/t_mkillumcor.x +ccdred/src/t_mkillumft.x +ccdred/src/t_mkskycor.x +ccdred/src/t_mkskyflat.x + Added an extra argument to the millumination subroutine to specify + whether to print log information. This is because this procedure + is used as an intermediate step in things like the fringe correction + the message is confusing to users. (6/21/94, Valdes) + + +ccdred/src/icaclip.gx +ccdred/src/iccclip.gx +ccdred/src/icpclip.gx +ccdred/src/icsclip.gx + 1. The restoration of deleted pixels to satisfy the nkeep parameter + was being done inside the iteration loop causing the possiblity + of a non-terminating loop; i.e. pixels are rejected, they are + restored, and the number left then does not statisfy the termination + condition. The restoration step was moved following the iterative + rejection. + 2. The restoration was also incorrectly when mclip=no and could + lead to a segmentation violation. + (6/13/94, Valdes) + +ccdred/src/iccclip.gx +ccdred/src/icsclip.gx + Found and fixed another typo bug. (6/7/94, Valdes/Zhang) + +ccdred/src/t_combine.x + For some reason the clget for the nkeep parameter was deleted + (it was in V2.10.2 but was gone in the version as of this date). + It was added again. (6/6/94, Valdes) + +ccdred/src/icscale.x + The sigma scaling flag, doscale1, would not be set in the case of + a mean offset of zero though the scale factors could be different. + (5/25/94, Valdes/Zhang) + +ccdred/src/icsclip.gx + There was a missing line: l = Memi[mp1]. (5/25/94, Valdes/Zhang) + +pkg/images/imarith/icaclip.gx +ccdred/src/icaclip.gx +ccdred/src/iccclip.gx +ccdred/src/icpclip.gx +ccdred/src/icsclip.gx + The reordering step when a central median is used during rejection + but the final combining is average was incorrect if the number + of rejected low pixels was greater than the number of pixel + number of pixels not rejected. (5/25/94, Valdes) + +ccdred/src/t_combine.x + Added a workaround for image header copy problem which leaves part + of the TEMPNAME keyword in the output image headers. For an output + pixel list file this could cause the file to be screwed up. + (5/6/94, Valdes) + +ccdred/src/icscale.x +ccdred/src/t_combine.x + 1. There is now a warning error if the scale, zero, or weight type + is unknown. + 2. An sfree was being called before the allocated memory was finished + being used. + (5/2/94, Valdes) + +ccdred/src/iclog.x + Changed the mean, median, mode, and zero formats from 6g to 7.5g to + insure 5 significant digits regardless of signs and decimal points. + (4/13/94, Valdes) + +ccdred/src/icaclip.gx +ccdred/src/iccclip.gx +ccdred/src/icsclip.gx + The image sigma was incorrectly computed when an offset scaling is used. + (3/8/94, Valdes) + +ccdred/src/setoverscan.x +ccdred/doc/ccdproc.hlp + It is an error if no bias section is given or if the whole image is + given. (1/3/94, Valdes) + +ccdred/src/t_ccdinst.x + There was an error causing reentrant formats which was fixed. + (12/16/93, Valdes) + +ccdred/src/ccdnscan.x + +ccdred/src/scancor.x +ccdred/src/setzero.x +ccdred/src/setdark.x +ccdred/src/setflat.x +ccdred/src/calimage.x +ccdred/src/proc.gx + +ccdred/src/t_ccdinst.x +ccdred/src/t_mkskyflat.x +ccdred/src/t_ccdproc.x +ccdred/src/ccdproc.x +ccdred/src/setfringe.x +ccdred/src/setillum.x +ccdred/src/mkpkg + +ccdred/doc/ccdproc.hlp +ccdred/doc/ccdinst.hlp +ccdred/doc/instruments.hlp + For short scan data the task now looks for the number of scan lines + in the image header. Also when a calibration image is software + scanned a new image is created. This allows processing objects with + different numbers of scan lines and preserving the unscanned + calibration image. (12/15/93, Valdes) + +ccdred/src/setoutput.x +ccdred/doc/ccdproc.hlp +ccdred/doc/ccdred.hlp + 1. The output datatypes were extended from just short and real to + include ushort, integer, long, and double. The calculation types + are still only short or real. + 2. The output datatype is no longer allowed to be of lower precision + than the input datatype. + (12/4/93, Valdes) + +ccdred/src/t_combine.x +ccdred/combine.par +ccdred/doc/combine.hlp +ccdred/doc/darkcombine.hlp +ccdred/doc/flatcombine.hlp +ccdred/doc/zerocombine.hlp + 1. The "outtype" parameter was being ignored and the package "pixeltype" + parameter was used instead. This was fixed to use the "outtype" + parameter. + 2. The output pixel datatypes now include unsigned short. + 3. The DARKCOMBINE, FLATCOMBINE, and ZEROCOMBINE scripts specified + that the output datatype be "real" because of the bug noted + above the output type was being determined by the package + "pixeltype" parameter. The change above fixes this so that + the combined output will always be real. The help pages did + not state that what the output datatype would be so a sentence + was added specifying the output datatype is real. + (12/4/93, Valdes) + +ccdred/icgrow.gx +ccdred/icpclip.gx +ccdred/icsclip.gx +ccdred/icaclip.gx +ccdred/iccclip.gx +ccdred/t_combine.x +ccdred/doc/combine.hlp + If there were fewer initial pixels than specified by nkeep then the + task would attempt to add garbage data to achieve nkeep pixels. This + could occur when using offsets, bad pixel masks, or thresholds. The + code was changed to check against the initial number of pixels rather + than the number of images. Also a negative nkeep is no longer + converted to a positive value based on the number of images. Instead + it specifies the maximum number of pixels to reject from the initial + set of pixels. (11/8/93, Valdes) + +ccdred/doc/ccdproc.hlp + Added a sentence explicitly saying the fixpix option provides + the same algorithm as FIXPIX. (11/1/93, Valdes) + +ccdred/src/icscale.x +ccdred/doc/combine.hlp + The help indicated that user input scale or zero level factors + by an @file or keyword are multiplicative and additive while the + task was using then as divisive and subtractive. This was + corrected to agree with the intend of the documentation. + Also the factors are no longer normalized. (9/24/93, Valdes) + +ccdred/src/icsetout.x + The case in which absolute offsets are specified but the offsets are + all the same did not work correctly. (9/24/93, Valdes) + +ccdred/doc/geometry.hlp +ccdred/doc/ccdproc.hlp +ccdred/doc/guide.hlp + The help was modified to say that the overscan region length is + determine from trimsec and is ignored in biassec. (9/23/93, Valdes) + +ccdred/doc/instruments.hlp +ccdred/doc/subsets.hlp + Added notes that comments are allowed. Also if there is more than + one translation for the same CCDRED parameter the last one takes + effect. (9/20/93, Valdes) + +ccdred/doc/combine.hlp + Clarified how bad pixel masks work with the "project" option. + (9/13/93, Valdes) + +ccdred/src/t_combine.x + The algorithm for making sure there are enough file descriptors failed + to account for the need to reopen the output image header for an + update. Thus when the number of input images + output images + logfile + was exactly 60 the task would fail. The update occurs when the output + image is unmapped so the solution was to close the input images first + except for the first image whose pointer is used in the new copy of the + output image. (8/4/93, Valdes) + +============ +V2.10.3 beta +============ + +ccdred/src/icgdata.gx + There was an indexing error in setting up the ID array when using + the grow option. This caused the CRREJECT/CCDCLIP algorithm to + fail with a floating divide by zero error when there were non-zero + shifts. (5/26/93, Valdes) + +ccdred/src/icmedian.gx + The median calculation is now done so that the original input data + is not lost. This slightly greater inefficiency is required so + that an output sigma image may be computed if desired. (5/10/93, Valdes) + +ccdred/darkcombine.cl +ccdred/doc/darkcombine.hlp +ccdred/doc/flatcombine.hlp +ccddb/kpno/direct.cl +ccddb/kpno/coude.cl +ccddb/kpno/cryocam.cl +ccddb/kpno/echelle.cl +ccddb/kpno/foe.cl +ccddb/kpno/specphot.cl +ccddb/kpno/sunlink.cl + 1. Updated FLATCOMBINE defaults for KPNO data. + 2. Changed package defaults for DARKCOMBINE to use "minmax" rejection. + (4/19/93, Valdes) + +ccdred/src/icombine.gx + There was no error checking when writing to the output image. If + an error occurred (the example being when an imaccessible imdir was + set) obscure messages would result. Errchks were added. + (4/16/93, Valdes) + +ccdred/src/setfpix.x +ccdred/src/ccdproc.x +ccdred/src/t_ccdproc.x +ccdred/doc/ccdproc.hlp +ccdred/doc/instrument.hlp + If a specified bad pixel file is not found an abort now occurs. Also + the FIXPIX processing header flag is set even if there are no + bad pixels. The documentation was revised to stress that an "untrimmed" + bad pixel file refers to the original CCD coordinates which is + especially important with subraster readouts. (2/23/93, Valdes) + +ccdred/src/icaclip.gx +ccdred/src/iccclip.gx +ccdred/src/icpclip.gx +ccdred/src/icsclip.gx + When using mclip=yes and when more pixels are rejected than allowed by + the nkeep parameter there was a subtle bug in how the pixels are added + back which can result in a segmentation violation. + if (nh == n2) ==> if (nh == n[i]) + (1/20/93, Valdes) + +ccdred/zerocombine.cl +ccdred/darkcombine.cl +ccdred/flatcombine.cl + Explicitly set ccdproc.noproc to no. (11/23/92, Valdes) + +======= +V2.10.2 +======= + +ccdred/src/calimage.x + Added test on the requested ccdtype when setting up the calibration images + to avoid mapping a calibration type image which is not going to be + used. (11/17/92, Valdes) + +ccdred/darkcombine.cl + Fixed typo in output parameter prompt string refering to a flat field. + (11/10/92, Valdes) + +ccdred/src/ccdred.h +ccdred/src/t_ccdproc.x +ccdred/src/proc.gx + Separated the minreplace operation from the findmean operation. It + is now a separate operation only applied to flat images. + (10/26/92, Valdes) + +ccdred/ccdtest/demo.dat + Removed display commands. Because DISPLAY is always loaded in V2.10 + there was no way to escape the displaying. + (9/30/92, Valdes) + +ccdred$darkcombine.cl +ccdred$flatcombine.cl +ccdred$zerocombine.cl +ccdred$doc/darkcombine.hlp +ccdred$doc/flatcombine.hlp +ccdred$doc/zerocombine.hlp + Added "blank", "nkeep", and "snoise" parameters. + (9/30/92, Valdes) + +ccdred$src/t_combine.x +ccdred$src/icaclip.gx +ccdred$src/iccclip.gx +ccdred$src/icgrow.gx +ccdred$src/iclog.x +ccdred$src/icombine.com +ccdred$src/icombine.gx +ccdred$src/icombine.h +ccdred$src/icpclip.gx +ccdred$src/icscale.x +ccdred$src/icsclip.gx +ccdred$src/icsetout.x +ccdred$combine.par +ccdred$doc/combine.hlp + The weighting was changed from using the square root of the exposure time + or image statistics to using the values directly. This corresponds + to variance weighting. Other options for specifying the scaling and + weighting factors were added; namely from a file or from a different + image header keyword. The \fInkeep\fR parameter was added to allow + controlling the maximum number of pixels to be rejected by the clipping + algorithms. The \fIsnoise\fR parameter was added to include a sensitivity + or scale noise component to the noise model. Errors will now delete + the output image. + (9/30/92, Valdes) + +ccdred$src/t_combine.x +ccdred$src/iclog.x + The log now prints the final image name rather than the temp name when + using the clobber option. (8/25/92, Valdes) + +ccdred$src/icaclip.gx +ccdred$src/iccclip.gx +ccdred$src/icpclip.gx +ccdred$src/icsclip.gx + There was a very unlikely possibility that if all the input pixels had + exactly the same number of rejected pixels the weighted average would + be done incorrectly because the dflag would not be set. (8/11/92, Valdes) + +ccdred$src/icmm.gx + This procedure failed to set the dflag resulting in the weighted average + being computed in correctly. (8/11/92, Valdes) + +ccdred$src/icscale.x + When scaling and zero offseting the zero level factors were incorrectly + computed. (8/10/92, Valdes) + +ccdred$src/ic[acs]clip.gx +ccdred$src/icstat.gx + Corrected type mismatches in intrinsic functions. (8/10/92, Valdes) + +======= +V2.10.1 +======= + +======= +V2.10.0 +======= + +===== +V2.10 +===== + +ccdred$src/icombine.gx + Needed to clear buffers returned by impl1 during the memory check + to avoid possible invalid values. (4/27/92, Valdes) + +ccdred$src/t_ccdproc.x +ccdred$src/calimage.x + Made it an error if an explicit calibration image is specified but cannot + be opened. Previously it would then look in the input list for the + appropriate type. (4/24/92, Valdes) + +ccdred$ccdproc.x +ccdred$t_ccdproc.x + Made the COMP type be processed like and OBJECT rather that the + default case. The only effect of this is to not have CCDMEAN + calculated. (4/8/92, Valdes) + +ccdred$src/icalip.gx +ccdred$src/icclip.gx +ccdred$src/ipslip.gx +ccdred$src/icslip.gx +ccdred$src/icmedian.gx + The median calculation with an even number of points for short data + could overflow (addition of two short values) and be incorrect. + (3/16/92, Valdes) + +ccdred$src/iclog.x + Added listing of read noise and gain. (2/10/92, Valdes) + +ccdred$src/icpclip.gx + Reduced the minimum number of images allowed for PCLIP to 3. + (1/7/92, Valdes) + +ccdred$darkcombine.cl +ccdred$flatcombine.cl + Set default parameters as requested by the support people. + (12/12/91, Valdes) + +ccdred$src/icgrow.gx + The first pixel to be checked was incorrectly set to 0 instead of 1 + resulting in a segvio when using the grow option. (12/6/91, Valdes) + +ccdred$src/proc.gx +ccdred$src/icgdata.gx +ccdred$src/icscale.x +ccdred$src/setfixpix.x +ccdred$src/t_combine.x + Fixed argument mismatch errors found by SPPLINT. (11/22/91, Valdes) + +ccdred$src + Replaced COMBINE with new version. (9/1/91, Valdes) + +ccdred$ccdtest/observe.cl -> artobs.cl +ccdred$ccdtest/observe.hlp -> artobs.hlp +ccdred$ccdtest/subsection.cl +ccdred$ccdtest/subsection.hlp +ccdred$ccdtest/mkimage.hlp +ccdred$ccdtest/demo.dat +ccdred$ccdtest/ccdtest.men +ccdred$ccdtest/ccdtest.hd +ccdred$ccdtest/ccdtest.cl +ccdred$ccddb/kpno/demo.dat + Renamed OBSERVE to ARTOBS to avoid conflict with the CCDACQ task of + the same name. (8/29/91, Valdes) + +ccdred$src/setoutput.x +ccdred$src/setproc.x +ccdred$src/setdark.x +ccdred$src/setzero.x +ccdred$src/setflat.x +ccdred$src/setfringe.x +ccdred$doc/ccdred.hlp + The default output pixel type and computation type are now real. + The computation type may be separately specified. (5/29/91, Valdes) + +ccdred$src/t_mkskycor.x + The computation of CCDMEAN failed to accumlate the last few lines causing + the mean to be underestimated. (4/16/91, Valdes) + +ccdred$src/t_ccdinst.x + +ccdred$src/ccdinst1.key + +ccdred$src/ccdinst2.key + +ccdred$src/ccdinst3.key + +ccdred$src/hdrmap.x +ccdred$src/mkpkg +ccdred$ccdinstrument.par + +ccdred$ccdred.cl +ccdred$ccdred.hd +ccdred$ccdred.men +ccdred$x_ccdred.x + Added the new task CCDINSTRUMENT. This also involved some changes to + the header translation package hdrmap.x. (10/23/90, Valdes) + +ccdred$src/imcscales.x +ccdred$src/imcmode.gx +ccdred$src/mkpkg + Added error check for incorrect mode section specification. + (10/3/90, Valdes) + +ccdred$src/ccdred.h +ccdred$src/proc.gx +ccdred$src/setproc.x +ccdred$ccdproc.par + Added a minreplace parameter to replace flat field values less than this + value by the value. This provides zero division prevention without + requiring specific flat field checking. + (10/3/90, Valdes) + +ccdred$src/t_ccdproc.x +ccdred$src/ccdproc.x +ccdred$src/scancor.x + 1. The scan correction now computes the CCDMEAN to account for the + ramp down. + 2. Did a simple move of the ccdmean call from before scancor to + after scancor. Since CCDMEAN is now computed in SCANCOR this + has no real affect and is just cosmetic. If CCDMEAN were not + computed in SCANCOR then the new placement would have computed + the right value at the expense of another pass through the image. + (9/21/90, Valdes) + +ccdred$src/t_badpixim.x + The template image cannot be closed immediately after opening the NEW_COPY + mask image because the STF kernel doesn't make the header copy until + pixel I/O occurs. This only affects STF images. (6/19/90, Valdes) + +==== +V2.9 +==== + +ccdred$src/t_combine.x + Changed: + char images[SZ_FNAME-1,nimages] --> char images[SZ_FNAME,nimages-1] + The incorrect declaration results in each successive image name have + additional leading characters. Apparently, since this has not be + found previously, the leading characters have generally been blanks. + (3/30/90, Valdes) + +ccdred$doc/combine.hlp + Clarified and documented definitions of the scale, offset, and weights. + (11/30/89, Valdes) + +ccdred$ccdproc.par + 1. All parameters now have default values. (10/31/89, Valdes) + +ccdred$src/cosmic/mkpkg +ccdred$src/gtascale.x - +ccdred$t_cosmicrays.x + 1. Removed duplicate of gtools procedure. + 2. Fixed transfer out of IFERR block message when input image was wrong. + 3. The badpixel file was not initialized to null if the user did not + want a badpixel file output. (9/21/89, Valdes) + +==== +V2.8 +=== + +ccdred$src/imcmode.gx + Fixed bug causing infinite loop when computing mode of constant value + section. (8/14/89, Valdes) + +ccdred$src/ccdproc.x +ccdred$src/ccddelete.x +ccdred$src/t_ccdproc.x +ccdred$src/t_mkfringe.x +ccdred$src/t_mkskyflat.x +ccdred$src/t_mkskycor.x +ccdred$src/t_mkillumft.x +ccdred$src/t_mkillumcor.x +ccdred$src/t_combine.x +ccdred$src/scancor.x +ccdred$src/readcor.x + 1. Added error checking for procedure ccddelete. + 2. Made workaround for error handling problem with procedure imrename + so that specifying a bad backup prefix would result in an abort + with an error message. (6/16/89, Valdes) + +ccdred$src/imcombine.gx + Made same changes made to image.imcombine to recover from too many VOS + file description error. (6/14/89, Valdes) + +ccdred$setinstrument.cl +ccdred$setinstrument.hlp + Incorrect instrument names are now reported to the user, a menu is + printed if there is one, and a second opportunity is given. + (6/14/89, Valdes) + +ccdred$ccdred.par + Added an ennumerated subset for the output datatype. (5/12/89, Valdes) + +ccdred$src/imcombine.gx + Because a file descriptor was not reserved for string buffer operations + and a call to stropen in cnvdate was not error checked the task would + hang when more than 115 images were combined. Better error checking + was added and now an error message is printed when the maximum number + of images that can be combined is exceeded. (5/9/89, Valdes) + +ccdred$src/sigma.gx +ccdred$src/imcaverage.gx + 1. Weighted sigma was being computed incorrectely. + 2. Added errchk to imcaverage.gx. + (5/6/89, Valdes) + +ccdred$src/setdark.x +ccdred$src/setflat.x +ccdred$src/setfringe.x +ccdred$src/setillum.x +ccdred$src/setoverscan.x +ccdred$src/settrim.x +ccdred$src/setzero.x + Made the trimsec, biassec, datasec, and ccdsec error messages more + informative. (3/13/89, Valdes) + +ccdred$src/imcmode.gx + For short data a short variable was wraping around when there were + a significant number of saturated pixels leading to an infinite loop. + The variables were made real regardless of the image datatype. + (3/1/89, Valdes) + +ccdred$src/t_mkskyflat.x +ccdred$src/t_mkskycor.x + 1. Added warning if images have not been flat fielded. + 2. Allowed flat field image to be found even if flatcor=no. + (2/24/89, Valdes) + +ccdred$src/imcthresh.gx +ccdred$combine.par +ccdred$doc/combine.hlp +ccdred$src/imcscales.x + 1. Added provision for blank value when all pixels are rejected by the + threshold. + 2. Fixed a bug that improperly scaled images in the threshold option. + 3. The offset printed in the log now has the opposite sign so that it + is the value "added" to bring images to a common level. + (2/16/89, Valdes) + +ccdred$src/proc.gx + When the data section had fewer lines than the output image (which occurs + when not trimming and the overscan being along lines) pixel out of + bounds errors occured. This bug was due to a sign error when reading + the non-trimmed overscan lines. (2/13/89, Valdes) + +ccdred$src/setoverscan.gx + The overscan buffer for readaxis=column was not initialized yielding + unpredictable and incorrect overscan data. + (3/13/89, Valdes) + +ccdred$src/imcmode.gx + Added test for nx=1. (2/8/89, Valdes) + +ccdred$darkcombine.cl +ccdred$flatcombine.cl + Changed the default parameters to use "avsigclip" combining and + no scaling or weighting. (1/27/89, Valdes) + +ccdred$src/ccdcheck.x +ccdred$src/setillum.x +ccdred$src/t_ccdproc.x + 1. If the illumination image does not have CCDMEAN in its header + it is calculated. + 2. If an error occurs in setting up for illumination or fringe + correction during processing a warning is issued and these + processing steps are skipped. They can be done later if + desired. Previously this caused an abort. + (1/27/89, Valdes) + +ccdred$ccdgroups.par +ccdred$src/t_ccdgroups.x +ccdred$doc/ccdgroups.hlp + Added two new group types; ccdtype and subset. (1/26/89, Valdes) + +ccdred$src/t_ccdlist.x +ccdred$doc/ccdlist.hlp + The exposure time and dark time are now printed in long format. This + is useful to allow verifying the header translation is working + correctly. (1/26/89, Valdes) + +ccdred$src/setfixpix.x +ccdred$src/t_badpixim.x + The magic word "untrimmed" no longer needs whitespace preceding it. + (1/24/89, Valdes) + +imred$ccdred/src/imcscales.x + Valdes, Dec 8, 1988 + 1. COMBINE now prints the scale as a multiplicative quantity. + 2. The combined exposure time was not being scaled by the scaling + factors resulting in a final exposure time inconsistent with the + data. + +imred$ccdred/src/t_mkskyflat.x +imred$ccdred/src/t_mkillumft.x +imred$ccdred/src/t_mkskycor.x +imred$ccdred/src/t_mkskyflat.x +imred$ccdred/src/t_mkfringe.x +imred$ccdred/doc/mkillumcor.hlp +imred$ccdred/doc/mkillumflat.hlp +imred$ccdred/mkillumflat.par +imred$ccdred/mkillumflat.par + 1. Minor typo in declaration (calimage.x) which had no effect. + 2. Missing include file (t_mkskyflat.x) caused "Cannot open image" + when using MKSKYFLAT. + 3. Added checks for division by zero which are reported at the end as + the number of divisions by zero and the replacement value. + The replacement value was added as a parameter value in MKILLUMCOR + and MKILLUMFLAT. + 4. Updated the help pages to reflect the new division by zero parameter. + 5. Modified the log strings to be more informative about what + was done and which images were used. + (10/20/88 Valdes) + +imred$ccdred/src/imcombine.gx + A vops clear routine was not called generically causing a crash with + double images. (10/19/88 Valdes) + +imred$ccdred/src/t_mkskycor.x + Replaced calls to recipricol vops procedure to one with zero checking. + (10/13/88 Valdes) + +imred$ccdred/src/imcscales.x + It is now an error if the mode is not positive for mode scaling or + weighting. (9/28/88 Valdes) + +imred$ccdred/ccdred.par +imred$ccdred/doc/ccdred.hlp + The plotfile parameter was changed to reflect the "" character + as the new default. (9/23/88 jvb) + +imred$ccdred/src/imcmedian.gx + The median option was selecting the n/2 value instead of (n+1)/2. Thus, + for an odd number of images the wrong value was being determined for the + median. (8/16/88 Valdes) + +imred$ccdred/src/scancor.x +imred$ccdred/src/calimage.x +imred$ccdred/src/ccdcmp.x + +imred$ccdred/src/mkpkg + 1. The shortscan correction was incorrectly writing to the input image + rather than the output image causing a cannot write to file error. + 2. It is now a trapped error if the input image is the same as a + calibration image. (4/18/88 Valdes) + +imred$ccdred/src/imcmode.gx + The use of a mode sections was handled incorrectly. (4/11/88 Valdes) + +noao$imred/ccdred/src/setoverscan.x + Minor bug fix: + gt_setr (gt, GTXMIN, 1.) -> gt_setr (gt, GTXMIN, x[1]) + gt_setr (gt, GTXMAX, real(npts)) -> gt_setr (gt, GTXMAX, x[npts]) + (2/11/88 Valdes) + +noao$imred/ccdred/src/t_mkillumflat.x -> t_mkillumft.x +noao$imred/ccdred/src/t_mkfringecor.x -> t_mkfringe.x +noao$imred/ccdred/src/t_badpiximage.x -> t_badpixim.x +noao$imred/ccdred/src/imcthreshold.gx -> imcthresh.gx +noao$imred/ccdred/src/generic/imcthresh.x -> imcthresh.x +noao$imred/ccdred/src/mkpkg +noao$imred/ccdred/src/generic/mkpkg + Shortened long names. (2/10/88 Valdes) + +noao$imred/ccdred/src/t_mkskycor.x +noao$imred/ccdred/doc/mkskycor.hlp +noao$imred/ccdred/doc/mkillumcor.hlp +noao$imred/ccdred/doc/mkskyflat.hlp +noao$imred/ccdred/doc/mkillumflat.hlp +noao$imred/ccdred/doc/mkfringecor.hlp + 1. When not clipping the first 3 lines of the illumination were always + zero. + 2. The clipping algorithm had several errors. + 3. It was unclear what a box size of 1. meant and whether one could + specify the entire image as the size of the box. + 4. The smoothing box has been generalize to let the user chose the minimum + and maximum box size. This lets the user do straight box smoothing + and the growing box smoothing. (2/2/88 Valdes) + +noao$imred/ccdred/src/ccdtypes.h + Added the comparison CCD image type. (1/21/88 Valdes) + +noao$imred/ccdred/src/t_mkskycor.x +noao$imred/ccdred/src/t_mkillumcor.x +noao$imred/ccdred/src/t_mkskyflat.x +noao$imred/ccdred/src/t_mkillumflat.x +noao$imred/ccdred/src/t_mkfringecor.x + Calling sequences to the set_ procedures were wrong. (1/20/88 Valdes) + +noao$imred/ccdred/src/imcscales.x + The exposure time is now read as real. (1/15/88 Valdes) + +noao$imred/ccdred/src/corinput.gx + Discovered an initialization bug which caused the fixing of bad lines + to fail after the first image. (11/12/87 Valdes) + +noao$imred/ccdred/ccdtest/observe.cl +noao$imred/ccdred/ccdtest/subsection.cl +noao$imred/ccdred/ccdtest/demo.dat + Made modification to allow the demo to work with STF format images. + The change was in being more explicit with image extensions; i.e. + obs* --> obs*.??h. (11/12/87 Valdes) + +noao$imred/ccdred/src/mkpkg +noao$imred/ccdred/src/ccdmean.x + +noao$imred/ccdred/src/ccdcache.h + +noao$imred/ccdred/src/ccdcache.com +noao$imred/ccdred/src/ccdcache.x +noao$imred/ccdred/src/t_ccdproc.x +noao$imred/ccdred/src/ccdproc.x +noao$imred/ccdred/src/ccdcheck.x +noao$imred/ccdred/src/setflat.x +noao$imred/ccdred/src/setdark.x +noao$imred/ccdred/src/setzero.x +noao$imred/ccdred/src/setfixpix.x +noao$imred/ccdred/src/setillum.x +noao$imred/ccdred/src/setfringe.x +noao$imred/ccdred/src/t_ccdlist.x + 1. There was a recursion problem caused by the absence of the CCDPROC + flag in a zero level image which did not need any processing + because there was no trimming, overscan subtraction, or bad + pixel correction. The procedure CCDPROC left the image + unmodified (no CCDPROC flag) which meant that later another unprocessed + calibration image would again try to process it leading to + recursion. Since I was uncomfortable with relying on the + CCDPROC flag I added the routine CCDCHECK to actually check + each processing flag against the defined operations. This will + also allow additional automatic processing of calibration + images if the users sets new flags after an initial pass + through the data. The CCDPROC flag is still set in the data + but it is not used. + 2. It is possible in data which has no object types for the flat + field image never to have its mean computed for later scaling. + There were two modifications to address this problem. If an + image is processed without a ccdtype then the mean will be + computed at a very small cost in time. If the image is later + used as a flat field this information will then be present. + Second, if a flat field calibration image does not have the + mean value, even if it has been processed, the mean value + will still be calculated. + 3. In looking at the recursion problem I realized that some of + the calibration images could be opened more than once, though + READ_ONLY, once for the image being processed and later if the + task has to backtrack to process a another calibration frame. I + was surprise that this was not found on VMS until I realized + that for OIF format images the image header is read and the + file is then closed. No file is actually left open until pixel + I/O is done. However, this should cause STF images to fail on + VMS because VMS does not allow a file to be open more than once + and the STF image header is kept open. I rewrote the image + caching interface to cache the IMIO pointer even if the pixel + data was not cached. This will insure any calibration image + is only opened once even if it is accessed independently from + different parts of the program. + 4. The error message when using fringe and illumination correction + images which have not been processed by MKFRINGECOR and + MKILLUMCOR was misleading when refering to the absence of the + MKFRINGE and MKILLUM flag. A user thought that the missing + flag was FRINGCOR which refers to an image being fringe corrected. + The message was made a little more clear. + 5. The CCDLIST listing for fringe correction in long format was wrong. + (11/12/87 Valdes) + +noao$imred/ccdred/src/t_combine.x +noao$imred/ccdred/src/t_ccdhedit.x +noao$imred/ccdred/src/setoverscan.x +noao$imred/ccdred/src/setinput.x +noao$imred/ccdred/src/imcscales.x +noao$imred/ccdred/src/imclogsum.x +noao$imred/ccdred/src/ccdlog.x +noao$imred/ccdred/src/ccddelete.x + Added calls to XT_STRIPWHITE to allow null strings to be recognized + with whitespace. It should probably use NOWHITE but this would make + it incompatible with V2.5. (11/6/87 Valdes) +.endhelp diff --git a/noao/imred/ccdred/badpiximage.par b/noao/imred/ccdred/badpiximage.par new file mode 100644 index 00000000..9a964701 --- /dev/null +++ b/noao/imred/ccdred/badpiximage.par @@ -0,0 +1,5 @@ +fixfile,f,a,,,,Bad pixel file +template,f,a,,,,Template image +image,f,a,,,,Bad pixel image to be created +goodvalue,i,h,1,,,Value assigned to the good pixels +badvalue,i,h,0,,,Value assigned to the bad pixels diff --git a/noao/imred/ccdred/ccddb/ctio/OLD/ccd.dat b/noao/imred/ccdred/ccddb/ctio/OLD/ccd.dat new file mode 100644 index 00000000..45e38898 --- /dev/null +++ b/noao/imred/ccdred/ccddb/ctio/OLD/ccd.dat @@ -0,0 +1,23 @@ +exptime itime +darktime itime +imagetyp data-typ +subset none +biassec biassec [405:425,7:572] +datasec datasec [35:340,4:570] +fixfile fixfile home$badpix + +fixpix bp-flag 0 +overscan bt-flag 0 +zerocor bi-flag 0 +darkcor dk-flag 0 +flatcor ff-flag 0 +fringcor fr-flag 0 + +OBJECT object +DARK dark +"PROJECTOR FLAT" flat +"SKY FLAT" other +COMPARISON other +BIAS zero +"DOME FLAT" flat +MASK other diff --git a/noao/imred/ccdred/ccddb/ctio/OLD/cfccd.dat b/noao/imred/ccdred/ccddb/ctio/OLD/cfccd.dat new file mode 100644 index 00000000..35af13e9 --- /dev/null +++ b/noao/imred/ccdred/ccddb/ctio/OLD/cfccd.dat @@ -0,0 +1,23 @@ +exptime exptime +darktime darktime +imagetyp imagetyp +subset filters +biassec biassec +datasec datasec +fixfile fixfile + +fixpix bp-flag 0 +overscan bt-flag 0 +zerocor bi-flag 0 +darkcor dk-flag 0 +flatcor ff-flag 0 +fringcor fr-flag 0 + +OBJECT object +DARK dark +"PROJECTOR FLAT" flat +"SKY FLAT" other +COMPARISON other +BIAS zero +"DOME FLAT" flat +MASK other diff --git a/noao/imred/ccdred/ccddb/ctio/OLD/csccd.dat b/noao/imred/ccdred/ccddb/ctio/OLD/csccd.dat new file mode 100644 index 00000000..d46f11c0 --- /dev/null +++ b/noao/imred/ccdred/ccddb/ctio/OLD/csccd.dat @@ -0,0 +1,23 @@ +exptime exptime +darktime darktime +imagetyp data-typ +subset none +biassec biassec +datasec datasec +fixfile fixfile + +fixpix bp-flag 0 +overscan bt-flag 0 +zerocor bi-flag 0 +darkcor dk-flag 0 +flatcor ff-flag 0 +fringcor fr-flag 0 + +OBJECT object +DARK dark +"PROJECTOR FLAT" flat +"SKY FLAT" other +COMPARISON other +BIAS zero +"DOME FLAT" flat +MASK other diff --git a/noao/imred/ccdred/ccddb/ctio/OLD/ech.dat b/noao/imred/ccdred/ccddb/ctio/OLD/ech.dat new file mode 100644 index 00000000..32cf5ee1 --- /dev/null +++ b/noao/imred/ccdred/ccddb/ctio/OLD/ech.dat @@ -0,0 +1,19 @@ +exptime exptime +darktime darktime +subset none +biassec biassec +trimsec datasec +imagetyp imagetyp + +'OBJECT' object +'COMPARISON' other +'BIAS' zero +'DOME FLAT' flat +'PROJECTOR FLAT' flat + +fixpix bp-flag 0 +overscan bt-flag 0 +zerocor bi-flag 0 +darkcor dk-flag 0 +flatcor ff-flag 0 +fringcor fr-flag 0 diff --git a/noao/imred/ccdred/ccddb/ctio/OLD/epi5.dat b/noao/imred/ccdred/ccddb/ctio/OLD/epi5.dat new file mode 100644 index 00000000..7b7613de --- /dev/null +++ b/noao/imred/ccdred/ccddb/ctio/OLD/epi5.dat @@ -0,0 +1,23 @@ +exptime exptime +darktime darktime +imagetyp imagetyp +subset none +biassec biassec [420:431,10:576] +trimsec trimsec [15:393,10:576] +fixfile fixfile home$ccds/epi5_badpix.dat + +fixpix bp-flag 0 +overscan bt-flag 0 +zerocor bi-flag 0 +darkcor dk-flag 0 +flatcor ff-flag 0 +fringcor fr-flag 0 + +OBJECT object +DARK dark +"PROJECTOR FLAT" flat +"SKY FLAT" other +COMPARISON other +BIAS zero +"DOME FLAT" flat +MASK other diff --git a/noao/imred/ccdred/ccddb/ctio/OLD/epi5_badpix.dat b/noao/imred/ccdred/ccddb/ctio/OLD/epi5_badpix.dat new file mode 100644 index 00000000..d4ccc345 --- /dev/null +++ b/noao/imred/ccdred/ccddb/ctio/OLD/epi5_badpix.dat @@ -0,0 +1,22 @@ +# EPI5_BADPIX.DAT - GEC EPI5 Blue Air Schmidt untrimmed coordinates +# +# Map includes columns which bleed due to very poor charge transfer at low +# light levels. +# +# SRH 8 December 87 +# + 37 37 396 313 + 37 37 510 528 + 46 46 482 307 + 77 77 148 490 +129 129 21 48 +154 154 346 446 +262 262 199 450 +284 284 493 549 +307 308 196 210 +307 309 395 576 +312 312 480 496 +347 348 88 111 +347 347 112 468 +352 352 127 438 +378 378 515 529 diff --git a/noao/imred/ccdred/ccddb/ctio/OLD/fpccd.dat b/noao/imred/ccdred/ccddb/ctio/OLD/fpccd.dat new file mode 100644 index 00000000..a56c56c0 --- /dev/null +++ b/noao/imred/ccdred/ccddb/ctio/OLD/fpccd.dat @@ -0,0 +1,23 @@ +EXPTIME exptime +DARKTIME darktime +IMAGETYP imagetyp +subset FPZ +biassec biassec +datasec datasec +fixfile fixfile + +fixpix bp-flag 0 +overscan bt-flag 0 +zerocor bi-flag 0 +darkcor dk-flag 0 +flatcor ff-flag 0 +fringcor fr-flag 0 + +OBJECT object +DARK dark +"PROJECTOR FLAT" flat +"SKY FLAT" other +COMPARISON other +BIAS zero +"DOME FLAT" flat +MASK other diff --git a/noao/imred/ccdred/ccddb/ctio/OLD/instruments.men b/noao/imred/ccdred/ccddb/ctio/OLD/instruments.men new file mode 100644 index 00000000..8fe97635 --- /dev/null +++ b/noao/imred/ccdred/ccddb/ctio/OLD/instruments.men @@ -0,0 +1,5 @@ +ccd CTIO genetic CCD +ech CTIO generic Echelle/CCD +cfccd CTIO generic CF/CCD +csccd CTIO generic CS/CCD +fpccd CTIO generic FP/CCD diff --git a/noao/imred/ccdred/ccddb/ctio/cfccd_both.dat b/noao/imred/ccdred/ccddb/ctio/cfccd_both.dat new file mode 100644 index 00000000..37991738 --- /dev/null +++ b/noao/imred/ccdred/ccddb/ctio/cfccd_both.dat @@ -0,0 +1,27 @@ +# CFCCD.DAT -- Instrument file to be used with quad when reducing direct +# imageing data obtained with ArCon. + +# Uncomment ONE of the following 3 lines to select the +# header keyword to use when grouping images into subsets by filter. +subset filters +#subset filter1 +#subset filter2 + +exptime exptime +darktime darktime +imagetyp imagetyp +biassec biassec +datasec datasec +trimsec trimsec +fixfile fixfile + +FOCUS object +OBJECT object +DARK dark +"PROJECTOR FLAT" flat +"SKY FLAT" flat +COMPARISON other +ZERO zero # New software +BIAS zero # Old software +"DOME FLAT" flat +MASK other diff --git a/noao/imred/ccdred/ccddb/ctio/cfccd_f1.dat b/noao/imred/ccdred/ccddb/ctio/cfccd_f1.dat new file mode 100644 index 00000000..68cd2063 --- /dev/null +++ b/noao/imred/ccdred/ccddb/ctio/cfccd_f1.dat @@ -0,0 +1,27 @@ +# CFCCD.DAT -- Instrument file to be used with quad when reducing direct +# imageing data obtained with ArCon. + +# Uncomment ONE of the following 3 lines to select the +# header keyword to use when grouping images into subsets by filter. +#subset filters +subset filter1 +#subset filter2 + +exptime exptime +darktime darktime +imagetyp imagetyp +biassec biassec +datasec datasec +trimsec trimsec +fixfile fixfile + +FOCUS object +OBJECT object +DARK dark +"PROJECTOR FLAT" flat +"SKY FLAT" flat +COMPARISON other +ZERO zero # New software +BIAS zero # Old software +"DOME FLAT" flat +MASK other diff --git a/noao/imred/ccdred/ccddb/ctio/cfccd_f2.dat b/noao/imred/ccdred/ccddb/ctio/cfccd_f2.dat new file mode 100644 index 00000000..c4d03cb8 --- /dev/null +++ b/noao/imred/ccdred/ccddb/ctio/cfccd_f2.dat @@ -0,0 +1,27 @@ +# CFCCD.DAT -- Instrument file to be used with quad when reducing direct +# imageing data obtained with ArCon. + +# Uncomment ONE of the following 3 lines to select the +# header keyword to use when grouping images into subsets by filter. +#subset filters +#subset filter1 +subset filter2 + +exptime exptime +darktime darktime +imagetyp imagetyp +biassec biassec +datasec datasec +trimsec trimsec +fixfile fixfile + +FOCUS object +OBJECT object +DARK dark +"PROJECTOR FLAT" flat +"SKY FLAT" flat +COMPARISON other +ZERO zero # New software +BIAS zero # Old software +"DOME FLAT" flat +MASK other diff --git a/noao/imred/ccdred/ccddb/ctio/csccd.dat b/noao/imred/ccdred/ccddb/ctio/csccd.dat new file mode 100644 index 00000000..000f8c07 --- /dev/null +++ b/noao/imred/ccdred/ccddb/ctio/csccd.dat @@ -0,0 +1,23 @@ +# CCD.DAT -- Instrument file to be used with ccdred when reducing spectroscopic +# data obtained with ArCon. + +subset none + +exptime exptime +darktime darktime +imagetyp imagetyp +biassec biassec +datasec datasec +trimsec trimsec +fixfile fixfile + +FOCUS object +OBJECT object +DARK dark +"PROJECTOR FLAT" flat +"SKY FLAT" flat +COMPARISON object +ZERO zero # New software +BIAS zero # Old software +"DOME FLAT" flat +MASK other diff --git a/noao/imred/ccdred/ccddb/ctio/echccd.dat b/noao/imred/ccdred/ccddb/ctio/echccd.dat new file mode 100644 index 00000000..90d08173 --- /dev/null +++ b/noao/imred/ccdred/ccddb/ctio/echccd.dat @@ -0,0 +1,23 @@ +# ECHCCD.DAT -- Instrument file to be used with ccdred when reducing echelle +# spectroscopic data obtained with ArCon. + +subset none + +exptime exptime +darktime darktime +imagetyp imagetyp +biassec biassec +datasec datasec +trimsec trimsec +fixfile fixfile + +OBJECT object +DARK dark +"PROJECTOR FLAT" flat +"SKY FLAT" flat +COMPARISON other +ZERO zero # New software +BIAS zero # Old software +"DOME FLAT" flat +MASK other +FOCUS object diff --git a/noao/imred/ccdred/ccddb/ctio/instruments.men b/noao/imred/ccdred/ccddb/ctio/instruments.men new file mode 100644 index 00000000..144c41d5 --- /dev/null +++ b/noao/imred/ccdred/ccddb/ctio/instruments.men @@ -0,0 +1,9 @@ +cfccd_f1 - Cassegrain focus CCD direct subset=filter1 +cfccd_f2 - Cassegrain focus CCD direct subset=filter2 +cfccd_both - Cassegrain focus CCD direct subset=filters +csccd - Cassegrain focus spectroscopy +echccd - Echelle spectroscopy +nfccd - Newtonian focus CCD direct (Schmidt) +pfccd_f1 - Prime focus CCD direct subset=filter1 +pfccd_f2 - Prime focus CCD direct subset=filter2 +pfccd_both - Prime focus CCD direct subset=filters diff --git a/noao/imred/ccdred/ccddb/ctio/nfccd.dat b/noao/imred/ccdred/ccddb/ctio/nfccd.dat new file mode 100644 index 00000000..06a173cf --- /dev/null +++ b/noao/imred/ccdred/ccddb/ctio/nfccd.dat @@ -0,0 +1,23 @@ +# NFCCD.DAT -- Instrument file to be used with ccdred when reducing direct +# imageing data obtained with ArCon. + +subset filter1 + +exptime exptime +darktime darktime +imagetyp imagetyp +biassec biassec +datasec datasec +trimsec trimsec +fixfile fixfile + +FOCUS object +OBJECT object +DARK dark +"PROJECTOR FLAT" flat +"SKY FLAT" flat +COMPARISON other +ZERO zero # New software +BIAS zero # Old software +"DOME FLAT" flat +MASK other diff --git a/noao/imred/ccdred/ccddb/ctio/pfccd_both.dat b/noao/imred/ccdred/ccddb/ctio/pfccd_both.dat new file mode 100644 index 00000000..ac8e03a6 --- /dev/null +++ b/noao/imred/ccdred/ccddb/ctio/pfccd_both.dat @@ -0,0 +1,27 @@ +# PFCCD.DAT -- Instrument file to be used with quad when reducing direct +# imageing data obtained with ArCon. + +# Uncomment ONE of the following 3 lines to select the +# header keyword to use when grouping images into subsets by filter. +subset filters +#subset filter1 +#subset filter2 + +exptime exptime +darktime darktime +imagetyp imagetyp +biassec biassec +datasec datasec +trimsec trimsec +fixfile fixfile + +FOCUS object +OBJECT object +DARK dark +"PROJECTOR FLAT" flat +"SKY FLAT" flat +COMPARISON other +ZERO zero # New software +BIAS zero # Old software +"DOME FLAT" flat +MASK other diff --git a/noao/imred/ccdred/ccddb/ctio/pfccd_f1.dat b/noao/imred/ccdred/ccddb/ctio/pfccd_f1.dat new file mode 100644 index 00000000..9893d7f1 --- /dev/null +++ b/noao/imred/ccdred/ccddb/ctio/pfccd_f1.dat @@ -0,0 +1,27 @@ +# PFCCD.DAT -- Instrument file to be used with quad when reducing direct +# imageing data obtained with ArCon. + +# Uncomment ONE of the following 3 lines to select the +# header keyword to use when grouping images into subsets by filter. +#subset filters +subset filter1 +#subset filter2 + +exptime exptime +darktime darktime +imagetyp imagetyp +biassec biassec +datasec datasec +trimsec trimsec +fixfile fixfile + +FOCUS object +OBJECT object +DARK dark +"PROJECTOR FLAT" flat +"SKY FLAT" flat +COMPARISON other +ZERO zero # New software +BIAS zero # Old software +"DOME FLAT" flat +MASK other diff --git a/noao/imred/ccdred/ccddb/ctio/pfccd_f2.dat b/noao/imred/ccdred/ccddb/ctio/pfccd_f2.dat new file mode 100644 index 00000000..89028468 --- /dev/null +++ b/noao/imred/ccdred/ccddb/ctio/pfccd_f2.dat @@ -0,0 +1,27 @@ +# PFCCD.DAT -- Instrument file to be used with quad when reducing direct +# imageing data obtained with ArCon. + +# Uncomment ONE of the following 3 lines to select the +# header keyword to use when grouping images into subsets by filter. +#subset filters +#subset filter1 +subset filter2 + +exptime exptime +darktime darktime +imagetyp imagetyp +biassec biassec +datasec datasec +trimsec trimsec +fixfile fixfile + +FOCUS object +OBJECT object +DARK dark +"PROJECTOR FLAT" flat +"SKY FLAT" flat +COMPARISON other +ZERO zero # New software +BIAS zero # Old software +"DOME FLAT" flat +MASK other diff --git a/noao/imred/ccdred/ccddb/kpno/Revisions b/noao/imred/ccdred/ccddb/kpno/Revisions new file mode 100644 index 00000000..47195a53 --- /dev/null +++ b/noao/imred/ccdred/ccddb/kpno/Revisions @@ -0,0 +1,35 @@ +.help revisions Dec91 ccddb$kpno +.nf +hydra.dat + +hydra.cl + +direct.cl + +coude.cl +cryocam.cl +default.cl +echelle.cl +fibers.cl +foe.cl +specphot.cl +sunlink.cl +instruments.men + 1. Added hydra entry. + 2. Linked all the entries to the new "default.cl" so that each + setup script only contains the differences from the default. + (9/8/97, Valdes) + +*.cl + 1. (all) ccdred.plotfile = "". + 2. (all) ccdred.pixeltype = "real real". + 3. (direct,fibers) ccdproc.interactive = yes + 4. (coude, specphot) ccdproc.ccdtype = "" + ccdproc.flatcor = no + ccdproc.trimsec = "" + (12/12/91, Valdes) + +instruments.men + Removed sunlink from the instrument menu. (12/12/91, Valdes) + +coude.dat + Changed the subset parameter from FILTER to GRATPOS. (12/11/91, Valdes) + +.endhelp diff --git a/noao/imred/ccdred/ccddb/kpno/camera.dat b/noao/imred/ccdred/ccddb/kpno/camera.dat new file mode 100644 index 00000000..841a37b9 --- /dev/null +++ b/noao/imred/ccdred/ccddb/kpno/camera.dat @@ -0,0 +1,21 @@ +exptime otime +darktime ttime +imagetyp data-typ +subset f1pos +biassec biassec [] +datasec datasec [] + +fixpix bp-flag 0 +overscan bt-flag 0 +zerocor bi-flag 0 +darkcor dk-flag 0 +flatcor ff-flag 0 +fringcor fr-flag 0 + +'OBJECT (0)' object +'DARK (1)' dark +'PROJECTOR FLAT (2)' flat +'SKY FLAT (3)' other +'COMPARISON LAMP (4)' other +'BIAS (5)' zero +'DOME FLAT (6)' flat diff --git a/noao/imred/ccdred/ccddb/kpno/coude.cl b/noao/imred/ccdred/ccddb/kpno/coude.cl new file mode 100644 index 00000000..1eb1a73e --- /dev/null +++ b/noao/imred/ccdred/ccddb/kpno/coude.cl @@ -0,0 +1,4 @@ +cl < "ccddb$kpno/default.cl" + +ccdred.instrument = "ccddb$kpno/coude.dat" +ccdproc.trimsec = "" diff --git a/noao/imred/ccdred/ccddb/kpno/coude.dat b/noao/imred/ccdred/ccddb/kpno/coude.dat new file mode 100644 index 00000000..f32350aa --- /dev/null +++ b/noao/imred/ccdred/ccddb/kpno/coude.dat @@ -0,0 +1,9 @@ +subset gratpos + +DARK dark +BIAS zero +OBJECT object +'DOME FLAT' flat +'PROJECTOR FLAT' flat +'COMPARISON' comp +'SKY FLAT' object diff --git a/noao/imred/ccdred/ccddb/kpno/cryocam.cl b/noao/imred/ccdred/ccddb/kpno/cryocam.cl new file mode 100644 index 00000000..1e917ff2 --- /dev/null +++ b/noao/imred/ccdred/ccddb/kpno/cryocam.cl @@ -0,0 +1,3 @@ +cl < "ccddb$kpno/default.cl" + +ccdred.instrument = "ccddb$kpno/cryocam.dat" diff --git a/noao/imred/ccdred/ccddb/kpno/cryocam.dat b/noao/imred/ccdred/ccddb/kpno/cryocam.dat new file mode 100644 index 00000000..f0a6134b --- /dev/null +++ b/noao/imred/ccdred/ccddb/kpno/cryocam.dat @@ -0,0 +1,9 @@ +subset filters + +DARK dark +BIAS zero +OBJECT object +'DOME FLAT' flat +'PROJECTOR FLAT' flat +'COMPARISON' comp +'SKY FLAT' object diff --git a/noao/imred/ccdred/ccddb/kpno/default.cl b/noao/imred/ccdred/ccddb/kpno/default.cl new file mode 100644 index 00000000..df16c7b6 --- /dev/null +++ b/noao/imred/ccdred/ccddb/kpno/default.cl @@ -0,0 +1,41 @@ +# Default KPNO parameters. + +ccdred.pixeltype = "real real" +ccdred.verbose = yes +ccdred.logfile = "logfile" +ccdred.plotfile = "" +ccdred.backup = "" +ccdred.instrument = "ccddb$kpno/default.dat" +ccdred.ssfile = "subsets" +ccdred.graphics = "stdgraph" +ccdred.cursor = "" + +ccdproc.ccdtype = "" +ccdproc.fixpix = no +ccdproc.overscan = yes +ccdproc.trim = yes +ccdproc.zerocor = yes +ccdproc.darkcor = no +ccdproc.flatcor = no +ccdproc.readcor = no +ccdproc.scancor = no +ccdproc.readaxis = "line" +ccdproc.biassec = "image" +ccdproc.trimsec = "image" +ccdproc.interactive = yes +ccdproc.function = "chebyshev" +ccdproc.order = 1 +ccdproc.sample = "*" +ccdproc.naverage = 1 +ccdproc.niterate = 1 +ccdproc.low_reject = 3 +ccdproc.high_reject = 3 +ccdproc.grow = 0 + +combine.rdnoise= "rdnoise" +combine.gain="gain" +zerocombine.rdnoise= "rdnoise" +zerocombine.gain="gain" +flatcombine.rdnoise= "rdnoise" +flatcombine.gain="gain" +flatcombine.reject = "crreject" diff --git a/noao/imred/ccdred/ccddb/kpno/demo.cl b/noao/imred/ccdred/ccddb/kpno/demo.cl new file mode 100644 index 00000000..51c54909 --- /dev/null +++ b/noao/imred/ccdred/ccddb/kpno/demo.cl @@ -0,0 +1,72 @@ +# Demonstration parameter setting script. + +# Set package parameters: +ccdred.pixeltype = "real real" +ccdred.verbose = yes +ccdred.logfile = "Demo.log" +ccdred.plotfile = "Demo.plots" +ccdred.backup = "B" +ccdred.ssfile = "Demo.subsets" + +# Set processing parameters: +ccdproc.fixpix = yes +ccdproc.overscan = yes +ccdproc.trim = yes +ccdproc.zerocor = yes +ccdproc.darkcor = yes +ccdproc.flatcor = yes +ccdproc.illumcor = no +ccdproc.fringecor = no +ccdproc.readcor = no +ccdproc.scancor = no +ccdproc.readaxis = "line" +ccdproc.fixfile = "ccdtest$badpix.dat" +ccdproc.biassec = "image" +ccdproc.trimsec = "image" +ccdproc.zero = "" +ccdproc.dark = "" +ccdproc.flat = "" +ccdproc.illum = "" +ccdproc.fringe = "" +ccdproc.scantype = "shortscan" +ccdproc.nscan = 1 +ccdproc.interactive = yes +ccdproc.function = "legendre" +ccdproc.order = 1 +ccdproc.sample = "*" +ccdproc.naverage = 1 +ccdproc.niterate = 1 +ccdproc.low_reject = 3. +ccdproc.high_reject = 3. +ccdproc.grow = 0. +flatcombine.process = no + +# Set demonstration observation parameters: +artobs.ncols = 132 +artobs.nlines = 100 +artobs.filter = "" +artobs.datasec = "[1:100,1:100]" +artobs.trimsec = "[3:98,3:98]" +artobs.biassec = "[103:130,*]" +artobs.imdata = "" +artobs.skyrate = 0. +artobs.badpix = "ccdtest$badpix.dat" +artobs.biasval = 500. +artobs.badval = 500. +artobs.zeroval = 100. +artobs.darkrate = 1. +artobs.zeroslope = 0.01 +artobs.darkslope = 0.002 +artobs.flatslope = 3.0000000000000E-4 +artobs.sigma = 5. +artobs.seed = 0 +artobs.overwrite = no + +# Set demonstration subsection readout parameters: +subsection.ncols = 82 +subsection.nlines = 50 +subsection.ccdsec = "[26:75,26:75]" +subsection.datasec = "[1:50,1:50]" +subsection.trimsec = "" +subsection.biassec = "[51:82,1:50]" +subsection.overwrite = no diff --git a/noao/imred/ccdred/ccddb/kpno/demo.dat b/noao/imred/ccdred/ccddb/kpno/demo.dat new file mode 100644 index 00000000..72697f58 --- /dev/null +++ b/noao/imred/ccdred/ccddb/kpno/demo.dat @@ -0,0 +1,3 @@ +imagetyp ccdtype +exptime integ +subset filter diff --git a/noao/imred/ccdred/ccddb/kpno/direct.cl b/noao/imred/ccdred/ccddb/kpno/direct.cl new file mode 100644 index 00000000..dfa9bc51 --- /dev/null +++ b/noao/imred/ccdred/ccddb/kpno/direct.cl @@ -0,0 +1,4 @@ +cl < "ccddb$kpno/default.cl" + +ccdred.instrument = "ccddb$kpno/direct.dat" +ccdproc.flatcor = yes diff --git a/noao/imred/ccdred/ccddb/kpno/direct.dat b/noao/imred/ccdred/ccddb/kpno/direct.dat new file mode 100644 index 00000000..f0a6134b --- /dev/null +++ b/noao/imred/ccdred/ccddb/kpno/direct.dat @@ -0,0 +1,9 @@ +subset filters + +DARK dark +BIAS zero +OBJECT object +'DOME FLAT' flat +'PROJECTOR FLAT' flat +'COMPARISON' comp +'SKY FLAT' object diff --git a/noao/imred/ccdred/ccddb/kpno/echelle.cl b/noao/imred/ccdred/ccddb/kpno/echelle.cl new file mode 100644 index 00000000..a011cc8f --- /dev/null +++ b/noao/imred/ccdred/ccddb/kpno/echelle.cl @@ -0,0 +1,3 @@ +cl < "ccddb$kpno/default.cl" + +ccdred.instrument = "ccddb$kpno/echelle.dat" diff --git a/noao/imred/ccdred/ccddb/kpno/echelle.dat b/noao/imred/ccdred/ccddb/kpno/echelle.dat new file mode 100644 index 00000000..f0a6134b --- /dev/null +++ b/noao/imred/ccdred/ccddb/kpno/echelle.dat @@ -0,0 +1,9 @@ +subset filters + +DARK dark +BIAS zero +OBJECT object +'DOME FLAT' flat +'PROJECTOR FLAT' flat +'COMPARISON' comp +'SKY FLAT' object diff --git a/noao/imred/ccdred/ccddb/kpno/fibers.cl b/noao/imred/ccdred/ccddb/kpno/fibers.cl new file mode 100644 index 00000000..bb1e0398 --- /dev/null +++ b/noao/imred/ccdred/ccddb/kpno/fibers.cl @@ -0,0 +1,3 @@ +cl < "ccddb$kpno/default.cl" + +ccdred.instrument = "ccddb$kpno/fibers.dat" diff --git a/noao/imred/ccdred/ccddb/kpno/fibers.dat b/noao/imred/ccdred/ccddb/kpno/fibers.dat new file mode 100644 index 00000000..f0a6134b --- /dev/null +++ b/noao/imred/ccdred/ccddb/kpno/fibers.dat @@ -0,0 +1,9 @@ +subset filters + +DARK dark +BIAS zero +OBJECT object +'DOME FLAT' flat +'PROJECTOR FLAT' flat +'COMPARISON' comp +'SKY FLAT' object diff --git a/noao/imred/ccdred/ccddb/kpno/fits.dat b/noao/imred/ccdred/ccddb/kpno/fits.dat new file mode 100644 index 00000000..f47abf8d --- /dev/null +++ b/noao/imred/ccdred/ccddb/kpno/fits.dat @@ -0,0 +1,21 @@ +exptime itime +darktime itime +imagetyp data-typ +subset f1pos +biassec biassec [] +datasec datasec [] + +fixpix bp-flag 0 +overscan bt-flag 0 +zerocor bi-flag 0 +darkcor dk-flag 0 +flatcor ff-flag 0 +fringcor fr-flag 0 + +'object ( 0 )' object +'dark ( 1 )' dark +'proj flat ( 2 )' flat +'sky flat ( 3 )' other +'comp ( 4 )' other +'bias ( 5 )' zero +'dome flat ( 6 )' flat diff --git a/noao/imred/ccdred/ccddb/kpno/foe.cl b/noao/imred/ccdred/ccddb/kpno/foe.cl new file mode 100644 index 00000000..da4081cb --- /dev/null +++ b/noao/imred/ccdred/ccddb/kpno/foe.cl @@ -0,0 +1,3 @@ +cl < "ccddb$kpno/default.cl" + +ccdred.instrument = "ccddb$kpno/foe.dat" diff --git a/noao/imred/ccdred/ccddb/kpno/foe.dat b/noao/imred/ccdred/ccddb/kpno/foe.dat new file mode 100644 index 00000000..f0a6134b --- /dev/null +++ b/noao/imred/ccdred/ccddb/kpno/foe.dat @@ -0,0 +1,9 @@ +subset filters + +DARK dark +BIAS zero +OBJECT object +'DOME FLAT' flat +'PROJECTOR FLAT' flat +'COMPARISON' comp +'SKY FLAT' object diff --git a/noao/imred/ccdred/ccddb/kpno/hydra.cl b/noao/imred/ccdred/ccddb/kpno/hydra.cl new file mode 100644 index 00000000..b24dc05e --- /dev/null +++ b/noao/imred/ccdred/ccddb/kpno/hydra.cl @@ -0,0 +1,12 @@ +cl < "ccddb$kpno/default.cl" + +ccdred.instrument = "ccddb$kpno/hydra.dat" + +combine.gain = "gain_12" +combine.rdnoise = "noise_12" +zerocombine.gain = "gain_12" +zerocombine.rdnoise = "noise_12" +darkcombine.gain = "gain_12" +darkcombine.rdnoise = "noise_12" +flatcombine.gain = "gain_12" +flatcombine.rdnoise = "noise_12" diff --git a/noao/imred/ccdred/ccddb/kpno/hydra.dat b/noao/imred/ccdred/ccddb/kpno/hydra.dat new file mode 100644 index 00000000..f0a6134b --- /dev/null +++ b/noao/imred/ccdred/ccddb/kpno/hydra.dat @@ -0,0 +1,9 @@ +subset filters + +DARK dark +BIAS zero +OBJECT object +'DOME FLAT' flat +'PROJECTOR FLAT' flat +'COMPARISON' comp +'SKY FLAT' object diff --git a/noao/imred/ccdred/ccddb/kpno/instruments.men b/noao/imred/ccdred/ccddb/kpno/instruments.men new file mode 100644 index 00000000..5dea4af6 --- /dev/null +++ b/noao/imred/ccdred/ccddb/kpno/instruments.men @@ -0,0 +1,12 @@ +direct Current headers for Sun plus CCDPROC setup for direct CCD +specphot Current headers for Sun plus CCDPROC setup for spectropho- + tometry, ie GoldCam, barefoot CCD +hydra WIYN Hydra with Arcon +foe Current headers for Sun plus CCDPROC setup for FOE +fibers Current headers for Sun plus CCDPROC setup for fiber array +coude Current headers for Sun plus CCDPROC setup for Coude +cyrocam Current headers for Sun plus CCDPROC setup for Cryo Cam +echelle Current headers for Sun plus CCDPROC setup for Echelle +kpnoheaders Current headers with no changes to CCDPROC parameters +fits Mountain FITS header prior to Aug. 87 (?) +camera Mountain CAMERA header for IRAF Version 2.6 and earlier diff --git a/noao/imred/ccdred/ccddb/kpno/kpnoheaders.dat b/noao/imred/ccdred/ccddb/kpno/kpnoheaders.dat new file mode 100644 index 00000000..f0a6134b --- /dev/null +++ b/noao/imred/ccdred/ccddb/kpno/kpnoheaders.dat @@ -0,0 +1,9 @@ +subset filters + +DARK dark +BIAS zero +OBJECT object +'DOME FLAT' flat +'PROJECTOR FLAT' flat +'COMPARISON' comp +'SKY FLAT' object diff --git a/noao/imred/ccdred/ccddb/kpno/specphot.cl b/noao/imred/ccdred/ccddb/kpno/specphot.cl new file mode 100644 index 00000000..4359279d --- /dev/null +++ b/noao/imred/ccdred/ccddb/kpno/specphot.cl @@ -0,0 +1,5 @@ +cl < "ccddb$kpno/default.cl" + +ccdred.instrument = "ccddb$kpno/specphot.dat" +ccdproc.trimsec = "" +ccdproc.grow = 1 diff --git a/noao/imred/ccdred/ccddb/kpno/specphot.dat b/noao/imred/ccdred/ccddb/kpno/specphot.dat new file mode 100644 index 00000000..f0a6134b --- /dev/null +++ b/noao/imred/ccdred/ccddb/kpno/specphot.dat @@ -0,0 +1,9 @@ +subset filters + +DARK dark +BIAS zero +OBJECT object +'DOME FLAT' flat +'PROJECTOR FLAT' flat +'COMPARISON' comp +'SKY FLAT' object diff --git a/noao/imred/ccdred/ccddb/kpno/sunlink.cl b/noao/imred/ccdred/ccddb/kpno/sunlink.cl new file mode 100644 index 00000000..1f5fe7fe --- /dev/null +++ b/noao/imred/ccdred/ccddb/kpno/sunlink.cl @@ -0,0 +1,4 @@ +cl < "ccddb$kpno/default.cl" + +ccdred.instrument = "ccddb$kpno/sunlink.dat" +ccdproc.flatcor = yes diff --git a/noao/imred/ccdred/ccddb/kpno/sunlink.dat b/noao/imred/ccdred/ccddb/kpno/sunlink.dat new file mode 100644 index 00000000..44d237d6 --- /dev/null +++ b/noao/imred/ccdred/ccddb/kpno/sunlink.dat @@ -0,0 +1,8 @@ +subset filters + +DARK dark +BIAS zero +OBJECT object +'DOME FLAT' flat +'PROJECTOR FLAT' flat +'COMPARISON' comp diff --git a/noao/imred/ccdred/ccddb/kpno/template.cl b/noao/imred/ccdred/ccddb/kpno/template.cl new file mode 100644 index 00000000..b5284029 --- /dev/null +++ b/noao/imred/ccdred/ccddb/kpno/template.cl @@ -0,0 +1,25 @@ +# Template parameter setting script. These parameters should be +# set for a particular instrument. + +ccdproc.fixpix = +ccdproc.overscan = +ccdproc.trim = +ccdproc.zerocor = +ccdproc.darkcor = +ccdproc.flatcor = +ccdproc.readcor = +ccdproc.scancor = +ccdproc.readaxis = +ccdproc.fixfile = +ccdproc.biassec = +ccdproc.datasec = +ccdproc.scantype = +ccdproc.interactive = +ccdproc.function = +ccdproc.order = +ccdproc.sample = +ccdproc.naverage = +ccdproc.niterate = +ccdproc.low_reject = +ccdproc.high_reject = +ccdproc.grow = diff --git a/noao/imred/ccdred/ccdgroups.par b/noao/imred/ccdred/ccdgroups.par new file mode 100644 index 00000000..4b8d5007 --- /dev/null +++ b/noao/imred/ccdred/ccdgroups.par @@ -0,0 +1,5 @@ +images,s,a,,,,CCD images to group +output,s,a,,,,Output root group filename +group,s,h,"ccdtype","position|title|date|ccdtype|subset",,Group type +radius,r,h,"60",,,Group position radius (arc sec) +ccdtype,s,h,"",,,CCD image types to select diff --git a/noao/imred/ccdred/ccdhedit.par b/noao/imred/ccdred/ccdhedit.par new file mode 100644 index 00000000..5695dffa --- /dev/null +++ b/noao/imred/ccdred/ccdhedit.par @@ -0,0 +1,4 @@ +images,s,a,,,,CCD images +parameter,s,a,,,,Image header parameter +value,s,a,,,,Parameter value +type,s,h,"string","string|real|integer",,Parameter type (string|real|integer) diff --git a/noao/imred/ccdred/ccdinstrument.par b/noao/imred/ccdred/ccdinstrument.par new file mode 100644 index 00000000..99bec801 --- /dev/null +++ b/noao/imred/ccdred/ccdinstrument.par @@ -0,0 +1,5 @@ +images,s,a,,,,List of images +instrument,s,h,)_.instrument,,,CCD instrument file +ssfile,s,h,)_.ssfile,,,Subset translation file +edit,b,h,yes,,,Edit instrument translation file? +parameters,s,h,"basic","basic|common|all",,Parameters to be displayed diff --git a/noao/imred/ccdred/ccdlist.par b/noao/imred/ccdred/ccdlist.par new file mode 100644 index 00000000..3eb82917 --- /dev/null +++ b/noao/imred/ccdred/ccdlist.par @@ -0,0 +1,5 @@ +images,s,a,,,,CCD images to listed +ccdtype,s,h,"",,,CCD image type to be listed +names,b,h,no,,,List image names only? +long,b,h,no,,,Long format listing? +ccdproc,pset,h,,,,CCD processing parameters diff --git a/noao/imred/ccdred/ccdmask.par b/noao/imred/ccdred/ccdmask.par new file mode 100644 index 00000000..8127f4dc --- /dev/null +++ b/noao/imred/ccdred/ccdmask.par @@ -0,0 +1,12 @@ +image,f,a,,,,Input image +mask,f,a,,,,Output pixel mask +ncmed,i,h,7,1,,Column box size for median level calculation +nlmed,i,h,7,1,,Line box size for median level calculation +ncsig,i,h,15,10,,Column box size for sigma calculation +nlsig,i,h,15,10,,Line box size for sigma calculation +lsigma,r,h,6.,,,Low clipping sigma +hsigma,r,h,6.,,,High clipping sigma +ngood,i,h,5,1,,Minimum column length of good pixel seqments +linterp,i,h,2,1,,Mask value for line interpolation +cinterp,i,h,3,1,,Mask value for column interpolation +eqinterp,i,h,2,1,,Mask value for equal interpolation diff --git a/noao/imred/ccdred/ccdproc.par b/noao/imred/ccdred/ccdproc.par new file mode 100644 index 00000000..f86ad07d --- /dev/null +++ b/noao/imred/ccdred/ccdproc.par @@ -0,0 +1,39 @@ +images,s,a,"",,,List of CCD images to correct +output,s,h,"",,,List of output CCD images +ccdtype,s,h,"object",,,CCD image type to correct +max_cache,i,h,0,0,,Maximum image caching memory (in Mbytes) +noproc,b,h,no,,,"List processing steps only? +" +fixpix,b,h,yes,,,Fix bad CCD lines and columns? +overscan,b,h,yes,,,Apply overscan strip correction? +trim,b,h,yes,,,Trim the image? +zerocor,b,h,yes,,,Apply zero level correction? +darkcor,b,h,yes,,,Apply dark count correction? +flatcor,b,h,yes,,,Apply flat field correction? +illumcor,b,h,no,,,Apply illumination correction? +fringecor,b,h,no,,,Apply fringe correction? +readcor,b,h,no,,,Convert zero level image to readout correction? +scancor,b,h,no,,,"Convert flat field image to scan correction? +" +readaxis,s,h,"line","column|line",, Read out axis (column|line) +fixfile,s,h,"",,,File describing the bad lines and columns +biassec,s,h,"",,,Overscan strip image section +trimsec,s,h,"",,,Trim data section +zero,s,h,"",,,Zero level calibration image +dark,s,h,"",,,Dark count calibration image +flat,s,h,"",,,Flat field images +illum,s,h,"",,,Illumination correction images +fringe,s,h,"",,,Fringe correction images +minreplace,r,h,1.,,,Minimum flat field value +scantype,s,h,"shortscan","shortscan|longscan",,Scan type (shortscan|longscan) +nscan,i,h,1,1,,"Number of short scan lines +" +interactive,b,h,no,,,Fit overscan interactively? +function,s,h,"legendre",,,Fitting function +order,i,h,1,1,,Number of polynomial terms or spline pieces +sample,s,h,"*",,,Sample points to fit +naverage,i,h,1,,,Number of sample points to combine +niterate,i,h,1,0,,Number of rejection iterations +low_reject,r,h,3.,0.,,Low sigma rejection factor +high_reject,r,h,3.,0.,,High sigma rejection factor +grow,r,h,0.,0.,,Rejection growing radius diff --git a/noao/imred/ccdred/ccdred.cl b/noao/imred/ccdred/ccdred.cl new file mode 100644 index 00000000..d289b1ed --- /dev/null +++ b/noao/imred/ccdred/ccdred.cl @@ -0,0 +1,29 @@ +#{ CCDRED -- CCD Reduction Package + +set ccddb = "ccdred$ccddb/" +set ccdtest = "ccdred$ccdtest/" + +package ccdred + +task $ccdtest = ccdtest$ccdtest.cl + +task badpiximage, + ccdgroups, + ccdhedit, + ccdinstrument, + ccdlist, + ccdmask, + ccdproc, + combine, + mkfringecor, + mkillumcor, + mkillumflat, + mkskycor, + mkskyflat = ccdred$x_ccdred.e + +task darkcombine = ccdred$darkcombine.cl +task flatcombine = ccdred$flatcombine.cl +task setinstrument = ccdred$setinstrument.cl +task zerocombine = ccdred$zerocombine.cl + +clbye() diff --git a/noao/imred/ccdred/ccdred.hd b/noao/imred/ccdred/ccdred.hd new file mode 100644 index 00000000..c98f5a87 --- /dev/null +++ b/noao/imred/ccdred/ccdred.hd @@ -0,0 +1,38 @@ +# Help directory for the CCDRED package. + +$doc = "./doc/" + +badpiximage hlp=doc$badpiximage.hlp +ccdgroups hlp=doc$ccdgroups.hlp +ccdhedit hlp=doc$ccdhedit.hlp +ccdlist hlp=doc$ccdlist.hlp +ccdmask hlp=doc$ccdmask.hlp +ccdproc hlp=doc$ccdproc.hlp +combine hlp=doc$combine.hlp +darkcombine hlp=doc$darkcombine.hlp +flatcombine hlp=doc$flatcombine.hlp +mkfringecor hlp=doc$mkfringecor.hlp +mkillumcor hlp=doc$mkillumcor.hlp +mkillumflat hlp=doc$mkillumflat.hlp +mkskycor hlp=doc$mkskycor.hlp +mkskyflat hlp=doc$mkskyflat.hlp +setinstrument hlp=doc$setinstrument.hlp +zerocombine hlp=doc$zerocombine.hlp + +ccdgeometry hlp=doc$ccdgeometry.hlp +ccdinstrument hlp=doc$ccdinst.hlp +ccdtypes hlp=doc$ccdtypes.hlp +flatfields hlp=doc$flatfields.hlp +guide hlp=doc$guide.hlp +instruments hlp=doc$instruments.hlp +package hlp=doc$ccdred.hlp +subsets hlp=doc$subsets.hlp + +revisions sys=Revisions + +$ccdtest = "noao$imred/ccdred/ccdtest/" + +ccdtest men=ccdtest$ccdtest.men, + hlp=.., + pkg=ccdtest$ccdtest.hd, + src=ccdtest$ccdtest.cl diff --git a/noao/imred/ccdred/ccdred.men b/noao/imred/ccdred/ccdred.men new file mode 100644 index 00000000..cbd02af8 --- /dev/null +++ b/noao/imred/ccdred/ccdred.men @@ -0,0 +1,28 @@ + badpiximage - Create a bad pixel mask image from a bad pixel file + ccdgroups - Group CCD images into image lists + ccdhedit - CCD image header editor + ccdinstrument - Review and edit instrument translation files + ccdlist - List CCD processing information + ccdmask - Create bad pixel mask from CCD flat field images + ccdproc - Process CCD images + ccdtest - CCD test and demonstration package + combine - Combine CCD images + darkcombine - Combine and process dark count images + flatcombine - Combine and process flat field images + mkfringecor - Make fringe correction images from sky images + mkillumcor - Make flat field illumination correction images + mkillumflat - Make illumination corrected flat fields + mkskycor - Make sky illumination correction images + mkskyflat - Make sky corrected flat field images + setinstrument - Set instrument parameters + zerocombine - Combine and process zero level images + + ADDITIONAL HELP TOPICS + + ccdgeometry - Discussion of CCD coordinate/geometry keywords + ccdtypes - Description of the CCD image types + flatfields - Discussion of CCD flat field calibrations + guide - Introductory guide to using the CCDRED package + instruments - Instrument specific data files + package - CCD image reduction package + subsets - Description of CCD subsets diff --git a/noao/imred/ccdred/ccdred.par b/noao/imred/ccdred/ccdred.par new file mode 100644 index 00000000..218e7421 --- /dev/null +++ b/noao/imred/ccdred/ccdred.par @@ -0,0 +1,12 @@ +# CCDRED package parameter file + +pixeltype,s,h,"real real",,,Output and calculation pixel datatypes +verbose,b,h,no,,,Print log information to the standard output? +logfile,f,h,"logfile",,,Text log file +plotfile,f,h,"",,,Log metacode plot file +backup,s,h,"",,,Backup directory or prefix +instrument,s,h,"",,,CCD instrument file +ssfile,s,h,"subsets",,,Subset translation file +graphics,s,h,"stdgraph",,,Interactive graphics output device +cursor,*gcur,h,"",,,Graphics cursor input +version,s,h,"2: October 1987" diff --git a/noao/imred/ccdred/ccdtest/artobs.cl b/noao/imred/ccdred/ccdtest/artobs.cl new file mode 100644 index 00000000..b64294a6 --- /dev/null +++ b/noao/imred/ccdred/ccdtest/artobs.cl @@ -0,0 +1,109 @@ +# ARTOBS -- Make a CCD observation + +procedure artobs (image, exptime, ccdtype) + +string image {prompt="Image name"} +real exptime {prompt="Exposure time"} +string ccdtype {prompt="CCD type"} + +int ncols=132 {prompt="Number of columns"} +int nlines=100 {prompt="Number of lines"} +string filter="" {prompt="Filter"} +string datasec="[1:100,1:100]" {prompt="Data section"} +string trimsec="[3:98,3:98]" {prompt="Trim section"} +string biassec="[103:130,*]" {prompt="Bias section"} + +file imdata="" {prompt="Image data"} +real skyrate=0. {prompt="Sky count rate"} +file badpix="" {prompt="Bad pixel regions"} +real biasval=500. {prompt="Bias value"} +real badval=500. {prompt="Bad pixel value"} +real zeroval=100. {prompt="Zero level value"} +real darkrate=1. {prompt="Dark count rate"} +real zeroslope=0.01 {prompt="Slope of zero level"} +real darkslope=0.002 {prompt="Slope of dark count rate"} +real flatslope=0.0003 {prompt="Flat field slope"} +real sigma=5. {prompt="Gaussian sigma"} +int seed=0 {prompt="Random number seed"} +bool overwrite=no {prompt="Overwrite existing image?"} + +begin + int c1, c2, l1, l2 + real exp, value, valslope + string im, type, s + + im = image + exp = exptime + type = ccdtype + + if (access (im//".imh") == yes) + im = im // ".imh" + if (access (im//".hhh") == yes) + im = im // ".hhh" + if (access (im) == yes) { + if (overwrite == yes) + imdelete (im, verify=no) + else + return + } + + # Create the image. + s = str (ncols) // " " // str (nlines) + mkimage (im, "make", 0., 2, s, pixtype="short", slope=0., sigma=sigma, + seed=seed) + + # Add a data image. + if (access (imdata//".imh") == yes) + imdata = imdata // ".imh" + if (access (imdata//".hhh") == yes) + imdata = imdata // ".hhh" + if (access (imdata) == yes) + imcopy (imdata//datasec, im//datasec, verbose=no) + + # Add sky. + value = exp * skyrate + if (value != 0.) + mkimage (im//datasec, "add", value, slope=0., sigma=0.) + + # Add flat field response. + if (flatslope != 0.) + mkimage (im//datasec, "mul", 1., slope=flatslope, sigma=0.) + + # Add zero level and dark count. + value = zeroval + exp * darkrate + valslope = zeroslope + exp * darkslope + if ((value != 0.) && (valslope != 0.)) + mkimage (im//datasec, "add", value, slope=valslope, sigma=0.) + + # Add bias. + if (biasval != 0.) + mkimage (im, "add", biasval, slope=0., sigma=sigma, seed=0) + + # Set bad pixels. + if (access (badpix)) { + list = badpix + while (fscan (list, c1, c2, l1, l2) != EOF) { + if (nscan() != 4) + next + c1 = max (1, c1) + c2 = min (ncols, c2) + l1 = max (1, l1) + l2 = min (nlines, l2) + s = "["//c1//":"//c2//","//l1//":"//l2//"]" + mkimage (im//s, "replace", badval, slope=0., sigma=0.) + } + } + + # Set image header + ccdhedit (im, "exptime", exp, type="real") + if (type != "") + ccdhedit (im, "imagetyp", type, type="string") + if (datasec != "") + ccdhedit (im, "datasec", datasec, type="string") + if (trimsec != "") + ccdhedit (im, "trimsec", trimsec, type="string") + if (biassec != "") + ccdhedit (im, "biassec", biassec, type="string") + if (filter != "") + ccdhedit (im, "subset", filter, type="string") +end diff --git a/noao/imred/ccdred/ccdtest/artobs.hlp b/noao/imred/ccdred/ccdtest/artobs.hlp new file mode 100644 index 00000000..02f2cf0f --- /dev/null +++ b/noao/imred/ccdred/ccdtest/artobs.hlp @@ -0,0 +1,127 @@ +.help artobs Oct87 noao.imred.ccdred.ccdtest +.ih +NAME +artobs -- Make a demonstration CCD observation +.ih +USAGE +artobs image exptime ccdtype +.ih +PARAMETERS +.ls image +Observation to be created. +.le +.ls exptime +Exposure time of observation. +.le +.ls ccdtype +CCD image type of observation. This type is one of the standard types +for the CCDRED package. +.le +.ls ncols = 132, nlines = 100 +The number of columns and lines in the full image created including +bias section. +.le +.ls filter = "" +Filter string for the observation. +.le +.ls datasec = "[1:100,1:100]" +Data section of the observation. +.le +.ls trimsec = "[3:98,3:98]" +Trim section for later processing. +.le +.ls biassec = "[103:130,*]" +Prescan or overscan bias section. +.le +.ls imdata = "" +Image to be used as source of observation if specified. The image must +be at least as large as the data section. +.le +.ls skyrate = 0. +Sky counting rate. The total sky value will be scaled by the exposure time. +.le +.ls badpix = "" +Bad pixel region file in the standard CCDRED bad pixel file format. +.le +.ls biasval = 500. +Mean bias value of the entire image. +.le +.ls badval = 500. +Bad pixel value placed at the specified bad pixel regions. +.le +.ls zeroval = 100. +Zero level of the data section. +.le +.ls darkrate = 1. +Dark count rate. The total dark count will be scaled by the exposure time +.le +.ls zeroslope = 0.01 +Slope of the zero level per pixel. +.le +.ls darkslope = 0.002 +Slope of the dark count rate per pixel. This is also scaled by the exposure +time. +.le +.ls flatslope = 3.0000000000000E-4 +The mean flat field response is 1 with a slope given by this value. +.le +.ls sigma = 5. +Gaussian noise sigma per pixel. +.le +.ls seed = 0 +Random number seed. If zero new values are used for every observation. +.le +.ls overwrite = no +Overwrite an existing image? If no a new observation is not created. +There is no warning message. +.le +.ih +DESCRIPTION +This script task generates artificial CCD observations which include +bad pixels, bias and zero levels, dark counts, flat field response +variations and sky brightness levels. Optionally, image data from +a reference image may be included. This task is designed to be used +with the \fBccdred\fR package and includes appropriate image header +information. + +First the task checks whether the requested image exists. If it does +exist and the overwrite flag is no then a new observations is not created. +If the overwrite flag is set then the old image is deleted and a new +observation is created. + +An empty image of the specified size and of pixel data type short is +first created. If a noise sigma is specified it is added to the entire +image. If a reference image is specified then image section given by +the \fIdatasec\fR parameter is copied into the data section of the +observation. Next a sky level, specified by the \fIskyrate\fR +parameter times the exposure time, is added to the data section. +The flat field response with a mean of one and a slope given by the +\fIflatslope\fR parameter is multiplied into the data section. If +a dark count rate and/or a zero level is specified then these effects +are added to the data section. Then the specified bias level +is added to the entire image; i.e. including the bias section. +Finally, the pixels specified in the bad pixel region file, if one +is specified, are set to the bad pixel value. + +The CCD reduction parameters for the data section, the trim section, +the bias section, exposure time, the CCD image type, and the filter +are added to the image header (if they are specified) using \fBccdhedit\fR +to apply any keyword translation. +.ih +EXAMPLES +1. To create some test CCD images first set the task parameters such as +number of columns and lines, data, bias, and trim sections, and data +values. The images are then created as follows: + + cl> artobs.filter = "V" # Set the filter + cl> artobs zero 0. zero # Zero level image + cl> artobs dark 1000. dark skyrate=0. # Dark count image + cl> artobs flat 1. flat skyrate=1000. # Flat field image + cl> artobs obj 10. object # Object image + +Note that the CCD image type is not used explicitly so that for a +dark count image you must set the sky count rate to zero. +.ih +SEE ALSO +mkimage, subsection, demo +.endhelp diff --git a/noao/imred/ccdred/ccdtest/badpix.dat b/noao/imred/ccdred/ccdtest/badpix.dat new file mode 100644 index 00000000..92b13aa9 --- /dev/null +++ b/noao/imred/ccdred/ccdtest/badpix.dat @@ -0,0 +1,4 @@ +10 10 1 1000 +20 20 1 20 +30 30 50 100 +1 1000 50 50 diff --git a/noao/imred/ccdred/ccdtest/ccdtest.cl b/noao/imred/ccdred/ccdtest/ccdtest.cl new file mode 100644 index 00000000..eb3f8b68 --- /dev/null +++ b/noao/imred/ccdred/ccdtest/ccdtest.cl @@ -0,0 +1,10 @@ +#{ CCDTEST -- CCDRED Test package + +package ccdtest + +task mkimage = ccdtest$x_ccdred.e +task artobs = ccdtest$artobs.cl +task subsection = ccdtest$subsection.cl +task demo = ccdtest$demo.cl + +clbye() diff --git a/noao/imred/ccdred/ccdtest/ccdtest.hd b/noao/imred/ccdred/ccdtest/ccdtest.hd new file mode 100644 index 00000000..4218f9b0 --- /dev/null +++ b/noao/imred/ccdred/ccdtest/ccdtest.hd @@ -0,0 +1,6 @@ +# Help directory for the CCDTEST package. + +demo hlp=demo.hlp, src=demo.cl +mkimage hlp=mkimage.hlp, src=t_mkimage.x +artobs hlp=artobs.hlp, src=artobs.cl +subsection hlp=subsection.hlp, src=subsection.cl diff --git a/noao/imred/ccdred/ccdtest/ccdtest.men b/noao/imred/ccdred/ccdtest/ccdtest.men new file mode 100644 index 00000000..f2b3909d --- /dev/null +++ b/noao/imred/ccdred/ccdtest/ccdtest.men @@ -0,0 +1,4 @@ + artobs - Create an artificial CCD observation + demo - Run a demonstration of the CCD reduction package + mkimage - Make or modify an image with simple values + subsection - Create an artificial subsection CCD observation diff --git a/noao/imred/ccdred/ccdtest/demo.cl b/noao/imred/ccdred/ccdtest/demo.cl new file mode 100644 index 00000000..213500c4 --- /dev/null +++ b/noao/imred/ccdred/ccdtest/demo.cl @@ -0,0 +1 @@ +stty (playback=demofile, verify=yes) diff --git a/noao/imred/ccdred/ccdtest/demo.dat b/noao/imred/ccdred/ccdtest/demo.dat new file mode 100644 index 00000000..733a319b --- /dev/null +++ b/noao/imred/ccdred/ccdtest/demo.dat @@ -0,0 +1,182 @@ +\O=NOAO/IRAF V2.5 valdes@lyra Mon 15:42:35 12-Oct-87 +\T=vt640 +\G=vt640 +clear\n\{%V-%!200\} +\n\{%10000 + CCD REDUCTION DEMONSTRATION + + In this demonstration we are going to make some (artificial) CCD + observations which we will reduce using the CCDRED package. The + dome is opening and we are ready to begin observing...\} +\n\{%V-\} +unlearn\sccdred;unlearn\sccdtest\n\{ # Initialize parameters and data...\} +imdelete\s%B%%*.*\sv-\n\{%V-\} +imrename\sB*.*\s%B%%*.*\sv-\n\{%V-\} +imdelete\sZero*.*,Flat*.*\n\{%V-\} +delete\sDemo*\sv-\n\{%V-\} +\n\{%V-\} +setinstrument\sdemo\sreview-\n\{ # Set instrument parameters...\} +lpar\sartobs\n\{ # List observing parameters...\} +artobs\sobs001\s0.\szero\n\{%15000 # Observe zero level images...\} +artobs\sobs002\s0.\szero\n\{%V-\} +artobs\sobs003\s0.\szero\n\{%V-\} +artobs\sobs004\s0.\szero\n\{%V-\} +artobs\sobs005\s0.\szero\n\{%V-\} +\n\{%V-\} +artobs.skyrate=0\n\{ # Observe a long dark count...\} +artobs\sobs006\s1000.\sdark\n\{%V-\} +\n\{%V-\} +artobs.filter="V"\n\{ # Observe V flat fields...\} +artobs.skyrate=2000\n\{%V-\} +artobs\sobs007\s1.\sflat\n\{%V-\} +artobs\sobs008\s1.\sflat\n\{%V-\} +artobs\sobs009\s1.\sflat\n\{%V-\} +artobs\sobs010\s1.\sflat\n\{%V-\} +artobs\sobs011\s2.\sflat\n\{%V-\} +artobs\sobs012\s2.\sflat\n\{%V-\} +\n\{%V-\} +artobs.filter="B"\n\{ # Observe B flat fields...\} +artobs.skyrate=1000\n\{%V-\} +artobs\sobs013\s1.\sflat\n\{%V-\} +artobs\sobs014\s2.\sflat\n\{%V-\} +artobs\sobs015\s3.\sflat\n\{%V-\} +artobs\sobs016\s3.\sflat\n\{%V-\} +artobs\sobs017\s3.\sflat\n\{%V-\} +artobs\sobs018\s3.\sflat\n\{%V-\} +\n\{%V-\} +artobs.filter="V"\n\{ # Observe objects...\} +artobs.skyrate=100\n\{%V-\} +artobs\sobs019\s10.\sobject\simdata=dev$pix\n\{%V-\} +artobs\sobs020\s20.\sobject\simdata=dev$pix\n\{%V-\} +artobs.filter="B"\n\{%V-\} +artobs\sobs021\s30.\sobject\simdata=dev$pix\n\{%V-\} +artobs\sobs022\s40.\sobject\simdata=dev$pix\n\{%V-\} +\n\{%V-\} +lpar\ssubsection\n\{ # Subsection readout parameters...\} +subsection\sobs023\sobs019\n\{%5000 # Readout a subsection of the CCD...\} +dir\n\{ # Check directory of observations...\} +clear\n\{%10000 # Continue...\} +\n\{%15000 + INSTRUMENT SETUP + + Because there are a variety of instruments, observatories, and data + formats there are many parameters. To set all of these conveniently + there is a task which reads setup files prepared by the observing + staff. The setup task: + 1. Defines an instrument header translation file which + translates the image header parameters to something + the CCDRED package understands. This is an important + feature of the package. + 2. It runs a setup script which sets parameters and performs + other functions desired by the observing staff. + 3. The user is then given the opportunity to modify the + package and processing parameters...\} +\n\{%V-\} +setinstrument\smode=m\n\{ # Set demo instrument parameters...\} +demo\r +\{%5000\}^Z +\{%5000\}^Z +\{%5000\}\r +\r +\r +\r +\r +\r +\r +\r +\r +\r +\r +\r +\r +\r +\r +\r +\r +\r +\r +Zero\r +\r +Flat*.*\r +^Z +clear\n\{%5000 # Continue...\} +\n\{%20000 + IMAGE HEADERS + + The CCDRED package uses image header information if present. This + includes the type of data (object, flat field, etc.), exposure + time, region of image containing the data, processing status, and + more. To make this more general there is a instrument header + translation file to translate image header keywords to the standard + names used by the package. In this example the image header + keywords are identical to the package except that the image type is + CCDTYPE, the exposure time is INTEG and the subset parameter is + FILTER. Let's look at the image header using the the standard + image header lister and the special one in the CCDRED package. + This special lister provides additional information about image + types and processing status...\} + +\n\{%V-\} +imheader\sobs023\sl+\n\{ # List object image header...\} +ccdlist\sobs*.*\n\{%5000 # List short CCD status...\} +ccdlist\sobs023\sl+\n\{%5000 # List long CCD status...\} +clear\n\{%5000 # Continue...\} +\n\{%20000 + COMBINE CALIBRATION IMAGES + + In order to reduce calibration noise and eliminate cosmic ray events + we combine many zero level and flat field calibration images. The + combining task provides many options. We will combine the images by + scaling each image to the same exposure time, rejecting the highest + pixel at each image point, and taking a weighted average of the + remainder. Flat field images must be combined separately for each + filter. We will simply specify all the images and the task automatically + selects the appropriate images to combine! ...\} +\n\{%V-\} +zerocombine\smode=m\n\{ # Combine zero level images...\} +obs*.*\r +\{%5000\}^Z +flatcombine\smode=m\n\{ # Combine flat field images...\} +obs*.*\r +\{%5000\}^Z +clear\n\{%5000 # Continue...\} +\n\{%15000 + PROCESS OBSERVATIONS + + We are now ready to process our observations. The processing steps we + have selected are to replace bad pixels by interpolation, fit and + subtract a readout bias given by an overscan strip, subtract the zero + level calibration image, scale and subtract a dark count calibration, + divide by a flat field, trim the image of the overscan strip and border + columns and lines. The task which does this is "ccdproc". The task is + expert at reducing CCD observations easily and efficiently. It checks + the image types, applies the proper filter flat field, applies the + proper part of the calibration images to subsection readouts, does only + the processing steps selected if not done previously, and automatically + processes the calibration images as needed. As before we simply specify + all the images and the task selects the appropriate images to process + including finding the one dark count image "obs006". Watch the log + messages to see what the task is doing...\} +\n\{%V-\} +ccdproc\sobs*.*\n\{ # Process object images...\} +\n\{%V-\} +\{%V-\}q0,+,\r +NO\n\{%V-\} +\n\{%10000 + That's it! We're done. Now lets check the results. The "ccdlist" + listing will show the processing status and the images are now smaller + and of pixel datatype real. The CCDSEC parameter identifies the relation + of the image to the actual CCD pixels of the detector...\} +\n\{%V-\} +ccdlist\sobs*.*\sccdtype=object\n\{ # List short CCD status...\} +ccdlist\sobs023\sl+\n\{%5000 # List long CCD status...\} +imhead\sobs023\sl+\n\{%5000 # List object image header...\} +dir\n\{%5000 # Check the data directory...\} +\n\{%V- + We specified that the original images be saved by using the prefix B. + We are also left with a text log file, a metacode file containing the + fits to the overscan regions, and a file which maps the filter subset + strings to short identifiers used in CCDLIST and when creating the + combined images "FlatV" and "FlatB". You may look through these files, + or use GKIMOSAIC to examine the metacode file, now if you want. +\} diff --git a/noao/imred/ccdred/ccdtest/demo.hlp b/noao/imred/ccdred/ccdtest/demo.hlp new file mode 100644 index 00000000..c03d5efb --- /dev/null +++ b/noao/imred/ccdred/ccdtest/demo.hlp @@ -0,0 +1,27 @@ +.help demo Oct87 noao.imred.ccdred.ccdtest +.ih +NAME +demo -- Run a demonstration of the CCD reduction package +.ih +USAGE +demo +.ih +PARAMETERS +.ls demofile = "ccdtest$demo.dat" +Demonstration playback file. +.le +.ih +DESCRIPTION +This script task runs a demonstration playback. The playback file +is specified by a hidden parameter. Normally this default playback file +is used. The default demonstration will use the task \fBtv.display\fR if it +is loaded to show you the CCD frames being processed. +.ih +EXAMPLES +1. To run a demonstration of the \fBccdred\fR package: + + cl> demo +.ih +SEE ALSO +stty +.endhelp diff --git a/noao/imred/ccdred/ccdtest/demo.par b/noao/imred/ccdred/ccdtest/demo.par new file mode 100644 index 00000000..70bee0f3 --- /dev/null +++ b/noao/imred/ccdred/ccdtest/demo.par @@ -0,0 +1 @@ +demofile,s,h,"ccdtest$demo.dat",,,Demonstration playback file diff --git a/noao/imred/ccdred/ccdtest/mkimage.hlp b/noao/imred/ccdred/ccdtest/mkimage.hlp new file mode 100644 index 00000000..2be4ab5b --- /dev/null +++ b/noao/imred/ccdred/ccdtest/mkimage.hlp @@ -0,0 +1,87 @@ +.help mkimage Oct87 noao.imred.ccdred.ccdtest +.ih +NAME +mkimage -- Make or modify and image with simple values +.ih +USAGE +mkimage image option value [ndim dims] +.ih +PARAMETERS +.ls image +Image to create or modify. +.le +.ls option +Editing option which is one of the following: +.ls make +Make a new image of the specified size, dimensionality, pixel type, and values. +.le +.ls replace +Replace pixel values in the image. +.le +.ls add +Add to the pixel values in the image. +.le +.ls multiply +Multiply the pixel values in the image. +.le +.le +.ls value +Mean pixel value to be used. +.le +.ls ndim +Number of dimensions when creating a new image. +.le +.ls dims +Image dimensions given as a white space separated string (see the examples). +.le +.ls pixtype = "real" +Pixel datatype when creating an image. The types are "real", "short", +"integer", "long", and "double". +.le +.ls slope = 0. +Slope of pixel values per pixel. +.le +.ls sigma = 0. +Gaussian noise of pixel values if not zero. +.le +.ls seed = 0 +Seed for random numbers. If zero then the first time the task is +called a seed of 1 is used and all subsequent calls while the task is in +the process cache continue with new random numbers. +.le +.ih +DESCRIPTION +An image is created or modified using simple values. This task is intended +for test and demonstration purposes. A image may be created of a specified +size, dimensionality, and pixel datatype. The pixel values used in creating +or editing an image consist of a sloped plane (which repeats for dimensions +greater than 2) with pseudo-Gaussian noise. The sloped plane is defined such +that: + + pix[i,j] = value + slope * ((ncols + nlines) / 2 - 1) + slope * (i + j) + +where i and j are the pixel indices (starting with 1) and ncols and nlines +are the number of columns and lines. The interpretation of "value" is that +it is the mean of the plane. The Gaussian noise is only approximately random +for purposes of speed! +.ih +EXAMPLES +1. To create an 2 dimensional real image of size 100 x 200 with all zero +values: + + cl> mkimage name make 0 2 "100 200" + +Note that the dimension string is quoted because of the blank separated +values. + +2. To add noise with a sigma of 5: + + cl> mkimage name add 0 sigma=5 + +2. To replace a region of the image with the value 10: + + cl> mkimage name[10:20,30:40] replace 10 +.ih +SEE ALSO +artobs, subsection +.endhelp diff --git a/noao/imred/ccdred/ccdtest/mkimage.par b/noao/imred/ccdred/ccdtest/mkimage.par new file mode 100644 index 00000000..148bf7ea --- /dev/null +++ b/noao/imred/ccdred/ccdtest/mkimage.par @@ -0,0 +1,10 @@ +image,s,a,,,,Image to make or modify +option,s,a,,"make|replace|add|multiply",,Editing option +value,r,a,,,,Mean pixel value +slope,r,h,0.,,,Slope of pixel values +sigma,r,h,0.,0.,,Noise sigma +seed,i,h,0,0,,Seed for noise generator + +ndim,i,a,,1,7,Number of dimensions +dims,s,a,,,,Image dimensions +pixtype,s,h,"real","short|real",,Pixel datatype diff --git a/noao/imred/ccdred/ccdtest/mkpkg b/noao/imred/ccdred/ccdtest/mkpkg new file mode 100644 index 00000000..79fcb59c --- /dev/null +++ b/noao/imred/ccdred/ccdtest/mkpkg @@ -0,0 +1,10 @@ +# Make CCDTEST Package. + +$checkout libpkg.a .. +$update libpkg.a +$checkin libpkg.a .. +$exit + +libpkg.a: + t_mkimage.x <imhdr.h> + ; diff --git a/noao/imred/ccdred/ccdtest/subsection.cl b/noao/imred/ccdred/ccdtest/subsection.cl new file mode 100644 index 00000000..60522c8b --- /dev/null +++ b/noao/imred/ccdred/ccdtest/subsection.cl @@ -0,0 +1,53 @@ +# SUBSECTION -- Make a subsection CCD observation + +procedure subsection (subimage, image) + +string subimage {prompt="Subsection image name"} +string image {prompt="Full image name"} + +int ncols=82 {prompt="Number of columns"} +int nlines=50 {prompt="Number of lines"} +string ccdsec="[26:75,26:75]" {prompt="CCD section"} +string datasec="[1:50,1:50]" {prompt="Data section"} +string trimsec="" {prompt="Trim section"} +string biassec="[51:82,1:50]" {prompt="Bias section"} +bool overwrite=no {prompt="Overwrite existing image?"} + +begin + string im, imdata, s + real biasval, sigma + + im = subimage + imdata = image + biasval = artobs.biasval + sigma = artobs.sigma + + if (access (im//".imh") == yes) + im = im // ".imh" + if (access (im//".hhh") == yes) + im = im // ".hhh" + if (access (im) == yes) { + if (overwrite == yes) + imdelete (im, verify=no) + else + return + } + + # Create the image. + s = "[1:" // str (ncols) // ",1:" // str(nlines) // "]" + imcopy (imdata//s, im, verbose=no) + + # Copy subsection image. + imcopy (imdata//ccdsec, im//datasec, verbose=no) + + # Add bias. + if (biasval != 0.) + mkimage (im//biassec, "replace", biasval, slope=0., sigma=sigma, + seed=0) + + # Set image header + ccdhedit (im, "ccdsec", ccdsec, type="string") + ccdhedit (im, "datasec", datasec, type="string") + ccdhedit (im, "trimsec", trimsec, type="string") + ccdhedit (im, "biassec", biassec, type="string") +end diff --git a/noao/imred/ccdred/ccdtest/subsection.hlp b/noao/imred/ccdred/ccdtest/subsection.hlp new file mode 100644 index 00000000..a2779500 --- /dev/null +++ b/noao/imred/ccdred/ccdtest/subsection.hlp @@ -0,0 +1,73 @@ +.help subsection Oct87 noao.imred.ccdred.ccdtest +.ih +NAME +subsection -- Make a subsection readout CCD image +.ih +USAGE +subsection subimage image +.ih +PARAMETERS +.ls subimage +Subsection image to be created. +.le +.ls image +Full image from which to take the subsection readout. +.le +.ls ncols = 82, nlines = 50 +Number of image columns and lines in the full subsection image including +bias regions. +.le +.ls ccdsec="[26:75,26:75]" +CCD section of the subsection. This is the image section of the full +image to be used. +.le +.ls datasec = "[1:50,1:50]" +Data section of the image. +.le +.ls trimsec = "" +Trim section for later processing. +.le +.ls biassec="[51:82,1:50]" +Prescan or overscan bias section. +.le +.ls overwrite = no +Overwrite an existing image? If no a new observation is not created. +There is no warning message. +.le +.ih +DESCRIPTION +This script task generates artificial CCD subsection observations +which include bad pixels, bias and zero levels, dark counts, flat +field response variations and sky brightness levels. It creates an +subsection image which includes a bias section from a previously +created image (created by the task \fBartobs\fR). This task is +designed to be used with the \fBccdred\fR package and includes +appropriate image header information. + +First the task checks whether the requested image exists. If it does +exist and the overwrite flag is no then a new observations is not created. +If the overwrite flag is set then the old image is deleted and a new +observation is created. + +The image section give by the parameter \fIccdsec\fR of the reference +image is copied to the new image. It is assumed the reference image +contains any desired zero level, bias, flat field, and dark count +effects. The bias section is then added with a bias value given by +\fBartobs.biasval\fR with noise given by \fBartobs.sigma\fR. + +Also the image header parameters from the reference image are +copied and the data, bias, trim, and ccd section parameters are +updated. +.ih +EXAMPLES +1. To create some test CCD images first create full frame observations with +the task \fBartobs\fR. Then set the subsection parameters +for the size of the subsection observation, the data section, trim section, +bias section, and the CCD section of the subsection observation. + + cl> artobs obj 5 object filter=V + cl> subsection obj1 object +.ih +SEE ALSO +mkimage, artobs, demo +.endhelp diff --git a/noao/imred/ccdred/ccdtest/t_mkimage.x b/noao/imred/ccdred/ccdtest/t_mkimage.x new file mode 100644 index 00000000..ff0d5f26 --- /dev/null +++ b/noao/imred/ccdred/ccdtest/t_mkimage.x @@ -0,0 +1,204 @@ +include <imhdr.h> + +define OPTIONS "|make|replace|add|multiply|" +define MAKE 1 # Create a new image +define REPLACE 2 # Replace pixels +define ADD 3 # Add to pixels +define MULTIPLY 4 # Multiply pixels + +# T_MKIMAGE -- Make or edit an image with simple values. +# An image may be created of a specified size, dimensionality, and pixel +# datatype. The image may also be edited to replace, add, or multiply +# by specified values. The values may be a combination of a sloped plane +# (repeated for dimensions greater than 2) and Gaussian noise. +# The editing may be confined to sections of the image by use of image +# sections in the input image. This task is a simple tool for +# specialized uses in test applications. +# +# The sloped plane is defined such that: +# +# pix[i,j] = value + slope * ((ncols + nlines) / 2 - 1) + slope * (i + j) +# +# The interpretation of value is that it is the mean of the plane. +# +# The Gaussian noise is only approximately random for purposes of speed! + +procedure t_mkimage () + +char image[SZ_FNAME] # Image to edit +char option[7] # Edit option +real value # Edit value +real slope # Slope +real sigma # Gaussian noise sigma +long seed # Random number seed + +int i, op, ncols, nlines +long vin[IM_MAXDIM], vout[IM_MAXDIM] +pointer sp, rannums, im, buf, bufin, bufout + +int clgwrd(), clgeti(), clscan(), nscan() imgnlr(), impnlr() +char clgetc() +real clgetr() +long clgetl() +pointer immap() + +data seed/1/ + +begin + call smark (sp) + call clgstr ("image", image, SZ_FNAME) + op = clgwrd ("option", option, 7, OPTIONS) + value = clgetr ("value") + slope = clgetr ("slope") + sigma = clgetr ("sigma") + if (clgetl ("seed") > 0) + seed = clgetl ("seed") + + call amovkl (long (1), vin, IM_MAXDIM) + call amovkl (long (1), vout, IM_MAXDIM) + switch (op) { + case MAKE: + im = immap (image, NEW_IMAGE, 0) + IM_NDIM(im) = clgeti ("ndim") + i = clscan ("dims") + do i = 1, IM_NDIM(im) + call gargi (IM_LEN(im, i)) + if (nscan() != IM_NDIM(im)) + call error (0, "Bad dimension string") + switch (clgetc ("pixtype")) { + case 's': + IM_PIXTYPE(im) = TY_SHORT + case 'i': + IM_PIXTYPE(im) = TY_INT + case 'l': + IM_PIXTYPE(im) = TY_LONG + case 'r': + IM_PIXTYPE(im) = TY_REAL + case 'd': + IM_PIXTYPE(im) = TY_DOUBLE + default: + call error (0, "Bad pixel type") + } + + ncols = IM_LEN(im,1) + nlines = IM_LEN(im,2) + call salloc (rannums, 2 * ncols, TY_REAL) + call mksigma (sigma, seed, Memr[rannums], 2*ncols) + + while (impnlr (im, bufout, vout) != EOF) + call mkline (value, slope, sigma, seed, Memr[rannums], + Memr[bufout], vout[2] - 1, ncols, nlines) + case REPLACE: + im = immap (image, READ_WRITE, 0) + + ncols = IM_LEN(im,1) + nlines = IM_LEN(im,2) + call salloc (rannums, 2 * ncols, TY_REAL) + call mksigma (sigma, seed, Memr[rannums], 2*ncols) + + while (impnlr (im, bufout, vout) != EOF) + call mkline (value, slope, sigma, seed, Memr[rannums], + Memr[bufout], vout[2] - 1, ncols, nlines) + case ADD: + im = immap (image, READ_WRITE, 0) + + ncols = IM_LEN(im,1) + nlines = IM_LEN(im,2) + call salloc (buf, ncols, TY_REAL) + call salloc (rannums, 2 * ncols, TY_REAL) + call mksigma (sigma, seed, Memr[rannums], 2*ncols) + + while (imgnlr (im, bufin, vin) != EOF) { + i = impnlr (im, bufout, vout) + call mkline (value, slope, sigma, seed, Memr[rannums], + Memr[buf], vout[2] - 1, ncols, nlines) + call aaddr (Memr[bufin], Memr[buf], Memr[bufout], ncols) + } + case MULTIPLY: + im = immap (image, READ_WRITE, 0) + + ncols = IM_LEN(im,1) + nlines = IM_LEN(im,2) + call salloc (buf, ncols, TY_REAL) + call salloc (rannums, 2 * ncols, TY_REAL) + call mksigma (sigma, seed, Memr[rannums], 2*ncols) + + while (imgnlr (im, bufin, vin) != EOF) { + i = impnlr (im, bufout, vout) + call mkline (value, slope, sigma, seed, Memr[rannums], + Memr[buf], vout[2] - 1, ncols, nlines) + call amulr (Memr[bufin], Memr[buf], Memr[bufout], ncols) + } + } + + call imunmap (im) + call sfree (sp) +end + + +# MKLINE -- Make a line of data. A slope of zero is a special case. +# The Gaussian random numbers are taken from the sequence of stored +# values with starting point chosen randomly in the interval 1 to ncols. +# This is not very random but is much more efficient. + +procedure mkline (value, slope, sigma, seed, rannums, data, line, ncols, nlines) + +real value # Mean value +real slope # Slope in mean +real sigma # Sigma about mean +long seed # Random number seed +real rannums[ARB] # Random numbers +real data[ncols] # Data for line +int line # Line number +int ncols # Number of columns +int nlines # Number of lines + +int i +real a, urand() + +begin + if (slope == 0.) + call amovkr (value, data, ncols) + else { + a = value + slope * (line - (ncols + nlines) / 2. - 1) + do i = 1, ncols + data[i] = a + slope * i + } + if (sigma > 0.) { + i = (ncols - 1) * urand (seed) + 1 + call aaddr (rannums[i], data, data, ncols) + } +end + + +# MKSIGMA -- A sequence of random numbers of the specified sigma and +# starting seed is generated. The random number generator is modeled after +# that in Numerical Recipes by Press, Flannery, Teukolsky, and Vetterling. + +procedure mksigma (sigma, seed, rannums, nnums) + +real sigma # Sigma for random numbers +long seed # Seed for random numbers +real rannums[nnums] # Random numbers +int nnums # Number of random numbers + +int i +real v1, v2, r, fac, urand() + +begin + if (sigma > 0.) { + for (i=1; i<=nnums; i=i+1) { + repeat { + v1 = 2 * urand (seed) - 1. + v2 = 2 * urand (seed) - 1. + r = v1 ** 2 + v2 ** 2 + } until ((r > 0) && (r < 1)) + fac = sqrt (-2. * log (r) / r) * sigma + rannums[i] = v1 * fac + if (i == nnums) + break + i = i + 1 + rannums[i] = v2 * fac + } + } +end diff --git a/noao/imred/ccdred/combine.par b/noao/imred/ccdred/combine.par new file mode 100644 index 00000000..0a1ae2f8 --- /dev/null +++ b/noao/imred/ccdred/combine.par @@ -0,0 +1,40 @@ +# COMBINE -- Image combine parameters + +input,s,a,,,,List of images to combine +output,s,a,,,,List of output images +plfile,s,h,"",,,List of output pixel list files (optional) +sigma,s,h,"",,,"List of sigma images (optional) +" +ccdtype,s,h,"",,,CCD image type to combine (optional) +subsets,b,h,no,,,Combine images by subset parameter? +delete,b,h,no,,,Delete input images after combining? +clobber,b,h,no,,,"Clobber existing output image? +" +combine,s,h,"average","average|median",,Type of combine operation +reject,s,h,"none","none|minmax|ccdclip|crreject|sigclip|avsigclip|pclip",,Type of rejection +project,b,h,no,,,Project highest dimension of input images? +outtype,s,h,"real","short|ushort|integer|long|real|double",,Output image pixel datatype +offsets,f,h,"none",,,Input image offsets +masktype,s,h,"none","none|goodvalue|badvalue|goodbits|badbits",,Mask type +maskvalue,r,h,0,,,Mask value +blank,r,h,0.,,,"Value if there are no pixels +" +scale,s,h,"none",,,Image scaling +zero,s,h,"none",,,Image zero point offset +weight,s,h,"none",,,Image weights +statsec,s,h,"",,,"Image section for computing statistics +" +lthreshold,r,h,INDEF,,,Lower threshold +hthreshold,r,h,INDEF,,,Upper threshold +nlow,i,h,1,0,,minmax: Number of low pixels to reject +nhigh,i,h,1,0,,minmax: Number of high pixels to reject +nkeep,i,h,1,,,Minimum to keep (pos) or maximum to reject (neg) +mclip,b,h,yes,,,Use median in sigma clipping algorithms? +lsigma,r,h,3.,0.,,Lower sigma clipping factor +hsigma,r,h,3.,0.,,Upper sigma clipping factor +rdnoise,s,h,"0.",,,ccdclip: CCD readout noise (electrons) +gain,s,h,"1.",,,ccdclip: CCD gain (electrons/DN) +snoise,s,h,"0.",,,ccdclip: Sensitivity noise (fraction) +sigscale,r,h,0.1,0.,,Tolerance for sigma clipping scaling corrections +pclip,r,h,-0.5,,,pclip: Percentile clipping parameter +grow,i,h,0,,,Radius (pixels) for 1D neighbor rejection diff --git a/noao/imred/ccdred/cosmicrays.par b/noao/imred/ccdred/cosmicrays.par new file mode 100644 index 00000000..3d14b146 --- /dev/null +++ b/noao/imred/ccdred/cosmicrays.par @@ -0,0 +1,15 @@ +input,s,a,,,,List of images in which to detect cosmic rays +output,s,a,,,,List of cosmic ray replaced output images (optional) +badpix,s,h,"",,,"List of bad pixel files (optional) +" +ccdtype,s,h,"",,,CCD image type to select (optional) +threshold,r,h,25.,,,Detection threshold above mean +fluxratio,r,h,2.,,,Flux ratio threshold (in percent) +npasses,i,h,5,1,,Number of detection passes +window,s,h,"5","5|7",,"Size of detection window +" +interactive,b,h,yes,,,Examine parameters interactively? +train,b,h,no,,,Use training objects? +objects,*imcur,h,"",,,Cursor list of training objects +savefile,f,h,"",,,File to save train objects +answer,s,q,,"no|yes|NO|YES",,Review parameters for a particular image? diff --git a/noao/imred/ccdred/darkcombine.cl b/noao/imred/ccdred/darkcombine.cl new file mode 100644 index 00000000..715456eb --- /dev/null +++ b/noao/imred/ccdred/darkcombine.cl @@ -0,0 +1,48 @@ +# DARKCOMBINE -- Process and combine dark count CCD images. + +procedure darkcombine (input) + +string input {prompt="List of dark images to combine"} +file output="Dark" {prompt="Output dark image root name"} +string combine="average" {prompt="Type of combine operation", + enum="average|median"} +string reject="minmax" {prompt="Type of rejection", + enum="none|minmax|ccdclip|crreject|sigclip|avsigclip|pclip"} +string ccdtype="dark" {prompt="CCD image type to combine"} +bool process=yes {prompt="Process images before combining?"} +bool delete=no {prompt="Delete input images after combining?"} +bool clobber=no {prompt="Clobber existing output image?"} +string scale="exposure" {prompt="Image scaling", + enum="none|mode|median|mean|exposure"} +string statsec="" {prompt="Image section for computing statistics"} +int nlow=0 {prompt="minmax: Number of low pixels to reject"} +int nhigh=1 {prompt="minmax: Number of high pixels to reject"} +int nkeep=1 {prompt="Minimum to keep (pos) or maximum to reject (neg)"} +bool mclip=yes {prompt="Use median in sigma clipping algorithms?"} +real lsigma=3. {prompt="Lower sigma clipping factor"} +real hsigma=3. {prompt="Upper sigma clipping factor"} +string rdnoise="0." {prompt="ccdclip: CCD readout noise (electrons)"} +string gain="1." {prompt="ccdclip: CCD gain (electrons/DN)"} +string snoise="0." {prompt="ccdclip: Sensitivity noise (fraction)"} +real pclip=-0.5 {prompt="pclip: Percentile clipping parameter"} +real blank=0. {prompt="Value if there are no pixels"} + +begin + string ims + + ims = input + + # Process images first if desired. + if (process == YES) + ccdproc (ims, output="", ccdtype=ccdtype, noproc=no) + + # Combine the flat field images. + combine (ims, output=output, plfile="", sigma="", combine=combine, + reject=reject, ccdtype=ccdtype, subsets=no, delete=delete, + clobber=clobber, project=no, outtype="real", offsets="none", + masktype="none", blank=blank, scale=scale, zero="none", weight=no, + statsec=statsec, lthreshold=INDEF, hthreshold=INDEF, nlow=nlow, + nhigh=nhigh, nkeep=nkeep, mclip=mclip, lsigma=lsigma, hsigma=hsigma, + rdnoise=rdnoise, gain=gain, snoise=snoise, sigscale=0.1, + pclip=pclip, grow=0) +end diff --git a/noao/imred/ccdred/doc/Notes b/noao/imred/ccdred/doc/Notes new file mode 100644 index 00000000..209faf30 --- /dev/null +++ b/noao/imred/ccdred/doc/Notes @@ -0,0 +1,96 @@ +12/15/93: +I have modified CCDPROC to more fully support scan table observations. In +combination with the ability to have the number of scan rows encoded in the +image header automatically, this allows such data to be processed in a +fairly foolproof and documented way. + +First if ccdproc.scancor=no then the NSCANROW keyword and nscan parameter +are ignored. For actual scanned data this may be useful to override +things. Otherwise the following steps are taken. The logic is slightly +complex so that everything is done in the right order and only as needed. + +The task wants to apply dark count and flat field calibration images which +have been scanned by the same number of rows. [Zero calibration images are +assumed not to be scanned. This made sense to me but if desired the zero +images can also be treated like the darks and flats.] This is similar to +the way flat fields are checked for subset (filter/grating). If the +appropriate dark or flat has not been scanned then it is scanned in +software; i.e. a moving average is taken over the unscanned image. + +The number of scan rows is determined for each object being processed from +the NSCANROW keyword or appropriate translation in the header translation +file. If this keyword is not found the nscan parameter value is used; +i.e. it is assumed the object image has been scanned by the specified +amount. This allows using the software in cases where the number of scan +rows is not encoded in the header. In the case of dark and flat images if +NSCANROW is not found a value of 1 (unscanned) is assumed. + +The set of possible calibration images (from the zero and flat parameters +or the list of input images) is searched for one which has been scanned +with the same number of lines as the object being processed. If one is +found it is processed as needed before applying to the object. If one is +not found then an unscanned one is sought. It is an error if neither can +be found. An unscanned image is first processed as necessary (overscan, +trim, etc.) and then scanned in software to create a new image. The new +image has the name of the unscanned image with the number of scan lines +appended, for example Flat1.32. It also has the NSCANROW keyword added as +well as a comment indicating the image from which it was created. This +approach allows the calibration image to be created only once for each +different scan format and the number of scan lines may be changed for +different observations and the appropriate calibration made from the +unscanned image. + +The following example shows how this all works. There are four object +images using two filters and two scan row values and unscanned +zero, dark, and flats. + +cc> dir +Dark.imh FlatV.imh obs019.imh obs021.imh pixels +FlatB.imh Zero.imh obs020.imh obs022.imh +cc> hselect obs* $I,filter,nscanrow yes +obs019.imh V 24 +obs020.imh V 32 +obs021.imh B 24 +obs022.imh B 32 +cc> ccdproc obs* overscan+ trim+ zerocor+ darkcor+ flatcor+ scancor+ +obs019.imh: Dec 15 17:53 Zero level correction image is Zero +Dark.imh: Dec 15 17:53 Zero level correction image is Zero +Dark.24.imh: Dec 15 17:53 Converted to shortscan from Dark.imh with nscan=24 +obs019.imh: Dec 15 17:53 Dark count correction image is Dark.24.imh +FlatV.imh: Dec 15 17:53 Zero level correction image is Zero +FlatV.imh: Dec 15 17:53 Dark count correction image is Dark.imh +FlatV.24.imh: Dec 15 17:53 Converted to shortscan from FlatV.imh with nscan=24 +obs019.imh: Dec 15 17:53 Flat field image is FlatV.24.imh +obs020.imh: Dec 15 17:53 Zero level correction image is Zero +Dark.32.imh: Dec 15 17:53 Converted to shortscan from Dark.imh with nscan=32 +obs020.imh: Dec 15 17:53 Dark count correction image is Dark.32.imh +FlatV.32.imh: Dec 15 17:53 Converted to shortscan from FlatV.imh with nscan=32 +obs020.imh: Dec 15 17:53 Flat field image is FlatV.32.imh +obs021.imh: Dec 15 17:53 Zero level correction image is Zero +obs021.imh: Dec 15 17:53 Dark count correction image is Dark.24.imh +FlatB.imh: Dec 15 17:53 Zero level correction image is Zero +FlatB.imh: Dec 15 17:53 Dark count correction image is Dark.imh +FlatB.24.imh: Dec 15 17:53 Converted to shortscan from FlatB.imh with nscan=24 +obs021.imh: Dec 15 17:53 Flat field image is FlatB.24.imh +obs022.imh: Dec 15 17:53 Zero level correction image is Zero +obs022.imh: Dec 15 17:53 Dark count correction image is Dark.32.imh +FlatB.32.imh: Dec 15 17:53 Converted to shortscan from FlatB.imh with nscan=32 +obs022.imh: Dec 15 17:53 Flat field image is FlatB.32.imh +cc> ccdlist *.imh +cc> ccdlist *.imh +Dark.24.imh[96,96][real][dark][][OTZ]: +Dark.32.imh[96,96][real][dark][][OTZ]: +Dark.imh[96,96][real][dark][][OTZ]: +FlatB.24.imh[96,96][real][flat][B][OTZD]: +FlatB.32.imh[96,96][real][flat][B][OTZD]: +FlatB.imh[96,96][real][flat][B][OTZD]: +FlatV.24.imh[96,96][real][flat][V][OTZD]: +FlatV.32.imh[96,96][real][flat][V][OTZD]: +FlatV.imh[96,96][real][flat][V][OTZD]: +Zero.imh[96,96][real][zero][][OT]: +obs019.imh[96,96][real][object][V][OTZDF]: +obs020.imh[96,96][real][object][V][OTZDF]: +obs021.imh[96,96][real][object][B][OTZDF]: +obs022.imh[96,96][real][object][B][OTZDF]: + +Frank diff --git a/noao/imred/ccdred/doc/badpiximage.hlp b/noao/imred/ccdred/doc/badpiximage.hlp new file mode 100644 index 00000000..46e13160 --- /dev/null +++ b/noao/imred/ccdred/doc/badpiximage.hlp @@ -0,0 +1,51 @@ +.help badpiximage Jun87 noao.imred.ccdred +.ih +NAME +badpiximage -- Create a bad pixel mask image from a bad pixel file +.ih +USAGE +badpiximage fixfile template image +.ih +PARAMETERS +.ls fixfile +Bad pixel file. +.le +.ls template +Template image used to define the size of the bad pixel mask image. +.le +.ls image +Bad pixel mask image to be created. +.le +.ls goodvalue = 1 +Integer value assigned to the good pixels. +.le +.ls badvalue = 0 +Integer value assigned to the bad pixels. +.le +.ih +DESCRIPTION +A bad pixel mask image is created from the specified bad pixel file. +The format of the bad pixel file is that used by \fBccdproc\fR to +correct CCD defects (see instruments). The bad pixel image is of pixel type short and +has the value given by the parameter \fBgoodvalue\fR for the good +pixels and the value given by the parameter \fBbadvalue\fR for the bad pixels. +The image size and header parameters are taken from the specified +template image. The bad pixel mask image may be used to view the +location of the bad pixels and blink against an data image using an +image display, to mask or flag bad pixels later by image arithmetic, +and to propagate the positions of the bad pixels through the +reductions. +.ih +EXAMPLES +1. To make a bad pixel mask image from the bad pixel file "cryocambp.dat" +using the image "ccd005" as the template: + + cl> badpiximage cryocambp.dat ccd005 cryocambp + +2. To make the bad pixel mask image with good values of 0 and bad values of 1: + + cl> badpixim cryomapbp.dat ccd005 cryocambp good=0 bad=1 +.ih +SEE ALSO +ccdproc, instruments +.endhelp diff --git a/noao/imred/ccdred/doc/ccdgeometry.hlp b/noao/imred/ccdred/doc/ccdgeometry.hlp new file mode 100644 index 00000000..a051ae5e --- /dev/null +++ b/noao/imred/ccdred/doc/ccdgeometry.hlp @@ -0,0 +1,73 @@ +.help ccdgeometry Sep87 noao.imred.ccdred +.ih +NAME +ccdgeometry - Discussion of CCD geometry and header parameters +.ih +DESCRIPTION +The \fBccdred\fR package maintains and updates certain geometry +information about the images. This geometry is described by four image +header parameters which may be present. These are defined below by the +parameter names used in the package. Note that these names may be +different in the image header using the image header translation +feature of the package. + +.ls DATASEC +The section of the image containing the CCD data. If absent the +entire image is assumed to be data. Only the pixels within the +data section are modified during processing. Therefore, there may be +additional calibration or observation information in the image. +If after processing, the data section is the entire image it is +not recorded in the image header. +.le +.ls CCDSEC +The section of the CCD to corresponding to the data section. This +refers to the physical format, columns and lines, of the detector. This is +the coordinate system used during processing to relate calibration +data to the image data; i.e. image data pixels are calibrated by +calibration pixels at the same CCD coordinates regardless of image pixel +coordinates. This allows recording only parts of the CCD during data +taking and calibrating with calibration frames covering some or all of +the CCD. The CCD section is maintained during trimming operations. +Note that changing the format of the images by image operators outside +of the \fBccdred\fR package will invalidate this coordinate system. +The size of the CCD section must agree with that of the data section. +If a CCD section is absent then it defaults to the data section such +that the first pixel of the data section has CCD coordinate (1,1). +.le +.ls BIASSEC +The section of the image containing prescan or overscan bias information. +It consists of a strip perpendicular to the readout axis. There may be +both a prescan and overscan but the package currently only uses one. +This parameter may be overridden during processing by the parameter +\fIccdproc.biassec\fR. Only the part of the bias section along the +readout is used and the length of the bias region is determined by +the trim section. If one wants to limit the region of the bias +strip used in the fit then the \fIsample\fR parameter should be used. +.le +.ls TRIMSEC +The section of the image extracted during processing when the trim +operation is selected (\fIccdproc.trim\fR). If absent when the trim +operation is selected it defaults to the data section; i.e. the processed +image consists only of the data section. This parameter may be overridden +during processing by the parameter \fIccdproc.trimsec\fR. After trimming +this parameter, if present, is removed from the image header. The +CCD section, data section, and bias section parameters are also modified +by trimming. +.le + +The geometry is as follows. When a CCD image is recorded it consists +of a data section corresponding to part or all of the CCD detector. +Regions outside of the data section may contain additional information +which are not affected except by trimming. Most commonly this consists +of prescan and overscan bias data. When recording only part of the +full CCD detector the package maintains information about that part and +correctly applies calibrations for that part of the detector. Also any +trimming operation updates the CCD coordinate information. If the +images include the data section, bias section, trim section, and ccd +section the processing may be performed entirely automatically. + +The sections are specified using the notation [c1:c2,l1:l2] where c1 +and c2 are the first and last columns and l1 and l2 are the first and +last lines. Currently c1 and l1 must be less than c2 and l2 +respectively and no subsampling is allowed. This may be added later. +.endhelp diff --git a/noao/imred/ccdred/doc/ccdgroups.hlp b/noao/imred/ccdred/doc/ccdgroups.hlp new file mode 100644 index 00000000..48c29b99 --- /dev/null +++ b/noao/imred/ccdred/doc/ccdgroups.hlp @@ -0,0 +1,163 @@ +.help ccdgroups Jun87 noao.imred.ccdred +.ih +NAME +ccdgroups -- Group CCD images into image lists +.ih +USAGE +ccdgroups images output +.ih +PARAMETERS +.ls images +List of CCD images to be grouped. +.le +.ls output +Output root group filename. The image group lists will be put in files +with this root name followed by a number. +.le +.ls group = "ccdtype" +Group type. There are currently four grouping types: +.ls ccdtype +Group by CCD image type. +.le +.ls subset +Group by subset parameter. +.le +.ls position +Group by position in right ascension (in hours) and declination (in degrees). +The groups are defined by a radius parameter (in arc seconds). +.le +.ls title +Group by identical titles. +.le +.ls date +Group by identical dates. +.le +.le +.ls radius = 60. +Grouping radius when grouping by positions. This is given in arc seconds. +.le +.ls ccdtype = "" +CCD image types to select from the input image list. If null ("") then +all image types are used. +.le +.ih +DESCRIPTION +The input images, possible restricted to a particular CCD image type, +are grouped into image lists. The "ccdtype" or "subset" groups +produce output image lists with the given root name and the CCD type +or subset as an extension (without a period). For the other group +types the +image lists have file names given by +the root output name and a numeric extension (without a period). +If the package parameter \fIccdred.verbose\fR is yes then the +image name and output group list is printed for each image. The image lists can +be used with the @ list feature for processing separate groups of observations. +Note that grouping by CCD image type and subset is often not necessary since +the \fBccdred\fR tasks automatically use this information (see +\fBccdtypes\fR and \fBsubsets\fR). + +Besides CCD image type and subsets there are currently three ways to +group images. These are by position in the sky, by title, and by +date. Further groups may be added as suggested. The title grouping is +useful if consistent titles are used when taking data. The date +grouping is useful if multiple nights of observations are not organized +by directories (it is recommended that data from separate nights be +kept in separate directories). The position grouping finds +observations within a given radius on the sky of the first member of +the group (this is not a clustering algorithm). The right ascension +and declination coordinates must be in standard units, hours and +degrees respectively. The grouping radius is in arc seconds. This +grouping type is useful for making sets of data in which separate +calibration images are taken at each position. + +The date, title, and coordinates are accessed through the instrument +translation file. The standard names used are "date-obs", "title", "ra", +and "dec". +.ih +EXAMPLES +1. For each object 5 exposures were taken to be combined in order to remove +cosmic rays. If the titles are the same then (with ccdred.verbose=yes): + +.nf + cl> ccdgroups *.imh group group=title ccdtype=object + ccd005.imh --> group1 + ccd006.imh --> group1 + ccd007.imh --> group1 + ccd008.imh --> group1 + ccd009.imh --> group1 + ccd012.imh --> group2 + ccd013.imh --> group2 + ccd014.imh --> group2 + ccd015.imh --> group2 + ccd016.imh --> group2 + [... etc ...] + cl> combine @group1 obj1 proc+ + cl> combine @group2 obj2 proc+ + [... etc ...] +.fi + +Note the numeric suffixes to the output root name "group". + +2. CCD observations were made in groups with a flat field, the object, and +a comparison spectrum at each position. To group and process this data: + +.nf + cl> ccdgroups *.imh obs group=position >> logfile + cl> ccdproc @obs1 + cl> ccdproc @obs2 + cl> ccdproc @obs3 +.fi + +Since no flat field is specified for the parameter \fIccdproc.flat\fR +the flat field is taken from the input image list. + +3. If for some reason you want to group by date and position it is possible +to use two steps. + +.nf + cl> ccdgroups *.imh date group=date + cl> ccdgroups @data1 pos1 + cl> ccdgroups @data2 pos2 +.fi + +4. To get groups by CCD image type: + +.nf + cl> ccdgroups *.imh "" group=ccdtype + ccd005.imh --> zero + ccd006.imh --> zero + ccd007.imh --> zero + ccd008.imh --> dark + ccd009.imh --> flat + ccd012.imh --> flat + ccd013.imh --> object + ccd014.imh --> object + ccd015.imh --> object + ccd016.imh --> object + [... etc ...] +.fi + +Note the use of a null root name and the extension is the standard +CCDRED types (not necessarily those used in the image header). + +5. To get groups by subset: + +.nf + cl> ccdgroups *.imh filt group=subset + ccd005.imh --> filt + ccd006.imh --> filtB + ccd007.imh --> filtB + ccd008.imh --> filtB + ccd009.imh --> filtV + ccd012.imh --> filtV + ccd013.imh --> filtV + ccd014.imh --> filtB + ccd015.imh --> filtB + ccd016.imh --> filtB + [... etc ...] +.fi + +.ih +SEE ALSO +ccdlist, ccdtypes, instruments, subsets +.endhelp diff --git a/noao/imred/ccdred/doc/ccdhedit.hlp b/noao/imred/ccdred/doc/ccdhedit.hlp new file mode 100644 index 00000000..1bc27d29 --- /dev/null +++ b/noao/imred/ccdred/doc/ccdhedit.hlp @@ -0,0 +1,108 @@ +.help ccdhedit Jun87 noao.imred.ccdred +.ih +NAME +ccdhedit -- CCD image header editor +.ih +USAGE +ccdhedit images parameter value +.ih +PARAMETERS +.ls images +List of CCD images to be edited. +.le +.ls parameter +Image header parameter. The image header parameter will be translated by +the header translation file for the images. +.le +.ls value +The parameter value. If the null string ("") is specified then the +parameter is deleted from the image header, otherwise it is added or +modified. If the parameter is "imagetyp" then the value string giving +the CCD image type is translated from the package CCD type to the +instrument specific string. +.le +.ls type = "string" +The parameter type. The parameter types are "string", "real", or "integer". +.le +.ih +DESCRIPTION +The image headers of the specified CCD images are edited to add, modify, +or delete a parameter. The parameters may be those used by the \fBccdred\fR +package. The parameter name is translated to an image header parameter by the +instrument translation file (see \fBinstruments\fR) if a translation is +given. Otherwise the parameter is that in the image header. If the parameter +is "imagetyp" the parameter value for the CCD image type may be that +used by the package; i.e. dark, object, flat, etc. The value string will be +translated to the instrument image string in this case. The translation +facility allows use of this task in an instrument independent way. + +The value string is used to determine whether to delete or modify the +image parameter. If the null string, "", is given the specified parameter +is deleted. If parameters are added the header type must be specified +as a string, real, or integer parameter. The numeric types convert the +value string to a number. +.ih +EXAMPLES +The \fBccdred\fR package is usable even with little image header information. +However, if desired the header information can be added to images which +lack it. In all the examples the parameters used are those of the package +and apply equally well to any image header format provided there is an +instrument translation file. + +.nf +1. cl> ccdhedit obj* imagetyp object +2. cl> ccdhedit flat* imagetyp flat +3. cl> ccdhedit zero* imagetyp zero +4. cl> ccdhedit obj0![1-3]* subset "V filter" +5. cl> ccdhedit obj0![45]* subset "R filter" +6. cl> ccdhedit flat001 subset "R filter" +7. cl> ccdhedit obj* exptime 500 type=integer +.fi + +8. The following is an example of a CL script which sets the CCD image type, +the subset, and the exposure time simultaneously. The user may expand +on this example to include other parameters or other initialization +operations. + +.nf + cl> edit ccdheader.cl + + ---------------------------------------------------------------- + # Program to set CCD header parameters. + + procedure ccdheader (images) + + string images {prompt="CCD images"} + string imagetyp {prompt="CCD image type"} + string subset {prompt="CCD subset"} + string exptime {prompt="CCD exposure time"} + + begin + string ims + + ims = images + ccdhedit (ims, "imagetyp", imagetyp, type="string") + ccdhedit (ims, "subset", subset, type="string") + ccdhedit (ims, "exptime", exptime, type="real") + end + ---------------------------------------------------------------- + + cl> task ccdheader=ccdheader.cl + cl> ccdheader obj* imagetyp=object subset="V" exptime=500 +.fi + +9. The image header may be changed to force processing a calibration image +as an object. For example to flatten a flat field: + +.nf + cl> ccdhedit testflat imagetyp other + cl> ccdproc testflat +.fi + +10. To delete processing flags: + + cl> ccdhedit obj042 flatcor "" +.ih +SEE ALSO +hedit, instruments, ccdtypes, subsets +.endhelp diff --git a/noao/imred/ccdred/doc/ccdinst.hlp b/noao/imred/ccdred/doc/ccdinst.hlp new file mode 100644 index 00000000..ea90f4a7 --- /dev/null +++ b/noao/imred/ccdred/doc/ccdinst.hlp @@ -0,0 +1,391 @@ +.help ccdinstrument Dec93 noao.imred.ccdred +.ih +NAME +ccdinstrument -- Setup and verify CCD instrument translation files +.ih +USAGE +ccdinstrument images +.ih +PARAMETERS +.ls images +List of images to be verified or used to setup a CCD instrument translation +file. +.le +.ls instrument = ")_.instrument" +CCD instrument translation file. The default is to use the translation +file defined in the \fBccdred\fR package parameters. Note that one would +need write permission to update this file though the task has a write +command to save any changes to a different file. +.le +.ls ssfile = ")_.ssfile" +Subset translation file. The default is to use the file defined in +the \fBccdred\fR package parameters. +.le +.ls edit = yes +Edit the instrument translation file? If "yes" an interactive +mode is entered allowing translation parameters to be modified while if +"no" the task is simply used to verify the translations noninteractively. +.le +.ls parameters = "basic" +Parameters to be displayed. The choices are "basic" to display only the +most basic parameters (those needed for the simplest automation of +\fBccdred\fR tasks), "common" to display the common parameters used +by the package (most of these are keywords to be written to the image +rather than translated), and "all" to display all the parameters +referenced by the package including the most obscure. For most uses +the "basic" set is all that is important and the other options are +included for completeness. +.le +.ih +DESCRIPTION +The purpose of this task is to provide an interface to simplify setting +up CCD instrument translation files and to verify the translations +for a set of images. Before this task was written users who needed to +set up translation files for new instruments and observatories had +to directly create the files with an editor. Many people encountered +difficulties and were prone to errors. Also there was no task that +directly verified the translations though \fBccdlist\fR provided some +clues. + +The \fBccdred\fR package was designed to make intelligent use of +information in image headers for determining things such as image +calibration or object type and exposure times. While the package may +be used without this capability it is much more convenient to be +able to use information from the image. The package was also intended +to be used with many different instruments, detectors, and observatories. +The key to providing image header access across different observatories +is the ability to translate the needs of the package to the appropriate +keywords in the image header. This is done through a file called +an "instrument translation file". For a complete description of +this file and other instrument setup features of the package see +\fBccdred.instruments\fR. + +The instrument translation file translates the parameter names used by +the \fBccdred\fR package into image specific parameters and also +supplies default values for parameters. The translation proceeds as +follows. When a package task needs a parameter for an image, for +example "imagetyp", it looks in the instrument translation file. If +the file is not found or none is specified then the image header +keyword that is requested is assumed to have the same name. If an +instrument translation file is defined then the requested parameter is +translated to an image header keyword, provided a translation entry is +given. If no translation is given the package name is used. For +example the package parameter "imagetyp" might be translated to +"data-typ" (the old NOAO CCD keyword). If the parameter is not found +then the default value specified in the translation file, if present, +is returned. + +For recording parameter information in the header, such +as processing flags, translation is also used. For example, if the +flag specifying that the image has been corrected by a flat field is to +be set then the package parameter name "flatcor" might be translated to +"ff-flag". If no translation is given then the new image header +parameter is entered as "flatcor". + +The CCD image type requires a second level of translation also defined +in the translation file. Once the image keyword which identifies the +type of CCD image, for example a flat field or object, is translated +to an imahe keyword the specific +string value must be translated to one of the CCD image types used +by the package. The translation works in the same way, the specific +string found is translated to the \fBccdred\fR type and returned to +the task. This translation is tricky in that the exact string +including all spaces and capitalizations must be correctly defined +in the translation file. The \fBccdinstrument\fR allows doing +this automatically thus minimizing typing errors. + +The basic display format of the task is a table of five columns +giving the parameter name used by the package, the image keyword +to which it is translated, the default value (if any), the value +the task will receive for the current image after translation, +and the actual keyword value in the image. A "?" is printed if +a value cannot be determined. The idea of the task is to make sure +that the value a \fBccdred\fR task sees is the correct one and if not +to modify the translation appropriately. In verify mode when the +\fBedit\fR parameter is not set the translation table is simply +printed for each input image. + +In edit mode the user interactively gives commands at the ccdinstrument +prompt to display or modify keywords. The modifications can then be +written to the instrument file or saved in a private copy. The +list of commands is shown below and may be printed using ? or help. + +.in 4 +.nf + CCDINSTRUMENT COMMANDS + +? Print command summary +help Print command summary +imheader Page image header +instrument Print current instrument translation file +next Next image +newimage Select a new image +quit Quit +read Read instrument translation file +show Show current translations +write Write instrument translation file + +translate Translate image string selected by the imagetyp + parameter to one of the CCDRED types given as an + argument or queried: + object, zero, dark, flat, comp, illum, fringe, other + +.fi +The following are CCDRED parameters which may be translated. You are +queried for the image keyword to use or it may be typed after the command. +An optional default value (returned if the image does not contain the +keyword) may be typed as the second argument of the command. +.nf + + BASIC PARAMETERS +imagetyp Image type parameter (see also translate) +subset Subset or filter parameter +exptime Exposure time +darktime Dark time (may be same as the exposure time) +.fi +.in -4 + +The commands may be followed by values such as file names for some of +the general commands or the keyword and default value for the parameters +to be translated. Note this is the only way to specify a default value. +If no arguments are given the user is prompted with the current value +which may then be changed. + +The set of parameters shown above are only those considered "basic". +In order to avoid confusion the task can limit the set of parameters +displayed. Without going into great detail, it is only the basic +parameters which are generally required to have valid translations to +allow the package to work well. However, for completeness, and if someone +wants to go wild with translations, further parameters may be displayed +and changed. The parameters displayed is controlled by the \fIparameters\fR +keyword. The additional parameters not shown above are: + +.in 4 +.nf + USEFUL DEFAULT GEOMETRY PARAMETERS +biassec Bias section (often has a default value) +trimsec Trim section (often has a default value) + + COMMON PROCESSING FLAGS +fixpix Bad pixel replacement flag +overscan Overscan correction flag +trim Trim flag +zerocor Zero level correction flag +darkcor Dark count correction flag +flatcor Flat field correction flag + + RARELY TRANSLATED PARAMETERS +ccdsec CCD section +datasec Data section +fixfile Bad pixel file + +fringcor Fringe correction flag +illumcor Ilumination correction flag +readcor One dimensional zero level read out correction +scancor Scan mode correction flag +nscanrow Number of scan rows + +illumflt Ilumination flat image +mkfringe Fringe image +mkillum Iillumination image +skyflat Sky flat image + +ccdmean Mean value +ccdmeant Mean value compute time +fringscl Fringe scale factor +ncombine Number of images combined +date-obs Date of observations +dec Declination +ra Right Ascension +title Image title +.fi +.in -4 +.ih +EXAMPLES +1. To verify the translations for a set of images using the default +translation file: + +.nf + cl> setinst "" review- + cl> ccdinst dev$pix edit- + Image: dev$pix + Instrument file: + Subset file: subsets + + CCDRED IMAGE DEFAULT CCDRED IMAGE + PARAM KEYWORD VALUE VALUE VALUE + -------------------------------- + imagetyp imagetyp none ? + subset subset ? + exptime exptime ? ? + darktime darktime ? ? + + cl> setinst "" site=kpno dir=ccddb$ review- + cl> ccdinst dev$pix edit- + Image: dev$pix + + Instrument file: ccddb$kpno/camera.dat + Subset file: subsets + + CCDRED IMAGE DEFAULT CCDRED IMAGE + PARAM KEYWORD VALUE VALUE VALUE + -------------------------------- + imagetyp data-typ object OBJECT (0) + subset f1pos 2 2 + exptime otime 600 600 + darktime ttime 600 600 +.fi + +2. Set up an instrument translation file from scratch. + +.nf + ccdinst ech???.imh instr=myccd edit+ + Warning: OPEN: File does not exist (myccd) + Image: ech001.imh + Instrument file: myccd + Subset file: subsets + + CCDRED IMAGE DEFAULT CCDRED IMAGE + PARAM KEYWORD VALUE VALUE VALUE + ------------------------------------------------------ + imagetyp imagetyp none ? + subset subset ? + exptime exptime ? ? + darktime darktime ? ? + + ccdinstrument> imagetyp + Image keyword for image type (imagetyp): ccdtype + imagetyp ccdtype unknown BIAS + ccdinstrument> translate + CCDRED image type for 'BIAS' (unknown): zero + imagetyp ccdtype zero BIAS + ccdinstrument> subset + Image keyword for subset parameter (subset): filters + subset filters 1 1 0 + ccdinstrument> exptime integ + exptime integ 0. 0. + ccdinstrument> darktime integ + darktime integ 0. 0. + ccdinstrument> show + Image: ech001.imh + Instrument file: myccd + Subset file: subsets + + CCDRED IMAGE DEFAULT CCDRED IMAGE + PARAM KEYWORD VALUE VALUE VALUE + ------------------------------------------------------ + imagetyp ccdtype zero BIAS + subset filters 1 1 0 + exptime integ 0. 0. + darktime integ 0. 0. + + ccdinstrument> next + Image: ech002.imh + Instrument file: myccd + Subset file: subsets + + CCDRED IMAGE DEFAULT CCDRED IMAGE + PARAM KEYWORD VALUE VALUE VALUE + ------------------------------------------------------ + imagetyp ccdtype unknown PROJECTOR FLAT + subset filters 1 1 0 + exptime integ 20. 20. + darktime integ 20. 20. + + ccdinstrument> trans + CCDRED image type for 'PROJECTOR FLAT' (unknown): flat + imagetyp ccdtype flat PROJECTOR FLAT + ccdinstrument> next + Image: ech003.imh + Instrument file: myccd + Subset file: subsets + + CCDRED IMAGE DEFAULT CCDRED IMAGE + PARAM KEYWORD VALUE VALUE VALUE + ------------------------------------------------------ + imagetyp ccdtype unknown COMPARISON + subset filters 1 1 0 + exptime integ 300 300 + darktime integ 300 300 + + ccdinstrument> translate comp + imagetyp ccdtype comp COMPARISON + ccdinstrument> next + Image: ech004.imh + Instrument file: myccd + Subset file: subsets + + CCDRED IMAGE DEFAULT CCDRED IMAGE + PARAM KEYWORD VALUE VALUE VALUE + ------------------------------------------------------ + imagetyp ccdtype unknown OBJECT + subset filters 1 1 0 + exptime integ 3600 3600 + darktime integ 3600 3600 + + ccdinstrument> translate object + imagetyp ccdtype object OBJECT + ccdinstrument> inst + imagetyp ccdtype + BIAS zero + subset filters + exptime integ + darktime integ + 'PROJECTOR FLAT' flat + COMPARISON comp + OBJECT object + + ccdinstrument> next + Update instrument file myccd (yes)? +.fi + +3. Set default geometry parameters. Note that to set a default the +arguments must be on the command line. + +.nf + cc> ccdinst ech001 instr=myccd param=common edit+ + Image: ech001 + Instrument file: myccd + Subset file: subsets + + CCDRED IMAGE DEFAULT CCDRED IMAGE + PARAM KEYWORD VALUE VALUE VALUE + ------------------------------------------------------ + imagetyp ccdtype zero BIAS + subset filters 1 1 0 + exptime integ 0. 0. + darktime integ 0. 0. + + biassec biassec ? ? + trimsec trimsec ? ? + + fixpix fixpix no ? + overscan overscan no ? + trim trim no ? + zerocor zerocor no ? + darkcor darkcor no ? + flatcor flatcor no ? + + ccdinstrument> biassec biassec [803:830,*] + biassec biassec [803:830,*] [803:830,*] ? + ccdinstrument> trimsec trimsec [2:798,2:798] + trimsec trimsec [2:798,2:798] [2:798,2:798] ? + ccdinstrument> instr + trimsec trimsec [2:798,2:798] + biassec biassec [803:830,*] + imagetyp ccdtype + BIAS zero + subset filters + exptime integ + darktime integ + 'PROJECTOR FLAT' flat + COMPARISON comp + OBJECT object + + ccdinstrument> q + Update instrument file myccd (yes)? +.fi +.ih +SEE ALSO +instruments, setinstrument +.endhelp diff --git a/noao/imred/ccdred/doc/ccdlist.hlp b/noao/imred/ccdred/doc/ccdlist.hlp new file mode 100644 index 00000000..9ce7dfdd --- /dev/null +++ b/noao/imred/ccdred/doc/ccdlist.hlp @@ -0,0 +1,133 @@ +.help ccdlist Jun87 noao.imred.ccdred +.ih +NAME +ccdlist -- List CCD processing information +.ih +USAGE +ccdlist images +.ih +PARAMETERS +.ls images +CCD images to be listed. A subset of the these may be selected using the +CCD image type parameter. +.le +.ls ccdtype = "" +CCD image type to be listed. If no type is specified then all the images +are listed. If an image type is specified then only images +of that type are listed. See \fBccdtypes\fR for a list of the package +image types. +.le +.ls names = no +List the image names only? Used with the CCD image type parameter to make +a list of the images of the specified type. +.le +.ls long = no +Long format listing? The images are listed in a long format containing some +image parameters and the processing history. +.le +.ls ccdproc (pset) +CCD processing parameter set. +.le +.ih +DESCRIPTION +Information from the specified input images is listed on the standard +output. A specific CCD image type may be selected from the input +images by the parameter \fIccdtype\fR. There are three list formats; +the default one line per image format, an image name only format, and a +multi-line long format. The default one line format consists of the +image name, image size, image pixel type, CCD image type, subset ID (if +defined), processing flags, and title. This format contains the same +information as that produced by \fBimheader\fR as well as CCD specific +information. The processing flags identifying the processing operations +performed on the image are given by the following single letter codes. + +.nf + B - Bad pixel replacement + O - Overscan bias subtraction + T - Trimming + Z - Zero level subtraction + D - Dark count subtraction + F - Flat field calibration + I - Iillumination correction + Q - Fringe correction +.fi + +The long format has the same first line as the default format plus additional +instrument information such as the exposure time and the full processing +history. In addition to listing the completed processing, the operations +not yet done (as specified by the \fBccdproc\fR parameters) are also +listed. + +The image name only format is intended to be used to generate lists of +images of the same CCD image type. These lists may be used as "@" file +lists in IRAF tasks. +.ih +EXAMPLES +1. To list the default format for all images: + +.nf + cl> ccdlist *.imh + ccd001.imh[544,512][short][unknown][V]:FOCUS L98-193 + ccd007.imh[544,512][short][object][V]:N2968 V 600s + ccd015.imh[544,512][short][object][B]:N3098 B 500s + ccd024.imh[544,512][short][object][R]:N4036 R 600s + ccd045.imh[544,512][short][flat][V]:dflat 6v+blue 5s + ccd066.imh[544,512][short][flat][B]:dflat 6v+blue 5s + ccd103.imh[544,512][short][flat][R]:dflat 6v+blue 5s + ccd104.imh[544,512][short][zero][]:bias + ccd105.imh[544,512][short][dark][]:dark 3600s +.fi + +These images have not been processed. + +2. To restrict the listing to just the object images: + +.nf + cl> ccdlist *.imh ccdtype=object + ccd007.imh[544,512][short][object][V]:N2968 V 600s + ccd015.imh[544,512][short][object][B]:N3098 B 500s + ccd024.imh[544,512][short][object][R]:N4036 R 600s +.fi + +3. The long list for image "ccd007" is obtained by: + +.nf + cl> ccdlist ccd007 l+ + ccd007[544,512][short][object][V]:N2968 R 600s + exptime = 200. darktime = 200. + [TO BE DONE] Overscan strip is [520:540,*] + [TO BE DONE] Trim image section is [3:510,3:510] + [TO BE DONE] Flat field correction +.fi + +4. After processing the images have the short listing: + +.nf + cl> ccdlist *.imh ccdtype=object + ccd007.imh[508,508][real][object][V][OTF]:N2968 V 600s + ccd015.imh[508,508][real][object][B][OTF]:N3098 B 500s + ccd024.imh[544,512][short][object][R][OTF]:N4036 R 600s +.fi + +The processing indicated is overscan subtraction, trimming, and flat fielding. + +5. The long listing for "ccd007" after processing is: + +.nf + cl> ccdlist ccd007 l+ + ccd007[508,508][real][object][V][OTF]:N2968 R 600s + exptime = 200. darktime = 200. + Jun 2 18:18 Overscan section is [520:540,*] with mean=481.8784 + Jun 2 18:18 Trim data section is [3:510,3:510] + Jun 2 18:19 Flat field image is FlatV.imh with scale=138.2713 +.fi + +6. To make a list file containing all the flat field images: + + cl> ccdlist *.imh ccdtype=flat name+ > flats + +This file can be used as an @ file for processing. +.ih +SEE ALSO +ccdtypes ccdgroups +.endhelp diff --git a/noao/imred/ccdred/doc/ccdmask.hlp b/noao/imred/ccdred/doc/ccdmask.hlp new file mode 100644 index 00000000..190ef016 --- /dev/null +++ b/noao/imred/ccdred/doc/ccdmask.hlp @@ -0,0 +1,138 @@ +.help ccdmask Jun96 noao.imred.ccdred +.ih +NAME +ccdmask -- create a pixel mask from a CCD image +.ih +USAGE +.nf +ccdmask image mask +.fi +.ih +PARAMETERS +.ls image +CCD image to use in defining bad pixels. Typically this is +a flat field image or, even better, the ratio of two flat field +images of different exposure levels. +.le +.ls mask +Pixel mask name to be created. A pixel list image, .pl extension, +is created so no extension is necessary. +.le +.ls ncmed = 7, nlmed = 7 +The column and line size of a moving median rectangle used to estimate the +uncontaminated local signal. The column median size should be at least 3 +pixels to span single bad columns. +.le +.ls ncsig = 15, nlsig = 15 +The column and line size of regions used to estimate the uncontaminated +local sigma using a percentile. The size of the box should contain +of order 100 pixels or more. +.le +.ls lsigma = 6, hsigma = 6 +Positive sigma factors to use for selecting pixels below and above +the median level based on the local percentile sigma. +.le +.ls ngood = 5 +Gaps of undetected pixels along the column direction of length less +than this amount are also flagged as bad pixels. +.le +.ls linterp = 2 +Mask code for pixels having a bounding good pixel separation which is +smaller along lines; i.e. to use line interpolation along the narrower +dimension. +.le +.ls cinterp = 3 +Mask code for pixels having a bounding good pixel separation which is +smaller along columns; i.e. to use columns interpolation along the narrower +dimension. +.le +.ls eqinterp = 2 +Mask code for pixels having a bounding good pixel separation which is +equal along lines and columns. +.le +.ih +DESCRIPTION +\fBCcdmask\fR makes a pixel mask from pixels deviating by a specified +statistical amount from the local median level. The input images may be of +any type but this task was designed primarily for detecting column oriented +CCD defects such as charge traps that cause bad columns and non-linear +sensitivities. The ideal input is a ratio of two flat fields having +different exposure levels so that all features which would normally flat +field properly are removed and only pixels which are not corrected by flat +fielding are found to make the pixel mask. A single flat field may also be +used but pixels of low or high sensitivity may be included as well as true +bad pixels. + +The input image is first subtracted by a moving box median. The median is +unaffected by bad pixels provided the median size is larger that twice +the size of a bad region. Thus, if 3 pixel wide bad columns are present +then the column median box size should be at least 7 pixels. The median +box can be a single pixel wide along one dimension if needed. This may be +appropriate for spectroscopic long slit data. + +The median subtracted image is then divided into blocks of size +\fInclsig\fR by \fInlsig\fR. In each block the pixel values are sorted and +the pixels nearest the 30.9 and 69.1 percentile points are found; this +would be the one sigma points in a Gaussian noise distribution. The +difference between the two count levels divided by two is then the local +sigma estimate. This algorithm is used to avoid contamination by the bad +pixel values. The block size must be at least 10 pixels in each dimension +to provide sufficient pixels for a good estimate of the percentile sigma. The +sigma uncertainty estimate of each pixel in the image is then the sigma +from the nearest block. + +The deviant pixels are found by comparing the median subtracted residual to +a specified sigma threshold factor times the local sigma above and below +zero (the \fIlsigma\fR and \fIhsigma\fR parameters). This is done for +individual pixels and then for column sums of pixels (excluding previously +flagged bad pixels) from two to the number of lines in the image. The sigma +of the sums is scaled by the square root of the number of pixels summed so +that statistically low or high column regions may be detected even though +individual pixels may not be statistically deviant. For the purpose of +this task one would normally select large sigma threshold factors such as +six or greater to detect only true bad pixels and not the extremes of the +noise distribution. + +As a final step each column is examined to see if there are small +segments of unflagged pixels between bad pixels. If the length +of a segment is less than that given by the \fIngood\fR parameter +all the pixels in the segment are also marked as bad. + +The bad pixel mask is created with good pixels identified by zero values +and the bad pixels by non-zero values. +The nearest good pixels along the columns and lines for +each bad pixel are located and the separation along the columns and lines +between those pixels is computed. The smaller separation is used to select +the mask value. If the smaller separation is along lines the \fIlinterp\fR +value is set, if the smaller separation is along columns the \fIcinterp\fR +value is set, and if the two are equal the \fIeqinterp\fR value is set. +The purpose of this is to allow interpolating across bad pixels using the +narrowest dimension. The task \fBfixpix\fR can select the type of pixel +replacement to use for each mask value. So one can chose, for example, +line interpolation for the linterp values and the eqinterp values, and +column interpolation for the cinterp values. + +In addition to this task, pixel mask images may be made in a variety of +ways. Any task which produces and modifies image values may be used. Some +useful tasks are \fBimexpr, imreplace, imcopy, text2mask\fR and +\fBmkpattern\fR. If a new image is specified with an explicit ".pl" +extension then the pixel mask format is produced. +.ih +EXAMPLES +1. Two flat fields of exposures 1 second and 3 seconds are taken, +overscan and zero corrected, and trimmed. These are then used +to generate a CCD mask. + +.nf + cl> imarith flat1 / flat2 ratio + cl> ccdmask ratio mask +.fi +.ih +REVISIONS +.ls CCDMASK V2.11 +This task is new. +.le +.ih +SEE ALSO +imreplace, imexpr, imcopy, imedit, fixpix, text2mask +.endhelp diff --git a/noao/imred/ccdred/doc/ccdproc.hlp b/noao/imred/ccdred/doc/ccdproc.hlp new file mode 100644 index 00000000..26ec6d1d --- /dev/null +++ b/noao/imred/ccdred/doc/ccdproc.hlp @@ -0,0 +1,825 @@ +.help ccdproc Dec93 noao.imred.ccdred +.ih +NAME +ccdproc -- Process CCD images +.ih +USAGE +ccdproc images +.ih +PARAMETERS +.ls images +List of input CCD images to process. The list may include processed +images and calibration images. +.le +.ls output = "" +List of output images. If no list is given then the processing will replace +the input images with the processed images. If a list is given it must +match the input image list. \fINote that any dependent calibration images +still be processed in-place with optional backup.\fR +.le +.ls ccdtype = "" +CCD image type to select from the input image list. If no type is given +then all input images will be selected. The recognized types are described +in \fBccdtypes\fR. +.le +.ls max_cache = 0 +Maximum image caching memory (in Mbytes). If there is sufficient memory +the calibration images, such as zero level, dark count, and flat fields, +will be cached in memory when processing many input images. This +reduces the disk I/O and makes the task run a little faster. If the +value is zero image caching is not used. +.le +.ls noproc = no +List processing steps only? +.le + +.ce +PROCESSING SWITCHES +.ls fixpix = yes +Fix bad CCD lines and columns by linear interpolation from neighboring +lines and columns? If yes then a bad pixel mask, image, or file must be +specified. +.le +.ls overscan = yes +Apply overscan or prescan bias correction? If yes then the overscan +image section and the readout axis must be specified. +.le +.ls trim = yes +Trim the image of the overscan region and bad edge lines and columns? +If yes then the data section must be specified. +.le +.ls zerocor = yes +Apply zero level correction? If yes a zero level image must be specified. +.le +.ls darkcor = yes +Apply dark count correction? If yes a dark count image must be specified. +.le +.ls flatcor = yes +Apply flat field correction? If yes flat field images must be specified. +.le +.ls illumcor = no +Apply iillumination correction? If yes iillumination images must be specified. +.le +.ls fringecor = no +Apply fringe correction? If yes fringe images must be specified. +.le +.ls readcor = no +Convert zero level images to readout correction images? If yes then +zero level images are averaged across the readout axis to form one +dimensional zero level readout correction images. +.le +.ls scancor = no +Convert zero level, dark count and flat field images to scan mode flat +field images? If yes then the form of scan mode correction is specified by +the parameter \fIscantype\fR. +.le + +.ce +PROCESSING PARAMETERS +.ls readaxis = "line" +Read out axis specified as "line" or "column". +.le +.ls fixfile +Bad pixel mask, image, or file. If "image" is specified then the name is +specified in the image header or instrument translation file. If "BPM" is +specified then the standard BPM image header keyword defines a bad pixel +mask. A bad pixel mask is a compact format (".pl" extension) with zero +values indicating good pixels and non-zero values indicating bad pixels. A +bad pixel image is a regular image in which zero values are good pixels and +non-zero values are bad pixels. A bad pixel file specifies bad pixels or +rectangular bad pixel regions as described later. The direction of +interpolation is determined by the mask value with a value of two +interpolating across columns, a value of three interpolating across lines, +and any other non-zero value interpolating along the narrowest dimension. +.le +.ls biassec +Overscan bias strip image section. If "image" is specified then the overscan +bias section is specified in the image header or instrument translation file. +Only the part of the bias section along the readout axis is used. The +length of the bias region fit is defined by the trim section. If one +wants to limit the region of the overscan used in the fit to be less +than that of the trim section then the sample region parameter, +\fIsample\fR, should be used. It is an error if no section or the +whole image is specified. +.le +.ls trimsec +image section for trimming. If "image" is specified then the trim +image section is specified in the image header or instrument translation file. +.le +.ls zero = "" +Zero level calibration image. The zero level image may be one or two +dimensional. The CCD image type and subset are not checked for these +images and they take precedence over any zero level calibration images +given in the input list. +.le +.ls dark = "" +Dark count calibration image. The CCD image type and subset are not checked +for these images and they take precedence over any dark count calibration +images given in the input list. +.le +.ls flat = "" +Flat field calibration images. The flat field images may be one or +two dimensional. The CCD image type is not checked for these +images and they take precedence over any flat field calibration images given +in the input list. The flat field image with the same subset as the +input image being processed is selected. +.le +.ls illum = "" +Iillumination correction images. The CCD image type is not checked for these +images and they take precedence over any iillumination correction images given +in the input list. The iillumination image with the same subset as the +input image being processed is selected. +.le +.ls fringe = "" +Fringe correction images. The CCD image type is not checked for these +images and they take precedence over any fringe correction images given +in the input list. The fringe image with the same subset as the +input image being processed is selected. +.le +.ls minreplace = 1. +When processing flat fields, pixel values below this value (after +all other processing such as overscan, zero, and dark corrections) are +replaced by this value. This allows flat fields processed by \fBccdproc\fR +to be certain to avoid divide by zero problems when applied to object +images. +.le +.ls scantype = "shortscan" +Type of scan format used in creating the CCD images. The modes are: +.ls "shortscan" +The CCD is scanned over a number of lines and then read out as a regular +two dimensional image. In this mode unscanned zero level, dark count and +flat fields are numerically scanned to form scanned flat fields comparable +to the observations. +.le +.ls "longscan" +In this mode the CCD is clocked and read out continuously to form a long +strip. Flat fields are averaged across the readout axis to +form a one dimensional flat field readout correction image. This assumes +that all recorded image lines are clocked over the entire active area of the +CCD. +.le +.le +.ls nscan +Number of object scan readout lines used in short scan mode. This parameter +is used when the scan type is "shortscan" and the number of scan lines +cannot be determined from the object image header (using the keyword +nscanrows or it's translation). +.le + + +.ce +OVERSCAN FITTING PARAMETERS + +There are two types of overscan (or prescan) determinations. One determines +a independent overscan value for each line and is only available for a +\fIreadaxis\fR of 1. The other averages the overscan along the readout +direction to make an overscan vector, fits a smoothing function to the vector, +and then evaluate and then evaluates the smooth function at each readout +line or column. The line-by-line determination only uses the +\fIfunction\fR parameter and the smoothing determinations uses all +the following parameters. + +.ls function = "legendre" +Line-by-line determination of the overscan is specified by: + +.nf + mean - the mean of the biassec columns at each line + median - the median of the biassec columns at each line + minmax - the mean at each line with the min and max excluded +.fi + +The smoothed overscan vector may be fit by one of the functions: + +.nf + legendre - legendre polynomial + chebyshev - chebyshev polynomial + spline1 - linear spline + spline3 - cubic spline +.fi +.le +.ls order = 1 +Number of polynomial terms or spline pieces in the overscan fit. +.le +.ls sample = "*" +Sample points to use in the overscan fit. The string "*" specified all +points otherwise an \fBicfit\fR range string is used. +.le +.ls naverage = 1 +Number of points to average or median to form fitting points. Positive +numbers specify averages and negative numbers specify medians. +.le +.ls niterate = 1 +Number of rejection iterations to remove deviant points from the overscan fit. +If 0 then no points are rejected. +.le +.ls low_reject = 3., high_reject = 3. +Low and high sigma rejection factors for rejecting deviant points from the +overscan fit. +.le +.ls grow = 0. +One dimensional growing radius for rejection of neighbors to deviant points. +.le +.ls interactive = no +Fit the overscan vector interactively? If yes and the overscan function type +is one of the \fBicfit\fR types then the average overscan vector is fit +interactively using the \fBicfit\fR package. If no then the fitting parameters +given below are used. +.le +.ih +DESCRIPTION +\fBCcdproc\fR processes CCD images to correct and calibrate for +detector defects, readout bias, zero level bias, dark counts, +response, iillumination, and fringing. It also trims unwanted +lines and columns and changes the pixel datatype. It is efficient +and easy to use; all one has to do is set the parameters and then +begin processing the images. The task takes care of most of the +record keeping and automatically does the prerequisite processing +of calibration images. Beneath this simplicity there is much that +is going on. In this section a simple description of the usage is +given. The following sections present more detailed discussions +on the different operations performed and the order and logic +of the processing steps. For a user's guide to the \fBccdred\fR +package see \fBguide\fR. Much of the ease of use derives from using +information in the image header. If this information is missing +see section 13. + +One begins by setting the task parameters. There are many parameters +but they may be easily reviewed and modified using the task \fBeparam\fR. +The input CCD images to be processed are given as an image list. +Previously processed images are ignored and calibration images are +recognized, provided the CCD image types are in the image header (see +\fBinstruments\fR and \fBccdtypes\fR). Therefore it is permissible to +use simple image templates such as "*.imh". The \fIccdtype\fR parameter +may be used to select only certain types of CCD images to process +(see \fBccdtypes\fR). + +The processing operations are selected by boolean (yes/no) parameters. +Because calibration images are recognized and processed appropriately, +the processing operations for object images should be set. +Any combination of operations may be specified and the operations are +performed simultaneously. While it is possible to do operations in +separate steps this is much less efficient. Two of the operation +parameters apply only to zero level and flat field images. These +are used for certain types of CCDs and modes of operation. + +The processing steps selected have related parameters which must be +set. These are things like image sections defining the overscan and +trim regions and calibration images. There are a number of parameters +used for fitting the overscan or prescan bias section. These are +parameters used by the standard IRAF curve fitting package \fBicfit\fR. +The parameters are described in more detail in the following sections. + +In addition to the task parameters there are package parameters +which affect \fBccdproc\fR. These include the instrument and subset +files, the text and plot log files, the output pixel datatype, +the amount of memory available for calibration image caching, +the verbose parameter for logging to the terminal, and the backup +prefix. These are described in \fBccdred\fR. + +Calibration images are specified by task parameters and/or in the +input image list. If more than one calibration image is specified +then the first one encountered is used and a warning is issued for the +extra images. Calibration images specified by +task parameters take precedence over calibration images in the input list. +These images also need not have a CCD image type parameter since the task +parameter identifies the type of calibration image. This method is +best if there is only one calibration image for all images +to be processed. This is almost always true for zero level and dark +count images. If no calibration image is specified by task parameter +then calibration images in the input image list are identified and +used. This requires that the images have CCD image types recognized +by the package. This method is useful if one may simply say "*.imh" +as the image list to process all images or if the images are broken +up into groups, in "@" files for example, each with their own calibration +frames. + +When an input image is processed the task first determines the processing +parameters and calibration images. If a requested operation has been +done it is skipped and if all requested operations have been completed then +no processing takes place. When it determines that a calibration image +is required it checks for the image from the task parameter and then +for a calibration image of the proper type in the input list. + +Having +selected a calibration image it checks if it has been processed for +all the operations selected by the CCDPROC parameters. +After the calibration images have been identified, and processed if +necessary, the images may be cached in memory. This is done when there +are more than two input images (it is actually less efficient to +cache the calibration images for one or two input images) and the parameter +\fImax_cache\fR is greater than zero. When caching, as many calibration +images as allowed by the specified memory are read into memory and +kept there for all the input images. Cached images are, therefore, +only read once from disk which reduces the amount of disk I/O. This +makes a modest decrease in the execution time. It is not dramatic +because the actual processing is fairly CPU intensive. + +Once the processing parameters and calibration images have been determined +the input image is processed for all the desired operations in one step; +i.e. there are no intermediate results or images. This makes the task +efficient. If a matching list of output images is given then the processed +image is written to the specified output image name. If no output image +list is given then the corrected image is output as a temporary image until +the entire image has been processed. When the image has been completely +processed then the original image is deleted (or renamed using the +specified backup prefix) and the corrected image replaces the original +image. Using a temporary image protects the data in the event of an abort +or computer failure. Keeping the original image name eliminates much of +the record keeping and the need to generate new image names. +.sh +1. Fixpix +Regions of bad lines and columns may be replaced by linear +interpolation from neighboring lines and columns when the parameter +\fIfixpix\fR is set. This algorithm is the same as used in the +task \fBfixpix\fR. The bad pixels may be specified by a pixel mask, +an image, or a text file. For the mask or image, values of zero indicate +good pixels and other values indicate bad pixels to be replaced. + +The text file consists of lines with four fields, the starting and +ending columns and the starting and ending lines. Any number of +regions may be specified. Comment lines beginning with the character +'#' may be included. The description applies directly to the input +image (before trimming) so different files are needed for previously +trimmed or subsection readouts. The data in this file is internally +turned into the same description as a bad pixel mask with values of +two for regions which are narrower or equal across the columns and +a value of three for regions narrower across lines. + +The direction of interpolation is determined from the values in the +mask, image, or the converted text file. A value of two interpolates +across columns, a value of three interpolates across lines, and any +other value interpolates across the narrowest dimension of bad pixels +and using column interpolation if the two dimensions are equal. + +The bad pixel description may be specified explicitly with the parameter +\fIfixfile\fR or indirectly if the parameter has the value "image". In the +latter case the instrument file must contain the name of the file. +.sh +2. Overscan +If an overscan or prescan correction is specified (\fIoverscan\fR +parameter) then the image section (\fIbiassec\fR parameter) defines +the overscan region. + +There are two types of overscan (or prescan) determinations. One determines +a independent overscan value for each line and is only available for a +\fIreadaxis\fR of 1. The other averages the overscan along the readout +direction to make an overscan vector, fits a smoothing function to the vector, +and then evaluate and then evaluates the smooth function at each readout +line or column. + +The line-by-line determination provides an mean, median, or +mean with the minimum and maximum values excluded. The median +is lowest value of the middle two when the number of overscan columns +is even rather than the mean. + +The smoothed overscan vector determination uses the \fBicfit\fR options +including interactive fitting. The fitting function is generally either a +constant (polynomial of 1 term) or a high order function which fits the +large scale shape of the overscan vector. Bad pixel rejection is also +available to eliminate cosmic ray events. The function fitting may be done +interactively using the standard \fBicfit\fR iteractive graphical curve +fitting tool. Regardless of whether the fit is done interactively, the +overscan vector and the fit may be recorded for later review in a metacode +plot file named by the parameter \fIccdred.plotfile\fR. The mean value of +the bias function is also recorded in the image header and log file. +.sh +3. Trim +When the parameter \fItrim\fR is set the input image will be trimmed to +the image section given by the parameter \fItrimsec\fR. This trim +should, of course, be the same as that used for the calibration images. +.sh +4. Zerocor +After the readout bias is subtracted, as defined by the overscan or prescan +region, there may still be a zero level bias. This level may be two +dimensional or one dimensional (the same for every readout line). A +zero level calibration is obtained by taking zero length exposures; +generally many are taken and combined. To apply this zero +level calibration the parameter \fIzerocor\fR is set. In addition if +the zero level bias is only readout dependent then the parameter \fIreadcor\fR +is set to reduce two dimensional zero level images to one dimensional +images. The zero level images may be specified by the parameter \fIzero\fR +or given in the input image list (provided the CCD image type is defined). + +When the zero level image is needed to correct an input image it is checked +to see if it has been processed and, if not, it is processed automatically. +Processing of zero level images consists of bad pixel replacement, +overscan correction, trimming, and averaging to one dimension if the +readout correction is specified. +.sh +5. Darkcor +Dark counts are subtracted by scaling a dark count calibration image to +the same exposure time as the input image and subtracting. The +exposure time used is the dark time which may be different than the +actual integration or exposure time. A dark count calibration image is +obtained by taking a very long exposure with the shutter closed; i.e. +an exposure with no light reaching the detector. The dark count +correction is selected with the parameter \fIdarkcor\fR and the dark +count calibration image is specified either with the parameter +\fIdark\fR or as one of the input images. The dark count image is +automatically processed as needed. Processing of dark count images +consists of bad pixel replacement, overscan and zero level correction, +and trimming. +.sh +6. Flatcor +The relative detector pixel response is calibrated by dividing by a +scaled flat field calibration image. A flat field image is obtained by +exposure to a spatially uniform source of light such as an lamp or +twilight sky. Flat field images may be corrected for the spectral +signature in spectroscopic images (see \fBresponse\fR and +\fBapnormalize\fR), or for iillumination effects (see \fBmkillumflat\fR +or \fBmkskyflat\fR). For more on flat fields and iillumination corrections +see \fBflatfields\fR. The flat field response is dependent on the +wavelength of light so if different filters or spectroscopic wavelength +coverage are used a flat field calibration for each one is required. +The different flat fields are automatically selected by a subset +parameter (see \fBsubsets\fR). + +Flat field calibration is selected with the parameter \fBflatcor\fR +and the flat field images are specified with the parameter \fBflat\fR +or as part of the input image list. The appropriate subset is automatically +selected for each input image processed. The flat field image is +automatically processed as needed. Processing consists of bad pixel +replacement, overscan subtraction, zero level subtraction, dark count +subtraction, and trimming. Also if a scan mode is used and the +parameter \fIscancor\fR is specified then a scan mode correction is +applied (see below). The processing also computes the mean of the +flat field image which is used later to scale the flat field before +division into the input image. For scan mode flat fields the ramp +part is included in computing the mean which will affect the level +of images processed with this flat field. Note that there is no check for +division by zero in the interest of efficiency. If division by zero +does occur a fatal error will occur. The flat field can be fixed by +replacing small values using a task such as \fBimreplace\fR or +during processing using the \fIminreplace\fR parameter. Note that the +\fIminreplace\fR parameter only applies to flat fields processed by +\fBccdproc\fR. +.sh +7. Illumcor +CCD images processed through the flat field calibration may not be +completely flat (in the absence of objects). In particular, a blank +sky image may still show gradients. This residual nonflatness is called +the iillumination pattern. It may be introduced even if the detector is +uniformly illuminated by the sky because the flat field lamp +iillumination may be nonuniform. The iillumination pattern is found from a +blank sky, or even object image, by heavily smoothing and rejecting +objects using sigma clipping. The iillumination calibration image is +divided into the data being processed to remove the iillumination +pattern. The iillumination pattern is a function of the subset so there +must be an iillumination correction image for each subset to be +processed. The tasks \fBmkillumcor\fR and \fBmkskycor\fR are used to +create the iillumination correction images. For more on iillumination +corrections see \fBflatfields\fR. + +An alternative to treating the iillumination correction as a separate +operation is to combine the flat field and iillumination correction +into a corrected flat field image before processing the object +images. This will save some processing time but does require creating +the flat field first rather than correcting the images at the same +time or later. There are two methods, removing the large scale +shape of the flat field and combining a blank sky image iillumination +with the flat field. These methods are discussed further in the +tasks which create them; \fBmkillumcor\fR and \fBmkskycor\fR. +.sh +8. Fringecor +There may be a fringe pattern in the images due to the night sky lines. +To remove this fringe pattern a blank sky image is heavily smoothed +to produce an iillumination image which is then subtracted from the +original sky image. The residual fringe pattern is scaled to the +exposure time of the image to be fringe corrected and then subtracted. +Because the intensity of the night sky lines varies with time an +additional scaling factor may be given in the image header. +The fringe pattern is a function of the subset so there must be +a fringe correction image for each subset to be processed. +The task \fBmkfringecor\fR is used to create the fringe correction images. +.sh +9. Readcor +If a zero level correction is desired (\fIzerocor\fR parameter) +and the parameter \fIreadcor\fR is yes then a single zero level +correction vector is applied to each readout line or column. Use of a +readout correction rather than a two dimensional zero level image +depends on the nature of the detector or if the CCD is operated in +longscan mode (see below). The readout correction is specified by a +one dimensional image (\fIzero\fR parameter) and the readout axis +(\fIreadaxis\fR parameter). If the zero level image is two dimensional +then it is automatically processed to a one dimensional image by +averaging across the readout axis. Note that this modifies the zero +level calibration image. +.sh +10. Scancor +CCD detectors may be operated in several modes in astronomical +applications. The most common is as a direct imager where each pixel +integrates one point in the sky or spectrum. However, the design of most CCD's +allows the sky to be scanned across the CCD while shifting the +accumulating signal at the same rate. \fBCcdproc\fR provides for two +scanning modes called "shortscan" and "longscan". The type of scan +mode is set with the parameter \fIscanmode\fR. + +In "shortscan" mode the detector is scanned over a specified number of +lines (not necessarily at sideral rates). The lines that scroll off the +detector during the integration are thrown away. At the end of the +integration the detector is read out in the same way as an unscanned +observation. The advantage of this mode is that the small scale, zero +level, dark count and flat field responses are averaged in one dimension +over the number of lines scanned. A zero level, dark count or flat field may be +observed in the same way in which case there is no difference in the +processing from unscanned imaging and the parameter \fIscancor\fR may be +no. If it is yes, though, checking is done to insure that the calibration +image used has the same number of scan lines as the object being +processed. However, one obtains an increase in the statistical accuracy of +if they are not scanned during the observation but +digitally scanned during the processing. In shortscan mode with +\fIscancor\fR set to yes, zero level, dark count and flat field images are +digitally scanned, if needed, by the same number of scan lines as the +object. The number of scan lines is determined from the object image +header using the keyword nscanrow (or it's translation). If not found the +object is assumed to have been scanned with the value given by the +\fInscan\fR parameter. Zero, dark and flat calibration images are assumed +to be unscanned if the header keyword is not found. + +If a scanned zero level, dark count or flat field image is not found +matching the object then one may be created from the unscanned calibration +image. The image will have the root name of the unscanned image with an +extension of the number of scan rows; i.e. Flat1.32 is created from Flat1 +with a digital scanning of 32 lines. + +In "longscan" mode the detector is continuously read out to produce an +arbitrarily long strip. Provided data which has not passed over the entire +detector is thrown away, the zero level, dark count, and flat field +corrections will be one dimensional. If \fIscancor\fR is specified and the +scan mode is "longscan" then a one dimensional zero level, dark count, and +flat field correction will be applied. +.sh +11. Processing Steps +The following describes the steps taken by the task. This detailed +outline provides the most detailed specification of the task. + +.ls 5 (1) +An image to be processed is first checked that it is of the specified +CCD image type. If it is not the desired type then go on to the next image. +.le +.ls (2) +A temporary output image is created of the specified pixel data type +(\fBccdred.pixeltype\fR). The header parameters are copied from the +input image. +.le +.ls (3) +If trimming is specified and the image has not been trimmed previously, +the trim section is determined. +.le +.ls (4) +If bad pixel replacement is specified and this has not been done +previously, the bad pixel file is determined either from the task +parameter or the instrument translation file. The bad pixel regions +are read. If the image has been trimmed previously and the bad pixel +file contains the word "untrimmed" then the bad pixel coordinates are +translated to those of the trimmed image. +.le +.ls (5) +If an overscan correction is specified and this correction has not been +applied, the overscan section is averaged along the readout axis. If +trimming is to be done the overscan section is trimmed to the same +limits. A function is fit either interactively or noninteractively to +the overscan vector. The function is used to produce the overscan +vector to be subtracted from the image. This is done in real +arithmetic. +.le +.ls (6) +If the image is a zero level image go to processing step 12. +If a zero level correction is desired and this correction has not been +performed, find the zero level calibration image. If the zero level +calibration image has not been processed it is processed at this point. +This is done by going to processing step 1 for this image. After the +calibration image has been processed, processing of the input image +continues from this point. +The processed calibration image may be +cached in memory if it has not been previously and if there is enough memory. +.le +.ls (7) +If the image is a dark count image go to processing step 12. +If a dark count correction is desired and this correction has not been +performed, find the dark count calibration image. If the dark count +calibration image has not been processed it is processed at this point. +This is done by going to processing step 1 for this image. After the +calibration image has been processed, processing of the input image +continues from this point. The ratio of the input image dark time +to the dark count image dark time is determined to be multiplied with +each pixel of the dark count image before subtracting from the input +image. +The processed calibration image may be +cached in memory if it has not been previously and if there is enough memory. +.le +.ls (8) +If the image is a flat field image go to processing step 12. If a flat +field correction is desired and this correction has not been performed, +find the flat field calibration image of the appropriate subset. If +the flat field calibration image has not been processed it is processed +at this point. This is done by going to processing step 1 for this +image. After the calibration image has been processed, processing of +the input image continues from this point. The mean of the image +is determined from the image header to be used for scaling. If no +mean is found then a unit scaling is used. +The processed calibration image may be +cached in memory if it has not been previously and if there is enough memory. +.le +.ls (9) +If the image is an iillumination image go to processing step 12. If an +iillumination correction is desired and this correction has not been performed, +find the iillumination calibration image of the appropriate subset. +The iillumination image must have the "mkillum" processing flag or the +\fBccdproc\fR will abort with an error. The mean of the image +is determined from the image header to be used for scaling. If no +mean is found then a unit scaling is used. The processed calibration +image may be +cached in memory if it has not been previously and there is enough memory. +.le +.ls (10) +If the image is a fringe image go to processing step 12. If a fringe +correction is desired and this correction has not been performed, +find the fringe calibration image of the appropriate subset. +The iillumination image must have the "mkfringe" processing flag or the +\fBccdproc\fR will abort with an error. The ratio of the input +image exposure time to the fringe image exposure time is determined. +If there is a fringe scaling in the image header then this factor +is multiplied by the exposure time ratio. This factor is used +for scaling. The processed calibration image may be +cached in memory if it has not been previously and there is enough memory. +.le +.ls (11) +If there are no processing operations flagged, delete the temporary output +image, which has been opened but not used, and go to 14. +.le +.ls (12) +The input image is processed line by line with trimmed lines ignored. +A line of the input image is read. Bad pixel replacement and trimming +is applied to the image. Image lines from the calibration images +are read from disk or the image cache. If the calibration is one +dimensional (such as a readout zero +level correction or a longscan flat field correction) then the image +vector is read only once. Note that IRAF image I/O is buffered for +efficiency and accessing a line at a time does not mean that image +lines are read from disk a line at a time. Given the input line, the +calibration images, the overscan vector, and the various scale factors +a special data path for each combination of corrections is used to +perform all the processing in the most efficient manner. If the +image is a flat field any pixels less than the \fIminreplace\fR +parameter are replaced by that minimum value. Also a mean is +computed for the flat field and stored as the CCDMEAN keyword and +the time, in a internal format, when this value was calculated is stored +in the CCDMEANT keyword. The time is checked against the image modify +time to determine if the value is valid or needs to be recomputed. +.le +.ls (13) +The input image is deleted or renamed to a backup image. The temporary +output image is renamed to the input image name. +.le +.ls (14) +If the image is a zero level image and the readout correction is specified +then it is averaged to a one dimensional readout correction. +.le +.ls (15) +If the image is a zero level, dark count, or flat field image and the scan +mode correction is specified then the correction is applied. For shortscan +mode a modified two dimensional image is produced while for longscan mode a +one dimensional average image is produced. +.le +.ls (16) +The processing is completed and either the next input image is processed +beginning at step 1 or, if it is a calibration image which is being +processed for an input image, control returns to the step which initiated +the calibration image processing. +.le +.sh +12. Processing Arithmetic +The \fBccdproc\fR task has two data paths, one for real image pixel datatypes +and one for short integer pixel datatype. In addition internal arithmetic +is based on the rules of FORTRAN. For efficiency there is +no checking for division by zero in the flat field calibration. +The following rules describe the processing arithmetic and data paths. + +.ls (1) +If the input, output, or any calibration image is of type real the +real data path is used. This means all image data is converted to +real on input. If all the images are of type short all input data +is kept as short integers. Thus, if all the images are of the same type +there is no datatype conversion on input resulting in greater +image I/O efficiency. +.le +.ls (2) +In the real data path the processing arithmetic is always real and, +if the output image is of short pixel datatype, the result +is truncated. +.le +.ls (3) +The overscan vector and the scale factors for dark count, flat field, +iillumination, and fringe calibrations are always of type real. Therefore, +in the short data path any processing which includes these operations +will be coerced to real arithmetic and the result truncated at the end +of the computation. +.le +.sh +13. In the Absence of Image Header Information +The tasks in the \fBccdred\fR package are most convenient to use when +the CCD image type, subset, and exposure time are contained in the +image header. The ability to redefine which header parameters contain +this information makes it possible to use the package at many different +observatories (see \fBinstruments\fR). However, in the absence of any +image header information the tasks may still be used effectively. +There are two ways to proceed. One way is to use \fBccdhedit\fR +to place the information in the image header. + +The second way is to specify the processing operations more explicitly +than is needed when the header information is present. The parameter +\fIccdtype\fR is set to "" or to "none". The calibration images are +specified explicitly by task parameter since they cannot be recognized +in the input list. Only one subset at a time may be processed. + +If dark count and fringe corrections are to be applied the exposure +times must be added to all the images. Alternatively, the dark count +and fringe images may be scaled explicitly for each input image. This +works because the exposure times default to 1 if they are not given in +the image header. +.ih +EXAMPLES +The user's \fBguide\fR presents a tutorial in the use of this task. + +1. In general all that needs to be done is to set the task parameters +and enter + + cl> ccdproc *.imh & + +This will run in the background and process all images which have not +been processed previously. +.ih +TIME REQUIREMENTS +.nf +o SUN-3, 15 MHz 68020 with 68881 floating point hardware (no FPA) +o 8 Mb RAM, 2 Fuji Eagle disks. +o Input images = 544 x 512 short +o Output image = 500 x 500 real +o Operations are overscan subtraction (O), trimming to 500x500 (T), + zero level subtraction (Z), dark count scaling and subtraction (D), + and flat field scaling and subtraction (F). +o UNIX statistics + (user, system, and clock time, and misc. memory and i/o statistics): + +[OTF] One calibration image and 9 object images: +No caching: 110.6u 25.5s 3:18 68% 28+ 40K 3093+1645io 9pf+0w +Caching: 111.2u 23.0s 2:59 74% 28+105K 2043+1618io 9pf+0w + +[OTZF] Two calibration images and 9 object images: +No caching: 119.2u 29.0s 3:45 65% 28+ 50K 4310+1660io 9pf+0w +Caching: 119.3u 23.0s 3:07 75% 28+124K 2179+1601io 9pf+0w + +[OTZDF] Three calibration images and 9 object images: +No caching: 149.4u 31.6s 4:41 64% 28+ 59K 5501+1680io 19pf+0w +Caching: 151.5u 29.0s 4:14 70% 27+227K 2346+1637io 148pf+0w + +[OTZF] 2 calibration images and 20 images processed: +No caching: 272.7u 63.8u 8:47 63% 28+ 50K 9598+3713io 12pf+0w +Caching: 271.2u 50.9s 7:00 76% 28+173K 4487+3613io 51pf+0w +.fi +.ih +REVISIONS +.ls CCDPROC V2.11.2 +A new "output" parameter is available to specify an output image leaving +the input image unchanged. If this parameter is not specified then +the previous behavior of "in-place" operation with an optional backup +occurs. +.le +.ls CCDPROC V2.11 +The bad pixel fixing was modified to allow use of pixel masks, +images, or the text file description. Bad pixel masks are the +desired description and use of text files is only supported for +backward compatibility. Note that support for the trimmed +or untrimmed conversion from text files has been eliminated. + +Line-by-line overscan/prescan subtraction is now provided with +three simple algorithms. +.le +.ls CCDPROC: V2.10.3 +The output pixel datatypes (specified by the package parameter +\fIpixeltype\fR have been extended to include unsigned short +integers. Also it was previously possible to have the output +pixel datatype be of lower precision than the input. Now the +output pixel datatype is not allowed to lose precision; i.e. +a real input image may not be processed to a short datatype. + +For short scan data the task now looks for the number of scan lines in the +image header. Also when a calibration image is software scanned a new +image is created. This allows processing objects with different numbers of +scan lines and preserving the unscanned calibration image. + +It is an error if no biassec is specified rather than defaulting to +the whole image. + +The time, in a internal format, when the CCDMEAN value is calculated is +stored in the CCDMEANT keyword. The time is checked against the image +modify time to determine if the value is valid or needs to be recomputed. +.le +.ih +SEE ALSO +.nf +instruments, ccdtypes, flatfields, icfit, ccdred, guide, mkillumcor, +mkskycor, mkfringecor +.fi +.endhelp diff --git a/noao/imred/ccdred/doc/ccdred.hlp b/noao/imred/ccdred/doc/ccdred.hlp new file mode 100644 index 00000000..f2cca5bd --- /dev/null +++ b/noao/imred/ccdred/doc/ccdred.hlp @@ -0,0 +1,104 @@ +.help package Dec93 noao.imred +.ih +NAME +ccdred -- CCD image reduction package +.ih +USAGE +ccdred +.ih +PARAMETERS +.ls pixeltype = "real real" +Output pixel datatype and calculation datatype. When images are processed +or created the output pixel datatype is determined by this parameter if the +specified datatype is of equal or higher precision otherwise the input +image datatype is preserved. For example if the output datatype is +specified as "input" then input images which are "short" or "ushort" will +be output as integer but any real datatype input images will remain real. +The allowed types and order of precision are "short", "ushort", "int", +"long", "real", or "double", for short signed integer, short unsigned +integer, integer, long integers, and real or double floating point. Note +that if short input images are processed into real images the disk space +required will generally increase. The calculation datatypes may only be +short and real with a default of real if none is specified. +.le +.ls verbose = no +Print log information to the standard output? +.le +.ls logfile = "logfile" +Text log file. If no filename is specified then no log file is kept. +.le +.ls plotfile = "" +Log metacode plot file for the overscan bias vector fits. If no filename +is specified then no metacode plot file is kept. +.le +.ls backup = "" +Backup prefix for backup images. If no prefix is specified then no backup +images are kept when processing. If specified then the backup image +has the specified prefix. +.le +.ls instrument = "" +CCD instrument translation file. This is usually set with +\fBsetinstrument\fR. +.le +.ls ssfile = "subsets" +Subset translation file used to define the subset identifier. See +\fBsubsets\fR for more. +.le +.ls graphics = "stdgraph" +Interactive graphics output device when fitting the overscan bias vector. +.le +.ls cursor = "" +Graphics cursor input. The default is the standard graphics cursor. +.le +.ls version = "June 1987" +Package version. +.le +.ih +DESCRIPTION +The CCD reduction package is loaded when this command is entered. The +package contains parameters which affect the operation of the tasks it +defines. When images are processed or new image are created the output +pixel datatype is that specified by the parameter \fBpixeltype\fR. Note +that CCD processing replaces the original image by the processed image so +the pixel type of the CCD images may change during processing. The output +pixel type is not allowed to change to a lower precision but it is common +for input short images to be processed to real images. Processing images +from short to real pixel datatypes will generally increase the amount of +disk space required (a factor of 2 on most computers). + +The tasks produce log output which may be printed on the standard +output (the terminal unless redirected) and appended to a file. The +parameter \fIverbose\fR determines whether processing information +is printed. This may be desirable initially, but when using background +jobs the verbose output should be turned off. The user may look at +the end of the log file (for example with \fBtail\fR) to determine +the status of the processing. + +The package was designed to work with data from many different observatories +and instruments. In order to accomplish this an instrument translation +file is used to define a mapping between the package parameters and +the particular image header format. The instrument translation file +is specified to the package by the parameter \fIinstrument\fR. This +parameter is generally set by the task \fBsetinstrument\fR. The other +file used is a subset file. This is generally created and maintained +by the package and the user need not do anything. For more sophisticated +users see \fBinstruments\fR and \fBsubsets\fR. + +The package has very little graphics +output. The exception is the overscan bias subtraction. The bias +vector is logged in the metacode plot file if given. The plot file +may be examined with the tasks in the \fBplot\fR package such as +\fBgkimosaic\fR. When interactively fitting the overscan vector +the graphics input and output devices must be specified. The defaults +should apply in most cases. + +Because processing replaces the input image by the processed image it +may be desired to save the original image. This may be done by +specifying a backup prefix with the parameter \fIbackup\fR. For +example, if the prefix is "orig" and the image is "ccd001", the backup +image will be "origccd001". The prefix may be a directory but it must +end with '/' or '$' (for logical directories). +.ih +SEE ALSO +ccdproc, instruments, setinstrument, subsets +.endhelp diff --git a/noao/imred/ccdred/doc/ccdred.ms b/noao/imred/ccdred/doc/ccdred.ms new file mode 100644 index 00000000..645514ec --- /dev/null +++ b/noao/imred/ccdred/doc/ccdred.ms @@ -0,0 +1,787 @@ +.RP +.TL +The IRAF CCD Reduction Package -- CCDRED +.AU +Francisco Valdes +.AI +IRAF Group - Central Computer Services +.K2 +P.O. Box 26732, Tucson, Arizona 85726 +September 1987 +.AB +The IRAF\(dg CCD reduction package, \fBccdred\fR, provides tools +for the easy and efficient reduction of CCD images. The standard +reduction operations are replacement of bad pixels, subtraction of an +overscan or prescan bias, subtraction of a zero level image, +subtraction of a dark count image, division by a flat field calibration +image, division by an illumination correction, subtraction of a fringe +image, and trimming unwanted lines or columns. Another common +operation provided by the package is scaling and combining images with +a number of algorithms for rejecting cosmic rays. Data in the image +header is used to make the reductions largely automated and +self-documenting though the package may still be used in the absence of +this data. Also a translation mechanism is used to relate image header +parameters to those used by the package to allow data from a variety of +observatories and instruments to be processed. This paper describes +the design goals for the package and the main tasks and algorithms +which satisfy these goals. +.PP +This paper is to be published as part of the proceedings of the +Santa Cruz Summer Workshop in Astronomy and Astrophysics, +\fIInstrumentation for Ground-Based Optical Astronomy: Present and +Future\fR, edited by Lloyd B. Robinson and published by +Springer-Verlag. +.LP +\(dgImage Reduction and Analysis Facility (IRAF), a software system +distributed by the National Optical Astronomy Observatories (NOAO). +.AE +.NH +Introduction +.PP +The IRAF CCD reduction package, \fBccdred\fR, provides tools +for performing the standard instrumental corrections and calibrations +to CCD images. The major design goals were: +.IP +.nf +\(bu To be easy to use +\(bu To be largely automated +\(bu To be image header driven if the data allows +\(bu To be usable for a variety of instruments and observatories +\(bu To be efficient and capable of processing large volumes of data +.fi +.LP +This paper describes the important tasks and algorithms and shows how +these design goals were met. It is not intended to describe every +task, parameter, and usage in detail; the package has full +documentation on each task plus a user's guide. +.PP +The standard CCD correction and calibration operations performed are +replacement of bad columns and lines by interpolation from neighboring +columns and lines, subtraction of a bias level determined from overscan +or prescan columns or lines, subtraction of a zero level using a zero +length exposure calibration image, subtraction of a dark count +calibration image appropriately scaled to the dark time exposure of the +image, division by a scaled flat field calibration image, division by +an illumination image (derived from a blank sky image), subtraction of +a scaled fringe image (also derived from a blank sky image), and +trimming the image of unwanted lines or columns such as the overscan +strip. The processing may change the pixel datatype on disk (IRAF allows +seven image datatypes); usually from 16 bit integer to real format. +Two special operations are also supported for scan mode and one +dimensional zero level and flat field calibrations; i.e. the same +calibration is applied to each CCD readout line. Any set of operations +may be done simultaneously over a list of images in a highly efficient +manner. The reduction operations are recorded in the image header and +may also be logged on the terminal and in a log file. +.PP +The package also provides tools for combining multiple exposures +of object and calibration images to improve the statistical accuracy of +the observations and to remove transient bad pixels. The combining +operation scales images of different exposure times, adjusts for +variable sky background, statistically weights the images by their +signal-to-noise, and provides a number of useful algorithms for +detecting and rejecting transient bad pixels. +.PP +Other tasks are provided for listing reduction information about +the images, deriving secondary calibration images (such as sky +corrected flat fields or illumination correction images), and easily +setting the package parameters for different instruments. +.PP +This paper is organized as follows. There is a section giving an +overview of how the package is used to reduce CCD data. This gives the +user's perspective and illustrates the general ease of use. The next +section describes many of the features of the package contributing to +its ease of use, automation, and generality. The next two sections +describe the major tools and algorithms in some detail. This includes +discussions about achieving high efficiency. Finally the status of the +package and its use at NOAO is given. References to additional +documentation about IRAF and the CCD reduction package and an appendix +listing the individual tasks in the package are found at the end of +this paper. +.NH +A User's Overview +.PP +This section provides an overview of reducing data with the IRAF CCD +reduction package. There are many variations in usage depending on the +type of data, whether the image headers contain information about the +data which may be used by the tasks, and the scientific goal. Only a +brief example is given. A more complete discussion of usage and +examples is given in \fIA User's Guide to the IRAF CCDRED Package\fR. +The package was developed within the IRAF system and so makes use of +all the sophisticated features provided. These features are also +summarized here for those not familiar with IRAF since they are an +important part of using the package. +.PP +Since the IRAF system is widely distributed and runs on a wide variety +of computers, the site of the CCD reductions might be at the telescope, +a system at the observatory provided for this purpose, or at the +user's home computer. The CCD images to be processed are either +available immediately as the data is taken, transferred from the data taking +computer via a network link (the method adopted at NOAO), or transferred +to the reduction computer via a medium such as magnetic tape in FITS +format. The flexibility in reduction sites and hardware is one of the +virtues of the IRAF-based CCD reduction package. +.PP +IRAF tasks typically have a number of parameters which give the user +control over most aspects of the program. This is possible since the +parameters are kept in parameter files so that the user need not enter +a large number of parameters every time the task is run. The user may +change any of these parameters as desired in several ways, such as by +explicit assignment and using an easy to learn and use, +fill-in-the-value type of screen editor. The parameter values are +\fIlearned\fR so that once a user sets the values they are maintained +until the user changes them again; even between login sessions. +.PP +The first step in using the CCD reduction package is to set the default +processing parameters for the data to be reduced. These parameters include +a database file describing the image header keyword translations and +default values, the processing operations desired (operations +required vary with instrument and observer), the calibration image names, +and certain special parameters for special types of observations such +as scan mode. A special script task (a command procedure) is available +to automatically set the default values, given the instrument name, to standard +values defined by the support staff. Identifying the instrument in this +way may be all the novice user need do though most people quickly learn +to adjust parameters at will. +.PP +As an example suppose there is an instrument identified as \fLrca4m\fR +for an RCA CCD at the NOAO 4 meter telescope. The user gives the command + +.ft L + cl> setinstrument rca4m +.ft R + +which sets the default parameters to values suggested by the support staff +for this instrument. The user may then change these suggested values if +desired. In this example the processing switches are set to perform +overscan bias subtraction, zero level image subtraction, flat fielding, +and trimming. +.PP +The NOAO image headers contain information identifying the type of +image, such as object, zero level, and flat field, the filter used to +match flat fields with object images, the location of the overscan bias +data, the trim size for the data, and whether the image has been +processed. With this information the user need not worry about +selecting images, pairing object images with calibration images, or +inadvertently reprocessing an image. +.PP +The first step is to combine multiple zero level and flat field observations +to reduce the effects of statistical noise. This is done by the +commands + +.nf +.ft L + cl> zerocombine *.imh + cl> flatcombine *.imh +.ft R +.fi + +The "cl> " is the IRAF command language prompt. The first command says +look through all the images and combine the zero level images. The +second command says look through all the images and combine the flat +field images by filter. What could be simpler? Some \fIhidden\fR (default) +parameters the user may modify are the combined image name, whether to +process the images first, and the type of combining algorithm to use. +.PP +The next step is to process the images using the combined calibration +images. The command is + +.ft L + cl> ccdproc *.imh +.ft R + +This command says look through all the images, find the object images, +find the overscan data based on the image header and subtract the +bias, subtract the zero level calibration image, divide by the flat field +calibration image, and trim the bias data and edge lines and columns. +During this operation the task recognizes that the +zero level and flat field calibration images have not been processed +and automatically processes them when they are needed. The log output +of this task, which may be to the terminal, to a file, or both, shows +how this works. + +.nf +.ft L + ccd003: Jun 1 15:12 Trim data section is [3:510,3:510] + ccd003: Jun 1 15:12 Overscan section is [520:540,*], mean=485.0 + Dark: Jun 1 15:12 Trim data section is [3:510,3:510] + Dark: Jun 1 15:13 Overscan section is [520:540,*], mean=484.6 + ccd003: Jun 1 15:13 Dark count image is Dark.imh + FlatV: Jun 1 15:13 Trim data section is [3:510,3:510] + FlatV: Jun 1 15:14 Overscan section is [520:540,*], mean=486.4 + ccd003: Jun 1 15:15 Flat field image is FlatV.imh, scale=138.2 + ccd004: Jun 1 15:16 Trim data section is [3:510,3:510] + ccd004: Jun 1 15:16 Overscan section is [520:540,*], mean=485.2 + ccd004: Jun 1 15:16 Dark count image is Dark.imh + ccd004: Jun 1 15:16 Flat field image is FlatV.imh, scale=138.2 + \fI<... more ...>\fL + ccd013: Jun 1 15:22 Trim data section is [3:510,3:510] + ccd013: Jun 1 15:23 Overscan section is [520:540,*], mean=482.4 + ccd013: Jun 1 15:23 Dark count image is Dark.imh + FlatB: Jun 1 15:23 Trim data section is [3:510,3:510] + FlatB: Jun 1 15:23 Overscan section is [520:540,*], mean=486.4 + ccd013: Jun 1 15:24 Flat field image is FlatB.imh, scale=132.3 + \fI<... more ...>\fL +.ft R +.fi + +.PP +The log gives the name of the image and a time stamp for each entry. +The first image is ccd003. It is to be trimmed to the specified +size given as an \fIimage section\fR, an array notation used commonly +in IRAF to specify subsections of images. The location of the +overscan data is also given by an image section which, in this case, +was found in the image header. The mean bias level of the overscan +is also logged though the overscan is actually a function of the +readout line with the order of the function selected by the user. +.PP +When the task comes to subtracting the zero level image it first +notes that the calibration image has not been processed and switches +to processing the zero level image. Since it knows it is a zero level +image the task does not attempt to zero level or flat field correct +this image. After the zero level image has been processed the task +returns to the object image only to find that the flat field image +also has not been processed. It determines that the object image was +obtained with a V filter and selects the flat field image having the same +filter. The flat field image is processed through the zero level correction +and then the task again returns to the object image, ccd003, which it +finishes processing. +.PP +The next image, ccd004, is also a V filter +observation. Since the zero level and V filter flat field have been +processed the object image is processed directly. This continues +for all the object images except for a detour to process the B filter flat +field when the task first encounters a B filter object image. +.PP +In summary, the basic usage of the CCD reduction package is quite simple. +First, the instrument is identified and some parameters for the data +are set. Calibration images are then combined if needed. Finally, +the processing is done with the simple command + +.ft L + cl> ccdproc *.imh& +.ft R + +where the processing is performed as a \fIbackground job\fR in this example. +This simplicity was a major goal of the package. +.NH +Features of the Package +.PP +This section describes some of the special features of the package +which contribute to its ease of use, generality, and efficiency. +The major criteria for ease of use are to minimize the user's record keeping +involving input and output image names, the types of images, subset +parameters such as filters which must be kept separate, and the state +of processing of each image. The goal is to allow input images to +be specified using simple wildcards, such as "*.imh" to specify all +images, with the knowledge that the task will only operate on images +for which it makes sense. To accomplish this the tasks must be able to +determine the type of image, subset, and the state of processing from +the image itself. This is done by making use of image header parameters. +.PP +For generality the package does not require any image header information +except the exposure time. It is really not very much more difficult to +reduce such data. Mainly, the user must be more explicit about specifying +images and setting task parameters or add the information to the image +headers. Some default header information may also be set in the image +header translation file (discussed below). +.PP +One important image header parameter is the image type. This +discriminates between object images and various types of calibration +images such as flat field, zero level, dark count, comparison arcs, +illumination, and fringe images. This information is used in two +ways. For most of the tasks the user may select that only one type of +image be considered. Thus, all the flat field images may be selected +for combining or only the processing status of the object images be +listed. The second usage is to allow the processing tasks to identify +the standard calibration images and apply only those operations which +make sense. For example, flat field images are not divided by a +flat field. This allows the user to set the processing operations +desired for the object images without fear of misprocessing the +calibration images. The image type is also used to automatically +select calibration images from a list of images to be processed instead +of explicitly identifying them. +.PP +A related parameter specifies the subset. For certain operations the +images must have a common value for this parameter. This parameter is +often the filter but it may also apply to a grating or aperture, for example. +The subset parameter is used to identify the appropriate flat field +image to apply to an image or to select common flat fields to be combined +into a higher quality flat field. This is automatic and the user need not +keep track of which image was taken with which filter or grating. +.PP +The other important image header parameters are the processing flags. +These identify when an image has been processed and also act as a history +of the operation including calibration images used and other parameter +information. The usage of these parameters is obvious; it allows the +user to include processed images in a wildcard list knowing that the +processing will not be repeated and to quickly determine the processing +status of the image. +.PP +Use of image header parameters often ties the software to the a +particular observatory. To maintain generality and usefulness for data +other than that at NOAO, the CCD reduction package was designed to +provide a translation between parameters requested by the package and +those actually found in the image header. This translation is defined +in a simple text file which maps one keyword to another and also gives +a default value to be used if the image header does not include a +value. In addition the translation file maps the arbitrary strings +which may identify image types to the standard types which the package +recognizes. This is a relatively simple scheme and does not allow for +forming combinations or for interpreting values which are not simple +such as embedding an exposure time as part of a string. A more complex +translation scheme may prove desirable as experience is gained with +other types of image header formats, but by then a general header translation +ability and/or new image database structure may be a standard IRAF +feature. +.PP +This feature has proven useful at NOAO. During the course of +developing the package the data taking system was modernized by +updating keywords and adding new information in the image headers, +generally following the lines laid out by the \fBccdred\fR package. +However, there is a period of transition and it is also desirable to +reduce preexisting data. There are several different formats for this +data. The header translation files make coping with these different +formats relatively easy. +.PP +A fundamental aspect of the package is that the processing +modifies the images. In other words, the reduction operations are +performed directly on the image. This "feature" further simplifies +record keeping, frees the user from having to form unique output image +names, and minimizes the amount of disk space required. There +are two safety features in this process. First, the modifications do +not take effect until the operation is completed on the image. This +allows the user to abort the task without leaving the image data in a +partially processed state and protects data if the computer +crashes. The second feature is that there is a parameter which may be +set to make a backup of the input data with a particular prefix; for +example "b", "orig", or "imdir$" (a logical directory prefix). This +backup feature may be used when there is sufficient disk space, when +learning to use the package, or just to be cautious. +.PP +In a similar effort to efficiently manage disk space, when combining +images into a master object or calibration image, there is an option to +delete the input images upon completion of the combining operation. +Generally this is desirable when there are many calibration exposures, +such as zero level or flat field images, which are not used after they +are combined into a final calibration image. +.PP +The goal of generality for many instruments at +different observatories inherently conflicts with the goal of ease of +use. Generality requires many parameters and options. This is +feasible in the CCD reduction package, as well as the other IRAF packages, +because of the IRAF parameter handling mechanism. In \fBccdred\fR +there still remains the problem of setting the parameters appropriately +for a particular instrument, image header format, and observatory. +.PP +To make this convenient there is a task, \fBsetinstrument\fR, that, +based on an instrument name, runs a setup script for the instrument. +An example of this task was given in the previous section. +The script may do any type of operation but mainly it sets default +parameters. The setup scripts are generally created by the support staff +for the instrument. The combination of the setup script and the +instrument translation file make the package, in a sense, programmable +and achieves the desired instrument/observatory generality with ease of use. +.NH +CCD Processing +.PP +This section describes in some detail how the CCD processing is performed. +The task which does the basic CCD processing is call \fBccdproc\fR. +From the point of view of usage the task is very simple but a great deal +is required to achieve this simplicity. The approach we take in describing +the task is to follow the flow of control as the task runs with digressions +as appropriate. +.PP +The highest level of control is a loop over the input images; all the +operations are performed successively on each image. It is common for +IRAF tasks which operate on individual images to allow the operation to +be repeated automatically over a list of input images. This is important +in the \fBccdred\fR package because data sets are often large and the +processing is generally the same for each image. It would be tedious +to have to give the processing command for each image to be processed. +If an error occurs while processing an image the error is +printed as a warning and processing continues with the next image. +This provides protection primarily against mistyped or nonexistent images. +.PP +Before the first image is processed the calibration images are +identified. There are two ways to specify calibration images; +explicitly via task parameters or implicitly as part of the list of +images to be processed. Explicitly identifying calibration images +takes precedence over calibration images in the input list. Specifying +calibration images as part of the input image list requires that the +image types can be determined from the image header. Using the input +list provides a mechanism for breaking processing up into sets of +images (possibly using files containing the image names for each set) +each having their own calibration images. One can, of course, +selectively specify input and calibration images, but whenever possible +one would like to avoid having to specify explicit images to process +since this requires record keeping by the user. +.PP +The first step in processing an image is to check that it is of the +appropriate image type. The user may select to process images of only +one type. Generally this is object images since calibration images are +automatically processed as needed. Images which are not of the desired +type are skipped and the next image is considered. +.PP +A temporary output image is created next. The output pixel datatype on +disk may be changed at this point as selected by the user. +For example it is common for the raw CCD images to be digitized as 16 +bit integers but after calibration it is sometimes desirable to have +real format pixels. If no output pixel datatype is specified the +output image takes the same pixel datatype as the input image. The +processing is done by operating on the input image and writing the +results to a temporary output image. When the processing is complete +the output image replaces the input image. This gives the effect of +processing the images in place but with certain safeguards. If the +computer crashes or the processing is interrupted the integrity of the +input image is maintained. The reasons for chosing to process the +images in this way are to avoid having to generate new image names (a +tiresome record keeping process for the user), to minimize disk +usage, and generally the unprocessed images are not used once they have +been processed. When dealing with large volumes of data these reasons +become fairly important. However, the user may specify a backup prefix +for the images in which case, once the processing is completed, the +original input image is renamed by appending it to the prefix (or with +an added digit if a previous backup image of the same name exits) +before the processed output image takes the original input name. +.PP +The next step is to determine the image geometry. Only a subsection of +the raw image may contain the CCD data. If this region is specified by +a header parameter then the processing will affect only this region. +This allows calibration and other data to be part of the image. +Normally, the only other data in a image is overscan or prescan data. +The location of this bias data is determined from the image header or +from a task parameter (which overrides the image header value). To +relate calibration images of different sizes and to allow for readout +of only a portion of the CCD detector, a header parameter may relate +the image data coordinates to the full CCD coordinates. Application of +calibration image data and identifying bad pixel regions via a bad +pixel file is done in this CCD coordinate system. The final +geometrical information is the region of the input image to be output +after processing; an operation called trimming. This is defined by an +image header parameter or a task parameter. Trimming of the image is +selected by the user. Any or all of this geometry information may be +absent from the image and appropriate defaults are used. +.PP +Each selected operation which is appropriate for the image type is then +considered. If the operation has been performed previously it will not +be repeated. If all selected operations have been performed then the +temporary output image is deleted and the input image is left +unchanged. The next image is then processed. +.PP +For each selected operation to be performed the pertinent data is +determined. This consists of such things as the name of the +calibration image, scaling factors, the overscan bias function, etc. +Note that at this point only the parameters are determined, the +operation is not yet performed. This is because operations are not +performed sequentially but simultaneously as described below. Consider +flat fielding as an example. First the input image is checked to see +if it has been flat fielded. Then the flat field calibration image is +determined. The flat field image is checked to see if it has been +processed. If it has not been processed then it is processed by +calling a procedure which is essentially a copy of the main processing +program. After the flat field image has been processed, parameters +affecting the processing, such as the flat field scale factor +(essentially the mean of the flat field image), are determined. A log +of the operation is then printed if desired. +.PP +Once all the processing operations and parameters have been defined the +actual processing begins. One of the key design goals was that the +processing be efficient. There are two primary methods used to achieve +this goal; separate processing paths for 16 bit integer data and +floating point data and simultaneous operations. If the image, the +calibration images, and the output image (as selected by the user) are +16 bit integer pixel datatypes then the image data is read and written +as integer data. This eliminates internal datatype conversions both +during I/O and during computations. However, many operations include +use of real factors such as the overscan bias, dark count exposure +scaling, and flat field scaling which causes the computation to be done +in real arithmetic before the result is stored again as an integer +value. In any case there is never any loss of precision except when +converting the output pixel to short integer. If any of the images are +not integer then a real internal data path is used in which input and +output image data are converted to real as necessary. +.PP +For each data path the processing proceeds line-by-line. For each line +in the output image data region (ignoring pixels outside the data area +and pixels which are trimmed) the appropriate input data and +calibration data are obtained. The calibration data is determined from +the CCD coordinates of the output image and are not necessarily from +the same image line or columns. The input data is copied to the output +array while applying bad pixel corrections and trimming. The line is +then processed using a specially optimized procedure. This procedure +applies all operations simultaneously for all combinations of +operations. As an example, consider subtracting an overscan bias, +subtracting a zero level, and dividing by a flat field. The basic +kernel of the task, where the bulk of the CPU time is used, is + +.nf +.ft L + do i = 1, n + out[i] = (out[i] - overscan - zero[i]) * flatscale / flat[i] +.ft R +.fi + +Here, \fIn\fR is the number of pixels in the line, \fIoverscan\fR is +the overscan bias value for the line, \fIzero\fR is the zero level data +from the zero level image, \fIflatscale\fR is the mean of the flat +field image, and \fIflat\fR is the flat field data from the flat +field image. Note the operations are not applied sequentially but +in a single statement. This is the most efficient method and there is +no need for intermediate images. +.PP +Though the processing is logically performed line-by-line in the program, +the image I/O from the disk is not done this way. The IRAF virtual +operating system image interface automatically provides multi-line +buffering for maximal I/O efficiency. +.PP +In many image processing systems it has been standard to apply operations +sequentially over an image. This requires producing intermediate images. +Since this is clearly inefficient in terms of I/O it has been the practice +to copy the images into main memory and operate upon them there until +the final image is ready to be saved. This has led to the perception +that in order to be efficient an image processing system \fImust\fR +store images in memory. This is not true and the IRAF CCD reduction +package illustrates this. The CCD processing does not use intermediate +images and does not need to keep the entire image in main memory. +Furthermore, though of lesser importance than I/O, the single statement method +illustrated above is more efficient than multiple passes through the +images even when the images are kept in main memory. Finally, as CCD +detectors increase in size and small, fast, and cheap processors become +common it is a distinct advantage to not require the large amounts of +memory needed to keep entire images in memory. +.PP +There is one area in which use of main memory can improve performance +and \fBccdproc\fR does take advantage of it if desired. The calibration +images usually are the same for many input images. By specifying the +maximum amount of memory available for storing images in memory +the calibration images may be stored in memory up to that amount. +By parameterizing the memory requirement there is no builtin dependence +on large memory! +.PP +After processing the input image the last steps are to log the operations +in the image header using processing keywords and replace the input +image by the output image as described earlier. The CCD coordinates +of the data are recorded in the header, even if not there previously, to +allow further processing on the image after the image has been trimmed. +.NH +Combining Images +.PP +The second important tool in the CCD reduction package is a task to combine +many images into a single, higher quality image. While this may also be +done with more general image processing tools (the IRAF task \fBimsum\fR +for example) the \fBccdred\fR tasks include special CCD dependent features such +as recognizing the image types and using the image header translation +file. Combining images is often done +with calibration images, which are easy to obtain in number, where it +is important to minimize the statistical noise so as to not affect the +object images. Sometimes object images also are combined. +The task is called \fBcombine\fR and there are special versions of +this task called \fBzerocombine, darkcombine\fR, and \fBflatcombine\fR +for the standard calibration images. +.PP +The task takes a list of input images to be combined. As output there +is the combined image, an optional sigma image, and optional log output either +to the terminal, to a log file, or both. A subset or subsets +of the input images may be selected based on the image type and a +subset parameter such as the filter. As with the processing task, +this allows selecting images without having to explicitly list each +image from a large data set. When combining based on a subset parameter +there is an output image, and possibly a sigma image, for each separate subset. +The output image pixel datatype may also be changed during combining; +usually from 16 bit integer input to real output. +The sigma image is the standard deviation of the input images about the +output image. +.PP +Except for summing the images together, +combining images may require correcting for variations between the images +due to differing exposure times, sky background, extinctions, and +positions. Currently, extinction corrections and registration are +not included but scaling and shifting corrections are included. +The scaling corrections may be done by exposure times or by computing +the mode in each image. Additive shifting is also done by computing +the mode in the images. The region of the image in which the mode +is computed can be specified but by default the whole image is used. +A scaling correction is used when the flux level or sensitivity is varying. +The offset correction is used when the sky brightness is varying independently +of the object brightness. If the images are not scaled then special +data paths combine the images more efficiently. +.PP +Except for medianing and summing, the images are combined by averaging. +The average may be weighted by + +.nf +.ft L + weight = (N * scale / mode) ** 2 +.ft R +.fi + +where \fIN\fR is the number of images previously combined (the task +records the number of images combined in the image header), \fIscale\fR +is the relative scale (applied by dividing) from the exposure time or +mode, and \fImode\fR is the background mode estimate used when adding a +variable offset. +.PP +The combining operation is the heart of the task. There are a number +algorithms which may be used as well as applying statistical weights. +The algorithms are used to detect and reject deviant pixels, such as +cosmic rays. +The choice of algorithm depends on the data, the number of images, +and the importance of rejecting cosmic rays. The more complex the +algorithm the more time consuming the operation. +The list below summarizes the algorithms. +Further algorithms may be added in time. + +.IP "Sum - sum the input images" +.br +The input images are combined by summing. Care must be taken +not to exceed the range of the 16 bit integer datatype when summing if the +output datatype is of this type. Summing is the only algorithm in which +scaling and weighting are not used. Also no sigma image is produced. +.IP "Average - average the input images" +.br +The input images are combined by averaging. The images may be scaled +and weighted. There is no pixel rejection. A sigma image is produced +if more than one image is combined. +.IP "Median - median the input images" +.br +The input images are combined by medianing each pixel. Unless the images +are at the same exposure level they should be scaled. The sigma image +is based on all the input images and is only an approximation to the +uncertainty in the median estimates. +.IP "Minreject, maxreject, minmaxreject - reject extreme pixels" +.br +At each pixel the minimum, maximum, or both are excluded from the +average. The images should be scaled and the average may be +weighted. The sigma image requires at least two pixels after rejection +of the extreme values. These are relatively fast algorithms and are +a good choice if there are many images (>15). +.IP "Threshold - reject pixels above and below specified thresholds" +.br +The input images are combined with pixels above and below specified +threshold values (before scaling) excluded. The images may be scaled +and the average weighted. The sigma image also has the rejected +pixels excluded. +.IP "Sigclip - apply a sigma clipping algorithm to each pixel" +.br +The input images are combined by applying a sigma clipping algorithm +at each pixel. The images should be scaled. This only rejects highly +deviant points and so +includes more of the data than the median or minimum and maximum +algorithms. It requires many images (>10-15) to work effectively. +Otherwise the bad pixels bias the sigma significantly. The mean +used to determine the sigmas is based on the "minmaxrej" algorithm +to eliminate the effects of bad pixels on the mean. Only one +iteration is performed and at most one pixel is rejected at each +point in the output image. After the deviant pixels are rejected the final +mean is computed from all the data. The sigma image excludes the +rejected pixels. +.IP "Avsigclip - apply a sigma clipping algorithm to each pixel" +.br +The input images are combined with a variant of the sigma clipping +algorithm which works well with only a few images. The images should +be scaled. For each line the mean is first estimated using the +"minmaxrej" algorithm. The sigmas at each point in the line are scaled +by the square root of the mean, that is a Poisson scaling of the noise +is assumed. These sigmas are averaged to get a line estimate of the +sigma. Then the sigma at each point in the line is estimated by +multiplying the line sigma by the square root of the mean at that point. As +with the sigma clipping algorithm only one iteration is performed and +at most one pixel is rejected at each point. After the deviant pixels +are rejected the file mean is computed from all the data. The sigma +image excludes the rejected pixels. +.RE +.PP +The "avsigclip" algorithm is the best algorithm for rejecting cosmic +rays, especially with a small number of images, but it is also the most +time consuming. With many images (>10-15) it might be advisable to use +one of the other algorithms ("maxreject", "median", "minmaxrej") because +of their greater speed. +.PP +This task also has several design features to make it efficient and +versatile. There are separate data paths for integer data and real +data; as with processing, if all input images and the output image are +of the same datatype then the I/O is done with no internal conversions. +With mixed datatypes the operations are done as real. Even in the +integer path the operations requiring real arithmetic to preserve the +accuracy of the calculation are performed in that mode. There is +effectively no limit to the number of images which may be combined. +Also, the task determines the amount of memory available and buffers +the I/O as much as possible. This is a case where operating on images +from disk rather than in memory is essential. +.NH +Status and Conclusion +.PP +The initial implementation of the IRAF \fBccdred\fR package was +completed in June 1987. It has been in use at the National Optical +Astronomy Observatories since April 1987. The package was not +distributed with Version 2.5 of IRAF (released in August 1987) but is +available as a separate installation upon request. It will be part of +future releases of IRAF. +.PP +At NOAO the CCD reduction package is available at the telescopes as the +data is obtained. This is accomplished by transferring the images from +the data taking computer to a Sun workstation (Sun Microsystems, Inc.) +initially via tape and later by a direct link. There are several +reasons for adopting this architecture. First, the data acquisition +system is well established and is dedicated to its real-time function. +The second computer was phased in without disrupting the essential +operation of the telescopes and if it fails data taking may continue +with data being stored on tape. The role of the second computer is to +provide faster and more powerful reduction and analysis capability not +required in a data acquisition system. In the future it can be more +easily updated to follow the state of the art in small computers. As +CCD detectors get larger the higher processing speeds will be essential +to keep up with the data flow. +.PP +By writing the reduction software in the high level, portable, IRAF +system the users have the capability to process their data from the +basic CCD reductions to a full analysis at the telescope. Furthermore, +the same software is widely available on a variety of computers if +later processing or reprocessing is desired; staff and visitors at NOAO +may also reduce their data at the headquarters facilities. The use of +a high level system was also essential in achieving the design goals; +it would be difficult to duplicate this complex package without +the rich programming environment provided by the IRAF system. +.NH +References +.PP +The following documentation is distributed by the National Optical +Astronomy Observatories, Central Computer Services, P.O. Box 26732, +Tucson, Arizona, 85726. A comprehensive description of the IRAF system +is given in \fIThe IRAF Data Reduction and Analysis System\fR by Doug +Tody (also appearing in \fIProceedings of the SPIE - Instrumentation in +Astronomy VI\fR, Vol. 627, 1986). A general guide to using IRAF is \fIA +User's Introduction to the IRAF Command Language\fR by Peter Shames +and Doug Tody. Both these documents are also part of the IRAF +documentation distributed with the system. +.PP +A somewhat more tutorial description of the \fBccdred\fR package is +\fIA User's Guide to the IRAF CCDRED Package\fR by the author. +Detailed task descriptions and supplementary documentation are +given in the on-line help library and are part of the user's guide. +.NH +Appendix +.PP +The current set of tasks making up the IRAF CCD Reduction Package, +\fBccdred\fR, are summarized below. + +.nf +.ft L + badpiximage - Create a bad pixel mask image from a bad pixel file + ccdgroups - Group CCD images into image lists + ccdhedit - CCD image header editor + ccdlist - List CCD processing information + ccdproc - Process CCD images + combine - Combine CCD images + darkcombine - Combine and process dark count images + flatcombine - Combine and process flat field images + mkfringecor - Make fringe correction images from sky images + mkillumcor - Make flat field illumination correction images + mkillumflat - Make illumination corrected flat fields + mkskycor - Make sky illumination correction images + mkskyflat - Make sky corrected flat field images +setinstrument - Set instrument parameters + zerocombine - Combine and process zero level images +.fi +.ft R diff --git a/noao/imred/ccdred/doc/ccdtypes.hlp b/noao/imred/ccdred/doc/ccdtypes.hlp new file mode 100644 index 00000000..2cec33ea --- /dev/null +++ b/noao/imred/ccdred/doc/ccdtypes.hlp @@ -0,0 +1,124 @@ +.help ccdtypes Jun87 noao.imred.ccdred +.ih +NAME +ccdtypes -- Description of the CCD image types +.ih +CCDTYPES +The following CCD image types may be specified as the value of the parameter +\fIccdtype\fR: + +.nf + "" - (the null string) all image types + object - object images + zero - zero level images such as a bias or preflash + dark - dark count images + flat - flat field images + illum - iillumination images + fringe - fringe correction images + other - other image types defined in the translation file + none - images without an image type parameter + unknown - image types not defined in the translation file +.fi +.ih +DESCRIPTION +The \fBccdred\fR package recognizes certain standard CCD image types +identified in the image header. The tasks may select images of a +particular CCD image type from image lists with the parameter +\fIccdtype\fR and also recognize and take special actions for +calibration images. + +In order to make use of CCD image type information the header keyword +identifying the image type must be specified in the instrument +translation file. This entry has the form + + imagetyp keyword + +where keyword is the image header keyword. This allows the package to +access the image type string. There must also be a translation between +the image type strings and the CCD types as recognized by the package. +This information consists of lines in the instrument translation file +of the form + + header package + +where header is the exact string given in the image header and package +is one of the types recognized by the package. The image header string +can be virtually anything and if it contains blanks it must be +quoted. The package image types are those given above except for +the null string, "none", and "unknown". That is, these types may +be specified as a CCD image type in selecting images but not as a translations +of image type strings. + +There may be more than one image type that maps to the same package +type. In particular other standard CCD image types, such as comparison +spectra, multiple exposure, standard star, etc., should be mapped to +object or other. There may also be more than one type of flat field, i.e. dome +flat, sky flat, and lamp flat. For more on the instrument translation +file see the help for \fBinstruments\fR. +.ih +EXAMPLES +1. The example entries in the instrument translation file are from the 1986 +NOAO CCD image header format produced by the CAMERA format tape writer. + +.nf + imagetyp data-typ + + 'OBJECT (0)' object + 'DARK (1)' dark + 'PROJECTOR FLAT (2)' flat + 'SKY FLAT (3)' other + 'COMPARISON LAMP (4)' other + 'BIAS (5)' zero + 'DOME FLAT (6)' flat +.fi + +The image header keyword describing the image type is "data-typ". +The values of the image type strings in the header contain blanks so they +are quoted. Also the case of the strings is important. Note that there +are two types of flat field images and two types of other images. + +2. One way to check the image types is with the task \fBccdlist\fR. + +.nf + cl> ccdlist *.imh + Zero.imh[504,1][real][zero][1][OT]:FOCUS L98-193 + Flat1.imh[504,1][real][flat][1][OTZ]:dflat 6v+blue 5s + ccd002.imh[504,504][real][unknown][1][OTZF]:FOCUS L98-193 + ccd003.imh[544,512][short][object][1]:L98-193 + ccd004.imh[544,512][short][object][1]:L98-193 + ccd005.imh[544,512][short][object][1]:L98-193 + oldformat.imh[544,512][short][none][1]:M31 V +.fi + +The unknown type has a header image type of "MUL (8)". The old format +image does not have any header type. + +3. To select only images of a particular type: + +.nf + cl> ccdlist *.imh ccdtype=object + ccd003.imh[544,512][short][object][1]:L98-193 + ccd004.imh[544,512][short][object][1]:L98-193 + ccd005.imh[544,512][short][object][1]:L98-193 + cl> ccdlist *.imh ccdtype=unknown + ccd002.imh[504,504][real][unknown][1][OTZF]:FOCUS L98-193 + cl> ccdlist *.imh ccdtype=none + oldformat.imh[544,512][short][none][1]:M31 V +.fi + +4. To process images with \fBccdproc\fR: + +.nf + cl> ccdproc *.imh + cl> ccdproc *.imh ccdtype=object +.fi + +In the first case all the images will be processed (the default value of +\fIccdtype\fR is ""). However, the task recognizes the calibration +images, such as zero level and flat fields, and processes them appropriately. +In the second case only object images are processed and all other images +are ignored (except if needed as a calibration image). +.ih +SEE ALSO +instruments +.endhelp diff --git a/noao/imred/ccdred/doc/combine.hlp b/noao/imred/ccdred/doc/combine.hlp new file mode 100644 index 00000000..474937bf --- /dev/null +++ b/noao/imred/ccdred/doc/combine.hlp @@ -0,0 +1,1146 @@ +.help combine Aug96 noao.imred.ccdred +.ih +NAME +combine -- Combine CCD images using various algorithms +.ih +USAGE +combine input output +.ih +PARAMETERS +.ls input +List of CCD images to combine. Images of a particular CCD image type may be +selected with the parameter \fIccdtype\fR with the remaining images ignored. +.le +.ls output +Output combined image or list of images. If the \fIproject\fR parameter is +no (the typical case for CCD acquisition) then there will be one output +image or, if the \fIsubsets\fR parameter is selected, one +output image per subset. If the images consist of stacks then +the \fIproject\fR option allows combining each input stack into separate +output images as given by the image list. +.le +.ls plfile = "" (optional) +Output pixel list file or list of files. If no name is given or the +list ends prematurely then no file is produced. The pixel list file +is a map of the number of pixels rejected or, equivalently, +the total number of input images minus the number of pixels actually used. +The file name is also added to the output image header under the +keyword BPM. +.le +.ls sigma = "" (optional) +Output sigma image or list of images. If no name is given or the list ends +prematurely then no image is produced. The sigma is standard deviation, +corrected for a finite population, of the input pixel values (excluding +rejected pixels) about the output combined pixel values. +.le + +.ls ccdtype = "" +CCD image type to combine. If specified only input images of the specified +type are combined. See \fBccdtypes\fR for the possible image types. +.le +.ls amps = yes +Combine images by amplifier? If yes then the input images are grouped by +the amplifier parameter and each group combined into a separate output +image. The amplifier identifier is appended to the output image name(s). +See \fBsubsets\fR for more on the amplifier parameter. +.le +.ls subsets = no +Combine images by subset parameter? If yes then the input images are +grouped by subset parameter and each group combined into a separate output +image. The subset identifier is appended to the output image +name(s). See \fBsubsets\fR for more on the subset parameter. +.le +.ls delete = no +Delete input images after combining? Only those images combined are deleted. +.le +.ls clobber = no +Clobber existing output images? THIS OPTION IS NO LONGER SUPPORTED BUT +THE PARAMETER REMAINS FOR NOW FOR BACKWARD COMPATIBILITY. IF SET TO +yes AN ERROR ABORT WILL OCCUR. +.le + +.ls combine = "average" (average|median) +Type of combining operation performed on the final set of pixels (after +offsetting, masking, thresholding, and rejection). The choices are +"average" or "median". The median uses the average of the two central +values when the number of pixels is even. +.le +.ls reject = "none" (none|minmax|ccdclip|crreject|sigclip|avsigclip|pclip) +Type of rejection operation performed on the pixels remaining after offsetting, +masking and thresholding. The algorithms are discussed in the +DESCRIPTION section. The rejection choices are: + +.nf + none - No rejection + minmax - Reject the nlow and nhigh pixels + ccdclip - Reject pixels using CCD noise parameters + crreject - Reject only positive pixels using CCD noise parameters + sigclip - Reject pixels using a sigma clipping algorithm + avsigclip - Reject pixels using an averaged sigma clipping algorithm + pclip - Reject pixels using sigma based on percentiles +.fi + +.le +.ls project = no +Project (combine) across the highest dimension of the input images? If +no then all the input images are combined to a single output image. If +yes then the highest dimension elements of each input image are combined to +an output image and optional pixel list and sigma images. Each element of +the highest dimension may have a separate offset but there can only be one +mask image. +.le +.ls outtype = "real" (short|ushort|integer|long|real|double) +Output image pixel datatype. The pixel datatypes are "double", "real", +"long", "integer", unsigned short ("ushort") and "short" with highest +precedence first. If none is specified then the highest precedence +datatype of the input images is used. A mixture of short and unsigned +short images has a highest precedence of integer. +The datatypes may be abbreviated to +a single character. +.le +.ls offsets = "none" (none|wcs|grid|<filename>) +Integer offsets to add to each image axes. The options are: +.ls "none" +No offsets are applied. +.le +.ls "wcs" +The world coordinate system (wcs) in the image is used to derive the +offsets. The nearest integer offset that matches the world coordinate +at the center of the first input image is used. +.le +.ls "grid" +A uniform grid of offsets is specified by a string of the form + +.nf + grid [n1] [s1] [n2] [s2] ... +.fi + +where ni is the number of images in dimension i and si is the step +in dimension i. For example "grid 5 100 5 100" specifies a 5x5 +grid with origins offset by 100 pixels. +.le +.ls <filename> +The offsets are given in the specified file. The file consists +of one line per image with the offsets in each dimension forming the +columns. +.le +.le +.ls masktype = "none" (none|goodvalue|badvalue|goodbits|badbits) +Type of pixel masking to use. If "none" then no pixel masking is done +even if an image has an associated pixel mask. The other choices +are to select the value in the pixel mask to be treated as good +(goodvalue) or bad (badvalue) or the bits (specified as a value) +to be treated as good (goodbits) or bad (badbits). The pixel mask +file name comes from the image header keyword BPM. +Note that when +combining images by projection of the highest dimension only one +pixel mask is applied to all the images. \fBAlso if the number of +input images becomes too large (currently about 115 .imh or 57 .hhh +images) then the images are temporarily stacked and combined by projection +which also means the bad pixel mask from the first image will be used +for all images.\fR +.le +.ls maskvalue = 0 +Mask value used with the \fImasktype\fR parameter. If the mask type +selects good or bad bits the value may be specified using IRAF notation +for decimal, octal, or hexadecimal; i.e 12, 14b, 0cx to select bits 3 +and 4. +.le +.ls blank = 0. +Output value to be used when there are no pixels. +.le + +.ls scale = "none" (none|mode|median|mean|exposure|@<file>|!<keyword>) +Multiplicative image scaling to be applied. The choices are none, scale +by the mode, median, or mean of the specified statistics section, scale +by the exposure time in the image header, scale by the values in a specified +file, or scale by a specified image header keyword. When specified in +a file the scales must be one per line in the order of the input +images. +.le +.ls zero = "none" (none|mode|median|mean|@<file>|!<keyword>) +Additive zero level image shifts to be applied. The choices are none or +shift by the mode, median, or mean of the specified statistics section, +shift by values given in a file, or shift by values given by an image +header keyword. When specified in a file the zero values must be one +per line in the order of the input images. File or keyword zero offset +values do not allow a correction to the weights. +.le +.ls weight = "none" (none|mode|median|mean|exposure|@<file>|!<keyword>) +Weights to be applied during the final averaging. The choices are none, +the mode, median, or mean of the specified statistics section, the exposure +time, values given in a file, or values given by an image header keyword. +When specified in a file the weights must be one per line in the order of +the input images and the only adjustment made by the task is for the number of +images previously combined. In this case the weights should be those +appropriate for the scaled images which would normally be the inverse +of the variance in the scaled image. +.le +.ls statsec = "" +Section of images to use in computing image statistics for scaling and +weighting. If no section is given then the entire region of the input is +sampled (for efficiency the images are sampled if they are big enough). +When the images are offset relative to each other one can precede the image +section with one of the modifiers "input", "output", "overlap". The first +interprets the section relative to the input image (which is equivalent to +not specifying a modifier), the second interprets the section relative to +the output image, and the last selects the common overlap and any following +section is ignored. +.le + +.ce +Algorithm Parameters +.ls lthreshold = INDEF, hthreshold = INDEF +Low and high thresholds to be applied to the input pixels. This is done +before any scaling, rejection, and combining. If INDEF the thresholds +are not used. +.le +.ls nlow = 1, nhigh = 1 (minmax) +The number of low and high pixels to be rejected by the "minmax" algorithm. +These numbers are converted to fractions of the total number of input images +so that if no rejections have taken place the specified number of pixels +are rejected while if pixels have been rejected by masking, thresholding, +or nonoverlap, then the fraction of the remaining pixels, truncated +to an integer, is used. +.le +.ls nkeep = 1 +The minimum number of pixels to retain or the maximum number to reject when +using the clipping algorithms (ccdclip, crreject, sigclip, avsigclip, or +pclip). When given as a positive value this is the minimum number to +keep. When given as a negative value the absolute value is the maximum +number to reject. If there are fewer pixels at some point due to +offsetting, thresholding, or masking then if the number to keep (positive +nkeep) is greater than the number of pixels no pixels will be rejected and +if the number to reject is given (negative nkeep) then up to that number +may be rejected. +.le +.ls mclip = yes (ccdclip, crreject, sigclip, avsigcliip) +Use the median as the estimate for the true intensity rather than the +average with high and low values excluded in the "ccdclip", "crreject", +"sigclip", and "avsigclip" algorithms? The median is a better estimator +in the presence of data which one wants to reject than the average. +However, computing the median is slower than the average. +.le +.ls lsigma = 3., hsigma = 3. (ccdclip, crreject, sigclip, avsigclip, pclip) +Low and high sigma clipping factors for the "ccdclip", "crreject", "sigclip", +"avsigclip", and "pclip" algorithms. They multiply a "sigma" factor +produced by the algorithm to select a point below and above the average or +median value for rejecting pixels. The lower sigma is ignored for the +"crreject" algorithm. +.le +.ls rdnoise = "0.", gain = "1.", snoise = "0." (ccdclip, crreject) +CCD readout noise in electrons, gain in electrons/DN, and sensitivity noise +as a fraction. These parameters are used with the "ccdclip" and "crreject" +algorithms. The values may be either numeric or an image header keyword +which contains the value. The noise model for a pixel is: + +.nf + variance in DN = (rdnoise/gain)^2 + DN/gain + (snoise*DN)^2 + variance in e- = (rdnoise)^2 + (gain*DN) + (snoise*(gain*DN))^2 + = rdnoise^2 + Ne + (snoise * Ne)^2 +.fi + +where DN is the data number and Ne is the number of electrons. Sensitivity +noise typically comes from noise introduced during flat fielding. +.le +.ls sigscale = 0.1 (ccdclip, crreject, sigclip, avsigclip) +This parameter determines when poisson corrections are made to the +computation of a sigma for images with different scale factors. If all +relative scales are within this value of unity and all relative zero level +offsets are within this fraction of the mean then no correction is made. +The idea is that if the images are all similarly though not identically +scaled, the extra computations involved in making poisson corrections for +variations in the sigmas can be skipped. A value of zero will apply the +corrections except in the case of equal images and a large value can be +used if the sigmas of pixels in the images are independent of scale and +zero level. +.le +.ls pclip = -0.5 (pclip) +Percentile clipping algorithm parameter. If greater than +one in absolute value then it specifies a number of pixels above or +below the median to use for computing the clipping sigma. If less +than one in absolute value then it specifies the fraction of the pixels +above or below the median to use. A positive value selects a point +above the median and a negative value selects a point below the median. +The default of -0.5 selects approximately the quartile point. +See the DESCRIPTION section for further details. +.le +.ls grow = 0 +Number of pixels to either side of a rejected pixel along image lines +to also be rejected. This applies only to pixels rejected by one of +the rejection algorithms and not the masked or threshold rejected pixels. +.le + +PACKAGE PARAMETERS + +The package parameters are used to specify verbose and log output and the +instrument and header definitions. +.ih +DESCRIPTION +A set of CCD images are combined by weighted averaging or medianing. Pixels +may be rejected from the combining by using pixel masks, threshold levels, +and rejection algorithms. The images may be scaled multiplicatively or +additively based on image statistics, image header keywords, or text files +before rejection. The images may be combined with integer pixel coordinate +offsets to produce an image bigger than any of the input images. +This task is a variant of the \fBimages.imcombine\fR task specialized +for CCD images. + +The input images to be combined are specified by a list. A subset or +subsets of the input list may be selected using the parameters +\fIccdtype\fR and \fIsubsets\fR. The \fIccdtype\fR parameter +selects only images of a specified standard CCD image type. +The \fIsubsets\fR parameter breaks up the input +list into sublists of common subset parameter (filter, grating, etc.). For +more information see \fBccdtypes\fR and \fBsubsets\fR. This selection +process is useful with wildcard templates to combine, for example, the flat +field images for each filter in one step (see \fBflatcombine\fR). When +subsets of the input list are used the output image and optional pixel file +and sigma image are given by root names with an amplifier and subset +identifier appended by the task. + +If the \fBproject\fR parameter is yes then the highest dimension elements +of each input image are combined to make an output image of one lower +dimension. There is no limit to the number of elements combined in this +case. This case is If the \fBproject\fR is no then the entire input list +is combined to form a single output image per subset. In this case the +images must all have the same dimensionality but they may have different +sizes. There is a software limit of approximately 100 images in this +case. + +The output image header is a copy of the first image in the combined set. +In addition, the number of images combined is recorded under the keyword +NCOMBINE, the exposure time is updated as the weighted average of the input +exposure times, and any pixel list file created is recorded under the +keyword BPM. The output pixel type is set by the parameter \fIouttype\fR. +If left blank then the input datatype of highest precision is used. +A mixture of short and unsigned short images has a highest precision of +integer. + +In addition to one or more output combined images there may also be a pixel +list image containing the number of pixels rejected at each point in the +output image, an image containing the sigmas of the pixels combined about +the final output combined pixels, and a log file. The pixel list image is +in the compact pixel list format which can be used as an image in other +programs. The sigma computation is the standard deviation corrected for a +finite population (the n/(n-1) factor) including weights if a weighted +average is used. + +Other input/output parameters are \fIdelete\fR and \fIclobber\fR. The +\fIdelete\fR parameter may be set to "yes" to delete the input images +used in producing an output image after it has been created. This is +useful for minimizing disk space, particularly with large +sets of calibration images needed to achieve high statistical accuracy +in the final calibration image. The \fBclobber\fR parameter allows +the output image names to be existing images which are overwritten (at +the end of the operation). + +An outline of the steps taken by the program is given below and the +following sections elaborate on the steps. + +.nf +o Set the input image offsets and the final output image size. +o Set the input image scales and weights +o Write the log file output +.fi + +For each output image line: + +.nf +o Get input image lines that overlap the output image line +o Reject masked pixels +o Reject pixels outside the threshold limits +o Reject pixels using the specified algorithm +o Reject neighboring pixels along each line +o Combine remaining pixels using the weighted average or median +o Compute sigmas of remaining pixels about the combined values +o Write the output image line, rejected pixel list, and sigmas +.fi + + +OFFSETS + +The images to be combined need not be of the same size or overlap. They +do have to have the same dimensionality which will also be the dimensionality +of the output image. Any dimensional images supported by IRAF may be +used. Note that if the \fIproject\fR flag is yes then the input images +are the elements of the highest dimension; for example the planes of a +three dimensional image. + +The overlap of the images is determined by a set of integer pixel offsets +with an offset for each dimension of each input image. For example +offsets of 0, 10, and 20 in the first dimension of three images will +result in combining the three images with only the first image in the +first 10 colums, the first two images in the next 10 columns and +all three images starting in the 31st column. At the 31st output column +the 31st column of the first image will be combined with the 21st column +of the second image and the 1st column of the third image. + +The output image size is set by the maximum extent in each dimension +of any input image after applying the offsets. In the above example if +all the images have 100 columns then the output image will have 130 +columns corresponding to the 30 column offset in the third image. + +The input image offsets are set using the \fIoffset\fR parameter. There +are four ways to specify the offsets. If the word "none" or the empty +string "" are used then all offsets will be zero and all pixels with the +same coordinates will be combined. The output image size will be equal to +the biggest dimensions of the input images. + +If "wcs" offsets are specified then the world coordinate systems (wcs) +in the image headers are used to derived the offsets. The world coordinate +at the center of the first input image is evaluated. Then integer pixel +offsets are determined for each image to bring the same world coordinate +to the same point. Note the following caveats. The world coordinate +systems must be of the same type, orientation, and scale and only the +nearest integer shift is used. + +If the input images have offsets in a regular grid or one wants to make +an output image in which the input images are "mosaiced" together in +a grid then the special offset string beginning with the word "grid" +is used. The format is + +.nf + grid [n1] [s1] [n2] [s2] ... +.fi + +where ni is the number of images in dimension i and si is the step in +dimension i. For example "grid 5 100 5 100" specifies a 5x5 grid with +origins offset by 100 pixels. Note that one must insure that the input +images are specified in the correct order. This may best be accomplished +using a "@" list. One useful application of the grid is to make a +nonoverlapping mosaic of a number of images for display purposes. Suppose +there are 16 images which are 100x100. The offset string "grid 4 101 4 +101" will produce a mosaic with a one pixel border having the value set +by \fIblank\fR parameter between the images. + +The offsets may be defined in a file by specifying the file name +in the \fIoffset\fR parameter. (Note that the special file name STDIN +may be used to type in the values terminated by the end-of-file +character). The file consists of a line for each input image. The lines +must be in the same order as the input images and so an "@" list may +be useful. The lines consist of whitespace separated offsets one for +each dimension of the images. In the first example cited above the +offset file might contain: + +.nf + 0 0 + 10 0 + 20 0 +.fi + +where we assume the second dimension has zero offsets. + +The offsets need not have zero for one of the images. The offsets may +include negative values or refer to some arbitrary common point. +When the offsets are read by the program it will find the minimum +value in each dimension and subtract it from all the other offsets +in that dimension. The above example could also be specified as: + +.nf + 225 15 + 235 15 + 245 15 +.fi + +There may be cases where one doesn't want the minimum offsets reset +to zero. If all the offsets are positive and the comment "# Absolute" +appears in the offset file then the images will be combined with +blank values between the first output pixel and the first overlapping +input pixel. Continuing with the above example, the file + +.nf + # Absolute + 10 10 + 20 10 + 30 10 +.fi + +will have the first pixel of the first image in the 11th pixel of the +output image. Note that there is no way to "pad" the other side of +the output image. + + +SCALES AND WEIGHTS + +In order to combine images with rejection of pixels based on deviations +from some average or median they must be scaled to a common level. There +are two types of scaling available, a multiplicative intensity scale and an +additive zero point shift. The intensity scaling is defined by the +\fIscale\fR parameter and the zero point shift by the \fIzero\fR +parameter. These parameters may take the values "none" for no scaling, +"mode", "median", or "mean" to scale by statistics of the image pixels, +"exposure" (for intensity scaling only) to scale by the exposure time +keyword in the image header, any other image header keyword specified by +the keyword name prefixed by the character '!', and the name of a file +containing the scale factors for the input image prefixed by the +character '@'. + +Examples of the possible parameter values are shown below where +"myval" is the name of an image header keyword and "scales.dat" is +a text file containing a list of scale factors. + +.nf + scale = none No scaling + zero = mean Intensity offset by the mean + scale = exposure Scale by the exposure time + zero = !myval Intensity offset by an image keyword + scale = @scales.dat Scales specified in a file +.fi + +The image statistics factors are computed by sampling a uniform grid +of points with the smallest grid step that yields less than 10000 +pixels; sampling is used to reduce the time need to compute the statistics. +If one wants to restrict the sampling to a region of the image the +\fIstatsec\fR parameter is used. This parameter has the following +syntax: + +.nf + [input|output|overlap] [image section] +.fi + +The initial modifier defaults to "input" if absent. The modifiers are useful +if the input images have offsets. In that case "input" specifies +that the image section refers to each input image, "output" specifies +that the image section refers to the output image coordinates, and +"overlap" specifies the mutually overlapping region of the input images. +In the latter case an image section is ignored. + +The statistics are as indicated by their names. In particular, the +mode is a true mode using a bin size which is a fraction of the +range of the pixels and is not based on a relationship between the +mode, median, and mean. Also masked pixels are excluded from the +computations as well as during the rejection and combining operations. + +The "exposure" option in the intensity scaling uses the exposure time +from the image header. If one wants to use a nonexposure time image +header keyword the !<keyword> syntax is available. + +If both an intensity scaling and zero point shift are selected the +multiplicative scaling is done first. Use of both makes sense +if the intensity scaling is the exposure time to correct for +different exposure times and then the zero point shift allows for +sky brightness changes. + +The image statistics and scale factors are recorded in the log file +unless they are all equal, which is equivalent to no scaling. The +intensity scale factors are normalized to a unit mean and the zero +point shifts are adjust to a zero mean. When the factors are specified +in an @file or by a keyword they are not normalized. + +Scaling affects not only the mean values between images but also the +relative pixel uncertainties. For example scaling an image by a +factor of 0.5 will reduce the effective noise sigma of the image +at each pixel by the square root of 0.5. Changes in the zero +point also changes the noise sigma if the image noise characteristics +are Poissonian. In the various rejection algorithms based on +identifying a noise sigma and clipping large deviations relative to +the scaled median or mean, one may need to account for the scaling induced +changes in the image noise characteristics. + +In those algorithms it is possible to eliminate the "sigma correction" +while still using scaling. The reasons this might be desirable are 1) if +the scalings are similar the corrections in computing the mean or median +are important but the sigma corrections may not be important and 2) the +image statistics may not be Poissonian, either inherently or because the +images have been processed in some way that changes the statistics. In the +first case because computing square roots and making corrections to every +pixel during the iterative rejection operation may be a significant +computational speed limit the parameter \fIsigscale\fR selects how +dissimilar the scalings must be to require the sigma corrections. This +parameter is a fractional deviation which, since the scale factors are +normalized to unity, is the actual minimum deviation in the scale factors. +For the zero point shifts the shifts are normalized by the mean shift +before adjusting the shifts to a zero mean. To always use sigma scaling +corrections the parameter is set to zero and to eliminate the correction in +all cases it is set to a very large number. + +If the final combining operation is "average" then the images may be +weighted during the averaging. The weights are specified in the +same way as the scale factors. In addition +the NCOMBINE keyword, if present, will be used in the weights. +The weights, scaled to a unit sum, are printed in the log output. + +The weights are only used for the final weighted average and sigma image +output. They are not used to form averages in the various rejection +algorithms. For weights in the case of no scaling or only multiplicative +scaling the weights are used as given or determined so that images with +lower signal levels will have lower weights. However, for cases in which +zero level scaling is used and the zero levels are determined from image +statistics (not from an input file or keyword) the weights are computed +from the initial weights (the exposure time, image statistics, or input +values) using the formula: + +.nf + weight_final = weight_initial / (scale * sky) +.fi + +where the sky values are those from the image statistics before conversion +to zero level shifts and adjustment to zero mean over all images. The +reasoning is that if the zero level is high the sky brightness is high and +so the S/N is lower and the weight should be lower. If any sky value +determined from the image statistics comes out to be negative a warning is +given and the none of the weight are adjusted for sky levels. + +The weights are not adjusted when the zero offsets are input from a file +or keyword since these values do not imply the actual image sky value. +In this case if one wants to account for different sky statistics +in the weights the user must specify the weights in a file taking +explicit account of changes in the weights due to different sky +statistics. + + +PIXEL MASKS + +A pixel mask is a type of IRAF file having the extension ".pl" which +identifies an integer value with each pixel of the images to which it is +applied. The integer values may denote regions, a weight, a good or bad +flag, or some other type of integer or integer bit flag. In the common +case where many values are the same this file is compacted to be small and +efficient to use. It is also most compact and efficient if the majority of +the pixels have a zero mask value so frequently zero is the value for good +pixels. Note that these files, while not stored as a strict pixel array, +may be treated as images in programs. This means they may be created by +programs such as \fBmkpattern\fR, edited by \fBimedit\fR, examined by +\fBimexamine\fR, operated upon by \fBimarith\fR, graphed by \fBimplot\fR, +and displayed by \fBdisplay\fR. + +At the time of introducing this task, generic tools for creating +pixel masks have yet to be written. There are two ways to create a +mask in V2.10. First if a regular integer image can be created +then it can be converted to pixel list format with \fBimcopy\fR: + +.nf + cl> imcopy template plfile.pl +.fi + +by specifically using the .pl extension on output. Other programs that +can create integer images (such \fBmkpattern\fR or \fBccdred.badpiximage\fR) +can create the pixel list file directly by simply using the ".pl" +extension in the output image name. + +To use pixel masks with \fBcombine\fR one must associate a pixel +mask file with an image by entering the pixel list file name in the +image header under the keyword BPM (bad pixel mask). This can be +done with \fBhedit\fR. Note that the same pixel mask may be associated +with more than one image as might be the case if the mask represents +defects in the detector used to obtain the images. + +If a pixel mask is associated with an image the mask is used when the +\fImasktype\fR parameter is set to a value other than "none". Note that +when it is set to "none" mask information is not used even if it exists for +the image. The values of \fImasktype\fR which apply masks are "goodvalue", +"badvalue", "goodbits", and "badbits". They are used in conjunction with +the \fImaskvalue\fR parameter. When the mask type is "goodvalue" the +pixels with mask values matching the specified value are included in +combining and all others are rejected. Similarly, for a mask type of +"badvalue" the pixels with mask values matching the specified value are +rejected and all others are accepted. The bit types are useful for +selecting a combination of attributes in a mask consisting of bit flags. +The mask value is still an integer but is interpreted by bitwise comparison +with the values in the mask file. + +If a mask operation is specified and an image has no mask image associated +with it then the mask values are taken as all zeros. In those cases be +careful that zero is an accepted value otherwise the entire image will be +rejected. + +In the case of combining the higher dimensions of an image into a +lower dimensional image, the "project" option, the same pixel mask +is applied to all of the data being combined; i.e. the same 2D +pixel mask is applied to every plane of a 3D image. This is because +a higher dimensional image is treated as a collection of lower +dimensional images having the same header and hence the same +bad pixel mask. It would be tempting to use a bad pixel mask with +the same dimension as the image being projected but this is not +currently how the task works. + +When the number of input images exceeds the maximum number of open files +allowed by IRAF (currently about 115 .imh or 57 .hhh images) the input +images are stacked and combined with the project option. \fBThis means +that the bad pixel mask from the first input image will be applied to all +the images.\fR + + +THRESHOLD REJECTION + +In addition to rejecting masked pixels, pixels in the unscaled input +images which are below or above the thresholds given by the parameters +\fIlthreshold\fR and \fIhthreshold\fR are rejected. Values of INDEF +mean that no threshold value is applied. Threshold rejection may be used +to exclude very bad pixel values or as an alternative way of masking +images. In the latter case one can use a task like \fBimedit\fR +or \fBimreplace\fR to set parts of the images to be excluded to some +very low or high magic value. + + +REJECTION ALGORITHMS + +The \fIreject\fR parameter selects a type of rejection operation to +be applied to pixels not masked or thresholded. If no rejection +operation is desired the value "none" is specified. + +MINMAX +.in 4 +A specified fraction of the highest and lowest pixels are rejected. +The fraction is specified as the number of high and low pixels, the +\fInhigh\fR and \fInlow\fR parameters, when data from all the input images +are used. If pixels have been rejected by offseting, masking, or +thresholding then a matching fraction of the remaining pixels, truncated +to an integer, are used. Thus, + +.nf + nl = n * nlow/nimages + 0.001 + nh = n * nhigh/nimages + 0.001 +.fi + +where n is the number of pixels surviving offseting, masking, and +thresholding, nimages is the number of input images, nlow and nhigh +are task parameters and nl and nh are the final number of low and +high pixels rejected by the algorithm. The factor of 0.001 is to +adjust for rounding of the ratio. + +As an example with 10 input images and specifying one low and two high +pixels to be rejected the fractions to be rejected are nlow=0.1 and nhigh=0.2 +and the number rejected as a function of n is: + +.nf + n 0 1 2 3 4 5 6 7 8 9 10 + nl 0 0 0 0 0 0 0 0 0 0 1 + nh 0 0 0 0 0 1 1 1 1 1 2 +.fi + +.in -4 +CCDCLIP +.in 4 +If the images are obtained using a CCD with known read out noise, gain, and +sensitivity noise parameters and they have been processed to preserve the +relation between data values and photons or electrons then the noise +characteristics of the images are well defined. In this model the sigma in +data values at a pixel with true value <I>, as approximated by the median +or average with the lowest and highest value excluded, is given by: + +.nf + sigma = ((rn / g) ** 2 + <I> / g + (s * <I>) ** 2) ** 1/2 +.fi + +where rn is the read out noise in electrons, g is the gain in +electrons per data value, s is a sensitivity noise given as a fraction, +and ** is the exponentiation operator. Often the sensitivity noise, +due to uncertainties in the pixel sensitivities (for example from the +flat field), is not known in which case a value of zero can be used. +See the task \fBstsdas.wfpc.noisemodel\fR for a way to determine +these vaues (though that task expresses the read out noise in data +numbers and the sensitivity noise parameter as a percentage). + +The read out noise is specified by the \fIrdnoise\fR parameter. The value +may be a numeric value to be applied to all the input images or a image +header keyword containing the value for each image. Similarly, the +parameter \fIgain\fR specifies the gain as either a value or image header +keyword and the parameter \fIsnoise\fR specifies the sensitivity +noise parameter as either a value or image header keyword. + +The algorithm operates on each output pixel independently. It starts by +taking the median or unweighted average (excluding the minimum and maximum) +of the unrejected pixels provided there are at least two input pixels. The +expected sigma is computed from the CCD noise parameters and pixels more +that \fIlsigma\fR times this sigma below or \fIhsigma\fR times this sigma +above the median or average are rejected. The process is then iterated +until no further pixels are rejected. If the average is used as the +estimator of the true value then after the first round of rejections the +highest and lowest values are no longer excluded. Note that it is possible +to reject all pixels if the average is used and is sufficiently skewed by +bad pixels such as cosmic rays. + +If there are different CCD noise parameters for the input images +(as might occur using the image header keyword specification) then +the sigmas are computed for each pixel from each image using the +same estimated true value. + +If the images are scaled and shifted and the \fIsigscale\fR threshold +is exceedd then a sigma is computed for each pixel based on the +image scale parameters; i.e. the median or average is scaled to that of the +original image before computing the sigma and residuals. + +After rejection the number of retained pixels is checked against the +\fInkeep\fR parameter. If there are fewer pixels retained than specified +by this parameter the pixels with the smallest residuals in absolute +value are added back. If there is more than one pixel with the same +absolute residual (for example the two pixels about an average +or median of two will have the same residuals) they are all added +back even if this means more than \fInkeep\fR pixels are retained. +Note that the \fInkeep\fR parameter only applies to the pixels used +by the clipping rejection algorithm and does not apply to threshold +or bad pixel mask rejection. + +This is the best clipping algorithm to use if the CCD noise parameters are +adequately known. The parameters affecting this algorithm are \fIreject\fR +to select this algorithm, \fImclip\fR to select the median or average for +the center of the clipping, \fInkeep\fR to limit the number of pixels +rejected, the CCD noise parameters \fIrdnoise, gain\fR and \fIsnoise\fR, +\fIlsigma\fR and \fIhsigma\fR to select the clipping thresholds, +and \fIsigscale\fR to set the threshold for making corrections to the sigma +calculation for different image scale factors. + +.in -4 +CRREJECT +.in 4 +This algorithm is identical to "ccdclip" except that only pixels above +the average are rejected based on the \fIhsigma\fR parameter. This +is appropriate for rejecting cosmic ray events and works even with +two images. + +.in -4 +SIGCLIP +.in 4 +The sigma clipping algorithm computes at each output pixel the median or +average excluding the high and low values and the sigma about this +estimate. There must be at least three input pixels, though for this method +to work well there should be at least 10 pixels. Values deviating by more +than the specified sigma threshold factors are rejected. These steps are +repeated, except that after the first time the average includes all values, +until no further pixels are rejected or there are fewer than three pixels. + +After rejection the number of retained pixels is checked against the +\fInkeep\fR parameter. If there are fewer pixels retained than specified +by this parameter the pixels with the smallest residuals in absolute +value are added back. If there is more than one pixel with the same +absolute residual (for example the two pixels about an average +or median of two will have the same residuals) they are all added +back even if this means more than \fInkeep\fR pixels are retained. +Note that the \fInkeep\fR parameter only applies to the pixels used +by the clipping rejection algorithm and does not apply to threshold +or bad pixel mask rejection. + +The parameters affecting this algorithm are \fIreject\fR to select +this algorithm, \fImclip\fR to select the median or average for the +center of the clipping, \fInkeep\fR to limit the number of pixels +rejected, \fIlsigma\fR and \fIhsigma\fR to select the +clipping thresholds, and \fIsigscale\fR to set the threshold for +making corrections to the sigma calculation for different image scale +factors. + +.in -4 +AVSIGCLIP +.in 4 +The averaged sigma clipping algorithm assumes that the sigma about the +median or mean (average excluding the low and high values) is proportional +to the square root of the median or mean at each point. This is +described by the equation: + +.nf + sigma(column,line) = sqrt (gain(line) * signal(column,line)) +.fi + +where the \fIestimated\fR signal is the mean or median (hopefully excluding +any bad pixels) and the gain is the \fIestimated\fR proportionality +constant having units of photons/data number. + +This noise model is valid for images whose values are proportional to the +number of photons recorded. In effect this algorithm estimates a +detector gain for each line with no read out noise component when +information about the detector noise parameters are not known or +available. The gain proportionality factor is computed +independently for each output line by averaging the square of the residuals +(at points having three or more input values) scaled by the median or +mean. In theory the proportionality should be the same for all rows but +because of the estimating process will vary somewhat. + +Once the proportionality factor is determined, deviant pixels exceeding the +specified thresholds are rejected at each point by estimating the sigma +from the median or mean. If any values are rejected the median or mean +(this time not excluding the extreme values) is recomputed and further +values rejected. This is repeated until there are no further pixels +rejected or the number of remaining input values falls below three. Note +that the proportionality factor is not recomputed after rejections. + +If the images are scaled differently and the sigma scaling correction +threshold is exceedd then a correction is made in the sigma +calculations for these differences, again under the assumption that +the noise in an image scales as the square root of the mean intensity. + +After rejection the number of retained pixels is checked against the +\fInkeep\fR parameter. If there are fewer pixels retained than specified +by this parameter the pixels with the smallest residuals in absolute +value are added back. If there is more than one pixel with the same +absolute residual (for example the two pixels about an average +or median of two will have the same residuals) they are all added +back even if this means more than \fInkeep\fR pixels are retained. +Note that the \fInkeep\fR parameter only applies to the pixels used +by the clipping rejection algorithm and does not apply to threshold +or bad pixel mask rejection. + +This algorithm works well for even a few input images. It works better if +the median is used though this is slower than using the average. Note that +if the images have a known read out noise and gain (the proportionality +factor above) then the "ccdclip" algorithm is superior. The two algorithms +are related in that the average sigma proportionality factor is an estimate +of the gain. + +The parameters affecting this algorithm are \fIreject\fR to select +this algorithm, \fImclip\fR to select the median or average for the +center of the clipping, \fInkeep\fR to limit the number of pixels +rejected, \fIlsigma\fR and \fIhsigma\fR to select the +clipping thresholds, and \fIsigscale\fR to set the threshold for +making corrections to the sigma calculation for different image scale +factors. + +.in -4 +PCLIP +.in 4 +The percentile clipping algorithm is similar to sigma clipping using the +median as the center of the distribution except that, instead of computing +the sigma of the pixels from the CCD noise parameters or from the data +values, the width of the distribution is characterized by the difference +between the median value and a specified "percentile" pixel value. This +width is then multipled by the scale factors \fIlsigma\fR and \fIhsigma\fR +to define the clipping thresholds above and below the median. The clipping +is not iterated. + +The pixel values at each output point are ordered in magnitude and the +median is determined. In the case of an even number of pixels the average +of the two middle values is used as the median value and the lower or upper +of the two is the median pixel when counting from the median pixel to +selecting the percentile pixel. The parameter \fIpclip\fR selects the +percentile pixel as the number (if the absolute value is greater +than unity) or fraction of the pixels from the median in the ordered set. +The direction of the percentile pixel from the median is set by the sign of +the \fIpclip\fR parameter with a negative value signifying pixels with +values less than the median. Fractional values are internally converted to +the appropriate number of pixels for the number of input images. A minimum +of one pixel and a maximum corresponding to the extreme pixels from the +median are enforced. The value used is reported in the log output. Note +that the same percentile pixel is used even if pixels have been rejected by +offseting, masking, or thresholding; for example, if the 3nd pixel below +the median is specified then the 3rd pixel will be used whether there are +10 pixels or 5 pixels remaining after the preliminary steps. + +Some examples help clarify the definition of the percentile pixel. In the +examples assume 10 pixels. The median is then the average of the +5th and 6th pixels. A \fIpclip\fR value of 2 selects the 2nd pixel +above the median (6th) pixel which is the 8th pixel. A \fIpclip\fR +value of -0.5 selects the point halfway between the median and the +lowest pixel. In this case there are 4 pixels below the median, +half of that is 2 pixels which makes the percentile pixel the 3rd pixel. + +The percentile clipping algorithm is most useful for clipping small +excursions, such as the wings of bright objects when combining +disregistered observations for a sky flat field, that are missed when using +the pixel values to compute a sigma. It is not as powerful, however, as +using the CCD noise parameters (provided they are accurately known) to clip +about the median. + +The parameters affecting this algorithm are \fIreject\fR to select this +algorithm, \fIpclip\fR to select the percentile pixel, \fInkeep\fR to limit +the number of pixels rejected, and \fIlsigma\fR and \fIhsigma\fR to select +the clipping thresholds. + +.in -4 +GROW REJECTION + +Neighbors of pixels rejected by the rejection algorithms along image lines +may also be rejected. The number of neighbors to be rejected on either +side is specified by the \fIgrow\fR parameter. The rejection only +applies to neighbors along each image line. This is because the +task operates independently on each image line and does not have the +ability to go back to previous lines or maintain a list of rejected +pixels to later lines. + +This rejection step is also checked against the \fInkeep\fR parameter +and only as many pixels as would not violate this parameter are +rejected. Unlike it's application in the rejection algorithms at +this stage there is no checking on the magnitude of the residuals +and the pixels retained which would otherwise be rejected are randomly +selected. + + +COMBINING + +After all the steps of offsetting the input images, masking pixels, +threshold rejection, scaling, and applying a rejection algorithms the +remaining pixels are combined and output. The pixels may be combined +by computing the median or by computing a weighted average. + + +SIGMA OUTPUT + +In addition to the combined image and optional sigma image may be +produced. The sigma computed is the standard deviation, corrected for a +finite population by a factor of n/(n-1), of the unrejected input pixel +values about the output combined pixel values. +.ih +EXAMPLES +1. To average and median images without any other features: + +.nf + cl> combine obj* avg combine=average reject=none + cl> combine obj* med combine=median reject=none +.fi + +2. To reject cosmic rays: + +.nf + cl> combine obs1,obs2 Obs reject=crreject rdnoise=5.1, gain=4.3 +.fi + +3. To make a grid for display purposes with 21 64x64 images: + +.nf + cl> combine @list grid offset="grid 5 65 5 65" +.fi + +4. To apply a mask image with good pixels marked with a zero value and + bad pixels marked with a value of one: + +.nf + cl> hedit ims* bpm badpix.pl add+ ver- + cl> combine ims* final combine=median masktype=goodval +.fi + +5. To scale image by the exposure time and then adjust for varying + sky brightness and make a weighted average: + +.nf + cl> combine obj* avsig combine=average reject=avsig \ + >>> scale=exp zero=mode weight=exp expname=exptime +.fi +.ih +TIME REQUIREMENTS +The following times were obtain with a Sun 4/470. The tests combine +1000x200 images consisting of Poisson noise and cosmic rays generated +with the \fBartdata\fR package. The times, especially the total time, +are approximate and depend on user loads. + +.nf +IMAGES: Number of images (1000x200) and datatype (R=real, S=short) +COMBINE: Combine option +REJECT: Rejection option with grow = 0 + minmax: nlow = 1, nhigh = 1 + ccdclip: lsigma = 3., hsigma = 3, sigscale = 0. + sigclip: lsigma = 3., hsigma = 3, sigscale = 0. + avsigclip: lsigma = 3., hsigma = 3, sigscale = 0. + pclip: lsigma = 3., hsigma = 3, pclip = -0.5 + /a: mclip = no (clip about the average) + /m: mclip = yes (clip about the median) +O M T S: Features used (Y=yes, N=no) +O: offset = "grid 5 10 2 10" +M: masktype = goodval, maskval = 0 + Pixel mask has 2 bad lines and 20 bad columns +T: lthreshold = INDEF, hthreshold = 1100. +S: scale = mode, zero = none, weight = mode +TIME: cpu time in seconds, total time in minutes and seconds + + +IMAGES COMBINE REJECT O M T S TIME + + 10R average none N N N N 1.3 0:08 + 10R average minmax N N N N 4.3 0:10 + 10R average pclip N N N N 17.9 0:32 + 10R average ccdclip/a N N N N 11.6 0:21 + 10R average crreject/a N N N N 11.4 0:21 + 10R average sigclip/a N N N N 13.6 0:29 + 10R average avsigclip/a N N N N 15.9 0:35 + 10R average ccdclip/m N N N N 16.9 0:32 + 10R average crreject/m N N N N 17.0 0:28 + 10R average sigclip/m N N N N 19.6 0:42 + 10R average avsigclip/m N N N N 20.6 0:43 + + 10R median none N N N N 6.8 0:17 + 10R median minmax N N N N 7.8 0:15 + 10R median pclip N N N N 16.9 1:00 + 10R median ccdclip/a N N N N 18.0 0:34 + 10R median crreject/a N N N N 17.7 0:30 + 10R median sigclip/a N N N N 21.1 1:13 + 10R median avsigclip/a N N N N 23.1 0:41 + 10R median ccdclip/m N N N N 16.1 0:27 + 10R median crreject/m N N N N 16.0 0:27 + 10R median sigclip/m N N N N 18.1 0:29 + 10R median avsigclip/m N N N N 19.6 0:32 + + 10R average none N N N Y 6.1 0:36 + 10R median none N N N Y 10.4 0:49 + 10R median pclip N N N Y 20.4 1:10 + 10R median ccdclip/m N N N Y 19.5 0:36 + 10R median avsigclip/m N N N Y 23.0 1:06 + + 10R average none N Y N N 3.5 0:12 + 10R median none N Y N N 8.9 0:21 + 10R median pclip N Y N N 19.9 0:45 + 10R median ccdclip/m N Y N N 18.0 0:44 + 10R median avsigclip/m N Y N N 20.9 0:28 + + 10R average none Y N N N 4.3 0:13 + 10R median none Y N N N 9.6 0:21 + 10R median pclip Y N N N 21.8 0:54 + 10R median ccdclip/m Y N N N 19.3 0:44 + 10R median avsigclip/m Y N N N 22.8 0:51 + + 10R average none Y Y Y Y 10.8 0:22 + 10R median none Y Y Y Y 16.1 0:28 + 10R median pclip Y Y Y Y 27.4 0:42 + 10R median ccdclip/m Y Y Y Y 25.5 0:39 + 10R median avsigclip/m Y Y Y Y 28.9 0:44 + + 10S average none N N N N 2.2 0:06 + 10S average minmax N N N N 4.6 0:12 + 10S average pclip N N N N 18.1 0:33 +.fi +.ih +REVISIONS +.ls COMBINE V2.11 +The limit of the number of images that may be combined has been removed. +If the number of images exceeds the maximum number of open images permitted +then the images are stacked in a single temporary image and then combined +with the project option. Note that this will double the amount of +diskspace temporarily. There is also a limitation in this case that the +bad pixel mask from the first image in the list will be applied to all the +images. + +Integer offsets may be determined from the image world coordinate system. +.le +.ls COMBINE V2.10.3 +The output pixel datatype parameter, \fIouttype\fR was previously ignored +and the package \fIpixeltype\fR was used. The task output pixel type +parameter is now used. + +The factors specified by an @file or keyword are not normalized. +.le +.ls COMBINE V2.10.2 +The weighting was changed from using the square root of the exposure time +or image statistics to using the values directly. This corresponds +to variance weighting. Other options for specifying the scaling and +weighting factors were added; namely from a file or from a different +image header keyword. The \fInkeep\fR parameter was added to allow +controlling the maximum number of pixels to be rejected by the clipping +algorithms. The \fIsnoise\fR parameter was added to include a sensitivity +or scale noise component to the noise model. Errors will now delete +the output images. +.le +.ls COMBINE V2.10 +This task was greatly revised to provide many new features. These features +are: + +.nf + o Bad pixel masks + o Combining offset and different size images + o Blank value for missing data + o Combining across the highest dimension (the project option) + o Separating threshold rejection, the rejection algorithms, + and the final combining statistic + o New CCDCLIP, CRREJECT, and PCLIP algorithms + o Rejection now may reject more than one pixel per output pixel + o Choice of a central median or average for clipping + o Choice of final combining operation + o Simultaneous multiplicative and zero point scaling +.fi +.le +.ih +LIMITATIONS +Though the previous limit on the number of images that can be combined +was removed in V2.11 the method has the limitation that only a single +bad pixel mask will be used for all images. +.ih +SEE ALSO +image.imcombine, instruments, ccdtypes, icfit, ccdred, guide, darkcombine, +flatcombine, zerocombine, onedspec.scombine wfpc.noisemodel +.endhelp diff --git a/noao/imred/ccdred/doc/contents.ms b/noao/imred/ccdred/doc/contents.ms new file mode 100644 index 00000000..8ba2624a --- /dev/null +++ b/noao/imred/ccdred/doc/contents.ms @@ -0,0 +1,34 @@ +.sp 1i +.ps +2 +.ft B +.ce +Contents +.sp 3 +.ps -2 +.ft R +.sp +1.\h'|0.4i'\fBIntroduction\fP\l'|5.6i.'\0\01 +.sp +2.\h'|0.4i'\fBGetting Started\fP\l'|5.6i.'\0\02 +.sp +3.\h'|0.4i'\fBProcessing Your Data\fP\l'|5.6i.'\0\05 +.br +\h'|0.4i'3.1.\h'|0.9i'Combining Calibration Images\l'|5.6i.'\0\06 +.br +\h'|0.4i'3.2.\h'|0.9i'Calibrations and Corrections\l'|5.6i.'\0\07 +.sp +4.\h'|0.4i'\fBSpecial Processing Operations\fP\l'|5.6i.'\0\08 +.br +\h'|0.4i'4.1.\h'|0.9i'Spectroscopic Flat Fields\l'|5.6i.'\0\08 +.br +\h'|0.4i'4.2.\h'|0.9i'Illumination Corrections\l'|5.6i.'\0\09 +.br +\h'|0.4i'4.3.\h'|0.9i'Sky Flat Fields\l'|5.6i.'\010 +.br +\h'|0.4i'4.4.\h'|0.9i'Illumination Corrected Flat Fields\l'|5.6i.'\010 +.br +\h'|0.4i'4.5.\h'|0.9i'Fringe Corrections\l'|5.6i.'\010 +.sp +5.\h'|0.4i'\fBSummary\fP\l'|5.6i.'\011 +.sp +\h'|0.4i'\fBReferences\fP\l'|5.6i.'\011 diff --git a/noao/imred/ccdred/doc/darkcombine.hlp b/noao/imred/ccdred/doc/darkcombine.hlp new file mode 100644 index 00000000..c545a13e --- /dev/null +++ b/noao/imred/ccdred/doc/darkcombine.hlp @@ -0,0 +1,120 @@ +.help darkcombine Aug91 noao.imred.ccdred +.ih +NAME +darkcombine -- Combine and process dark count images +.ih +USAGE +darkcombine input +.ih +PARAMETERS +.ls input +List of dark count images to combine. The \fIccdtype\fR parameter +may be used to select the zero level images from a list containing all +types of data. +.le +.ls output = "Dark" +Output dark count root image name. +.le +.ls combine = "average" (average|median) +Type of combining operation performed on the final set of pixels (after +rejection). The choices are +"average" or "median". The median uses the average of the two central +values when the number of pixels is even. +.le +.ls reject = "minmax" (none|minmax|ccdclip|crreject|sigclip|avsigclip|pclip) +Type of rejection operation. See \fBcombine\fR for details. +.le +.ls ccdtype = "dark" +CCD image type to combine. If no image type is given then all input images +are combined. +.le +.ls process = yes +Process the input images before combining? +.le +.ls delete = no +Delete input images after combining? Only those images combined are deleted. +.le +.ls clobber = no +Clobber existing output images? +.le +.ls scale = "exposure" (none|mode|median|mean|exposure) +Multiplicative image scaling to be applied. The choices are none, scale +by the mode, median, or mean of the specified statistics section, or scale +by the exposure time given in the image header. +.le +.ls statsec = "" +Section of images to use in computing image statistics for scaling. +If no section is given then the entire region of the image is +sampled (for efficiency the images are sampled if they are big enough). +.le + +.ce +Algorithm Parameters +.ls nlow = 0, nhigh = 1 (minmax) +The number of low and high pixels to be rejected by the "minmax" algorithm. +.le +.ls nkeep = 1 +The minimum number of pixels to retain or the maximum number to reject +when using the clipping algorithms (ccdclip, crreject, sigclip, +avsigclip, or pclip). When given as a positive value this is the minimum +number to keep. When given as a negative value the absolute value is +the maximum number to reject. This is actually converted to a number +to keep by adding it to the number of images. +.le +.ls mclip = yes (ccdclip, crreject, sigclip, avsigcliip) +Use the median as the estimate for the true intensity rather than the +average with high and low values excluded in the "ccdclip", "crreject", +"sigclip", and "avsigclip" algorithms? The median is a better estimator +in the presence of data which one wants to reject than the average. +However, computing the median is slower than the average. +.le +.ls lsigma = 3., hsigma = 3. (ccdclip, crreject, sigclip, avsigclip, pclip) +Low and high sigma clipping factors for the "ccdclip", "crreject", "sigclip", +"avsigclip", and "pclip" algorithms. They multiply a "sigma" factor +produced by the algorithm to select a point below and above the average or +median value for rejecting pixels. The lower sigma is ignored for the +"crreject" algorithm. +.le +.ls rdnoise = "0.", gain = "1.", snoise = "0." (ccdclip, crreject) +CCD readout noise in electrons, gain in electrons/DN, and sensitivity noise +as a fraction. These parameters are used with the "ccdclip" and "crreject" +algorithms. The values may be either numeric or an image header keyword +which contains the value. +.le +.ls pclip = -0.5 (pclip) +Percentile clipping algorithm parameter. If greater than +one in absolute value then it specifies a number of pixels above or +below the median to use for computing the clipping sigma. If less +than one in absolute value then it specifies the fraction of the pixels +above or below the median to use. A positive value selects a point +above the median and a negative value selects a point below the median. +The default of -0.5 selects approximately the quartile point. +See \fBcombine\fR for further details. +.le +.ls blank = 0. +Output value to be used when there are no pixels. +.le +.ih +DESCRIPTION +The dark count images in the input image list are combined. +The input images may be processed first if desired. +The original images may be deleted automatically if desired. +The output pixel datatype will be real. + +This task is a script which applies \fBccdproc\fR and \fBcombine\fR. The +parameters and combining algorithms are described in detail in the help for +\fBcombine\fR. This script has default parameters specifically set for +dark count images and simplifies the combining parameters. There are other +combining options not included in this task. For these additional +features, such as thresholding, offseting, masking, and projecting, use +\fBcombine\fR. +.ih +EXAMPLES +1. The image data contains four dark count images. To automatically select +them and combine them as a background job using the default combining algorithm: + + cl> darkcombine ccd*.imh& +.ih +SEE ALSO +ccdproc, combine +.endhelp diff --git a/noao/imred/ccdred/doc/flatcombine.hlp b/noao/imred/ccdred/doc/flatcombine.hlp new file mode 100644 index 00000000..549c912c --- /dev/null +++ b/noao/imred/ccdred/doc/flatcombine.hlp @@ -0,0 +1,133 @@ +.help flatcombine Aug91 noao.imred.ccdred +.ih +NAME +flatcombine -- Combine and process flat field images +.ih +USAGE +flatcombine input +.ih +PARAMETERS +.ls input +List of flat field images to combine. The \fIccdtype\fR parameter +may be used to select the flat field images from a list containing all +types of data. +.le +.ls output = "Flat" +Output flat field root image name. The subset ID is appended. +.le +.ls combine = "average" (average|median) +Type of combining operation performed on the final set of pixels (after +rejection). The choices are +"average" or "median". The median uses the average of the two central +values when the number of pixels is even. +.le +.ls reject = "avsigclip" (none|minmax|ccdclip|crreject|sigclip|avsigclip|pclip) +Type of rejection operation. See \fBcombine\fR for details. +.le +.ls ccdtype = "flat" +CCD image type to combine. If no image type is given then all input images +are combined. +.le +.ls process = yes +Process the input images before combining? +.le +.ls subsets = yes +Combine images by subset parameter? If yes then the input images are +grouped by subset parameter and each group combined into a separate output +image. The subset identifier is appended to the output and sigma image +names. See \fBsubsets\fR for more on the subset parameter. This is generally +used with flat field images. +.le +.ls delete = no +Delete input images after combining? Only those images combined are deleted. +.le +.ls clobber = no +Clobber existing output images? +.le +.ls scale = "mode" (none|mode|median|mean|exposure) +Multiplicative image scaling to be applied. The choices are none, scale +by the mode, median, or mean of the specified statistics section, or scale +by the exposure time given in the image header. +.le +.ls statsec = "" +Section of images to use in computing image statistics for scaling. +If no section is given then the entire region of the image is +sampled (for efficiency the images are sampled if they are big enough). +.le + +.ce +Algorithm Parameters +.ls nlow = 1, nhigh = 1 (minmax) +The number of low and high pixels to be rejected by the "minmax" algorithm. +.le +.ls nkeep = 1 +The minimum number of pixels to retain or the maximum number to reject +when using the clipping algorithms (ccdclip, crreject, sigclip, +avsigclip, or pclip). When given as a positive value this is the minimum +number to keep. When given as a negative value the absolute value is +the maximum number to reject. This is actually converted to a number +to keep by adding it to the number of images. +.le +.ls mclip = yes (ccdclip, crreject, sigclip, avsigcliip) +Use the median as the estimate for the true intensity rather than the +average with high and low values excluded in the "ccdclip", "crreject", +"sigclip", and "avsigclip" algorithms? The median is a better estimator +in the presence of data which one wants to reject than the average. +However, computing the median is slower than the average. +.le +.ls lsigma = 3., hsigma = 3. (ccdclip, crreject, sigclip, avsigclip, pclip) +Low and high sigma clipping factors for the "ccdclip", "crreject", "sigclip", +"avsigclip", and "pclip" algorithms. They multiply a "sigma" factor +produced by the algorithm to select a point below and above the average or +median value for rejecting pixels. The lower sigma is ignored for the +"crreject" algorithm. +.le +.ls rdnoise = "0.", gain = "1.", snoise = "0." (ccdclip, crreject) +CCD readout noise in electrons, gain in electrons/DN, and sensitivity noise +as a fraction. These parameters are used with the "ccdclip" and "crreject" +algorithms. The values may be either numeric or an image header keyword +which contains the value. +.le +.ls pclip = -0.5 (pclip) +Percentile clipping algorithm parameter. If greater than +one in absolute value then it specifies a number of pixels above or +below the median to use for computing the clipping sigma. If less +than one in absolute value then it specifies the fraction of the pixels +above or below the median to use. A positive value selects a point +above the median and a negative value selects a point below the median. +The default of -0.5 selects approximately the quartile point. +See \fBcombine\fR for further details. +.le +.ls blank = 1. +Output value to be used when there are no pixels. +.le +.ih +DESCRIPTION +The flat field images in the input image list are combined. If there +is more than one subset (such as a filter or grating) then the input +flat field images are grouped by subset and an combined separately. +The input images may be processed first if desired. However if all +zero level bias effects are linear then this is not necessary and some +processing time may be saved. The original images may be deleted +automatically if desired. The output pixel datatype will be real. + +This task is a script which applies \fBccdproc\fR and \fBcombine\fR. The +parameters and combining algorithms are described in detail in the help for +\fBcombine\fR. This script has default parameters specifically set for +flat field images and simplifies the combining parameters. There are other +combining options not included in this task. For these additional +features, such as thresholding, offseting, masking, and projecting, use +\fBcombine\fR. +.ih +EXAMPLES +1. The image data contains four flat field images for three filters. +To automatically select them and combine them as a background job +using the default combining algorithm: + + cl> flatcombine ccd*.imh& + +The final images are "FlatV", "FlatB", and "FlatR". +.ih +SEE ALSO +ccdproc, combine, subsets +.endhelp diff --git a/noao/imred/ccdred/doc/flatfields.hlp b/noao/imred/ccdred/doc/flatfields.hlp new file mode 100644 index 00000000..94766960 --- /dev/null +++ b/noao/imred/ccdred/doc/flatfields.hlp @@ -0,0 +1,177 @@ +.help flatfields Jun87 noao.imred.ccdred + +.ih +NAME +flatfields -- Discussion of CCD flat field calibrations +.ih +DESCRIPTION +This topic describes the different types of CCD flat fields and +the tasks available in the \fBccdred\fR and spectroscopy packages for +creating them. Flat field calibration is the most important operation +performed on CCD data. This operation calibrates the relative response +of the detector at each pixel. In some cases this is as simple as +taking a special type of observation called a flat field. However, in +many cases this calibration observation must be corrected for +iillumination, scanning, wavelength, and aperture effects. + +The discussion is in three sections; direct imaging, scan mode, +and spectroscopy. Though there are many similarities between these +modes of operation there are important differences in how corrections +are applied to the basic flat field observations. The application of +the flat field calibrations to the observations using \fBccdproc\fR is +the same in all cases, however. +.sh +1. Direct Imaging +The starting point for determining the flat field calibration is an +observation of something which should have uniform response at all +points on the detector. In addition the color of the light falling at +each pixel should be the same as that in an observation so the same +filter must be used when determining the flat field (the issue of the +matching the color of the objects observed at the appropriate pixels is +ignored here). The best calibration observation is of a blank sky. If +an accurate blank sky observation can be obtained then this is all that +is needed for a flat field calibration. This type of flat field might +be called a \fIsky flat\fR, though this term is more often used for a +type of flat field described below. There are two difficulties with +this type of calibration; finding a really blank sky and getting a +sufficiently accurate measurement without using all the observing +time. + +It is usually not possible to get a blank sky observation accurate +enough to calibrate the individual pixels without introducing +undesirable noise. What is generally done is to use a lamp to either +uniformly illuminate a part of the dome or directly illuminate the +field of view. The first type of observation is called a \fIdome +flat\fR and the second is called a \fIprojection flat\fR. We shall call +both of these types of observations \fBlamp flat fields\fR. If the +iillumination is truely uniform then these types of observations are +sufficient for flat field calibration. To get a very accurate flat +field many observations are made and then combined (see +\fBflatcombine\fR). + +Unfortunately, it is sometimes the case that the lamp flat fields +do not illuminate the telescope/detector in the same way as the actual +observations. Calibrating with these flat fields will introduce a +residual large scale iillumination pattern, though it will correctly +calibrate the relative pixel responses locally. There are two ways to +correct for this effect. The first is to correct the flat field +observation. The second is to apply the uncorrected flat field to the +observations and then apply an \fIiillumination\fR correction as a +separate operation. The first is more efficient since it consists of a +single correction applied to each observation but in some cases the +approximate correction is desired immediately, the observation needed +to make the correction has not been taken yet, or the residual +iillumination error is not discovered until later. + +For the two methods there are two types of correction. One is to +use a blank sky observation to correct for the residual iillumination +pattern. This is different than using the sky observation directly as +a flat field calibration in that only the large scale pattern is +needed. Determining the large scale iillumination does not require high +signal-to-noise at each pixel and faint objects in the image can be +either eliminated or ignored. The second method is to remove the large +scale shape from the lamp flat field. This is not as good as using a +blank sky observation but, if there is no such observation and the +iillumination pattern is essentially only in the lamp flat field, this +may be sufficient. + +From the above two paragraphs one sees there are four options. +There is a task in the \fBccdred\fR package for each of these options. +To correct a lamp flat field observation by a blank sky observation, +called a \fIsky flat\fR, the task is \fBmkskyflat\fR. To correct the +flat field for its own large scale gradients, called an \fIiillumination +flat\fR, the task is \fBmkillumflat\fR. To create a secondary +correction to be applied to data processed with the lamp flat field +image the tasks are \fBmkskycor\fR and \fBmkillumcor\fR which are, +respectively, based on a blank sky observation and the lamp flat field +iillumination pattern. + +With this introduction turn to the individual documentation for these +four tasks for further details. +.sh +2. Scan Mode +There are two types of scan modes supported by the \fBccdred\fR +package; \fIshortscan\fR and \fIlongscan\fR (see \fBccdproc\fR for +further details). They both affect the manner in which flat field +calibrations are handled. The shortscan mode produces images which are +the same as direct images except that the light recorded at each pixel +was collected by a number of different pixels. This improves the flat +field calibration. If the flat field images, of the same types +described in the direct imaging section, are observed in the same way +as all other observations, i.e. in scan mode, then there is no +difference from direct imaging (except in the quality of the flat +fields). There is a statistical advantage to observing the lamp or sky +flat field without scanning and then numerically averaging to simulate +the result of the scanning. This improves the accuracy of +the flat fields and might possibly allow direct blank sky observations +to be used for flat fields. The numerical scanning is done in +\fBccdproc\fR by setting the appropriate scanning parameters. + +In longscan mode the CCD detector is read out in such a way that +each output image pixel is the sum of the light falling on all pixels +along the direction of the scan. This reduces the flat field calibration +to one dimension, one response value for each point across the scan. +The one dimensional calibration is obtained from a longscan observation +by averaging all the readout lines. +This is done automatically in \fBccdproc\fR by setting the appropriate +parameters. In this case very good flat fields can be obtained from +one or more blank sky observations or an unscanned lamp observation. Other +corrections are not generally used. +.sh +3. Spectroscopy +Spectroscopic flat fields differ from direct imaging in that the +spectrum of the sky or lamp and transmission variations with wavelength +are part of the observation. Application of such images will introduce +the inverse of the spectrum and transmission into the observation. It +also distorts the observed counts making signal-to-noise estimates +invalid. This, and the low signal in the dispersed light, makes it +difficult to use blank sky observations directly as flat fields. As +with direct imaging, sky observation may be used to correct for +iillumination errors if necessary. At sufficiently high dispersion the +continuous lamp spectrum may be flat enough that the spectral signature +of the lamp is not a problem. Alternatively, flux calibrating the +spectra will also remove the flat field spectral signature. The +spectroscopic flat fields also have to be corrected for regions outside +of the slit or apertures to avoid bad response effects when applying +the flat field calibration to the observations. + +The basic scheme for removing the spectral signature is to average +all the lines or columns across the dispersion and within the aperture +to form an estimate of the spectrum. In addition to the averaging, a +smooth curve is fit to the lamp spectrum to remove noise. This smooth +shape is then divided back into each line or column to eliminate the +shape of the spectrum without changing the shape of the spectrum +in the spatial direction or the small scale response variations. +Regions outside of the apertures are replaced by unity. +This method requires that the dispersion be aligned fairly close to +either the CCD lines or columns. + +This scheme is used in both longslit and multiaperture spectra. +The latter includes echelle, slitlets, aperture masks, and fiber feeds. +For narrow apertures which do not have wider slits for the lamp +exposures there may be problems with flexure and defining a good +composite spectrum. The algorithm for longslit spectra is simpler and +is available in the task \fBresponse\fR in the \fBlongslit\fR package. +For multiaperture data there are problems of defining where the spectra +lie and avoiding regions off of the aperture where there is no signal. +The task which does this is \fBapnormalize\fR in the \fBapextract\fR +package. Note that the lamp observations must first be processed +explicitly for bias and dark count corrections. + +Longslit spectra may also suffer the same types of iillumination +problems found in direct imaging. However, in this case the iillumination +pattern is determined from sky observations (or the flat field itself) +by finding the large scale pattern across the dispersion and at a number +of wavelengths while avoiding the effects of night sky spectrum. The +task which makes this type of correction in the \fBlongslit\fR package +is \fBiillumination\fR. This produces an iillumination correction. +To make sky flats or the other types of corrections image arithmetic +is used. Note also that the sky observations must be explicitly +processed through the flat field stage before computing the iillumination. +.ih +SEE ALSO +.nf +ccdproc, guide, mkillumcor, mkillumflat, mkskycor, mkskyflat +apextract.apnormalize, longslit.response, longslit.iillumination +.fi +.endhelp diff --git a/noao/imred/ccdred/doc/guide.hlp b/noao/imred/ccdred/doc/guide.hlp new file mode 100644 index 00000000..5006a6ec --- /dev/null +++ b/noao/imred/ccdred/doc/guide.hlp @@ -0,0 +1,717 @@ +.help guide Feb88 noao.imred.ccdred +.ce +User's Guide to the CCDRED Package +.sh +1. Introduction + + This guide provides a brief description of the IRAF CCD reduction +package \fBccdred\fR and examples of reducing simple CCD data. It is a +generic guide in that it is not tied to any particular type of data. +There may be more specific guides (or "cookbooks") for your data. +Detailed descriptions of the tasks and features of the package are +provided in the help documentation for the package. + + The purpose of the CCDRED package is to provide tools for the easy +and efficient reduction of CCD images. The standard reduction +operations are replacement of bad columns and lines by interpolation +from neighboring columns and lines, subtraction of a bias level +determined from overscan or prescan columns or lines, subtraction of a +zero level using a zero length exposure calibration image, subtraction +of a dark count calibration image appropriately scaled to the dark time +exposure, division by a scaled flat field calibration image, division +by an iillumination image (derived from a blank sky image), subtraction +of a scaled fringe image (also derived from a blank sky image), and +trimming the image of unwanted lines or columns such as the overscan +strip. Any set of operations may be done simultaneously over a list of +images in a highly efficient manner. The reduction operations are +recorded in the image header and may also be logged on the terminal and +in a log file. + + The package also provides tools for combining multiple exposures +of object and calibration images to improve the statistical accuracy of +the observations and to remove transient bad pixels. The combining +operation scales images of different exposure times, adjusts for +variable sky background, statistically weights the images by their +signal-to-noise, and provides a number of useful algorithms for +detecting and rejecting transient bad pixels. + + Other tasks are provided for listing reduction information about +the images, deriving secondary calibration images (such as sky +corrected flat fields or iillumination correction images), and easily +setting the package parameters for different instruments. + + There are several important features provided by the package to +make the reduction of CCD images convenient; particularly to minimize +record keeping. One of these is the ability to recognize the different +types of CCD images. This ability allows the user to select a certain +class of images to be processed or listed and allows the processing +tasks to identify calibration images and process them differently from +object images. The standard CCD image types are \fIobject\fR, +\fIzero\fR level, \fIdark\fR count, and \fIflat\fR field. For more on +the image types see \fBccdtypes\fR. + + The tasks can also identify the different filters (or other subset +parameter) which require different flat field images. This means you don't +have to separate the images by filter and process each set separately. +This feature is discussed further in \fBsubsets\fR. + + The tasks keep track of the reduction steps completed on each +image and ignore images which have been processed. This feature, +along with recognizing the image types and subsets, makes it possible to +specify all the images to a task with a wildcard template, such as +"*.imh", rather than indicating each image by name. You will find this +extremely important with large sets of observations. + + A fundamental aspect of the package is that the processing +modifies the images. In other words, the reduction operations are +performed directly on the image. This "feature" further simplifies +record keeping, frees the user from having to form unique output image +names, and minimizes the amount of disk space required. There +are two safety features in this process. First, the modifications do +not take effect until the operation is completed on the image. This +allows you to abort the task without messing up the image data and +protects data if the computer crashes. The second feature is that +there is a package parameter which may be set to make a backup of the +input data with a particular prefix such as "orig" or "imdir$". This +backup feature may be used when there is sufficient disk space, when learning +to use the package, or just to be cautious. + + In a similar effort to efficiently manage disk space, when combining +images into a master object or calibration image there is an option to +delete the input images upon completion of the combining operation. +Generally this is desirable when there are many calibration exposures, +such as zero level or flat field images, which are not used after they +are combined into a final calibration image. + + The following sections guide you through the basic use of the +\fBccdred\fR package. Only the important parameters which you might +want to change are described. It is assumed that the support personnel +have created the necessary instrument files (see \fBinstruments\fR) +which will set the default parameters for the data you will be +reducing. If this is not the case you may need to delve more deeply +into the details of the tasks. Information about all the parameters +and how the various tasks operate are given in the help documentation +for the tasks and in additional special help topics. Some useful help +documentation is indicated in the discussion and also in the +\fBReferences\fR section. +.sh +2. Getting Started + + The first step is to load \fBccdred\fR. This is done by loading +the \fBnoao\fR package, followed by the image reduction package +\fBimred\fR, and finally the \fBccdred\fR package. Loading a +package consists of typing its name. Note that some of these packages may be +loaded automatically when you logon to IRAF. + + When you load the \fBccdred\fR package the menu of tasks or commands +is listed. This appears as follows: + +.nf + cl> ccdred + badpiximage ccdtest mkfringecor setinstrument + ccdgroups combine mkillumcor zerocombine + ccdhedit cosmicrays mkillumflat + ccdlist darkcombine mkskycor + ccdproc flatcombine mkskyflat +.fi + +A summary of the tasks and additional help topics is obtained by typing: + + cl> help + +This list and how to get additional help on specific topics is described +in the \fBReferences\fR section at the end of this guide. + + The first command to use is \fBsetinstrument\fR, which sets the package +appropriately for the CCD images to be reduced. The support personnel +should tell you the instrument identification, but if not a list +of known instruments may be listed by using '?' for the instrument name. + +.nf + cl> setinstrument + Instrument ID (type ? for a list) \fI<enter instrument id or ?>\fR + <Set ccdred package parameters using eparam> + <Set ccdproc task parameters using eparam> +.fi + +This task sets the default parameters and then allows you to modify the +package parameters and the processing parameters using the parameter +editor \fBeparam\fR. If you are not familiar with \fBeparam\fR see the +help or CL introduction documentation. For most terminals you move up +and down through the parameters with the terminal arrow keys, you +change the parameters by simply typing the desired value, and you exit +with control Z or control D. Note that you can change parameters for +any task at any time with \fBeparam\fR and you do not have to run +\fBsetinstrument\fR again, even if you logout, until you need to reduce +data from a different instrument. + + The \fBccdred\fR package parameters control general I/O functions of +the tasks in the package. The parameters you might wish to change are +the output pixel type and the verbose option. Except when the input +images are short integers, the noise is significantly greater than one +digital unit, and disk space is critical, it is probably better to +allow the processing to convert the images to real pixel datatype. The +verbose parameter simply prints the information written to the log file +on the terminal. This can be useful when little else is being done and +you are just beginning. However, when doing background processing and +other IRAF reduction tasks it is enough to simply look at the end of +the logfile with the task \fBtail\fR to see the current state of the +processing. + + The \fBccdproc\fR parameters control the CCD processing. There are +many parameters but they all may be conveniently set at this point. +Many of the parameters have default values set appropriately for the +instrument you specified. The images to be processed can be specified +later. What needs to be set are the processing operations that you +want done and the parameters required for each operation. The +processing operations are selected by entering yes or no for each one. +The following items briefly describe each of the possible processing +operations and the additional parameters required. + +.ls \fIfixpix\fR - Fix bad CCD lines and columns? +The bad pixels (cosmetic defects) in the detector are given in a file +specified by the parameter \fIfixfile\fR. This information is used +to replace the pixels by interpolating from the neighboring pixels. +A standard file for your instrument may be set by \fBsetinstrument\fR +or if the word "image" is given then the file is defined in the instrument +data file. For more on the bad pixel file see \fBinstruments\fR. +.le +.ls \fIoverscan\fR - Apply overscan strip correction? +The overscan or prescan region is specified by the parameter +\fIbiassec\fR. This is given as an IRAF image section. Only the +part of the section corresponding to the readout axis is used and +the other part is ignored. The length of the overscan region is +set by the \fItrimsec\fR parameter. The overscan +region is averaged along the readout axis, specified by the parameter +\fIreadaxis\fR, to create a one dimensional bias vector. This bias is +fit by a function to remove cosmic rays and noise. There are a number +of parameters at the end of the parameter list which control the +fitting. The default overscan bias section and fitting parameters for +your instrument should be set by \fBsetinstrument\fR. If the word +"image" is given the overscan bias section is defined in the image +header or the instrument translation file. If an overscan section is +not set you can use \fBimplot\fR to determine the columns or rows for +the bias region and define an overscan image section. If you are +unsure about image sections consult with someone or read the +introductory IRAF documentation. +.le +.ls \fItrim\fR - Trim the image? +The image is trimmed to the image section given by the parameter +\fItrimsec\fR. A default trim section for your instrument should be +set by \fBsetinstrument\fR, however, you may override this default if +desired. If the word "image" is given the data +image section is given in the image header or the instrument +translation file. As with the overscan image section it is +straightforward to specify, but if you are unsure consult someone. +.le +.ls \fIzerocor\fR - Apply zero level correction? +The zero level image to be subtracted is specified by the parameter +\fIzero\fR. If none is given then the calibration image will be sought +in the list of images to be processed. +.le +.ls \fIdarkcor\fR - Apply dark count correction? +The dark count image to be subtracted is specified by the parameter +\fIdark\fR. If none is given then the calibration image will be sought +in the list of images to be processed. +.le +.ls \fIflatcor\fR - Apply flat field correction? +The flat field images to be used are specified by the parameter +\fIflat\fR. There must be one flat field image for each filter +or subset (see \fBsubsets\fR) to be processed. If a flat field +image is not given then the calibration image will be sought +in the list of images to be processed. +.le +.ls \fIreadcor\fR - Convert zero level image to readout correction? +If a one dimensional zero level readout correction vector is to be subtracted +instead of a two dimensional zero level image then, when this parameter is set, +the zero level images will be averaged to one dimension. The readout axis +must be specified by the parameter \fIreadaxis\fR. The default for your +instrument is set by \fBsetinstrument\fR. +.le +.ls \fIscancor\fR - Convert flat field image to scan correction? +If the instrument is operated in a scan mode then a correction to the +flat field may be required. There are two types of scan modes, "shortscan" +and "longscan". In longscan mode flat field images will be averaged +to one dimension and the readout axis must be specified. Shortscan mode +is a little more complicated. The scan correction is used if the flat +field images are not observed in scan mode. The number of scan lines +must be specified by the parameter \fInscan\fR. If they are observed in +scan mode, like the object observations, then the scan correction +operations should \fInot\fR be specified. For details of scan mode operations +see \fBccdproc\fR. The scan parameters +should be set by \fBsetinstrument\fR. If in doubt consult someone +familiar with the instrument and mode of operation. +.le + + This description of the parameters is longer than the actual operation of +setting the parameters. The only parameters likely to change during processing +are the calibration image parameters. + + When processing many images using the same calibration files a modest +performance improvement can be achieved by keeping (caching) the +calibration images in memory to avoid disk accesses. This option +is available by specifying the amount of memory available for image +caching with the parameter \fImax_cache\fR. If the value is zero then +the images are accessed from disk as needed while if there is +sufficient memory the calibration images may be kept in memory during +the task execution. +.sh +3. Processing Your Data + + The processing path depends on the type of data, the type of +instrument, types of calibration images, and the observing +sequence. In this section we describe two types of operations common +in reducing most data; combining calibration images and performing the +standard calibration and correction operations. Some additional special +operations are described in the following section. + + However, the first thing you might want to try before any +processing is to get a listing of the CCD images showing the CCD image +types, subsets, and processing flags. The task for this is +\fBccdlist\fR. It has three types of output; a short one line per +image format, a longer format which shows the state of the processing, +and a format which prints the image names only (used to create files +containing lists of images of a particular CCD image type). To get a +quick listing type: + +.nf + cl> ccdlist *.imh + ccd001.imh[544,512][short][unknown][V]:FOCUS L98-193 + ccd007.imh[544,512][short][object][V]:N2968 V 600s + ccd015.imh[544,512][short][object][B]:N3098 B 500s + ccd024.imh[544,512][short][object][R]:N4036 R 600s + ccd045.imh[544,512][short][flat][V]:dflat 5s + ccd066.imh[544,512][short][flat][B]:dflat 5s + ccd103.imh[544,512][short][flat][R]:dflat 5s + ccd104.imh[544,512][short][zero][]:bias + ccd105.imh[544,512][short][dark][]:dark 3600s +.fi + + The example shows only a sample of the images. The short format +listing tells you the name of the image, its size and pixel type, the +CCD image type as seen by the package, the subset identifier (in this +case the filter), and the title. If the data had been processed then +there would also be processing flags. If the CCD image types do not +seem right then there may be a problem with the instrument +specification. + + Many of the tasks in the \fBccdred\fR package have the parameter +\fIccdtype\fR which selects a particular type of image. To list +only the object images from the previous example: + +.nf + cl> ccdlist *.imh ccdtype=object + ccd007.imh[544,512][short][object][V]:N2968 V 600s + ccd015.imh[544,512][short][object][B]:N3098 B 500s + ccd024.imh[544,512][short][object][R]:N4036 R 600s +.fi + +If no CCD image type is specified (by using the null string "") +then all image types are selected. This may be +necessary if your instrument data does not contain image type identifications. +.sh +3.1 Combining Calibration Images + + If you do not need to combine calibration images because you only +have one image of each type, you can skip this section. Calibration +images, particularly zero level and flat field images, are combined in +order to minimize the effects of noise and reject bad pixels in the +calibrations. The basic tool for combining images is the task +\fBcombine\fR. There are simple variants of this task whose default +parameters are set appropriately for each type of calibration image. +These are the ones you will use for calibration images leaving +\fBcombine\fR for combining object images. Zero level images are +combined with \fBzerocombine\fR, dark count images with +\fBdarkcombine\fR, and flat field images with \fBflatcombine\fR. + + For example, to combine flat field images the command is: + +.nf + cl> flatcombine *.imh + Jun 1 14:26 combine: maxreject + Images N Exp Mode Scale Offset Weight + ccd045.imh 1 5.0 INDEF 1.000 0. 0.048 + ccd046.imh 1 5.0 INDEF 1.000 0. 0.048 + <... list of files ...> + ccd065.imh 1 5.0 INDEF 1.000 0. 0.048 + ----------- ------ ------ + FlatV.imh 21 5.0 +.fi + +This output is printed when verbose mode is set. The same information +is recorded in the log file. In this case the flat fields are combined +by rejecting the maximum value at each point in the image (the +"maxreject" algorithm). The images are scaled by the exposure times, +which are all the same in this example. The mode is not evaluated for +exposure scaling and the relative weights are the same because the +exposure times are the same. The example only shows part of the +output; \fBflatcombine\fR automatically groups the flat field images by +filter to produce the calibration images "FlatV", "FlatB", and +"FlatR". +.sh +3.2 Calibrations and Corrections + + Processing the CCD data is easy and largely automated. +First, set the task parameters with the following command: + + cl> eparam ccdproc + +You may have already set the parameters when you ran +\fBsetinstrument\fR, though the calibration image parameters +\fIzero\fR, \fIdark\fR, and \fIflat\fR may still need to be set or +changed. Once this is done simply give the command + +.nf + cl> ccdproc *.imh + ccd003: Jun 1 15:13 Overscan section is [520:540,*] with mean=485.0 + ccd003: Jun 1 15:14 Trim data section is [3:510,3:510] + ccd003: Jun 1 15:14 Overscan section is [520:540,*] with mean=485.0 + FlatV: Jun 1 15:14 Trim data section is [3:510,3:510] + FlatV: Jun 1 15:15 Overscan section is [520:540,*] with mean=486.4 + ccd003: Jun 1 15:15 Flat field image is FlatV.imh with scale=138.2 + ccd004: Jun 1 15:16 Trim data section is [3:510,3:510] + ccd004: Jun 1 15:16 Overscan section is [520:540,*] with mean=485.2 + ccd004: Jun 1 15:16 Flat field image is FlatV.imh with scale=138.2 + <... more ...> + ccd013: Jun 1 15:22 Trim data section is [3:510,3:510] + ccd013: Jun 1 15:23 Overscan section is [520:540,*] with mean=482.4 + FlatB: Jun 1 15:23 Trim data section is [3:510,3:510] + FlatB: Jun 1 15:23 Overscan section is [520:540,*] with mean=486.4 + ccd013: Jun 1 15:24 Flat field image is FlatB.imh with scale=132.3 + <... more ...> +.fi + + The output shown is with verbose mode set. It is the same as +recorded in the log file. It illustrates the principle of automatic +calibration image processing. The first object image, "ccd003", was +being processed when the flat field image was required. Since the +image was taken with the V filter the appropriate flat field was +determined to be "FlatV". Since it had not been processed, the +processing of "ccd003" was interrupted to process "FlatV". The +processed calibration image may have been cached if there was enough +memory. Once "FlatV" was processed (note that the flat field was not +flattened because the task knows this image is a flat field) the +processing of "ccd003" was completed. The next image, "ccd004", is +also a V filter image so the already processed, and possibly cached, +flat field "FlatV" is used again. The first B band image is "ccd013" +and, as before, the B filter flat field calibration image is processed +automatically. The same automatic calibration processing and image +caching occurs when using zero level and dark count calibration +images. + + Commonly the processing is done with the verbose mode turned off +and the task run as a background job. This is done with the commands + +.nf + cl> ccdred.verbose=no + cl> ccdproc *.imh & +.fi + +The already processed images in the input list are recognized as having been +processed and are not affected. To check the status of the processing we +can look at the end of the log file with: + + cl> tail logfile + +After processing we can repeat the \fBccdlist\fR command to find: + +.nf + cl> ccdlist *.imh ccdtype=object + ccd007.imh[508,508][real][object][V][OTF]:N2968 V 600s + ccd015.imh[508,508][real][object][B][OTF]:N3098 B 500s + ccd024.imh[544,512][short][object][R][OTF]:N4036 R 600s +.fi + +The processing flags indicate the images have been overscan corrected, +trimmed, and flat fielded. + + As you can see, processing images is very easy. There is one source +of minor confusion for beginning users and that is dealing with calibration +images. First, there is no reason that calibration images +may not be processed explicitly with \fBccdproc\fR, just remember to set +the \fIccdtype\fR to the calibration image type or to "". When processing +object images the calibration images to be used may be specified either +with the task parameter for the particular calibration image or by +including the calibration image in the list of input images. Calibration +images specified by parameter value take precedence and the task +does not check its CCD image type. Calibration images given in the +input list must have a valid CCD image type. In case too many +calibration images are specified, say because the calibration images +combined to make the master calibration images were not deleted and +so are part of the image list "*.imh", only the first one will be used. +Another point to know is that flat field, iillumination, and fringe images +are subset (filter) dependent and so a calibration image for each filter +must be specified. +.sh +4. Special Processing Operations + + The special processing operations are mostly concerned with the +flat field response correction. There are also special processing +operations available in \fBccdproc\fR for one dimensional readout +corrections in the zero level and flat field calibrations. These +were described briefly above and in more detail in \fBccdproc\fR +and are not discussed further in this guide. The processing +operations described in this section are for preparing flat fields +for two dimensional spectroscopic data, for correcting flat fields +for iilluminations effects, for making a separate iillumination correction, +and for applying corrections for fringe effects. For additional +discussion about flat fields and iillumination corrections see the +help topic \fBflatfields\fR. +.sh +4.1 Spectroscopic Flat Fields + + For spectroscopic data the flat fields may have to be processed to +remove the general shape of the lamp spectrum and to replace regions outside +of the aperture where there is no flat field information with values that +will not cause bad response effects when the flat field is applied to the +data. If the shape of the lamp spectrum is not important and if the +longslit spectra have the regions outside of the slit either off the +detector or trimmed then you may use the flat field without special +processing. + + First you must process the flat field images explicitly with + + cl> ccdproc *.imh ccdtype=flat + +where "*.imh" may be replaced with any list containing the flat fields. +If zero level and dark count corrections are required these calibration +images must be available at this time. + + Load the \fBtwodspec\fR package and then either the \fBlongslit\fR +package, for longslit data, or the \fBapextract\fR package, for +multiaperture data such as echelles, multifiber, or aperture mask +spectra. The task for removing the longslit quartz spectrum is +\fBresponse\fR. There is also a task for removing iillumination +effects, including the slit profile, from longslit spectra called +\fBiillumination\fR. For more about processing longslit spectra see the +help for these tasks and the paper \fIReduction of Longslit Spectra +with IRAF\fR. The cookbook \fIReduction of Longslit Spectroscopic +Data Using IRAF (KPNO ICCD and Cryogenic Camera Data)\fR also provides +a very good discussion even if your data is from a different instrument. + + For multiaperture data the task for removing the relative shapes of +the spectra is called \fBapnormalize\fR. Again, consult the help documentation +for this task for further details. Since you will probably also be +using the package for extracting the spectra you may be interested +in the document \fIThe IRAF APEXTRACT Package\fR. +.sh +4.2 Iillumination Corrections + + The flat field calibration images may not have the same iillumination +pattern as the observations of the sky due to the way the lamp illuminates the +optical system. In this case when the flat field correction is applied +to the data there will be gradients in the sky background. To remove +these gradients a blank sky calibration image is heavily smoothed +to produce an iillumination image. The iillumination image +is then divided into the images during processing to correct for the +iillumination difference between the flat field and the objects. +Like the flat fields, the iillumination corrections images may be subset +dependent so there should be an iillumination image for each subset. + +The task which makes iillumination correction images is \fBmkskycor\fR. +Some examples are + +.nf + cl> mkskycor sky004 Illum004 + cl> mkskycor sky*.imh "" +.fi + +In the first example the sky image "sky004" is used to make the iillumination +correction image "Illum004". In the second example the sky images are +converted to iillumination correction images by specifying no output image +names. Like \fBccdproc\fR if the input images have not been processed they +are first processed automatically. + +To apply the iillumination correction + +.nf + cl> ccdproc *.imh ccdtype=object illumcor+ illum=Illum004 + cl> ccdproc *.imh ccdtype=object illumcor+ illum=sky*.imh +.fi + +The iillumination images could also be set using \fBeparam\fR or given +on the command line. +.sh +4.3 Sky Flat Fields + + You will notice that when you process images with an iillumination +correction you are dividing each image by a flat field calibration and +an iillumination correction. If the iillumination corrections are not +done as a later step but at the same time as the rest of the processing +one will get the same calibration by multiplying the flat field by +the iillumination correction and using this product alone as the +flat field. Such an image is called a \fIsky flat\fR since it is +a flat field which has been corrected to yield a flat sky when applied +to the observations. This approach has the advantage of one less +calibration image and two less computations (scaling and dividing the +iillumination correction). As an added short cut, rather than compute +the iillumination image with \fBmkskycor\fR and then multiplying, the +task \fBmkskyflat\fR does all this in one step. Thus, \fBmkskyflat\fR +takes an input blank sky image, processes it if needed, determines the +appropriate flat field (sky flats are also subset dependent) from the +\fBccdproc\fR parameters or the input image list, and produces an +output sky flat. Further if no output image is specified the task +converts the input blank sky calibration image into a sky flat. + + Two examples in which a new image is created and in which the +input images are converted to sky flats are + +.nf + cl> mkskyflat sky004 Skyflat + cl> mkskyflat sky*.imh "" +.fi +.sh +4.4 Iillumination Corrected Flat Fields + + A third method to account for iillumination problems in the flat fields +is to remove the large scale pattern from the flat field itself. This is +useful if there are no reasonable blank sky calibration images and the +astronomical exposures are evenly illuminated but the flat fields are not. +This is done by smoothing the flat field images instead of blank sky +images. As with using the sky images there are two methods, creating +an iillumination correction to be applied as a separate step or fixing +the original flat field. The smoothing algorithm is +the same as that used in the other tasks. The tasks to make these types +of corrections are \fBmkillumcor\fR and \fBmkillumflat\fR. The usage +is pretty much the same as the other iillumination correction tasks +except that it is more reasonable to replace the original flat fields +by the corrected flat fields when fixing the flat field. Examples +of an iillumination correction and removing the iillumination pattern +from the flat field are + +.nf + cl> mkillumcor flat025 Illum025 + cl> mkillumflat flat*.imh "" +.fi + +As with the other tasks, the input images are processed if necessary. +.sh +4.5 Fringe Corrections + + Some CCD detectors suffer from fringing effects due to the night +sky emission lines which are not removed by the other calibration +and correction operations. To correct for the fringing you need a +really blank sky image. There is not yet a task to remove objects from +sky images because this is often done with an interactive image display +tool (which will soon be added). The blank sky image is heavily smoothed +to determine the mean sky background and then this is subtracted from the +original image. The image should then be essentially zero except for the +fringe pattern. This fringe correction image is scaled to the same +exposure time as the image to be corrected and then subtracted to remove +the fringing. Note that since the night sky lines are variable there +may need to be an additional scaling applied. Determining this scaling +requires either an interactive display tool or a very clever task. +Such tasks will also be added in the future. + + The task to make a fringe correction image is \fBmkfringecor\fR. +the sky background is determined in exactly the same way as the iillumination +pattern, in fact the same sky image may be used for both the sky +iillumination and for the fringe correction. The task works consistently +with the "mk" tasks in that the input images are processed first if needed +and then the output correction image is produced with the specified name +or replaces the input image if no output image is specified. +As examples, + +.nf + cl> mkfringecor sky004 Fringe + cl> mkfringecor sky*.imh "" +.fi +.sh +5. Demonstration + + A simple demonstration task is available. To run this demonstration +load the \fBccdtest\fR package; this is a subpackage of the main +\fBccdred\fR package. Then simply type + + cl> demo + +The demonstration will then create some artificial CCD data and reduce +them giving descriptive comments as it goes along. This demonstration uses +the "playback" facility of the command language and is actually substituting +it's own commands for terminal input. Initially you must type carriage return +or space after each comment ending with "...". If you wish to have the +demonstration run completely automatically at it's own speed then type 'g' +a the "..." prompt. Thereafter, it will simple pause long enough to give +you a chance to read the comments. When the demo is finished you will +need to remove the files created. However, feel free to examine the reduced +images, the log file, etc. \fINote that the demonstration changes the +setup parameters so be sure to run \fBsetinstrument\fI again and check +the setup parameters.\fR +.sh +6. Summary + + The \fBccdred\fR package is very easy to use. First load the package; +it is in the \fBimred\fR package which is in the \fBnoao\fR package. +If this is your first time reducing data from a particular instrument +or if you have changed instruments then run \fBsetinstrument\fR. +Set the processing parameters for the operations you want performed. +If you need to combine calibration images to form a master calibration +image use one of the combine tasks. Spectroscopic flat fields may +need to be processed first in order to remove the lamp spectrum. +Finally, just type + + cl> ccdproc *.imh& +.sh +7. References + + A general guide to using IRAF is \fIA User's Introduction to the IRAF +Command Language\fR. This document may be found in the IRAF documentation +sets and is available from the National Optical Astronomy Observatories, +Central Computer Services (NOAO-CCS). + + A more detailed description of the \fBccdred\fR package including +a discussion of the design and some of the algorithms see \fIThe IRAF +CCD Reduction Package -- CCDRED\fR by F. Valdes. This paper is available +from NOAO-CCS and appears in the proceedings of the Santa Cruz Summer +Workshop in Astronomy and Astrophysics, \fIInstrumentation for Ground-Based +Optical Astronomy: Present and Future\fR, edited by Lloyd B. Robinson and +published by Springer-Verlag. + + The task descriptions and supplementary documentation are available +in printed form in the IRAF documentation sets, a special set +containing documentation for just the \fBccdred\fR package, and on-line +through the help task by typing + + cl> help \fItopic\fR + +where \fItopic\fR is one of the following. + +.nf + badpiximage - Create a bad pixel mask image from a bad pixel file + ccdgroups - Group CCD images into image lists + ccdhedit - CCD image header editor + ccdlist - List CCD processing information + ccdproc - Process CCD images + ccdtest - CCD test and demonstration package + combine - Combine CCD images + cosmicrays - Detect and replace cosmic rays + darkcombine - Combine and process dark count images + flatcombine - Combine and process flat field images + mkfringecor - Make fringe correction images from sky images + mkillumcor - Make flat field iillumination correction images + mkillumflat - Make iillumination corrected flat fields + mkskycor - Make sky iillumination correction images + mkskyflat - Make sky corrected flat field images +setinstrument - Set instrument parameters + zerocombine - Combine and process zero level images + + ADDITIONAL HELP TOPICS + + ccdred - CCD image reduction package + ccdtypes - Description of the CCD image types + flatfields - Discussion of CCD flat field calibrations + guide - Introductory guide to using the CCDRED package + instruments - Instrument specific data files + subsets - Description of CCD subsets +.fi + +Printed copies of the on-line help documentation may be made with the +command + + cl> help topic | lprint + + In addition to the package documentation for \fBccdred\fR, +\fBlongslit\fR, and \fBapextract\fR there may be specific guides for +certain instruments. These specific guides, called "cookbooks", give +specific examples and parameter values for the CCD data. +.endhelp diff --git a/noao/imred/ccdred/doc/guide.ms b/noao/imred/ccdred/doc/guide.ms new file mode 100644 index 00000000..62d87bb9 --- /dev/null +++ b/noao/imred/ccdred/doc/guide.ms @@ -0,0 +1,794 @@ +.RP +.TL +User's Guide to the CCDRED Package +.AU +Francisco Valdes +.AI +IRAF Group - Central Computer Services +.K2 +P.O. Box 26732, Tucson, Arizona 85726 +June 1987 +Revised February 1988 +.AB +The IRAF CCD reduction package, \fBccdred\fR, provides tools +for the easy and efficient reduction of CCD images. The standard +reduction operations are replacement of bad pixels, subtraction of an +overscan or prescan bias, subtraction of a zero level image, +subtraction of a dark count image, division by a flat field calibration +image, division by an illumination correction, subtraction of a fringe +image, and trimming unwanted lines or columns. Another common +operation provided by the package is scaling and combining images with +a number of algorithms for rejecting cosmic rays. Data in the image +header is used to make the reductions largely automated and +self-documenting though the package may still be used in the absence of +this data. Also a translation mechanism is used to relate image header +parameters to those used by the package to allow data from a variety of +observatories and instruments to be processed. This guide provides a brief +description of the IRAF CCD reduction package and examples of reducing +simple CCD data. +.AE +.NH +Introduction +.LP + This guide provides a brief description of the IRAF CCD reduction +package \fBccdred\fR and examples of reducing simple CCD data. It is a +generic guide in that it is not tied to any particular type of data. +There may be more specific guides (or "cookbooks") for your data. +Detailed descriptions of the tasks and features of the package are +provided in the help documentation for the package. + + The purpose of the CCDRED package is to provide tools for the easy +and efficient reduction of CCD images. The standard reduction +operations are replacement of bad columns and lines by interpolation +from neighboring columns and lines, subtraction of a bias level +determined from overscan or prescan columns or lines, subtraction of a +zero level using a zero length exposure calibration image, subtraction +of a dark count calibration image appropriately scaled to the dark time +exposure, division by a scaled flat field calibration image, division +by an illumination image (derived from a blank sky image), subtraction +of a scaled fringe image (also derived from a blank sky image), and +trimming the image of unwanted lines or columns such as the overscan +strip. Any set of operations may be done simultaneously over a list of +images in a highly efficient manner. The reduction operations are +recorded in the image header and may also be logged on the terminal and +in a log file. + + The package also provides tools for combining multiple exposures +of object and calibration images to improve the statistical accuracy of +the observations and to remove transient bad pixels. The combining +operation scales images of different exposure times, adjusts for +variable sky background, statistically weights the images by their +signal-to-noise, and provides a number of useful algorithms for +detecting and rejecting transient bad pixels. + + Other tasks are provided for listing reduction information about +the images, deriving secondary calibration images (such as sky +corrected flat fields or illumination correction images), and easily +setting the package parameters for different instruments. + + There are several important features provided by the package to +make the reduction of CCD images convenient; particularly to minimize +record keeping. One of these is the ability to recognize the different +types of CCD images. This ability allows the user to select a certain +class of images to be processed or listed and allows the processing +tasks to identify calibration images and process them differently from +object images. The standard CCD image types are \fIobject\fR, +\fIzero\fR level, \fIdark\fR count, and \fIflat\fR field. For more on +the image types see \fBccdtypes\fR. + + The tasks can also identify the different filters (or other subset +parameter) which require different flat field images. This means you don't +have to separate the images by filter and process each set separately. +This feature is discussed further in \fBsubsets\fR. + + The tasks keep track of the reduction steps completed on each +image and ignore images which have been processed. This feature, +along with recognizing the image types and subsets, makes it possible to +specify all the images to a task with a wildcard template, such as +"*.imh", rather than indicating each image by name. You will find this +extremely important with large sets of observations. + + A fundamental aspect of the package is that the processing +modifies the images. In other words, the reduction operations are +performed directly on the image. This "feature" further simplifies +record keeping, frees the user from having to form unique output image +names, and minimizes the amount of disk space required. There +are two safety features in this process. First, the modifications do +not take effect until the operation is completed on the image. This +allows you to abort the task without messing up the image data and +protects data if the computer crashes. The second feature is that +there is a package parameter which may be set to make a backup of the +input data with a particular prefix such as "orig" or "imdir$". This +backup feature may be used when there is sufficient disk space, when learning +to use the package, or just to be cautious. + + In a similar effort to efficiently manage disk space, when combining +images into a master object or calibration image there is an option to +delete the input images upon completion of the combining operation. +Generally this is desirable when there are many calibration exposures, +such as zero level or flat field images, which are not used after they +are combined into a final calibration image. + + The following sections guide you through the basic use of the +\fBccdred\fR package. Only the important parameters which you might +want to change are described. It is assumed that the support personnel +have created the necessary instrument files (see \fBinstruments\fR) +which will set the default parameters for the data you will be +reducing. If this is not the case you may need to delve more deeply +into the details of the tasks. Information about all the parameters +and how the various tasks operate are given in the help documentation +for the tasks and in additional special help topics. Some useful help +documentation is indicated in the discussion and also in the +\fBReferences\fR section. +.NH +Getting Started +.LP + The first step is to load \fBccdred\fR. This is done by loading +the \fBnoao\fR package, followed by the image reduction package +\fBimred\fR, and finally the \fBccdred\fR package. Loading a +package consists of typing its name. Note that some of these packages may be +loaded automatically when you logon to IRAF. + + When you load the \fBccdred\fR package the menu of tasks or commands +is listed. This appears as follows: + +.nf +.KS +.ft L + cl> ccdred + badpiximage ccdtest mkfringecor setinstrument + ccdgroups combine mkillumcor zerocombine + ccdhedit cosmicrays mkillumflat + ccdlist darkcombine mkskycor + ccdproc flatcombine mkskyflat +.ft R +.KE +.fi + +A summary of the tasks and additional help topics is obtained by typing: + +.ft L + cl> help +.ft R + +This list and how to get additional help on specific topics is described +in the \fBReferences\fR section at the end of this guide. + + The first command to use is \fBsetinstrument\fR, which sets the package +appropriately for the CCD images to be reduced. The support personnel +should tell you the instrument identification, but if not a list +of known instruments may be listed by using '?' for the instrument name. + +.nf +.ft L + cl> setinstrument + Instrument ID (type ? for a list) \fI<enter instrument id or ?> + <Set ccdred package parameters using eparam> + <Set ccdproc task parameters using eparam> +.ft R +.fi + +This task sets the default parameters and then allows you to modify the +package parameters and the processing parameters using the parameter +editor \fBeparam\fR. If you are not familiar with \fBeparam\fR see the +help or CL introduction documentation. For most terminals you move up +and down through the parameters with the terminal arrow keys, you +change the parameters by simply typing the desired value, and you exit +with control Z or control D. Note that you can change parameters for +any task at any time with \fBeparam\fR and you do not have to run +\fBsetinstrument\fR again, even if you logout, until you need to reduce +data from a different instrument. + + The \fBccdred\fR package parameters control general I/O functions of +the tasks in the package. The parameters you might wish to change are +the output pixel type and the verbose option. Except when the input +images are short integers, the noise is significantly greater than one +digital unit, and disk space is critical, it is probably better to +allow the processing to convert the images to real pixel datatype. The +verbose parameter simply prints the information written to the log file +on the terminal. This can be useful when little else is being done and +you are just beginning. However, when doing background processing and +other IRAF reduction tasks it is enough to simply look at the end of +the logfile with the task \fBtail\fR to see the current state of the +processing. + + The \fBccdproc\fR parameters control the CCD processing. There are +many parameters but they all may be conveniently set at this point. +Many of the parameters have default values set appropriately for the +instrument you specified. The images to be processed can be specified +later. What needs to be set are the processing operations that you +want done and the parameters required for each operation. The +processing operations are selected by entering yes or no for each one. +The following items briefly describe each of the possible processing +operations and the additional parameters required. + +.LP +\fIfixpix\fR - Fix bad CCD lines and columns? +.IP +The bad pixels (cosmetic defects) in the detector are given in a file +specified by the parameter \fIfixfile\fR. This information is used +to replace the pixels by interpolating from the neighboring pixels. +A standard file for your instrument may be set by \fBsetinstrument\fR +or if the word "image" is given then the file is defined in the instrument +data file. For more on the bad pixel file see \fBinstruments\fR. +.LP +\fIoverscan\fR - Apply overscan strip correction? +.IP +The overscan or prescan region is specified by the parameter +\fIbiassec\fR. This is given as an IRAF image section. The overscan +region is averaged along the readout axis, specified by the parameter +\fIreadaxis\fR, to create a one dimensional bias vector. This bias is +fit by a function to remove cosmic rays and noise. There are a number +of parameters at the end of the parameter list which control the +fitting. The default overscan bias section and fitting parameters for +your instrument should be set by \fBsetinstrument\fR. If the word +"image" is given the overscan bias section is defined in the image +header or the instrument translation file. If an overscan section is +not set you can use \fBimplot\fR to determine the columns or rows for +the bias region and define an overscan image section. If you are +unsure about image sections consult with someone or read the +introductory IRAF documentation. +.LP +\fItrim\fR - Trim the image? +.IP +The image is trimmed to the image section given by the parameter +\fItrimsec\fR. A default trim section for your instrument should be +set by \fBsetinstrument\fR, however, you may override this default if +desired. If the word "image" is given the data +image section is given in the image header or the instrument +translation file. As with the overscan image section it is +straightforward to specify, but if you are unsure consult someone. +.LP +\fIzerocor\fR - Apply zero level correction? +.IP +The zero level image to be subtracted is specified by the parameter +\fIzero\fR. If none is given then the calibration image will be sought +in the list of images to be processed. +.LP +\fIdarkcor\fR - Apply dark count correction? +.IP +The dark count image to be subtracted is specified by the parameter +\fIdark\fR. If none is given then the calibration image will be sought +in the list of images to be processed. +.LP +\fIflatcor\fR - Apply flat field correction? +.IP +The flat field images to be used are specified by the parameter +\fIflat\fR. There must be one flat field image for each filter +or subset (see \fBsubsets\fR) to be processed. If a flat field +image is not given then the calibration image will be sought +in the list of images to be processed. +.LP +\fIreadcor\fR - Convert zero level image to readout correction? +.IP +If a one dimensional zero level readout correction vector is to be subtracted +instead of a two dimensional zero level image then, when this parameter is set, +the zero level images will be averaged to one dimension. The readout axis +must be specified by the parameter \fIreadaxis\fR. The default for your +instrument is set by \fBsetinstrument\fR. +.LP +\fIscancor\fR - Convert flat field image to scan correction? +.IP +If the instrument is operated in a scan mode then a correction to the +flat field may be required. There are two types of scan modes, "shortscan" +and "longscan". In longscan mode flat field images will be averaged +to one dimension and the readout axis must be specified. Shortscan mode +is a little more complicated. The scan correction is used if the flat +field images are not observed in scan mode. The number of scan lines +must be specified by the parameter \fInscan\fR. If they are observed in +scan mode, like the object observations, then the scan correction +operations should \fInot\fR be specified. For details of scan mode operations +see \fBccdproc\fR. The scan parameters +should be set by \fBsetinstrument\fR. If in doubt consult someone +familiar with the instrument and mode of operation. +.LP + + This description of the parameters is longer than the actual operation of +setting the parameters. The only parameters likely to change during processing +are the calibration image parameters. + + When processing many images using the same calibration files a modest +performance improvement can be achieved by keeping (caching) the +calibration images in memory to avoid disk accesses. This option +is available by specifying the amount of memory available for image +caching with the parameter \fImax_cache\fR. If the value is zero then +the images are accessed from disk as needed while if there is +sufficient memory the calibration images may be kept in memory during +the task execution. +.NH +Processing Your Data +.LP + The processing path depends on the type of data, the type of +instrument, types of calibration images, and the observing +sequence. In this section we describe two types of operations common +in reducing most data; combining calibration images and performing the +standard calibration and correction operations. Some additional special +operations are described in the following section. + + However, the first thing you might want to try before any +processing is to get a listing of the CCD images showing the CCD image +types, subsets, and processing flags. The task for this is +\fBccdlist\fR. It has three types of of output; a short one line per +image format, a longer format which shows the state of the processing, +and a format which prints the image names only (used to create files +containing lists of images of a particular CCD image type). To get a +quick listing type: + +.nf +.ft L + cl> ccdlist *.imh + ccd001.imh[544,512][short][unknown][V]:FOCUS L98-193 + ccd007.imh[544,512][short][object][V]:N2968 V 600s + ccd015.imh[544,512][short][object][B]:N3098 B 500s + ccd024.imh[544,512][short][object][R]:N4036 R 600s + ccd045.imh[544,512][short][flat][V]:dflat 5s + ccd066.imh[544,512][short][flat][B]:dflat 5s + ccd103.imh[544,512][short][flat][R]:dflat 5s + ccd104.imh[544,512][short][zero][]:bias + ccd105.imh[544,512][short][dark][]:dark 3600s +.ft R +.fi + + The example shows only a sample of the images. The short format +listing tells you the name of the image, its size and pixel type, the +CCD image type as seen by the package, the subset identifier (in this +case the filter), and the title. If the data had been processed then +there would also be processing flags. If the CCD image types do not +seem right then there may be a problem with the instrument +specification. + + Many of the tasks in the \fBccdred\fR package have the parameter +\fIccdtype\fR which selects a particular type of image. To list +only the object images from the previous example: + +.nf +.ft L + cl> ccdlist *.imh ccdtype=object + ccd007.imh[544,512][short][object][V]:N2968 V 600s + ccd015.imh[544,512][short][object][B]:N3098 B 500s + ccd024.imh[544,512][short][object][R]:N4036 R 600s +.ft R +.fi + +If no CCD image type is specified (by using the null string "") +then all image types are selected. This may be +necessary if your instrument data does not contain image type identifications. +.NH 2 +Combining Calibration Images +.LP + If you do not need to combine calibration images because you only +have one image of each type, you can skip this section. Calibration +images, particularly zero level and flat field images, are combined in +order to minimize the effects of noise and reject bad pixels in the +calibrations. The basic tool for combining images is the task +\fBcombine\fR. There are simple variants of this task whose default +parameters are set appropriately for each type of calibration image. +These are the ones you will use for calibration images leaving +\fBcombine\fR for combining object images. Zero level images are +combined with \fBzerocombine\fR, dark count images with +\fBdarkcombine\fR, and flat field images with \fBflatcombine\fR. + + For example, to combine flat field images the command is: + +.nf +.ft L + cl> flatcombine *.imh + Jun 1 14:26 combine: maxreject + Images N Exp Mode Scale Offset Weight + ccd045.imh 1 5.0 INDEF 1.000 0. 0.048 + ccd046.imh 1 5.0 INDEF 1.000 0. 0.048 + \fI<... list of files ...>\fL + ccd065.imh 1 5.0 INDEF 1.000 0. 0.048 + ----------- ------ ------ + FlatV.imh 21 5.0 +.ft R +.fi + +This output is printed when verbose mode is set. The same information +is recorded in the log file. In this case the flat fields are combined +by rejecting the maximum value at each point in the image (the +"maxreject" algorithm). The images are scaled by the exposure times, +which are all the same in this example. The mode is not evaluated for +exposure scaling and the relative weights are the same because the +exposure times are the same. The example only shows part of the +output; \fBflatcombine\fR automatically groups the flat field images by +filter to produce the calibration images "FlatV", "FlatB", and +"FlatR". +.NH 2 +Calibrations and Corrections +.LP + Processing the CCD data is easy and largely automated. +First, set the task parameters with the following command: + +.ft L + cl> eparam ccdproc +.ft R + +You may have already set the parameters when you ran +\fBsetinstrument\fR, though the calibration image parameters +\fIzero\fR, \fIdark\fR, and \fIflat\fR may still need to be set or +changed. Once this is done simply give the command + +.nf +.ft L + cl> ccdproc *.imh + ccd003: Jun 1 15:13 Overscan section is [520:540,*] with mean=485.0 + ccd003: Jun 1 15:14 Trim data section is [3:510,3:510] + ccd003: Jun 1 15:14 Overscan section is [520:540,*] with mean=485.0 + FlatV: Jun 1 15:14 Trim data section is [3:510,3:510] + FlatV: Jun 1 15:15 Overscan section is [520:540,*] with mean=486.4 + ccd003: Jun 1 15:15 Flat field image is FlatV.imh with scale=138.2 + ccd004: Jun 1 15:16 Trim data section is [3:510,3:510] + ccd004: Jun 1 15:16 Overscan section is [520:540,*] with mean=485.2 + ccd004: Jun 1 15:16 Flat field image is FlatV.imh with scale=138.2 + \fI<... more ...>\fL + ccd013: Jun 1 15:22 Trim data section is [3:510,3:510] + ccd013: Jun 1 15:23 Overscan section is [520:540,*] with mean=482.4 + FlatB: Jun 1 15:23 Trim data section is [3:510,3:510] + FlatB: Jun 1 15:23 Overscan section is [520:540,*] with mean=486.4 + ccd013: Jun 1 15:24 Flat field image is FlatB.imh with scale=132.3 + \fI<... more ...>\fL +.ft R +.fi + + The output shown is with verbose mode set. It is the same as +recorded in the log file. It illustrates the principle of automatic +calibration image processing. The first object image, "ccd003", was +being processed when the flat field image was required. Since the +image was taken with the V filter the appropriate flat field was +determined to be "FlatV". Since it had not been processed, the +processing of "ccd003" was interrupted to process "FlatV". The +processed calibration image may have been cached if there was enough +memory. Once "FlatV" was processed (note that the flat field was not +flattened because the task knows this image is a flat field) the +processing of "ccd003" was completed. The next image, "ccd004", is +also a V filter image so the already processed, and possibly cached, +flat field "FlatV" is used again. The first B band image is "ccd013" +and, as before, the B filter flat field calibration image is processed +automatically. The same automatic calibration processing and image +caching occurs when using zero level and dark count calibration +images. + + Commonly the processing is done with the verbose mode turned off +and the task run as a background job. This is done with the commands + +.nf +.ft L + cl> ccdred.verbose=no + cl> ccdproc *.imh & +.ft R +.fi + +The already processed images in the input list are recognized as having been +processed and are not affected. To check the status of the processing we +can look at the end of the log file with: + +.ft L + cl> tail logfile +.ft R + +After processing we can repeat the \fBccdlist\fR command to find: + +.nf +.ft L + cl> ccdlist *.imh ccdtype=object + ccd007.imh[508,508][real][object][V][OTF]:N2968 V 600s + ccd015.imh[508,508][real][object][B][OTF]:N3098 B 500s + ccd024.imh[544,512][short][object][R][OTF]:N4036 R 600s +.ft R +.fi + +The processing flags indicate the images have been overscan corrected, +trimmed, and flat fielded. + + As you can see, processing images is very easy. There is one source +of minor confusion for beginning users and that is dealing with calibration +images. First, there is no reason that calibration images +may not be processed explicitly with \fBccdproc\fR, just remember to set +the \fIccdtype\fR to the calibration image type or to "". When processing +object images the calibration images to be used may be specified either +with the task parameter for the particular calibration image or by +including the calibration image in the list of input images. Calibration +images specified by parameter value take precedence and the task +does not check its CCD image type. Calibration images given in the +input list must have a valid CCD image type. In case too many +calibration images are specified, say because the calibration images +combined to make the master calibration images were not deleted and +so are part of the image list "*.imh", only the first one will be used. +Another point to know is that flat field, illumination, and fringe images +are subset (filter) dependent and so a calibration image for each filter +must be specified. +.NH +Special Processing Operations +.LP + The special processing operations are mostly concerned with the +flat field response correction. There are also special processing +operations available in \fBccdproc\fR for one dimensional readout +corrections in the zero level and flat field calibrations. These +were described briefly above and in more detail in \fBccdproc\fR +and are not discussed further in this guide. The processing +operations described in this section are for preparing flat fields +for two dimensional spectroscopic data, for correcting flat fields +for illuminations effects, for making a separate illumination correction, +and for applying corrections for fringe effects. For additional +discussion about flat fields and illumination corrections see the +help topic \fBflatfields\fR. +.NH 2 +Spectroscopic Flat Fields +.LP + For spectroscopic data the flat fields may have to be processed to +remove the general shape of the lamp spectrum and to replace regions outside +of the aperture where there is no flat field information with values that +will not cause bad response effects when the flat field is applied to the +data. If the shape of the lamp spectrum is not important and if the +longslit spectra have the regions outside of the slit either off the +detector or trimmed then you may use the flat field without special +processing. + + First you must process the flat field images explicitly with + +.ft L + cl> ccdproc *.imh ccdtype=flat +.ft R + +where "*.imh" may be replaced with any list containing the flat fields. +If zero level and dark count corrections are required these calibration +images must be available at this time. + + Load the \fBtwodspec\fR package and then either the \fBlongslit\fR +package, for longslit data, or the \fBapextract\fR package, for +multiaperture data such as echelles, multifiber, or aperture mask +spectra. The task for removing the longslit quartz spectrum is +\fBresponse\fR. There is also a task for removing illumination +effects, including the slit profile, from longslit spectra called +\fBillumination\fR. For more about processing longslit spectra see the +help for these tasks and the paper \fIReduction of Longslit Spectra +with IRAF\fR. The cookbook \fIReduction of Longslit Spectroscopic +Data Using IRAF (KPNO ICCD and Cryogenic Camera Data)\fR also provides +a very good discussion even if your data is from a different instrument. + + For multiaperture data the task for removing the relative shapes of +the spectra is called \fBapnormalize\fR. Again, consult the help documentation +for this task for further details. Since you will probably also be +using the package for extracting the spectra you may be interested +in the document \fIThe IRAF APEXTRACT Package\fR. +.NH 2 +Illumination Corrections +.LP + The flat field calibration images may not have the same illumination +pattern as the observations of the sky due to the way the lamp illuminates the +optical system. In this case when the flat field correction is applied +to the data there will be gradients in the sky background. To remove +these gradients a blank sky calibration image is heavily smoothed +to produce an illumination image. The illumination image +is then divided into the images during processing to correct for the +illumination difference between the flat field and the objects. +Like the flat fields, the illumination corrections images may be subset +dependent so there should be an illumination image for each subset. + +The task which makes illumination correction images is \fBmkskycor\fR. +Some examples are + +.nf +.ft L + cl> mkskycor sky004 Illum004 + cl> mkskycor sky*.imh "" +.ft R +.fi + +In the first example the sky image "sky004" is used to make the illumination +correction image "Illum004". In the second example the sky images are +converted to illumination correction images by specifying no output image +names. Like \fBccdproc\fR if the input images have not been processed they +are first processed automatically. + +To apply the illumination correction + +.nf +.ft L + cl> ccdproc *.imh ccdtype=object illumcor+ illum=Illum004 + cl> ccdproc *.imh ccdtype=object illumcor+ illum=sky*.imh +.ft R +.fi + +The illumination images could also be set using \fBeparam\fR or given +on the command line. +.NH 2 +Sky Flat Fields +.LP + You will notice that when you process images with an illumination +correction you are dividing each image by a flat field calibration and +an illumination correction. If the illumination corrections are not +done as a later step but at the same time as the rest of the processing +one will get the same calibration by multiplying the flat field by +the illumination correction and using this product alone as the +flat field. Such an image is called a \fIsky flat\fR since it is +a flat field which has been corrected to yield a flat sky when applied +to the observations. This approach has the advantage of one less +calibration image and two less computations (scaling and dividing the +illumination correction). As an added short cut, rather than compute +the illumination image with \fBmkskycor\fR and then multiplying, the +task \fBmkskyflat\fR does all this in one step. Thus, \fBmkskyflat\fR +takes an input blank sky image, processes it if needed, determines the +appropriate flat field (sky flats are also subset dependent) from the +\fBccdproc\fR parameters or the input image list, and produces an +output sky flat. Further if no output image is specified the task +converts the input blank sky calibration image into a sky flat. + + Two examples in which a new image is created and in which the +input images are converted to sky flats are + +.nf +.ft L + cl> mkskyflat sky004 Skyflat + cl> mkskyflat sky*.imh "" +.ft R +.fi +.NH 2 +Illumination Corrected Flat Fields +.LP + A third method to account for illumination problems in the flat fields +is to remove the large scale pattern from the flat field itself. This is +useful if there are no reasonable blank sky calibration images and the +astronomical exposures are evenly illuminated but the flat fields are not. +This is done by smoothing the flat field images instead of blank sky +images. As with using the sky images there are two methods, creating +an illumination correction to be applied as a separate step or fixing +the original flat field. The smoothing algorithm is +the same as that used in the other tasks. The tasks to make these types +of corrections are \fBmkillumcor\fR and \fBmkillumflat\fR. The usage +is pretty much the same as the other illumination correction tasks +except that it is more reasonable to replace the original flat fields +by the corrected flat fields when fixing the flat field. Examples +of an illumination correction and removing the illumination pattern +from the flat field are + +.nf +.ft L + cl> mkillumcor flat025 Illum025 + cl> mkillumflat flat*.imh "" +.ft R +.fi + +As with the other tasks, the input images are processed if necessary. +.NH 2 +Fringe Corrections +.LP + Some CCD detectors suffer from fringing effects due to the night +sky emission lines which are not removed by the other calibration +and correction operations. To correct for the fringing you need a +really blank sky image. There is not yet a task to remove objects from +sky images because this is often done with an interactive image display +tool (which will soon be added). The blank sky image is heavily smoothed +to determine the mean sky background and then this is subtracted from the +original image. The image should then be essentially zero except for the +fringe pattern. This fringe correction image is scaled to the same +exposure time as the image to be corrected and then subtracted to remove +the fringing. Note that since the night sky lines are variable there +may need to be an additional scaling applied. Determining this scaling +requires either an interactive display tool or a very clever task. +Such tasks will also be added in the future. + + The task to make a fringe correction image is \fBmkfringecor\fR. +the sky background is determined in exactly the same way as the illumination +pattern, in fact the same sky image may be used for both the sky +illumination and for the fringe correction. The task works consistently +with the "mk" tasks in that the input images are processed first if needed +and then the output correction image is produced with the specified name +or replaces the input image if no output image is specified. +As examples, + +.nf +.ft L + cl> mkfringecor sky004 Fringe + cl> mkfringecor sky*.imh "" +.ft R +.fi +.NH +Demonstration +.LP + A simple demonstration task is available. To run this demonstration +load the \fBccdtest\fR package; this is a subpackage of the main +\fBccdred\fR package. Then simply type + +.ft L + cl> demo +.ft R + +The demonstration will then create some artificial CCD data and reduce +them giving descriptive comments as it goes along. This demonstration uses +the "playback" facility of the command language and is actually substituting +it's own commands for terminal input. Initially you must type carriage return +or space after each comment ending with "...". If you wish to have the +demonstration run completely automatically at it's own speed then type 'g' +a the "..." prompt. Thereafter, it will simple pause long enough to give +you a chance to read the comments. When the demo is finished you will +need to remove the files created. However, feel free to examine the reduced +images, the log file, etc. \fINote that the demonstration changes the +setup parameters so be sure to run \fBsetinstrument\fI again and check +the setup parameters.\fR +.NH +Summary +.LP + The \fBccdred\fR package is very easy to use. First load the package; +it is in the \fBimred\fR package which is in the \fBnoao\fR package. +If this is your first time reducing data from a particular instrument +or if you have changed instruments then run \fBsetinstrument\fR. +Set the processing parameters for the operations you want performed. +If you need to combine calibration images to form a master calibration +image use one of the combine tasks. Spectroscopic flat fields may +need to be processed first in order to remove the lamp spectrum. +Finally, just type + +.ft L + cl> ccdproc *.imh& +.ft R +.SH +References +.LP + A general guide to using IRAF is \fIA User's Introduction to the IRAF +Command Language\fR. This document may be found in the IRAF documentation +sets and is available from the National Optical Astronomy Observatories, +Central Computer Services (NOAO-CCS). + + A more detailed description of the \fBccdred\fR package including +a discussion of the design and some of the algorithms see \fIThe IRAF +CCD Reduction Package -- CCDRED\fR" by F. Valdes. This paper is available +from NOAO-CCS and appears in the proceedings of the Santa Cruz Summer +Workshop in Astronomy and Astrophysics, \fIInstrumentation for Ground-Based +Optical Astronomy: Present and Future\fR, edited by Lloyd B. Robinson and +published by Springer-Verlag. + + The task descriptions and supplementary documentation are available +in printed form in the IRAF documentation sets, a special set +containing documentation for just the \fBccdred\fR package, and on-line +through the help task by typing + +.ft L + cl> help \fItopic\fR +.ft R + +where \fItopic\fR is one of the following. + +.nf +.ft L + badpiximage - Create a bad pixel mask image from a bad pixel file + ccdgroups - Group CCD images into image lists + ccdhedit - CCD image header editor + ccdlist - List CCD processing information + ccdproc - Process CCD images + ccdtest - CCD test and demonstration package + combine - Combine CCD images + cosmicrays - Detect and replace cosmic rays + darkcombine - Combine and process dark count images + flatcombine - Combine and process flat field images + mkfringecor - Make fringe correction images from sky images + mkillumcor - Make flat field illumination correction images + mkillumflat - Make illumination corrected flat fields + mkskycor - Make sky illumination correction images + mkskyflat - Make sky corrected flat field images +setinstrument - Set instrument parameters + zerocombine - Combine and process zero level images + + ADDITIONAL HELP TOPICS + + ccdred - CCD image reduction package + ccdtypes - Description of the CCD image types + flatfields - Discussion of CCD flat field calibrations + guide - Introductory guide to using the CCDRED package + instruments - Instrument specific data files + subsets - Description of CCD subsets +.ft R +.fi + +Printed copies of the on-line help documentation may be made with the +command + +.ft L + cl> help \fItopic\fL | lprint +.ft R + + In addition to the package documentation for \fBccdred\fR, +\fBlongslit\fR, and \fBapextract\fR there may be specific guides for +certain instruments. These specific guides, called "cookbooks", give +specific examples and parameter values for the CCD data. diff --git a/noao/imred/ccdred/doc/instruments.hlp b/noao/imred/ccdred/doc/instruments.hlp new file mode 100644 index 00000000..95baff37 --- /dev/null +++ b/noao/imred/ccdred/doc/instruments.hlp @@ -0,0 +1,256 @@ +.help instruments Dec93 noao.imred.ccdred + +.ih +NAME +instruments -- Instrument specific data files +.ih +DESCRIPTION +The \fBccdred\fR package has been designed to accommodate many different +instruments, detectors, and observatories. This is done by having +instrument specific data files. Note that by instrument we mean a +combination of detector, instrument, application, and observatory, so +there might be several "instruments" associated with a particular CCD +detector. Creating and maintaining the instrument files is generally +the responsibility of the support staff, though the user may create or +copy and modify his/her own instrument/application specific files. The +task \fBsetinstrument\fR makes this information available to the user +and package easily. + +There are three instrument data files, all of which are optional. The +package may be used without the instrument files but much of the +convenience of the package, particularly with respect to using the CCD +image types, will be lost. The three files are an instrument image +header translation file, an initialization task which mainly sets +default task parameters, and a bad pixel file identifying the cosmic +bad pixels in the detector. These files are generally stored in a +system data directory which is a subdirectory of the logical +directory "ccddb$". Each file has a root name which identifies the +instrument. +.sh +1. Instrument Translation File +The instrument translation file translates the parameter names used by +the \fBccdred\fR pacakge into instrument specific parameters and also +supplies instrument specific default values. The package parameter +\fIccdred.instrument\fR specifies this file to the package. The task +\fBsetinstrument\fR sets this parameter, though it can be set +explicitly like any other parameter. For the standard instrument +translation file the root name is the instrument identification and the +extension is "dat" ("*.dat" files are protected from being removed in a +"stripped" system, i.e. when all nonessential files are removed). +Private instrument files may be given any name desired. + +The instrument translation proceeds as follows. When a package task needs +a parameter for an image, for example "imagetyp", it looks in the instrument +translation file. If the file is not found or none is specified then the +image header keyword that is requested has the same name. If an +instrument translation file is defined then the requested +parameter is translated to an image header keyword, provided a translation +entry is given. If no translation is given the package name is used. For +example the package parameter "imagetyp" might be translated to "data-typ" +(the old NOAO CCD keyword). If the parameter is not found then the default +value specified in the translation file, if present, is returned. For recording +parameter information in the header, such as processing flags, the +translation is also used. The default value has no meaning in this case. +For example, if the flag specifying that the image has been corrected +by a flat field is to be set then the package parameter name "flatcor" +might be translated to "ff-flag". If no translation is given then the +new image header parameter is entered as "flatcor". + +The format of the translation file are lines consisting of the package +parameter name, followed by the image header keyword, followed by the +default value. The first two fields are parameter names. The fields +are separated by whitespace (blanks and tabs). String default values +containing blanks must be quoted. An example is given below. + +.nf + # Sample translation file. + exptime itime + darktime itime + imagetyp data-typ + subset f1pos + biassec biassec [411:431,2:573] + datasec datasec [14:385,2:573] + + fixpix bp-flag 0 + overscan bt-flag 0 + zerocor bi-flag 0 + darkcor dk-flag 0 + flatcor ff-flag 0 + fringcor fr-flag 0 +.fi + +The first comment line is ignored as are blank lines. +The first two lines translate the CCD image type, and the subset parameter +without default values (see \fBccdtypes\fR and \fBsubsets\fR for more +information). The next two lines give the overscan bias strip +section and the data section with default values for the instrument. +Note that these parameters may be overridden in the task \fBccdproc\fR. + +The next set of translations requires further discussion. For processing +flags the package assumes that the absence of a keyword means that the +processing has not been done. If processing is always to be done with +the \fBCCDRED\fR package and no processing keywords are recorded in the raw data +then these parameters should be absent (unless you don't like the names +used by the package). However, for compatibility with the original NOAO +CCD images, which may be processed outside of IRAF and which use 0 as the +no processing value, the processing flags are translated and the false values +are indicated by the default values. + +If there is more than one translation for the same CCDRED parameter, +for example more than one exptime, then the last one is used. + +In addition to the parameter name translations the translation file +contains translations between the value of the image type parameter +and the image types used by the package. These lines +consist of the image header type string as the first field (with quotes +if there are blanks) and the image type as recognized by the package. The +following example will make this clearer. + +.nf + 'OBJECT (0)' object + 'DARK (1)' dark + 'PROJECTOR FLAT (2)' flat + 'SKY FLAT (3)' other + 'COMPARISON LAMP (4)' other + 'BIAS (5)' zero + 'DOME FLAT (6)' flat +.fi + +The values of the image type strings in the header contain blanks so they +are quoted. Also the case of the strings is important. Note that there +are two types of flat field images and three types of object images. + +The CCD image types recognized by the package are: + +.nf + zero - zero level image such as a bias or preflash + dark - dark count image + flat - flat field image + illum - iillumination image such as a sky image + fringe - fringe correction image + object - object image +.fi + +There may be more than one image type that maps to the same package +type. In particular other standard CCD image types, such as comparison +spectra, multiple exposure, standard star, etc., should be mapped to +object or other. There may also be more than one type of flat field, +i.e. dome flat, sky flat, and lamp flat. For more on the CCD image +types see \fBccdtypes\fR. + +The complete set of package parameters are given below. +The package parameter names are generally the same as the +standard image header keywords being adopted by NOAO. + +.nf + General Image Header and Default Parameters + ccdmean darktime exptime fixfile + imagetyp ncombine biassec subset + title datasec nscanrow + + CCDRED Processing Flags + ccdproc darkcor fixpix flatcor + fringcor illumcor overscan trim + zerocor + + CCDRED CCD Image Types + dark flat fringe illum + none object unknown zero +.fi + +The translation mechanism described here may become more +sophisticated in the future and a general IRAF system facility may be +implemented eventually. For the present the translation mechanism is +quite simple. +.sh +2. Instrument Setup Script +The task \fBsetinstrument\fR translates an instrument ID into a +CL script in the instrument directory. This script is then executed. +Generally this script simply sets the task parameters for an +instrument/application. However, it could do anything else the support +staff desires. Below are the first few lines of a typical instrument setup +script. + +.nf + ccdred.instrument = "ccddb$kpno/example.dat" + ccdred.pixeltype = "real" + ccdproc.fixpix = yes + ccdproc.overscan = yes + ccdproc.trim = yes + ccdproc.zerocor = no + ccdproc.darkcor = no + ccdproc.flatcor = yes + ccdproc.biassec = "[411:431,2:573]" + ccdproc.datasec = "[14:385,2:573]" +.fi + +The instrument parameter should always be set unless there is no +translation file for the instrument. The \fBccdproc\fR parameters +illustrate setting the appropriate processing flags for the +instrument. The overscan bias and trim data sections show an alternate +method of setting these instrument specific parameters. They may be +set in the setup script in which case they are given explicitly in the +user parameter list for \fBccdproc\fR. If the value is "image" then +the parameters may be determined either through the default value in +the instrument translation file, as illustrated in the previous +section, or from the image header itself. + +The instrument setup script for setting default task parameters may be +easily created by the support person as follows. Set the package +parameters using \fBeparam\fR or with CL statements. Setting the +parameters might involve testing. When satisfied with the way the +package is set then the parameters may be dumped to a setup script +using the task \fBdparam\fR. The final step is editing this script to +delete unimportant and query parameters. For example, + +.nf + cl> dparam ccdred >> file.cl + cl> dparam ccdproc >> file.cl + cl> dparam combine >> file.cl + ... + cl> ed file.cl +.fi +.sh +3. Instrument Bad Pixel File +The bad pixel file describes the bad pixels, columns, and lines in the +detector which are to be replaced by interpolation when processing the +images. This file is clearly detector specific. The file consists of +lines describing rectangular regions of the image. +The regions are specified by four numbers giving the starting and ending +columns followed by the starting and ending lines. The starting and +ending points may be the same to specify a single column or line. The +example below illustrates a bad pixel file. + +.nf + # RCA1 CCD untrimmed + 25 25 1 512 + 108 108 1 512 + 302 302 403 512 + 1 512 70 70 + 245 246 312 315 +.fi + +If there is a comment line in the file containing the word "untrimmed" +then the coordinates of the bad pixel regions apply to the original CCD +detector coordinates. +If the image has been trimmed and the bad pixels are replaced at a later +stage then this word indicates that the trim region be determined from the +image header and the necessary coordinate conversion made to the original +CCD pixel coordinates. Note that if a subraster readout is used the +coordinates must still refer to the original CCD coordinates and +not the raw, untrimmed readout image. If the word +"untrimmed" does not appear then the coordinates are assumed to apply to +the image directly; i.e. the trimmed coordinates if the image has been +trimmed or the original coordinates if the image has not been trimmed. +The standard bad pixel files should always refer to the original, untrimmed +coordinates. + +The first two bad pixel regions are complete bad columns (the image +is 512 x 512), the next line is a partial bad column, the next line is +a bad line, and the last line is a small bad region. These files are +easy to create, provided you have a good image to work from and a way +to measure the positions with an image or graphics display. +.ih +SEE ALSO +ccdtypes, subsets, setinstrument +.endhelp diff --git a/noao/imred/ccdred/doc/mkfringecor.hlp b/noao/imred/ccdred/doc/mkfringecor.hlp new file mode 100644 index 00000000..797f4d11 --- /dev/null +++ b/noao/imred/ccdred/doc/mkfringecor.hlp @@ -0,0 +1,90 @@ +.help mkfringecor Feb88 noao.imred.ccdred +.ih +NAME +mkfringecor -- Make fringe correction images from sky images +.ih +USAGE +mkfringecor input output +.ih +PARAMETERS +.ls input +List of input images for making fringe correction images. +.le +.ls output +List of output fringe correction images. If none is +specified or if the name is the same as the input image then the output +image replaces the input image. +.le +.ls ccdtype = "" +CCD image type to select from the input images. If none is specified +then all types are used. +.le +.ls xboxmin = 5, xboxmax = 0.25, yboxmin = 5, yboxmax = 0.25 +Minimum and maximum smoothing box size along the x and y axes. The +minimum box size is used at the edges and grows to the maximum size in +the middle of the image. This allows the smoothed image to better +represent gradients at the edge of the image. If a size is less then 1 +then it is interpreted as a fraction of the image size. If a size is +greater than or equal to 1 then it is the box size in pixels. A size +greater than the size of image selects a box equal to the size of the +image. +.le +.ls clip = yes +Clean the input images of objects? If yes then a clipping algorithm is +used to detect and exclude objects from the smoothing. +.le +.ls lowsigma = 2.5, highsigma = 2.5 +Sigma clipping thresholds above and below the smoothed background. +.le +.ls ccdproc (parameter set) +CCD processing parameters. +.le +.ih +DESCRIPTION +The input blank sky images are automatically processed up through the +iillumination correction before computing the fringe correction images. +The fringe corrections are subset dependent. +The slowly varying background is determined and subtracted leaving only +the fringe pattern caused by the sky emission lines. These fringe images +are then scaled and subtracted from the observations by \fBccdproc\fR. +The background is determined by heavily smoothing the image using a +moving "boxcar" average. The effects of the objects and fringes in the +image is minimized by using a sigma clipping algorithm to detect and +exclude them from the average. Note, however, that objects left in the +fringe image will affect the fringe corrected observations. Any objects +in the sky image should be removed using \fBskyreplace\fR (not yet +available). + +The smoothing algorithm is a moving average over a two dimensional +box. The algorithm is unconvential in that the box size is not fixed. +The box size is increased from the specified minimum at the edges to +the maximum in the middle of the image. This permits a better estimate +of the background at the edges, while retaining the very large scale +smoothing in the center of the image. Note that the sophisticated +tools of the \fBimages\fR package may be used for smoothing but this +requires more of the user and, for the more sophisticated smoothing +algorithms such as surface fitting, more processing time. + +To minimize the effects of the fringes and any objects in the blank sky +calibration images a sigma clipping algorithm is used to detect and +exclude features from the background. This is done by computing the +rms of the image lines relative to the smoothed background and +excluding points exceeding the specified threshold factors times the +rms. This is done before each image line is added to the moving +average, except for the first few lines where an iterative process is +used. +.ih +EXAMPLES +1. The two examples below make an fringe correction image from a blank +sky image, "sky017". In the first example a separate fringe +image is created and in the second the fringe image replaces the +sky image. + +.nf + cl> mkskycor sky017 Fringe + cl> mkskycor sky017 frg017 +.fi +.ih +SEE ALSO +ccdproc +.endhelp diff --git a/noao/imred/ccdred/doc/mkillumcor.hlp b/noao/imred/ccdred/doc/mkillumcor.hlp new file mode 100644 index 00000000..0effd7a2 --- /dev/null +++ b/noao/imred/ccdred/doc/mkillumcor.hlp @@ -0,0 +1,92 @@ +.help mkillumcor Oct88 noao.imred.ccdred +.ih +NAME +mkillumcor -- Make flat field iillumination correction images +.ih +USAGE +mkillumcor input output +.ih +PARAMETERS +.ls input +List of input images for making flat field iillumination correction images. +.le +.ls output +List of output flat field iillumination correction images. If none is +specified or if the name is the same as the input image then the output +image replaces the input image. +.le +.ls ccdtype = "flat" +CCD image type to select from the input images. If none is specified +then all types are used. +.le +.ls xboxmin = 5, xboxmax = 0.25, yboxmin = 5, yboxmax = 0.25 +Minimum and maximum smoothing box size along the x and y axes. The +minimum box size is used at the edges and grows to the maximum size in +the middle of the image. This allows the smoothed image to better +represent gradients at the edge of the image. If a size is less then 1 +then it is interpreted as a fraction of the image size. If a size is +greater than or equal to 1 then it is the box size in pixels. A size +greater than the size of image selects a box equal to the size of the +image. +.le +.ls clip = yes +Clean the input images of objects? If yes then a clipping algorithm is +used to detect and exclude deviant points from the smoothing. +.le +.ls lowsigma = 2.5, highsigma = 2.5 +Sigma clipping thresholds above and below the smoothed iillumination. +.le +.ls divbyzero = 1. +The iillumination correction is the inverse of the smoothed flat field. +This may produce division by zero. A warning is given if division +by zero takes place and the result (the iillumination correction value) +is replaced by the value of this parameter. +.le +.ls ccdproc (parameter set) +CCD processing parameters. +.le +.ih +DESCRIPTION +First, the input flat field images are automatically processed if +needed. Then, the large scale iillumination pattern of the images is +determined by heavily smoothing them using a moving "boxcar" average. +The iillumination correction, the inverse of the iillumination pattern, +is applied by \fBccdproc\fR to CCD images to remove the iillumination +pattern introduced by the flat field. The combination of the flat +field calibration and the iillumination correction based on the flat +field is equivalent to removing the iillumination from the flat field +(see \fBmkillumflat\fR). This two step calibration is generally used +when the observations have been previously flat field calibrated. This +task is closely related to \fBmkskycor\fR which determines the +iillumination correction from a blank sky image; this is preferable to +using the iillumination from the flat field as it corrects for the +residual iillumination error. For a general discussion of the options +for flat fields and iillumination corrections see \fBflatfields\fR. + +The smoothing algorithm is a moving average over a two dimensional +box. The algorithm is unconvential in that the box size is not fixed. +The box size is increased from the specified minimum at the edges to +the maximum in the middle of the image. This permits a better estimate +of the background at the edges, while retaining the very large scale +smoothing in the center of the image. Note that the sophisticated +tools of the \fBimages\fR package may be used for smoothing but this +requires more of the user and, for the more sophisticated smoothing +algorithms such as surface fitting, more processing time. + +To minimize the effects of bad pixels a sigma clipping algorithm is +used to detect and reject these pixels from the iillumination. This is +done by computing the rms of the image lines relative to the smoothed +iillumination and excluding points exceeding the specified threshold +factors times the rms. This is done before each image line is added to +the moving average, except for the first few lines where an iterative +process is used. +.ih +EXAMPLES +1. The example below makes an iillumination correction image from the +flat field image, "flat017". + + cl> mkillumcor flat017 Illum +.ih +SEE ALSO +ccdproc, flatfields, mkillumflat, mkskycor, mkskyflat +.endhelp diff --git a/noao/imred/ccdred/doc/mkillumflat.hlp b/noao/imred/ccdred/doc/mkillumflat.hlp new file mode 100644 index 00000000..8288fb85 --- /dev/null +++ b/noao/imred/ccdred/doc/mkillumflat.hlp @@ -0,0 +1,101 @@ +.help mkillumflat Oct88 noao.imred.ccdred +.ih +NAME +mkillumflat -- Make illumination corrected flat fields +.ih +USAGE +mkillumflat input output +.ih +PARAMETERS +.ls input +List of input flat field images to be illumination corrected. +.le +.ls output +List of output illumination corrected flat field images. +If none is specified or if the name is the same as the +input image then the output image replaces the input image. +.le +.ls ccdtype = "flat" +CCD image type to select from the input images. +.le +.ls xboxmin = 5, xboxmax = 0.25, yboxmin = 5, yboxmax = 0.25 +Minimum and maximum smoothing box size along the x and y axes. The +minimum box size is used at the edges and grows to the maximum size in +the middle of the image. This allows the smoothed image to better +represent gradients at the edge of the image. If a size is less then 1 +then it is interpreted as a fraction of the image size. If a size is +greater than or equal to 1 then it is the box size in pixels. A size +greater than the size of image selects a box equal to the size of the +image. +.le +.ls clip = yes +Clean the input images of objects? If yes then a clipping algorithm is +used to detect and exclude objects from the smoothing. +.le +.ls lowsigma = 2.5, highsigma = 2.5 +Sigma clipping thresholds above and below the smoothed illumination. +.le +.ls divbyzero = 1. +The illumination flat field is the ratio of the flat field to a +smoothed flat field. This may produce division by zero. A warning is +given if division by zero takes place and the result (the illumination +corrected flat field value) is replaced by the value of this +parameter. +.le +.ls ccdproc (parameter set) +CCD processing parameters. +.le +.ih +DESCRIPTION +First, the input flat field images are processed as needed. Then the +large scale illumination pattern of the images is removed. The +illumination pattern is determined by heavily smoothing the image using +a moving "boxcar" average. The output image is the ratio of the input +image to the illumination pattern. The illumination pattern is +normalized by its mean to preserve the mean level of the input image. + +When this task is applied to flat field images only the small scale +response effects are retained. This is appropriate if the flat field +images have illumination effects which differ from the astronomical +images and blank sky images are not available for creating sky +corrected flat fields. When a high quality blank sky image is +available the related task \fBmkskyflat\fR should be used. Note that +the illumination correction, whether from the flat field or a sky +image, may be applied as a separate step by using the task +\fBmkillumcor\fR or \fBmkskycor\fR and applying the illumination +correction as a separate operation in \fBccdproc\fR. However, creating +an illumination corrected flat field image before processing is more +efficient since one less operation per image processed is needed. For +more discussion about flat fields and illumination corrections see +\fBflatfields\fR. + +The smoothing algorithm is a moving average over a two dimensional +box. The algorithm is unconvential in that the box size is not fixed. +The box size is increased from the specified minimum at the edges to +the maximum in the middle of the image. This permits a better estimate +of the background at the edges, while retaining the very large scale +smoothing in the center of the image. Note that the sophisticated +tools of the \fBimages\fR package may be used for smoothing but this +requires more of the user and, for the more sophisticated smoothing +algorithms such as surface fitting, more processing time. + +To minimize the effects of bad pixels a sigma clipping algorithm is +used to detect and reject these pixels from the illumination. This is +done by computing the rms of the image lines relative to the smoothed +illumination and excluding points exceeding the specified threshold +factors times the rms. This is done before each image line is added to +the moving average, except for the first few lines where an iterative +process is used. +.ih +EXAMPLES +1. Two examples in which a new image is created and in which the +input flat fields are corrected in place are: + +.nf + cl> mkllumflat flat004 FlatV + cl> mkillumflat flat* "" +.fi +.ih +SEE ALSO +ccdproc, flatfields, mkfringecor, mkillumcor, mkskycor, mkskyflat +.endhelp diff --git a/noao/imred/ccdred/doc/mkskycor.hlp b/noao/imred/ccdred/doc/mkskycor.hlp new file mode 100644 index 00000000..15cfacf6 --- /dev/null +++ b/noao/imred/ccdred/doc/mkskycor.hlp @@ -0,0 +1,103 @@ +.help mkskycor Feb88 noao.imred.ccdred +.ih +NAME +mkskycor -- Make sky iillumination correction images +.ih +USAGE +mkskycor input output +.ih +PARAMETERS +.ls input +List of input images for making sky iillumination correction images. +.le +.ls output +List of output flat field iillumination correction images. If none is +specified or if the name is the same as the input image then the output +image replaces the input image. +.le +.ls ccdtype = "" +CCD image type to select from the input images. If none is specified +then all types are used. +.le +.ls xboxmin = 5, xboxmax = 0.25, yboxmin = 5, yboxmax = 0.25 +Minimum and maximum smoothing box size along the x and y axes. The +minimum box size is used at the edges and grows to the maximum size in +the middle of the image. This allows the smoothed image to better +represent gradients at the edge of the image. If a size is less then 1 +then it is interpreted as a fraction of the image size. If a size is +greater than or equal to 1 then it is the box size in pixels. A size +greater than the size of image selects a box equal to the size of the +image. +.le +.ls clip = yes +Clean the input images of objects? If yes then a clipping algorithm is +used to detect and exclude objects from the smoothing. +.le +.ls lowsigma = 2.5, highsigma = 2.5 +Sigma clipping thresholds above and below the smoothed iillumination. +.le +.ls ccdproc (parameter set) +CCD processing parameters. +.le +.ih +DESCRIPTION +The large scale iillumination pattern of the input images, generally +blank sky calibration images, is determined by heavily smoothing +the image using a moving "boxcar" average. The effects of objects in +the image may be minimized by using a sigma clipping algorithm to +detect and exclude the objects from the average. This +iillumination image is applied by \fBccdproc\fR to CCD images to remove +the iillumination pattern. + +The input images are automatically processed up through flat field +calibration before computing the iillumination. The iillumination +correction is that needed to make the processed images flat +over large scales. The input images are generally blank sky calibration +images which have the same iillumination and instrumental effects +as the object observations. Object images may be used but removal +of the objects may not be very good; particularly large, bright objects. +For further discussion of flat fields and iillumination corrections +see \fBflatfields\fR. + +You will notice that when you process images with an iillumination +correction you are dividing each image by a flat field calibration and +an iillumination correction. If the iillumination corrections are not +done as a later step but at the same time as the rest of the processing +one will get the same calibration by multiplying the flat field by the +iillumination correction and using this product alone as the flat +field. This approach has the advantage of one less calibration image +and two less computations (scaling and dividing the iillumination +correction). Such an image, called a \fIsky flat\fR, may be created by +\fBmkskyflat\fR as an alternative to this task. + +The smoothing algorithm is a moving average over a two dimensional +box. The algorithm is unconvential in that the box size is not fixed. +The box size is increased from the specified minimum at the edges to +the maximum in the middle of the image. This permits a better estimate +of the background at the edges, while retaining the very large scale +smoothing in the center of the image. Note that the sophisticated +tools of the \fBimages\fR package may be used for smoothing but this +requires more of the user and, for the more sophisticated smoothing +algorithms such as surface fitting, more processing time. + +Blank sky images may not be completely blank so a sigma clipping +algorithm may be used to detect and exclude objects from the +iillumination pattern. This is done by computing the rms of the image +lines relative to the smoothed background and excluding points +exceeding the specified threshold factors times the rms. This is done +before each image line is added to the moving average, except for the +first few lines where an iterative process is used. +.ih +EXAMPLES +1. The two examples below make an iillumination image from a blank sky image, +"sky017". In the first example a separate iillumination image is created +and in the second the iillumination image replaces the sky image. + +.nf + cl> mkskycor sky017 Illum + cl> mkskycor sky017 sky017 +.fi +.ih +SEE ALSO +ccdproc, flatfields, mkillumcor, mkillumflat, mkskyflat +.endhelp diff --git a/noao/imred/ccdred/doc/mkskyflat.hlp b/noao/imred/ccdred/doc/mkskyflat.hlp new file mode 100644 index 00000000..d28e2301 --- /dev/null +++ b/noao/imred/ccdred/doc/mkskyflat.hlp @@ -0,0 +1,110 @@ +.help mkskyflat Feb88 noao.imred.ccdred +.ih +NAME +mkskyflat -- Make sky corrected flat field images +.ih +USAGE +mkskyflat input output +.ih +PARAMETERS +.ls input +List of blank sky images to be used to create sky corrected flat field +calibration images. +.le +.ls output +List of output sky corrected flat field calibration images (called +sky flats). If none is specified or if the name is the same as the +input image then the output image replaces the input image. +.le +.ls ccdtype = "" +CCD image type to select from the input images. +.le +.ls xboxmin = 5, xboxmax = 0.25, yboxmin = 5, yboxmax = 0.25 +Minimum and maximum smoothing box size along the x and y axes. The +minimum box size is used at the edges and grows to the maximum size in +the middle of the image. This allows the smoothed image to better +represent gradients at the edge of the image. If a size is less then 1 +then it is interpreted as a fraction of the image size. If a size is +greater than or equal to 1 then it is the box size in pixels. A size +greater than the size of image selects a box equal to the size of the +image. +.le +.ls clip = yes +Clean the input images of objects? If yes then a clipping algorithm is +used to detect and exclude objects from the smoothing. +.le +.ls lowsigma = 2.5, highsigma = 2.5 +Sigma clipping thresholds above and below the smoothed iillumination. +.le +.ls ccdproc (pset) +CCD processing parameter set. +.le +.ih +DESCRIPTION +A sky corrected flat field calibration image, called a sky flat, is a +flat field that when applied to observations of the sky have no large +scale gradients. Flat field images are generally obtained by exposures +to lamps either illuminating the telescope field or a surface in the dome +at which the telescope is pointed. Because the detector is not illuminated +in the same way as an observation of the sky there may be large +scale iillumination patterns introduced into the observations with such +a flat field. To correct this type of flat field a blank sky observation +(which has been divided by the original flat field) is heavily smoothed +to remove the noise leaving only the residual large scale iillumination +pattern. This iillumination pattern is divided into the original flat +field to remove this residual. + +The advantage of creating a sky flat field is that when processing +the observations no additional operations are required. However, +if the observations have already been processed with the original +flat field then the residual iillumination pattern of blank sky +calibration images may be created as an iillumination correction +to be applied by \fBccdproc\fR. Such a correction is created by the +task \fBmkskycor\fR. If a good blank sky image is not +available then it may be desirable to remove the iillumination pattern +of the flat field image using \fBmkillumflat\fR or \fBmkillumcor\fR +provided the sky observations are truly uniformly illuminated. +For more on flat fields and iillumination corrections see \fBflatfields\fR. + +The input, blank sky images are first processed, based on the +\fBccdproc\fR parameters, if needed. These parameters also determine +the flat field image to be used in making the sky flat. The residual +iillumination pattern is determined by heavily smoothing the image using +a moving "boxcar" average. The effects of objects in the input image +may be minimized by using a sigma clipping algorithm to detect and +exclude the objects from the average. The output image is ratio of the +flat field image, for the same subset as the input image, to the +residual iillumination pattern determined from the processed blank sky +input image. The iillumination pattern is normalized by its mean to +preserve the mean level of the flat field image. + +The smoothing algorithm is a moving average over a two dimensional +box. The algorithm is unconvential in that the box size is not fixed. +The box size is increased from the specified minimum at the edges to +the maximum in the middle of the image. This permits a better estimate +of the background at the edges, while retaining the very large scale +smoothing in the center of the image. Note that the sophisticated +tools of the \fBimages\fR package may be used for smoothing but this +requires more of the user and, for the more sophisticated smoothing +algorithms such as surface fitting, more processing time. + +Blank sky images may not be completely blank so a sigma clipping +algorithm may be used to detect and exclude objects from the +iillumination pattern. This is done by computing the rms of the image +lines relative to the smoothed background and excluding points +exceeding the specified threshold factors times the rms. This is done +before each image line is added to the moving average, except for the +first few lines where an iterative process is used. +.ih +EXAMPLES +1. Two examples in which a new image is created and in which the +input sky images are converted to sky flats are: + +.nf + cl> mkskyflat sky004 Skyflat + cl> mkskyflat sky* "" +.fi +.ih +SEE ALSO +ccdproc, flatfields, mkfringecor, mkillumcor, mkillumflat, mkskycor +.endhelp diff --git a/noao/imred/ccdred/doc/setinstrument.hlp b/noao/imred/ccdred/doc/setinstrument.hlp new file mode 100644 index 00000000..410dd20f --- /dev/null +++ b/noao/imred/ccdred/doc/setinstrument.hlp @@ -0,0 +1,97 @@ +.help setinstrument Oct87 noao.imred.ccdred +.ih +NAME +setinstrument -- Set instrument parameters +.ih +USAGE +setinstrument instrument +.ih +PARAMETERS +.ls instrument +Instrument identification for instrument parameters to be set. If '?' +then a list of the instrument identifiers is printed. +.le +.ls site = "kpno" +Site ID. +.le +.ls directory = "ccddb$" +Instrument directory containing instrument files. The instrument files +are found in the subdirectory given by the site ID. +.le +.ls review = yes +Review the instrument parameters? If yes then \fBeparam\fR is run for +the parameters of \fBccdred\fR and \fBccdproc\fR. +.le +.ls query +Parameter query if initial instrument is not found. +.le +.ih +DESCRIPTION +The purpose of the task is to allow the user to easily set default +parameters for a new instrument. The default parameters are generally +defined by support personal in an instrument directory for a particular +site. The instrument directory is the concatenation of the specified +directory and the site. For example if the directory is "ccddb$" and +the site is "kpno" then the instrument directory is "ccddb$kpno/". +The user may have his own set of instrument files in a local directory. +The current directory is used by setting the directory and site to the +null string (""). + +The user specifies an instrument identifier. This instrument may +be specific to a particular observatory, telescope, instrument, and +detector. If the character '?' is specified or the instrument file is +not found then a list of instruments +in the instrument directory is produced by paging the file "instruments.men". +The task then performs the following operations: +.ls (1) +If an instrument translation file with the name given by the instrument +ID and the extension ".dat" is found then the instrument translation +file parameter, \fIccdred.instrument\fR, is set to this file. +If it does not exist then the user is queried again. Note that a +null instrument, "", is allowed to set no translation file. +.le +.ls (2) +If an instrument setup script with the name given by the instrument ID +and the extension ".cl" is found then the commands in the file are +executed (using the command \fIcl < script\fR. This script generally +sets default parameters. +.le +.ls (3) +If the review flag is set the task \fBeparam\fR is run to allow the user +to examine and modify the parameters for the package \fBccdred\fR and task +\fBccdproc\fR. +.le +.ih +EXAMPLES +1. To get a list of the instruments; + +.nf + cl> setinstrument ? + [List of instruments] + +2. To set the instrument and edit the processing parameters: + + cl> setinstrument ccdlink + [Edit CCDRED parameters] + [Edit CCDPROC parameters] + +3. To use your own instrument translation file and/or setup script in +your working directory. + + cl> setinst.site="" + cl> setinst.dir="" + cl> setinst myinstrument + +To make these files see help under \fBinstruments\fR. Copying and modifying +system files is also straightforward. + + cl> copy ccddb$kpno/fits.dat . + cl> edit fits.dat + cl> setinst.site="" + cl> setinst.dir="" + cl> setinst fits +.fi +.ih +SEE ALSO +instruments, ccdred, ccdproc +.endhelp diff --git a/noao/imred/ccdred/doc/subsets.hlp b/noao/imred/ccdred/doc/subsets.hlp new file mode 100644 index 00000000..78aafb01 --- /dev/null +++ b/noao/imred/ccdred/doc/subsets.hlp @@ -0,0 +1,99 @@ +.help subsets Jun87 noao.imred.ccdred +.ih +NAME +subsets -- Description of CCD subsets +.ih +DESCRIPTION +The \fBccdred\fR package groups observation into subsets. +The image header parameter used to identify the subsets is defined +in the instrument translation file (see help for \fBinstruments\fR). +For example to select subsets by the header parameter "filters" the +instrument translation file would contain the line: + + subset filters + +Observations are generally grouped into subsets based on a common +instrument configuration such as a filter, aperture mask, +grating setting, etc. This allows combining images from several +different subsets automatically and applying the appropriate +flat field image when processing the observations. For example +if the subsets are by filter then \fBflatcombine\fR will search +through all the images, find the flat field images (based on the +CCD type parameter), and combine the flat field images from +each filter separately. Then when processing the images the +flat field with the same filter as the observation is used. + +Each subset is assigned a short identifier. This is listed when +using \fBccdlist\fR and is appended to a root name when combining +images. Because the subset parameter in the image header may be +any string there must be a mapping applied to generate unique +identifiers. This mapping is defined in the file given by +the package parameter \fIccdred.ssfile\fR. The file consists of +lines with two fields (except that comment lines may be included +as a line by itself or following the second field): + + 'subset string' subset_id + +where the subset string is the image header string and the subset_id is +the identifier. A field must be quoted if it contains blanks. The +user may create this file but generally it is created by the tasks. The +tasks use the first word of the subset string as the default identifier +and a number is appended if the first word is not unique. The +following steps define the subset identifier: + +.ls (1) +Search the subset file, if present, for a matching subset string and +use the defined subset identifier. +.le +.ls (2) +If there is no matching subset string use the first word of the +image header subset string and, if it is not unique, +add successive integers until it is unique. +.le +.ls (3) +If the identifier is not in the subset file create the file and add an +entry if necessary. +.le +.ih +EXAMPLES +1. The subset file is "subsets" (the default). The subset parameter is +translated to "f1pos" in the image header (the old NOAO CCD parameter) +which is an integer filter position. After running a task, say +"ccdlist *.imh" to cause all filters to be checked, the subset file contains: + +.nf + '2' 2 + '5' 5 + '3' 3 +.fi + +The order reflects the order in which the filters were encountered. +Suppose the user wants to have more descriptive names then the subset +file can be created or edited to the form: + +.nf + # Sample translation file. + '2' U + '3' B + '4' V +.fi + +(This is only an example and does not mean these are standard filters.) + +2. As another example suppose the image header parameter is "filter" and +contains more descriptive strings. The subset file might become: + +.nf + 'GG 385 Filter' GG + 'GG 495 Filter' GG1 + 'RG 610 Filter' RG + 'H-ALPHA' H_ALPHA +.fi + +In this case use of the first word was not very good but it is unique. +It is better if the filters are encoded with the thought that the first +word will be used by \fBccdred\fR; it should be short and unique. +.ih +SEE ALSO +instruments +.endhelp diff --git a/noao/imred/ccdred/doc/zerocombine.hlp b/noao/imred/ccdred/doc/zerocombine.hlp new file mode 100644 index 00000000..1646ea9c --- /dev/null +++ b/noao/imred/ccdred/doc/zerocombine.hlp @@ -0,0 +1,121 @@ +.help zerocombine Aug91 noao.imred.ccdred +.ih +NAME +zerocombine -- Combine and process zero level images +.ih +USAGE +zerocombine input +.ih +PARAMETERS +.ls input +List of zero level images to combine. The \fIccdtype\fR parameter +may be used to select the zero level images from a list containing all +types of data. +.le +.ls output = "Zero" +Output zero level root image name. +.le +.ls combine = "average" (average|median) +Type of combining operation performed on the final set of pixels (after +rejection). The choices are +"average" or "median". The median uses the average of the two central +values when the number of pixels is even. +.le +.ls reject = "minmax" (none|minmax|ccdclip|crreject|sigclip|avsigclip|pclip) +Type of rejection operation. See \fBcombine\fR for details. +.le +.ls ccdtype = "zero" +CCD image type to combine. If no image type is given then all input images +are combined. +.le +.ls process = no +Process the input images before combining? +.le +.ls delete = no +Delete input images after combining? Only those images combined are deleted. +.le +.ls clobber = no +Clobber existing output images? +.le +.ls scale = "none" (none|mode|median|mean|exposure) +Multiplicative image scaling to be applied. The choices are none, scale +by the mode, median, or mean of the specified statistics section, or scale +by the exposure time given in the image header. +.le +.ls statsec = "" +Section of images to use in computing image statistics for scaling. +If no section is given then the entire region of the image is +sampled (for efficiency the images are sampled if they are big enough). +.le + +.ce +Algorithm Parameters +.ls nlow = 0, nhigh = 1 (minmax) +The number of low and high pixels to be rejected by the "minmax" algorithm. +.le +.ls nkeep = 1 +The minimum number of pixels to retain or the maximum number to reject +when using the clipping algorithms (ccdclip, crreject, sigclip, +avsigclip, or pclip). When given as a positive value this is the minimum +number to keep. When given as a negative value the absolute value is +the maximum number to reject. This is actually converted to a number +to keep by adding it to the number of images. +.le +.ls mclip = yes (ccdclip, crreject, sigclip, avsigcliip) +Use the median as the estimate for the true intensity rather than the +average with high and low values excluded in the "ccdclip", "crreject", +"sigclip", and "avsigclip" algorithms? The median is a better estimator +in the presence of data which one wants to reject than the average. +However, computing the median is slower than the average. +.le +.ls lsigma = 3., hsigma = 3. (ccdclip, crreject, sigclip, avsigclip, pclip) +Low and high sigma clipping factors for the "ccdclip", "crreject", "sigclip", +"avsigclip", and "pclip" algorithms. They multiply a "sigma" factor +produced by the algorithm to select a point below and above the average or +median value for rejecting pixels. The lower sigma is ignored for the +"crreject" algorithm. +.le +.ls rdnoise = "0.", gain = "1.", snoise = "0." (ccdclip, crreject) +CCD readout noise in electrons, gain in electrons/DN, and sensitivity noise +as a fraction. These parameters are used with the "ccdclip" and "crreject" +algorithms. The values may be either numeric or an image header keyword +which contains the value. +.le +.ls pclip = -0.5 (pclip) +Percentile clipping algorithm parameter. If greater than +one in absolute value then it specifies a number of pixels above or +below the median to use for computing the clipping sigma. If less +than one in absolute value then it specifies the fraction of the pixels +above or below the median to use. A positive value selects a point +above the median and a negative value selects a point below the median. +The default of -0.5 selects approximately the quartile point. +See \fBcombine\fR for further details. +.le +.ls blank = 0. +Output value to be used when there are no pixels. +.le +.ih +DESCRIPTION +The zero level images in the input image list are combined. +The input images may be processed first if desired. +The original images may be deleted automatically if desired. +The output pixel datatype will be real. + +This task is a script which applies \fBccdproc\fR and \fBcombine\fR. The +parameters and combining algorithms are described in detail in the help for +\fBcombine\fR. This script has default parameters specifically set for +zero level images and simplifies the combining parameters. There are other +combining options not included in this task. For these additional +features, such as thresholding, offseting, masking, and projecting, use +\fBcombine\fR. +.ih +EXAMPLES +1. The image data contains four zero level images. +To automatically select them and combine them as a background job +using the default combining algorithm: + + cl> zerocombine ccd*.imh& +.ih +SEE ALSO +ccdproc, combine +.endhelp diff --git a/noao/imred/ccdred/flatcombine.cl b/noao/imred/ccdred/flatcombine.cl new file mode 100644 index 00000000..78bd1e80 --- /dev/null +++ b/noao/imred/ccdred/flatcombine.cl @@ -0,0 +1,49 @@ +# FLATCOMBINE -- Process and combine flat field CCD images. + +procedure flatcombine (input) + +string input {prompt="List of flat field images to combine"} +file output="Flat" {prompt="Output flat field root name"} +string combine="average" {prompt="Type of combine operation", + enum="average|median"} +string reject="avsigclip" {prompt="Type of rejection", + enum="none|minmax|ccdclip|crreject|sigclip|avsigclip|pclip"} +string ccdtype="flat" {prompt="CCD image type to combine"} +bool process=yes {prompt="Process images before combining?"} +bool subsets=yes {prompt="Combine images by subset parameter?"} +bool delete=no {prompt="Delete input images after combining?"} +bool clobber=no {prompt="Clobber existing output image?"} +string scale="mode" {prompt="Image scaling", + enum="none|mode|median|mean|exposure"} +string statsec="" {prompt="Image section for computing statistics"} +int nlow=1 {prompt="minmax: Number of low pixels to reject"} +int nhigh=1 {prompt="minmax: Number of high pixels to reject"} +int nkeep=1 {prompt="Minimum to keep (pos) or maximum to reject (neg)"} +bool mclip=yes {prompt="Use median in sigma clipping algorithms?"} +real lsigma=3. {prompt="Lower sigma clipping factor"} +real hsigma=3. {prompt="Upper sigma clipping factor"} +string rdnoise="0." {prompt="ccdclip: CCD readout noise (electrons)"} +string gain="1." {prompt="ccdclip: CCD gain (electrons/DN)"} +string snoise="0." {prompt="ccdclip: Sensitivity noise (fraction)"} +real pclip=-0.5 {prompt="pclip: Percentile clipping parameter"} +real blank=1. {prompt="Value if there are no pixels"} + +begin + string ims + + ims = input + + # Process images first if desired. + if (process == YES) + ccdproc (ims, output="", ccdtype=ccdtype, noproc=no) + + # Combine the flat field images. + combine (ims, output=output, plfile="", sigma="", combine=combine, + reject=reject, ccdtype=ccdtype, subsets=subsets, delete=delete, + clobber=clobber, project=no, outtype="real", offsets="none", + masktype="none", blank=blank, scale=scale, zero="none", weight=no, + statsec=statsec, lthreshold=INDEF, hthreshold=INDEF, nlow=nlow, + nhigh=nhigh, nkeep=nkeep, mclip=mclip, lsigma=lsigma, hsigma=hsigma, + rdnoise=rdnoise, gain=gain, snoise=snoise, sigscale=0.1, + pclip=pclip, grow=0) +end diff --git a/noao/imred/ccdred/mkfringecor.par b/noao/imred/ccdred/mkfringecor.par new file mode 100644 index 00000000..c088fe8b --- /dev/null +++ b/noao/imred/ccdred/mkfringecor.par @@ -0,0 +1,11 @@ +input,s,a,,,,Input CCD images +output,s,h,"",,,Output fringe images (same as input if none given) +ccdtype,s,h,"",,,CCD image type to select +xboxmin,r,h,5,0.,,Minimum smoothing box size in x at edges +xboxmax,r,h,0.25,0.,,Maximum smoothing box size in x +yboxmin,r,h,5,0.,,Minimum moothing box size in y at edges +yboxmax,r,h,0.25,0.,,Maximum moothing box size in y +clip,b,h,yes,,,Clip input pixels? +lowsigma,r,h,2.5,0.,,Low clipping sigma +highsigma,r,h,2.5,0.,,High clipping sigma +ccdproc,pset,h,,,,CCD processing parameters diff --git a/noao/imred/ccdred/mkillumcor.par b/noao/imred/ccdred/mkillumcor.par new file mode 100644 index 00000000..cda8eb54 --- /dev/null +++ b/noao/imred/ccdred/mkillumcor.par @@ -0,0 +1,12 @@ +input,s,a,,,,Input CCD images +output,s,a,,,,Output images (same as input if none given) +ccdtype,s,h,"flat",,,CCD image type to select +xboxmin,r,h,5,0.,,Minimum smoothing box size in x at edges +xboxmax,r,h,0.25,0.,,Maximum smoothing box size in x +yboxmin,r,h,5,0.,,Minimum smoothing box size in y at edges +yboxmax,r,h,0.25,0.,,Maximum smoothing box size in y +clip,b,h,yes,,,Clip input pixels? +lowsigma,r,h,2.5,0.,,Low clipping sigma +highsigma,r,h,2.5,0.,,High clipping sigma +divbyzero,r,h,1.,,,Result for division by zero +ccdproc,pset,h,,,,CCD processing parameters diff --git a/noao/imred/ccdred/mkillumflat.par b/noao/imred/ccdred/mkillumflat.par new file mode 100644 index 00000000..67897f46 --- /dev/null +++ b/noao/imred/ccdred/mkillumflat.par @@ -0,0 +1,12 @@ +input,s,a,,,,Input CCD flat field images +output,s,a,,,,Output images (same as input if none given) +ccdtype,s,h,"flat",,,CCD image type to select +xboxmin,r,h,5,0.,,Minimum smoothing box size in x at edges +xboxmax,r,h,0.25,0.,,Maximum smoothing box size in x +yboxmin,r,h,5,0.,,Minimum moothing box size in y at edges +yboxmax,r,h,0.25,0.,,Maximum moothing box size in y +clip,b,h,yes,,,Clip input pixels? +lowsigma,r,h,2.5,0.,,Low clipping sigma +highsigma,r,h,2.5,0.,,High clipping sigma +divbyzero,r,h,1.,,,Result for division by zero +ccdproc,pset,h,,,,CCD processing parameters diff --git a/noao/imred/ccdred/mkpkg b/noao/imred/ccdred/mkpkg new file mode 100644 index 00000000..dab87bc3 --- /dev/null +++ b/noao/imred/ccdred/mkpkg @@ -0,0 +1,29 @@ +# Make CCDRED Package. + +$call relink +$exit + +update: + $call relink + $call install + ; + +relink: + $update libpkg.a + $call ccdred + ; + +install: + $move xx_ccdred.e noaobin$x_ccdred.e + ; + +ccdred: + $omake x_ccdred.x + $link x_ccdred.o libpkg.a -lxtools -lcurfit -lgsurfit -lncar -lgks\ + -o xx_ccdred.e + ; + +libpkg.a: + @src + @ccdtest + ; diff --git a/noao/imred/ccdred/mkskycor.par b/noao/imred/ccdred/mkskycor.par new file mode 100644 index 00000000..e719dfa0 --- /dev/null +++ b/noao/imred/ccdred/mkskycor.par @@ -0,0 +1,11 @@ +input,s,a,,,,Input CCD images +output,s,a,,,,Output images (same as input if none given) +ccdtype,s,h,"",,,CCD image type to select +xboxmin,r,h,5,0.,,Minimum smoothing box size in x at edges +xboxmax,r,h,0.25,0.,,Maximum smoothing box size in x +yboxmin,r,h,5,0.,,Minimum moothing box size in y at edges +yboxmax,r,h,0.25,0.,,Maximum moothing box size in y +clip,b,h,yes,,,Clip input pixels? +lowsigma,r,h,2.5,0.,,Low clipping sigma +highsigma,r,h,2.5,0.,,High clipping sigma +ccdproc,pset,h,,,,CCD processing parameters diff --git a/noao/imred/ccdred/mkskyflat.par b/noao/imred/ccdred/mkskyflat.par new file mode 100644 index 00000000..e719dfa0 --- /dev/null +++ b/noao/imred/ccdred/mkskyflat.par @@ -0,0 +1,11 @@ +input,s,a,,,,Input CCD images +output,s,a,,,,Output images (same as input if none given) +ccdtype,s,h,"",,,CCD image type to select +xboxmin,r,h,5,0.,,Minimum smoothing box size in x at edges +xboxmax,r,h,0.25,0.,,Maximum smoothing box size in x +yboxmin,r,h,5,0.,,Minimum moothing box size in y at edges +yboxmax,r,h,0.25,0.,,Maximum moothing box size in y +clip,b,h,yes,,,Clip input pixels? +lowsigma,r,h,2.5,0.,,Low clipping sigma +highsigma,r,h,2.5,0.,,High clipping sigma +ccdproc,pset,h,,,,CCD processing parameters diff --git a/noao/imred/ccdred/setinstrument.cl b/noao/imred/ccdred/setinstrument.cl new file mode 100644 index 00000000..c10a7427 --- /dev/null +++ b/noao/imred/ccdred/setinstrument.cl @@ -0,0 +1,57 @@ +# SETINSTRUMENT -- Set up instrument parameters for the CCD reduction tasks. +# +# This task sets default parameters based on an instrument ID. + +procedure setinstrument (instrument) + +char instrument {prompt="Instrument ID (type ? for a list)"} +char site="kpno" {prompt="Site ID"} +char directory="ccddb$" {prompt="Instrument directory"} +bool review=yes {prompt="Review instrument parameters?"} +char query {prompt="Instrument ID (type q to quit)", + mode="q"} + +begin + string inst, instdir, instmen, instfile + + # Define instrument directory, menu, and file + instdir = directory + if (site != "") + instdir = instdir // site // "/" + instmen = instdir // "instruments.men" + inst = instrument + instfile = instdir // inst // ".dat" + + # Loop until a valid instrument file is given. + while (inst != "" && !access (instfile)) { + if (access (instmen)) + page (instmen) + else if (inst == "?") + print ("Instrument list ", instmen, " not found") + else + print ("Instrument file ", instfile, " not found") + print ("") + inst = query + if (inst == "q") + return + instrument = inst + instfile = instdir // inst // ".dat" + } + + # Set instrument parameter. + if (access (instfile)) + ccdred.instrument = instfile + else + ccdred.instrument = "" + + # Run instrument setup script. + instfile = instdir // inst // ".cl" + if (access (instfile)) + cl (< instfile) + + # Review parameters if desired. + if (review) { + eparam ("ccdred") + eparam ("ccdproc") + } +end diff --git a/noao/imred/ccdred/skyreplace.par b/noao/imred/ccdred/skyreplace.par new file mode 100644 index 00000000..b611c30d --- /dev/null +++ b/noao/imred/ccdred/skyreplace.par @@ -0,0 +1,3 @@ +image,f,a,,,,Image to be modified +frame,i,h,1,,,Image display frame +cursor,*gcur,h,,,,Cursor diff --git a/noao/imred/ccdred/src/calimage.x b/noao/imred/ccdred/src/calimage.x new file mode 100644 index 00000000..82efdf54 --- /dev/null +++ b/noao/imred/ccdred/src/calimage.x @@ -0,0 +1,367 @@ +include <error.h> +include <imset.h> +include "ccdtypes.h" + +define SZ_SUBSET 16 # Maximum size of subset string +define IMAGE Memc[$1+($2-1)*SZ_FNAME] # Image string +define SUBSET Memc[$1+($2-1)*(SZ_SUBSET+1)] # Subset string + +# CAL_IMAGE -- Return a calibration image for a specified input image. +# CAL_OPEN -- Open the calibration image list. +# CAL_CLOSE -- Close the calibration image list. +# CAL_LIST -- Add images to the calibration image list. +# +# The open procedure is called first to get the calibration image +# lists and add them to an internal list. Calibration images from the +# input list are also added so that calibration images may be specified +# either from the calibration image list parameters or in the input image list. +# Existence errors and duplicate calibration images are ignored. +# Validity checks are made when the calibration images are requested. +# +# During processing the calibration image names are requested for each input +# image. The calibration image list is searched for a calibration image of +# the right type and subset. If more than one is found the first one is +# returned and a warning given for the others. The warning is only issued +# once. If no calibration image is found then an error is returned. +# +# The calibration image list must be closed at the end of processing the +# input images. + + +# CAL_IMAGE -- Return a calibration image of a particular type. +# Search the calibration list for the first calibration image of the desired +# type and subset. Print a warning if there is more than one possible +# calibration image and return an error if there is no calibration image. + +procedure cal_image (im, ccdtype, nscan, image, maxchars) + +pointer im # Image to be processed +int ccdtype # Callibration CCD image type desired +int nscan # Number of scan rows desired +char image[maxchars] # Calibration image (returned) +int maxchars # Maximum number chars in image name + +int i, m, n +pointer sp, subset, str +bool strne(), ccd_cmp() + +pointer ccdtypes # Pointer to array of calibration ccdtypes +pointer subsets # Pointer to array of calibration subsets +pointer nscans # Pointer to array of calibration nscan values +pointer images # Pointer to array of calibration image names +int nimages # Number of images +common /calib/ ccdtypes, subsets, nscans, images, nimages + +begin + call smark (sp) + call salloc (subset, SZ_SUBSET, TY_CHAR) + call salloc (str, SZ_LINE, TY_CHAR) + + m = 0 + n = 0 + switch (ccdtype) { + case ZERO, DARK: + do i = 1, nimages { + if (Memi[ccdtypes+i-1] != ccdtype) + next + n = n + 1 + if (n == 1) { + m = i + } else { + if (Memi[nscans+i-1] == Memi[nscans+m-1]) { +# call eprintf ( +# "Warning: Extra calibration image %s ignored\n") +# call pargstr (IMAGE(images,i)) + + # Reset the image type to eliminate further warnings. + Memi[ccdtypes+i-1] = UNKNOWN + } else if (Memi[nscans+m-1] != nscan && + (Memi[nscans+i-1] == nscan || + Memi[nscans+i-1] == 1)) { + m = i + } + } + } + case FLAT, ILLUM, FRINGE: + call ccdsubset (im, Memc[subset], SZ_SUBSET) + + do i = 1, nimages { + if (Memi[ccdtypes+i-1] != ccdtype) + next + if (strne (SUBSET(subsets,i), Memc[subset])) + next + n = n + 1 + if (n == 1) { + m = i + } else { + if (Memi[nscans+i-1] == Memi[nscans+m-1]) { +# call eprintf ( +# "Warning: Extra calibration image %s ignored\n") +# call pargstr (IMAGE(images,i)) + + # Reset the image type to eliminate further warnings. + Memi[ccdtypes+i-1] = UNKNOWN + } else if (Memi[nscans+m-1] != nscan && + (Memi[nscans+i-1] == nscan || + Memi[nscans+i-1] == 1)) { + m = i + } + } + } + } + + # If no calibration image is found then it is an error. + if (m == 0) { + switch (ccdtype) { + case ZERO: + call error (0, "No zero level calibration image found") + case DARK: + call error (0, "No dark count calibration image found") + case FLAT: + call sprintf (Memc[str], SZ_LINE, + "No flat field calibration image of subset %s found") + call pargstr (Memc[subset]) + call error (0, Memc[str]) + case ILLUM: + call sprintf (Memc[str], SZ_LINE, + "No illumination calibration image of subset %s found") + call pargstr (Memc[subset]) + call error (0, Memc[str]) + case FRINGE: + call sprintf (Memc[str], SZ_LINE, + "No fringe calibration image of subset %s found") + call pargstr (Memc[subset]) + call error (0, Memc[str]) + } + } + + call strcpy (IMAGE(images,m), image, maxchars) + if (nscan != Memi[nscans+m-1]) { + if (nscan != 1 && Memi[nscans+m-1] == 1) + call cal_scan (nscan, image, maxchars) + else { + call sprintf (Memc[str], SZ_LINE, + "Cannot find or create calibration with nscan of %d") + call pargi (nscan) + call error (0, Memc[str]) + } + } + + # Check that the input image is not the same as the calibration image. + call imstats (im, IM_IMAGENAME, Memc[str], SZ_LINE) + if (ccd_cmp (Memc[str], IMAGE(images,m))) { + call sprintf (Memc[str], SZ_LINE, + "Calibration image %s is the same as the input image") + call pargstr (image) + call error (0, Memc[str]) + } + + call sfree (sp) +end + + +# CAL_OPEN -- Create a list of calibration images from the input image list +# and the calibration image lists. + +procedure cal_open (list) + +int list # List of input images +int list1 # List of calibration images + +pointer sp, str +int ccdtype, strdic(), imtopenp() +bool clgetb() + +pointer ccdtypes # Pointer to array of calibration ccdtypes +pointer subsets # Pointer to array of calibration subset numbers +pointer nscans # Pointer to array of calibration nscan values +pointer images # Pointer to array of calibration image names +int nimages # Number of images +common /calib/ ccdtypes, subsets, nscans, images, nimages + +errchk cal_list + +begin + call smark (sp) + call salloc (str, SZ_LINE, TY_CHAR) + + call clgstr ("ccdtype", Memc[str], SZ_LINE) + call xt_stripwhite (Memc[str]) + if (Memc[str] == EOS) + ccdtype = NONE + else + ccdtype = strdic (Memc[str], Memc[str], SZ_LINE, CCDTYPES) + + # Add calibration images to list. + nimages = 0 + if (ccdtype != ZERO && clgetb ("zerocor")) { + list1 = imtopenp ("zero") + call cal_list (list1, ZERO) + call imtclose (list1) + } + if (ccdtype != ZERO && ccdtype != DARK && clgetb ("darkcor")) { + list1 = imtopenp ("dark") + call cal_list (list1, DARK) + call imtclose (list1) + } + if (ccdtype != ZERO && ccdtype != DARK && ccdtype != FLAT && + clgetb ("flatcor")) { + list1 = imtopenp ("flat") + call cal_list (list1, FLAT) + call imtclose (list1) + } + if (ccdtype != ZERO && ccdtype != DARK && ccdtype != FLAT && + ccdtype != ILLUM && clgetb ("illumcor")) { + list1 = imtopenp ("illum") + call cal_list (list1, ILLUM) + call imtclose (list1) + } + if (ccdtype != ZERO && ccdtype != DARK && ccdtype != FLAT && + ccdtype != FRINGE && clgetb ("fringecor")) { + list1 = imtopenp ("fringe") + call cal_list (list1, FRINGE) + call imtclose (list1) + } + if (list != NULL) { + call cal_list (list, UNKNOWN) + call imtrew (list) + } + + call sfree (sp) +end + + +# CAL_CLOSE -- Free memory from the internal calibration image list. + +procedure cal_close () + +pointer ccdtypes # Pointer to array of calibration ccdtypes +pointer subsets # Pointer to array of calibration subset +pointer nscans # Pointer to array of calibration nscan values +pointer images # Pointer to array of calibration image names +int nimages # Number of images +common /calib/ ccdtypes, subsets, nscans, images, nimages + +begin + if (nimages > 0) { + call mfree (ccdtypes, TY_INT) + call mfree (subsets, TY_CHAR) + call mfree (nscans, TY_INT) + call mfree (images, TY_CHAR) + } +end + + +# CAL_LIST -- Add calibration images to an internal list. +# Map each image and get the CCD image type and subset. +# If the ccdtype is given as a procedure argument this overrides the +# image header type. For the calibration images add the type, subset, +# and image name to dynamic arrays. Ignore duplicate names. + +procedure cal_list (list, listtype) + +pointer list # Image list +int listtype # CCD type of image in list. + # Overrides header type if not UNKNOWN. + +int i, ccdtype, ccdtypei(), ccdnscan(), imtgetim() +pointer sp, image, im, immap() +bool streq() + +pointer ccdtypes # Pointer to array of calibration ccdtypes +pointer subsets # Pointer to array of calibration subsets +pointer nscans # Pointer to array of calibration nscan values +pointer images # Pointer to array of calibration image names +int nimages # Number of images +common /calib/ ccdtypes, subsets, nscans, images, nimages + +begin + call smark (sp) + call salloc (image, SZ_FNAME, TY_CHAR) + + while (imtgetim (list, Memc[image], SZ_FNAME) != EOF) { + # Open the image. If an explicit type is given it is an + # error if the image can't be opened. + iferr (im = immap (Memc[image], READ_ONLY, 0)) { + if (listtype == UNKNOWN) + next + else + call erract (EA_ERROR) + } + + # Override image header CCD type if a list type is given. + if (listtype == UNKNOWN) + ccdtype = ccdtypei (im) + else + ccdtype = listtype + + switch (ccdtype) { + case ZERO, DARK, FLAT, ILLUM, FRINGE: + # Check for duplication. + for (i=1; i<=nimages; i=i+1) + if (streq (Memc[image], IMAGE(images,i))) + break + if (i <= nimages) + break + + # Allocate memory for a new image. + if (i == 1) { + call malloc (ccdtypes, i, TY_INT) + call malloc (subsets, i * (SZ_SUBSET+1), TY_CHAR) + call malloc (nscans, i, TY_INT) + call malloc (images, i * SZ_FNAME, TY_CHAR) + } else { + call realloc (ccdtypes, i, TY_INT) + call realloc (subsets, i * SZ_FNAME, TY_CHAR) + call realloc (nscans, i, TY_INT) + call realloc (images, i * SZ_FNAME, TY_CHAR) + } + + # Enter the ccdtype, subset, and image name. + Memi[ccdtypes+i-1] = ccdtype + Memi[nscans+i-1] = ccdnscan (im, ccdtype) + call ccdsubset (im, SUBSET(subsets,i), SZ_SUBSET) + call strcpy (Memc[image], IMAGE(images,i), SZ_FNAME-1) + nimages = i + } + call imunmap (im) + } + call sfree (sp) +end + + +# CAL_SCAN -- Generate name for scan corrected calibration image. + +procedure cal_scan (nscan, image, maxchar) + +int nscan #I Number of scan lines +char image[maxchar] #U Input root name, output scan name +int maxchar #I Maximum number of chars in image name + +bool clgetb() +pointer sp, root, ext + +begin + # Check if this operation is desired. + if (!clgetb ("scancor") || nscan == 1) + return + + call smark (sp) + call salloc (root, SZ_FNAME, TY_CHAR) + call salloc (ext, SZ_FNAME, TY_CHAR) + + call xt_imroot (image, Memc[root], SZ_FNAME) + call xt_imext (image, Memc[ext], SZ_FNAME) + if (IS_INDEFI (nscan)) { + call sprintf (image, maxchar, "%s.1d%s") + call pargstr (Memc[root]) + call pargstr (Memc[ext]) + } else { + call sprintf (image, maxchar, "%s.%d%s") + call pargstr (Memc[root]) + call pargi (nscan) + call pargstr (Memc[ext]) + } + + call sfree (sp) +end diff --git a/noao/imred/ccdred/src/ccdcache.com b/noao/imred/ccdred/src/ccdcache.com new file mode 100644 index 00000000..91ffae12 --- /dev/null +++ b/noao/imred/ccdred/src/ccdcache.com @@ -0,0 +1,10 @@ +# Common data defining the cached images and data. + +int ccd_ncache # Number of images cached +int ccd_maxcache # Maximum size of cache +int ccd_szcache # Current size of cache +int ccd_oldsize # Original memory size +int ccd_pcache # Pointer to image cache structures + +common /ccdcache_com/ ccd_ncache, ccd_maxcache, ccd_szcache, ccd_oldsize, + ccd_pcache diff --git a/noao/imred/ccdred/src/ccdcache.h b/noao/imred/ccdred/src/ccdcache.h new file mode 100644 index 00000000..f7de3a2c --- /dev/null +++ b/noao/imred/ccdred/src/ccdcache.h @@ -0,0 +1,10 @@ +# Definition for image cache structure. + +define CCD_LENCACHE 6 + +define CCD_IM Memi[$1] # IMIO pointer +define CCD_NACCESS Memi[$1+1] # Number of accesses requested +define CCD_SZDATA Memi[$1+2] # Size of data in cache in chars +define CCD_DATA Memi[$1+3] # Pointer to data cache +define CCD_BUFR Memi[$1+4] # Pointer to real image line +define CCD_BUFS Memi[$1+5] # Pointer to short image line diff --git a/noao/imred/ccdred/src/ccdcache.x b/noao/imred/ccdred/src/ccdcache.x new file mode 100644 index 00000000..78f84ace --- /dev/null +++ b/noao/imred/ccdred/src/ccdcache.x @@ -0,0 +1,381 @@ +include <imhdr.h> +include <imset.h> +include <mach.h> +include "ccdcache.h" + +.help ccdcache Jun87 +.nf --------------------------------------------------------------------- +The purpose of the CCD image caching package is to minimize image mapping +time, to prevent multiple mapping of the same image, and to keep entire +calibration images in memory for extended periods to minimize disk +I/O. It is selected by specifying a maximum caching size based on the +available memory. When there is not enough memory for caching (or by +setting the size to 0) then standard IMIO is used. When there is +enough memory then as many images as will fit into the specified cache +size are kept in memory. Images are also kept mapped until explicitly +flushed or the entire package is closed. + +This is a special purpose interface intended only for the CCDRED package. +It has the following restrictions. + + 1. Images must be processed to be cached. + 2. Images must be 2 dimensional to be cached + 3. Images must be real or short to be cached. + 4. Images must be read_only to be cached. + 5. Cached images remain in memory until they are displaced, + flushed, or the package is closed. + +The package consists of the following procedures. + + ccd_open () + im = ccd_cache (image) + ptr = ccd_glr (im, col1, col2, line) + ptr = ccd_gls (im, col1, col2, line) + ccd_unmap (im) + ccd_flush (im) + ccd_close () + + +CCD_OPEN: Initialize the image cache. Called at the beginning. +CCD_CLOSE: Flush the image cache and restore memory. Called at the end. + +CCD_CACHE: Open an image and save the IMIO pointer. If the image has been +opened previously it need not be opened again. If image data caching +is specified the image data may be read it into memory. In order for +image data caching to occur the the image has to have been processed, +be two dimensional, be real or short, and the total cache memory not +be exceeded. If an error occurs in reading the image into memory +the data is not cached. + +CCD_UNMAP: The image access number is decremented but the image +is not closed against the event it will be used again. + +CCD_FLUSH: The image is closed and flushed from the cache. + +CCD_GLR, CCD_GLS: Get a real or short image line. If the image data is cached +then a pointer to the line is quickly returned. If the data is not cached then +IMIO is used to get the pointer. +.endhelp --------------------------------------------------------------------- + + + +# CCD_CACHE -- Open an image and possibly cache it in memory. + +pointer procedure ccd_cache (image, ccdtype) + +char image[ARB] # Image to be opened +int ccdtype # Image type + +int i, nc, nl, nbytes +pointer sp, str, pcache, pcache1, im + +int sizeof() +pointer immap(), imgs2r(), imgs2s() +bool streq(), ccdcheck() +errchk immap, imgs2r, imgs2s + +include "ccdcache.com" + +define done_ 99 + +begin + call smark (sp) + call salloc (str, SZ_LINE, TY_CHAR) + + # Check if the image is cached. + for (i=1; i<=ccd_ncache; i=i+1) { + pcache = Memi[ccd_pcache+i-1] + im = CCD_IM(pcache) + call imstats (im, IM_IMAGENAME, Memc[str], SZ_LINE) + if (streq (image, Memc[str])) + break + } + + # If the image is not cached open it and allocate memory. + if (i > ccd_ncache) { + im = immap (image, READ_ONLY, 0) + ccd_ncache = i + call realloc (ccd_pcache, ccd_ncache, TY_INT) + call malloc (pcache, CCD_LENCACHE, TY_STRUCT) + Memi[ccd_pcache+i-1] = pcache + CCD_IM(pcache) = im + CCD_NACCESS(pcache) = 0 + CCD_SZDATA(pcache) = 0 + CCD_DATA(pcache) = NULL + CCD_BUFR(pcache) = NULL + CCD_BUFS(pcache) = NULL + } + + # If not caching the image data or if the image data has already + # been cached we are done. + if ((ccd_maxcache == 0) || (CCD_SZDATA(pcache) > 0)) + goto done_ + + # Don't cache unprocessed calibration image data. + # This is the only really CCDRED specific code. + if (ccdcheck (im, ccdtype)) + goto done_ + + # Check image is 2D and a supported pixel type. + if (IM_NDIM(im) != 2) + goto done_ + if ((IM_PIXTYPE(im) != TY_REAL) && (IM_PIXTYPE(im) !=TY_SHORT)) + goto done_ + + # Compute the size of the image data. + nc = IM_LEN(im,1) + nl = IM_LEN(im,2) + nbytes = nc * nl * sizeof (IM_PIXTYPE(im)) * SZB_CHAR + + # Free memory not in use. + if (ccd_szcache + nbytes > ccd_maxcache) { + for (i=1; i<=ccd_ncache; i=i+1) { + pcache1 = Memi[ccd_pcache+i-1] + if (CCD_NACCESS(pcache1) == 0) { + if (CCD_SZDATA(pcache1) > 0) { + ccd_szcache = ccd_szcache - CCD_SZDATA(pcache1) + CCD_SZDATA(pcache1) = 0 + CCD_DATA(pcache1) = NULL + call mfree (CCD_BUFR(pcache1), TY_REAL) + call mfree (CCD_BUFS(pcache1), TY_SHORT) + call imseti (CCD_IM(pcache1), IM_CANCEL, YES) + if (ccd_szcache + nbytes > ccd_maxcache) + break + } + } + } + } + if (ccd_szcache + nbytes > ccd_maxcache) + goto done_ + + # Cache the image data + iferr { + switch (IM_PIXTYPE (im)) { + case TY_SHORT: + CCD_DATA(pcache) = imgs2s (im, 1, nc, 1, nl) + case TY_REAL: + CCD_DATA(pcache) = imgs2r (im, 1, nc, 1, nl) + } + ccd_szcache = ccd_szcache + nbytes + CCD_SZDATA(pcache) = nbytes + } then { + call imunmap (im) + im = immap (image, READ_ONLY, 0) + CCD_IM(pcache) = im + CCD_SZDATA(pcache) = 0 + } + +done_ + CCD_NACCESS(pcache) = CCD_NACCESS(pcache) + 1 + call sfree (sp) + return (im) +end + + +# CCD_OPEN -- Initialize the CCD image cache. + +procedure ccd_open (max_cache) + +int max_cache # Maximum cache size in bytes + +int max_size, begmem() +include "ccdcache.com" + +begin + ccd_ncache = 0 + ccd_maxcache = max_cache + ccd_szcache = 0 + call malloc (ccd_pcache, 1, TY_INT) + + # Ask for the maximum physical memory. + if (ccd_maxcache > 0) { + ccd_oldsize = begmem (0, ccd_oldsize, max_size) + call fixmem (max_size) + } +end + + +# CCD_UNMAP -- Unmap an image. +# Don't actually unmap the image since it may be opened again. + +procedure ccd_unmap (im) + +pointer im # IMIO pointer + +int i +pointer pcache +include "ccdcache.com" + +begin + for (i=1; i<=ccd_ncache; i=i+1) { + pcache = Memi[ccd_pcache+i-1] + if (CCD_IM(pcache) == im) { + CCD_NACCESS(pcache) = CCD_NACCESS(pcache) - 1 + return + } + } + + call imunmap (im) +end + + +# CCD_FLUSH -- Close image and flush from cache. + +procedure ccd_flush (im) + +pointer im # IMIO pointer + +int i +pointer pcache +include "ccdcache.com" + +begin + for (i=1; i<=ccd_ncache; i=i+1) { + pcache = Memi[ccd_pcache+i-1] + if (CCD_IM(pcache) == im) { + ccd_ncache = ccd_ncache - 1 + ccd_szcache = ccd_szcache - CCD_SZDATA(pcache) + call mfree (CCD_BUFR(pcache), TY_REAL) + call mfree (CCD_BUFS(pcache), TY_SHORT) + call mfree (pcache, TY_STRUCT) + for (; i<=ccd_ncache; i=i+1) + Memi[ccd_pcache+i-1] = Memi[ccd_pcache+i] + break + } + } + + call imunmap (im) +end + + +# CCD_CLOSE -- Close the image cache. + +procedure ccd_close () + +int i +pointer pcache +include "ccdcache.com" + +begin + for (i=1; i<=ccd_ncache; i=i+1) { + pcache = Memi[ccd_pcache+i-1] + call imunmap (CCD_IM(pcache)) + call mfree (CCD_BUFR(pcache), TY_REAL) + call mfree (CCD_BUFS(pcache), TY_SHORT) + call mfree (pcache, TY_STRUCT) + } + call mfree (ccd_pcache, TY_INT) + + # Restore memory. + call fixmem (ccd_oldsize) +end + + +# CCD_GLR -- Get a line of real data from the image. +# If the image data is cached this is fast (particularly if the datatype +# matches). If the image data is not cached then use IMIO. + +pointer procedure ccd_glr (im, col1, col2, line) + +pointer im # IMIO pointer +int col1, col2 # Columns +int line # Line + +int i +pointer pcache, data, bufr, imgs2r() +errchk malloc +include "ccdcache.com" + +begin + # Quick test for cached data. + if (ccd_maxcache == 0) + return (imgs2r (im, col1, col2, line, line)) + + # Return cached data. + if (IM_PIXTYPE(im) == TY_REAL) { + for (i=1; i<=ccd_ncache; i=i+1) { + pcache = Memi[ccd_pcache+i-1] + if (CCD_IM(pcache) == im) { + if (CCD_SZDATA(pcache) > 0) + return (CCD_DATA(pcache)+(line-1)*IM_LEN(im,1)+col1-1) + else + break + } + } + } else { + for (i=1; i<=ccd_ncache; i=i+1) { + pcache = Memi[ccd_pcache+i-1] + if (CCD_IM(pcache) == im) { + if (CCD_SZDATA(pcache) > 0) { + data = CCD_DATA(pcache)+(line-1)*IM_LEN(im,1)+col1-1 + bufr = CCD_BUFR(pcache) + if (bufr == NULL) { + call malloc (bufr, IM_LEN(im,1), TY_REAL) + CCD_BUFR(pcache) = bufr + } + call achtsr (Mems[data], Memr[bufr], IM_LEN(im,1)) + return (bufr) + } else + break + } + } + } + + # Return uncached data. + return (imgs2r (im, col1, col2, line, line)) +end + + +# CCD_GLS -- Get a line of short data from the image. +# If the image data is cached this is fast (particularly if the datatype +# matches). If the image data is not cached then use IMIO. + +pointer procedure ccd_gls (im, col1, col2, line) + +pointer im # IMIO pointer +int col1, col2 # Columns +int line # Line + +int i +pointer pcache, data, bufs, imgs2s() +errchk malloc +include "ccdcache.com" + +begin + # Quick test for cached data. + if (ccd_maxcache == 0) + return (imgs2s (im, col1, col2, line, line)) + + # Return cached data. + if (IM_PIXTYPE(im) == TY_SHORT) { + for (i=1; i<=ccd_ncache; i=i+1) { + pcache = Memi[ccd_pcache+i-1] + if (CCD_IM(pcache) == im) { + if (CCD_SZDATA(pcache) > 0) + return (CCD_DATA(pcache)+(line-1)*IM_LEN(im,1)+col1-1) + else + break + } + } + } else { + for (i=1; i<=ccd_ncache; i=i+1) { + pcache = Memi[ccd_pcache+i-1] + if (CCD_IM(pcache) == im) { + if (CCD_SZDATA(pcache) > 0) { + data = CCD_DATA(pcache)+(line-1)*IM_LEN(im,1)+col1-1 + bufs = CCD_BUFS(pcache) + if (bufs == NULL) { + call malloc (bufs, IM_LEN(im,1), TY_SHORT) + CCD_BUFS(pcache) = bufs + } + call achtrs (Memr[data], Mems[bufs], IM_LEN(im,1)) + return (bufs) + } else + break + } + } + } + + # Return uncached data. + return (imgs2s (im, col1, col2, line, line)) +end diff --git a/noao/imred/ccdred/src/ccdcheck.x b/noao/imred/ccdred/src/ccdcheck.x new file mode 100644 index 00000000..0dde14f9 --- /dev/null +++ b/noao/imred/ccdred/src/ccdcheck.x @@ -0,0 +1,67 @@ +include <imhdr.h> +include "ccdtypes.h" + +# CCDCHECK -- Check processing status. + +bool procedure ccdcheck (im, ccdtype) + +pointer im # IMIO pointer +int ccdtype # CCD type + +real ccdmean, hdmgetr() +bool clgetb(), ccdflag() +long time +int hdmgeti() + +begin + if (clgetb ("trim") && !ccdflag (im, "trim")) + return (true) + if (clgetb ("fixpix") && !ccdflag (im, "fixpix")) + return (true) + if (clgetb ("overscan") && !ccdflag (im, "overscan")) + return (true) + + switch (ccdtype) { + case ZERO: + if (clgetb ("readcor") && !ccdflag (im, "readcor")) + return (true) + case DARK: + if (clgetb ("zerocor") && !ccdflag (im, "zerocor")) + return (true) + case FLAT: + if (clgetb ("zerocor") && !ccdflag (im, "zerocor")) + return (true) + if (clgetb ("darkcor") && !ccdflag (im, "darkcor")) + return (true) + if (clgetb ("scancor") && !ccdflag (im, "scancor")) + return (true) + iferr (ccdmean = hdmgetr (im, "ccdmean")) + return (true) + iferr (time = hdmgeti (im, "ccdmeant")) + time = IM_MTIME(im) + if (time < IM_MTIME(im)) + return (true) + case ILLUM: + if (clgetb ("zerocor") && !ccdflag (im, "zerocor")) + return (true) + if (clgetb ("darkcor") && !ccdflag (im, "darkcor")) + return (true) + if (clgetb ("flatcor") && !ccdflag (im, "flatcor")) + return (true) + iferr (ccdmean = hdmgetr (im, "ccdmean")) + return (true) + default: + if (clgetb ("zerocor") && !ccdflag (im, "zerocor")) + return (true) + if (clgetb ("darkcor") && !ccdflag (im, "darkcor")) + return (true) + if (clgetb ("flatcor") && !ccdflag (im, "flatcor")) + return (true) + if (clgetb ("illumcor") && !ccdflag (im, "illumcor")) + return (true) + if (clgetb ("fringecor") && !ccdflag (im, "fringcor")) + return (true) + } + + return (false) +end diff --git a/noao/imred/ccdred/src/ccdcmp.x b/noao/imred/ccdred/src/ccdcmp.x new file mode 100644 index 00000000..a2687934 --- /dev/null +++ b/noao/imred/ccdred/src/ccdcmp.x @@ -0,0 +1,23 @@ +# CCD_CMP -- Compare two image names with extensions ignored. + +bool procedure ccd_cmp (image1, image2) + +char image1[ARB] # First image +char image2[ARB] # Second image + +int i, j, strmatch(), strlen(), strncmp() +bool streq() + +begin + if (streq (image1, image2)) + return (true) + + i = max (strmatch (image1, ".imh"), strmatch (image1, ".hhh")) + if (i == 0) + i = strlen (image1) + j = max (strmatch (image2, ".imh"), strmatch (image2, ".hhh")) + if (j == 0) + j = strlen (image2) + + return (strncmp (image1, image2, max (i, j)) == 0) +end diff --git a/noao/imred/ccdred/src/ccdcopy.x b/noao/imred/ccdred/src/ccdcopy.x new file mode 100644 index 00000000..a12b2123 --- /dev/null +++ b/noao/imred/ccdred/src/ccdcopy.x @@ -0,0 +1,31 @@ +include <imhdr.h> + +# CCDCOPY -- Copy an image. This should be done with an IMIO procedure +# but there isn't one yet. + +procedure ccdcopy (old, new) + +char old[ARB] # Image to be copied +char new[ARB] # New copy + +int i, nc, nl +pointer in, out, immap(), imgl2s(), impl2s(), imgl2r(), impl2r() + +begin + in = immap (old, READ_ONLY, 0) + out = immap (new, NEW_COPY, in) + + nc = IM_LEN(in,1) + nl = IM_LEN(in,2) + switch (IM_PIXTYPE(in)) { + case TY_SHORT: + do i = 1, nl + call amovs (Mems[imgl2s(in,i)], Mems[impl2s(out,i)], nc) + default: + do i = 1, nl + call amovr (Memr[imgl2r(in,i)], Memr[impl2r(out,i)], nc) + } + + call imunmap (in) + call imunmap (out) +end diff --git a/noao/imred/ccdred/src/ccddelete.x b/noao/imred/ccdred/src/ccddelete.x new file mode 100644 index 00000000..90931135 --- /dev/null +++ b/noao/imred/ccdred/src/ccddelete.x @@ -0,0 +1,55 @@ +# CCDDELETE -- Delete an image by renaming it to a backup image. +# +# 1. Get the backup prefix which may be a path name. +# 2. If no prefix is specified then delete the image without a backup. +# 3. If there is a prefix then make a backup image name. +# Rename the image to the backup image name. +# +# The backup image name is formed by prepending the backup prefix to the +# image name. If a previous backup exist append integers to the backup +# prefix until a nonexistant image name is created. + +procedure ccddelete (image) + +char image[ARB] # Image to delete (backup) + +int i, imaccess() +pointer sp, prefix, backup +errchk imdelete, imrename + +begin + call smark (sp) + call salloc (prefix, SZ_FNAME, TY_CHAR) + call salloc (backup, SZ_FNAME, TY_CHAR) + + # Get the backup prefix. + call clgstr ("backup", Memc[prefix], SZ_FNAME) + call xt_stripwhite (Memc[prefix]) + + # If there is no prefix then simply delete the image. + if (Memc[prefix] == EOS) + call imdelete (image) + + # Otherwise create a backup image name which does not exist and + # rename the image to the backup image. + + else { + i = 0 + repeat { + if (i == 0) { + call sprintf (Memc[backup], SZ_FNAME, "%s%s") + call pargstr (Memc[prefix]) + call pargstr (image) + } else { + call sprintf (Memc[backup], SZ_FNAME, "%s%d%s") + call pargstr (Memc[prefix]) + call pargi (i) + call pargstr (image) + } + i = i + 1 + } until (imaccess (Memc[backup], READ_ONLY) == NO) + call imrename (image, Memc[backup]) + } + + call sfree (sp) +end diff --git a/noao/imred/ccdred/src/ccdflag.x b/noao/imred/ccdred/src/ccdflag.x new file mode 100644 index 00000000..427365d2 --- /dev/null +++ b/noao/imred/ccdred/src/ccdflag.x @@ -0,0 +1,27 @@ +# CCDFLAG -- Determine if a CCD processing flag is set. This is less than +# obvious because of the need to use the default value to indicate a +# false flag. + +bool procedure ccdflag (im, name) + +pointer im # IMIO pointer +char name[ARB] # CCD flag name + +bool flag, strne() +pointer sp, str1, str2 + +begin + call smark (sp) + call salloc (str1, SZ_LINE, TY_CHAR) + call salloc (str2, SZ_LINE, TY_CHAR) + + # Get the flag string value and the default value. + # The flag is true if the value and the default do not match. + + call hdmgstr (im, name, Memc[str1], SZ_LINE) + call hdmgdef (name, Memc[str2], SZ_LINE) + flag = strne (Memc[str1], Memc[str2]) + + call sfree (sp) + return (flag) +end diff --git a/noao/imred/ccdred/src/ccdinst1.key b/noao/imred/ccdred/src/ccdinst1.key new file mode 100644 index 00000000..2a3ef1d4 --- /dev/null +++ b/noao/imred/ccdred/src/ccdinst1.key @@ -0,0 +1,27 @@ + CCDINSTRUMENT COMMANDS + +? Print command summary +help Print command summary +imheader Page image header +instrument Print current instrument translation file +next Next image +newimage Select a new image +quit Quit +read Read instrument translation file +show Show current translations +write Write instrument translation file + +translate Translate image string selected by the imagetyp parameter + to one of the CCDRED types given as an argument or queried: + object, zero, dark, flat, comp, illum, fringe, other + +The following are CCDRED parameters which may be translated. You are +queried for the image keyword to use or it may be typed after the command. +An optional default value (returned if the image does not contain the +keyword) may be typed as the second argument of the command. + + BASIC PARAMETERS +imagetyp Image type parameter (see also translate) +subset Subset or filter parameter +exptime Exposure time +darktime Dark time (may be same as the exposure time) diff --git a/noao/imred/ccdred/src/ccdinst2.key b/noao/imred/ccdred/src/ccdinst2.key new file mode 100644 index 00000000..bd909433 --- /dev/null +++ b/noao/imred/ccdred/src/ccdinst2.key @@ -0,0 +1,39 @@ + CCDINSTRUMENT COMMANDS + +? Print command summary +help Print command summary +imheader Page image header +instrument Print current instrument translation file +next Next image +newimage Select a new image +quit Quit +read Read instrument translation file +show Show current translations +write Write instrument translation file + +translate Translate image string selected by the imagetyp parameter + to one of the CCDRED types given as an argument or queried: + object, zero, dark, flat, comp, illum, fringe, other + +The following are CCDRED parameters which may be translated. You are +queried for the image keyword to use or it may be typed after the command. +An optional default value (returned if the image does not contain the +keyword) may be typed as the second argument of the command. + + BASIC PARAMETERS +imagetyp Image type parameter (see also translate) +subset Subset or filter parameter +exptime Exposure time +darktime Dark time (may be same as the exposure time) + + USEFUL DEFAULT GEOMETRY PARAMETERS +biassec Bias section (often has a default value) +trimsec Trim section (often has a default value) + + COMMON PROCESSING FLAGS +fixpix Bad pixel replacement flag +overscan Overscan correction flag +trim Trim flag +zerocor Zero level correction flag +darkcor Dark count correction flag +flatcor Flat field correction flag diff --git a/noao/imred/ccdred/src/ccdinst3.key b/noao/imred/ccdred/src/ccdinst3.key new file mode 100644 index 00000000..7215aa67 --- /dev/null +++ b/noao/imred/ccdred/src/ccdinst3.key @@ -0,0 +1,62 @@ + CCDINSTRUMENT COMMANDS + +? Print command summary +help Print command summary +imheader Page image header +instrument Print current instrument translation file +next Next image +newimage Select a new image +quit Quit +read Read instrument translation file +show Show current translations +write Write instrument translation file + +translate Translate image string selected by the imagetyp parameter + to one of the CCDRED types given as an argument or queried: + object, zero, dark, flat, comp, illum, fringe, other + +The following are CCDRED parameters which may be translated. You are +queried for the image keyword to use or it may be typed after the command. +An optional default value (returned if the image does not contain the +keyword) may be typed as the second argument of the command. + + BASIC PARAMETERS +imagetyp Image type parameter (see also translate) +subset Subset or filter parameter +exptime Exposure time +darktime Dark time (may be same as the exposure time) + + USEFUL DEFAULT GEOMETRY PARAMETERS +biassec Bias section (often has a default value) +trimsec Trim section (often has a default value) + + COMMON PROCESSING FLAGS +fixpix Bad pixel replacement flag +overscan Overscan correction flag +trim Trim flag +zerocor Zero level correction flag +darkcor Dark count correction flag +flatcor Flat field correction flag + + RARELY TRANSLATED PARAMETERS +ccdsec CCD section +datasec Data section +fixfile Bad pixel file + +fringcor Fringe correction flag +illumcor Ilumination correction flag +readcor One dimensional zero level read out correction flag +scancor Scan mode correction flag + +illumflt Ilumination flat image +mkfringe Fringe image +mkillum Illumination image +skyflat Sky flat image + +ccdmean Mean value +fringscl Fringe scale factor +ncombine Number of images combined +date-obs Date of observations +dec Declination +ra Right Ascension +title Image title diff --git a/noao/imred/ccdred/src/ccdlog.x b/noao/imred/ccdred/src/ccdlog.x new file mode 100644 index 00000000..48453704 --- /dev/null +++ b/noao/imred/ccdred/src/ccdlog.x @@ -0,0 +1,46 @@ +include <imhdr.h> +include <imset.h> + +# CCDLOG -- Log information about the processing with the image name. +# +# 1. If the package "verbose" parameter is set print the string preceded +# by the image name. +# 2. If the package "logfile" parameter is not null append the string, +# preceded by the image name, to the file. + +procedure ccdlog (im, str) + +pointer im # IMIO pointer +char str[ARB] # Log string + +int fd, open() +bool clgetb() +pointer sp, fname +errchk open + +begin + call smark (sp) + call salloc (fname, SZ_FNAME, TY_CHAR) + + # Write to the standard error output if "verbose". + if (clgetb ("verbose")) { + call imstats (im, IM_IMAGENAME, Memc[fname], SZ_FNAME) + call eprintf ("%s: %s\n") + call pargstr (Memc[fname]) + call pargstr (str) + } + + # Append to the "logfile" if not null. + call clgstr ("logfile", Memc[fname], SZ_FNAME) + call xt_stripwhite (Memc[fname]) + if (Memc[fname] != EOS) { + fd = open (Memc[fname], APPEND, TEXT_FILE) + call imstats (im, IM_IMAGENAME, Memc[fname], SZ_FNAME) + call fprintf (fd, "%s: %s\n") + call pargstr (Memc[fname]) + call pargstr (str) + call close (fd) + } + + call sfree (sp) +end diff --git a/noao/imred/ccdred/src/ccdmean.x b/noao/imred/ccdred/src/ccdmean.x new file mode 100644 index 00000000..d38ea97b --- /dev/null +++ b/noao/imred/ccdred/src/ccdmean.x @@ -0,0 +1,50 @@ +include <imhdr.h> + + +# CCDMEAN -- Compute mean and add to header if needed. + +procedure ccdmean (input) + +char input[ARB] # Input image + +int i, nc, nl, hdmgeti() +long time, clktime() +bool clgetb() +real mean, hdmgetr(), asumr() +pointer in, immap(), imgl2r() +errchk immap + +begin + # Check if this operation has been done. + + in = immap (input, READ_WRITE, 0) + ifnoerr (mean = hdmgetr (in, "ccdmean")) { + iferr (time = hdmgeti (in, "ccdmeant")) + time = IM_MTIME(in) + if (time >= IM_MTIME(in)) { + call imunmap (in) + return + } + } + + if (clgetb ("noproc")) { + call eprintf ( + " [TO BE DONE] Compute mean of image\n") + call pargstr (input) + call imunmap (in) + return + } + + # Compute and record the mean. + nc = IM_LEN(in,1) + nl = IM_LEN(in,2) + mean = 0. + do i = 1, nl + mean = mean + asumr (Memr[imgl2r(in,i)], nc) + mean = mean / (nc * nl) + time = clktime (long(0)) + call hdmputr (in, "ccdmean", mean) + call hdmputi (in, "ccdmeant", int (time)) + + call imunmap (in) +end diff --git a/noao/imred/ccdred/src/ccdnscan.x b/noao/imred/ccdred/src/ccdnscan.x new file mode 100644 index 00000000..3a9fbeba --- /dev/null +++ b/noao/imred/ccdred/src/ccdnscan.x @@ -0,0 +1,38 @@ +include "ccdtypes.h" + + +# CCDNSCAN -- Return the number CCD scan rows. +# +# If not found in the header return the "nscan" parameter for objects and +# 1 for calibration images. + +int procedure ccdnscan (im, ccdtype) + +pointer im #I Image +int ccdtype #I CCD type +int nscan #O Number of scan lines + +bool clgetb() +char type, clgetc() +int hdmgeti(), clgeti() + +begin + iferr (nscan = hdmgeti (im, "nscanrow")) { + switch (ccdtype) { + case ZERO, DARK, FLAT, ILLUM, FRINGE: + nscan = 1 + default: + type = clgetc ("scantype") + if (type == 's') + nscan = clgeti ("nscan") + else { + if (clgetb ("scancor")) + nscan = INDEFI + else + nscan = 1 + } + } + } + + return (nscan) +end diff --git a/noao/imred/ccdred/src/ccdproc.x b/noao/imred/ccdred/src/ccdproc.x new file mode 100644 index 00000000..1b2a133c --- /dev/null +++ b/noao/imred/ccdred/src/ccdproc.x @@ -0,0 +1,106 @@ +include <error.h> +include "ccdred.h" +include "ccdtypes.h" + +# CCDPROC -- Process a CCD image of a specified CCD image type. +# +# The input image is corrected for bad pixels, overscan levels, zero +# levels, dark counts, flat field, illumination, and fringing. It may also +# be trimmed. The checking of whether to apply each correction, getting the +# required parameters, and logging the operations is left to separate +# procedures, one for each correction. The actual processing is done by +# a specialized procedure designed to be very efficient. These +# procedures may also process calibration images if necessary. +# The specified image type overrides the image type in the image header. +# There are two data type paths; one for short data types and one for +# all other data types (usually real). + +procedure ccdproc (input, ccdtype) + +char input[ARB] # CCD image to process +int ccdtype # CCD type of image (independent of header). + +pointer sp, output, str, in, out, ccd, immap() +errchk immap, set_output, ccddelete +errchk set_fixpix, set_zero, set_dark, set_flat, set_illum, set_fringe + +begin + call smark (sp) + call salloc (output, SZ_FNAME, TY_CHAR) + call salloc (str, SZ_LINE, TY_CHAR) + + # Map the image, make a working output image and set the processing + # parameters. + + in = immap (input, READ_ONLY, 0) + call mktemp ("tmp", Memc[output], SZ_FNAME) + call set_output (in, out, Memc[output]) + call set_proc (in, out, ccd) + call set_sections (ccd) + call set_trim (ccd) + call set_fixpix (ccd) + call set_overscan (ccd) + + # Set processing appropriate for the various image types. + switch (ccdtype) { + case ZERO: + case DARK: + call set_zero (ccd) + case FLAT: + call set_zero (ccd) + call set_dark (ccd) + CORS(ccd, FINDMEAN) = YES + CORS(ccd, MINREP) = YES + case ILLUM: + call set_zero (ccd) + call set_dark (ccd) + call set_flat (ccd) + case OBJECT, COMP: + call set_zero (ccd) + call set_dark (ccd) + call set_flat (ccd) + call set_illum (ccd) + call set_fringe (ccd) + default: + call set_zero (ccd) + call set_dark (ccd) + call set_flat (ccd) + call set_illum (ccd) + call set_fringe (ccd) + CORS(ccd, FINDMEAN) = YES + } + + # Do the processing if the COR flag is set. + if (COR(ccd) == YES) { + call doproc (ccd) + call set_header (ccd) + + # Replace the input by the output image. + call imunmap (in) + call imunmap (out) + iferr (call ccddelete (input)) { + call imdelete (Memc[output]) + call error (1, + "Can't delete or make backup of original image") + } + call imrename (Memc[output], input) + } else { + # Delete the temporary output image leaving the input unchanged. + call imunmap (in) + iferr (call imunmap (out)) + ; + iferr (call imdelete (Memc[output])) + ; + } + call free_proc (ccd) + + # Do special processing for calibration images. + switch (ccdtype) { + case ZERO: + call readcor (input) + case FLAT: + call ccdmean (input) + } + + call sfree (sp) +end diff --git a/noao/imred/ccdred/src/ccdred.h b/noao/imred/ccdred/src/ccdred.h new file mode 100644 index 00000000..2d370d86 --- /dev/null +++ b/noao/imred/ccdred/src/ccdred.h @@ -0,0 +1,150 @@ +# CCDRED Data Structures and Definitions + +# The CCD structure: This structure is used to communicate processing +# parameters between the package procedures. It contains pointers to +# data, calibration image IMIO pointers, scaling parameters, and the +# correction flags. The corrections flags indicate which processing +# operations are to be performed. The subsection parameters do not +# include a step size. A step size is assumed. If arbitrary subsampling +# is desired this would be the next generalization. + +define LEN_CCD 131 # Length of CCD structure + +# CCD data coordinates +define CCD_C1 Memi[$1] # CCD starting column +define CCD_C2 Memi[$1+1] # CCD ending column +define CCD_L1 Memi[$1+2] # CCD starting line +define CCD_L2 Memi[$1+3] # CCD ending line + +# Input data +define IN_IM Memi[$1+10] # Input image pointer +define IN_C1 Memi[$1+11] # Input data starting column +define IN_C2 Memi[$1+12] # Input data ending column +define IN_L1 Memi[$1+13] # Input data starting line +define IN_L2 Memi[$1+14] # Input data ending line + +# Output data +define OUT_IM Memi[$1+20] # Output image pointer +define OUT_C1 Memi[$1+21] # Output data starting column +define OUT_C2 Memi[$1+22] # Output data ending column +define OUT_L1 Memi[$1+23] # Output data starting line +define OUT_L2 Memi[$1+24] # Output data ending line + +# Mask data +define MASK_IM Memi[$1+30] # Mask image pointer +define MASK_C1 Memi[$1+31] # Mask data starting column +define MASK_C2 Memi[$1+32] # Mask data ending column +define MASK_L1 Memi[$1+33] # Mask data starting line +define MASK_L2 Memi[$1+34] # Mask data ending line +define MASK_PM Memi[$1+35] # Mask pointer +define MASK_FP Memi[$1+36] # Mask fixpix data + +# Zero level data +define ZERO_IM Memi[$1+40] # Zero level image pointer +define ZERO_C1 Memi[$1+41] # Zero level data starting column +define ZERO_C2 Memi[$1+42] # Zero level data ending column +define ZERO_L1 Memi[$1+43] # Zero level data starting line +define ZERO_L2 Memi[$1+44] # Zero level data ending line + +# Dark count data +define DARK_IM Memi[$1+50] # Dark count image pointer +define DARK_C1 Memi[$1+51] # Dark count data starting column +define DARK_C2 Memi[$1+52] # Dark count data ending column +define DARK_L1 Memi[$1+53] # Dark count data starting line +define DARK_L2 Memi[$1+54] # Dark count data ending line + +# Flat field data +define FLAT_IM Memi[$1+60] # Flat field image pointer +define FLAT_C1 Memi[$1+61] # Flat field data starting column +define FLAT_C2 Memi[$1+62] # Flat field data ending column +define FLAT_L1 Memi[$1+63] # Flat field data starting line +define FLAT_L2 Memi[$1+64] # Flat field data ending line + +# Illumination data +define ILLUM_IM Memi[$1+70] # Illumination image pointer +define ILLUM_C1 Memi[$1+71] # Illumination data starting column +define ILLUM_C2 Memi[$1+72] # Illumination data ending column +define ILLUM_L1 Memi[$1+73] # Illumination data starting line +define ILLUM_L2 Memi[$1+74] # Illumination data ending line + +# Fringe data +define FRINGE_IM Memi[$1+80] # Fringe image pointer +define FRINGE_C1 Memi[$1+81] # Fringe data starting column +define FRINGE_C2 Memi[$1+82] # Fringe data ending column +define FRINGE_L1 Memi[$1+83] # Fringe data starting line +define FRINGE_L2 Memi[$1+84] # Fringe data ending line + +# Trim section +define TRIM_C1 Memi[$1+90] # Trim starting column +define TRIM_C2 Memi[$1+91] # Trim ending column +define TRIM_L1 Memi[$1+92] # Trim starting line +define TRIM_L2 Memi[$1+93] # Trim ending line + +# Bias section +define BIAS_C1 Memi[$1+100] # Bias starting column +define BIAS_C2 Memi[$1+101] # Bias ending column +define BIAS_L1 Memi[$1+102] # Bias starting line +define BIAS_L2 Memi[$1+103] # Bias ending line + +define READAXIS Memi[$1+110] # Read out axis (1=cols, 2=lines) +define CALCTYPE Memi[$1+111] # Calculation data type +define OVERSCAN_TYPE Memi[$1+112] # Overscan type +define OVERSCAN_VEC Memi[$1+113] # Pointer to overscan vector +define DARKSCALE Memr[P2R($1+114)] # Dark count scale factor +define FRINGESCALE Memr[P2R($1+115)] # Fringe scale factor +define FLATSCALE Memr[P2R($1+116)] # Flat field scale factor +define ILLUMSCALE Memr[P2R($1+117)] # Illumination scale factor +define MINREPLACE Memr[P2R($1+118)] # Minimum replacement value +define MEAN Memr[P2R($1+119)] # Mean of output image +define COR Memi[$1+120] # Overall correction flag +define CORS Memi[$1+121+($2-1)] # Individual correction flags + +# The correction array contains the following elements with array indices +# given by the macro definitions. + +define NCORS 10 # Number of corrections + +define FIXPIX 1 # Fix bad pixels +define TRIM 2 # Trim image +define OVERSCAN 3 # Apply overscan correction +define ZEROCOR 4 # Apply zero level correction +define DARKCOR 5 # Apply dark count correction +define FLATCOR 6 # Apply flat field correction +define ILLUMCOR 7 # Apply illumination correction +define FRINGECOR 8 # Apply fringe correction +define FINDMEAN 9 # Find the mean of the output image +define MINREP 10 # Check and replace minimum value + +# The following definitions identify the correction values in the correction +# array. They are defined in terms of bit fields so that it is possible to +# add corrections to form unique combination corrections. Some of +# these combinations are implemented as compound operations for efficiency. + +define O 001B # overscan +define Z 002B # zero level +define D 004B # dark count +define F 010B # flat field +define I 020B # Illumination +define Q 040B # Fringe + +# The following correction combinations are recognized. + +define ZO 003B # zero level + overscan +define DO 005B # dark count + overscan +define DZ 006B # dark count + zero level +define DZO 007B # dark count + zero level + overscan +define FO 011B # flat field + overscan +define FZ 012B # flat field + zero level +define FZO 013B # flat field + zero level + overscan +define FD 014B # flat field + dark count +define FDO 015B # flat field + dark count + overscan +define FDZ 016B # flat field + dark count + zero level +define FDZO 017B # flat field + dark count + zero level + overscan +define QI 060B # fringe + illumination + +# The following overscan functions are recognized. +define OVERSCAN_TYPES "|mean|median|minmax|chebyshev|legendre|spline3|spline1|" +define OVERSCAN_MEAN 1 # Mean of overscan +define OVERSCAN_MEDIAN 2 # Median of overscan +define OVERSCAN_MINMAX 3 # Minmax of overscan +define OVERSCAN_FIT 4 # Following codes are function fits diff --git a/noao/imred/ccdred/src/ccdsection.x b/noao/imred/ccdred/src/ccdsection.x new file mode 100644 index 00000000..aced216a --- /dev/null +++ b/noao/imred/ccdred/src/ccdsection.x @@ -0,0 +1,100 @@ +include <ctype.h> + +# CCD_SECTION -- Parse a 2D image section into its elements. +# 1. The default values must be set by the caller. +# 2. A null image section is OK. +# 3. The first nonwhitespace character must be '['. +# 4. The last interpreted character must be ']'. +# +# This procedure should be replaced with an IMIO procedure at some +# point. + +procedure ccd_section (section, x1, x2, xstep, y1, y2, ystep) + +char section[ARB] # Image section +int x1, x2, xstep # X image section parameters +int y1, y2, ystep # X image section parameters + +int i, ip, a, b, c, temp, ctoi() +define error_ 99 + +begin + # Decode the section string. + ip = 1 + while (IS_WHITE(section[ip])) + ip = ip + 1 + if (section[ip] == '[') + ip = ip + 1 + else if (section[ip] == EOS) + return + else + goto error_ + + do i = 1, 2 { + while (IS_WHITE(section[ip])) + ip = ip + 1 + + # Default values + if (i == 1) { + a = x1 + b = x2 + c = xstep + } else { + a = y1 + b = y2 + c = ystep + } + + # 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 = temp + if (section[ip] == ':') { + ip = ip + 1 + if (ctoi (section, ip, b) == 0) # a:b + goto error_ + } else + b = a + } else if (section[ip] == '-') { # -* + temp = a + a = b + b = 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) == 0) + goto error_ + else if (c == 0) + goto error_ + } + if (a > b && c > 0) + c = -c + + if (i == 1) { + x1 = a + x2 = b + xstep = c + } else { + y1 = a + y2 = b + ystep = c + } + + while (IS_WHITE(section[ip])) + ip = ip + 1 + if (section[ip] == ',') + ip = ip + 1 + } + + if (section[ip] != ']') + goto error_ + + return +error_ + call error (0, "Error in image section specification") +end diff --git a/noao/imred/ccdred/src/ccdsubsets.x b/noao/imred/ccdred/src/ccdsubsets.x new file mode 100644 index 00000000..528b0223 --- /dev/null +++ b/noao/imred/ccdred/src/ccdsubsets.x @@ -0,0 +1,93 @@ +include <ctype.h> + + +# CCDSUBSET -- Return the CCD subset identifier. +# +# 1. Get the subset string and search the subset record file for the ID string. +# 2. If the subset string is not in the record file define a default ID string +# based on the first word of the subset string. If the first word is not +# unique append a integer to the first word until it is unique. +# 3. Add the new subset string and identifier to the record file. +# 4. Since the ID string is used to generate image names replace all +# nonimage name characters with '_'. +# +# It is an error if the record file cannot be created or written when needed. + +procedure ccdsubset (im, subset, sz_name) + +pointer im # Image +char subset[sz_name] # CCD subset identifier +int sz_name # Size of subset string + +bool streq() +int i, fd, ctowrd(), open(), fscan() +pointer sp, fname, str1, str2, subset1, subset2, subset3 +errchk open + +begin + call smark (sp) + call salloc (fname, SZ_FNAME, TY_CHAR) + call salloc (str1, SZ_LINE, TY_CHAR) + call salloc (str2, SZ_LINE, TY_CHAR) + call salloc (subset1, SZ_LINE, TY_CHAR) + call salloc (subset2, SZ_LINE, TY_CHAR) + call salloc (subset3, SZ_LINE, TY_CHAR) + + # Get the subset record file and the subset string. + call clgstr ("ssfile", Memc[fname], SZ_LINE) + call hdmgstr (im, "subset", Memc[str1], SZ_LINE) + + # The default subset identifier is the first word of the subset string. + i = 1 + i = ctowrd (Memc[str1], i, Memc[subset1], SZ_LINE) + + # A null subset string is ok. If not null check for conflict + # with previous subset IDs. + if (Memc[str1] != EOS) { + call strcpy (Memc[subset1], Memc[subset3], SZ_LINE) + + # Search the subset record file for the same subset string. + # If found use the ID string. If the subset ID has been + # used for another subset string then increment an integer + # suffix to the default ID and check the list again. + + i = 1 + ifnoerr (fd = open (Memc[fname], READ_ONLY, TEXT_FILE)) { + while (fscan (fd) != EOF) { + call gargwrd (Memc[str2], SZ_LINE) + call gargwrd (Memc[subset2], SZ_LINE) + if (streq (Memc[str1], Memc[str2])) { + i = 0 + call strcpy (Memc[subset2], Memc[subset1], SZ_LINE) + break + } if (streq (Memc[subset1], Memc[subset2])) { + call sprintf (Memc[subset1], SZ_LINE, "%s%d") + call pargstr (Memc[subset3]) + call pargi (i) + i = i + 1 + call seek (fd, BOF) + } + } + call close (fd) + } + + # If the subset is not in the record file add it. + if (i > 0) { + fd = open (Memc[fname], APPEND, TEXT_FILE) + call fprintf (fd, "'%s'\t%s\n") + call pargstr (Memc[str1]) + call pargstr (Memc[subset1]) + call close (fd) + } + } + + # Set the subset ID string and replace magic characters by '_' + # since the subset ID is used in forming image names. + + call strcpy (Memc[subset1], subset, sz_name) + for (i=1; subset[i]!=EOS; i=i+1) + if (!(IS_ALNUM(subset[i])||subset[i]=='.')) + subset[i] = '_' + + call sfree (sp) +end diff --git a/noao/imred/ccdred/src/ccdtypes.h b/noao/imred/ccdred/src/ccdtypes.h new file mode 100644 index 00000000..0d5d4caf --- /dev/null +++ b/noao/imred/ccdred/src/ccdtypes.h @@ -0,0 +1,14 @@ +# Standard CCD image types. + +define CCDTYPES "|object|zero|dark|flat|illum|fringe|other|comp|" + +define NONE -1 +define UNKNOWN 0 +define OBJECT 1 +define ZERO 2 +define DARK 3 +define FLAT 4 +define ILLUM 5 +define FRINGE 6 +define OTHER 7 +define COMP 8 diff --git a/noao/imred/ccdred/src/ccdtypes.x b/noao/imred/ccdred/src/ccdtypes.x new file mode 100644 index 00000000..bf6d29e2 --- /dev/null +++ b/noao/imred/ccdred/src/ccdtypes.x @@ -0,0 +1,72 @@ +include "ccdtypes.h" + +# CCDTYPES -- Return the CCD type name string. +# CCDTYPEI -- Return the CCD type code. + + +# CCDTYPES -- Return the CCD type name string. + +procedure ccdtypes (im, name, sz_name) + +pointer im # Image +char name[sz_name] # CCD type name +int sz_name # Size of name string + +int strdic() +pointer sp, str + +begin + call smark (sp) + call salloc (str, SZ_LINE, TY_CHAR) + + # Get the image type string. If none then return "none". + # Otherwise get the corresponding package image type string. + # If the image type is unknown return "unknown" otherwise return + # the package name. + + call hdmgstr (im, "imagetyp", Memc[str], SZ_LINE) + if (Memc[str] == EOS) { + call strcpy ("none", name, sz_name) + } else { + call hdmname (Memc[str], name, sz_name) + if (name[1] == EOS) + call strcpy (Memc[str], name, sz_name) + if (strdic (name, name, sz_name, CCDTYPES) == UNKNOWN) + call strcpy ("unknown", name, sz_name) + } + + call sfree (sp) +end + + +# CCDTYPEI -- Return the CCD type code. + +int procedure ccdtypei (im) + +pointer im # Image +int ccdtype # CCD type (returned) + +pointer sp, str1, str2 +int strdic() + +begin + call smark (sp) + call salloc (str1, SZ_LINE, TY_CHAR) + call salloc (str2, SZ_LINE, TY_CHAR) + + # Get the image type and if there is none then return the NONE code. + call hdmgstr (im, "imagetyp", Memc[str1], SZ_LINE) + if (Memc[str1] == EOS) { + ccdtype = NONE + + # Otherwise get the package type and convert to an image type code. + } else { + call hdmname (Memc[str1], Memc[str2], SZ_LINE) + if (Memc[str2] == EOS) + call strcpy (Memc[str1], Memc[str2], SZ_LINE) + ccdtype = strdic (Memc[str2], Memc[str2], SZ_LINE, CCDTYPES) + } + + call sfree (sp) + return (ccdtype) +end diff --git a/noao/imred/ccdred/src/combine/generic/icaclip.x b/noao/imred/ccdred/src/combine/generic/icaclip.x new file mode 100644 index 00000000..1530145c --- /dev/null +++ b/noao/imred/ccdred/src/combine/generic/icaclip.x @@ -0,0 +1,1102 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "../icombine.h" + +define MINCLIP 3 # Minimum number of images for this algorithm + + +# IC_AAVSIGCLIP -- Reject pixels using an average sigma about the average +# The average sigma is normalized by the expected poisson sigma. + +procedure ic_aavsigclips (d, m, n, scales, zeros, nimages, npts, average) + +pointer d[nimages] # Data pointers +pointer m[nimages] # Image id pointers +int n[npts] # Number of good pixels +real scales[nimages] # Scales +real zeros[nimages] # Zeros +int nimages # Number of images +int npts # Number of output points per line +real average[npts] # Average + +int i, j, k, l, jj, n1, n2, nin, nk, maxkeep +real d1, low, high, sum, a, s, s1, r, one +data one /1.0/ +pointer sp, sums, resid, dp1, dp2, mp1, mp2 + +include "../icombine.com" + +begin + # If there are insufficient pixels go on to the combining. + if (nkeep < 0) + maxkeep = max (0, nimages + nkeep) + else + maxkeep = min (nimages, nkeep) + if (nimages < max (MINCLIP, maxkeep+1) || dflag == D_NONE) { + docombine = true + return + } + + call smark (sp) + call salloc (sums, npts, TY_REAL) + call salloc (resid, nimages+1, TY_REAL) + + # Since the unweighted average is computed here possibly skip combining + if (dowts || combine != AVERAGE) + docombine = true + else + docombine = false + + # Compute the unweighted average with the high and low rejected and + # the poisson scaled average sigma. There must be at least three + # pixels at each point to define the average and contributions to + # the mean sigma. Corrections for differences in the image + # scale factors are selected by the doscale1 flag. + + nin = n[1] + s = 0. + n2 = 0 + do i = 1, npts { + k = i - 1 + n1 = n[i] + if (n1 < 3) + next + + # Unweighted average with the high and low rejected + low = Mems[d[1]+k] + high = Mems[d[2]+k] + if (low > high) { + d1 = low + low = high + high = d1 + } + sum = 0. + do j = 3, n1 { + d1 = Mems[d[j]+k] + if (d1 < low) { + sum = sum + low + low = d1 + } else if (d1 > high) { + sum = sum + high + high = d1 + } else + sum = sum + d1 + } + a = sum / (n1 - 2) + sum = sum + low + high + + # Poisson scaled sigma accumulation + if (doscale1) { + do j = 1, n1 { + dp1 = d[j] + k + mp1 = m[j] + k + + d1 = Mems[dp1] + l = Memi[mp1] + s1 = max (one, (a + zeros[l]) / scales[l]) + s = s + (d1 - a) ** 2 / s1 + } + } else { + s1 = max (one, a) + do j = 1, n1 + s = s + (Mems[d[j]+k] - a) ** 2 / s1 + } + n2 = n2 + n1 + + # Save the average and sum for later. + average[i] = a + Memr[sums+k] = sum + } + + # Here is the final sigma. + if (n2 > 1) + s = sqrt (s / (n2 - 1)) + + # Reject pixels and compute the final average (if needed). + # There must be at least three pixels at each point for rejection. + # Iteratively scale the mean sigma and reject pixels + # Compact the data and keep track of the image IDs if needed. + + do i = 1, npts { + k = i - 1 + n1 = n[i] + if (nkeep < 0) + maxkeep = max (0, n1 + nkeep) + else + maxkeep = min (n1, nkeep) + if (n1 <= max (2, maxkeep)) { + if (!docombine) { + if (n1 == 0) + average[i] = blank + else { + sum = Mems[d[1]+k] + do j = 2, n1 + sum = sum + Mems[d[j]+k] + average[i] = sum / n1 + } + } + next + } + + a = average[i] + sum = Memr[sums+k] + + repeat { + n2 = n1 + if (s > 0.) { + if (doscale1) { + for (j=1; j<=n1; j=j+1) { + dp1 = d[j] + k + mp1 = m[j] + k + + d1 = Mems[dp1] + l = Memi[mp1] + s1 = s * sqrt (max (one, (a+zeros[l]) / scales[l])) + r = (d1 - a) / s1 + if (r < -lsigma || r > hsigma) { + Memr[resid+n1] = abs(r) + if (j < n1) { + dp2 = d[n1] + k + Mems[dp1] = Mems[dp2] + Mems[dp2] = d1 + mp2 = m[n1] + k + Memi[mp1] = Memi[mp2] + Memi[mp2] = l + j = j - 1 + } + sum = sum - d1 + n1 = n1 - 1 + } + } + } else { + s1 = s * sqrt (max (one, a)) + for (j=1; j<=n1; j=j+1) { + dp1 = d[j] + k + d1 = Mems[dp1] + r = (d1 - a) / s1 + if (r < -lsigma || r > hsigma) { + Memr[resid+n1] = abs(r) + if (j < n1) { + dp2 = d[n1] + k + Mems[dp1] = Mems[dp2] + Mems[dp2] = d1 + if (keepids) { + mp1 = m[j] + k + mp2 = m[n1] + k + l = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = l + } + j = j - 1 + } + sum = sum - d1 + n1 = n1 - 1 + } + } + } + } + if (n1 > 1) + a = sum / n1 + } until (n1 == n2 || n1 <= max (2, maxkeep)) + + # If too many are rejected add some back in. + # Pixels with equal residuals are added together. + if (n1 < maxkeep) { + nk = maxkeep + if (doscale1) { + for (j=n1+1; j<=nk; j=j+1) { + dp1 = d[j] + k + mp1 = m[j] + k + r = Memr[resid+j] + jj = 0 + do l = j+1, n2 { + s = Memr[resid+l] + if (s < r + TOL) { + if (s > r - TOL) + jj = jj + 1 + else { + jj = 0 + Memr[resid+l] = r + r = s + dp2 = d[l] + k + d1 = Mems[dp1] + Mems[dp1] = Mems[dp2] + Mems[dp2] = d1 + mp2 = m[l] + k + s = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = s + } + } + } + sum = sum + Mems[dp1] + n1 = n1 + 1 + nk = max (nk, j+jj) + } + } else { + for (j=n1+1; j<=nk; j=j+1) { + dp1 = d[j] + k + r = Memr[resid+j] + jj = 0 + do l = j+1, n2 { + s = Memr[resid+l] + if (s < r + TOL) { + if (s > r - TOL) + jj = jj + 1 + else { + jj = 0 + Memr[resid+l] = r + r = s + dp2 = d[l] + k + d1 = Mems[dp1] + Mems[dp1] = Mems[dp2] + Mems[dp2] = d1 + if (keepids) { + mp1 = m[j] + k + mp2 = m[l] + k + s = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = s + } + } + } + } + sum = sum + Mems[dp1] + n1 = n1 + 1 + nk = max (nk, j+jj) + } + } + if (n1 > 1) + a = sum / n1 + } + + # Save the average if needed. + n[i] = n1 + if (!docombine) { + if (n1 > 0) + average[i] = a + else + average[i] = blank + } + } + + # Check if the data flag has to be reset for rejected pixels + if (dflag == D_ALL) { + do i = 1, npts { + if (n[i] != nin) { + dflag = D_MIX + break + } + } + } + + call sfree (sp) +end + + +# IC_MAVSIGCLIP -- Reject pixels using an average sigma about the median +# The average sigma is normalized by the expected poisson sigma. + +procedure ic_mavsigclips (d, m, n, scales, zeros, nimages, npts, median) + +pointer d[nimages] # Data pointers +pointer m[nimages] # Image id pointers +int n[npts] # Number of good pixels +real scales[nimages] # Scales +real zeros[nimages] # Zeros +int nimages # Number of images +int npts # Number of output points per line +real median[npts] # Median + +int i, j, k, l, id, n1, n2, n3, nl, nh, nin, maxkeep +pointer sp, resid, mp1, mp2 +real med, low, high, r, s, s1, one +data one /1.0/ + +include "../icombine.com" + +begin + # If there are insufficient pixels go on to the combining. + if (nkeep < 0) + maxkeep = max (0, nimages + nkeep) + else + maxkeep = min (nimages, nkeep) + if (nimages < max (MINCLIP, maxkeep+1) || dflag == D_NONE) { + docombine = true + return + } + + call smark (sp) + call salloc (resid, nimages+1, TY_REAL) + + # Compute the poisson scaled average sigma about the median. + # There must be at least three pixels at each point to define + # the mean sigma. Corrections for differences in the image + # scale factors are selected by the doscale1 flag. + + s = 0. + n2 = 0 + nin = n[1] + do i = 1, npts { + k = i - 1 + n1 = n[i] + if (n1 < 3) { + if (n1 == 0) + median[i] = blank + else if (n1 == 1) + median[i] = Mems[d[1]+k] + else { + low = Mems[d[1]+k] + high = Mems[d[2]+k] + median[i] = (low + high) / 2. + } + next + } + + # Median + n3 = 1 + n1 / 2 + if (mod (n1, 2) == 0) { + low = Mems[d[n3-1]+k] + high = Mems[d[n3]+k] + med = (low + high) / 2. + } else + med = Mems[d[n3]+k] + + # Poisson scaled sigma accumulation + if (doscale1) { + do j = 1, n1 { + l = Memi[m[j]+k] + s1 = max (one, (med + zeros[l]) / scales[l]) + s = s + (Mems[d[j]+k] - med) ** 2 / s1 + } + } else { + s1 = max (one, med) + do j = 1, n1 + s = s + (Mems[d[j]+k] - med) ** 2 / s1 + } + n2 = n2 + n1 + + # Save the median for later. + median[i] = med + } + + # Here is the final sigma. + if (n2 > 1) + s = sqrt (s / (n2 - 1)) + else + return + + # Compute individual sigmas and iteratively clip. + do i = 1, npts { + k = i - 1 + n1 = n[i] + if (nkeep < 0) + maxkeep = max (0, n1 + nkeep) + else + maxkeep = min (n1, nkeep) + if (n1 < max (3, maxkeep+1)) + next + nl = 1 + nh = n1 + med = median[i] + + repeat { + n2 = n1 + n3 = nl + n1 / 2 + + if (n1 >= max (MINCLIP, maxkeep+1) && s > 0.) { + if (doscale1) { + for (; nl <= n2; nl = nl + 1) { + l = Memi[m[nl]+k] + s1 = s * sqrt (max (one, (med+zeros[l])/scales[l])) + r = (med - Mems[d[nl]+k]) / s1 + if (r <= lsigma) + break + Memr[resid+nl] = r + n1 = n1 - 1 + } + for (; nh >= nl; nh = nh - 1) { + l = Memi[m[nh]+k] + s1 = s * sqrt (max (one, (med+zeros[l])/scales[l])) + r = (Mems[d[nh]+k] - med) / s1 + if (r <= hsigma) + break + Memr[resid+nh] = r + n1 = n1 - 1 + } + } else { + s1 = s * sqrt (max (one, med)) + for (; nl <= n2; nl = nl + 1) { + r = (med - Mems[d[nl]+k]) / s1 + if (r <= lsigma) + break + Memr[resid+nl] = r + n1 = n1 - 1 + } + for (; nh >= nl; nh = nh - 1) { + r = (Mems[d[nh]+k] - med) / s1 + if (r <= hsigma) + break + Memr[resid+nh] = r + n1 = n1 - 1 + } + } + + # Recompute median + if (n1 < n2) { + if (n1 > 0) { + n3 = nl + n1 / 2 + if (mod (n1, 2) == 0) { + low = Mems[d[n3-1]+k] + high = Mems[d[n3]+k] + med = (low + high) / 2. + } else + med = Mems[d[n3]+k] + } else + med = blank + } + } + } until (n1 == n2 || n1 < max (MINCLIP, maxkeep+1)) + + # If too many are rejected add some back in. + # Pixels with equal residuals are added together. + while (n1 < maxkeep) { + if (nl == 1) + nh = nh + 1 + else if (nh == n[i]) + nl = nl - 1 + else { + r = Memr[resid+nl-1] + s = Memr[resid+nh+1] + if (r < s) { + nl = nl - 1 + r = r + TOL + if (s <= r) + nh = nh + 1 + if (nl > 1) { + if (Memr[resid+nl-1] <= r) + nl = nl - 1 + } + } else { + nh = nh + 1 + s = s + TOL + if (r <= s) + nl = nl - 1 + if (nh < n2) { + if (Memr[resid+nh+1] <= s) + nh = nh + 1 + } + } + } + n1 = nh - nl + 1 + + # Recompute median + if (n1 < n2) { + if (n1 > 0) { + n3 = nl + n1 / 2 + if (mod (n1, 2) == 0) { + low = Mems[d[n3-1]+k] + high = Mems[d[n3]+k] + med = (low + high) / 2. + } else + med = Mems[d[n3]+k] + } else + med = blank + } + } + + # Only set median and reorder if needed + n[i] = n1 + if (n1 > 0 && nl > 1 && (combine != MEDIAN || grow > 0)) { + j = max (nl, n1 + 1) + if (keepids) { + do l = 1, min (n1, nl-1) { + Mems[d[l]+k] = Mems[d[j]+k] + if (grow > 0) { + mp1 = m[l] + k + mp2 = m[j] + k + id = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = id + } else + Memi[m[l]+k] = Memi[m[j]+k] + j = j + 1 + } + } else { + do l = 1, min (n1, nl - 1) { + Mems[d[l]+k] = Mems[d[j]+k] + j = j + 1 + } + } + } + + if (combine == MEDIAN) + median[i] = med + } + + # Check if data flag needs to be reset for rejected pixels + if (dflag == D_ALL) { + do i = 1, npts { + if (n[i] != nin) { + dflag = D_MIX + break + } + } + } + + # Flag that the median is computed. + if (combine == MEDIAN) + docombine = false + else + docombine = true + + call sfree (sp) +end + +# IC_AAVSIGCLIP -- Reject pixels using an average sigma about the average +# The average sigma is normalized by the expected poisson sigma. + +procedure ic_aavsigclipr (d, m, n, scales, zeros, nimages, npts, average) + +pointer d[nimages] # Data pointers +pointer m[nimages] # Image id pointers +int n[npts] # Number of good pixels +real scales[nimages] # Scales +real zeros[nimages] # Zeros +int nimages # Number of images +int npts # Number of output points per line +real average[npts] # Average + +int i, j, k, l, jj, n1, n2, nin, nk, maxkeep +real d1, low, high, sum, a, s, s1, r, one +data one /1.0/ +pointer sp, sums, resid, dp1, dp2, mp1, mp2 + +include "../icombine.com" + +begin + # If there are insufficient pixels go on to the combining. + if (nkeep < 0) + maxkeep = max (0, nimages + nkeep) + else + maxkeep = min (nimages, nkeep) + if (nimages < max (MINCLIP, maxkeep+1) || dflag == D_NONE) { + docombine = true + return + } + + call smark (sp) + call salloc (sums, npts, TY_REAL) + call salloc (resid, nimages+1, TY_REAL) + + # Since the unweighted average is computed here possibly skip combining + if (dowts || combine != AVERAGE) + docombine = true + else + docombine = false + + # Compute the unweighted average with the high and low rejected and + # the poisson scaled average sigma. There must be at least three + # pixels at each point to define the average and contributions to + # the mean sigma. Corrections for differences in the image + # scale factors are selected by the doscale1 flag. + + nin = n[1] + s = 0. + n2 = 0 + do i = 1, npts { + k = i - 1 + n1 = n[i] + if (n1 < 3) + next + + # Unweighted average with the high and low rejected + low = Memr[d[1]+k] + high = Memr[d[2]+k] + if (low > high) { + d1 = low + low = high + high = d1 + } + sum = 0. + do j = 3, n1 { + d1 = Memr[d[j]+k] + if (d1 < low) { + sum = sum + low + low = d1 + } else if (d1 > high) { + sum = sum + high + high = d1 + } else + sum = sum + d1 + } + a = sum / (n1 - 2) + sum = sum + low + high + + # Poisson scaled sigma accumulation + if (doscale1) { + do j = 1, n1 { + dp1 = d[j] + k + mp1 = m[j] + k + + d1 = Memr[dp1] + l = Memi[mp1] + s1 = max (one, (a + zeros[l]) / scales[l]) + s = s + (d1 - a) ** 2 / s1 + } + } else { + s1 = max (one, a) + do j = 1, n1 + s = s + (Memr[d[j]+k] - a) ** 2 / s1 + } + n2 = n2 + n1 + + # Save the average and sum for later. + average[i] = a + Memr[sums+k] = sum + } + + # Here is the final sigma. + if (n2 > 1) + s = sqrt (s / (n2 - 1)) + + # Reject pixels and compute the final average (if needed). + # There must be at least three pixels at each point for rejection. + # Iteratively scale the mean sigma and reject pixels + # Compact the data and keep track of the image IDs if needed. + + do i = 1, npts { + k = i - 1 + n1 = n[i] + if (nkeep < 0) + maxkeep = max (0, n1 + nkeep) + else + maxkeep = min (n1, nkeep) + if (n1 <= max (2, maxkeep)) { + if (!docombine) { + if (n1 == 0) + average[i] = blank + else { + sum = Memr[d[1]+k] + do j = 2, n1 + sum = sum + Memr[d[j]+k] + average[i] = sum / n1 + } + } + next + } + + a = average[i] + sum = Memr[sums+k] + + repeat { + n2 = n1 + if (s > 0.) { + if (doscale1) { + for (j=1; j<=n1; j=j+1) { + dp1 = d[j] + k + mp1 = m[j] + k + + d1 = Memr[dp1] + l = Memi[mp1] + s1 = s * sqrt (max (one, (a+zeros[l]) / scales[l])) + r = (d1 - a) / s1 + if (r < -lsigma || r > hsigma) { + Memr[resid+n1] = abs(r) + if (j < n1) { + dp2 = d[n1] + k + Memr[dp1] = Memr[dp2] + Memr[dp2] = d1 + mp2 = m[n1] + k + Memi[mp1] = Memi[mp2] + Memi[mp2] = l + j = j - 1 + } + sum = sum - d1 + n1 = n1 - 1 + } + } + } else { + s1 = s * sqrt (max (one, a)) + for (j=1; j<=n1; j=j+1) { + dp1 = d[j] + k + d1 = Memr[dp1] + r = (d1 - a) / s1 + if (r < -lsigma || r > hsigma) { + Memr[resid+n1] = abs(r) + if (j < n1) { + dp2 = d[n1] + k + Memr[dp1] = Memr[dp2] + Memr[dp2] = d1 + if (keepids) { + mp1 = m[j] + k + mp2 = m[n1] + k + l = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = l + } + j = j - 1 + } + sum = sum - d1 + n1 = n1 - 1 + } + } + } + } + if (n1 > 1) + a = sum / n1 + } until (n1 == n2 || n1 <= max (2, maxkeep)) + + # If too many are rejected add some back in. + # Pixels with equal residuals are added together. + if (n1 < maxkeep) { + nk = maxkeep + if (doscale1) { + for (j=n1+1; j<=nk; j=j+1) { + dp1 = d[j] + k + mp1 = m[j] + k + r = Memr[resid+j] + jj = 0 + do l = j+1, n2 { + s = Memr[resid+l] + if (s < r + TOL) { + if (s > r - TOL) + jj = jj + 1 + else { + jj = 0 + Memr[resid+l] = r + r = s + dp2 = d[l] + k + d1 = Memr[dp1] + Memr[dp1] = Memr[dp2] + Memr[dp2] = d1 + mp2 = m[l] + k + s = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = s + } + } + } + sum = sum + Memr[dp1] + n1 = n1 + 1 + nk = max (nk, j+jj) + } + } else { + for (j=n1+1; j<=nk; j=j+1) { + dp1 = d[j] + k + r = Memr[resid+j] + jj = 0 + do l = j+1, n2 { + s = Memr[resid+l] + if (s < r + TOL) { + if (s > r - TOL) + jj = jj + 1 + else { + jj = 0 + Memr[resid+l] = r + r = s + dp2 = d[l] + k + d1 = Memr[dp1] + Memr[dp1] = Memr[dp2] + Memr[dp2] = d1 + if (keepids) { + mp1 = m[j] + k + mp2 = m[l] + k + s = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = s + } + } + } + } + sum = sum + Memr[dp1] + n1 = n1 + 1 + nk = max (nk, j+jj) + } + } + if (n1 > 1) + a = sum / n1 + } + + # Save the average if needed. + n[i] = n1 + if (!docombine) { + if (n1 > 0) + average[i] = a + else + average[i] = blank + } + } + + # Check if the data flag has to be reset for rejected pixels + if (dflag == D_ALL) { + do i = 1, npts { + if (n[i] != nin) { + dflag = D_MIX + break + } + } + } + + call sfree (sp) +end + + +# IC_MAVSIGCLIP -- Reject pixels using an average sigma about the median +# The average sigma is normalized by the expected poisson sigma. + +procedure ic_mavsigclipr (d, m, n, scales, zeros, nimages, npts, median) + +pointer d[nimages] # Data pointers +pointer m[nimages] # Image id pointers +int n[npts] # Number of good pixels +real scales[nimages] # Scales +real zeros[nimages] # Zeros +int nimages # Number of images +int npts # Number of output points per line +real median[npts] # Median + +int i, j, k, l, id, n1, n2, n3, nl, nh, nin, maxkeep +pointer sp, resid, mp1, mp2 +real med, low, high, r, s, s1, one +data one /1.0/ + +include "../icombine.com" + +begin + # If there are insufficient pixels go on to the combining. + if (nkeep < 0) + maxkeep = max (0, nimages + nkeep) + else + maxkeep = min (nimages, nkeep) + if (nimages < max (MINCLIP, maxkeep+1) || dflag == D_NONE) { + docombine = true + return + } + + call smark (sp) + call salloc (resid, nimages+1, TY_REAL) + + # Compute the poisson scaled average sigma about the median. + # There must be at least three pixels at each point to define + # the mean sigma. Corrections for differences in the image + # scale factors are selected by the doscale1 flag. + + s = 0. + n2 = 0 + nin = n[1] + do i = 1, npts { + k = i - 1 + n1 = n[i] + if (n1 < 3) { + if (n1 == 0) + median[i] = blank + else if (n1 == 1) + median[i] = Memr[d[1]+k] + else { + low = Memr[d[1]+k] + high = Memr[d[2]+k] + median[i] = (low + high) / 2. + } + next + } + + # Median + n3 = 1 + n1 / 2 + if (mod (n1, 2) == 0) { + low = Memr[d[n3-1]+k] + high = Memr[d[n3]+k] + med = (low + high) / 2. + } else + med = Memr[d[n3]+k] + + # Poisson scaled sigma accumulation + if (doscale1) { + do j = 1, n1 { + l = Memi[m[j]+k] + s1 = max (one, (med + zeros[l]) / scales[l]) + s = s + (Memr[d[j]+k] - med) ** 2 / s1 + } + } else { + s1 = max (one, med) + do j = 1, n1 + s = s + (Memr[d[j]+k] - med) ** 2 / s1 + } + n2 = n2 + n1 + + # Save the median for later. + median[i] = med + } + + # Here is the final sigma. + if (n2 > 1) + s = sqrt (s / (n2 - 1)) + else + return + + # Compute individual sigmas and iteratively clip. + do i = 1, npts { + k = i - 1 + n1 = n[i] + if (nkeep < 0) + maxkeep = max (0, n1 + nkeep) + else + maxkeep = min (n1, nkeep) + if (n1 < max (3, maxkeep+1)) + next + nl = 1 + nh = n1 + med = median[i] + + repeat { + n2 = n1 + n3 = nl + n1 / 2 + + if (n1 >= max (MINCLIP, maxkeep+1) && s > 0.) { + if (doscale1) { + for (; nl <= n2; nl = nl + 1) { + l = Memi[m[nl]+k] + s1 = s * sqrt (max (one, (med+zeros[l])/scales[l])) + r = (med - Memr[d[nl]+k]) / s1 + if (r <= lsigma) + break + Memr[resid+nl] = r + n1 = n1 - 1 + } + for (; nh >= nl; nh = nh - 1) { + l = Memi[m[nh]+k] + s1 = s * sqrt (max (one, (med+zeros[l])/scales[l])) + r = (Memr[d[nh]+k] - med) / s1 + if (r <= hsigma) + break + Memr[resid+nh] = r + n1 = n1 - 1 + } + } else { + s1 = s * sqrt (max (one, med)) + for (; nl <= n2; nl = nl + 1) { + r = (med - Memr[d[nl]+k]) / s1 + if (r <= lsigma) + break + Memr[resid+nl] = r + n1 = n1 - 1 + } + for (; nh >= nl; nh = nh - 1) { + r = (Memr[d[nh]+k] - med) / s1 + if (r <= hsigma) + break + Memr[resid+nh] = r + n1 = n1 - 1 + } + } + + # Recompute median + if (n1 < n2) { + if (n1 > 0) { + n3 = nl + n1 / 2 + if (mod (n1, 2) == 0) { + low = Memr[d[n3-1]+k] + high = Memr[d[n3]+k] + med = (low + high) / 2. + } else + med = Memr[d[n3]+k] + } else + med = blank + } + } + } until (n1 == n2 || n1 < max (MINCLIP, maxkeep+1)) + + # If too many are rejected add some back in. + # Pixels with equal residuals are added together. + while (n1 < maxkeep) { + if (nl == 1) + nh = nh + 1 + else if (nh == n[i]) + nl = nl - 1 + else { + r = Memr[resid+nl-1] + s = Memr[resid+nh+1] + if (r < s) { + nl = nl - 1 + r = r + TOL + if (s <= r) + nh = nh + 1 + if (nl > 1) { + if (Memr[resid+nl-1] <= r) + nl = nl - 1 + } + } else { + nh = nh + 1 + s = s + TOL + if (r <= s) + nl = nl - 1 + if (nh < n2) { + if (Memr[resid+nh+1] <= s) + nh = nh + 1 + } + } + } + n1 = nh - nl + 1 + + # Recompute median + if (n1 < n2) { + if (n1 > 0) { + n3 = nl + n1 / 2 + if (mod (n1, 2) == 0) { + low = Memr[d[n3-1]+k] + high = Memr[d[n3]+k] + med = (low + high) / 2. + } else + med = Memr[d[n3]+k] + } else + med = blank + } + } + + # Only set median and reorder if needed + n[i] = n1 + if (n1 > 0 && nl > 1 && (combine != MEDIAN || grow > 0)) { + j = max (nl, n1 + 1) + if (keepids) { + do l = 1, min (n1, nl-1) { + Memr[d[l]+k] = Memr[d[j]+k] + if (grow > 0) { + mp1 = m[l] + k + mp2 = m[j] + k + id = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = id + } else + Memi[m[l]+k] = Memi[m[j]+k] + j = j + 1 + } + } else { + do l = 1, min (n1, nl - 1) { + Memr[d[l]+k] = Memr[d[j]+k] + j = j + 1 + } + } + } + + if (combine == MEDIAN) + median[i] = med + } + + # Check if data flag needs to be reset for rejected pixels + if (dflag == D_ALL) { + do i = 1, npts { + if (n[i] != nin) { + dflag = D_MIX + break + } + } + } + + # Flag that the median is computed. + if (combine == MEDIAN) + docombine = false + else + docombine = true + + call sfree (sp) +end diff --git a/noao/imred/ccdred/src/combine/generic/icaverage.x b/noao/imred/ccdred/src/combine/generic/icaverage.x new file mode 100644 index 00000000..3646b725 --- /dev/null +++ b/noao/imred/ccdred/src/combine/generic/icaverage.x @@ -0,0 +1,163 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> +include "../icombine.h" + + +# IC_AVERAGE -- Compute the average image line. +# Options include a weight average. + +procedure ic_averages (d, m, n, wts, npts, average) + +pointer d[ARB] # Data pointers +pointer m[ARB] # Image ID pointers +int n[npts] # Number of points +real wts[ARB] # Weights +int npts # Number of output points per line +real average[npts] # Average (returned) + +int i, j, k +real sumwt, wt +real sum + +include "../icombine.com" + +begin + # If no data has been excluded do the average without checking the + # number of points and using the fact that the weights are normalized. + # If all the data has been excluded set the average to the blank value. + + if (dflag == D_ALL) { + if (dowts) { + do i = 1, npts { + k = i - 1 + wt = wts[Memi[m[1]+k]] + sum = Mems[d[1]+k] * wt + do j = 2, n[i] { + wt = wts[Memi[m[j]+k]] + sum = sum + Mems[d[j]+k] * wt + } + average[i] = sum + } + } else { + do i = 1, npts { + k = i - 1 + sum = Mems[d[1]+k] + do j = 2, n[i] + sum = sum + Mems[d[j]+k] + average[i] = sum / n[i] + } + } + } else if (dflag == D_NONE) { + do i = 1, npts + average[i] = blank + } else { + if (dowts) { + do i = 1, npts { + if (n[i] > 0) { + k = i - 1 + wt = wts[Memi[m[1]+k]] + sum = Mems[d[1]+k] * wt + sumwt = wt + do j = 2, n[i] { + wt = wts[Memi[m[j]+k]] + sum = sum + Mems[d[j]+k] * wt + sumwt = sumwt + wt + } + average[i] = sum / sumwt + } else + average[i] = blank + } + } else { + do i = 1, npts { + if (n[i] > 0) { + k = i - 1 + sum = Mems[d[1]+k] + do j = 2, n[i] + sum = sum + Mems[d[j]+k] + average[i] = sum / n[i] + } else + average[i] = blank + } + } + } +end + +# IC_AVERAGE -- Compute the average image line. +# Options include a weight average. + +procedure ic_averager (d, m, n, wts, npts, average) + +pointer d[ARB] # Data pointers +pointer m[ARB] # Image ID pointers +int n[npts] # Number of points +real wts[ARB] # Weights +int npts # Number of output points per line +real average[npts] # Average (returned) + +int i, j, k +real sumwt, wt +real sum + +include "../icombine.com" + +begin + # If no data has been excluded do the average without checking the + # number of points and using the fact that the weights are normalized. + # If all the data has been excluded set the average to the blank value. + + if (dflag == D_ALL) { + if (dowts) { + do i = 1, npts { + k = i - 1 + wt = wts[Memi[m[1]+k]] + sum = Memr[d[1]+k] * wt + do j = 2, n[i] { + wt = wts[Memi[m[j]+k]] + sum = sum + Memr[d[j]+k] * wt + } + average[i] = sum + } + } else { + do i = 1, npts { + k = i - 1 + sum = Memr[d[1]+k] + do j = 2, n[i] + sum = sum + Memr[d[j]+k] + average[i] = sum / n[i] + } + } + } else if (dflag == D_NONE) { + do i = 1, npts + average[i] = blank + } else { + if (dowts) { + do i = 1, npts { + if (n[i] > 0) { + k = i - 1 + wt = wts[Memi[m[1]+k]] + sum = Memr[d[1]+k] * wt + sumwt = wt + do j = 2, n[i] { + wt = wts[Memi[m[j]+k]] + sum = sum + Memr[d[j]+k] * wt + sumwt = sumwt + wt + } + average[i] = sum / sumwt + } else + average[i] = blank + } + } else { + do i = 1, npts { + if (n[i] > 0) { + k = i - 1 + sum = Memr[d[1]+k] + do j = 2, n[i] + sum = sum + Memr[d[j]+k] + average[i] = sum / n[i] + } else + average[i] = blank + } + } + } +end diff --git a/noao/imred/ccdred/src/combine/generic/iccclip.x b/noao/imred/ccdred/src/combine/generic/iccclip.x new file mode 100644 index 00000000..57709064 --- /dev/null +++ b/noao/imred/ccdred/src/combine/generic/iccclip.x @@ -0,0 +1,898 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "../icombine.h" + +define MINCLIP 2 # Mininum number of images for algorithm + + +# IC_ACCDCLIP -- Reject pixels using CCD noise parameters about the average + +procedure ic_accdclips (d, m, n, scales, zeros, nm, nimages, npts, average) + +pointer d[nimages] # Data pointers +pointer m[nimages] # Image id pointers +int n[npts] # Number of good pixels +real scales[nimages] # Scales +real zeros[nimages] # Zeros +real nm[3,nimages] # Noise model parameters +int nimages # Number of images +int npts # Number of output points per line +real average[npts] # Average + +int i, j, k, l, jj, n1, n2, nin, nk, maxkeep +real d1, low, high, sum, a, s, r, zero +data zero /0.0/ +pointer sp, resid, dp1, dp2, mp1, mp2 + +include "../icombine.com" + +begin + # If there are no pixels go on to the combining. Since the unweighted + # average is computed here possibly skip the combining later. + + # There must be at least max (1, nkeep) pixels. + if (nkeep < 0) + maxkeep = max (0, nimages + nkeep) + else + maxkeep = min (nimages, nkeep) + if (nimages < max (MINCLIP, maxkeep+1) || dflag == D_NONE) { + docombine = true + return + } else if (dowts || combine != AVERAGE) + docombine = true + else + docombine = false + + call smark (sp) + call salloc (resid, nimages+1, TY_REAL) + + # There must be at least two pixels for rejection. The initial + # average is the low/high rejected average except in the case of + # just two pixels. The rejections are iterated and the average + # is recomputed. Corrections for scaling may be performed. + # Depending on other flags the image IDs may also need to be adjusted. + + nin = n[1] + do i = 1, npts { + k = i - 1 + n1 = n[i] + if (nkeep < 0) + maxkeep = max (0, n1 + nkeep) + else + maxkeep = min (n1, nkeep) + if (n1 <= max (MINCLIP-1, maxkeep)) { + if (!docombine) { + if (n1 == 0) + average[i] = blank + else { + sum = Mems[d[1]+k] + do j = 2, n1 + sum = sum + Mems[d[j]+k] + average[i] = sum / n1 + } + } + next + } + + repeat { + if (n1 == 2) { + sum = Mems[d[1]+k] + sum = sum + Mems[d[2]+k] + a = sum / 2 + } else { + low = Mems[d[1]+k] + high = Mems[d[2]+k] + if (low > high) { + d1 = low + low = high + high = d1 + } + sum = 0. + do j = 3, n1 { + d1 = Mems[d[j]+k] + if (d1 < low) { + sum = sum + low + low = d1 + } else if (d1 > high) { + sum = sum + high + high = d1 + } else + sum = sum + d1 + } + a = sum / (n1 - 2) + sum = sum + low + high + } + n2 = n1 + if (doscale1) { + for (j=1; j<=n1; j=j+1) { + dp1 = d[j] + k + mp1 = m[j] + k + + l = Memi[mp1] + s = scales[l] + d1 = max (zero, s * (a + zeros[l])) + s = sqrt (nm[1,l] + d1/nm[2,l] + (d1*nm[3,l])**2) / s + + d1 = Mems[dp1] + r = (d1 - a) / s + if (r < -lsigma || r > hsigma) { + Memr[resid+n1] = abs(r) + if (j < n1) { + dp2 = d[n1] + k + Mems[dp1] = Mems[dp2] + Mems[dp2] = d1 + mp2 = m[n1] + k + Memi[mp1] = Memi[mp2] + Memi[mp2] = l + j = j - 1 + } + sum = sum - d1 + n1 = n1 - 1 + } + } + } else { + if (!keepids) { + s = max (zero, a) + s = sqrt (nm[1,1] + s/nm[2,1] + (s*nm[3,1])**2) + } + for (j=1; j<=n1; j=j+1) { + if (keepids) { + l = Memi[m[j]+k] + s = max (zero, a) + s = sqrt (nm[1,l] + s/nm[2,l] + (s*nm[3,l])**2) + } + dp1 = d[j] + k + d1 = Mems[dp1] + r = (d1 - a) / s + if (r < -lsigma || r > hsigma) { + Memr[resid+n1] = abs(r) + if (j < n1) { + dp2 = d[n1] + k + Mems[dp1] = Mems[dp2] + Mems[dp2] = d1 + if (keepids) { + mp1 = m[j] + k + mp2 = m[n1] + k + l = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = l + } + j = j - 1 + } + sum = sum - d1 + n1 = n1 - 1 + } + } + } + } until (n1 == n2 || n1 < max (MINCLIP, maxkeep+1)) + + if (n1 < maxkeep) { + nk = maxkeep + if (doscale1) { + for (j=n1+1; j<=nk; j=j+1) { + dp1 = d[j] + k + mp1 = m[j] + k + r = Memr[resid+j] + jj = 0 + do l = j+1, n2 { + s = Memr[resid+l] + if (s < r + TOL) { + if (s > r - TOL) + jj = jj + 1 + else { + jj = 0 + Memr[resid+l] = r + r = s + dp2 = d[l] + k + d1 = Mems[dp1] + Mems[dp1] = Mems[dp2] + Mems[dp2] = d1 + mp2 = m[l] + k + s = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = s + } + } + } + sum = sum + Mems[dp1] + n1 = n1 + 1 + nk = max (nk, j+jj) + } + } else { + for (j=n1+1; j<=nk; j=j+1) { + dp1 = d[j] + k + r = Memr[resid+j] + jj = 0 + do l = j+1, n2 { + s = Memr[resid+l] + if (s < r + TOL) { + if (s > r - TOL) + jj = jj + 1 + else { + jj = 0 + Memr[resid+l] = r + r = s + dp2 = d[l] + k + d1 = Mems[dp1] + Mems[dp1] = Mems[dp2] + Mems[dp2] = d1 + if (keepids) { + mp1 = m[j] + k + mp2 = m[l] + k + s = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = s + } + } + } + } + sum = sum + Mems[dp1] + n1 = n1 + 1 + nk = max (nk, j+jj) + } + } + } + + n[i] = n1 + if (!docombine) + if (n1 > 0) + average[i] = sum / n1 + else + average[i] = blank + } + + # Check if the data flag has to be reset for rejected pixels + if (dflag == D_ALL) { + do i = 1, npts { + if (n[i] != nin) { + dflag = D_MIX + break + } + } + } + + call sfree (sp) +end + + +# IC_CCDCLIP -- Reject pixels using CCD noise parameters about the median + +procedure ic_mccdclips (d, m, n, scales, zeros, nm, nimages, npts, median) + +pointer d[nimages] # Data pointers +pointer m[nimages] # Image id pointers +int n[npts] # Number of good pixels +real scales[nimages] # Scales +real zeros[nimages] # Zeros +real nm[3,nimages] # Noise model +int nimages # Number of images +int npts # Number of output points per line +real median[npts] # Median + +int i, j, k, l, id, n1, n2, n3, nl, nh, nin, maxkeep +real r, s +pointer sp, resid, mp1, mp2 +real med, zero +data zero /0.0/ + +include "../icombine.com" + +begin + # There must be at least max (MINCLIP, nkeep+1) pixels. + if (nkeep < 0) + maxkeep = max (0, nimages + nkeep) + else + maxkeep = min (nimages, nkeep) + if (nimages < max (MINCLIP, maxkeep+1) || dflag == D_NONE) { + docombine = true + return + } + + call smark (sp) + call salloc (resid, nimages+1, TY_REAL) + + # Compute median and sigma and iteratively clip. + nin = n[1] + do i = 1, npts { + k = i - 1 + n1 = n[i] + if (nkeep < 0) + maxkeep = max (0, n1 + nkeep) + else + maxkeep = min (n1, nkeep) + nl = 1 + nh = n1 + + repeat { + n2 = n1 + n3 = nl + n1 / 2 + + if (n1 == 0) + med = blank + else if (mod (n1, 2) == 0) { + med = Mems[d[n3-1]+k] + med = (med + Mems[d[n3]+k]) / 2. + } else + med = Mems[d[n3]+k] + + if (n1 >= max (MINCLIP, maxkeep+1)) { + if (doscale1) { + for (; nl <= n2; nl = nl + 1) { + l = Memi[m[nl]+k] + s = scales[l] + r = max (zero, s * (med + zeros[l])) + s = sqrt (nm[1,l] + r/nm[2,l] + (r*nm[3,l])**2) / s + r = (med - Mems[d[nl]+k]) / s + if (r <= lsigma) + break + Memr[resid+nl] = r + n1 = n1 - 1 + } + for (; nh >= nl; nh = nh - 1) { + l = Memi[m[nh]+k] + s = scales[l] + r = max (zero, s * (med + zeros[l])) + s = sqrt (nm[1,l] + r/nm[2,l] + (r*nm[3,l])**2) / s + r = (Mems[d[nh]+k] - med) / s + if (r <= hsigma) + break + Memr[resid+nh] = r + n1 = n1 - 1 + } + } else { + if (!keepids) { + s = max (zero, med) + s = sqrt (nm[1,1] + s/nm[2,1] + (s*nm[3,1])**2) + } + for (; nl <= n2; nl = nl + 1) { + if (keepids) { + l = Memi[m[nl]+k] + s = max (zero, med) + s = sqrt (nm[1,l] + s/nm[2,l] + (s*nm[3,l])**2) + } + r = (med - Mems[d[nl]+k]) / s + if (r <= lsigma) + break + Memr[resid+nl] = r + n1 = n1 - 1 + } + for (; nh >= nl; nh = nh - 1) { + if (keepids) { + l = Memi[m[nh]+k] + s = max (zero, med) + s = sqrt (nm[1,l] + s/nm[2,l] + (s*nm[3,l])**2) + } + r = (Mems[d[nh]+k] - med) / s + if (r <= hsigma) + break + Memr[resid+nh] = r + n1 = n1 - 1 + } + } + } + } until (n1 == n2 || n1 < max (MINCLIP, maxkeep+1)) + + while (n1 < maxkeep) { + if (nl == 1) + nh = nh + 1 + else if (nh == n[i]) + nl = nl - 1 + else { + r = Memr[resid+nl-1] + s = Memr[resid+nh+1] + if (r < s) { + nl = nl - 1 + r = r + TOL + if (s <= r) + nh = nh + 1 + if (nl > 1) { + if (Memr[resid+nl-1] <= r) + nl = nl - 1 + } + } else { + nh = nh + 1 + s = s + TOL + if (r <= s) + nl = nl - 1 + if (nh < n2) { + if (Memr[resid+nh+1] <= s) + nh = nh + 1 + } + } + } + n1 = nh - nl + 1 + } + + # Only set median and reorder if needed + n[i] = n1 + if (n1 > 0 && nl > 1 && (combine != MEDIAN || grow > 0)) { + j = max (nl, n1 + 1) + if (keepids) { + do l = 1, min (n1, nl-1) { + Mems[d[l]+k] = Mems[d[j]+k] + if (grow > 0) { + mp1 = m[l] + k + mp2 = m[j] + k + id = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = id + } else + Memi[m[l]+k] = Memi[m[j]+k] + j = j + 1 + } + } else { + do l = 1, min (n1, nl - 1) { + Mems[d[l]+k] = Mems[d[j]+k] + j = j + 1 + } + } + } + + if (combine == MEDIAN) + median[i] = med + } + + # Check if data flag needs to be reset for rejected pixels + if (dflag == D_ALL) { + do i = 1, npts { + if (n[i] != nin) { + dflag = D_MIX + break + } + } + } + + # Flag that the median is computed. + if (combine == MEDIAN) + docombine = false + else + docombine = true + + call sfree (sp) +end + +# IC_ACCDCLIP -- Reject pixels using CCD noise parameters about the average + +procedure ic_accdclipr (d, m, n, scales, zeros, nm, nimages, npts, average) + +pointer d[nimages] # Data pointers +pointer m[nimages] # Image id pointers +int n[npts] # Number of good pixels +real scales[nimages] # Scales +real zeros[nimages] # Zeros +real nm[3,nimages] # Noise model parameters +int nimages # Number of images +int npts # Number of output points per line +real average[npts] # Average + +int i, j, k, l, jj, n1, n2, nin, nk, maxkeep +real d1, low, high, sum, a, s, r, zero +data zero /0.0/ +pointer sp, resid, dp1, dp2, mp1, mp2 + +include "../icombine.com" + +begin + # If there are no pixels go on to the combining. Since the unweighted + # average is computed here possibly skip the combining later. + + # There must be at least max (1, nkeep) pixels. + if (nkeep < 0) + maxkeep = max (0, nimages + nkeep) + else + maxkeep = min (nimages, nkeep) + if (nimages < max (MINCLIP, maxkeep+1) || dflag == D_NONE) { + docombine = true + return + } else if (dowts || combine != AVERAGE) + docombine = true + else + docombine = false + + call smark (sp) + call salloc (resid, nimages+1, TY_REAL) + + # There must be at least two pixels for rejection. The initial + # average is the low/high rejected average except in the case of + # just two pixels. The rejections are iterated and the average + # is recomputed. Corrections for scaling may be performed. + # Depending on other flags the image IDs may also need to be adjusted. + + nin = n[1] + do i = 1, npts { + k = i - 1 + n1 = n[i] + if (nkeep < 0) + maxkeep = max (0, n1 + nkeep) + else + maxkeep = min (n1, nkeep) + if (n1 <= max (MINCLIP-1, maxkeep)) { + if (!docombine) { + if (n1 == 0) + average[i] = blank + else { + sum = Memr[d[1]+k] + do j = 2, n1 + sum = sum + Memr[d[j]+k] + average[i] = sum / n1 + } + } + next + } + + repeat { + if (n1 == 2) { + sum = Memr[d[1]+k] + sum = sum + Memr[d[2]+k] + a = sum / 2 + } else { + low = Memr[d[1]+k] + high = Memr[d[2]+k] + if (low > high) { + d1 = low + low = high + high = d1 + } + sum = 0. + do j = 3, n1 { + d1 = Memr[d[j]+k] + if (d1 < low) { + sum = sum + low + low = d1 + } else if (d1 > high) { + sum = sum + high + high = d1 + } else + sum = sum + d1 + } + a = sum / (n1 - 2) + sum = sum + low + high + } + n2 = n1 + if (doscale1) { + for (j=1; j<=n1; j=j+1) { + dp1 = d[j] + k + mp1 = m[j] + k + + l = Memi[mp1] + s = scales[l] + d1 = max (zero, s * (a + zeros[l])) + s = sqrt (nm[1,l] + d1/nm[2,l] + (d1*nm[3,l])**2) / s + + d1 = Memr[dp1] + r = (d1 - a) / s + if (r < -lsigma || r > hsigma) { + Memr[resid+n1] = abs(r) + if (j < n1) { + dp2 = d[n1] + k + Memr[dp1] = Memr[dp2] + Memr[dp2] = d1 + mp2 = m[n1] + k + Memi[mp1] = Memi[mp2] + Memi[mp2] = l + j = j - 1 + } + sum = sum - d1 + n1 = n1 - 1 + } + } + } else { + if (!keepids) { + s = max (zero, a) + s = sqrt (nm[1,1] + s/nm[2,1] + (s*nm[3,1])**2) + } + for (j=1; j<=n1; j=j+1) { + if (keepids) { + l = Memi[m[j]+k] + s = max (zero, a) + s = sqrt (nm[1,l] + s/nm[2,l] + (s*nm[3,l])**2) + } + dp1 = d[j] + k + d1 = Memr[dp1] + r = (d1 - a) / s + if (r < -lsigma || r > hsigma) { + Memr[resid+n1] = abs(r) + if (j < n1) { + dp2 = d[n1] + k + Memr[dp1] = Memr[dp2] + Memr[dp2] = d1 + if (keepids) { + mp1 = m[j] + k + mp2 = m[n1] + k + l = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = l + } + j = j - 1 + } + sum = sum - d1 + n1 = n1 - 1 + } + } + } + } until (n1 == n2 || n1 < max (MINCLIP, maxkeep+1)) + + if (n1 < maxkeep) { + nk = maxkeep + if (doscale1) { + for (j=n1+1; j<=nk; j=j+1) { + dp1 = d[j] + k + mp1 = m[j] + k + r = Memr[resid+j] + jj = 0 + do l = j+1, n2 { + s = Memr[resid+l] + if (s < r + TOL) { + if (s > r - TOL) + jj = jj + 1 + else { + jj = 0 + Memr[resid+l] = r + r = s + dp2 = d[l] + k + d1 = Memr[dp1] + Memr[dp1] = Memr[dp2] + Memr[dp2] = d1 + mp2 = m[l] + k + s = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = s + } + } + } + sum = sum + Memr[dp1] + n1 = n1 + 1 + nk = max (nk, j+jj) + } + } else { + for (j=n1+1; j<=nk; j=j+1) { + dp1 = d[j] + k + r = Memr[resid+j] + jj = 0 + do l = j+1, n2 { + s = Memr[resid+l] + if (s < r + TOL) { + if (s > r - TOL) + jj = jj + 1 + else { + jj = 0 + Memr[resid+l] = r + r = s + dp2 = d[l] + k + d1 = Memr[dp1] + Memr[dp1] = Memr[dp2] + Memr[dp2] = d1 + if (keepids) { + mp1 = m[j] + k + mp2 = m[l] + k + s = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = s + } + } + } + } + sum = sum + Memr[dp1] + n1 = n1 + 1 + nk = max (nk, j+jj) + } + } + } + + n[i] = n1 + if (!docombine) + if (n1 > 0) + average[i] = sum / n1 + else + average[i] = blank + } + + # Check if the data flag has to be reset for rejected pixels + if (dflag == D_ALL) { + do i = 1, npts { + if (n[i] != nin) { + dflag = D_MIX + break + } + } + } + + call sfree (sp) +end + + +# IC_CCDCLIP -- Reject pixels using CCD noise parameters about the median + +procedure ic_mccdclipr (d, m, n, scales, zeros, nm, nimages, npts, median) + +pointer d[nimages] # Data pointers +pointer m[nimages] # Image id pointers +int n[npts] # Number of good pixels +real scales[nimages] # Scales +real zeros[nimages] # Zeros +real nm[3,nimages] # Noise model +int nimages # Number of images +int npts # Number of output points per line +real median[npts] # Median + +int i, j, k, l, id, n1, n2, n3, nl, nh, nin, maxkeep +real r, s +pointer sp, resid, mp1, mp2 +real med, zero +data zero /0.0/ + +include "../icombine.com" + +begin + # There must be at least max (MINCLIP, nkeep+1) pixels. + if (nkeep < 0) + maxkeep = max (0, nimages + nkeep) + else + maxkeep = min (nimages, nkeep) + if (nimages < max (MINCLIP, maxkeep+1) || dflag == D_NONE) { + docombine = true + return + } + + call smark (sp) + call salloc (resid, nimages+1, TY_REAL) + + # Compute median and sigma and iteratively clip. + nin = n[1] + do i = 1, npts { + k = i - 1 + n1 = n[i] + if (nkeep < 0) + maxkeep = max (0, n1 + nkeep) + else + maxkeep = min (n1, nkeep) + nl = 1 + nh = n1 + + repeat { + n2 = n1 + n3 = nl + n1 / 2 + + if (n1 == 0) + med = blank + else if (mod (n1, 2) == 0) { + med = Memr[d[n3-1]+k] + med = (med + Memr[d[n3]+k]) / 2. + } else + med = Memr[d[n3]+k] + + if (n1 >= max (MINCLIP, maxkeep+1)) { + if (doscale1) { + for (; nl <= n2; nl = nl + 1) { + l = Memi[m[nl]+k] + s = scales[l] + r = max (zero, s * (med + zeros[l])) + s = sqrt (nm[1,l] + r/nm[2,l] + (r*nm[3,l])**2) / s + r = (med - Memr[d[nl]+k]) / s + if (r <= lsigma) + break + Memr[resid+nl] = r + n1 = n1 - 1 + } + for (; nh >= nl; nh = nh - 1) { + l = Memi[m[nh]+k] + s = scales[l] + r = max (zero, s * (med + zeros[l])) + s = sqrt (nm[1,l] + r/nm[2,l] + (r*nm[3,l])**2) / s + r = (Memr[d[nh]+k] - med) / s + if (r <= hsigma) + break + Memr[resid+nh] = r + n1 = n1 - 1 + } + } else { + if (!keepids) { + s = max (zero, med) + s = sqrt (nm[1,1] + s/nm[2,1] + (s*nm[3,1])**2) + } + for (; nl <= n2; nl = nl + 1) { + if (keepids) { + l = Memi[m[nl]+k] + s = max (zero, med) + s = sqrt (nm[1,l] + s/nm[2,l] + (s*nm[3,l])**2) + } + r = (med - Memr[d[nl]+k]) / s + if (r <= lsigma) + break + Memr[resid+nl] = r + n1 = n1 - 1 + } + for (; nh >= nl; nh = nh - 1) { + if (keepids) { + l = Memi[m[nh]+k] + s = max (zero, med) + s = sqrt (nm[1,l] + s/nm[2,l] + (s*nm[3,l])**2) + } + r = (Memr[d[nh]+k] - med) / s + if (r <= hsigma) + break + Memr[resid+nh] = r + n1 = n1 - 1 + } + } + } + } until (n1 == n2 || n1 < max (MINCLIP, maxkeep+1)) + + while (n1 < maxkeep) { + if (nl == 1) + nh = nh + 1 + else if (nh == n[i]) + nl = nl - 1 + else { + r = Memr[resid+nl-1] + s = Memr[resid+nh+1] + if (r < s) { + nl = nl - 1 + r = r + TOL + if (s <= r) + nh = nh + 1 + if (nl > 1) { + if (Memr[resid+nl-1] <= r) + nl = nl - 1 + } + } else { + nh = nh + 1 + s = s + TOL + if (r <= s) + nl = nl - 1 + if (nh < n2) { + if (Memr[resid+nh+1] <= s) + nh = nh + 1 + } + } + } + n1 = nh - nl + 1 + } + + # Only set median and reorder if needed + n[i] = n1 + if (n1 > 0 && nl > 1 && (combine != MEDIAN || grow > 0)) { + j = max (nl, n1 + 1) + if (keepids) { + do l = 1, min (n1, nl-1) { + Memr[d[l]+k] = Memr[d[j]+k] + if (grow > 0) { + mp1 = m[l] + k + mp2 = m[j] + k + id = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = id + } else + Memi[m[l]+k] = Memi[m[j]+k] + j = j + 1 + } + } else { + do l = 1, min (n1, nl - 1) { + Memr[d[l]+k] = Memr[d[j]+k] + j = j + 1 + } + } + } + + if (combine == MEDIAN) + median[i] = med + } + + # Check if data flag needs to be reset for rejected pixels + if (dflag == D_ALL) { + do i = 1, npts { + if (n[i] != nin) { + dflag = D_MIX + break + } + } + } + + # Flag that the median is computed. + if (combine == MEDIAN) + docombine = false + else + docombine = true + + call sfree (sp) +end diff --git a/noao/imred/ccdred/src/combine/generic/icgdata.x b/noao/imred/ccdred/src/combine/generic/icgdata.x new file mode 100644 index 00000000..5c6ac18c --- /dev/null +++ b/noao/imred/ccdred/src/combine/generic/icgdata.x @@ -0,0 +1,459 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> +include <mach.h> +include "../icombine.h" + + +# IC_GDATA -- Get line of image and mask data and apply threshold and scaling. +# Entirely empty lines are excluded. The data are compacted within the +# input data buffers. If it is required, the connection to the original +# image index is keeped in the returned m data pointers. + +procedure ic_gdatas (in, out, dbuf, d, id, n, m, lflag, offsets, scales, + zeros, nimages, npts, v1, v2) + +pointer in[nimages] # Input images +pointer out[ARB] # Output images +pointer dbuf[nimages] # Data buffers for nonaligned images +pointer d[nimages] # Data pointers +pointer id[nimages] # ID pointers +int n[npts] # Number of good pixels +pointer m[nimages] # Mask pointers +int lflag[nimages] # Empty mask flags +int offsets[nimages,ARB] # Image offsets +real scales[nimages] # Scale factors +real zeros[nimages] # Zero offset factors +int nimages # Number of input images +int npts # NUmber of output points per line +long v1[ARB], v2[ARB] # Line vectors + +int i, j, k, l, ndim, nused +real a, b +pointer buf, dp, ip, mp, imgnls() + +include "../icombine.com" + +begin + # Get masks and return if there is no data + call ic_mget (in, out, offsets, v1, v2, m, lflag, nimages) + if (dflag == D_NONE) + return + + # Get data and fill data buffers. Correct for offsets if needed. + ndim = IM_NDIM(out[1]) + do i = 1, nimages { + if (lflag[i] == D_NONE) + next + if (aligned) { + call amovl (v1, v2, IM_MAXDIM) + if (project) + v2[ndim+1] = i + j = imgnls (in[i], d[i], v2) + } else { + v2[1] = v1[1] + do j = 2, ndim + v2[j] = v1[j] - offsets[i,j] + if (project) + v2[ndim+1] = i + j = imgnls (in[i], buf, v2) + call amovs (Mems[buf], Mems[dbuf[i]+offsets[i,1]], + IM_LEN(in[i],1)) + d[i] = dbuf[i] + } + } + + # Apply threshold if needed + if (dothresh) { + do i = 1, nimages { + dp = d[i] + if (lflag[i] == D_ALL) { + do j = 1, npts { + a = Mems[dp] + if (a < lthresh || a > hthresh) { + Memi[m[i]+j-1] = 1 + lflag[i] = D_MIX + dflag = D_MIX + } + dp = dp + 1 + } + } else if (lflag[i] == D_MIX) { + mp = m[i] + do j = 1, npts { + if (Memi[mp] == 0) { + a = Mems[dp] + if (a < lthresh || a > hthresh) { + Memi[m[i]+j-1] = 1 + dflag = D_MIX + } + } + dp = dp + 1 + mp = mp + 1 + } + } + + # Check for completely empty lines + if (lflag[i] == D_MIX) { + lflag[i] = D_NONE + mp = m[i] + do j = 1, npts { + if (Memi[mp] == 0) { + lflag[i] = D_MIX + break + } + mp = mp + 1 + } + } + } + } + + # Apply scaling (avoiding masked pixels which might overflow?) + if (doscale) { + if (dflag == D_ALL) { + do i = 1, nimages { + dp = d[i] + a = scales[i] + b = -zeros[i] + do j = 1, npts { + Mems[dp] = Mems[dp] / a + b + dp = dp + 1 + } + } + } else if (dflag == D_MIX) { + do i = 1, nimages { + dp = d[i] + a = scales[i] + b = -zeros[i] + if (lflag[i] == D_ALL) { + do j = 1, npts { + Mems[dp] = Mems[dp] / a + b + dp = dp + 1 + } + } else if (lflag[i] == D_MIX) { + mp = m[i] + do j = 1, npts { + if (Memi[mp] == 0) + Mems[dp] = Mems[dp] / a + b + dp = dp + 1 + mp = mp + 1 + } + } + } + } + } + + # Sort pointers to exclude unused images. + # Use the lflag array to keep track of the image index. + + if (dflag == D_ALL) + nused = nimages + else { + nused = 0 + do i = 1, nimages + if (lflag[i] != D_NONE) { + nused = nused + 1 + d[nused] = d[i] + m[nused] = m[i] + lflag[nused] = i + } + if (nused == 0) + dflag = D_NONE + } + + # Compact data to remove bad pixels + # Keep track of the image indices if needed + # If growing mark the end of the included image indices with zero + + if (dflag == D_ALL) { + call amovki (nused, n, npts) + if (keepids) + do i = 1, nimages + call amovki (i, Memi[id[i]], npts) + } else if (dflag == D_NONE) + call aclri (n, npts) + else { + call aclri (n, npts) + if (keepids) { + do i = 1, nused { + l = lflag[i] + dp = d[i] + ip = id[i] + mp = m[i] + do j = 1, npts { + if (Memi[mp] == 0) { + n[j] = n[j] + 1 + k = n[j] + if (k < i) { + Mems[d[k]+j-1] = Mems[dp] + Memi[id[k]+j-1] = l + } else + Memi[ip] = l + } + dp = dp + 1 + ip = ip + 1 + mp = mp + 1 + } + } + if (grow > 0) { + do j = 1, npts { + do i = n[j]+1, nimages + Memi[id[i]+j-1] = 0 + } + } + } else { + do i = 1, nused { + dp = d[i] + mp = m[i] + do j = 1, npts { + if (Memi[mp] == 0) { + n[j] = n[j] + 1 + k = n[j] + if (k < i) + Mems[d[k]+j-1] = Mems[dp] + } + dp = dp + 1 + mp = mp + 1 + } + } + } + } + + # Sort the pixels and IDs if needed + if (mclip) { + call malloc (dp, nimages, TY_SHORT) + if (keepids) { + call malloc (ip, nimages, TY_INT) + call ic_2sorts (d, Mems[dp], id, Memi[ip], n, npts) + call mfree (ip, TY_INT) + } else + call ic_sorts (d, Mems[dp], n, npts) + call mfree (dp, TY_SHORT) + } +end + +# IC_GDATA -- Get line of image and mask data and apply threshold and scaling. +# Entirely empty lines are excluded. The data are compacted within the +# input data buffers. If it is required, the connection to the original +# image index is keeped in the returned m data pointers. + +procedure ic_gdatar (in, out, dbuf, d, id, n, m, lflag, offsets, scales, + zeros, nimages, npts, v1, v2) + +pointer in[nimages] # Input images +pointer out[ARB] # Output images +pointer dbuf[nimages] # Data buffers for nonaligned images +pointer d[nimages] # Data pointers +pointer id[nimages] # ID pointers +int n[npts] # Number of good pixels +pointer m[nimages] # Mask pointers +int lflag[nimages] # Empty mask flags +int offsets[nimages,ARB] # Image offsets +real scales[nimages] # Scale factors +real zeros[nimages] # Zero offset factors +int nimages # Number of input images +int npts # NUmber of output points per line +long v1[ARB], v2[ARB] # Line vectors + +int i, j, k, l, ndim, nused +real a, b +pointer buf, dp, ip, mp, imgnlr() + +include "../icombine.com" + +begin + # Get masks and return if there is no data + call ic_mget (in, out, offsets, v1, v2, m, lflag, nimages) + if (dflag == D_NONE) + return + + # Get data and fill data buffers. Correct for offsets if needed. + ndim = IM_NDIM(out[1]) + do i = 1, nimages { + if (lflag[i] == D_NONE) + next + if (aligned) { + call amovl (v1, v2, IM_MAXDIM) + if (project) + v2[ndim+1] = i + j = imgnlr (in[i], d[i], v2) + } else { + v2[1] = v1[1] + do j = 2, ndim + v2[j] = v1[j] - offsets[i,j] + if (project) + v2[ndim+1] = i + j = imgnlr (in[i], buf, v2) + call amovr (Memr[buf], Memr[dbuf[i]+offsets[i,1]], + IM_LEN(in[i],1)) + d[i] = dbuf[i] + } + } + + # Apply threshold if needed + if (dothresh) { + do i = 1, nimages { + dp = d[i] + if (lflag[i] == D_ALL) { + do j = 1, npts { + a = Memr[dp] + if (a < lthresh || a > hthresh) { + Memi[m[i]+j-1] = 1 + lflag[i] = D_MIX + dflag = D_MIX + } + dp = dp + 1 + } + } else if (lflag[i] == D_MIX) { + mp = m[i] + do j = 1, npts { + if (Memi[mp] == 0) { + a = Memr[dp] + if (a < lthresh || a > hthresh) { + Memi[m[i]+j-1] = 1 + dflag = D_MIX + } + } + dp = dp + 1 + mp = mp + 1 + } + } + + # Check for completely empty lines + if (lflag[i] == D_MIX) { + lflag[i] = D_NONE + mp = m[i] + do j = 1, npts { + if (Memi[mp] == 0) { + lflag[i] = D_MIX + break + } + mp = mp + 1 + } + } + } + } + + # Apply scaling (avoiding masked pixels which might overflow?) + if (doscale) { + if (dflag == D_ALL) { + do i = 1, nimages { + dp = d[i] + a = scales[i] + b = -zeros[i] + do j = 1, npts { + Memr[dp] = Memr[dp] / a + b + dp = dp + 1 + } + } + } else if (dflag == D_MIX) { + do i = 1, nimages { + dp = d[i] + a = scales[i] + b = -zeros[i] + if (lflag[i] == D_ALL) { + do j = 1, npts { + Memr[dp] = Memr[dp] / a + b + dp = dp + 1 + } + } else if (lflag[i] == D_MIX) { + mp = m[i] + do j = 1, npts { + if (Memi[mp] == 0) + Memr[dp] = Memr[dp] / a + b + dp = dp + 1 + mp = mp + 1 + } + } + } + } + } + + # Sort pointers to exclude unused images. + # Use the lflag array to keep track of the image index. + + if (dflag == D_ALL) + nused = nimages + else { + nused = 0 + do i = 1, nimages + if (lflag[i] != D_NONE) { + nused = nused + 1 + d[nused] = d[i] + m[nused] = m[i] + lflag[nused] = i + } + if (nused == 0) + dflag = D_NONE + } + + # Compact data to remove bad pixels + # Keep track of the image indices if needed + # If growing mark the end of the included image indices with zero + + if (dflag == D_ALL) { + call amovki (nused, n, npts) + if (keepids) + do i = 1, nimages + call amovki (i, Memi[id[i]], npts) + } else if (dflag == D_NONE) + call aclri (n, npts) + else { + call aclri (n, npts) + if (keepids) { + do i = 1, nused { + l = lflag[i] + dp = d[i] + ip = id[i] + mp = m[i] + do j = 1, npts { + if (Memi[mp] == 0) { + n[j] = n[j] + 1 + k = n[j] + if (k < i) { + Memr[d[k]+j-1] = Memr[dp] + Memi[id[k]+j-1] = l + } else + Memi[ip] = l + } + dp = dp + 1 + ip = ip + 1 + mp = mp + 1 + } + } + if (grow > 0) { + do j = 1, npts { + do i = n[j]+1, nimages + Memi[id[i]+j-1] = 0 + } + } + } else { + do i = 1, nused { + dp = d[i] + mp = m[i] + do j = 1, npts { + if (Memi[mp] == 0) { + n[j] = n[j] + 1 + k = n[j] + if (k < i) + Memr[d[k]+j-1] = Memr[dp] + } + dp = dp + 1 + mp = mp + 1 + } + } + } + } + + # Sort the pixels and IDs if needed + if (mclip) { + call malloc (dp, nimages, TY_REAL) + if (keepids) { + call malloc (ip, nimages, TY_INT) + call ic_2sortr (d, Memr[dp], id, Memi[ip], n, npts) + call mfree (ip, TY_INT) + } else + call ic_sortr (d, Memr[dp], n, npts) + call mfree (dp, TY_REAL) + } +end + diff --git a/noao/imred/ccdred/src/combine/generic/icgrow.x b/noao/imred/ccdred/src/combine/generic/icgrow.x new file mode 100644 index 00000000..b94e1cbc --- /dev/null +++ b/noao/imred/ccdred/src/combine/generic/icgrow.x @@ -0,0 +1,148 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "../icombine.h" + + +# IC_GROW -- Reject neigbors of rejected pixels. +# The rejected pixels are marked by having nonzero ids beyond the number +# of included pixels. The pixels rejected here are given zero ids +# to avoid growing of the pixels rejected here. The unweighted average +# can be updated but any rejected pixels requires the median to be +# recomputed. When the number of pixels at a grow point reaches nkeep +# no further pixels are rejected. Note that the rejection order is not +# based on the magnitude of the residuals and so a grow from a weakly +# rejected image pixel may take precedence over a grow from a strongly +# rejected image pixel. + +procedure ic_grows (d, m, n, nimages, npts, average) + +pointer d[ARB] # Data pointers +pointer m[ARB] # Image id pointers +int n[npts] # Number of good pixels +int nimages # Number of images +int npts # Number of output points per line +real average[npts] # Average + +int i1, i2, j1, j2, k1, k2, l, is, ie, n2, maxkeep +pointer mp1, mp2 + +include "../icombine.com" + +begin + if (dflag == D_NONE) + return + + do i1 = 1, npts { + k1 = i1 - 1 + is = max (1, i1 - grow) + ie = min (npts, i1 + grow) + do j1 = n[i1]+1, nimages { + l = Memi[m[j1]+k1] + if (l == 0) + next + if (combine == MEDIAN) + docombine = true + + do i2 = is, ie { + if (i2 == i1) + next + k2 = i2 - 1 + n2 = n[i2] + if (nkeep < 0) + maxkeep = max (0, n2 + nkeep) + else + maxkeep = min (n2, nkeep) + if (n2 <= maxkeep) + next + do j2 = 1, n2 { + mp1 = m[j2] + k2 + if (Memi[mp1] == l) { + if (!docombine && n2 > 1) + average[i2] = + (n2*average[i2] - Mems[d[j2]+k2]) / (n2-1) + mp2 = m[n2] + k2 + if (j2 < n2) { + Mems[d[j2]+k2] = Mems[d[n2]+k2] + Memi[mp1] = Memi[mp2] + } + Memi[mp2] = 0 + n[i2] = n2 - 1 + break + } + } + } + } + } +end + +# IC_GROW -- Reject neigbors of rejected pixels. +# The rejected pixels are marked by having nonzero ids beyond the number +# of included pixels. The pixels rejected here are given zero ids +# to avoid growing of the pixels rejected here. The unweighted average +# can be updated but any rejected pixels requires the median to be +# recomputed. When the number of pixels at a grow point reaches nkeep +# no further pixels are rejected. Note that the rejection order is not +# based on the magnitude of the residuals and so a grow from a weakly +# rejected image pixel may take precedence over a grow from a strongly +# rejected image pixel. + +procedure ic_growr (d, m, n, nimages, npts, average) + +pointer d[ARB] # Data pointers +pointer m[ARB] # Image id pointers +int n[npts] # Number of good pixels +int nimages # Number of images +int npts # Number of output points per line +real average[npts] # Average + +int i1, i2, j1, j2, k1, k2, l, is, ie, n2, maxkeep +pointer mp1, mp2 + +include "../icombine.com" + +begin + if (dflag == D_NONE) + return + + do i1 = 1, npts { + k1 = i1 - 1 + is = max (1, i1 - grow) + ie = min (npts, i1 + grow) + do j1 = n[i1]+1, nimages { + l = Memi[m[j1]+k1] + if (l == 0) + next + if (combine == MEDIAN) + docombine = true + + do i2 = is, ie { + if (i2 == i1) + next + k2 = i2 - 1 + n2 = n[i2] + if (nkeep < 0) + maxkeep = max (0, n2 + nkeep) + else + maxkeep = min (n2, nkeep) + if (n2 <= maxkeep) + next + do j2 = 1, n2 { + mp1 = m[j2] + k2 + if (Memi[mp1] == l) { + if (!docombine && n2 > 1) + average[i2] = + (n2*average[i2] - Memr[d[j2]+k2]) / (n2-1) + mp2 = m[n2] + k2 + if (j2 < n2) { + Memr[d[j2]+k2] = Memr[d[n2]+k2] + Memi[mp1] = Memi[mp2] + } + Memi[mp2] = 0 + n[i2] = n2 - 1 + break + } + } + } + } + } +end diff --git a/noao/imred/ccdred/src/combine/generic/icmedian.x b/noao/imred/ccdred/src/combine/generic/icmedian.x new file mode 100644 index 00000000..ec0166ba --- /dev/null +++ b/noao/imred/ccdred/src/combine/generic/icmedian.x @@ -0,0 +1,343 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "../icombine.h" + + +# IC_MEDIAN -- Median of lines + +procedure ic_medians (d, n, npts, median) + +pointer d[ARB] # Input data line pointers +int n[npts] # Number of good pixels +int npts # Number of output points per line +real median[npts] # Median + +int i, j, k, j1, j2, n1, lo, up, lo1, up1 +bool even +real val1, val2, val3 +short temp, wtemp + +include "../icombine.com" + +begin + # If no data return after possibly setting blank values. + if (dflag == D_NONE) { + do i = 1, npts + median[i]= blank + return + } + + # If the data were previously sorted then directly compute the median. + if (mclip) { + if (dflag == D_ALL) { + n1 = n[1] + even = (mod (n1, 2) == 0) + j1 = n1 / 2 + 1 + j2 = n1 / 2 + do i = 1, npts { + k = i - 1 + if (even) { + val1 = Mems[d[j1]+k] + val2 = Mems[d[j2]+k] + median[i] = (val1 + val2) / 2. + } else + median[i] = Mems[d[j1]+k] + } + } else { + do i = 1, npts { + k = i - 1 + n1 = n[i] + if (n1 > 0) { + j1 = n1 / 2 + 1 + if (mod (n1, 2) == 0) { + j2 = n1 / 2 + val1 = Mems[d[j1]+k] + val2 = Mems[d[j2]+k] + median[i] = (val1 + val2) / 2. + } else + median[i] = Mems[d[j1]+k] + } else + median[i] = blank + } + } + return + } + + # Compute the median. + do i = 1, npts { + k = i - 1 + n1 = n[i] + + # If there are more than 3 points use Wirth algorithm. This + # is the same as vops$amed.gx except for an even number of + # points it selects the middle two and averages. + if (n1 > 3) { + lo = 1 + up = n1 + j = max (lo, min (up, (up+1)/2)) + + while (lo < up) { + if (! (lo < up)) + break + + temp = Mems[d[j]+k]; lo1 = lo; up1 = up + + repeat { + while (Mems[d[lo1]+k] < temp) + lo1 = lo1 + 1 + while (temp < Mems[d[up1]+k]) + up1 = up1 - 1 + if (lo1 <= up1) { + wtemp = Mems[d[lo1]+k] + Mems[d[lo1]+k] = Mems[d[up1]+k] + Mems[d[up1]+k] = wtemp + lo1 = lo1 + 1; up1 = up1 - 1 + } + } until (lo1 > up1) + + if (up1 < j) + lo = lo1 + if (j < lo1) + up = up1 + } + + median[i] = Mems[d[j]+k] + + if (mod (n1,2) == 0) { + lo = 1 + up = n1 + j = max (lo, min (up, (up+1)/2)+1) + + while (lo < up) { + if (! (lo < up)) + break + + temp = Mems[d[j]+k]; lo1 = lo; up1 = up + + repeat { + while (Mems[d[lo1]+k] < temp) + lo1 = lo1 + 1 + while (temp < Mems[d[up1]+k]) + up1 = up1 - 1 + if (lo1 <= up1) { + wtemp = Mems[d[lo1]+k] + Mems[d[lo1]+k] = Mems[d[up1]+k] + Mems[d[up1]+k] = wtemp + lo1 = lo1 + 1; up1 = up1 - 1 + } + } until (lo1 > up1) + + if (up1 < j) + lo = lo1 + if (j < lo1) + up = up1 + } + median[i] = (median[i] + Mems[d[j]+k]) / 2 + } + + # If 3 points find the median directly. + } else if (n1 == 3) { + val1 = Mems[d[1]+k] + val2 = Mems[d[2]+k] + val3 = Mems[d[3]+k] + if (val1 < val2) { + if (val2 < val3) # abc + median[i] = val2 + else if (val1 < val3) # acb + median[i] = val3 + else # cab + median[i] = val1 + } else { + if (val2 > val3) # cba + median[i] = val2 + else if (val1 > val3) # bca + median[i] = val3 + else # bac + median[i] = val1 + } + + # If 2 points average. + } else if (n1 == 2) { + val1 = Mems[d[1]+k] + val2 = Mems[d[2]+k] + median[i] = (val1 + val2) / 2 + + # If 1 point return the value. + } else if (n1 == 1) + median[i] = Mems[d[1]+k] + + # If no points return with a possibly blank value. + else + median[i] = blank + } +end + +# IC_MEDIAN -- Median of lines + +procedure ic_medianr (d, n, npts, median) + +pointer d[ARB] # Input data line pointers +int n[npts] # Number of good pixels +int npts # Number of output points per line +real median[npts] # Median + +int i, j, k, j1, j2, n1, lo, up, lo1, up1 +bool even +real val1, val2, val3 +real temp, wtemp + +include "../icombine.com" + +begin + # If no data return after possibly setting blank values. + if (dflag == D_NONE) { + do i = 1, npts + median[i]= blank + return + } + + # If the data were previously sorted then directly compute the median. + if (mclip) { + if (dflag == D_ALL) { + n1 = n[1] + even = (mod (n1, 2) == 0) + j1 = n1 / 2 + 1 + j2 = n1 / 2 + do i = 1, npts { + k = i - 1 + if (even) { + val1 = Memr[d[j1]+k] + val2 = Memr[d[j2]+k] + median[i] = (val1 + val2) / 2. + } else + median[i] = Memr[d[j1]+k] + } + } else { + do i = 1, npts { + k = i - 1 + n1 = n[i] + if (n1 > 0) { + j1 = n1 / 2 + 1 + if (mod (n1, 2) == 0) { + j2 = n1 / 2 + val1 = Memr[d[j1]+k] + val2 = Memr[d[j2]+k] + median[i] = (val1 + val2) / 2. + } else + median[i] = Memr[d[j1]+k] + } else + median[i] = blank + } + } + return + } + + # Compute the median. + do i = 1, npts { + k = i - 1 + n1 = n[i] + + # If there are more than 3 points use Wirth algorithm. This + # is the same as vops$amed.gx except for an even number of + # points it selects the middle two and averages. + if (n1 > 3) { + lo = 1 + up = n1 + j = max (lo, min (up, (up+1)/2)) + + while (lo < up) { + if (! (lo < up)) + break + + temp = Memr[d[j]+k]; lo1 = lo; up1 = up + + repeat { + while (Memr[d[lo1]+k] < temp) + lo1 = lo1 + 1 + while (temp < Memr[d[up1]+k]) + up1 = up1 - 1 + if (lo1 <= up1) { + wtemp = Memr[d[lo1]+k] + Memr[d[lo1]+k] = Memr[d[up1]+k] + Memr[d[up1]+k] = wtemp + lo1 = lo1 + 1; up1 = up1 - 1 + } + } until (lo1 > up1) + + if (up1 < j) + lo = lo1 + if (j < lo1) + up = up1 + } + + median[i] = Memr[d[j]+k] + + if (mod (n1,2) == 0) { + lo = 1 + up = n1 + j = max (lo, min (up, (up+1)/2)+1) + + while (lo < up) { + if (! (lo < up)) + break + + temp = Memr[d[j]+k]; lo1 = lo; up1 = up + + repeat { + while (Memr[d[lo1]+k] < temp) + lo1 = lo1 + 1 + while (temp < Memr[d[up1]+k]) + up1 = up1 - 1 + if (lo1 <= up1) { + wtemp = Memr[d[lo1]+k] + Memr[d[lo1]+k] = Memr[d[up1]+k] + Memr[d[up1]+k] = wtemp + lo1 = lo1 + 1; up1 = up1 - 1 + } + } until (lo1 > up1) + + if (up1 < j) + lo = lo1 + if (j < lo1) + up = up1 + } + median[i] = (median[i] + Memr[d[j]+k]) / 2 + } + + # If 3 points find the median directly. + } else if (n1 == 3) { + val1 = Memr[d[1]+k] + val2 = Memr[d[2]+k] + val3 = Memr[d[3]+k] + if (val1 < val2) { + if (val2 < val3) # abc + median[i] = val2 + else if (val1 < val3) # acb + median[i] = val3 + else # cab + median[i] = val1 + } else { + if (val2 > val3) # cba + median[i] = val2 + else if (val1 > val3) # bca + median[i] = val3 + else # bac + median[i] = val1 + } + + # If 2 points average. + } else if (n1 == 2) { + val1 = Memr[d[1]+k] + val2 = Memr[d[2]+k] + median[i] = (val1 + val2) / 2 + + # If 1 point return the value. + } else if (n1 == 1) + median[i] = Memr[d[1]+k] + + # If no points return with a possibly blank value. + else + median[i] = blank + } +end + diff --git a/noao/imred/ccdred/src/combine/generic/icmm.x b/noao/imred/ccdred/src/combine/generic/icmm.x new file mode 100644 index 00000000..259759bd --- /dev/null +++ b/noao/imred/ccdred/src/combine/generic/icmm.x @@ -0,0 +1,300 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "../icombine.h" + + +# IC_MM -- Reject a specified number of high and low pixels + +procedure ic_mms (d, m, n, npts) + +pointer d[ARB] # Data pointers +pointer m[ARB] # Image ID pointers +int n[npts] # Number of good pixels +int npts # Number of output points per line + +int n1, ncombine, npairs, nlow, nhigh, np +int i, i1, j, jmax, jmin +pointer k, kmax, kmin +short d1, d2, dmin, dmax + +include "../icombine.com" + +begin + if (dflag == D_NONE) + return + + if (dflag == D_ALL) { + n1 = n[1] + nlow = flow * n1 + 0.001 + nhigh = fhigh * n1 + 0.001 + ncombine = n1 - nlow - nhigh + npairs = min (nlow, nhigh) + nlow = nlow - npairs + nhigh = nhigh - npairs + } + + do i = 1, npts { + i1 = i - 1 + n1 = n[i] + if (dflag == D_MIX) { + nlow = flow * n1 + 0.001 + nhigh = fhigh * n1 + 0.001 + ncombine = max (ncombine, n1 - nlow - nhigh) + npairs = min (nlow, nhigh) + nlow = nlow - npairs + nhigh = nhigh - npairs + } + + # Reject the npairs low and high points. + do np = 1, npairs { + k = d[1] + i1 + d1 = Mems[k] + dmax = d1; dmin = d1; jmax = 1; jmin = 1; kmax = k; kmin = k + do j = 2, n1 { + d2 = d1 + k = d[j] + i1 + d1 = Mems[k] + if (d1 > dmax) { + dmax = d1; jmax = j; kmax = k + } else if (d1 < dmin) { + dmin = d1; jmin = j; kmin = k + } + } + j = n1 - 1 + if (keepids) { + if (jmax < j) { + if (jmin != j) { + Mems[kmax] = d2 + Memi[m[jmax]+i1] = Memi[m[j]+i1] + } else { + Mems[kmax] = d1 + Memi[m[jmax]+i1] = Memi[m[n1]+i1] + } + } + if (jmin < j) { + if (jmax != n1) { + Mems[kmin] = d1 + Memi[m[jmin]+i1] = Memi[m[n1]+i1] + } else { + Mems[kmin] = d2 + Memi[m[jmin]+i1] = Memi[m[j]+i1] + } + } + } else { + if (jmax < j) { + if (jmin != j) + Mems[kmax] = d2 + else + Mems[kmax] = d1 + } + if (jmin < j) { + if (jmax != n1) + Mems[kmin] = d1 + else + Mems[kmin] = d2 + } + } + n1 = n1 - 2 + } + + # Reject the excess low points. + do np = 1, nlow { + k = d[1] + i1 + d1 = Mems[k] + dmin = d1; jmin = 1; kmin = k + do j = 2, n1 { + k = d[j] + i1 + d1 = Mems[k] + if (d1 < dmin) { + dmin = d1; jmin = j; kmin = k + } + } + if (keepids) { + if (jmin < n1) { + Mems[kmin] = d1 + Memi[m[jmin]+i1] = Memi[m[n1]+i1] + } + } else { + if (jmin < n1) + Mems[kmin] = d1 + } + n1 = n1 - 1 + } + + # Reject the excess high points. + do np = 1, nhigh { + k = d[1] + i1 + d1 = Mems[k] + dmax = d1; jmax = 1; kmax = k + do j = 2, n1 { + k = d[j] + i1 + d1 = Mems[k] + if (d1 > dmax) { + dmax = d1; jmax = j; kmax = k + } + } + if (keepids) { + if (jmax < n1) { + Mems[kmax] = d1 + Memi[m[jmax]+i1] = Memi[m[n1]+i1] + } + } else { + if (jmax < n1) + Mems[kmax] = d1 + } + n1 = n1 - 1 + } + n[i] = n1 + } + + if (dflag == D_ALL && npairs + nlow + nhigh > 0) + dflag = D_MIX +end + +# IC_MM -- Reject a specified number of high and low pixels + +procedure ic_mmr (d, m, n, npts) + +pointer d[ARB] # Data pointers +pointer m[ARB] # Image ID pointers +int n[npts] # Number of good pixels +int npts # Number of output points per line + +int n1, ncombine, npairs, nlow, nhigh, np +int i, i1, j, jmax, jmin +pointer k, kmax, kmin +real d1, d2, dmin, dmax + +include "../icombine.com" + +begin + if (dflag == D_NONE) + return + + if (dflag == D_ALL) { + n1 = n[1] + nlow = flow * n1 + 0.001 + nhigh = fhigh * n1 + 0.001 + ncombine = n1 - nlow - nhigh + npairs = min (nlow, nhigh) + nlow = nlow - npairs + nhigh = nhigh - npairs + } + + do i = 1, npts { + i1 = i - 1 + n1 = n[i] + if (dflag == D_MIX) { + nlow = flow * n1 + 0.001 + nhigh = fhigh * n1 + 0.001 + ncombine = max (ncombine, n1 - nlow - nhigh) + npairs = min (nlow, nhigh) + nlow = nlow - npairs + nhigh = nhigh - npairs + } + + # Reject the npairs low and high points. + do np = 1, npairs { + k = d[1] + i1 + d1 = Memr[k] + dmax = d1; dmin = d1; jmax = 1; jmin = 1; kmax = k; kmin = k + do j = 2, n1 { + d2 = d1 + k = d[j] + i1 + d1 = Memr[k] + if (d1 > dmax) { + dmax = d1; jmax = j; kmax = k + } else if (d1 < dmin) { + dmin = d1; jmin = j; kmin = k + } + } + j = n1 - 1 + if (keepids) { + if (jmax < j) { + if (jmin != j) { + Memr[kmax] = d2 + Memi[m[jmax]+i1] = Memi[m[j]+i1] + } else { + Memr[kmax] = d1 + Memi[m[jmax]+i1] = Memi[m[n1]+i1] + } + } + if (jmin < j) { + if (jmax != n1) { + Memr[kmin] = d1 + Memi[m[jmin]+i1] = Memi[m[n1]+i1] + } else { + Memr[kmin] = d2 + Memi[m[jmin]+i1] = Memi[m[j]+i1] + } + } + } else { + if (jmax < j) { + if (jmin != j) + Memr[kmax] = d2 + else + Memr[kmax] = d1 + } + if (jmin < j) { + if (jmax != n1) + Memr[kmin] = d1 + else + Memr[kmin] = d2 + } + } + n1 = n1 - 2 + } + + # Reject the excess low points. + do np = 1, nlow { + k = d[1] + i1 + d1 = Memr[k] + dmin = d1; jmin = 1; kmin = k + do j = 2, n1 { + k = d[j] + i1 + d1 = Memr[k] + if (d1 < dmin) { + dmin = d1; jmin = j; kmin = k + } + } + if (keepids) { + if (jmin < n1) { + Memr[kmin] = d1 + Memi[m[jmin]+i1] = Memi[m[n1]+i1] + } + } else { + if (jmin < n1) + Memr[kmin] = d1 + } + n1 = n1 - 1 + } + + # Reject the excess high points. + do np = 1, nhigh { + k = d[1] + i1 + d1 = Memr[k] + dmax = d1; jmax = 1; kmax = k + do j = 2, n1 { + k = d[j] + i1 + d1 = Memr[k] + if (d1 > dmax) { + dmax = d1; jmax = j; kmax = k + } + } + if (keepids) { + if (jmax < n1) { + Memr[kmax] = d1 + Memi[m[jmax]+i1] = Memi[m[n1]+i1] + } + } else { + if (jmax < n1) + Memr[kmax] = d1 + } + n1 = n1 - 1 + } + n[i] = n1 + } + + if (dflag == D_ALL && npairs + nlow + nhigh > 0) + dflag = D_MIX +end diff --git a/noao/imred/ccdred/src/combine/generic/icombine.x b/noao/imred/ccdred/src/combine/generic/icombine.x new file mode 100644 index 00000000..b4ff60be --- /dev/null +++ b/noao/imred/ccdred/src/combine/generic/icombine.x @@ -0,0 +1,607 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> +include <imset.h> +include <error.h> +include <syserr.h> +include <mach.h> +include "../icombine.h" + + +# ICOMBINE -- Combine images +# +# The memory and open file descriptor limits are checked and an attempt +# to recover is made either by setting the image pixel files to be +# closed after I/O or by notifying the calling program that memory +# ran out and the IMIO buffer size should be reduced. After the checks +# a procedure for the selected combine option is called. +# Because there may be several failure modes when reaching the file +# limits we first assume an error is due to the file limit, except for +# out of memory, and close some pixel files. If the error then repeats +# on accessing the pixels the error is passed back. + + +procedure icombines (in, out, offsets, nimages, bufsize) + +pointer in[nimages] # Input images +pointer out[ARB] # Output images +int offsets[nimages,ARB] # Input image offsets +int nimages # Number of input images +int bufsize # IMIO buffer size + +char str[1] +int i, j, npts, fd, stropen(), errcode(), imstati() +pointer sp, d, id, n, m, lflag, scales, zeros, wts, dbuf +pointer buf, imgl1s(), impl1i() +errchk stropen, imgl1s, impl1i +pointer impl1r() +errchk impl1r + +include "../icombine.com" + +begin + npts = IM_LEN(out[1],1) + + # Allocate memory. + call smark (sp) + call salloc (d, nimages, TY_POINTER) + call salloc (id, nimages, TY_POINTER) + call salloc (n, npts, TY_INT) + call salloc (m, nimages, TY_POINTER) + call salloc (lflag, nimages, TY_INT) + call salloc (scales, nimages, TY_REAL) + call salloc (zeros, nimages, TY_REAL) + call salloc (wts, nimages, TY_REAL) + call amovki (D_ALL, Memi[lflag], nimages) + + # If aligned use the IMIO buffer otherwise we need vectors of + # output length. + + if (!aligned) { + call salloc (dbuf, nimages, TY_POINTER) + do i = 1, nimages + call salloc (Memi[dbuf+i-1], npts, TY_SHORT) + } + + if (project) { + call imseti (in[1], IM_NBUFS, nimages) + call imseti (in[1], IM_BUFSIZE, bufsize) + do i = 1, 3 { + if (out[i] != NULL) + call imseti (out[i], IM_BUFSIZE, bufsize) + } + } else { + # Reserve FD for string operations. + fd = stropen (str, 1, NEW_FILE) + + # Do I/O to the images. + do i = 1, 3 { + if (out[i] != NULL) + call imseti (out[i], IM_BUFSIZE, bufsize) + } + buf = impl1r (out[1]) + call aclrr (Memr[buf], npts) + if (out[3] != NULL) { + buf = impl1r (out[3]) + call aclrr (Memr[buf], npts) + } + if (out[2] != NULL) { + buf = impl1i (out[2]) + call aclri (Memi[buf], npts) + } + + do i = 1, nimages { + call imseti (in[i], IM_BUFSIZE, bufsize) + iferr (buf = imgl1s (in[i])) { + switch (errcode()) { + case SYS_MFULL: + call sfree (sp) + call strclose (fd) + call erract (EA_ERROR) + case SYS_FTOOMANYFILES, SYS_IKIOPIX: + if (imstati (in[i], IM_CLOSEFD) == YES) { + call sfree (sp) + call strclose (fd) + call erract (EA_ERROR) + } + do j = i-2, nimages + call imseti (in[j], IM_CLOSEFD, YES) + buf = imgl1s (in[i]) + default: + call sfree (sp) + call strclose (fd) + call erract (EA_ERROR) + } + } + } + + call strclose (fd) + } + + call ic_combines (in, out, Memi[dbuf], Memi[d], Memi[id], Memi[n], + Memi[m], Memi[lflag], offsets, Memr[scales], Memr[zeros], + Memr[wts], nimages, npts) +end + + +# IC_COMBINE -- Combine images. + +procedure ic_combines (in, out, dbuf, d, id, n, m, lflag, offsets, + scales, zeros, wts, nimages, npts) + +pointer in[nimages] # Input images +pointer out[ARB] # Output image +pointer dbuf[nimages] # Data buffers for nonaligned images +pointer d[nimages] # Data pointers +pointer id[nimages] # Image index ID pointers +int n[npts] # Number of good pixels +pointer m[nimages] # Mask pointers +int lflag[nimages] # Line flags +int offsets[nimages,ARB] # Input image offsets +real scales[nimages] # Scale factors +real zeros[nimages] # Zero offset factors +real wts[nimages] # Combining weights +int nimages # Number of input images +int npts # Number of points per output line + +int i, ctor() +real r, imgetr() +pointer sp, v1, v2, v3, outdata, buf, nm, impnli() +pointer impnlr() +errchk ic_scale, imgetr + +include "../icombine.com" + +begin + call smark (sp) + call salloc (v1, IM_MAXDIM, TY_LONG) + call salloc (v2, IM_MAXDIM, TY_LONG) + call salloc (v3, IM_MAXDIM, TY_LONG) + call amovkl (long(1), Meml[v1], IM_MAXDIM) + call amovkl (long(1), Meml[v2], IM_MAXDIM) + call amovkl (long(1), Meml[v3], IM_MAXDIM) + + call ic_scale (in, out, offsets, scales, zeros, wts, nimages) + + # Set combine parameters + switch (combine) { + case AVERAGE: + if (dowts) + keepids = true + else + keepids = false + case MEDIAN: + dowts = false + keepids = false + } + docombine = true + + # Set rejection algorithm specific parameters + switch (reject) { + case CCDCLIP, CRREJECT: + call salloc (nm, 3*nimages, TY_REAL) + i = 1 + if (ctor (Memc[rdnoise], i, r) > 0) { + do i = 1, nimages + Memr[nm+3*(i-1)] = r + } else { + do i = 1, nimages + Memr[nm+3*(i-1)] = imgetr (in[i], Memc[rdnoise]) + } + i = 1 + if (ctor (Memc[gain], i, r) > 0) { + do i = 1, nimages { + Memr[nm+3*(i-1)+1] = r + Memr[nm+3*(i-1)] = + max ((Memr[nm+3*(i-1)] / r) ** 2, 1e4 / MAX_REAL) + } + } else { + do i = 1, nimages { + r = imgetr (in[i], Memc[gain]) + Memr[nm+3*(i-1)+1] = r + Memr[nm+3*(i-1)] = + max ((Memr[nm+3*(i-1)] / r) ** 2, 1e4 / MAX_REAL) + } + } + i = 1 + if (ctor (Memc[snoise], i, r) > 0) { + do i = 1, nimages + Memr[nm+3*(i-1)+2] = r + } else { + do i = 1, nimages { + r = imgetr (in[i], Memc[snoise]) + Memr[nm+3*(i-1)+2] = r + } + } + if (!keepids) { + if (doscale1 || grow > 0) + keepids = true + else { + do i = 2, nimages { + if (Memr[nm+3*(i-1)] != Memr[nm] || + Memr[nm+3*(i-1)+1] != Memr[nm+1] || + Memr[nm+3*(i-1)+2] != Memr[nm+2]) { + keepids = true + break + } + } + } + } + if (reject == CRREJECT) + lsigma = MAX_REAL + case MINMAX: + mclip = false + if (grow > 0) + keepids = true + case PCLIP: + mclip = true + if (grow > 0) + keepids = true + case AVSIGCLIP, SIGCLIP: + if (doscale1 || grow > 0) + keepids = true + case NONE: + mclip = false + grow = 0 + } + + if (keepids) { + do i = 1, nimages + call salloc (id[i], npts, TY_INT) + } + + while (impnlr (out[1], outdata, Meml[v1]) != EOF) { + call ic_gdatas (in, out, dbuf, d, id, n, m, lflag, offsets, + scales, zeros, nimages, npts, Meml[v2], Meml[v3]) + + switch (reject) { + case CCDCLIP, CRREJECT: + if (mclip) + call ic_mccdclips (d, id, n, scales, zeros, Memr[nm], + nimages, npts, Memr[outdata]) + else + call ic_accdclips (d, id, n, scales, zeros, Memr[nm], + nimages, npts, Memr[outdata]) + case MINMAX: + call ic_mms (d, id, n, npts) + case PCLIP: + call ic_pclips (d, id, n, nimages, npts, Memr[outdata]) + case SIGCLIP: + if (mclip) + call ic_msigclips (d, id, n, scales, zeros, nimages, npts, + Memr[outdata]) + else + call ic_asigclips (d, id, n, scales, zeros, nimages, npts, + Memr[outdata]) + case AVSIGCLIP: + if (mclip) + call ic_mavsigclips (d, id, n, scales, zeros, nimages, + npts, Memr[outdata]) + else + call ic_aavsigclips (d, id, n, scales, zeros, nimages, + npts, Memr[outdata]) + } + + if (grow > 0) + call ic_grows (d, id, n, nimages, npts, Memr[outdata]) + + if (docombine) { + switch (combine) { + case AVERAGE: + call ic_averages (d, id, n, wts, npts, Memr[outdata]) + case MEDIAN: + call ic_medians (d, n, npts, Memr[outdata]) + } + } + + if (out[2] != NULL) { + call amovl (Meml[v2], Meml[v1], IM_MAXDIM) + i = impnli (out[2], buf, Meml[v1]) + call amovki (nimages, Memi[buf], npts) + call asubi (Memi[buf], n, Memi[buf], npts) + } + + if (out[3] != NULL) { + call amovl (Meml[v2], Meml[v1], IM_MAXDIM) + i = impnlr (out[3], buf, Meml[v1]) + call ic_sigmas (d, id, n, wts, npts, Memr[outdata], + Memr[buf]) + } + call amovl (Meml[v1], Meml[v2], IM_MAXDIM) + } + + call sfree (sp) +end + +procedure icombiner (in, out, offsets, nimages, bufsize) + +pointer in[nimages] # Input images +pointer out[ARB] # Output images +int offsets[nimages,ARB] # Input image offsets +int nimages # Number of input images +int bufsize # IMIO buffer size + +char str[1] +int i, j, npts, fd, stropen(), errcode(), imstati() +pointer sp, d, id, n, m, lflag, scales, zeros, wts, dbuf +pointer buf, imgl1r(), impl1i() +errchk stropen, imgl1r, impl1i +pointer impl1r() +errchk impl1r + +include "../icombine.com" + +begin + npts = IM_LEN(out[1],1) + + # Allocate memory. + call smark (sp) + call salloc (d, nimages, TY_POINTER) + call salloc (id, nimages, TY_POINTER) + call salloc (n, npts, TY_INT) + call salloc (m, nimages, TY_POINTER) + call salloc (lflag, nimages, TY_INT) + call salloc (scales, nimages, TY_REAL) + call salloc (zeros, nimages, TY_REAL) + call salloc (wts, nimages, TY_REAL) + call amovki (D_ALL, Memi[lflag], nimages) + + # If aligned use the IMIO buffer otherwise we need vectors of + # output length. + + if (!aligned) { + call salloc (dbuf, nimages, TY_POINTER) + do i = 1, nimages + call salloc (Memi[dbuf+i-1], npts, TY_REAL) + } + + if (project) { + call imseti (in[1], IM_NBUFS, nimages) + call imseti (in[1], IM_BUFSIZE, bufsize) + do i = 1, 3 { + if (out[i] != NULL) + call imseti (out[i], IM_BUFSIZE, bufsize) + } + } else { + # Reserve FD for string operations. + fd = stropen (str, 1, NEW_FILE) + + # Do I/O to the images. + do i = 1, 3 { + if (out[i] != NULL) + call imseti (out[i], IM_BUFSIZE, bufsize) + } + buf = impl1r (out[1]) + call aclrr (Memr[buf], npts) + if (out[3] != NULL) { + buf = impl1r (out[3]) + call aclrr (Memr[buf], npts) + } + if (out[2] != NULL) { + buf = impl1i (out[2]) + call aclri (Memi[buf], npts) + } + + do i = 1, nimages { + call imseti (in[i], IM_BUFSIZE, bufsize) + iferr (buf = imgl1r (in[i])) { + switch (errcode()) { + case SYS_MFULL: + call sfree (sp) + call strclose (fd) + call erract (EA_ERROR) + case SYS_FTOOMANYFILES, SYS_IKIOPIX: + if (imstati (in[i], IM_CLOSEFD) == YES) { + call sfree (sp) + call strclose (fd) + call erract (EA_ERROR) + } + do j = i-2, nimages + call imseti (in[j], IM_CLOSEFD, YES) + buf = imgl1r (in[i]) + default: + call sfree (sp) + call strclose (fd) + call erract (EA_ERROR) + } + } + } + + call strclose (fd) + } + + call ic_combiner (in, out, Memi[dbuf], Memi[d], Memi[id], Memi[n], + Memi[m], Memi[lflag], offsets, Memr[scales], Memr[zeros], + Memr[wts], nimages, npts) +end + + +# IC_COMBINE -- Combine images. + +procedure ic_combiner (in, out, dbuf, d, id, n, m, lflag, offsets, + scales, zeros, wts, nimages, npts) + +pointer in[nimages] # Input images +pointer out[ARB] # Output image +pointer dbuf[nimages] # Data buffers for nonaligned images +pointer d[nimages] # Data pointers +pointer id[nimages] # Image index ID pointers +int n[npts] # Number of good pixels +pointer m[nimages] # Mask pointers +int lflag[nimages] # Line flags +int offsets[nimages,ARB] # Input image offsets +real scales[nimages] # Scale factors +real zeros[nimages] # Zero offset factors +real wts[nimages] # Combining weights +int nimages # Number of input images +int npts # Number of points per output line + +int i, ctor() +real r, imgetr() +pointer sp, v1, v2, v3, outdata, buf, nm, impnli() +pointer impnlr() +errchk ic_scale, imgetr + +include "../icombine.com" + +begin + call smark (sp) + call salloc (v1, IM_MAXDIM, TY_LONG) + call salloc (v2, IM_MAXDIM, TY_LONG) + call salloc (v3, IM_MAXDIM, TY_LONG) + call amovkl (long(1), Meml[v1], IM_MAXDIM) + call amovkl (long(1), Meml[v2], IM_MAXDIM) + call amovkl (long(1), Meml[v3], IM_MAXDIM) + + call ic_scale (in, out, offsets, scales, zeros, wts, nimages) + + # Set combine parameters + switch (combine) { + case AVERAGE: + if (dowts) + keepids = true + else + keepids = false + case MEDIAN: + dowts = false + keepids = false + } + docombine = true + + # Set rejection algorithm specific parameters + switch (reject) { + case CCDCLIP, CRREJECT: + call salloc (nm, 3*nimages, TY_REAL) + i = 1 + if (ctor (Memc[rdnoise], i, r) > 0) { + do i = 1, nimages + Memr[nm+3*(i-1)] = r + } else { + do i = 1, nimages + Memr[nm+3*(i-1)] = imgetr (in[i], Memc[rdnoise]) + } + i = 1 + if (ctor (Memc[gain], i, r) > 0) { + do i = 1, nimages { + Memr[nm+3*(i-1)+1] = r + Memr[nm+3*(i-1)] = + max ((Memr[nm+3*(i-1)] / r) ** 2, 1e4 / MAX_REAL) + } + } else { + do i = 1, nimages { + r = imgetr (in[i], Memc[gain]) + Memr[nm+3*(i-1)+1] = r + Memr[nm+3*(i-1)] = + max ((Memr[nm+3*(i-1)] / r) ** 2, 1e4 / MAX_REAL) + } + } + i = 1 + if (ctor (Memc[snoise], i, r) > 0) { + do i = 1, nimages + Memr[nm+3*(i-1)+2] = r + } else { + do i = 1, nimages { + r = imgetr (in[i], Memc[snoise]) + Memr[nm+3*(i-1)+2] = r + } + } + if (!keepids) { + if (doscale1 || grow > 0) + keepids = true + else { + do i = 2, nimages { + if (Memr[nm+3*(i-1)] != Memr[nm] || + Memr[nm+3*(i-1)+1] != Memr[nm+1] || + Memr[nm+3*(i-1)+2] != Memr[nm+2]) { + keepids = true + break + } + } + } + } + if (reject == CRREJECT) + lsigma = MAX_REAL + case MINMAX: + mclip = false + if (grow > 0) + keepids = true + case PCLIP: + mclip = true + if (grow > 0) + keepids = true + case AVSIGCLIP, SIGCLIP: + if (doscale1 || grow > 0) + keepids = true + case NONE: + mclip = false + grow = 0 + } + + if (keepids) { + do i = 1, nimages + call salloc (id[i], npts, TY_INT) + } + + while (impnlr (out[1], outdata, Meml[v1]) != EOF) { + call ic_gdatar (in, out, dbuf, d, id, n, m, lflag, offsets, + scales, zeros, nimages, npts, Meml[v2], Meml[v3]) + + switch (reject) { + case CCDCLIP, CRREJECT: + if (mclip) + call ic_mccdclipr (d, id, n, scales, zeros, Memr[nm], + nimages, npts, Memr[outdata]) + else + call ic_accdclipr (d, id, n, scales, zeros, Memr[nm], + nimages, npts, Memr[outdata]) + case MINMAX: + call ic_mmr (d, id, n, npts) + case PCLIP: + call ic_pclipr (d, id, n, nimages, npts, Memr[outdata]) + case SIGCLIP: + if (mclip) + call ic_msigclipr (d, id, n, scales, zeros, nimages, npts, + Memr[outdata]) + else + call ic_asigclipr (d, id, n, scales, zeros, nimages, npts, + Memr[outdata]) + case AVSIGCLIP: + if (mclip) + call ic_mavsigclipr (d, id, n, scales, zeros, nimages, + npts, Memr[outdata]) + else + call ic_aavsigclipr (d, id, n, scales, zeros, nimages, + npts, Memr[outdata]) + } + + if (grow > 0) + call ic_growr (d, id, n, nimages, npts, Memr[outdata]) + + if (docombine) { + switch (combine) { + case AVERAGE: + call ic_averager (d, id, n, wts, npts, Memr[outdata]) + case MEDIAN: + call ic_medianr (d, n, npts, Memr[outdata]) + } + } + + if (out[2] != NULL) { + call amovl (Meml[v2], Meml[v1], IM_MAXDIM) + i = impnli (out[2], buf, Meml[v1]) + call amovki (nimages, Memi[buf], npts) + call asubi (Memi[buf], n, Memi[buf], npts) + } + + if (out[3] != NULL) { + call amovl (Meml[v2], Meml[v1], IM_MAXDIM) + i = impnlr (out[3], buf, Meml[v1]) + call ic_sigmar (d, id, n, wts, npts, Memr[outdata], + Memr[buf]) + } + call amovl (Meml[v1], Meml[v2], IM_MAXDIM) + } + + call sfree (sp) +end + diff --git a/noao/imred/ccdred/src/combine/generic/icpclip.x b/noao/imred/ccdred/src/combine/generic/icpclip.x new file mode 100644 index 00000000..da09bb75 --- /dev/null +++ b/noao/imred/ccdred/src/combine/generic/icpclip.x @@ -0,0 +1,442 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "../icombine.h" + +define MINCLIP 3 # Minimum number for clipping + + +# IC_PCLIP -- Percentile clip +# +# 1) Find the median +# 2) Find the pixel which is the specified order index away +# 3) Use the data value difference as a sigma and apply clipping +# 4) Since the median is known return it so it does not have to be recomputed + +procedure ic_pclips (d, m, n, nimages, npts, median) + +pointer d[ARB] # Data pointers +pointer m[ARB] # Image id pointers +int n[npts] # Number of good pixels +int nimages # Number of input images +int npts # Number of output points per line +real median[npts] # Median + +int i, j, k, l, id, n1, n2, n3, n4, n5, nl, nh, nin, maxkeep +bool even, fp_equalr() +real sigma, r, s, t +pointer sp, resid, mp1, mp2 +real med + +include "../icombine.com" + +begin + # There must be at least MINCLIP and more than nkeep pixels. + if (nkeep < 0) + maxkeep = max (0, nimages + nkeep) + else + maxkeep = min (nimages, nkeep) + if (nimages < max (MINCLIP, maxkeep+1) || dflag == D_NONE) { + docombine = true + return + } + + call smark (sp) + call salloc (resid, nimages+1, TY_REAL) + + # Set sign of pclip parameter + if (pclip < 0) + t = -1. + else + t = 1. + + # If there are no rejected pixels compute certain parameters once. + if (dflag == D_ALL) { + n1 = n[1] + if (nkeep < 0) + maxkeep = max (0, n1 + nkeep) + else + maxkeep = min (n1, nkeep) + n2 = 1 + n1 / 2 + even = (mod (n1, 2) == 0) + if (pclip < 0.) { + if (even) + n3 = max (1, nint (n2 - 1 + pclip)) + else + n3 = max (1, nint (n2 + pclip)) + } else + n3 = min (n1, nint (n2 + pclip)) + nin = n1 + } + + # Now apply clipping. + do i = 1, npts { + # Compute median. + if (dflag == D_MIX) { + n1 = n[i] + if (nkeep < 0) + maxkeep = max (0, n1 + nkeep) + else + maxkeep = min (n1, nkeep) + if (n1 == 0) { + if (combine == MEDIAN) + median[i] = blank + next + } + n2 = 1 + n1 / 2 + even = (mod (n1, 2) == 0) + if (pclip < 0) { + if (even) + n3 = max (1, nint (n2 - 1 + pclip)) + else + n3 = max (1, nint (n2 + pclip)) + } else + n3 = min (n1, nint (n2 + pclip)) + } + + j = i - 1 + if (even) { + med = Mems[d[n2-1]+j] + med = (med + Mems[d[n2]+j]) / 2. + } else + med = Mems[d[n2]+j] + + if (n1 < max (MINCLIP, maxkeep+1)) { + if (combine == MEDIAN) + median[i] = med + next + } + + # Define sigma for clipping + sigma = t * (Mems[d[n3]+j] - med) + if (fp_equalr (sigma, 0.)) { + if (combine == MEDIAN) + median[i] = med + next + } + + # Reject pixels and save residuals. + # Check if any pixels are clipped. + # If so recompute the median and reset the number of good pixels. + # Only reorder if needed. + + for (nl=1; nl<=n1; nl=nl+1) { + r = (med - Mems[d[nl]+j]) / sigma + if (r < lsigma) + break + Memr[resid+nl] = r + } + for (nh=n1; nh>=1; nh=nh-1) { + r = (Mems[d[nh]+j] - med) / sigma + if (r < hsigma) + break + Memr[resid+nh] = r + } + n4 = nh - nl + 1 + + # If too many pixels are rejected add some back in. + # All pixels with the same residual are added. + while (n4 < maxkeep) { + if (nl == 1) + nh = nh + 1 + else if (nh == n[i]) + nl = nl - 1 + else { + r = Memr[resid+nl-1] + s = Memr[resid+nh+1] + if (r < s) { + nl = nl - 1 + r = r + TOL + if (s <= r) + nh = nh + 1 + if (nl > 1) { + if (Memr[resid+nl-1] <= r) + nl = nl - 1 + } + } else { + nh = nh + 1 + s = s + TOL + if (r <= s) + nl = nl - 1 + if (nh < n2) { + if (Memr[resid+nh+1] <= s) + nh = nh + 1 + } + } + } + n4 = nh - nl + 1 + } + + # If any pixels are rejected recompute the median. + if (nl > 1 || nh < n1) { + n5 = nl + n4 / 2 + if (mod (n4, 2) == 0) { + med = Mems[d[n5-1]+j] + med = (med + Mems[d[n5]+j]) / 2. + } else + med = Mems[d[n5]+j] + n[i] = n4 + } + if (combine == MEDIAN) + median[i] = med + + # Reorder if pixels only if necessary. + if (nl > 1 && (combine != MEDIAN || grow > 0)) { + k = max (nl, n4 + 1) + if (keepids) { + do l = 1, min (n1, nl-1) { + Mems[d[l]+j] = Mems[d[k]+j] + if (grow > 0) { + mp1 = m[l] + j + mp2 = m[k] + j + id = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = id + } else + Memi[m[l]+j] = Memi[m[k]+j] + k = k + 1 + } + } else { + do l = 1, min (n1, nl - 1) { + Mems[d[l]+j] = Mems[d[k]+j] + k = k + 1 + } + } + } + } + + # Check if data flag needs to be reset for rejected pixels. + if (dflag == D_ALL) { + do i = 1, npts { + if (n[i] != nin) { + dflag = D_MIX + break + } + } + } + + # Flag whether the median has been computed. + if (combine == MEDIAN) + docombine = false + else + docombine = true + + call sfree (sp) +end + +# IC_PCLIP -- Percentile clip +# +# 1) Find the median +# 2) Find the pixel which is the specified order index away +# 3) Use the data value difference as a sigma and apply clipping +# 4) Since the median is known return it so it does not have to be recomputed + +procedure ic_pclipr (d, m, n, nimages, npts, median) + +pointer d[ARB] # Data pointers +pointer m[ARB] # Image id pointers +int n[npts] # Number of good pixels +int nimages # Number of input images +int npts # Number of output points per line +real median[npts] # Median + +int i, j, k, l, id, n1, n2, n3, n4, n5, nl, nh, nin, maxkeep +bool even, fp_equalr() +real sigma, r, s, t +pointer sp, resid, mp1, mp2 +real med + +include "../icombine.com" + +begin + # There must be at least MINCLIP and more than nkeep pixels. + if (nkeep < 0) + maxkeep = max (0, nimages + nkeep) + else + maxkeep = min (nimages, nkeep) + if (nimages < max (MINCLIP, maxkeep+1) || dflag == D_NONE) { + docombine = true + return + } + + call smark (sp) + call salloc (resid, nimages+1, TY_REAL) + + # Set sign of pclip parameter + if (pclip < 0) + t = -1. + else + t = 1. + + # If there are no rejected pixels compute certain parameters once. + if (dflag == D_ALL) { + n1 = n[1] + if (nkeep < 0) + maxkeep = max (0, n1 + nkeep) + else + maxkeep = min (n1, nkeep) + n2 = 1 + n1 / 2 + even = (mod (n1, 2) == 0) + if (pclip < 0.) { + if (even) + n3 = max (1, nint (n2 - 1 + pclip)) + else + n3 = max (1, nint (n2 + pclip)) + } else + n3 = min (n1, nint (n2 + pclip)) + nin = n1 + } + + # Now apply clipping. + do i = 1, npts { + # Compute median. + if (dflag == D_MIX) { + n1 = n[i] + if (nkeep < 0) + maxkeep = max (0, n1 + nkeep) + else + maxkeep = min (n1, nkeep) + if (n1 == 0) { + if (combine == MEDIAN) + median[i] = blank + next + } + n2 = 1 + n1 / 2 + even = (mod (n1, 2) == 0) + if (pclip < 0) { + if (even) + n3 = max (1, nint (n2 - 1 + pclip)) + else + n3 = max (1, nint (n2 + pclip)) + } else + n3 = min (n1, nint (n2 + pclip)) + } + + j = i - 1 + if (even) { + med = Memr[d[n2-1]+j] + med = (med + Memr[d[n2]+j]) / 2. + } else + med = Memr[d[n2]+j] + + if (n1 < max (MINCLIP, maxkeep+1)) { + if (combine == MEDIAN) + median[i] = med + next + } + + # Define sigma for clipping + sigma = t * (Memr[d[n3]+j] - med) + if (fp_equalr (sigma, 0.)) { + if (combine == MEDIAN) + median[i] = med + next + } + + # Reject pixels and save residuals. + # Check if any pixels are clipped. + # If so recompute the median and reset the number of good pixels. + # Only reorder if needed. + + for (nl=1; nl<=n1; nl=nl+1) { + r = (med - Memr[d[nl]+j]) / sigma + if (r < lsigma) + break + Memr[resid+nl] = r + } + for (nh=n1; nh>=1; nh=nh-1) { + r = (Memr[d[nh]+j] - med) / sigma + if (r < hsigma) + break + Memr[resid+nh] = r + } + n4 = nh - nl + 1 + + # If too many pixels are rejected add some back in. + # All pixels with the same residual are added. + while (n4 < maxkeep) { + if (nl == 1) + nh = nh + 1 + else if (nh == n[i]) + nl = nl - 1 + else { + r = Memr[resid+nl-1] + s = Memr[resid+nh+1] + if (r < s) { + nl = nl - 1 + r = r + TOL + if (s <= r) + nh = nh + 1 + if (nl > 1) { + if (Memr[resid+nl-1] <= r) + nl = nl - 1 + } + } else { + nh = nh + 1 + s = s + TOL + if (r <= s) + nl = nl - 1 + if (nh < n2) { + if (Memr[resid+nh+1] <= s) + nh = nh + 1 + } + } + } + n4 = nh - nl + 1 + } + + # If any pixels are rejected recompute the median. + if (nl > 1 || nh < n1) { + n5 = nl + n4 / 2 + if (mod (n4, 2) == 0) { + med = Memr[d[n5-1]+j] + med = (med + Memr[d[n5]+j]) / 2. + } else + med = Memr[d[n5]+j] + n[i] = n4 + } + if (combine == MEDIAN) + median[i] = med + + # Reorder if pixels only if necessary. + if (nl > 1 && (combine != MEDIAN || grow > 0)) { + k = max (nl, n4 + 1) + if (keepids) { + do l = 1, min (n1, nl-1) { + Memr[d[l]+j] = Memr[d[k]+j] + if (grow > 0) { + mp1 = m[l] + j + mp2 = m[k] + j + id = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = id + } else + Memi[m[l]+j] = Memi[m[k]+j] + k = k + 1 + } + } else { + do l = 1, min (n1, nl - 1) { + Memr[d[l]+j] = Memr[d[k]+j] + k = k + 1 + } + } + } + } + + # Check if data flag needs to be reset for rejected pixels. + if (dflag == D_ALL) { + do i = 1, npts { + if (n[i] != nin) { + dflag = D_MIX + break + } + } + } + + # Flag whether the median has been computed. + if (combine == MEDIAN) + docombine = false + else + docombine = true + + call sfree (sp) +end diff --git a/noao/imred/ccdred/src/combine/generic/icsclip.x b/noao/imred/ccdred/src/combine/generic/icsclip.x new file mode 100644 index 00000000..d7ccfd84 --- /dev/null +++ b/noao/imred/ccdred/src/combine/generic/icsclip.x @@ -0,0 +1,964 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "../icombine.h" + +define MINCLIP 3 # Mininum number of images for algorithm + + +# IC_ASIGCLIP -- Reject pixels using sigma clipping about the average +# The initial average rejects the high and low pixels. A correction for +# different scalings of the images may be made. Weights are not used. + +procedure ic_asigclips (d, m, n, scales, zeros, nimages, npts, average) + +pointer d[nimages] # Data pointers +pointer m[nimages] # Image id pointers +int n[npts] # Number of good pixels +real scales[nimages] # Scales +real zeros[nimages] # Zeros +int nimages # Number of images +int npts # Number of output points per line +real average[npts] # Average + +int i, j, k, l, jj, n1, n2, nin, nk, maxkeep +real d1, low, high, sum, a, s, r, one +data one /1.0/ +pointer sp, resid, w, wp, dp1, dp2, mp1, mp2 + +include "../icombine.com" + +begin + # If there are insufficient pixels go on to the combining + if (nkeep < 0) + maxkeep = max (0, nimages + nkeep) + else + maxkeep = min (nimages, nkeep) + if (nimages < max (MINCLIP, maxkeep+1) || dflag == D_NONE) { + docombine = true + return + } + + # Flag whether returned average needs to be recomputed. + if (dowts || combine != AVERAGE) + docombine = true + else + docombine = false + + # Save the residuals and the sigma scaling corrections if needed. + call smark (sp) + call salloc (resid, nimages+1, TY_REAL) + if (doscale1) + call salloc (w, nimages, TY_REAL) + + # Do sigma clipping. + nin = n[1] + do i = 1, npts { + k = i - 1 + n1 = n[i] + if (nkeep < 0) + maxkeep = max (0, n1 + nkeep) + else + maxkeep = min (n1, nkeep) + + # If there are not enough pixels simply compute the average. + if (n1 < max (3, maxkeep)) { + if (!docombine) { + if (n1 == 0) + average[i] = blank + else { + sum = Mems[d[1]+k] + do j = 2, n1 + sum = sum + Mems[d[j]+k] + average[i] = sum / n1 + } + } + next + } + + # Compute average with the high and low rejected. + low = Mems[d[1]+k] + high = Mems[d[2]+k] + if (low > high) { + d1 = low + low = high + high = d1 + } + sum = 0. + do j = 3, n1 { + d1 = Mems[d[j]+k] + if (d1 < low) { + sum = sum + low + low = d1 + } else if (d1 > high) { + sum = sum + high + high = d1 + } else + sum = sum + d1 + } + a = sum / (n1 - 2) + sum = sum + low + high + + # Iteratively reject pixels and compute the final average if needed. + # Compact the data and keep track of the image IDs if needed. + + repeat { + n2 = n1 + if (doscale1) { + # Compute sigma corrected for scaling. + s = 0. + wp = w - 1 + do j = 1, n1 { + dp1 = d[j] + k + mp1 = m[j] + k + wp = wp + 1 + + d1 = Mems[dp1] + l = Memi[mp1] + r = sqrt (max (one, (a + zeros[l]) / scales[l])) + s = s + ((d1 - a) / r) ** 2 + Memr[wp] = r + } + s = sqrt (s / (n1 - 1)) + + # Reject pixels. Save the residuals and data values. + wp = w - 1 + if (s > 0.) { + for (j=1; j<=n1; j=j+1) { + dp1 = d[j] + k + mp1 = m[j] + k + wp = wp + 1 + + d1 = Mems[dp1] + r = (d1 - a) / (s * Memr[wp]) + if (r < -lsigma || r > hsigma) { + Memr[resid+n1] = abs (r) + if (j < n1) { + dp2 = d[n1] + k + Mems[dp1] = Mems[dp2] + Mems[dp2] = d1 + Memr[wp] = Memr[w+n1-1] + mp2 = m[n1] + k + l = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = l + j = j - 1 + } + sum = sum - d1 + n1 = n1 - 1 + } + } + } + } else { + # Compute the sigma without scale correction. + s = 0. + do j = 1, n1 + s = s + (Mems[d[j]+k] - a) ** 2 + s = sqrt (s / (n1 - 1)) + + # Reject pixels. Save the residuals and data values. + if (s > 0.) { + for (j=1; j<=n1; j=j+1) { + dp1 = d[j] + k + d1 = Mems[dp1] + r = (d1 - a) / s + if (r < -lsigma || r > hsigma) { + Memr[resid+n1] = abs (r) + if (j < n1) { + dp2 = d[n1] + k + Mems[dp1] = Mems[dp2] + Mems[dp2] = d1 + if (keepids) { + mp1 = m[j] + k + mp2 = m[n1] + k + l = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = l + } + j = j - 1 + } + sum = sum - d1 + n1 = n1 - 1 + } + } + } + } + + # Recompute the average. + if (n1 > 1) + a = sum / n1 + } until (n1 == n2 || n1 <= max (2, maxkeep)) + + # If too many pixels are rejected add some back. + # All pixels with equal residuals are added back. + if (n1 < maxkeep) { + nk = maxkeep + if (doscale1) { + for (j=n1+1; j<=nk; j=j+1) { + dp1 = d[j] + k + mp1 = m[j] + k + r = Memr[resid+j] + jj = 0 + do l = j+1, n2 { + s = Memr[resid+l] + if (s < r + TOL) { + if (s > r - TOL) + jj = jj + 1 + else { + jj = 0 + Memr[resid+l] = r + r = s + dp2 = d[l] + k + d1 = Mems[dp1] + Mems[dp1] = Mems[dp2] + Mems[dp2] = d1 + mp2 = m[l] + k + s = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = s + } + } + } + sum = sum + Mems[dp1] + n1 = n1 + 1 + nk = max (nk, j+jj) + } + } else { + for (j=n1+1; j<=nk; j=j+1) { + dp1 = d[j] + k + r = Memr[resid+j] + jj = 0 + do l = j+1, n2 { + s = Memr[resid+l] + if (s < r + TOL) { + if (s > r - TOL) + jj = jj + 1 + else { + jj = 0 + Memr[resid+l] = r + r = s + dp2 = d[l] + k + d1 = Mems[dp1] + Mems[dp1] = Mems[dp2] + Mems[dp2] = d1 + if (keepids) { + mp1 = m[j] + k + mp2 = m[l] + k + s = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = s + } + } + } + } + sum = sum + Mems[dp1] + n1 = n1 + 1 + nk = max (nk, j+jj) + } + } + + # Recompute the average. + if (n1 > 1) + a = sum / n1 + } + + # Save the average if needed. + n[i] = n1 + if (!docombine) { + if (n1 > 0) + average[i] = a + else + average[i] = blank + } + } + + # Check if the data flag has to be reset for rejected pixels + if (dflag == D_ALL) { + do i = 1, npts { + if (n[i] != nin) { + dflag = D_MIX + break + } + } + } + + call sfree (sp) +end + + +# IC_MSIGCLIP -- Reject pixels using sigma clipping about the median + +procedure ic_msigclips (d, m, n, scales, zeros, nimages, npts, median) + +pointer d[nimages] # Data pointers +pointer m[nimages] # Image id pointers +int n[npts] # Number of good pixels +real scales[nimages] # Scales +real zeros[nimages] # Zeros +int nimages # Number of images +int npts # Number of output points per line +real median[npts] # Median + +int i, j, k, l, id, n1, n2, n3, nl, nh, nin, maxkeep +real r, s +pointer sp, resid, w, mp1, mp2 +real med, one +data one /1.0/ + +include "../icombine.com" + +begin + # If there are insufficient pixels go on to the combining + if (nkeep < 0) + maxkeep = max (0, nimages + nkeep) + else + maxkeep = min (nimages, nkeep) + if (nimages < max (MINCLIP, maxkeep+1) || dflag == D_NONE) { + docombine = true + return + } + + # Save the residuals and sigma scaling corrections if needed. + call smark (sp) + call salloc (resid, nimages+1, TY_REAL) + if (doscale1) + call salloc (w, nimages, TY_REAL) + + # Compute median and sigma and iteratively clip. + nin = n[1] + do i = 1, npts { + k = i - 1 + n1 = n[i] + if (nkeep < 0) + maxkeep = max (0, n1 + nkeep) + else + maxkeep = min (n1, nkeep) + nl = 1 + nh = n1 + + repeat { + n2 = n1 + n3 = nl + n1 / 2 + + if (n1 == 0) + med = blank + else if (mod (n1, 2) == 0) + med = (Mems[d[n3-1]+k] + Mems[d[n3]+k]) / 2. + else + med = Mems[d[n3]+k] + + if (n1 >= max (MINCLIP, maxkeep+1)) { + if (doscale1) { + # Compute the sigma with scaling correction. + s = 0. + do j = nl, nh { + l = Memi[m[j]+k] + r = sqrt (max (one, (med + zeros[l]) / scales[l])) + s = s + ((Mems[d[j]+k] - med) / r) ** 2 + Memr[w+j-1] = r + } + s = sqrt (s / (n1 - 1)) + + # Reject pixels and save the residuals. + if (s > 0.) { + for (; nl <= n2; nl = nl + 1) { + r = (med - Mems[d[nl]+k]) / (s * Memr[w+nl-1]) + if (r <= lsigma) + break + Memr[resid+nl] = r + n1 = n1 - 1 + } + for (; nh >= nl; nh = nh - 1) { + r = (Mems[d[nh]+k] - med) / (s * Memr[w+nh-1]) + if (r <= hsigma) + break + Memr[resid+nh] = r + n1 = n1 - 1 + } + } + } else { + # Compute the sigma without scaling correction. + s = 0. + do j = nl, nh + s = s + (Mems[d[j]+k] - med) ** 2 + s = sqrt (s / (n1 - 1)) + + # Reject pixels and save the residuals. + if (s > 0.) { + for (; nl <= n2; nl = nl + 1) { + r = (med - Mems[d[nl]+k]) / s + if (r <= lsigma) + break + Memr[resid+nl] = r + n1 = n1 - 1 + } + for (; nh >= nl; nh = nh - 1) { + r = (Mems[d[nh]+k] - med) / s + if (r <= hsigma) + break + Memr[resid+nh] = r + n1 = n1 - 1 + } + } + } + } + } until (n1 == n2 || n1 < max (MINCLIP, maxkeep+1)) + + # If too many pixels are rejected add some back. + # All pixels with equal residuals are added back. + while (n1 < maxkeep) { + if (nl == 1) + nh = nh + 1 + else if (nh == n[i]) + nl = nl - 1 + else { + r = Memr[resid+nl-1] + s = Memr[resid+nh+1] + if (r < s) { + nl = nl - 1 + r = r + TOL + if (s <= r) + nh = nh + 1 + if (nl > 1) { + if (Memr[resid+nl-1] <= r) + nl = nl - 1 + } + } else { + nh = nh + 1 + s = s + TOL + if (r <= s) + nl = nl - 1 + if (nh < n2) { + if (Memr[resid+nh+1] <= s) + nh = nh + 1 + } + } + } + n1 = nh - nl + 1 + } + + # Only set median and reorder if needed + n[i] = n1 + if (n1 > 0 && nl > 1 && (combine != MEDIAN || grow > 0)) { + j = max (nl, n1 + 1) + if (keepids) { + do l = 1, min (n1, nl-1) { + Mems[d[l]+k] = Mems[d[j]+k] + if (grow > 0) { + mp1 = m[l] + k + mp2 = m[j] + k + id = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = id + } else + Memi[m[l]+k] = Memi[m[j]+k] + j = j + 1 + } + } else { + do l = 1, min (n1, nl - 1) { + Mems[d[l]+k] = Mems[d[j]+k] + j = j + 1 + } + } + } + + if (combine == MEDIAN) + median[i] = med + } + + # Check if data flag needs to be reset for rejected pixels + if (dflag == D_ALL) { + do i = 1, npts { + if (n[i] != nin) { + dflag = D_MIX + break + } + } + } + + # Flag that the median has been computed. + if (combine == MEDIAN) + docombine = false + else + docombine = true + + call sfree (sp) +end + +# IC_ASIGCLIP -- Reject pixels using sigma clipping about the average +# The initial average rejects the high and low pixels. A correction for +# different scalings of the images may be made. Weights are not used. + +procedure ic_asigclipr (d, m, n, scales, zeros, nimages, npts, average) + +pointer d[nimages] # Data pointers +pointer m[nimages] # Image id pointers +int n[npts] # Number of good pixels +real scales[nimages] # Scales +real zeros[nimages] # Zeros +int nimages # Number of images +int npts # Number of output points per line +real average[npts] # Average + +int i, j, k, l, jj, n1, n2, nin, nk, maxkeep +real d1, low, high, sum, a, s, r, one +data one /1.0/ +pointer sp, resid, w, wp, dp1, dp2, mp1, mp2 + +include "../icombine.com" + +begin + # If there are insufficient pixels go on to the combining + if (nkeep < 0) + maxkeep = max (0, nimages + nkeep) + else + maxkeep = min (nimages, nkeep) + if (nimages < max (MINCLIP, maxkeep+1) || dflag == D_NONE) { + docombine = true + return + } + + # Flag whether returned average needs to be recomputed. + if (dowts || combine != AVERAGE) + docombine = true + else + docombine = false + + # Save the residuals and the sigma scaling corrections if needed. + call smark (sp) + call salloc (resid, nimages+1, TY_REAL) + if (doscale1) + call salloc (w, nimages, TY_REAL) + + # Do sigma clipping. + nin = n[1] + do i = 1, npts { + k = i - 1 + n1 = n[i] + if (nkeep < 0) + maxkeep = max (0, n1 + nkeep) + else + maxkeep = min (n1, nkeep) + + # If there are not enough pixels simply compute the average. + if (n1 < max (3, maxkeep)) { + if (!docombine) { + if (n1 == 0) + average[i] = blank + else { + sum = Memr[d[1]+k] + do j = 2, n1 + sum = sum + Memr[d[j]+k] + average[i] = sum / n1 + } + } + next + } + + # Compute average with the high and low rejected. + low = Memr[d[1]+k] + high = Memr[d[2]+k] + if (low > high) { + d1 = low + low = high + high = d1 + } + sum = 0. + do j = 3, n1 { + d1 = Memr[d[j]+k] + if (d1 < low) { + sum = sum + low + low = d1 + } else if (d1 > high) { + sum = sum + high + high = d1 + } else + sum = sum + d1 + } + a = sum / (n1 - 2) + sum = sum + low + high + + # Iteratively reject pixels and compute the final average if needed. + # Compact the data and keep track of the image IDs if needed. + + repeat { + n2 = n1 + if (doscale1) { + # Compute sigma corrected for scaling. + s = 0. + wp = w - 1 + do j = 1, n1 { + dp1 = d[j] + k + mp1 = m[j] + k + wp = wp + 1 + + d1 = Memr[dp1] + l = Memi[mp1] + r = sqrt (max (one, (a + zeros[l]) / scales[l])) + s = s + ((d1 - a) / r) ** 2 + Memr[wp] = r + } + s = sqrt (s / (n1 - 1)) + + # Reject pixels. Save the residuals and data values. + wp = w - 1 + if (s > 0.) { + for (j=1; j<=n1; j=j+1) { + dp1 = d[j] + k + mp1 = m[j] + k + wp = wp + 1 + + d1 = Memr[dp1] + r = (d1 - a) / (s * Memr[wp]) + if (r < -lsigma || r > hsigma) { + Memr[resid+n1] = abs (r) + if (j < n1) { + dp2 = d[n1] + k + Memr[dp1] = Memr[dp2] + Memr[dp2] = d1 + Memr[wp] = Memr[w+n1-1] + mp2 = m[n1] + k + l = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = l + j = j - 1 + } + sum = sum - d1 + n1 = n1 - 1 + } + } + } + } else { + # Compute the sigma without scale correction. + s = 0. + do j = 1, n1 + s = s + (Memr[d[j]+k] - a) ** 2 + s = sqrt (s / (n1 - 1)) + + # Reject pixels. Save the residuals and data values. + if (s > 0.) { + for (j=1; j<=n1; j=j+1) { + dp1 = d[j] + k + d1 = Memr[dp1] + r = (d1 - a) / s + if (r < -lsigma || r > hsigma) { + Memr[resid+n1] = abs (r) + if (j < n1) { + dp2 = d[n1] + k + Memr[dp1] = Memr[dp2] + Memr[dp2] = d1 + if (keepids) { + mp1 = m[j] + k + mp2 = m[n1] + k + l = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = l + } + j = j - 1 + } + sum = sum - d1 + n1 = n1 - 1 + } + } + } + } + + # Recompute the average. + if (n1 > 1) + a = sum / n1 + } until (n1 == n2 || n1 <= max (2, maxkeep)) + + # If too many pixels are rejected add some back. + # All pixels with equal residuals are added back. + if (n1 < maxkeep) { + nk = maxkeep + if (doscale1) { + for (j=n1+1; j<=nk; j=j+1) { + dp1 = d[j] + k + mp1 = m[j] + k + r = Memr[resid+j] + jj = 0 + do l = j+1, n2 { + s = Memr[resid+l] + if (s < r + TOL) { + if (s > r - TOL) + jj = jj + 1 + else { + jj = 0 + Memr[resid+l] = r + r = s + dp2 = d[l] + k + d1 = Memr[dp1] + Memr[dp1] = Memr[dp2] + Memr[dp2] = d1 + mp2 = m[l] + k + s = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = s + } + } + } + sum = sum + Memr[dp1] + n1 = n1 + 1 + nk = max (nk, j+jj) + } + } else { + for (j=n1+1; j<=nk; j=j+1) { + dp1 = d[j] + k + r = Memr[resid+j] + jj = 0 + do l = j+1, n2 { + s = Memr[resid+l] + if (s < r + TOL) { + if (s > r - TOL) + jj = jj + 1 + else { + jj = 0 + Memr[resid+l] = r + r = s + dp2 = d[l] + k + d1 = Memr[dp1] + Memr[dp1] = Memr[dp2] + Memr[dp2] = d1 + if (keepids) { + mp1 = m[j] + k + mp2 = m[l] + k + s = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = s + } + } + } + } + sum = sum + Memr[dp1] + n1 = n1 + 1 + nk = max (nk, j+jj) + } + } + + # Recompute the average. + if (n1 > 1) + a = sum / n1 + } + + # Save the average if needed. + n[i] = n1 + if (!docombine) { + if (n1 > 0) + average[i] = a + else + average[i] = blank + } + } + + # Check if the data flag has to be reset for rejected pixels + if (dflag == D_ALL) { + do i = 1, npts { + if (n[i] != nin) { + dflag = D_MIX + break + } + } + } + + call sfree (sp) +end + + +# IC_MSIGCLIP -- Reject pixels using sigma clipping about the median + +procedure ic_msigclipr (d, m, n, scales, zeros, nimages, npts, median) + +pointer d[nimages] # Data pointers +pointer m[nimages] # Image id pointers +int n[npts] # Number of good pixels +real scales[nimages] # Scales +real zeros[nimages] # Zeros +int nimages # Number of images +int npts # Number of output points per line +real median[npts] # Median + +int i, j, k, l, id, n1, n2, n3, nl, nh, nin, maxkeep +real r, s +pointer sp, resid, w, mp1, mp2 +real med, one +data one /1.0/ + +include "../icombine.com" + +begin + # If there are insufficient pixels go on to the combining + if (nkeep < 0) + maxkeep = max (0, nimages + nkeep) + else + maxkeep = min (nimages, nkeep) + if (nimages < max (MINCLIP, maxkeep+1) || dflag == D_NONE) { + docombine = true + return + } + + # Save the residuals and sigma scaling corrections if needed. + call smark (sp) + call salloc (resid, nimages+1, TY_REAL) + if (doscale1) + call salloc (w, nimages, TY_REAL) + + # Compute median and sigma and iteratively clip. + nin = n[1] + do i = 1, npts { + k = i - 1 + n1 = n[i] + if (nkeep < 0) + maxkeep = max (0, n1 + nkeep) + else + maxkeep = min (n1, nkeep) + nl = 1 + nh = n1 + + repeat { + n2 = n1 + n3 = nl + n1 / 2 + + if (n1 == 0) + med = blank + else if (mod (n1, 2) == 0) + med = (Memr[d[n3-1]+k] + Memr[d[n3]+k]) / 2. + else + med = Memr[d[n3]+k] + + if (n1 >= max (MINCLIP, maxkeep+1)) { + if (doscale1) { + # Compute the sigma with scaling correction. + s = 0. + do j = nl, nh { + l = Memi[m[j]+k] + r = sqrt (max (one, (med + zeros[l]) / scales[l])) + s = s + ((Memr[d[j]+k] - med) / r) ** 2 + Memr[w+j-1] = r + } + s = sqrt (s / (n1 - 1)) + + # Reject pixels and save the residuals. + if (s > 0.) { + for (; nl <= n2; nl = nl + 1) { + r = (med - Memr[d[nl]+k]) / (s * Memr[w+nl-1]) + if (r <= lsigma) + break + Memr[resid+nl] = r + n1 = n1 - 1 + } + for (; nh >= nl; nh = nh - 1) { + r = (Memr[d[nh]+k] - med) / (s * Memr[w+nh-1]) + if (r <= hsigma) + break + Memr[resid+nh] = r + n1 = n1 - 1 + } + } + } else { + # Compute the sigma without scaling correction. + s = 0. + do j = nl, nh + s = s + (Memr[d[j]+k] - med) ** 2 + s = sqrt (s / (n1 - 1)) + + # Reject pixels and save the residuals. + if (s > 0.) { + for (; nl <= n2; nl = nl + 1) { + r = (med - Memr[d[nl]+k]) / s + if (r <= lsigma) + break + Memr[resid+nl] = r + n1 = n1 - 1 + } + for (; nh >= nl; nh = nh - 1) { + r = (Memr[d[nh]+k] - med) / s + if (r <= hsigma) + break + Memr[resid+nh] = r + n1 = n1 - 1 + } + } + } + } + } until (n1 == n2 || n1 < max (MINCLIP, maxkeep+1)) + + # If too many pixels are rejected add some back. + # All pixels with equal residuals are added back. + while (n1 < maxkeep) { + if (nl == 1) + nh = nh + 1 + else if (nh == n[i]) + nl = nl - 1 + else { + r = Memr[resid+nl-1] + s = Memr[resid+nh+1] + if (r < s) { + nl = nl - 1 + r = r + TOL + if (s <= r) + nh = nh + 1 + if (nl > 1) { + if (Memr[resid+nl-1] <= r) + nl = nl - 1 + } + } else { + nh = nh + 1 + s = s + TOL + if (r <= s) + nl = nl - 1 + if (nh < n2) { + if (Memr[resid+nh+1] <= s) + nh = nh + 1 + } + } + } + n1 = nh - nl + 1 + } + + # Only set median and reorder if needed + n[i] = n1 + if (n1 > 0 && nl > 1 && (combine != MEDIAN || grow > 0)) { + j = max (nl, n1 + 1) + if (keepids) { + do l = 1, min (n1, nl-1) { + Memr[d[l]+k] = Memr[d[j]+k] + if (grow > 0) { + mp1 = m[l] + k + mp2 = m[j] + k + id = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = id + } else + Memi[m[l]+k] = Memi[m[j]+k] + j = j + 1 + } + } else { + do l = 1, min (n1, nl - 1) { + Memr[d[l]+k] = Memr[d[j]+k] + j = j + 1 + } + } + } + + if (combine == MEDIAN) + median[i] = med + } + + # Check if data flag needs to be reset for rejected pixels + if (dflag == D_ALL) { + do i = 1, npts { + if (n[i] != nin) { + dflag = D_MIX + break + } + } + } + + # Flag that the median has been computed. + if (combine == MEDIAN) + docombine = false + else + docombine = true + + call sfree (sp) +end diff --git a/noao/imred/ccdred/src/combine/generic/icsigma.x b/noao/imred/ccdred/src/combine/generic/icsigma.x new file mode 100644 index 00000000..bc0d9788 --- /dev/null +++ b/noao/imred/ccdred/src/combine/generic/icsigma.x @@ -0,0 +1,205 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> +include "../icombine.h" + + +# IC_SIGMA -- Compute the sigma image line. +# The estimated sigma includes a correction for the finite population. +# Weights are used if desired. + +procedure ic_sigmas (d, m, n, wts, npts, average, sigma) + +pointer d[ARB] # Data pointers +pointer m[ARB] # Image ID pointers +int n[npts] # Number of points +real wts[ARB] # Weights +int npts # Number of output points per line +real average[npts] # Average +real sigma[npts] # Sigma line (returned) + +int i, j, k, n1 +real wt, sigcor, sumwt +real a, sum + +include "../icombine.com" + +begin + if (dflag == D_ALL) { + n1 = n[1] + if (dowts) { + if (n1 > 1) + sigcor = real (n1) / real (n1 - 1) + else + sigcor = 1. + do i = 1, npts { + k = i - 1 + a = average[i] + wt = wts[Memi[m[1]+k]] + sum = (Mems[d[1]+k] - a) ** 2 * wt + do j = 2, n1 { + wt = wts[Memi[m[j]+k]] + sum = sum + (Mems[d[j]+k] - a) ** 2 * wt + } + sigma[i] = sqrt (sum * sigcor) + } + } else { + if (n1 > 1) + sigcor = 1. / real (n1 - 1) + else + sigcor = 1. + do i = 1, npts { + k = i - 1 + a = average[i] + sum = (Mems[d[1]+k] - a) ** 2 + do j = 2, n1 + sum = sum + (Mems[d[j]+k] - a) ** 2 + sigma[i] = sqrt (sum * sigcor) + } + } + } else if (dflag == D_NONE) { + do i = 1, npts + sigma[i] = blank + } else { + if (dowts) { + do i = 1, npts { + n1 = n[i] + if (n1 > 0) { + k = i - 1 + if (n1 > 1) + sigcor = real (n1) / real (n1 -1) + else + sigcor = 1 + a = average[i] + wt = wts[Memi[m[1]+k]] + sum = (Mems[d[1]+k] - a) ** 2 * wt + sumwt = wt + do j = 2, n1 { + wt = wts[Memi[m[j]+k]] + sum = sum + (Mems[d[j]+k] - a) ** 2 * wt + sumwt = sumwt + wt + } + sigma[i] = sqrt (sum / sumwt * sigcor) + } else + sigma[i] = blank + } + } else { + do i = 1, npts { + n1 = n[i] + if (n1 > 0) { + k = i - 1 + if (n1 > 1) + sigcor = 1. / real (n1 - 1) + else + sigcor = 1. + a = average[i] + sum = (Mems[d[1]+k] - a) ** 2 + do j = 2, n1 + sum = sum + (Mems[d[j]+k] - a) ** 2 + sigma[i] = sqrt (sum * sigcor) + } else + sigma[i] = blank + } + } + } +end + +# IC_SIGMA -- Compute the sigma image line. +# The estimated sigma includes a correction for the finite population. +# Weights are used if desired. + +procedure ic_sigmar (d, m, n, wts, npts, average, sigma) + +pointer d[ARB] # Data pointers +pointer m[ARB] # Image ID pointers +int n[npts] # Number of points +real wts[ARB] # Weights +int npts # Number of output points per line +real average[npts] # Average +real sigma[npts] # Sigma line (returned) + +int i, j, k, n1 +real wt, sigcor, sumwt +real a, sum + +include "../icombine.com" + +begin + if (dflag == D_ALL) { + n1 = n[1] + if (dowts) { + if (n1 > 1) + sigcor = real (n1) / real (n1 - 1) + else + sigcor = 1. + do i = 1, npts { + k = i - 1 + a = average[i] + wt = wts[Memi[m[1]+k]] + sum = (Memr[d[1]+k] - a) ** 2 * wt + do j = 2, n1 { + wt = wts[Memi[m[j]+k]] + sum = sum + (Memr[d[j]+k] - a) ** 2 * wt + } + sigma[i] = sqrt (sum * sigcor) + } + } else { + if (n1 > 1) + sigcor = 1. / real (n1 - 1) + else + sigcor = 1. + do i = 1, npts { + k = i - 1 + a = average[i] + sum = (Memr[d[1]+k] - a) ** 2 + do j = 2, n1 + sum = sum + (Memr[d[j]+k] - a) ** 2 + sigma[i] = sqrt (sum * sigcor) + } + } + } else if (dflag == D_NONE) { + do i = 1, npts + sigma[i] = blank + } else { + if (dowts) { + do i = 1, npts { + n1 = n[i] + if (n1 > 0) { + k = i - 1 + if (n1 > 1) + sigcor = real (n1) / real (n1 -1) + else + sigcor = 1 + a = average[i] + wt = wts[Memi[m[1]+k]] + sum = (Memr[d[1]+k] - a) ** 2 * wt + sumwt = wt + do j = 2, n1 { + wt = wts[Memi[m[j]+k]] + sum = sum + (Memr[d[j]+k] - a) ** 2 * wt + sumwt = sumwt + wt + } + sigma[i] = sqrt (sum / sumwt * sigcor) + } else + sigma[i] = blank + } + } else { + do i = 1, npts { + n1 = n[i] + if (n1 > 0) { + k = i - 1 + if (n1 > 1) + sigcor = 1. / real (n1 - 1) + else + sigcor = 1. + a = average[i] + sum = (Memr[d[1]+k] - a) ** 2 + do j = 2, n1 + sum = sum + (Memr[d[j]+k] - a) ** 2 + sigma[i] = sqrt (sum * sigcor) + } else + sigma[i] = blank + } + } + } +end diff --git a/noao/imred/ccdred/src/combine/generic/icsort.x b/noao/imred/ccdred/src/combine/generic/icsort.x new file mode 100644 index 00000000..a39b68e2 --- /dev/null +++ b/noao/imred/ccdred/src/combine/generic/icsort.x @@ -0,0 +1,550 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +define LOGPTR 32 # log2(maxpts) (4e9) + + +# IC_SORT -- Quicksort. This is based on the VOPS asrt except that +# the input is an array of pointers to image lines and the sort is done +# across the image lines at each point along the lines. The number of +# valid pixels at each point is allowed to vary. The cases of 1, 2, and 3 +# pixels per point are treated specially. + +procedure ic_sorts (a, b, nvecs, npts) + +pointer a[ARB] # pointer to input vectors +short b[ARB] # work array +int nvecs[npts] # number of vectors +int npts # number of points in vectors + +short pivot, temp, temp3 +int i, j, k, l, p, npix, lv[LOGPTR], uv[LOGPTR] +define swap {temp=$1;$1=$2;$2=temp} +define copy_ 10 + +begin + do l = 0, npts-1 { + npix = nvecs[l+1] + if (npix <= 1) + next + + do i = 1, npix + b[i] = Mems[a[i]+l] + + # Special cases + if (npix <= 3) { + pivot = b[1] + temp = b[2] + if (npix == 2) { + if (temp < pivot) { + b[1] = temp + b[2] = pivot + } else + next + } else { + temp3 = b[3] + if (temp < pivot) { # bac|bca|cba + if (temp < temp3) { # bac|bca + b[1] = temp + if (pivot < temp3) # bac + b[2] = pivot + else { # bca + b[2] = temp3 + b[3] = pivot + } + } else { # cba + b[1] = temp3 + b[3] = pivot + } + } else if (temp3 < temp) { # acb|cab + b[3] = temp + if (pivot < temp3) # acb + b[2] = temp3 + else { # cab + b[1] = temp3 + b[2] = pivot + } + } else + next + } + goto copy_ + } + + # General case + do i = 1, npix + b[i] = Mems[a[i]+l] + + lv[1] = 1 + uv[1] = npix + p = 1 + + while (p > 0) { + if (lv[p] >= uv[p]) # only one elem in this subset + p = p - 1 # pop stack + else { + # Dummy do loop to trigger the Fortran optimizer. + do p = p, ARB { + i = lv[p] - 1 + j = uv[p] + + # Select as the pivot the element at the center of the + # array, to avoid quadratic behavior on an already + # sorted array. + + k = (lv[p] + uv[p]) / 2 + swap (b[j], b[k]) + pivot = b[j] # pivot line + + while (i < j) { + for (i=i+1; b[i] < pivot; i=i+1) + ; + for (j=j-1; j > i; j=j-1) + if (b[j] <= pivot) + break + if (i < j) # out of order pair + swap (b[i], b[j]) # interchange elements + } + + j = uv[p] # move pivot to position i + swap (b[i], b[j]) # interchange elements + + 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 + } + + break + } + p = p + 1 # push onto stack + } + } + +copy_ + do i = 1, npix + Mems[a[i]+l] = b[i] + } +end + + +# IC_2SORT -- Quicksort. This is based on the VOPS asrt except that +# the input is an array of pointers to image lines and the sort is done +# across the image lines at each point along the lines. The number of +# valid pixels at each point is allowed to vary. The cases of 1, 2, and 3 +# pixels per point are treated specially. A second integer set of +# vectors is sorted. + +procedure ic_2sorts (a, b, c, d, nvecs, npts) + +pointer a[ARB] # pointer to input vectors +short b[ARB] # work array +pointer c[ARB] # pointer to associated integer vectors +int d[ARB] # work array +int nvecs[npts] # number of vectors +int npts # number of points in vectors + +short pivot, temp, temp3 +int i, j, k, l, p, npix, lv[LOGPTR], uv[LOGPTR], itemp +define swap {temp=$1;$1=$2;$2=temp} +define iswap {itemp=$1;$1=$2;$2=itemp} +define copy_ 10 + +begin + do l = 0, npts-1 { + npix = nvecs[l+1] + if (npix <= 1) + next + + do i = 1, npix { + b[i] = Mems[a[i]+l] + d[i] = Memi[c[i]+l] + } + + # Special cases + if (npix <= 3) { + pivot = b[1] + temp = b[2] + if (npix == 2) { + if (temp < pivot) { + b[1] = temp + b[2] = pivot + iswap (d[1], d[2]) + } else + next + } else { + temp3 = b[3] + if (temp < pivot) { # bac|bca|cba + if (temp < temp3) { # bac|bca + b[1] = temp + if (pivot < temp3) { # bac + b[2] = pivot + iswap (d[1], d[2]) + } else { # bca + b[2] = temp3 + b[3] = pivot + itemp = d[2] + d[2] = d[3] + d[3] = d[1] + d[1] = itemp + } + } else { # cba + b[1] = temp3 + b[3] = pivot + iswap (d[1], d[3]) + } + } else if (temp3 < temp) { # acb|cab + b[3] = temp + if (pivot < temp3) { # acb + b[2] = temp3 + iswap (d[2], d[3]) + } else { # cab + b[1] = temp3 + b[2] = pivot + itemp = d[2] + d[2] = d[1] + d[1] = d[3] + d[3] = itemp + } + } else + next + } + goto copy_ + } + + # General case + lv[1] = 1 + uv[1] = npix + p = 1 + + while (p > 0) { + if (lv[p] >= uv[p]) # only one elem in this subset + p = p - 1 # pop stack + else { + # Dummy do loop to trigger the Fortran optimizer. + do p = p, ARB { + i = lv[p] - 1 + j = uv[p] + + # Select as the pivot the element at the center of the + # array, to avoid quadratic behavior on an already + # sorted array. + + k = (lv[p] + uv[p]) / 2 + swap (b[j], b[k]); swap (d[j], d[k]) + pivot = b[j] # pivot line + + while (i < j) { + for (i=i+1; b[i] < pivot; i=i+1) + ; + for (j=j-1; j > i; j=j-1) + if (b[j] <= pivot) + break + if (i < j) { # out of order pair + swap (b[i], b[j]) # interchange elements + swap (d[i], d[j]) + } + } + + j = uv[p] # move pivot to position i + swap (b[i], b[j]) # interchange elements + swap (d[i], d[j]) + + 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 + } + + break + } + p = p + 1 # push onto stack + } + } + +copy_ + do i = 1, npix { + Mems[a[i]+l] = b[i] + Memi[c[i]+l] = d[i] + } + } +end + +# IC_SORT -- Quicksort. This is based on the VOPS asrt except that +# the input is an array of pointers to image lines and the sort is done +# across the image lines at each point along the lines. The number of +# valid pixels at each point is allowed to vary. The cases of 1, 2, and 3 +# pixels per point are treated specially. + +procedure ic_sortr (a, b, nvecs, npts) + +pointer a[ARB] # pointer to input vectors +real b[ARB] # work array +int nvecs[npts] # number of vectors +int npts # number of points in vectors + +real pivot, temp, temp3 +int i, j, k, l, p, npix, lv[LOGPTR], uv[LOGPTR] +define swap {temp=$1;$1=$2;$2=temp} +define copy_ 10 + +begin + do l = 0, npts-1 { + npix = nvecs[l+1] + if (npix <= 1) + next + + do i = 1, npix + b[i] = Memr[a[i]+l] + + # Special cases + if (npix <= 3) { + pivot = b[1] + temp = b[2] + if (npix == 2) { + if (temp < pivot) { + b[1] = temp + b[2] = pivot + } else + next + } else { + temp3 = b[3] + if (temp < pivot) { # bac|bca|cba + if (temp < temp3) { # bac|bca + b[1] = temp + if (pivot < temp3) # bac + b[2] = pivot + else { # bca + b[2] = temp3 + b[3] = pivot + } + } else { # cba + b[1] = temp3 + b[3] = pivot + } + } else if (temp3 < temp) { # acb|cab + b[3] = temp + if (pivot < temp3) # acb + b[2] = temp3 + else { # cab + b[1] = temp3 + b[2] = pivot + } + } else + next + } + goto copy_ + } + + # General case + do i = 1, npix + b[i] = Memr[a[i]+l] + + lv[1] = 1 + uv[1] = npix + p = 1 + + while (p > 0) { + if (lv[p] >= uv[p]) # only one elem in this subset + p = p - 1 # pop stack + else { + # Dummy do loop to trigger the Fortran optimizer. + do p = p, ARB { + i = lv[p] - 1 + j = uv[p] + + # Select as the pivot the element at the center of the + # array, to avoid quadratic behavior on an already + # sorted array. + + k = (lv[p] + uv[p]) / 2 + swap (b[j], b[k]) + pivot = b[j] # pivot line + + while (i < j) { + for (i=i+1; b[i] < pivot; i=i+1) + ; + for (j=j-1; j > i; j=j-1) + if (b[j] <= pivot) + break + if (i < j) # out of order pair + swap (b[i], b[j]) # interchange elements + } + + j = uv[p] # move pivot to position i + swap (b[i], b[j]) # interchange elements + + 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 + } + + break + } + p = p + 1 # push onto stack + } + } + +copy_ + do i = 1, npix + Memr[a[i]+l] = b[i] + } +end + + +# IC_2SORT -- Quicksort. This is based on the VOPS asrt except that +# the input is an array of pointers to image lines and the sort is done +# across the image lines at each point along the lines. The number of +# valid pixels at each point is allowed to vary. The cases of 1, 2, and 3 +# pixels per point are treated specially. A second integer set of +# vectors is sorted. + +procedure ic_2sortr (a, b, c, d, nvecs, npts) + +pointer a[ARB] # pointer to input vectors +real b[ARB] # work array +pointer c[ARB] # pointer to associated integer vectors +int d[ARB] # work array +int nvecs[npts] # number of vectors +int npts # number of points in vectors + +real pivot, temp, temp3 +int i, j, k, l, p, npix, lv[LOGPTR], uv[LOGPTR], itemp +define swap {temp=$1;$1=$2;$2=temp} +define iswap {itemp=$1;$1=$2;$2=itemp} +define copy_ 10 + +begin + do l = 0, npts-1 { + npix = nvecs[l+1] + if (npix <= 1) + next + + do i = 1, npix { + b[i] = Memr[a[i]+l] + d[i] = Memi[c[i]+l] + } + + # Special cases + if (npix <= 3) { + pivot = b[1] + temp = b[2] + if (npix == 2) { + if (temp < pivot) { + b[1] = temp + b[2] = pivot + iswap (d[1], d[2]) + } else + next + } else { + temp3 = b[3] + if (temp < pivot) { # bac|bca|cba + if (temp < temp3) { # bac|bca + b[1] = temp + if (pivot < temp3) { # bac + b[2] = pivot + iswap (d[1], d[2]) + } else { # bca + b[2] = temp3 + b[3] = pivot + itemp = d[2] + d[2] = d[3] + d[3] = d[1] + d[1] = itemp + } + } else { # cba + b[1] = temp3 + b[3] = pivot + iswap (d[1], d[3]) + } + } else if (temp3 < temp) { # acb|cab + b[3] = temp + if (pivot < temp3) { # acb + b[2] = temp3 + iswap (d[2], d[3]) + } else { # cab + b[1] = temp3 + b[2] = pivot + itemp = d[2] + d[2] = d[1] + d[1] = d[3] + d[3] = itemp + } + } else + next + } + goto copy_ + } + + # General case + lv[1] = 1 + uv[1] = npix + p = 1 + + while (p > 0) { + if (lv[p] >= uv[p]) # only one elem in this subset + p = p - 1 # pop stack + else { + # Dummy do loop to trigger the Fortran optimizer. + do p = p, ARB { + i = lv[p] - 1 + j = uv[p] + + # Select as the pivot the element at the center of the + # array, to avoid quadratic behavior on an already + # sorted array. + + k = (lv[p] + uv[p]) / 2 + swap (b[j], b[k]); swap (d[j], d[k]) + pivot = b[j] # pivot line + + while (i < j) { + for (i=i+1; b[i] < pivot; i=i+1) + ; + for (j=j-1; j > i; j=j-1) + if (b[j] <= pivot) + break + if (i < j) { # out of order pair + swap (b[i], b[j]) # interchange elements + swap (d[i], d[j]) + } + } + + j = uv[p] # move pivot to position i + swap (b[i], b[j]) # interchange elements + swap (d[i], d[j]) + + 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 + } + + break + } + p = p + 1 # push onto stack + } + } + +copy_ + do i = 1, npix { + Memr[a[i]+l] = b[i] + Memi[c[i]+l] = d[i] + } + } +end diff --git a/noao/imred/ccdred/src/combine/generic/icstat.x b/noao/imred/ccdred/src/combine/generic/icstat.x new file mode 100644 index 00000000..41512ccb --- /dev/null +++ b/noao/imred/ccdred/src/combine/generic/icstat.x @@ -0,0 +1,444 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> +include "../icombine.h" + +define NMAX 10000 # Maximum number of pixels to sample + + +# IC_STAT -- Compute image statistics within specified section. +# The image section is relative to a reference image which may be +# different than the input image and may have an offset. Only a +# subsample of pixels is used. Masked and thresholded pixels are +# ignored. Only the desired statistics are computed to increase +# efficiency. + +procedure ic_stats (im, imref, section, offsets, image, nimages, + domode, domedian, domean, mode, median, mean) + +pointer im # Data image +pointer imref # Reference image for image section +char section[ARB] # Image section +int offsets[nimages,ARB] # Image section offset from data to reference +int image # Image index (for mask I/O) +int nimages # Number of images in offsets. +bool domode, domedian, domean # Statistics to compute +real mode, median, mean # Statistics + +int i, j, ndim, n, nv +real a +pointer sp, v1, v2, dv, va, vb +pointer data, mask, dp, lp, mp, imgnls() +short ic_modes() +real asums() + + +include "../icombine.com" + +begin + call smark (sp) + call salloc (v1, IM_MAXDIM, TY_LONG) + call salloc (v2, IM_MAXDIM, TY_LONG) + call salloc (dv, IM_MAXDIM, TY_LONG) + call salloc (va, IM_MAXDIM, TY_LONG) + call salloc (vb, IM_MAXDIM, TY_LONG) + + # Determine the image section parameters. This must be in terms of + # the data image pixel coordinates though the section may be specified + # in terms of the reference image coordinates. Limit the number of + # pixels in each dimension to a maximum. + + ndim = IM_NDIM(im) + if (project) + ndim = ndim - 1 + call amovki (1, Memi[v1], IM_MAXDIM) + call amovki (1, Memi[va], IM_MAXDIM) + call amovki (1, Memi[dv], IM_MAXDIM) + call amovi (IM_LEN(imref,1), Memi[vb], ndim) + call ic_section (section, Memi[va], Memi[vb], Memi[dv], ndim) + if (im != imref) + do i = 1, ndim { + Memi[va+i-1] = Memi[va+i-1] - offsets[image,i] + Memi[vb+i-1] = Memi[vb+i-1] - offsets[image,i] + } + + do j = 1, 10 { + n = 1 + do i = 0, ndim-1 { + Memi[v1+i] = max (1, min (Memi[va+i], Memi[vb+i])) + Memi[v2+i] = min (IM_LEN(im,i+1), max (Memi[va+i], Memi[vb+i])) + Memi[dv+i] = j + nv = max (1, (Memi[v2+i] - Memi[v1+i]) / Memi[dv+i] + 1) + Memi[v2+i] = Memi[v1+i] + (nv - 1) * Memi[dv+i] + n = n * nv + } + if (n < NMAX) + break + } + + call amovl (Memi[v1], Memi[va], IM_MAXDIM) + Memi[va] = 1 + if (project) + Memi[va+ndim] = image + call amovl (Memi[va], Memi[vb], IM_MAXDIM) + + # Accumulate the pixel values within the section. Masked pixels and + # thresholded pixels are ignored. + + call salloc (data, n, TY_SHORT) + dp = data + while (imgnls (im, lp, Memi[vb]) != EOF) { + call ic_mget1 (im, image, offsets[image,1], Memi[va], mask) + lp = lp + Memi[v1] - 1 + if (dflag == D_ALL) { + if (dothresh) { + do i = Memi[v1], Memi[v2], Memi[dv] { + a = Mems[lp] + if (a >= lthresh && a <= hthresh) { + Mems[dp] = a + dp = dp + 1 + } + lp = lp + Memi[dv] + } + } else { + do i = Memi[v1], Memi[v2], Memi[dv] { + Mems[dp] = Mems[lp] + dp = dp + 1 + lp = lp + Memi[dv] + } + } + } else if (dflag == D_MIX) { + mp = mask + Memi[v1] - 1 + if (dothresh) { + do i = Memi[v1], Memi[v2], Memi[dv] { + if (Memi[mp] == 0) { + a = Mems[lp] + if (a >= lthresh && a <= hthresh) { + Mems[dp] = a + dp = dp + 1 + } + } + mp = mp + Memi[dv] + lp = lp + Memi[dv] + } + } else { + do i = Memi[v1], Memi[v2], Memi[dv] { + if (Memi[mp] == 0) { + Mems[dp] = Mems[lp] + dp = dp + 1 + } + mp = mp + Memi[dv] + lp = lp + Memi[dv] + } + } + } + for (i=2; i<=ndim; i=i+1) { + Memi[va+i-1] = Memi[va+i-1] + Memi[dv+i-1] + if (Memi[va+i-1] <= Memi[v2+i-1]) + break + Memi[va+i-1] = Memi[v1+i-1] + } + if (i > ndim) + break + call amovl (Memi[va], Memi[vb], IM_MAXDIM) + } + + n = dp - data + if (n < 1) { + call sfree (sp) + call error (1, "Image section contains no pixels") + } + + # Compute only statistics needed. + if (domode || domedian) { + call asrts (Mems[data], Mems[data], n) + mode = ic_modes (Mems[data], n) + median = Mems[data+n/2-1] + } + if (domean) + mean = asums (Mems[data], n) / n + + call sfree (sp) +end + + +define NMIN 10 # Minimum number of pixels for mode calculation +define ZRANGE 0.8 # Fraction of pixels about median to use +define ZSTEP 0.01 # Step size for search for mode +define ZBIN 0.1 # Bin size for mode. + +# IC_MODE -- Compute mode of an array. The mode is found by binning +# with a bin size based on the data range over a fraction of the +# pixels about the median and a bin step which may be smaller than the +# bin size. If there are too few points the median is returned. +# The input array must be sorted. + +short procedure ic_modes (a, n) + +short a[n] # Data array +int n # Number of points + +int i, j, k, nmax +real z1, z2, zstep, zbin +short mode +bool fp_equalr() + +begin + if (n < NMIN) + return (a[n/2]) + + # Compute the mode. The array must be sorted. Consider a + # range of values about the median point. Use a bin size which + # is ZBIN of the range. Step the bin limits in ZSTEP fraction of + # the bin size. + + i = 1 + n * (1. - ZRANGE) / 2. + j = 1 + n * (1. + ZRANGE) / 2. + z1 = a[i] + z2 = a[j] + if (fp_equalr (z1, z2)) { + mode = z1 + return (mode) + } + + zstep = ZSTEP * (z2 - z1) + zbin = ZBIN * (z2 - z1) + zstep = max (1., zstep) + zbin = max (1., zbin) + + z1 = z1 - zstep + k = i + nmax = 0 + repeat { + z1 = z1 + zstep + z2 = z1 + zbin + for (; i < j && a[i] < z1; i=i+1) + ; + for (; k < j && a[k] < z2; k=k+1) + ; + if (k - i > nmax) { + nmax = k - i + mode = a[(i+k)/2] + } + } until (k >= j) + + return (mode) +end + +# IC_STAT -- Compute image statistics within specified section. +# The image section is relative to a reference image which may be +# different than the input image and may have an offset. Only a +# subsample of pixels is used. Masked and thresholded pixels are +# ignored. Only the desired statistics are computed to increase +# efficiency. + +procedure ic_statr (im, imref, section, offsets, image, nimages, + domode, domedian, domean, mode, median, mean) + +pointer im # Data image +pointer imref # Reference image for image section +char section[ARB] # Image section +int offsets[nimages,ARB] # Image section offset from data to reference +int image # Image index (for mask I/O) +int nimages # Number of images in offsets. +bool domode, domedian, domean # Statistics to compute +real mode, median, mean # Statistics + +int i, j, ndim, n, nv +real a +pointer sp, v1, v2, dv, va, vb +pointer data, mask, dp, lp, mp, imgnlr() +real ic_moder() +real asumr() + + +include "../icombine.com" + +begin + call smark (sp) + call salloc (v1, IM_MAXDIM, TY_LONG) + call salloc (v2, IM_MAXDIM, TY_LONG) + call salloc (dv, IM_MAXDIM, TY_LONG) + call salloc (va, IM_MAXDIM, TY_LONG) + call salloc (vb, IM_MAXDIM, TY_LONG) + + # Determine the image section parameters. This must be in terms of + # the data image pixel coordinates though the section may be specified + # in terms of the reference image coordinates. Limit the number of + # pixels in each dimension to a maximum. + + ndim = IM_NDIM(im) + if (project) + ndim = ndim - 1 + call amovki (1, Memi[v1], IM_MAXDIM) + call amovki (1, Memi[va], IM_MAXDIM) + call amovki (1, Memi[dv], IM_MAXDIM) + call amovi (IM_LEN(imref,1), Memi[vb], ndim) + call ic_section (section, Memi[va], Memi[vb], Memi[dv], ndim) + if (im != imref) + do i = 1, ndim { + Memi[va+i-1] = Memi[va+i-1] - offsets[image,i] + Memi[vb+i-1] = Memi[vb+i-1] - offsets[image,i] + } + + do j = 1, 10 { + n = 1 + do i = 0, ndim-1 { + Memi[v1+i] = max (1, min (Memi[va+i], Memi[vb+i])) + Memi[v2+i] = min (IM_LEN(im,i+1), max (Memi[va+i], Memi[vb+i])) + Memi[dv+i] = j + nv = max (1, (Memi[v2+i] - Memi[v1+i]) / Memi[dv+i] + 1) + Memi[v2+i] = Memi[v1+i] + (nv - 1) * Memi[dv+i] + n = n * nv + } + if (n < NMAX) + break + } + + call amovl (Memi[v1], Memi[va], IM_MAXDIM) + Memi[va] = 1 + if (project) + Memi[va+ndim] = image + call amovl (Memi[va], Memi[vb], IM_MAXDIM) + + # Accumulate the pixel values within the section. Masked pixels and + # thresholded pixels are ignored. + + call salloc (data, n, TY_REAL) + dp = data + while (imgnlr (im, lp, Memi[vb]) != EOF) { + call ic_mget1 (im, image, offsets[image,1], Memi[va], mask) + lp = lp + Memi[v1] - 1 + if (dflag == D_ALL) { + if (dothresh) { + do i = Memi[v1], Memi[v2], Memi[dv] { + a = Memr[lp] + if (a >= lthresh && a <= hthresh) { + Memr[dp] = a + dp = dp + 1 + } + lp = lp + Memi[dv] + } + } else { + do i = Memi[v1], Memi[v2], Memi[dv] { + Memr[dp] = Memr[lp] + dp = dp + 1 + lp = lp + Memi[dv] + } + } + } else if (dflag == D_MIX) { + mp = mask + Memi[v1] - 1 + if (dothresh) { + do i = Memi[v1], Memi[v2], Memi[dv] { + if (Memi[mp] == 0) { + a = Memr[lp] + if (a >= lthresh && a <= hthresh) { + Memr[dp] = a + dp = dp + 1 + } + } + mp = mp + Memi[dv] + lp = lp + Memi[dv] + } + } else { + do i = Memi[v1], Memi[v2], Memi[dv] { + if (Memi[mp] == 0) { + Memr[dp] = Memr[lp] + dp = dp + 1 + } + mp = mp + Memi[dv] + lp = lp + Memi[dv] + } + } + } + for (i=2; i<=ndim; i=i+1) { + Memi[va+i-1] = Memi[va+i-1] + Memi[dv+i-1] + if (Memi[va+i-1] <= Memi[v2+i-1]) + break + Memi[va+i-1] = Memi[v1+i-1] + } + if (i > ndim) + break + call amovl (Memi[va], Memi[vb], IM_MAXDIM) + } + + n = dp - data + if (n < 1) { + call sfree (sp) + call error (1, "Image section contains no pixels") + } + + # Compute only statistics needed. + if (domode || domedian) { + call asrtr (Memr[data], Memr[data], n) + mode = ic_moder (Memr[data], n) + median = Memr[data+n/2-1] + } + if (domean) + mean = asumr (Memr[data], n) / n + + call sfree (sp) +end + + +define NMIN 10 # Minimum number of pixels for mode calculation +define ZRANGE 0.8 # Fraction of pixels about median to use +define ZSTEP 0.01 # Step size for search for mode +define ZBIN 0.1 # Bin size for mode. + +# IC_MODE -- Compute mode of an array. The mode is found by binning +# with a bin size based on the data range over a fraction of the +# pixels about the median and a bin step which may be smaller than the +# bin size. If there are too few points the median is returned. +# The input array must be sorted. + +real procedure ic_moder (a, n) + +real a[n] # Data array +int n # Number of points + +int i, j, k, nmax +real z1, z2, zstep, zbin +real mode +bool fp_equalr() + +begin + if (n < NMIN) + return (a[n/2]) + + # Compute the mode. The array must be sorted. Consider a + # range of values about the median point. Use a bin size which + # is ZBIN of the range. Step the bin limits in ZSTEP fraction of + # the bin size. + + i = 1 + n * (1. - ZRANGE) / 2. + j = 1 + n * (1. + ZRANGE) / 2. + z1 = a[i] + z2 = a[j] + if (fp_equalr (z1, z2)) { + mode = z1 + return (mode) + } + + zstep = ZSTEP * (z2 - z1) + zbin = ZBIN * (z2 - z1) + + z1 = z1 - zstep + k = i + nmax = 0 + repeat { + z1 = z1 + zstep + z2 = z1 + zbin + for (; i < j && a[i] < z1; i=i+1) + ; + for (; k < j && a[k] < z2; k=k+1) + ; + if (k - i > nmax) { + nmax = k - i + mode = a[(i+k)/2] + } + } until (k >= j) + + return (mode) +end + diff --git a/noao/imred/ccdred/src/combine/generic/mkpkg b/noao/imred/ccdred/src/combine/generic/mkpkg new file mode 100644 index 00000000..63695459 --- /dev/null +++ b/noao/imred/ccdred/src/combine/generic/mkpkg @@ -0,0 +1,23 @@ +# Make CCDRED Package. + +$checkout libpkg.a ../../.. +$update libpkg.a +$checkin libpkg.a ../../.. +$exit + +libpkg.a: + icaclip.x ../icombine.com ../icombine.h + icaverage.x ../icombine.com ../icombine.h <imhdr.h> + iccclip.x ../icombine.com ../icombine.h + icgdata.x ../icombine.com ../icombine.h <imhdr.h> <mach.h> + icgrow.x ../icombine.com ../icombine.h + icmedian.x ../icombine.com ../icombine.h + icmm.x ../icombine.com ../icombine.h + icombine.x ../icombine.com ../icombine.h <error.h> <syserr.h>\ + <imhdr.h> <imset.h> <mach.h> + icpclip.x ../icombine.com ../icombine.h + icsclip.x ../icombine.com ../icombine.h + icsigma.x ../icombine.com ../icombine.h <imhdr.h> + icsort.x + icstat.x ../icombine.com ../icombine.h <imhdr.h> + ; diff --git a/noao/imred/ccdred/src/combine/icaclip.gx b/noao/imred/ccdred/src/combine/icaclip.gx new file mode 100644 index 00000000..bb592542 --- /dev/null +++ b/noao/imred/ccdred/src/combine/icaclip.gx @@ -0,0 +1,573 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "../icombine.h" + +define MINCLIP 3 # Minimum number of images for this algorithm + +$for (sr) +# IC_AAVSIGCLIP -- Reject pixels using an average sigma about the average +# The average sigma is normalized by the expected poisson sigma. + +procedure ic_aavsigclip$t (d, m, n, scales, zeros, nimages, npts, average) + +pointer d[nimages] # Data pointers +pointer m[nimages] # Image id pointers +int n[npts] # Number of good pixels +real scales[nimages] # Scales +real zeros[nimages] # Zeros +int nimages # Number of images +int npts # Number of output points per line +$if (datatype == sil) +real average[npts] # Average +$else +PIXEL average[npts] # Average +$endif + +int i, j, k, l, jj, n1, n2, nin, nk, maxkeep +$if (datatype == sil) +real d1, low, high, sum, a, s, s1, r, one +data one /1.0/ +$else +PIXEL d1, low, high, sum, a, s, s1, r, one +data one /1$f/ +$endif +pointer sp, sums, resid, dp1, dp2, mp1, mp2 + +include "../icombine.com" + +begin + # If there are insufficient pixels go on to the combining. + if (nkeep < 0) + maxkeep = max (0, nimages + nkeep) + else + maxkeep = min (nimages, nkeep) + if (nimages < max (MINCLIP, maxkeep+1) || dflag == D_NONE) { + docombine = true + return + } + + call smark (sp) + call salloc (sums, npts, TY_REAL) + call salloc (resid, nimages+1, TY_REAL) + + # Since the unweighted average is computed here possibly skip combining + if (dowts || combine != AVERAGE) + docombine = true + else + docombine = false + + # Compute the unweighted average with the high and low rejected and + # the poisson scaled average sigma. There must be at least three + # pixels at each point to define the average and contributions to + # the mean sigma. Corrections for differences in the image + # scale factors are selected by the doscale1 flag. + + nin = n[1] + s = 0. + n2 = 0 + do i = 1, npts { + k = i - 1 + n1 = n[i] + if (n1 < 3) + next + + # Unweighted average with the high and low rejected + low = Mem$t[d[1]+k] + high = Mem$t[d[2]+k] + if (low > high) { + d1 = low + low = high + high = d1 + } + sum = 0. + do j = 3, n1 { + d1 = Mem$t[d[j]+k] + if (d1 < low) { + sum = sum + low + low = d1 + } else if (d1 > high) { + sum = sum + high + high = d1 + } else + sum = sum + d1 + } + a = sum / (n1 - 2) + sum = sum + low + high + + # Poisson scaled sigma accumulation + if (doscale1) { + do j = 1, n1 { + dp1 = d[j] + k + mp1 = m[j] + k + + d1 = Mem$t[dp1] + l = Memi[mp1] + s1 = max (one, (a + zeros[l]) / scales[l]) + s = s + (d1 - a) ** 2 / s1 + } + } else { + s1 = max (one, a) + do j = 1, n1 + s = s + (Mem$t[d[j]+k] - a) ** 2 / s1 + } + n2 = n2 + n1 + + # Save the average and sum for later. + average[i] = a + Memr[sums+k] = sum + } + + # Here is the final sigma. + if (n2 > 1) + s = sqrt (s / (n2 - 1)) + + # Reject pixels and compute the final average (if needed). + # There must be at least three pixels at each point for rejection. + # Iteratively scale the mean sigma and reject pixels + # Compact the data and keep track of the image IDs if needed. + + do i = 1, npts { + k = i - 1 + n1 = n[i] + if (nkeep < 0) + maxkeep = max (0, n1 + nkeep) + else + maxkeep = min (n1, nkeep) + if (n1 <= max (2, maxkeep)) { + if (!docombine) { + if (n1 == 0) + average[i] = blank + else { + sum = Mem$t[d[1]+k] + do j = 2, n1 + sum = sum + Mem$t[d[j]+k] + average[i] = sum / n1 + } + } + next + } + + a = average[i] + sum = Memr[sums+k] + + repeat { + n2 = n1 + if (s > 0.) { + if (doscale1) { + for (j=1; j<=n1; j=j+1) { + dp1 = d[j] + k + mp1 = m[j] + k + + d1 = Mem$t[dp1] + l = Memi[mp1] + s1 = s * sqrt (max (one, (a+zeros[l]) / scales[l])) + r = (d1 - a) / s1 + if (r < -lsigma || r > hsigma) { + Memr[resid+n1] = abs(r) + if (j < n1) { + dp2 = d[n1] + k + Mem$t[dp1] = Mem$t[dp2] + Mem$t[dp2] = d1 + mp2 = m[n1] + k + Memi[mp1] = Memi[mp2] + Memi[mp2] = l + j = j - 1 + } + sum = sum - d1 + n1 = n1 - 1 + } + } + } else { + s1 = s * sqrt (max (one, a)) + for (j=1; j<=n1; j=j+1) { + dp1 = d[j] + k + d1 = Mem$t[dp1] + r = (d1 - a) / s1 + if (r < -lsigma || r > hsigma) { + Memr[resid+n1] = abs(r) + if (j < n1) { + dp2 = d[n1] + k + Mem$t[dp1] = Mem$t[dp2] + Mem$t[dp2] = d1 + if (keepids) { + mp1 = m[j] + k + mp2 = m[n1] + k + l = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = l + } + j = j - 1 + } + sum = sum - d1 + n1 = n1 - 1 + } + } + } + } + if (n1 > 1) + a = sum / n1 + } until (n1 == n2 || n1 <= max (2, maxkeep)) + + # If too many are rejected add some back in. + # Pixels with equal residuals are added together. + if (n1 < maxkeep) { + nk = maxkeep + if (doscale1) { + for (j=n1+1; j<=nk; j=j+1) { + dp1 = d[j] + k + mp1 = m[j] + k + r = Memr[resid+j] + jj = 0 + do l = j+1, n2 { + s = Memr[resid+l] + if (s < r + TOL) { + if (s > r - TOL) + jj = jj + 1 + else { + jj = 0 + Memr[resid+l] = r + r = s + dp2 = d[l] + k + d1 = Mem$t[dp1] + Mem$t[dp1] = Mem$t[dp2] + Mem$t[dp2] = d1 + mp2 = m[l] + k + s = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = s + } + } + } + sum = sum + Mem$t[dp1] + n1 = n1 + 1 + nk = max (nk, j+jj) + } + } else { + for (j=n1+1; j<=nk; j=j+1) { + dp1 = d[j] + k + r = Memr[resid+j] + jj = 0 + do l = j+1, n2 { + s = Memr[resid+l] + if (s < r + TOL) { + if (s > r - TOL) + jj = jj + 1 + else { + jj = 0 + Memr[resid+l] = r + r = s + dp2 = d[l] + k + d1 = Mem$t[dp1] + Mem$t[dp1] = Mem$t[dp2] + Mem$t[dp2] = d1 + if (keepids) { + mp1 = m[j] + k + mp2 = m[l] + k + s = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = s + } + } + } + } + sum = sum + Mem$t[dp1] + n1 = n1 + 1 + nk = max (nk, j+jj) + } + } + if (n1 > 1) + a = sum / n1 + } + + # Save the average if needed. + n[i] = n1 + if (!docombine) { + if (n1 > 0) + average[i] = a + else + average[i] = blank + } + } + + # Check if the data flag has to be reset for rejected pixels + if (dflag == D_ALL) { + do i = 1, npts { + if (n[i] != nin) { + dflag = D_MIX + break + } + } + } + + call sfree (sp) +end + + +# IC_MAVSIGCLIP -- Reject pixels using an average sigma about the median +# The average sigma is normalized by the expected poisson sigma. + +procedure ic_mavsigclip$t (d, m, n, scales, zeros, nimages, npts, median) + +pointer d[nimages] # Data pointers +pointer m[nimages] # Image id pointers +int n[npts] # Number of good pixels +real scales[nimages] # Scales +real zeros[nimages] # Zeros +int nimages # Number of images +int npts # Number of output points per line +$if (datatype == sil) +real median[npts] # Median +$else +PIXEL median[npts] # Median +$endif + +int i, j, k, l, id, n1, n2, n3, nl, nh, nin, maxkeep +pointer sp, resid, mp1, mp2 +$if (datatype == sil) +real med, low, high, r, s, s1, one +data one /1.0/ +$else +PIXEL med, low, high, r, s, s1, one +data one /1$f/ +$endif + +include "../icombine.com" + +begin + # If there are insufficient pixels go on to the combining. + if (nkeep < 0) + maxkeep = max (0, nimages + nkeep) + else + maxkeep = min (nimages, nkeep) + if (nimages < max (MINCLIP, maxkeep+1) || dflag == D_NONE) { + docombine = true + return + } + + call smark (sp) + call salloc (resid, nimages+1, TY_REAL) + + # Compute the poisson scaled average sigma about the median. + # There must be at least three pixels at each point to define + # the mean sigma. Corrections for differences in the image + # scale factors are selected by the doscale1 flag. + + s = 0. + n2 = 0 + nin = n[1] + do i = 1, npts { + k = i - 1 + n1 = n[i] + if (n1 < 3) { + if (n1 == 0) + median[i] = blank + else if (n1 == 1) + median[i] = Mem$t[d[1]+k] + else { + low = Mem$t[d[1]+k] + high = Mem$t[d[2]+k] + median[i] = (low + high) / 2. + } + next + } + + # Median + n3 = 1 + n1 / 2 + if (mod (n1, 2) == 0) { + low = Mem$t[d[n3-1]+k] + high = Mem$t[d[n3]+k] + med = (low + high) / 2. + } else + med = Mem$t[d[n3]+k] + + # Poisson scaled sigma accumulation + if (doscale1) { + do j = 1, n1 { + l = Memi[m[j]+k] + s1 = max (one, (med + zeros[l]) / scales[l]) + s = s + (Mem$t[d[j]+k] - med) ** 2 / s1 + } + } else { + s1 = max (one, med) + do j = 1, n1 + s = s + (Mem$t[d[j]+k] - med) ** 2 / s1 + } + n2 = n2 + n1 + + # Save the median for later. + median[i] = med + } + + # Here is the final sigma. + if (n2 > 1) + s = sqrt (s / (n2 - 1)) + else + return + + # Compute individual sigmas and iteratively clip. + do i = 1, npts { + k = i - 1 + n1 = n[i] + if (nkeep < 0) + maxkeep = max (0, n1 + nkeep) + else + maxkeep = min (n1, nkeep) + if (n1 < max (3, maxkeep+1)) + next + nl = 1 + nh = n1 + med = median[i] + + repeat { + n2 = n1 + n3 = nl + n1 / 2 + + if (n1 >= max (MINCLIP, maxkeep+1) && s > 0.) { + if (doscale1) { + for (; nl <= n2; nl = nl + 1) { + l = Memi[m[nl]+k] + s1 = s * sqrt (max (one, (med+zeros[l])/scales[l])) + r = (med - Mem$t[d[nl]+k]) / s1 + if (r <= lsigma) + break + Memr[resid+nl] = r + n1 = n1 - 1 + } + for (; nh >= nl; nh = nh - 1) { + l = Memi[m[nh]+k] + s1 = s * sqrt (max (one, (med+zeros[l])/scales[l])) + r = (Mem$t[d[nh]+k] - med) / s1 + if (r <= hsigma) + break + Memr[resid+nh] = r + n1 = n1 - 1 + } + } else { + s1 = s * sqrt (max (one, med)) + for (; nl <= n2; nl = nl + 1) { + r = (med - Mem$t[d[nl]+k]) / s1 + if (r <= lsigma) + break + Memr[resid+nl] = r + n1 = n1 - 1 + } + for (; nh >= nl; nh = nh - 1) { + r = (Mem$t[d[nh]+k] - med) / s1 + if (r <= hsigma) + break + Memr[resid+nh] = r + n1 = n1 - 1 + } + } + + # Recompute median + if (n1 < n2) { + if (n1 > 0) { + n3 = nl + n1 / 2 + if (mod (n1, 2) == 0) { + low = Mem$t[d[n3-1]+k] + high = Mem$t[d[n3]+k] + med = (low + high) / 2. + } else + med = Mem$t[d[n3]+k] + } else + med = blank + } + } + } until (n1 == n2 || n1 < max (MINCLIP, maxkeep+1)) + + # If too many are rejected add some back in. + # Pixels with equal residuals are added together. + while (n1 < maxkeep) { + if (nl == 1) + nh = nh + 1 + else if (nh == n[i]) + nl = nl - 1 + else { + r = Memr[resid+nl-1] + s = Memr[resid+nh+1] + if (r < s) { + nl = nl - 1 + r = r + TOL + if (s <= r) + nh = nh + 1 + if (nl > 1) { + if (Memr[resid+nl-1] <= r) + nl = nl - 1 + } + } else { + nh = nh + 1 + s = s + TOL + if (r <= s) + nl = nl - 1 + if (nh < n2) { + if (Memr[resid+nh+1] <= s) + nh = nh + 1 + } + } + } + n1 = nh - nl + 1 + + # Recompute median + if (n1 < n2) { + if (n1 > 0) { + n3 = nl + n1 / 2 + if (mod (n1, 2) == 0) { + low = Mem$t[d[n3-1]+k] + high = Mem$t[d[n3]+k] + med = (low + high) / 2. + } else + med = Mem$t[d[n3]+k] + } else + med = blank + } + } + + # Only set median and reorder if needed + n[i] = n1 + if (n1 > 0 && nl > 1 && (combine != MEDIAN || grow > 0)) { + j = max (nl, n1 + 1) + if (keepids) { + do l = 1, min (n1, nl-1) { + Mem$t[d[l]+k] = Mem$t[d[j]+k] + if (grow > 0) { + mp1 = m[l] + k + mp2 = m[j] + k + id = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = id + } else + Memi[m[l]+k] = Memi[m[j]+k] + j = j + 1 + } + } else { + do l = 1, min (n1, nl - 1) { + Mem$t[d[l]+k] = Mem$t[d[j]+k] + j = j + 1 + } + } + } + + if (combine == MEDIAN) + median[i] = med + } + + # Check if data flag needs to be reset for rejected pixels + if (dflag == D_ALL) { + do i = 1, npts { + if (n[i] != nin) { + dflag = D_MIX + break + } + } + } + + # Flag that the median is computed. + if (combine == MEDIAN) + docombine = false + else + docombine = true + + call sfree (sp) +end +$endfor diff --git a/noao/imred/ccdred/src/combine/icaverage.gx b/noao/imred/ccdred/src/combine/icaverage.gx new file mode 100644 index 00000000..c145bb33 --- /dev/null +++ b/noao/imred/ccdred/src/combine/icaverage.gx @@ -0,0 +1,93 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> +include "../icombine.h" + +$for (sr) +# IC_AVERAGE -- Compute the average image line. +# Options include a weight average. + +procedure ic_average$t (d, m, n, wts, npts, average) + +pointer d[ARB] # Data pointers +pointer m[ARB] # Image ID pointers +int n[npts] # Number of points +real wts[ARB] # Weights +int npts # Number of output points per line +$if (datatype == sil) +real average[npts] # Average (returned) +$else +PIXEL average[npts] # Average (returned) +$endif + +int i, j, k +real sumwt, wt +$if (datatype == sil) +real sum +$else +PIXEL sum +$endif + +include "../icombine.com" + +begin + # If no data has been excluded do the average without checking the + # number of points and using the fact that the weights are normalized. + # If all the data has been excluded set the average to the blank value. + + if (dflag == D_ALL) { + if (dowts) { + do i = 1, npts { + k = i - 1 + wt = wts[Memi[m[1]+k]] + sum = Mem$t[d[1]+k] * wt + do j = 2, n[i] { + wt = wts[Memi[m[j]+k]] + sum = sum + Mem$t[d[j]+k] * wt + } + average[i] = sum + } + } else { + do i = 1, npts { + k = i - 1 + sum = Mem$t[d[1]+k] + do j = 2, n[i] + sum = sum + Mem$t[d[j]+k] + average[i] = sum / n[i] + } + } + } else if (dflag == D_NONE) { + do i = 1, npts + average[i] = blank + } else { + if (dowts) { + do i = 1, npts { + if (n[i] > 0) { + k = i - 1 + wt = wts[Memi[m[1]+k]] + sum = Mem$t[d[1]+k] * wt + sumwt = wt + do j = 2, n[i] { + wt = wts[Memi[m[j]+k]] + sum = sum + Mem$t[d[j]+k] * wt + sumwt = sumwt + wt + } + average[i] = sum / sumwt + } else + average[i] = blank + } + } else { + do i = 1, npts { + if (n[i] > 0) { + k = i - 1 + sum = Mem$t[d[1]+k] + do j = 2, n[i] + sum = sum + Mem$t[d[j]+k] + average[i] = sum / n[i] + } else + average[i] = blank + } + } + } +end +$endfor diff --git a/noao/imred/ccdred/src/combine/iccclip.gx b/noao/imred/ccdred/src/combine/iccclip.gx new file mode 100644 index 00000000..69df984c --- /dev/null +++ b/noao/imred/ccdred/src/combine/iccclip.gx @@ -0,0 +1,471 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "../icombine.h" + +define MINCLIP 2 # Mininum number of images for algorithm + +$for (sr) +# IC_ACCDCLIP -- Reject pixels using CCD noise parameters about the average + +procedure ic_accdclip$t (d, m, n, scales, zeros, nm, nimages, npts, average) + +pointer d[nimages] # Data pointers +pointer m[nimages] # Image id pointers +int n[npts] # Number of good pixels +real scales[nimages] # Scales +real zeros[nimages] # Zeros +real nm[3,nimages] # Noise model parameters +int nimages # Number of images +int npts # Number of output points per line +$if (datatype == sil) +real average[npts] # Average +$else +PIXEL average[npts] # Average +$endif + +int i, j, k, l, jj, n1, n2, nin, nk, maxkeep +$if (datatype == sil) +real d1, low, high, sum, a, s, r, zero +data zero /0.0/ +$else +PIXEL d1, low, high, sum, a, s, r, zero +data zero /0$f/ +$endif +pointer sp, resid, dp1, dp2, mp1, mp2 + +include "../icombine.com" + +begin + # If there are no pixels go on to the combining. Since the unweighted + # average is computed here possibly skip the combining later. + + # There must be at least max (1, nkeep) pixels. + if (nkeep < 0) + maxkeep = max (0, nimages + nkeep) + else + maxkeep = min (nimages, nkeep) + if (nimages < max (MINCLIP, maxkeep+1) || dflag == D_NONE) { + docombine = true + return + } else if (dowts || combine != AVERAGE) + docombine = true + else + docombine = false + + call smark (sp) + call salloc (resid, nimages+1, TY_REAL) + + # There must be at least two pixels for rejection. The initial + # average is the low/high rejected average except in the case of + # just two pixels. The rejections are iterated and the average + # is recomputed. Corrections for scaling may be performed. + # Depending on other flags the image IDs may also need to be adjusted. + + nin = n[1] + do i = 1, npts { + k = i - 1 + n1 = n[i] + if (nkeep < 0) + maxkeep = max (0, n1 + nkeep) + else + maxkeep = min (n1, nkeep) + if (n1 <= max (MINCLIP-1, maxkeep)) { + if (!docombine) { + if (n1 == 0) + average[i] = blank + else { + sum = Mem$t[d[1]+k] + do j = 2, n1 + sum = sum + Mem$t[d[j]+k] + average[i] = sum / n1 + } + } + next + } + + repeat { + if (n1 == 2) { + sum = Mem$t[d[1]+k] + sum = sum + Mem$t[d[2]+k] + a = sum / 2 + } else { + low = Mem$t[d[1]+k] + high = Mem$t[d[2]+k] + if (low > high) { + d1 = low + low = high + high = d1 + } + sum = 0. + do j = 3, n1 { + d1 = Mem$t[d[j]+k] + if (d1 < low) { + sum = sum + low + low = d1 + } else if (d1 > high) { + sum = sum + high + high = d1 + } else + sum = sum + d1 + } + a = sum / (n1 - 2) + sum = sum + low + high + } + n2 = n1 + if (doscale1) { + for (j=1; j<=n1; j=j+1) { + dp1 = d[j] + k + mp1 = m[j] + k + + l = Memi[mp1] + s = scales[l] + d1 = max (zero, s * (a + zeros[l])) + s = sqrt (nm[1,l] + d1/nm[2,l] + (d1*nm[3,l])**2) / s + + d1 = Mem$t[dp1] + r = (d1 - a) / s + if (r < -lsigma || r > hsigma) { + Memr[resid+n1] = abs(r) + if (j < n1) { + dp2 = d[n1] + k + Mem$t[dp1] = Mem$t[dp2] + Mem$t[dp2] = d1 + mp2 = m[n1] + k + Memi[mp1] = Memi[mp2] + Memi[mp2] = l + j = j - 1 + } + sum = sum - d1 + n1 = n1 - 1 + } + } + } else { + if (!keepids) { + s = max (zero, a) + s = sqrt (nm[1,1] + s/nm[2,1] + (s*nm[3,1])**2) + } + for (j=1; j<=n1; j=j+1) { + if (keepids) { + l = Memi[m[j]+k] + s = max (zero, a) + s = sqrt (nm[1,l] + s/nm[2,l] + (s*nm[3,l])**2) + } + dp1 = d[j] + k + d1 = Mem$t[dp1] + r = (d1 - a) / s + if (r < -lsigma || r > hsigma) { + Memr[resid+n1] = abs(r) + if (j < n1) { + dp2 = d[n1] + k + Mem$t[dp1] = Mem$t[dp2] + Mem$t[dp2] = d1 + if (keepids) { + mp1 = m[j] + k + mp2 = m[n1] + k + l = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = l + } + j = j - 1 + } + sum = sum - d1 + n1 = n1 - 1 + } + } + } + } until (n1 == n2 || n1 < max (MINCLIP, maxkeep+1)) + + if (n1 < maxkeep) { + nk = maxkeep + if (doscale1) { + for (j=n1+1; j<=nk; j=j+1) { + dp1 = d[j] + k + mp1 = m[j] + k + r = Memr[resid+j] + jj = 0 + do l = j+1, n2 { + s = Memr[resid+l] + if (s < r + TOL) { + if (s > r - TOL) + jj = jj + 1 + else { + jj = 0 + Memr[resid+l] = r + r = s + dp2 = d[l] + k + d1 = Mem$t[dp1] + Mem$t[dp1] = Mem$t[dp2] + Mem$t[dp2] = d1 + mp2 = m[l] + k + s = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = s + } + } + } + sum = sum + Mem$t[dp1] + n1 = n1 + 1 + nk = max (nk, j+jj) + } + } else { + for (j=n1+1; j<=nk; j=j+1) { + dp1 = d[j] + k + r = Memr[resid+j] + jj = 0 + do l = j+1, n2 { + s = Memr[resid+l] + if (s < r + TOL) { + if (s > r - TOL) + jj = jj + 1 + else { + jj = 0 + Memr[resid+l] = r + r = s + dp2 = d[l] + k + d1 = Mem$t[dp1] + Mem$t[dp1] = Mem$t[dp2] + Mem$t[dp2] = d1 + if (keepids) { + mp1 = m[j] + k + mp2 = m[l] + k + s = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = s + } + } + } + } + sum = sum + Mem$t[dp1] + n1 = n1 + 1 + nk = max (nk, j+jj) + } + } + } + + n[i] = n1 + if (!docombine) + if (n1 > 0) + average[i] = sum / n1 + else + average[i] = blank + } + + # Check if the data flag has to be reset for rejected pixels + if (dflag == D_ALL) { + do i = 1, npts { + if (n[i] != nin) { + dflag = D_MIX + break + } + } + } + + call sfree (sp) +end + + +# IC_CCDCLIP -- Reject pixels using CCD noise parameters about the median + +procedure ic_mccdclip$t (d, m, n, scales, zeros, nm, nimages, npts, median) + +pointer d[nimages] # Data pointers +pointer m[nimages] # Image id pointers +int n[npts] # Number of good pixels +real scales[nimages] # Scales +real zeros[nimages] # Zeros +real nm[3,nimages] # Noise model +int nimages # Number of images +int npts # Number of output points per line +$if (datatype == sil) +real median[npts] # Median +$else +PIXEL median[npts] # Median +$endif + +int i, j, k, l, id, n1, n2, n3, nl, nh, nin, maxkeep +real r, s +pointer sp, resid, mp1, mp2 +$if (datatype == sil) +real med, zero +data zero /0.0/ +$else +PIXEL med, zero +data zero /0$f/ +$endif + +include "../icombine.com" + +begin + # There must be at least max (MINCLIP, nkeep+1) pixels. + if (nkeep < 0) + maxkeep = max (0, nimages + nkeep) + else + maxkeep = min (nimages, nkeep) + if (nimages < max (MINCLIP, maxkeep+1) || dflag == D_NONE) { + docombine = true + return + } + + call smark (sp) + call salloc (resid, nimages+1, TY_REAL) + + # Compute median and sigma and iteratively clip. + nin = n[1] + do i = 1, npts { + k = i - 1 + n1 = n[i] + if (nkeep < 0) + maxkeep = max (0, n1 + nkeep) + else + maxkeep = min (n1, nkeep) + nl = 1 + nh = n1 + + repeat { + n2 = n1 + n3 = nl + n1 / 2 + + if (n1 == 0) + med = blank + else if (mod (n1, 2) == 0) { + med = Mem$t[d[n3-1]+k] + med = (med + Mem$t[d[n3]+k]) / 2. + } else + med = Mem$t[d[n3]+k] + + if (n1 >= max (MINCLIP, maxkeep+1)) { + if (doscale1) { + for (; nl <= n2; nl = nl + 1) { + l = Memi[m[nl]+k] + s = scales[l] + r = max (zero, s * (med + zeros[l])) + s = sqrt (nm[1,l] + r/nm[2,l] + (r*nm[3,l])**2) / s + r = (med - Mem$t[d[nl]+k]) / s + if (r <= lsigma) + break + Memr[resid+nl] = r + n1 = n1 - 1 + } + for (; nh >= nl; nh = nh - 1) { + l = Memi[m[nh]+k] + s = scales[l] + r = max (zero, s * (med + zeros[l])) + s = sqrt (nm[1,l] + r/nm[2,l] + (r*nm[3,l])**2) / s + r = (Mem$t[d[nh]+k] - med) / s + if (r <= hsigma) + break + Memr[resid+nh] = r + n1 = n1 - 1 + } + } else { + if (!keepids) { + s = max (zero, med) + s = sqrt (nm[1,1] + s/nm[2,1] + (s*nm[3,1])**2) + } + for (; nl <= n2; nl = nl + 1) { + if (keepids) { + l = Memi[m[nl]+k] + s = max (zero, med) + s = sqrt (nm[1,l] + s/nm[2,l] + (s*nm[3,l])**2) + } + r = (med - Mem$t[d[nl]+k]) / s + if (r <= lsigma) + break + Memr[resid+nl] = r + n1 = n1 - 1 + } + for (; nh >= nl; nh = nh - 1) { + if (keepids) { + l = Memi[m[nh]+k] + s = max (zero, med) + s = sqrt (nm[1,l] + s/nm[2,l] + (s*nm[3,l])**2) + } + r = (Mem$t[d[nh]+k] - med) / s + if (r <= hsigma) + break + Memr[resid+nh] = r + n1 = n1 - 1 + } + } + } + } until (n1 == n2 || n1 < max (MINCLIP, maxkeep+1)) + + while (n1 < maxkeep) { + if (nl == 1) + nh = nh + 1 + else if (nh == n[i]) + nl = nl - 1 + else { + r = Memr[resid+nl-1] + s = Memr[resid+nh+1] + if (r < s) { + nl = nl - 1 + r = r + TOL + if (s <= r) + nh = nh + 1 + if (nl > 1) { + if (Memr[resid+nl-1] <= r) + nl = nl - 1 + } + } else { + nh = nh + 1 + s = s + TOL + if (r <= s) + nl = nl - 1 + if (nh < n2) { + if (Memr[resid+nh+1] <= s) + nh = nh + 1 + } + } + } + n1 = nh - nl + 1 + } + + # Only set median and reorder if needed + n[i] = n1 + if (n1 > 0 && nl > 1 && (combine != MEDIAN || grow > 0)) { + j = max (nl, n1 + 1) + if (keepids) { + do l = 1, min (n1, nl-1) { + Mem$t[d[l]+k] = Mem$t[d[j]+k] + if (grow > 0) { + mp1 = m[l] + k + mp2 = m[j] + k + id = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = id + } else + Memi[m[l]+k] = Memi[m[j]+k] + j = j + 1 + } + } else { + do l = 1, min (n1, nl - 1) { + Mem$t[d[l]+k] = Mem$t[d[j]+k] + j = j + 1 + } + } + } + + if (combine == MEDIAN) + median[i] = med + } + + # Check if data flag needs to be reset for rejected pixels + if (dflag == D_ALL) { + do i = 1, npts { + if (n[i] != nin) { + dflag = D_MIX + break + } + } + } + + # Flag that the median is computed. + if (combine == MEDIAN) + docombine = false + else + docombine = true + + call sfree (sp) +end +$endfor diff --git a/noao/imred/ccdred/src/combine/icgdata.gx b/noao/imred/ccdred/src/combine/icgdata.gx new file mode 100644 index 00000000..41cf5810 --- /dev/null +++ b/noao/imred/ccdred/src/combine/icgdata.gx @@ -0,0 +1,233 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> +include <mach.h> +include "../icombine.h" + +$for (sr) +# IC_GDATA -- Get line of image and mask data and apply threshold and scaling. +# Entirely empty lines are excluded. The data are compacted within the +# input data buffers. If it is required, the connection to the original +# image index is keeped in the returned m data pointers. + +procedure ic_gdata$t (in, out, dbuf, d, id, n, m, lflag, offsets, scales, + zeros, nimages, npts, v1, v2) + +pointer in[nimages] # Input images +pointer out[ARB] # Output images +pointer dbuf[nimages] # Data buffers for nonaligned images +pointer d[nimages] # Data pointers +pointer id[nimages] # ID pointers +int n[npts] # Number of good pixels +pointer m[nimages] # Mask pointers +int lflag[nimages] # Empty mask flags +int offsets[nimages,ARB] # Image offsets +real scales[nimages] # Scale factors +real zeros[nimages] # Zero offset factors +int nimages # Number of input images +int npts # NUmber of output points per line +long v1[ARB], v2[ARB] # Line vectors + +int i, j, k, l, ndim, nused +real a, b +pointer buf, dp, ip, mp, imgnl$t() + +include "../icombine.com" + +begin + # Get masks and return if there is no data + call ic_mget (in, out, offsets, v1, v2, m, lflag, nimages) + if (dflag == D_NONE) + return + + # Get data and fill data buffers. Correct for offsets if needed. + ndim = IM_NDIM(out[1]) + do i = 1, nimages { + if (lflag[i] == D_NONE) + next + if (aligned) { + call amovl (v1, v2, IM_MAXDIM) + if (project) + v2[ndim+1] = i + j = imgnl$t (in[i], d[i], v2) + } else { + v2[1] = v1[1] + do j = 2, ndim + v2[j] = v1[j] - offsets[i,j] + if (project) + v2[ndim+1] = i + j = imgnl$t (in[i], buf, v2) + call amov$t (Mem$t[buf], Mem$t[dbuf[i]+offsets[i,1]], + IM_LEN(in[i],1)) + d[i] = dbuf[i] + } + } + + # Apply threshold if needed + if (dothresh) { + do i = 1, nimages { + dp = d[i] + if (lflag[i] == D_ALL) { + do j = 1, npts { + a = Mem$t[dp] + if (a < lthresh || a > hthresh) { + Memi[m[i]+j-1] = 1 + lflag[i] = D_MIX + dflag = D_MIX + } + dp = dp + 1 + } + } else if (lflag[i] == D_MIX) { + mp = m[i] + do j = 1, npts { + if (Memi[mp] == 0) { + a = Mem$t[dp] + if (a < lthresh || a > hthresh) { + Memi[m[i]+j-1] = 1 + dflag = D_MIX + } + } + dp = dp + 1 + mp = mp + 1 + } + } + + # Check for completely empty lines + if (lflag[i] == D_MIX) { + lflag[i] = D_NONE + mp = m[i] + do j = 1, npts { + if (Memi[mp] == 0) { + lflag[i] = D_MIX + break + } + mp = mp + 1 + } + } + } + } + + # Apply scaling (avoiding masked pixels which might overflow?) + if (doscale) { + if (dflag == D_ALL) { + do i = 1, nimages { + dp = d[i] + a = scales[i] + b = -zeros[i] + do j = 1, npts { + Mem$t[dp] = Mem$t[dp] / a + b + dp = dp + 1 + } + } + } else if (dflag == D_MIX) { + do i = 1, nimages { + dp = d[i] + a = scales[i] + b = -zeros[i] + if (lflag[i] == D_ALL) { + do j = 1, npts { + Mem$t[dp] = Mem$t[dp] / a + b + dp = dp + 1 + } + } else if (lflag[i] == D_MIX) { + mp = m[i] + do j = 1, npts { + if (Memi[mp] == 0) + Mem$t[dp] = Mem$t[dp] / a + b + dp = dp + 1 + mp = mp + 1 + } + } + } + } + } + + # Sort pointers to exclude unused images. + # Use the lflag array to keep track of the image index. + + if (dflag == D_ALL) + nused = nimages + else { + nused = 0 + do i = 1, nimages + if (lflag[i] != D_NONE) { + nused = nused + 1 + d[nused] = d[i] + m[nused] = m[i] + lflag[nused] = i + } + if (nused == 0) + dflag = D_NONE + } + + # Compact data to remove bad pixels + # Keep track of the image indices if needed + # If growing mark the end of the included image indices with zero + + if (dflag == D_ALL) { + call amovki (nused, n, npts) + if (keepids) + do i = 1, nimages + call amovki (i, Memi[id[i]], npts) + } else if (dflag == D_NONE) + call aclri (n, npts) + else { + call aclri (n, npts) + if (keepids) { + do i = 1, nused { + l = lflag[i] + dp = d[i] + ip = id[i] + mp = m[i] + do j = 1, npts { + if (Memi[mp] == 0) { + n[j] = n[j] + 1 + k = n[j] + if (k < i) { + Mem$t[d[k]+j-1] = Mem$t[dp] + Memi[id[k]+j-1] = l + } else + Memi[ip] = l + } + dp = dp + 1 + ip = ip + 1 + mp = mp + 1 + } + } + if (grow > 0) { + do j = 1, npts { + do i = n[j]+1, nimages + Memi[id[i]+j-1] = 0 + } + } + } else { + do i = 1, nused { + dp = d[i] + mp = m[i] + do j = 1, npts { + if (Memi[mp] == 0) { + n[j] = n[j] + 1 + k = n[j] + if (k < i) + Mem$t[d[k]+j-1] = Mem$t[dp] + } + dp = dp + 1 + mp = mp + 1 + } + } + } + } + + # Sort the pixels and IDs if needed + if (mclip) { + call malloc (dp, nimages, TY_PIXEL) + if (keepids) { + call malloc (ip, nimages, TY_INT) + call ic_2sort$t (d, Mem$t[dp], id, Memi[ip], n, npts) + call mfree (ip, TY_INT) + } else + call ic_sort$t (d, Mem$t[dp], n, npts) + call mfree (dp, TY_PIXEL) + } +end +$endfor diff --git a/noao/imred/ccdred/src/combine/icgrow.gx b/noao/imred/ccdred/src/combine/icgrow.gx new file mode 100644 index 00000000..e3cf6228 --- /dev/null +++ b/noao/imred/ccdred/src/combine/icgrow.gx @@ -0,0 +1,81 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "../icombine.h" + +$for (sr) +# IC_GROW -- Reject neigbors of rejected pixels. +# The rejected pixels are marked by having nonzero ids beyond the number +# of included pixels. The pixels rejected here are given zero ids +# to avoid growing of the pixels rejected here. The unweighted average +# can be updated but any rejected pixels requires the median to be +# recomputed. When the number of pixels at a grow point reaches nkeep +# no further pixels are rejected. Note that the rejection order is not +# based on the magnitude of the residuals and so a grow from a weakly +# rejected image pixel may take precedence over a grow from a strongly +# rejected image pixel. + +procedure ic_grow$t (d, m, n, nimages, npts, average) + +pointer d[ARB] # Data pointers +pointer m[ARB] # Image id pointers +int n[npts] # Number of good pixels +int nimages # Number of images +int npts # Number of output points per line +$if (datatype == sil) +real average[npts] # Average +$else +PIXEL average[npts] # Average +$endif + +int i1, i2, j1, j2, k1, k2, l, is, ie, n2, maxkeep +pointer mp1, mp2 + +include "../icombine.com" + +begin + if (dflag == D_NONE) + return + + do i1 = 1, npts { + k1 = i1 - 1 + is = max (1, i1 - grow) + ie = min (npts, i1 + grow) + do j1 = n[i1]+1, nimages { + l = Memi[m[j1]+k1] + if (l == 0) + next + if (combine == MEDIAN) + docombine = true + + do i2 = is, ie { + if (i2 == i1) + next + k2 = i2 - 1 + n2 = n[i2] + if (nkeep < 0) + maxkeep = max (0, n2 + nkeep) + else + maxkeep = min (n2, nkeep) + if (n2 <= maxkeep) + next + do j2 = 1, n2 { + mp1 = m[j2] + k2 + if (Memi[mp1] == l) { + if (!docombine && n2 > 1) + average[i2] = + (n2*average[i2] - Mem$t[d[j2]+k2]) / (n2-1) + mp2 = m[n2] + k2 + if (j2 < n2) { + Mem$t[d[j2]+k2] = Mem$t[d[n2]+k2] + Memi[mp1] = Memi[mp2] + } + Memi[mp2] = 0 + n[i2] = n2 - 1 + break + } + } + } + } + } +end +$endfor diff --git a/noao/imred/ccdred/src/combine/icimstack.x b/noao/imred/ccdred/src/combine/icimstack.x new file mode 100644 index 00000000..2a19751d --- /dev/null +++ b/noao/imred/ccdred/src/combine/icimstack.x @@ -0,0 +1,125 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <error.h> +include <imhdr.h> + + +# IC_IMSTACK -- Stack images into a single image of higher dimension. + +procedure ic_imstack (images, nimages, output) + +char images[SZ_FNAME-1, nimages] #I Input images +int nimages #I Number of images +char output #I Name of output image + +int i, j, npix +long line_in[IM_MAXDIM], line_out[IM_MAXDIM] +pointer sp, key, in, out, buf_in, buf_out, ptr + +int imgnls(), imgnli(), imgnll(), imgnlr(), imgnld(), imgnlx() +int impnls(), impnli(), impnll(), impnlr(), impnld(), impnlx() +pointer immap() +errchk immap + +begin + call smark (sp) + call salloc (key, SZ_FNAME, TY_CHAR) + + iferr { + # Add each input image to the output image. + out = NULL + do i = 1, nimages { + in = NULL + ptr = immap (images[1,i], READ_ONLY, 0) + in = ptr + + # For the first input image map the output image as a copy + # and increment the dimension. Set the output line counter. + + if (i == 1) { + ptr = immap (output, NEW_COPY, in) + out = ptr + IM_NDIM(out) = IM_NDIM(out) + 1 + IM_LEN(out, IM_NDIM(out)) = nimages + npix = IM_LEN(out, 1) + call amovkl (long(1), line_out, IM_MAXDIM) + } + + # Check next input image for consistency with the output image. + if (IM_NDIM(in) != IM_NDIM(out) - 1) + call error (0, "Input images not consistent") + do j = 1, IM_NDIM(in) { + if (IM_LEN(in, j) != IM_LEN(out, j)) + call error (0, "Input images not consistent") + } + + call sprintf (Memc[key], SZ_FNAME, "stck%04d") + call pargi (i) + call imastr (out, Memc[key], images[1,i]) + + # Copy the input lines from the image to the next lines of + # the output image. Switch on the output data type to optimize + # IMIO. + + call amovkl (long(1), line_in, IM_MAXDIM) + switch (IM_PIXTYPE (out)) { + case TY_SHORT: + while (imgnls (in, buf_in, line_in) != EOF) { + if (impnls (out, buf_out, line_out) == EOF) + call error (0, "Error writing output image") + call amovs (Mems[buf_in], Mems[buf_out], npix) + } + case TY_INT: + while (imgnli (in, buf_in, line_in) != EOF) { + if (impnli (out, buf_out, line_out) == EOF) + call error (0, "Error writing output image") + call amovi (Memi[buf_in], Memi[buf_out], npix) + } + case TY_USHORT, TY_LONG: + while (imgnll (in, buf_in, line_in) != EOF) { + if (impnll (out, buf_out, line_out) == EOF) + call error (0, "Error writing output image") + call amovl (Meml[buf_in], Meml[buf_out], npix) + } + case TY_REAL: + while (imgnlr (in, buf_in, line_in) != EOF) { + if (impnlr (out, buf_out, line_out) == EOF) + call error (0, "Error writing output image") + call amovr (Memr[buf_in], Memr[buf_out], npix) + } + case TY_DOUBLE: + while (imgnld (in, buf_in, line_in) != EOF) { + if (impnld (out, buf_out, line_out) == EOF) + call error (0, "Error writing output image") + call amovd (Memd[buf_in], Memd[buf_out], npix) + } + case TY_COMPLEX: + while (imgnlx (in, buf_in, line_in) != EOF) { + if (impnlx (out, buf_out, line_out) == EOF) + call error (0, "Error writing output image") + call amovx (Memx[buf_in], Memx[buf_out], npix) + } + default: + while (imgnlr (in, buf_in, line_in) != EOF) { + if (impnlr (out, buf_out, line_out) == EOF) + call error (0, "Error writing output image") + call amovr (Memr[buf_in], Memr[buf_out], npix) + } + } + call imunmap (in) + } + } then { + if (out != NULL) { + call imunmap (out) + call imdelete (out) + } + if (in != NULL) + call imunmap (in) + call sfree (sp) + call erract (EA_ERROR) + } + + # Finish up. + call imunmap (out) + call sfree (sp) +end diff --git a/noao/imred/ccdred/src/combine/iclog.x b/noao/imred/ccdred/src/combine/iclog.x new file mode 100644 index 00000000..82135866 --- /dev/null +++ b/noao/imred/ccdred/src/combine/iclog.x @@ -0,0 +1,378 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> +include <imset.h> +include <mach.h> +include "icombine.h" +include "icmask.h" + +# IC_LOG -- Output log information is a log file has been specfied. + +procedure ic_log (in, out, ncombine, exptime, sname, zname, wname, + mode, median, mean, scales, zeros, wts, offsets, nimages, + dozero, nout, expname, exposure) + +pointer in[nimages] # Input images +pointer out[ARB] # Output images +int ncombine[nimages] # Number of previous combined images +real exptime[nimages] # Exposure times +char sname[ARB] # Scale name +char zname[ARB] # Zero name +char wname[ARB] # Weight name +real mode[nimages] # Modes +real median[nimages] # Medians +real mean[nimages] # Means +real scales[nimages] # Scale factors +real zeros[nimages] # Zero or sky levels +real wts[nimages] # Weights +int offsets[nimages,ARB] # Image offsets +int nimages # Number of images +bool dozero # Zero flag +int nout # Number of images combined in output +char expname[ARB] # Exposure name +real exposure # Output exposure + +int i, j, stack, ctor() +real rval, imgetr() +long clktime() +bool prncombine, prexptime, prmode, prmedian, prmean, prmask +bool prrdn, prgain, prsn +pointer sp, fname, key +errchk imgetr + +include "icombine.com" + +begin + if (logfd == NULL) + return + + call smark (sp) + call salloc (fname, SZ_LINE, TY_CHAR) + + stack = NO + if (project) { + ifnoerr (call imgstr (in[1], "stck0001", Memc[fname], SZ_LINE)) + stack = YES + } + if (stack == YES) + call salloc (key, SZ_FNAME, TY_CHAR) + + # Time stamp the log and print parameter information. + + call cnvdate (clktime(0), Memc[fname], SZ_LINE) + call fprintf (logfd, "\n%s: IMCOMBINE\n") + call pargstr (Memc[fname]) + switch (combine) { + case AVERAGE: + call fprintf (logfd, " combine = average, ") + case MEDIAN: + call fprintf (logfd, " combine = median, ") + } + call fprintf (logfd, "scale = %s, zero = %s, weight = %s\n") + call pargstr (sname) + call pargstr (zname) + call pargstr (wname) + + switch (reject) { + case MINMAX: + call fprintf (logfd, " reject = minmax, nlow = %d, nhigh = %d\n") + call pargi (nint (flow * nimages)) + call pargi (nint (fhigh * nimages)) + case CCDCLIP: + call fprintf (logfd, " reject = ccdclip, mclip = %b, nkeep = %d\n") + call pargb (mclip) + call pargi (nkeep) + call fprintf (logfd, + " rdnoise = %s, gain = %s, snoise = %s, sigma = %g, hsigma = %g\n") + call pargstr (Memc[rdnoise]) + call pargstr (Memc[gain]) + call pargstr (Memc[snoise]) + call pargr (lsigma) + call pargr (hsigma) + case CRREJECT: + call fprintf (logfd, + " reject = crreject, mclip = %b, nkeep = %d\n") + call pargb (mclip) + call pargi (nkeep) + call fprintf (logfd, + " rdnoise = %s, gain = %s, snoise = %s, hsigma = %g\n") + call pargstr (Memc[rdnoise]) + call pargstr (Memc[gain]) + call pargstr (Memc[snoise]) + call pargr (hsigma) + case PCLIP: + call fprintf (logfd, " reject = pclip, nkeep = %d\n") + call pargi (nkeep) + call fprintf (logfd, " pclip = %g, lsigma = %g, hsigma = %g\n") + call pargr (pclip) + call pargr (lsigma) + call pargr (hsigma) + case SIGCLIP: + call fprintf (logfd, " reject = sigclip, mclip = %b, nkeep = %d\n") + call pargb (mclip) + call pargi (nkeep) + call fprintf (logfd, " lsigma = %g, hsigma = %g\n") + call pargr (lsigma) + call pargr (hsigma) + case AVSIGCLIP: + call fprintf (logfd, + " reject = avsigclip, mclip = %b, nkeep = %d\n") + call pargb (mclip) + call pargi (nkeep) + call fprintf (logfd, " lsigma = %g, hsigma = %g\n") + call pargr (lsigma) + call pargr (hsigma) + } + if (reject != NONE && grow > 0) { + call fprintf (logfd, " grow = %d\n") + call pargi (grow) + } + if (dothresh) { + if (lthresh > -MAX_REAL && hthresh < MAX_REAL) { + call fprintf (logfd, " lthreshold = %g, hthreshold = %g\n") + call pargr (lthresh) + call pargr (hthresh) + } else if (lthresh > -MAX_REAL) { + call fprintf (logfd, " lthreshold = %g\n") + call pargr (lthresh) + } else { + call fprintf (logfd, " hthreshold = %g\n") + call pargr (hthresh) + } + } + call fprintf (logfd, " blank = %g\n") + call pargr (blank) + call clgstr ("statsec", Memc[fname], SZ_LINE) + if (Memc[fname] != EOS) { + call fprintf (logfd, " statsec = %s\n") + call pargstr (Memc[fname]) + } + + if (ICM_TYPE(icm) != M_NONE) { + switch (ICM_TYPE(icm)) { + case M_BOOLEAN, M_GOODVAL: + call fprintf (logfd, " masktype = goodval, maskval = %d\n") + call pargi (ICM_VALUE(icm)) + case M_BADVAL: + call fprintf (logfd, " masktype = badval, maskval = %d\n") + call pargi (ICM_VALUE(icm)) + case M_GOODBITS: + call fprintf (logfd, " masktype = goodbits, maskval = %d\n") + call pargi (ICM_VALUE(icm)) + case M_BADBITS: + call fprintf (logfd, " masktype = badbits, maskval = %d\n") + call pargi (ICM_VALUE(icm)) + } + } + + # Print information pertaining to individual images as a set of + # columns with the image name being the first column. Determine + # what information is relevant and print the appropriate header. + + prncombine = false + prexptime = false + prmode = false + prmedian = false + prmean = false + prmask = false + prrdn = false + prgain = false + prsn = false + do i = 1, nimages { + if (ncombine[i] != ncombine[1]) + prncombine = true + if (exptime[i] != exptime[1]) + prexptime = true + if (mode[i] != mode[1]) + prmode = true + if (median[i] != median[1]) + prmedian = true + if (mean[i] != mean[1]) + prmean = true + if (ICM_TYPE(icm) != M_NONE && Memi[ICM_PMS(icm)+i-1] != NULL) + prmask = true + if (reject == CCDCLIP || reject == CRREJECT) { + j = 1 + if (ctor (Memc[rdnoise], j, rval) == 0) + prrdn = true + j = 1 + if (ctor (Memc[gain], j, rval) == 0) + prgain = true + j = 1 + if (ctor (Memc[snoise], j, rval) == 0) + prsn = true + } + } + + call fprintf (logfd, " %20s ") + call pargstr ("Images") + if (prncombine) { + call fprintf (logfd, " %6s") + call pargstr ("N") + } + if (prexptime) { + call fprintf (logfd, " %6s") + call pargstr ("Exp") + } + if (prmode) { + call fprintf (logfd, " %7s") + call pargstr ("Mode") + } + if (prmedian) { + call fprintf (logfd, " %7s") + call pargstr ("Median") + } + if (prmean) { + call fprintf (logfd, " %7s") + call pargstr ("Mean") + } + if (prrdn) { + call fprintf (logfd, " %7s") + call pargstr ("Rdnoise") + } + if (prgain) { + call fprintf (logfd, " %6s") + call pargstr ("Gain") + } + if (prsn) { + call fprintf (logfd, " %6s") + call pargstr ("Snoise") + } + if (doscale) { + call fprintf (logfd, " %6s") + call pargstr ("Scale") + } + if (dozero) { + call fprintf (logfd, " %7s") + call pargstr ("Zero") + } + if (dowts) { + call fprintf (logfd, " %6s") + call pargstr ("Weight") + } + if (!aligned) { + call fprintf (logfd, " %9s") + call pargstr ("Offsets") + } + if (prmask) { + call fprintf (logfd, " %s") + call pargstr ("Maskfile") + } + call fprintf (logfd, "\n") + + do i = 1, nimages { + if (stack == YES) { + call sprintf (Memc[key], SZ_FNAME, "stck%04d") + call pargi (i) + ifnoerr (call imgstr (in[i], Memc[key], Memc[fname], SZ_LINE)) { + call fprintf (logfd, " %21s") + call pargstr (Memc[fname]) + } else { + call imstats (in[i], IM_IMAGENAME, Memc[fname], SZ_LINE) + call fprintf (logfd, " %16s[%3d]") + call pargstr (Memc[fname]) + call pargi (i) + } + } else if (project) { + call imstats (in[i], IM_IMAGENAME, Memc[fname], SZ_LINE) + call fprintf (logfd, " %16s[%3d]") + call pargstr (Memc[fname]) + call pargi (i) + } else { + call imstats (in[i], IM_IMAGENAME, Memc[fname], SZ_LINE) + call fprintf (logfd, " %21s") + call pargstr (Memc[fname]) + } + if (prncombine) { + call fprintf (logfd, " %6d") + call pargi (ncombine[i]) + } + if (prexptime) { + call fprintf (logfd, " %6.1f") + call pargr (exptime[i]) + } + if (prmode) { + call fprintf (logfd, " %7.5g") + call pargr (mode[i]) + } + if (prmedian) { + call fprintf (logfd, " %7.5g") + call pargr (median[i]) + } + if (prmean) { + call fprintf (logfd, " %7.5g") + call pargr (mean[i]) + } + if (prrdn) { + rval = imgetr (in[i], Memc[rdnoise]) + call fprintf (logfd, " %7g") + call pargr (rval) + } + if (prgain) { + rval = imgetr (in[i], Memc[gain]) + call fprintf (logfd, " %6g") + call pargr (rval) + } + if (prsn) { + rval = imgetr (in[i], Memc[snoise]) + call fprintf (logfd, " %6g") + call pargr (rval) + } + if (doscale) { + call fprintf (logfd, " %6.3f") + call pargr (1./scales[i]) + } + if (dozero) { + call fprintf (logfd, " %7.5g") + call pargr (-zeros[i]) + } + if (dowts) { + call fprintf (logfd, " %6.3f") + call pargr (wts[i]) + } + if (!aligned) { + if (IM_NDIM(out[1]) == 1) { + call fprintf (logfd, " %9d") + call pargi (offsets[i,1]) + } else { + do j = 1, IM_NDIM(out[1]) { + call fprintf (logfd, " %4d") + call pargi (offsets[i,j]) + } + } + } + if (prmask && Memi[ICM_PMS(icm)+i-1] != NULL) { + call imgstr (in[i], "BPM", Memc[fname], SZ_LINE) + call fprintf (logfd, " %s") + call pargstr (Memc[fname]) + } + call fprintf (logfd, "\n") + } + + # Log information about the output images. + call imstats (out[1], IM_IMAGENAME, Memc[fname], SZ_LINE) + call fprintf (logfd, "\n Output image = %s, ncombine = %d") + call pargstr (Memc[fname]) + call pargi (nout) + if (expname[1] != EOS) { + call fprintf (logfd, ", %s = %g") + call pargstr (expname) + call pargr (exposure) + } + call fprintf (logfd, "\n") + + if (out[2] != NULL) { + call imstats (out[2], IM_IMAGENAME, Memc[fname], SZ_LINE) + call fprintf (logfd, " Pixel list image = %s\n") + call pargstr (Memc[fname]) + } + + if (out[3] != NULL) { + call imstats (out[3], IM_IMAGENAME, Memc[fname], SZ_LINE) + call fprintf (logfd, " Sigma image = %s\n") + call pargstr (Memc[fname]) + } + + call flush (logfd) + call sfree (sp) +end diff --git a/noao/imred/ccdred/src/combine/icmask.com b/noao/imred/ccdred/src/combine/icmask.com new file mode 100644 index 00000000..baba6f6a --- /dev/null +++ b/noao/imred/ccdred/src/combine/icmask.com @@ -0,0 +1,8 @@ +# IMCMASK -- Common for IMCOMBINE mask interface. + +int mtype # Mask type +int mvalue # Mask value +pointer bufs # Pointer to data line buffers +pointer pms # Pointer to array of PMIO pointers + +common /imcmask/ mtype, mvalue, bufs, pms diff --git a/noao/imred/ccdred/src/combine/icmask.h b/noao/imred/ccdred/src/combine/icmask.h new file mode 100644 index 00000000..b2d30530 --- /dev/null +++ b/noao/imred/ccdred/src/combine/icmask.h @@ -0,0 +1,7 @@ +# ICMASK -- Data structure for IMCOMBINE mask interface. + +define ICM_LEN 4 # Structure length +define ICM_TYPE Memi[$1] # Mask type +define ICM_VALUE Memi[$1+1] # Mask value +define ICM_BUFS Memi[$1+2] # Pointer to data line buffers +define ICM_PMS Memi[$1+3] # Pointer to array of PMIO pointers diff --git a/noao/imred/ccdred/src/combine/icmask.x b/noao/imred/ccdred/src/combine/icmask.x new file mode 100644 index 00000000..ba448b68 --- /dev/null +++ b/noao/imred/ccdred/src/combine/icmask.x @@ -0,0 +1,354 @@ +include <imhdr.h> +include <pmset.h> +include "icombine.h" +include "icmask.h" + +# IC_MASK -- ICOMBINE mask interface +# +# IC_MOPEN -- Open masks +# IC_MCLOSE -- Close the mask interface +# IC_MGET -- Get lines of mask pixels for all the images +# IC_MGET1 -- Get a line of mask pixels for the specified image + + +# IC_MOPEN -- Open masks. +# Parse and interpret the mask selection parameters. + +procedure ic_mopen (in, out, nimages) + +pointer in[nimages] #I Input images +pointer out[ARB] #I Output images +int nimages #I Number of images + +int mtype # Mask type +int mvalue # Mask value +pointer bufs # Pointer to data line buffers +pointer pms # Pointer to array of PMIO pointers + +int i, npix, npms, clgwrd() +real clgetr() +pointer sp, fname, title, pm, pm_open() +bool invert, pm_empty() +errchk calloc, pm_open, pm_loadf + +include "icombine.com" + +begin + icm = NULL + if (IM_NDIM(out[1]) == 0) + return + + call smark (sp) + call salloc (fname, SZ_FNAME, TY_CHAR) + call salloc (title, SZ_FNAME, TY_CHAR) + + # Determine the mask parameters and allocate memory. + # The mask buffers are initialize to all excluded so that + # output points outside the input data are always excluded + # and don't need to be set on a line-by-line basis. + + mtype = clgwrd ("masktype", Memc[title], SZ_FNAME, MASKTYPES) + mvalue = clgetr ("maskvalue") + npix = IM_LEN(out[1],1) + call calloc (pms, nimages, TY_POINTER) + call calloc (bufs, nimages, TY_POINTER) + do i = 1, nimages { + call malloc (Memi[bufs+i-1], npix, TY_INT) + call amovki (1, Memi[Memi[bufs+i-1]], npix) + } + + # Check for special cases. The BOOLEAN type is used when only + # zero and nonzero are significant; i.e. the actual mask values are + # not important. The invert flag is used to indicate that + # empty masks are all bad rather the all good. + + if (mtype == 0) + mtype = M_NONE + if (mtype == M_BADBITS && mvalue == 0) + mtype = M_NONE + if (mvalue == 0 && (mtype == M_GOODVAL || mtype == M_GOODBITS)) + mtype = M_BOOLEAN + if ((mtype == M_BADVAL && mvalue == 0) || + (mtype == M_GOODVAL && mvalue != 0) || + (mtype == M_GOODBITS && mvalue == 0)) + invert = true + else + invert = false + + # If mask images are to be used, get the mask name from the image + # header and open it saving the descriptor in the pms array. + # Empty masks (all good) are treated as if there was no mask image. + + npms = 0 + do i = 1, nimages { + if (mtype != M_NONE) { + ifnoerr (call imgstr (in[i], "BPM", Memc[fname], SZ_FNAME)) { + pm = pm_open (NULL) + call pm_loadf (pm, Memc[fname], Memc[title], SZ_FNAME) + call pm_seti (pm, P_REFIM, in[i]) + if (pm_empty (pm) && !invert) + call pm_close (pm) + else { + if (project) { + npms = nimages + call amovki (pm, Memi[pms], nimages) + } else { + npms = npms + 1 + Memi[pms+i-1] = pm + } + } + if (project) + break + } + } + } + + # If no mask images are found and the mask parameters imply that + # good values are 0 then use the special case of no masks. + + if (npms == 0) { + if (!invert) + mtype = M_NONE + } + + # Set up mask structure. + call calloc (icm, ICM_LEN, TY_STRUCT) + ICM_TYPE(icm) = mtype + ICM_VALUE(icm) = mvalue + ICM_BUFS(icm) = bufs + ICM_PMS(icm) = pms + + call sfree (sp) +end + + +# IC_MCLOSE -- Close the mask interface. + +procedure ic_mclose (nimages) + +int nimages # Number of images + +int i +include "icombine.com" + +begin + if (icm == NULL) + return + + do i = 1, nimages + call mfree (Memi[ICM_BUFS(icm)+i-1], TY_INT) + do i = 1, nimages { + if (Memi[ICM_PMS(icm)+i-1] != NULL) + call pm_close (Memi[ICM_PMS(icm)+i-1]) + if (project) + break + } + call mfree (ICM_BUFS(icm), TY_POINTER) + call mfree (ICM_PMS(icm), TY_POINTER) + call mfree (icm, TY_STRUCT) +end + + +# IC_MGET -- Get lines of mask pixels in the output coordinate system. +# This converts the mask format to an array where zero is good and nonzero +# is bad. This has special cases for optimization. + +procedure ic_mget (in, out, offsets, v1, v2, m, lflag, nimages) + +pointer in[nimages] # Input image pointers +pointer out[ARB] # Output image pointer +int offsets[nimages,ARB] # Offsets to output image +long v1[IM_MAXDIM] # Data vector desired in output image +long v2[IM_MAXDIM] # Data vector in input image +pointer m[nimages] # Pointer to mask pointers +int lflag[nimages] # Line flags +int nimages # Number of images + +int mtype # Mask type +int mvalue # Mask value +pointer bufs # Pointer to data line buffers +pointer pms # Pointer to array of PMIO pointers + +int i, j, ndim, nout, npix +pointer buf, pm +bool pm_linenotempty() +errchk pm_glpi + +include "icombine.com" + +begin + # Determine if masks are needed at all. Note that the threshold + # is applied by simulating mask values so the mask pointers have to + # be set. + + dflag = D_ALL + if (icm == NULL) + return + if (ICM_TYPE(icm) == M_NONE && aligned && !dothresh) + return + + mtype = ICM_TYPE(icm) + mvalue = ICM_VALUE(icm) + bufs = ICM_BUFS(icm) + pms = ICM_PMS(icm) + + # Set the mask pointers and line flags and apply offsets if needed. + + ndim = IM_NDIM(out[1]) + nout = IM_LEN(out[1],1) + do i = 1, nimages { + npix = IM_LEN(in[i],1) + j = offsets[i,1] + m[i] = Memi[bufs+i-1] + buf = Memi[bufs+i-1] + j + pm = Memi[pms+i-1] + if (npix == nout) + lflag[i] = D_ALL + else + lflag[i] = D_MIX + + v2[1] = v1[1] + do j = 2, ndim { + v2[j] = v1[j] - offsets[i,j] + if (v2[j] < 1 || v2[j] > IM_LEN(in[i],j)) { + lflag[i] = D_NONE + break + } + } + if (project) + v2[ndim+1] = i + + if (lflag[i] == D_NONE) + next + + if (pm == NULL) { + call aclri (Memi[buf], npix) + next + } + + # Do mask I/O and convert to appropriate values in order of + # expected usage. + + if (pm_linenotempty (pm, v2)) { + call pm_glpi (pm, v2, Memi[buf], 32, npix, 0) + + if (mtype == M_BOOLEAN) + ; + else if (mtype == M_BADBITS) + call aandki (Memi[buf], mvalue, Memi[buf], npix) + else if (mtype == M_BADVAL) + call abeqki (Memi[buf], mvalue, Memi[buf], npix) + else if (mtype == M_GOODBITS) { + call aandki (Memi[buf], mvalue, Memi[buf], npix) + call abeqki (Memi[buf], 0, Memi[buf], npix) + } else if (mtype == M_GOODVAL) + call abneki (Memi[buf], mvalue, Memi[buf], npix) + + lflag[i] = D_NONE + do j = 1, npix + if (Memi[buf+j-1] == 0) { + lflag[i] = D_MIX + break + } + } else { + if (mtype == M_BOOLEAN || mtype == M_BADBITS) { + call aclri (Memi[buf], npix) + } else if ((mtype == M_BADVAL && mvalue != 0) || + (mtype == M_GOODVAL && mvalue == 0)) { + call aclri (Memi[buf], npix) + } else { + call amovki (1, Memi[buf], npix) + lflag[i] = D_NONE + } + } + } + + # Set overall data flag + dflag = lflag[1] + do i = 2, nimages { + if (lflag[i] != dflag) { + dflag = D_MIX + break + } + } +end + + +# IC_MGET1 -- Get line of mask pixels from a specified image. +# This is used by the IC_STAT procedure. This procedure converts the +# stored mask format to an array where zero is good and nonzero is bad. +# The data vector and returned mask array are in the input image pixel system. + +procedure ic_mget1 (in, image, offset, v, m) + +pointer in # Input image pointer +int image # Image index +int offset # Column offset +long v[IM_MAXDIM] # Data vector desired +pointer m # Pointer to mask + +int mtype # Mask type +int mvalue # Mask value +pointer bufs # Pointer to data line buffers +pointer pms # Pointer to array of PMIO pointers + +int i, npix +pointer buf, pm +bool pm_linenotempty() +errchk pm_glpi + +include "icombine.com" + +begin + dflag = D_ALL + if (icm == NULL) + return + if (ICM_TYPE(icm) == M_NONE) + return + + mtype = ICM_TYPE(icm) + mvalue = ICM_VALUE(icm) + bufs = ICM_BUFS(icm) + pms = ICM_PMS(icm) + + npix = IM_LEN(in,1) + m = Memi[bufs+image-1] + offset + pm = Memi[pms+image-1] + if (pm == NULL) + return + + # Do mask I/O and convert to appropriate values in order of + # expected usage. + + buf = m + if (pm_linenotempty (pm, v)) { + call pm_glpi (pm, v, Memi[buf], 32, npix, 0) + + if (mtype == M_BOOLEAN) + ; + else if (mtype == M_BADBITS) + call aandki (Memi[buf], mvalue, Memi[buf], npix) + else if (mtype == M_BADVAL) + call abeqki (Memi[buf], mvalue, Memi[buf], npix) + else if (mtype == M_GOODBITS) { + call aandki (Memi[buf], mvalue, Memi[buf], npix) + call abeqki (Memi[buf], 0, Memi[buf], npix) + } else if (mtype == M_GOODVAL) + call abneki (Memi[buf], mvalue, Memi[buf], npix) + + dflag = D_NONE + do i = 1, npix + if (Memi[buf+i-1] == 0) { + dflag = D_MIX + break + } + } else { + if (mtype == M_BOOLEAN || mtype == M_BADBITS) { + ; + } else if ((mtype == M_BADVAL && mvalue != 0) || + (mtype == M_GOODVAL && mvalue == 0)) { + ; + } else + dflag = D_NONE + } +end diff --git a/noao/imred/ccdred/src/combine/icmedian.gx b/noao/imred/ccdred/src/combine/icmedian.gx new file mode 100644 index 00000000..dc8488d9 --- /dev/null +++ b/noao/imred/ccdred/src/combine/icmedian.gx @@ -0,0 +1,228 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "../icombine.h" + +$for (sr) +# IC_MEDIAN -- Median of lines + +procedure ic_median$t (d, n, npts, median) + +pointer d[ARB] # Input data line pointers +int n[npts] # Number of good pixels +int npts # Number of output points per line +$if (datatype == sil) +real median[npts] # Median +$else +PIXEL median[npts] # Median +$endif + +int i, j, k, j1, j2, n1, lo, up, lo1, up1 +bool even +$if (datatype == silx) +real val1, val2, val3 +$else +PIXEL val1, val2, val3 +$endif +PIXEL temp, wtemp +$if (datatype == x) +real abs_temp +$endif + +include "../icombine.com" + +begin + # If no data return after possibly setting blank values. + if (dflag == D_NONE) { + do i = 1, npts + median[i]= blank + return + } + + # If the data were previously sorted then directly compute the median. + if (mclip) { + if (dflag == D_ALL) { + n1 = n[1] + even = (mod (n1, 2) == 0) + j1 = n1 / 2 + 1 + j2 = n1 / 2 + do i = 1, npts { + k = i - 1 + if (even) { + val1 = Mem$t[d[j1]+k] + val2 = Mem$t[d[j2]+k] + median[i] = (val1 + val2) / 2. + } else + median[i] = Mem$t[d[j1]+k] + } + } else { + do i = 1, npts { + k = i - 1 + n1 = n[i] + if (n1 > 0) { + j1 = n1 / 2 + 1 + if (mod (n1, 2) == 0) { + j2 = n1 / 2 + val1 = Mem$t[d[j1]+k] + val2 = Mem$t[d[j2]+k] + median[i] = (val1 + val2) / 2. + } else + median[i] = Mem$t[d[j1]+k] + } else + median[i] = blank + } + } + return + } + + # Compute the median. + do i = 1, npts { + k = i - 1 + n1 = n[i] + + # If there are more than 3 points use Wirth algorithm. This + # is the same as vops$amed.gx except for an even number of + # points it selects the middle two and averages. + if (n1 > 3) { + lo = 1 + up = n1 + j = max (lo, min (up, (up+1)/2)) + + while (lo < up) { + if (! (lo < up)) + break + + temp = Mem$t[d[j]+k]; lo1 = lo; up1 = up + $if (datatype == x) + abs_temp = abs (temp) + $endif + + repeat { + $if (datatype == x) + while (abs (Mem$t[d[lo1]+k]) < abs_temp) + $else + while (Mem$t[d[lo1]+k] < temp) + $endif + lo1 = lo1 + 1 + $if (datatype == x) + while (abs_temp < abs (Mem$t[d[up1]+k])) + $else + while (temp < Mem$t[d[up1]+k]) + $endif + up1 = up1 - 1 + if (lo1 <= up1) { + wtemp = Mem$t[d[lo1]+k] + Mem$t[d[lo1]+k] = Mem$t[d[up1]+k] + Mem$t[d[up1]+k] = wtemp + lo1 = lo1 + 1; up1 = up1 - 1 + } + } until (lo1 > up1) + + if (up1 < j) + lo = lo1 + if (j < lo1) + up = up1 + } + + median[i] = Mem$t[d[j]+k] + + if (mod (n1,2) == 0) { + lo = 1 + up = n1 + j = max (lo, min (up, (up+1)/2)+1) + + while (lo < up) { + if (! (lo < up)) + break + + temp = Mem$t[d[j]+k]; lo1 = lo; up1 = up + $if (datatype == x) + abs_temp = abs (temp) + $endif + + repeat { + $if (datatype == x) + while (abs (Mem$t[d[lo1]+k]) < abs_temp) + $else + while (Mem$t[d[lo1]+k] < temp) + $endif + lo1 = lo1 + 1 + $if (datatype == x) + while (abs_temp < abs (Mem$t[d[up1]+k])) + $else + while (temp < Mem$t[d[up1]+k]) + $endif + up1 = up1 - 1 + if (lo1 <= up1) { + wtemp = Mem$t[d[lo1]+k] + Mem$t[d[lo1]+k] = Mem$t[d[up1]+k] + Mem$t[d[up1]+k] = wtemp + lo1 = lo1 + 1; up1 = up1 - 1 + } + } until (lo1 > up1) + + if (up1 < j) + lo = lo1 + if (j < lo1) + up = up1 + } + median[i] = (median[i] + Mem$t[d[j]+k]) / 2 + } + + # If 3 points find the median directly. + } else if (n1 == 3) { + $if (datatype == x) + val1 = abs (Mem$t[d[1]+k]) + val2 = abs (Mem$t[d[2]+k]) + val3 = abs (Mem$t[d[3]+k]) + if (val1 < val2) { + if (val2 < val3) # abc + median[i] = Mem$t[d[2]+k] + else if (val1 < val3) # acb + median[i] = Mem$t[d[3]+k] + else # cab + median[i] = Mem$t[d[1]+k] + } else { + if (val2 > val3) # cba + median[i] = Mem$t[d[2]+k] + else if (val1 > val3) # bca + median[i] = Mem$t[d[3]+k] + else # bac + median[i] = Mem$t[d[1]+k] + } + $else + val1 = Mem$t[d[1]+k] + val2 = Mem$t[d[2]+k] + val3 = Mem$t[d[3]+k] + if (val1 < val2) { + if (val2 < val3) # abc + median[i] = val2 + else if (val1 < val3) # acb + median[i] = val3 + else # cab + median[i] = val1 + } else { + if (val2 > val3) # cba + median[i] = val2 + else if (val1 > val3) # bca + median[i] = val3 + else # bac + median[i] = val1 + } + $endif + + # If 2 points average. + } else if (n1 == 2) { + val1 = Mem$t[d[1]+k] + val2 = Mem$t[d[2]+k] + median[i] = (val1 + val2) / 2 + + # If 1 point return the value. + } else if (n1 == 1) + median[i] = Mem$t[d[1]+k] + + # If no points return with a possibly blank value. + else + median[i] = blank + } +end +$endfor diff --git a/noao/imred/ccdred/src/combine/icmm.gx b/noao/imred/ccdred/src/combine/icmm.gx new file mode 100644 index 00000000..90837ae5 --- /dev/null +++ b/noao/imred/ccdred/src/combine/icmm.gx @@ -0,0 +1,177 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "../icombine.h" + +$for (sr) +# IC_MM -- Reject a specified number of high and low pixels + +procedure ic_mm$t (d, m, n, npts) + +pointer d[ARB] # Data pointers +pointer m[ARB] # Image ID pointers +int n[npts] # Number of good pixels +int npts # Number of output points per line + +int n1, ncombine, npairs, nlow, nhigh, np +int i, i1, j, jmax, jmin +pointer k, kmax, kmin +PIXEL d1, d2, dmin, dmax + +include "../icombine.com" + +begin + if (dflag == D_NONE) + return + + if (dflag == D_ALL) { + n1 = n[1] + nlow = flow * n1 + 0.001 + nhigh = fhigh * n1 + 0.001 + ncombine = n1 - nlow - nhigh + npairs = min (nlow, nhigh) + nlow = nlow - npairs + nhigh = nhigh - npairs + } + + do i = 1, npts { + i1 = i - 1 + n1 = n[i] + if (dflag == D_MIX) { + nlow = flow * n1 + 0.001 + nhigh = fhigh * n1 + 0.001 + ncombine = max (ncombine, n1 - nlow - nhigh) + npairs = min (nlow, nhigh) + nlow = nlow - npairs + nhigh = nhigh - npairs + } + + # Reject the npairs low and high points. + do np = 1, npairs { + k = d[1] + i1 + $if (datatype == x) + d1 = abs (Mem$t[k]) + $else + d1 = Mem$t[k] + $endif + dmax = d1; dmin = d1; jmax = 1; jmin = 1; kmax = k; kmin = k + do j = 2, n1 { + d2 = d1 + k = d[j] + i1 + $if (datatype == x) + d1 = abs (Mem$t[k]) + $else + d1 = Mem$t[k] + $endif + if (d1 > dmax) { + dmax = d1; jmax = j; kmax = k + } else if (d1 < dmin) { + dmin = d1; jmin = j; kmin = k + } + } + j = n1 - 1 + if (keepids) { + if (jmax < j) { + if (jmin != j) { + Mem$t[kmax] = d2 + Memi[m[jmax]+i1] = Memi[m[j]+i1] + } else { + Mem$t[kmax] = d1 + Memi[m[jmax]+i1] = Memi[m[n1]+i1] + } + } + if (jmin < j) { + if (jmax != n1) { + Mem$t[kmin] = d1 + Memi[m[jmin]+i1] = Memi[m[n1]+i1] + } else { + Mem$t[kmin] = d2 + Memi[m[jmin]+i1] = Memi[m[j]+i1] + } + } + } else { + if (jmax < j) { + if (jmin != j) + Mem$t[kmax] = d2 + else + Mem$t[kmax] = d1 + } + if (jmin < j) { + if (jmax != n1) + Mem$t[kmin] = d1 + else + Mem$t[kmin] = d2 + } + } + n1 = n1 - 2 + } + + # Reject the excess low points. + do np = 1, nlow { + k = d[1] + i1 + $if (datatype == x) + d1 = abs (Mem$t[k]) + $else + d1 = Mem$t[k] + $endif + dmin = d1; jmin = 1; kmin = k + do j = 2, n1 { + k = d[j] + i1 + $if (datatype == x) + d1 = abs (Mem$t[k]) + $else + d1 = Mem$t[k] + $endif + if (d1 < dmin) { + dmin = d1; jmin = j; kmin = k + } + } + if (keepids) { + if (jmin < n1) { + Mem$t[kmin] = d1 + Memi[m[jmin]+i1] = Memi[m[n1]+i1] + } + } else { + if (jmin < n1) + Mem$t[kmin] = d1 + } + n1 = n1 - 1 + } + + # Reject the excess high points. + do np = 1, nhigh { + k = d[1] + i1 + $if (datatype == x) + d1 = abs (Mem$t[k]) + $else + d1 = Mem$t[k] + $endif + dmax = d1; jmax = 1; kmax = k + do j = 2, n1 { + k = d[j] + i1 + $if (datatype == x) + d1 = abs (Mem$t[k]) + $else + d1 = Mem$t[k] + $endif + if (d1 > dmax) { + dmax = d1; jmax = j; kmax = k + } + } + if (keepids) { + if (jmax < n1) { + Mem$t[kmax] = d1 + Memi[m[jmax]+i1] = Memi[m[n1]+i1] + } + } else { + if (jmax < n1) + Mem$t[kmax] = d1 + } + n1 = n1 - 1 + } + n[i] = n1 + } + + if (dflag == D_ALL && npairs + nlow + nhigh > 0) + dflag = D_MIX +end +$endfor diff --git a/noao/imred/ccdred/src/combine/icombine.com b/noao/imred/ccdred/src/combine/icombine.com new file mode 100644 index 00000000..cb826d58 --- /dev/null +++ b/noao/imred/ccdred/src/combine/icombine.com @@ -0,0 +1,40 @@ +# ICOMBINE Common + +int combine # Combine algorithm +int reject # Rejection algorithm +bool project # Combine across the highest dimension? +real blank # Blank value +pointer rdnoise # CCD read noise +pointer gain # CCD gain +pointer snoise # CCD sensitivity noise +real lthresh # Low threshold +real hthresh # High threshold +int nkeep # Minimum to keep +real lsigma # Low sigma cutoff +real hsigma # High sigma cutoff +real pclip # Number or fraction of pixels from median +real flow # Fraction of low pixels to reject +real fhigh # Fraction of high pixels to reject +int grow # Grow radius +bool mclip # Use median in sigma clipping? +real sigscale # Sigma scaling tolerance +int logfd # Log file descriptor + +# These flags allow special conditions to be optimized. + +int dflag # Data flag (D_ALL, D_NONE, D_MIX) +bool aligned # Are the images aligned? +bool doscale # Do the images have to be scaled? +bool doscale1 # Do the sigma calculations have to be scaled? +bool dothresh # Check pixels outside specified thresholds? +bool dowts # Does the final average have to be weighted? +bool keepids # Keep track of the image indices? +bool docombine # Call the combine procedure? +bool sort # Sort data? + +pointer icm # Mask data structure + +common /imccom/ combine, reject, blank, rdnoise, gain, snoise, lsigma, hsigma, + lthresh, hthresh, nkeep, pclip, flow, fhigh, grow, logfd, + dflag, sigscale, project, mclip, aligned, doscale, doscale1, + dothresh, dowts, keepids, docombine, sort, icm diff --git a/noao/imred/ccdred/src/combine/icombine.gx b/noao/imred/ccdred/src/combine/icombine.gx new file mode 100644 index 00000000..d6e93ef0 --- /dev/null +++ b/noao/imred/ccdred/src/combine/icombine.gx @@ -0,0 +1,395 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> +include <imset.h> +include <error.h> +include <syserr.h> +include <mach.h> +include "../icombine.h" + + +# ICOMBINE -- Combine images +# +# The memory and open file descriptor limits are checked and an attempt +# to recover is made either by setting the image pixel files to be +# closed after I/O or by notifying the calling program that memory +# ran out and the IMIO buffer size should be reduced. After the checks +# a procedure for the selected combine option is called. +# Because there may be several failure modes when reaching the file +# limits we first assume an error is due to the file limit, except for +# out of memory, and close some pixel files. If the error then repeats +# on accessing the pixels the error is passed back. + +$for (sr) +procedure icombine$t (in, out, offsets, nimages, bufsize) + +pointer in[nimages] # Input images +pointer out[ARB] # Output images +int offsets[nimages,ARB] # Input image offsets +int nimages # Number of input images +int bufsize # IMIO buffer size + +char str[1] +int i, j, npts, fd, stropen(), errcode(), imstati() +pointer sp, d, id, n, m, lflag, scales, zeros, wts, dbuf +pointer buf, imgl1$t(), impl1i() +errchk stropen, imgl1$t, impl1i +$if (datatype == sil) +pointer impl1r() +errchk impl1r +$else +pointer impl1$t() +errchk impl1$t +$endif + +include "../icombine.com" + +begin + npts = IM_LEN(out[1],1) + + # Allocate memory. + call smark (sp) + call salloc (d, nimages, TY_POINTER) + call salloc (id, nimages, TY_POINTER) + call salloc (n, npts, TY_INT) + call salloc (m, nimages, TY_POINTER) + call salloc (lflag, nimages, TY_INT) + call salloc (scales, nimages, TY_REAL) + call salloc (zeros, nimages, TY_REAL) + call salloc (wts, nimages, TY_REAL) + call amovki (D_ALL, Memi[lflag], nimages) + + # If aligned use the IMIO buffer otherwise we need vectors of + # output length. + + if (!aligned) { + call salloc (dbuf, nimages, TY_POINTER) + do i = 1, nimages + call salloc (Memi[dbuf+i-1], npts, TY_PIXEL) + } + + if (project) { + call imseti (in[1], IM_NBUFS, nimages) + call imseti (in[1], IM_BUFSIZE, bufsize) + do i = 1, 3 { + if (out[i] != NULL) + call imseti (out[i], IM_BUFSIZE, bufsize) + } + } else { + # Reserve FD for string operations. + fd = stropen (str, 1, NEW_FILE) + + # Do I/O to the images. + do i = 1, 3 { + if (out[i] != NULL) + call imseti (out[i], IM_BUFSIZE, bufsize) + } + $if (datatype == sil) + buf = impl1r (out[1]) + call aclrr (Memr[buf], npts) + if (out[3] != NULL) { + buf = impl1r (out[3]) + call aclrr (Memr[buf], npts) + } + $else + buf = impl1$t (out[1]) + call aclr$t (Mem$t[buf], npts) + if (out[3] != NULL) { + buf = impl1$t (out[3]) + call aclr$t (Mem$t[buf], npts) + } + $endif + if (out[2] != NULL) { + buf = impl1i (out[2]) + call aclri (Memi[buf], npts) + } + + do i = 1, nimages { + call imseti (in[i], IM_BUFSIZE, bufsize) + iferr (buf = imgl1$t (in[i])) { + switch (errcode()) { + case SYS_MFULL: + call sfree (sp) + call strclose (fd) + call erract (EA_ERROR) + case SYS_FTOOMANYFILES, SYS_IKIOPIX: + if (imstati (in[i], IM_CLOSEFD) == YES) { + call sfree (sp) + call strclose (fd) + call erract (EA_ERROR) + } + do j = i-2, nimages + call imseti (in[j], IM_CLOSEFD, YES) + buf = imgl1$t (in[i]) + default: + call sfree (sp) + call strclose (fd) + call erract (EA_ERROR) + } + } + } + + call strclose (fd) + } + + call ic_combine$t (in, out, Memi[dbuf], Memi[d], Memi[id], Memi[n], + Memi[m], Memi[lflag], offsets, Memr[scales], Memr[zeros], + Memr[wts], nimages, npts) +end + + +# IC_COMBINE -- Combine images. + +procedure ic_combine$t (in, out, dbuf, d, id, n, m, lflag, offsets, + scales, zeros, wts, nimages, npts) + +pointer in[nimages] # Input images +pointer out[ARB] # Output image +pointer dbuf[nimages] # Data buffers for nonaligned images +pointer d[nimages] # Data pointers +pointer id[nimages] # Image index ID pointers +int n[npts] # Number of good pixels +pointer m[nimages] # Mask pointers +int lflag[nimages] # Line flags +int offsets[nimages,ARB] # Input image offsets +real scales[nimages] # Scale factors +real zeros[nimages] # Zero offset factors +real wts[nimages] # Combining weights +int nimages # Number of input images +int npts # Number of points per output line + +int i, ctor() +real r, imgetr() +pointer sp, v1, v2, v3, outdata, buf, nm, impnli() +$if (datatype == sil) +pointer impnlr() +$else +pointer impnl$t() +$endif +errchk ic_scale, imgetr + +include "../icombine.com" + +begin + call smark (sp) + call salloc (v1, IM_MAXDIM, TY_LONG) + call salloc (v2, IM_MAXDIM, TY_LONG) + call salloc (v3, IM_MAXDIM, TY_LONG) + call amovkl (long(1), Meml[v1], IM_MAXDIM) + call amovkl (long(1), Meml[v2], IM_MAXDIM) + call amovkl (long(1), Meml[v3], IM_MAXDIM) + + call ic_scale (in, out, offsets, scales, zeros, wts, nimages) + + # Set combine parameters + switch (combine) { + case AVERAGE: + if (dowts) + keepids = true + else + keepids = false + case MEDIAN: + dowts = false + keepids = false + } + docombine = true + + # Set rejection algorithm specific parameters + switch (reject) { + case CCDCLIP, CRREJECT: + call salloc (nm, 3*nimages, TY_REAL) + i = 1 + if (ctor (Memc[rdnoise], i, r) > 0) { + do i = 1, nimages + Memr[nm+3*(i-1)] = r + } else { + do i = 1, nimages + Memr[nm+3*(i-1)] = imgetr (in[i], Memc[rdnoise]) + } + i = 1 + if (ctor (Memc[gain], i, r) > 0) { + do i = 1, nimages { + Memr[nm+3*(i-1)+1] = r + Memr[nm+3*(i-1)] = + max ((Memr[nm+3*(i-1)] / r) ** 2, 1e4 / MAX_REAL) + } + } else { + do i = 1, nimages { + r = imgetr (in[i], Memc[gain]) + Memr[nm+3*(i-1)+1] = r + Memr[nm+3*(i-1)] = + max ((Memr[nm+3*(i-1)] / r) ** 2, 1e4 / MAX_REAL) + } + } + i = 1 + if (ctor (Memc[snoise], i, r) > 0) { + do i = 1, nimages + Memr[nm+3*(i-1)+2] = r + } else { + do i = 1, nimages { + r = imgetr (in[i], Memc[snoise]) + Memr[nm+3*(i-1)+2] = r + } + } + if (!keepids) { + if (doscale1 || grow > 0) + keepids = true + else { + do i = 2, nimages { + if (Memr[nm+3*(i-1)] != Memr[nm] || + Memr[nm+3*(i-1)+1] != Memr[nm+1] || + Memr[nm+3*(i-1)+2] != Memr[nm+2]) { + keepids = true + break + } + } + } + } + if (reject == CRREJECT) + lsigma = MAX_REAL + case MINMAX: + mclip = false + if (grow > 0) + keepids = true + case PCLIP: + mclip = true + if (grow > 0) + keepids = true + case AVSIGCLIP, SIGCLIP: + if (doscale1 || grow > 0) + keepids = true + case NONE: + mclip = false + grow = 0 + } + + if (keepids) { + do i = 1, nimages + call salloc (id[i], npts, TY_INT) + } + + $if (datatype == sil) + while (impnlr (out[1], outdata, Meml[v1]) != EOF) { + call ic_gdata$t (in, out, dbuf, d, id, n, m, lflag, offsets, + scales, zeros, nimages, npts, Meml[v2], Meml[v3]) + + switch (reject) { + case CCDCLIP, CRREJECT: + if (mclip) + call ic_mccdclip$t (d, id, n, scales, zeros, Memr[nm], + nimages, npts, Memr[outdata]) + else + call ic_accdclip$t (d, id, n, scales, zeros, Memr[nm], + nimages, npts, Memr[outdata]) + case MINMAX: + call ic_mm$t (d, id, n, npts) + case PCLIP: + call ic_pclip$t (d, id, n, nimages, npts, Memr[outdata]) + case SIGCLIP: + if (mclip) + call ic_msigclip$t (d, id, n, scales, zeros, nimages, npts, + Memr[outdata]) + else + call ic_asigclip$t (d, id, n, scales, zeros, nimages, npts, + Memr[outdata]) + case AVSIGCLIP: + if (mclip) + call ic_mavsigclip$t (d, id, n, scales, zeros, nimages, + npts, Memr[outdata]) + else + call ic_aavsigclip$t (d, id, n, scales, zeros, nimages, + npts, Memr[outdata]) + } + + if (grow > 0) + call ic_grow$t (d, id, n, nimages, npts, Memr[outdata]) + + if (docombine) { + switch (combine) { + case AVERAGE: + call ic_average$t (d, id, n, wts, npts, Memr[outdata]) + case MEDIAN: + call ic_median$t (d, n, npts, Memr[outdata]) + } + } + + if (out[2] != NULL) { + call amovl (Meml[v2], Meml[v1], IM_MAXDIM) + i = impnli (out[2], buf, Meml[v1]) + call amovki (nimages, Memi[buf], npts) + call asubi (Memi[buf], n, Memi[buf], npts) + } + + if (out[3] != NULL) { + call amovl (Meml[v2], Meml[v1], IM_MAXDIM) + i = impnlr (out[3], buf, Meml[v1]) + call ic_sigma$t (d, id, n, wts, npts, Memr[outdata], + Memr[buf]) + } + call amovl (Meml[v1], Meml[v2], IM_MAXDIM) + } + $else + while (impnl$t (out[1], outdata, Meml[v1]) != EOF) { + call ic_gdata$t (in, out, dbuf, d, id, n, m, lflag, offsets, + scales, zeros, nimages, npts, Meml[v2], Meml[v3]) + + switch (reject) { + case CCDCLIP, CRREJECT: + if (mclip) + call ic_mccdclip$t (d, id, n, scales, zeros, Memr[nm], + nimages, npts, Mem$t[outdata]) + else + call ic_accdclip$t (d, id, n, scales, zeros, Memr[nm], + nimages, npts, Mem$t[outdata]) + case MINMAX: + call ic_mm$t (d, id, n, npts) + case PCLIP: + call ic_pclip$t (d, id, n, nimages, npts, Mem$t[outdata]) + case SIGCLIP: + if (mclip) + call ic_msigclip$t (d, id, n, scales, zeros, nimages, npts, + Mem$t[outdata]) + else + call ic_asigclip$t (d, id, n, scales, zeros, nimages, npts, + Mem$t[outdata]) + case AVSIGCLIP: + if (mclip) + call ic_mavsigclip$t (d, id, n, scales, zeros, nimages, + npts, Mem$t[outdata]) + else + call ic_aavsigclip$t (d, id, n, scales, zeros, nimages, + npts, Mem$t[outdata]) + } + + if (grow > 0) + call ic_grow$t (d, id, n, nimages, npts, Mem$t[outdata]) + + if (docombine) { + switch (combine) { + case AVERAGE: + call ic_average$t (d, id, n, wts, npts, Mem$t[outdata]) + case MEDIAN: + call ic_median$t (d, n, npts, Mem$t[outdata]) + } + } + + if (out[2] != NULL) { + call amovl (Meml[v2], Meml[v1], IM_MAXDIM) + i = impnli (out[2], buf, Meml[v1]) + call amovki (nimages, Memi[buf], npts) + call asubi (Memi[buf], n, Memi[buf], npts) + } + + if (out[3] != NULL) { + call amovl (Meml[v2], Meml[v1], IM_MAXDIM) + i = impnl$t (out[3], buf, Meml[v1]) + call ic_sigma$t (d, id, n, wts, npts, Mem$t[outdata], + Mem$t[buf]) + } + call amovl (Meml[v1], Meml[v2], IM_MAXDIM) + } + $endif + + call sfree (sp) +end +$endfor diff --git a/noao/imred/ccdred/src/combine/icombine.h b/noao/imred/ccdred/src/combine/icombine.h new file mode 100644 index 00000000..13b77117 --- /dev/null +++ b/noao/imred/ccdred/src/combine/icombine.h @@ -0,0 +1,52 @@ +# ICOMBINE Definitions + +# Memory management parameters; +define DEFBUFSIZE 65536 # default IMIO buffer size +define FUDGE 0.8 # fudge factor + +# Rejection options: +define REJECT "|none|ccdclip|crreject|minmax|pclip|sigclip|avsigclip|" +define NONE 1 # No rejection algorithm +define CCDCLIP 2 # CCD noise function clipping +define CRREJECT 3 # CCD noise function clipping +define MINMAX 4 # Minmax rejection +define PCLIP 5 # Percentile clip +define SIGCLIP 6 # Sigma clip +define AVSIGCLIP 7 # Sigma clip with average poisson sigma + +# Combine options: +define COMBINE "|average|median|" +define AVERAGE 1 +define MEDIAN 2 + +# Scaling options: +define STYPES "|none|mode|median|mean|exposure|" +define ZTYPES "|none|mode|median|mean|" +define WTYPES "|none|mode|median|mean|exposure|" +define S_NONE 1 +define S_MODE 2 +define S_MEDIAN 3 +define S_MEAN 4 +define S_EXPOSURE 5 +define S_FILE 6 +define S_KEYWORD 7 +define S_SECTION "|input|output|overlap|" +define S_INPUT 1 +define S_OUTPUT 2 +define S_OVERLAP 3 + +# Mask options +define MASKTYPES "|none|goodvalue|badvalue|goodbits|badbits|" +define M_NONE 1 # Don't use mask images +define M_GOODVAL 2 # Value selecting good pixels +define M_BADVAL 3 # Value selecting bad pixels +define M_GOODBITS 4 # Bits selecting good pixels +define M_BADBITS 5 # Bits selecting bad pixels +define M_BOOLEAN -1 # Ignore mask values + +# Data flag +define D_ALL 0 # All pixels are good +define D_NONE 1 # All pixels are bad or rejected +define D_MIX 2 # Mixture of good and bad pixels + +define TOL 0.001 # Tolerance for equal residuals diff --git a/noao/imred/ccdred/src/combine/icpclip.gx b/noao/imred/ccdred/src/combine/icpclip.gx new file mode 100644 index 00000000..223396c3 --- /dev/null +++ b/noao/imred/ccdred/src/combine/icpclip.gx @@ -0,0 +1,233 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "../icombine.h" + +define MINCLIP 3 # Minimum number for clipping + +$for (sr) +# IC_PCLIP -- Percentile clip +# +# 1) Find the median +# 2) Find the pixel which is the specified order index away +# 3) Use the data value difference as a sigma and apply clipping +# 4) Since the median is known return it so it does not have to be recomputed + +procedure ic_pclip$t (d, m, n, nimages, npts, median) + +pointer d[ARB] # Data pointers +pointer m[ARB] # Image id pointers +int n[npts] # Number of good pixels +int nimages # Number of input images +int npts # Number of output points per line +$if (datatype == sil) +real median[npts] # Median +$else +PIXEL median[npts] # Median +$endif + +int i, j, k, l, id, n1, n2, n3, n4, n5, nl, nh, nin, maxkeep +bool even, fp_equalr() +real sigma, r, s, t +pointer sp, resid, mp1, mp2 +$if (datatype == sil) +real med +$else +PIXEL med +$endif + +include "../icombine.com" + +begin + # There must be at least MINCLIP and more than nkeep pixels. + if (nkeep < 0) + maxkeep = max (0, nimages + nkeep) + else + maxkeep = min (nimages, nkeep) + if (nimages < max (MINCLIP, maxkeep+1) || dflag == D_NONE) { + docombine = true + return + } + + call smark (sp) + call salloc (resid, nimages+1, TY_REAL) + + # Set sign of pclip parameter + if (pclip < 0) + t = -1. + else + t = 1. + + # If there are no rejected pixels compute certain parameters once. + if (dflag == D_ALL) { + n1 = n[1] + if (nkeep < 0) + maxkeep = max (0, n1 + nkeep) + else + maxkeep = min (n1, nkeep) + n2 = 1 + n1 / 2 + even = (mod (n1, 2) == 0) + if (pclip < 0.) { + if (even) + n3 = max (1, nint (n2 - 1 + pclip)) + else + n3 = max (1, nint (n2 + pclip)) + } else + n3 = min (n1, nint (n2 + pclip)) + nin = n1 + } + + # Now apply clipping. + do i = 1, npts { + # Compute median. + if (dflag == D_MIX) { + n1 = n[i] + if (nkeep < 0) + maxkeep = max (0, n1 + nkeep) + else + maxkeep = min (n1, nkeep) + if (n1 == 0) { + if (combine == MEDIAN) + median[i] = blank + next + } + n2 = 1 + n1 / 2 + even = (mod (n1, 2) == 0) + if (pclip < 0) { + if (even) + n3 = max (1, nint (n2 - 1 + pclip)) + else + n3 = max (1, nint (n2 + pclip)) + } else + n3 = min (n1, nint (n2 + pclip)) + } + + j = i - 1 + if (even) { + med = Mem$t[d[n2-1]+j] + med = (med + Mem$t[d[n2]+j]) / 2. + } else + med = Mem$t[d[n2]+j] + + if (n1 < max (MINCLIP, maxkeep+1)) { + if (combine == MEDIAN) + median[i] = med + next + } + + # Define sigma for clipping + sigma = t * (Mem$t[d[n3]+j] - med) + if (fp_equalr (sigma, 0.)) { + if (combine == MEDIAN) + median[i] = med + next + } + + # Reject pixels and save residuals. + # Check if any pixels are clipped. + # If so recompute the median and reset the number of good pixels. + # Only reorder if needed. + + for (nl=1; nl<=n1; nl=nl+1) { + r = (med - Mem$t[d[nl]+j]) / sigma + if (r < lsigma) + break + Memr[resid+nl] = r + } + for (nh=n1; nh>=1; nh=nh-1) { + r = (Mem$t[d[nh]+j] - med) / sigma + if (r < hsigma) + break + Memr[resid+nh] = r + } + n4 = nh - nl + 1 + + # If too many pixels are rejected add some back in. + # All pixels with the same residual are added. + while (n4 < maxkeep) { + if (nl == 1) + nh = nh + 1 + else if (nh == n[i]) + nl = nl - 1 + else { + r = Memr[resid+nl-1] + s = Memr[resid+nh+1] + if (r < s) { + nl = nl - 1 + r = r + TOL + if (s <= r) + nh = nh + 1 + if (nl > 1) { + if (Memr[resid+nl-1] <= r) + nl = nl - 1 + } + } else { + nh = nh + 1 + s = s + TOL + if (r <= s) + nl = nl - 1 + if (nh < n2) { + if (Memr[resid+nh+1] <= s) + nh = nh + 1 + } + } + } + n4 = nh - nl + 1 + } + + # If any pixels are rejected recompute the median. + if (nl > 1 || nh < n1) { + n5 = nl + n4 / 2 + if (mod (n4, 2) == 0) { + med = Mem$t[d[n5-1]+j] + med = (med + Mem$t[d[n5]+j]) / 2. + } else + med = Mem$t[d[n5]+j] + n[i] = n4 + } + if (combine == MEDIAN) + median[i] = med + + # Reorder if pixels only if necessary. + if (nl > 1 && (combine != MEDIAN || grow > 0)) { + k = max (nl, n4 + 1) + if (keepids) { + do l = 1, min (n1, nl-1) { + Mem$t[d[l]+j] = Mem$t[d[k]+j] + if (grow > 0) { + mp1 = m[l] + j + mp2 = m[k] + j + id = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = id + } else + Memi[m[l]+j] = Memi[m[k]+j] + k = k + 1 + } + } else { + do l = 1, min (n1, nl - 1) { + Mem$t[d[l]+j] = Mem$t[d[k]+j] + k = k + 1 + } + } + } + } + + # Check if data flag needs to be reset for rejected pixels. + if (dflag == D_ALL) { + do i = 1, npts { + if (n[i] != nin) { + dflag = D_MIX + break + } + } + } + + # Flag whether the median has been computed. + if (combine == MEDIAN) + docombine = false + else + docombine = true + + call sfree (sp) +end +$endfor diff --git a/noao/imred/ccdred/src/combine/icscale.x b/noao/imred/ccdred/src/combine/icscale.x new file mode 100644 index 00000000..fc4efb2f --- /dev/null +++ b/noao/imred/ccdred/src/combine/icscale.x @@ -0,0 +1,376 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> +include <imset.h> +include <error.h> +include "icombine.h" + +# IC_SCALE -- Get the scale factors for the images. +# 1. This procedure does CLIO to determine the type of scaling desired. +# 2. The output header parameters for exposure time and NCOMBINE are set. + +procedure ic_scale (in, out, offsets, scales, zeros, wts, nimages) + +pointer in[nimages] # Input images +pointer out[ARB] # Output images +int offsets[nimages,ARB] # Image offsets +real scales[nimages] # Scale factors +real zeros[nimages] # Zero or sky levels +real wts[nimages] # Weights +int nimages # Number of images + +int stype, ztype, wtype +int i, j, k, l, nout +real mode, median, mean, exposure, zmean, darktime, dark +pointer sp, ncombine, exptime, modes, medians, means +pointer section, str, sname, zname, wname, imref +bool domode, domedian, domean, dozero, snorm, znorm, wflag + +bool clgetb() +int hdmgeti(), strdic(), ic_gscale() +real hdmgetr(), asumr(), asumi() +errchk ic_gscale, ic_statr + +include "icombine.com" + +begin + call smark (sp) + call salloc (ncombine, nimages, TY_INT) + call salloc (exptime, nimages, TY_REAL) + call salloc (modes, nimages, TY_REAL) + call salloc (medians, nimages, TY_REAL) + call salloc (means, nimages, TY_REAL) + call salloc (section, SZ_FNAME, TY_CHAR) + call salloc (str, SZ_LINE, TY_CHAR) + call salloc (sname, SZ_FNAME, TY_CHAR) + call salloc (zname, SZ_FNAME, TY_CHAR) + call salloc (wname, SZ_FNAME, TY_CHAR) + + # Set the defaults. + call amovki (1, Memi[ncombine], nimages) + call amovkr (0., Memr[exptime], nimages) + call amovkr (INDEF, Memr[modes], nimages) + call amovkr (INDEF, Memr[medians], nimages) + call amovkr (INDEF, Memr[means], nimages) + call amovkr (1., scales, nimages) + call amovkr (0., zeros, nimages) + call amovkr (1., wts, nimages) + + # Get the number of images previously combined and the exposure times. + # The default combine number is 1 and the default exposure is 0. + + do i = 1, nimages { + iferr (Memi[ncombine+i-1] = hdmgeti (in[i], "ncombine")) + Memi[ncombine+i-1] = 1 + iferr (Memr[exptime+i-1] = hdmgetr (in[i], "exptime")) + Memr[exptime+i-1] = 0. + if (project) { + call amovki (Memi[ncombine], Memi[ncombine], nimages) + call amovkr (Memr[exptime], Memr[exptime], nimages) + break + } + } + + # Set scaling factors. + + stype = ic_gscale ("scale", Memc[sname], STYPES, in, Memr[exptime], + scales, nimages) + ztype = ic_gscale ("zero", Memc[zname], ZTYPES, in, Memr[exptime], + zeros, nimages) + wtype = ic_gscale ("weight", Memc[wname], WTYPES, in, Memr[exptime], + wts, nimages) + + # Get image statistics only if needed. + domode = ((stype==S_MODE)||(ztype==S_MODE)||(wtype==S_MODE)) + domedian = ((stype==S_MEDIAN)||(ztype==S_MEDIAN)||(wtype==S_MEDIAN)) + domean = ((stype==S_MEAN)||(ztype==S_MEAN)||(wtype==S_MEAN)) + if (domode || domedian || domean) { + Memc[section] = EOS + Memc[str] = EOS + call clgstr ("statsec", Memc[section], SZ_FNAME) + call sscan (Memc[section]) + call gargwrd (Memc[section], SZ_FNAME) + call gargwrd (Memc[str], SZ_LINE) + + i = strdic (Memc[section], Memc[section], SZ_FNAME, S_SECTION) + switch (i) { + case S_INPUT: + call strcpy (Memc[str], Memc[section], SZ_FNAME) + imref = NULL + case S_OUTPUT: + call strcpy (Memc[str], Memc[section], SZ_FNAME) + imref = out[1] + case S_OVERLAP: + call strcpy ("[", Memc[section], SZ_FNAME) + do i = 1, IM_NDIM(out[1]) { + k = offsets[1,i] + 1 + l = offsets[1,i] + IM_LEN(in[1],i) + do j = 2, nimages { + k = max (k, offsets[j,i]+1) + l = min (l, offsets[j,i]+IM_LEN(in[j],i)) + } + if (i < IM_NDIM(out[1])) + call sprintf (Memc[str], SZ_LINE, "%d:%d,") + else + call sprintf (Memc[str], SZ_LINE, "%d:%d]") + call pargi (k) + call pargi (l) + call strcat (Memc[str], Memc[section], SZ_FNAME) + } + imref = out[1] + default: + imref = NULL + } + + do i = 1, nimages { + if (imref != out[1]) + imref = in[i] + call ic_statr (in[i], imref, Memc[section], offsets, + i, nimages, domode, domedian, domean, mode, median, mean) + if (domode) { + Memr[modes+i-1] = mode + if (stype == S_MODE) + scales[i] = mode + if (ztype == S_MODE) + zeros[i] = mode + if (wtype == S_MODE) + wts[i] = mode + } + if (domedian) { + Memr[medians+i-1] = median + if (stype == S_MEDIAN) + scales[i] = median + if (ztype == S_MEDIAN) + zeros[i] = median + if (wtype == S_MEDIAN) + wts[i] = median + } + if (domean) { + Memr[means+i-1] = mean + if (stype == S_MEAN) + scales[i] = mean + if (ztype == S_MEAN) + zeros[i] = mean + if (wtype == S_MEAN) + wts[i] = mean + } + } + } + + do i = 1, nimages + if (scales[i] <= 0.) { + call eprintf ("WARNING: Negative scale factors") + call eprintf (" -- ignoring scaling\n") + call amovkr (1., scales, nimages) + break + } + + # Convert to relative factors if needed. + snorm = (stype == S_FILE || stype == S_KEYWORD) + znorm = (ztype == S_FILE || ztype == S_KEYWORD) + wflag = (wtype == S_FILE || wtype == S_KEYWORD) + if (snorm) + call arcpr (1., scales, scales, nimages) + else { + mean = asumr (scales, nimages) / nimages + call adivkr (scales, mean, scales, nimages) + } + call adivr (zeros, scales, zeros, nimages) + zmean = asumr (zeros, nimages) / nimages + + if (wtype != S_NONE) { + do i = 1, nimages { + if (wts[i] <= 0.) { + call eprintf ("WARNING: Negative weights") + call eprintf (" -- using only NCOMBINE weights\n") + do j = 1, nimages + wts[j] = Memi[ncombine+j-1] + break + } + if (ztype == S_NONE || znorm || wflag) + wts[i] = Memi[ncombine+i-1] * wts[i] + else { + if (zeros[i] <= 0.) { + call eprintf ("WARNING: Negative zero offsets") + call eprintf (" -- ignoring zero weight adjustments\n") + do j = 1, nimages + wts[j] = Memi[ncombine+j-1] * wts[j] + break + } + wts[i] = Memi[ncombine+i-1] * wts[i] * zmean / zeros[i] + } + } + } + + if (znorm) + call anegr (zeros, zeros, nimages) + else { + # Because of finite arithmetic it is possible for the zero offsets + # to be nonzero even when they are all equal. Just for the sake of + # a nice log set the zero offsets in this case. + + call asubkr (zeros, zmean, zeros, nimages) + for (i=2; (i<=nimages)&&(zeros[i]==zeros[1]); i=i+1) + ; + if (i > nimages) + call aclrr (zeros, nimages) + } + mean = asumr (wts, nimages) + call adivkr (wts, mean, wts, nimages) + + # Set flags for scaling, zero offsets, sigma scaling, weights. + # Sigma scaling may be suppressed if the scales or zeros are + # different by a specified tolerance. + + doscale = false + dozero = false + doscale1 = false + dowts = false + do i = 2, nimages { + if (snorm || scales[i] != scales[1]) + doscale = true + if (znorm || zeros[i] != zeros[1]) + dozero = true + if (wts[i] != wts[1]) + dowts = true + } + if (doscale && sigscale != 0.) { + do i = 1, nimages { + if (abs (scales[i] - 1) > sigscale) { + doscale1 = true + break + } + } + if (!doscale1 && zmean > 0.) { + do i = 1, nimages { + if (abs (zeros[i] / zmean) > sigscale) { + doscale1 = true + break + } + } + } + } + + # Set the output header parameters. + nout = asumi (Memi[ncombine], nimages) + call hdmputi (out[1], "ncombine", nout) + exposure = 0. + darktime = 0. + mean = 0. + do i = 1, nimages { + exposure = exposure + wts[i] * Memr[exptime+i-1] / scales[i] + ifnoerr (dark = hdmgetr (in[i], "darktime")) + darktime = darktime + wts[i] * dark / scales[i] + else + darktime = darktime + wts[i] * Memr[exptime+i-1] / scales[i] + ifnoerr (mode = hdmgetr (in[i], "ccdmean")) + mean = mean + wts[i] * mode / scales[i] + } + call hdmputr (out[1], "exptime", exposure) + call hdmputr (out[1], "darktime", darktime) + ifnoerr (mode = hdmgetr (out[1], "ccdmean")) { + call hdmputr (out[1], "ccdmean", mean) + iferr (call imdelf (out[1], "ccdmeant")) + ; + } + if (out[2] != NULL) { + call imstats (out[2], IM_IMAGENAME, Memc[str], SZ_FNAME) + call imastr (out[1], "BPM", Memc[str]) + } + + # Start the log here since much of the info is only available here. + if (clgetb ("verbose")) { + i = logfd + logfd = STDOUT + call ic_log (in, out, Memi[ncombine], Memr[exptime], Memc[sname], + Memc[zname], Memc[wname], Memr[modes], Memr[medians], + Memr[means], scales, zeros, wts, offsets, nimages, dozero, + nout, "", exposure) + + logfd = i + } + call ic_log (in, out, Memi[ncombine], Memr[exptime], Memc[sname], + Memc[zname], Memc[wname], Memr[modes], Memr[medians], Memr[means], + scales, zeros, wts, offsets, nimages, dozero, nout, + "", exposure) + + doscale = (doscale || dozero) + + call sfree (sp) +end + + +# IC_GSCALE -- Get scale values as directed by CL parameter +# The values can be one of those in the dictionary, from a file specified +# with a @ prefix, or from an image header keyword specified by a ! prefix. + +int procedure ic_gscale (param, name, dic, in, exptime, values, nimages) + +char param[ARB] #I CL parameter name +char name[SZ_FNAME] #O Parameter value +char dic[ARB] #I Dictionary string +pointer in[nimages] #I IMIO pointers +real exptime[nimages] #I Exposure times +real values[nimages] #O Values +int nimages #I Number of images + +int type #O Type of value + +int fd, i, nowhite(), open(), fscan(), nscan(), strdic() +real rval, hdmgetr() +pointer errstr +errchk open, hdmgetr() + +include "icombine.com" + +begin + call clgstr (param, name, SZ_FNAME) + if (nowhite (name, name, SZ_FNAME) == 0) + type = S_NONE + else if (name[1] == '@') { + type = S_FILE + fd = open (name[2], READ_ONLY, TEXT_FILE) + i = 0 + while (fscan (fd) != EOF) { + call gargr (rval) + if (nscan() != 1) + next + if (i == nimages) { + call eprintf ( + "Warning: Ignoring additional %s values in %s\n") + call pargstr (param) + call pargstr (name[2]) + break + } + i = i + 1 + values[i] = rval + } + call close (fd) + if (i < nimages) { + call salloc (errstr, SZ_LINE, TY_CHAR) + call sprintf (Memc[errstr], SZ_FNAME, + "Insufficient %s values in %s") + call pargstr (param) + call pargstr (name[2]) + call error (1, Memc[errstr]) + } + } else if (name[1] == '!') { + type = S_KEYWORD + do i = 1, nimages { + values[i] = hdmgetr (in[i], name[2]) + if (project) { + call amovkr (values, values, nimages) + break + } + } + } else { + type = strdic (name, name, SZ_FNAME, dic) + if (type == 0) + call error (1, "Unknown scale, zero, or weight type") + if (type==S_EXPOSURE) + do i = 1, nimages + values[i] = max (0.001, exptime[i]) + } + + return (type) +end diff --git a/noao/imred/ccdred/src/combine/icsclip.gx b/noao/imred/ccdred/src/combine/icsclip.gx new file mode 100644 index 00000000..f70611aa --- /dev/null +++ b/noao/imred/ccdred/src/combine/icsclip.gx @@ -0,0 +1,504 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "../icombine.h" + +define MINCLIP 3 # Mininum number of images for algorithm + +$for (sr) +# IC_ASIGCLIP -- Reject pixels using sigma clipping about the average +# The initial average rejects the high and low pixels. A correction for +# different scalings of the images may be made. Weights are not used. + +procedure ic_asigclip$t (d, m, n, scales, zeros, nimages, npts, average) + +pointer d[nimages] # Data pointers +pointer m[nimages] # Image id pointers +int n[npts] # Number of good pixels +real scales[nimages] # Scales +real zeros[nimages] # Zeros +int nimages # Number of images +int npts # Number of output points per line +$if (datatype == sil) +real average[npts] # Average +$else +PIXEL average[npts] # Average +$endif + +int i, j, k, l, jj, n1, n2, nin, nk, maxkeep +$if (datatype == sil) +real d1, low, high, sum, a, s, r, one +data one /1.0/ +$else +PIXEL d1, low, high, sum, a, s, r, one +data one /1$f/ +$endif +pointer sp, resid, w, wp, dp1, dp2, mp1, mp2 + +include "../icombine.com" + +begin + # If there are insufficient pixels go on to the combining + if (nkeep < 0) + maxkeep = max (0, nimages + nkeep) + else + maxkeep = min (nimages, nkeep) + if (nimages < max (MINCLIP, maxkeep+1) || dflag == D_NONE) { + docombine = true + return + } + + # Flag whether returned average needs to be recomputed. + if (dowts || combine != AVERAGE) + docombine = true + else + docombine = false + + # Save the residuals and the sigma scaling corrections if needed. + call smark (sp) + call salloc (resid, nimages+1, TY_REAL) + if (doscale1) + call salloc (w, nimages, TY_REAL) + + # Do sigma clipping. + nin = n[1] + do i = 1, npts { + k = i - 1 + n1 = n[i] + if (nkeep < 0) + maxkeep = max (0, n1 + nkeep) + else + maxkeep = min (n1, nkeep) + + # If there are not enough pixels simply compute the average. + if (n1 < max (3, maxkeep)) { + if (!docombine) { + if (n1 == 0) + average[i] = blank + else { + sum = Mem$t[d[1]+k] + do j = 2, n1 + sum = sum + Mem$t[d[j]+k] + average[i] = sum / n1 + } + } + next + } + + # Compute average with the high and low rejected. + low = Mem$t[d[1]+k] + high = Mem$t[d[2]+k] + if (low > high) { + d1 = low + low = high + high = d1 + } + sum = 0. + do j = 3, n1 { + d1 = Mem$t[d[j]+k] + if (d1 < low) { + sum = sum + low + low = d1 + } else if (d1 > high) { + sum = sum + high + high = d1 + } else + sum = sum + d1 + } + a = sum / (n1 - 2) + sum = sum + low + high + + # Iteratively reject pixels and compute the final average if needed. + # Compact the data and keep track of the image IDs if needed. + + repeat { + n2 = n1 + if (doscale1) { + # Compute sigma corrected for scaling. + s = 0. + wp = w - 1 + do j = 1, n1 { + dp1 = d[j] + k + mp1 = m[j] + k + wp = wp + 1 + + d1 = Mem$t[dp1] + l = Memi[mp1] + r = sqrt (max (one, (a + zeros[l]) / scales[l])) + s = s + ((d1 - a) / r) ** 2 + Memr[wp] = r + } + s = sqrt (s / (n1 - 1)) + + # Reject pixels. Save the residuals and data values. + wp = w - 1 + if (s > 0.) { + for (j=1; j<=n1; j=j+1) { + dp1 = d[j] + k + mp1 = m[j] + k + wp = wp + 1 + + d1 = Mem$t[dp1] + r = (d1 - a) / (s * Memr[wp]) + if (r < -lsigma || r > hsigma) { + Memr[resid+n1] = abs (r) + if (j < n1) { + dp2 = d[n1] + k + Mem$t[dp1] = Mem$t[dp2] + Mem$t[dp2] = d1 + Memr[wp] = Memr[w+n1-1] + mp2 = m[n1] + k + l = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = l + j = j - 1 + } + sum = sum - d1 + n1 = n1 - 1 + } + } + } + } else { + # Compute the sigma without scale correction. + s = 0. + do j = 1, n1 + s = s + (Mem$t[d[j]+k] - a) ** 2 + s = sqrt (s / (n1 - 1)) + + # Reject pixels. Save the residuals and data values. + if (s > 0.) { + for (j=1; j<=n1; j=j+1) { + dp1 = d[j] + k + d1 = Mem$t[dp1] + r = (d1 - a) / s + if (r < -lsigma || r > hsigma) { + Memr[resid+n1] = abs (r) + if (j < n1) { + dp2 = d[n1] + k + Mem$t[dp1] = Mem$t[dp2] + Mem$t[dp2] = d1 + if (keepids) { + mp1 = m[j] + k + mp2 = m[n1] + k + l = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = l + } + j = j - 1 + } + sum = sum - d1 + n1 = n1 - 1 + } + } + } + } + + # Recompute the average. + if (n1 > 1) + a = sum / n1 + } until (n1 == n2 || n1 <= max (2, maxkeep)) + + # If too many pixels are rejected add some back. + # All pixels with equal residuals are added back. + if (n1 < maxkeep) { + nk = maxkeep + if (doscale1) { + for (j=n1+1; j<=nk; j=j+1) { + dp1 = d[j] + k + mp1 = m[j] + k + r = Memr[resid+j] + jj = 0 + do l = j+1, n2 { + s = Memr[resid+l] + if (s < r + TOL) { + if (s > r - TOL) + jj = jj + 1 + else { + jj = 0 + Memr[resid+l] = r + r = s + dp2 = d[l] + k + d1 = Mem$t[dp1] + Mem$t[dp1] = Mem$t[dp2] + Mem$t[dp2] = d1 + mp2 = m[l] + k + s = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = s + } + } + } + sum = sum + Mem$t[dp1] + n1 = n1 + 1 + nk = max (nk, j+jj) + } + } else { + for (j=n1+1; j<=nk; j=j+1) { + dp1 = d[j] + k + r = Memr[resid+j] + jj = 0 + do l = j+1, n2 { + s = Memr[resid+l] + if (s < r + TOL) { + if (s > r - TOL) + jj = jj + 1 + else { + jj = 0 + Memr[resid+l] = r + r = s + dp2 = d[l] + k + d1 = Mem$t[dp1] + Mem$t[dp1] = Mem$t[dp2] + Mem$t[dp2] = d1 + if (keepids) { + mp1 = m[j] + k + mp2 = m[l] + k + s = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = s + } + } + } + } + sum = sum + Mem$t[dp1] + n1 = n1 + 1 + nk = max (nk, j+jj) + } + } + + # Recompute the average. + if (n1 > 1) + a = sum / n1 + } + + # Save the average if needed. + n[i] = n1 + if (!docombine) { + if (n1 > 0) + average[i] = a + else + average[i] = blank + } + } + + # Check if the data flag has to be reset for rejected pixels + if (dflag == D_ALL) { + do i = 1, npts { + if (n[i] != nin) { + dflag = D_MIX + break + } + } + } + + call sfree (sp) +end + + +# IC_MSIGCLIP -- Reject pixels using sigma clipping about the median + +procedure ic_msigclip$t (d, m, n, scales, zeros, nimages, npts, median) + +pointer d[nimages] # Data pointers +pointer m[nimages] # Image id pointers +int n[npts] # Number of good pixels +real scales[nimages] # Scales +real zeros[nimages] # Zeros +int nimages # Number of images +int npts # Number of output points per line +$if (datatype == sil) +real median[npts] # Median +$else +PIXEL median[npts] # Median +$endif + +int i, j, k, l, id, n1, n2, n3, nl, nh, nin, maxkeep +real r, s +pointer sp, resid, w, mp1, mp2 +$if (datatype == sil) +real med, one +data one /1.0/ +$else +PIXEL med, one +data one /1$f/ +$endif + +include "../icombine.com" + +begin + # If there are insufficient pixels go on to the combining + if (nkeep < 0) + maxkeep = max (0, nimages + nkeep) + else + maxkeep = min (nimages, nkeep) + if (nimages < max (MINCLIP, maxkeep+1) || dflag == D_NONE) { + docombine = true + return + } + + # Save the residuals and sigma scaling corrections if needed. + call smark (sp) + call salloc (resid, nimages+1, TY_REAL) + if (doscale1) + call salloc (w, nimages, TY_REAL) + + # Compute median and sigma and iteratively clip. + nin = n[1] + do i = 1, npts { + k = i - 1 + n1 = n[i] + if (nkeep < 0) + maxkeep = max (0, n1 + nkeep) + else + maxkeep = min (n1, nkeep) + nl = 1 + nh = n1 + + repeat { + n2 = n1 + n3 = nl + n1 / 2 + + if (n1 == 0) + med = blank + else if (mod (n1, 2) == 0) + med = (Mem$t[d[n3-1]+k] + Mem$t[d[n3]+k]) / 2. + else + med = Mem$t[d[n3]+k] + + if (n1 >= max (MINCLIP, maxkeep+1)) { + if (doscale1) { + # Compute the sigma with scaling correction. + s = 0. + do j = nl, nh { + l = Memi[m[j]+k] + r = sqrt (max (one, (med + zeros[l]) / scales[l])) + s = s + ((Mem$t[d[j]+k] - med) / r) ** 2 + Memr[w+j-1] = r + } + s = sqrt (s / (n1 - 1)) + + # Reject pixels and save the residuals. + if (s > 0.) { + for (; nl <= n2; nl = nl + 1) { + r = (med - Mem$t[d[nl]+k]) / (s * Memr[w+nl-1]) + if (r <= lsigma) + break + Memr[resid+nl] = r + n1 = n1 - 1 + } + for (; nh >= nl; nh = nh - 1) { + r = (Mem$t[d[nh]+k] - med) / (s * Memr[w+nh-1]) + if (r <= hsigma) + break + Memr[resid+nh] = r + n1 = n1 - 1 + } + } + } else { + # Compute the sigma without scaling correction. + s = 0. + do j = nl, nh + s = s + (Mem$t[d[j]+k] - med) ** 2 + s = sqrt (s / (n1 - 1)) + + # Reject pixels and save the residuals. + if (s > 0.) { + for (; nl <= n2; nl = nl + 1) { + r = (med - Mem$t[d[nl]+k]) / s + if (r <= lsigma) + break + Memr[resid+nl] = r + n1 = n1 - 1 + } + for (; nh >= nl; nh = nh - 1) { + r = (Mem$t[d[nh]+k] - med) / s + if (r <= hsigma) + break + Memr[resid+nh] = r + n1 = n1 - 1 + } + } + } + } + } until (n1 == n2 || n1 < max (MINCLIP, maxkeep+1)) + + # If too many pixels are rejected add some back. + # All pixels with equal residuals are added back. + while (n1 < maxkeep) { + if (nl == 1) + nh = nh + 1 + else if (nh == n[i]) + nl = nl - 1 + else { + r = Memr[resid+nl-1] + s = Memr[resid+nh+1] + if (r < s) { + nl = nl - 1 + r = r + TOL + if (s <= r) + nh = nh + 1 + if (nl > 1) { + if (Memr[resid+nl-1] <= r) + nl = nl - 1 + } + } else { + nh = nh + 1 + s = s + TOL + if (r <= s) + nl = nl - 1 + if (nh < n2) { + if (Memr[resid+nh+1] <= s) + nh = nh + 1 + } + } + } + n1 = nh - nl + 1 + } + + # Only set median and reorder if needed + n[i] = n1 + if (n1 > 0 && nl > 1 && (combine != MEDIAN || grow > 0)) { + j = max (nl, n1 + 1) + if (keepids) { + do l = 1, min (n1, nl-1) { + Mem$t[d[l]+k] = Mem$t[d[j]+k] + if (grow > 0) { + mp1 = m[l] + k + mp2 = m[j] + k + id = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = id + } else + Memi[m[l]+k] = Memi[m[j]+k] + j = j + 1 + } + } else { + do l = 1, min (n1, nl - 1) { + Mem$t[d[l]+k] = Mem$t[d[j]+k] + j = j + 1 + } + } + } + + if (combine == MEDIAN) + median[i] = med + } + + # Check if data flag needs to be reset for rejected pixels + if (dflag == D_ALL) { + do i = 1, npts { + if (n[i] != nin) { + dflag = D_MIX + break + } + } + } + + # Flag that the median has been computed. + if (combine == MEDIAN) + docombine = false + else + docombine = true + + call sfree (sp) +end +$endfor diff --git a/noao/imred/ccdred/src/combine/icsection.x b/noao/imred/ccdred/src/combine/icsection.x new file mode 100644 index 00000000..746c1f51 --- /dev/null +++ b/noao/imred/ccdred/src/combine/icsection.x @@ -0,0 +1,94 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <ctype.h> + +# IC_SECTION -- Parse an image section into its elements. +# 1. The default values must be set by the caller. +# 2. A null image section is OK. +# 3. The first nonwhitespace character must be '['. +# 4. The last interpreted character must be ']'. +# +# This procedure should be replaced with an IMIO procedure at some +# point. + +procedure ic_section (section, x1, x2, xs, ndim) + +char section[ARB] # Image section +int x1[ndim] # Starting pixel +int x2[ndim] # Ending pixel +int xs[ndim] # Step +int ndim # Number of dimensions + +int i, ip, a, b, c, temp, ctoi() +define error_ 99 + +begin + # Decode the section string. + ip = 1 + while (IS_WHITE(section[ip])) + ip = ip + 1 + if (section[ip] == '[') + ip = ip + 1 + else if (section[ip] == EOS) + return + else + goto error_ + + do i = 1, ndim { + while (IS_WHITE(section[ip])) + ip = ip + 1 + if (section[ip] == ']') + break + + # Default values + a = x1[i] + b = x2[i] + c = xs[i] + + # 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 = temp + if (section[ip] == ':') { + ip = ip + 1 + if (ctoi (section, ip, b) == 0) # a:b + goto error_ + } else + b = a + } else if (section[ip] == '-') { # -* + temp = a + a = b + b = 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) == 0) + goto error_ + else if (c == 0) + goto error_ + } + if (a > b && c > 0) + c = -c + + x1[i] = a + x2[i] = b + xs[i] = c + + while (IS_WHITE(section[ip])) + ip = ip + 1 + if (section[ip] == ',') + ip = ip + 1 + } + + if (section[ip] != ']') + goto error_ + + return +error_ + call error (0, "Error in image section specification") +end diff --git a/noao/imred/ccdred/src/combine/icsetout.x b/noao/imred/ccdred/src/combine/icsetout.x new file mode 100644 index 00000000..bd1d75ec --- /dev/null +++ b/noao/imred/ccdred/src/combine/icsetout.x @@ -0,0 +1,193 @@ +include <imhdr.h> +include <mwset.h> + +# IC_SETOUT -- Set output image size and offsets of input images. + +procedure ic_setout (in, out, offsets, nimages) + +pointer in[nimages] # Input images +pointer out[ARB] # Output images +int offsets[nimages,ARB] # Offsets +int nimages # Number of images + +int i, j, indim, outdim, mwdim, a, b, amin, bmax, fd +real val +bool reloff, streq() +pointer sp, fname, lref, wref, cd, coord, shift, axno, axval +pointer mw, ct, mw_openim(), mw_sctran() +int open(), fscan(), nscan(), mw_stati() +errchk mw_openim, mw_gwtermd, mw_gltermd, mw_gaxmap +errchk mw_sctran, mw_ctrand, open + +include "icombine.com" +define newscan_ 10 + +begin + call smark (sp) + call salloc (fname, SZ_FNAME, TY_CHAR) + call salloc (lref, IM_MAXDIM, TY_DOUBLE) + call salloc (wref, IM_MAXDIM, TY_DOUBLE) + call salloc (cd, IM_MAXDIM*IM_MAXDIM, TY_DOUBLE) + call salloc (coord, IM_MAXDIM, TY_DOUBLE) + call salloc (shift, IM_MAXDIM, TY_REAL) + call salloc (axno, IM_MAXDIM, TY_INT) + call salloc (axval, IM_MAXDIM, TY_INT) + + # Check and set the image dimensionality. + indim = IM_NDIM(in[1]) + outdim = IM_NDIM(out[1]) + if (project) { + outdim = indim - 1 + IM_NDIM(out[1]) = outdim + } else { + do i = 1, nimages + if (IM_NDIM(in[i]) != outdim) { + call sfree (sp) + call error (1, "Image dimensions are not the same") + } + } + + # Set the reference point to that of the first image. + mw = mw_openim (in[1]) + mwdim = mw_stati (mw, MW_NPHYSDIM) + call mw_gwtermd (mw, Memd[lref], Memd[wref], Memd[cd], mwdim) + ct = mw_sctran (mw, "world", "logical", 0) + call mw_ctrand (ct, Memd[wref], Memd[lref], mwdim) + call mw_ctfree (ct) + if (project) + Memd[lref+outdim] = 1 + + # Parse the user offset string. If "none" then there are no offsets. + # If "wcs" then set the offsets based on the image WCS. + # If "grid" then set the offsets based on the input grid parameters. + # If a file scan it. + + call clgstr ("offsets", Memc[fname], SZ_FNAME) + call sscan (Memc[fname]) + call gargwrd (Memc[fname], SZ_FNAME) + if (nscan() == 0 || streq (Memc[fname], "none")) { + call aclri (offsets, outdim*nimages) + reloff = true + } else if (streq (Memc[fname], "wcs")) { + do j = 1, outdim + offsets[1,j] = 0 + if (project) { + ct = mw_sctran (mw, "world", "logical", 0) + do i = 2, nimages { + Memd[wref+outdim] = i + call mw_ctrand (ct, Memd[wref], Memd[coord], indim) + do j = 1, outdim + offsets[i,j] = nint (Memd[lref+j-1] - Memd[coord+j-1]) + } + call mw_ctfree (ct) + call mw_close (mw) + } else { + do i = 2, nimages { + call mw_close (mw) + mw = mw_openim (in[i]) + ct = mw_sctran (mw, "world", "logical", 0) + call mw_ctrand (ct, Memd[wref], Memd[coord], indim) + do j = 1, outdim + offsets[i,j] = nint (Memd[lref+j-1] - Memd[coord+j-1]) + call mw_ctfree (ct) + } + } + reloff = true + } else if (streq (Memc[fname], "grid")) { + amin = 1 + do j = 1, outdim { + call gargi (a) + call gargi (b) + if (nscan() < 1+2*j) + break + do i = 1, nimages + offsets[i,j] = mod ((i-1)/amin, a) * b + amin = amin * a + } + reloff = true + } else { + reloff = true + fd = open (Memc[fname], READ_ONLY, TEXT_FILE) + do i = 1, nimages { +newscan_ if (fscan (fd) == EOF) + call error (1, "IMCOMBINE: Offset list too short") + call gargwrd (Memc[fname], SZ_FNAME) + if (Memc[fname] == '#') { + call gargwrd (Memc[fname], SZ_FNAME) + call strlwr (Memc[fname]) + if (streq (Memc[fname], "absolute")) + reloff = false + else if (streq (Memc[fname], "relative")) + reloff = true + goto newscan_ + } + call reset_scan () + do j = 1, outdim { + call gargr (val) + offsets[i,j] = nint (val) + } + if (nscan() < outdim) + call error (1, "IMCOMBINE: Error in offset list") + } + call close (fd) + } + + # Set the output image size and the aligned flag + aligned = true + do j = 1, outdim { + a = offsets[1,j] + b = IM_LEN(in[1],j) + a + amin = a + bmax = b + do i = 2, nimages { + a = offsets[i,j] + b = IM_LEN(in[i],j) + a + if (a != amin || b != bmax || !reloff) + aligned = false + amin = min (a, amin) + bmax = max (b, bmax) + } + IM_LEN(out[1],j) = bmax + if (reloff || amin < 0) { + do i = 1, nimages + offsets[i,j] = offsets[i,j] - amin + IM_LEN(out[1],j) = IM_LEN(out[1],j) - amin + } + } + + # Update the WCS. + if (project || !aligned || !reloff) { + call mw_close (mw) + mw = mw_openim (out[1]) + mwdim = mw_stati (mw, MW_NPHYSDIM) + call mw_gaxmap (mw, Memi[axno], Memi[axval], mwdim) + if (!aligned || !reloff) { + call mw_gltermd (mw, Memd[cd], Memd[lref], mwdim) + do i = 1, mwdim { + j = Memi[axno+i-1] + if (j > 0 && j <= indim) + Memd[lref+i-1] = Memd[lref+i-1] + offsets[1,j] + } + call mw_sltermd (mw, Memd[cd], Memd[lref], mwdim) + } + if (project) { + # Apply dimensional reduction. + do i = 1, mwdim { + j = Memi[axno+i-1] + if (j <= outdim) + next + else if (j > outdim+1) + Memi[axno+i-1] = j - 1 + else { + Memi[axno+i-1] = 0 + Memi[axval+i-1] = 0 + } + } + call mw_saxmap (mw, Memi[axno], Memi[axval], mwdim) + } + call mw_saveim (mw, out) + } + call mw_close (mw) + + call sfree (sp) +end diff --git a/noao/imred/ccdred/src/combine/icsigma.gx b/noao/imred/ccdred/src/combine/icsigma.gx new file mode 100644 index 00000000..d0ae28d4 --- /dev/null +++ b/noao/imred/ccdred/src/combine/icsigma.gx @@ -0,0 +1,115 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> +include "../icombine.h" + +$for (sr) +# IC_SIGMA -- Compute the sigma image line. +# The estimated sigma includes a correction for the finite population. +# Weights are used if desired. + +procedure ic_sigma$t (d, m, n, wts, npts, average, sigma) + +pointer d[ARB] # Data pointers +pointer m[ARB] # Image ID pointers +int n[npts] # Number of points +real wts[ARB] # Weights +int npts # Number of output points per line +$if (datatype == sil) +real average[npts] # Average +real sigma[npts] # Sigma line (returned) +$else +PIXEL average[npts] # Average +PIXEL sigma[npts] # Sigma line (returned) +$endif + +int i, j, k, n1 +real wt, sigcor, sumwt +$if (datatype == sil) +real a, sum +$else +PIXEL a, sum +$endif + +include "../icombine.com" + +begin + if (dflag == D_ALL) { + n1 = n[1] + if (dowts) { + if (n1 > 1) + sigcor = real (n1) / real (n1 - 1) + else + sigcor = 1. + do i = 1, npts { + k = i - 1 + a = average[i] + wt = wts[Memi[m[1]+k]] + sum = (Mem$t[d[1]+k] - a) ** 2 * wt + do j = 2, n1 { + wt = wts[Memi[m[j]+k]] + sum = sum + (Mem$t[d[j]+k] - a) ** 2 * wt + } + sigma[i] = sqrt (sum * sigcor) + } + } else { + if (n1 > 1) + sigcor = 1. / real (n1 - 1) + else + sigcor = 1. + do i = 1, npts { + k = i - 1 + a = average[i] + sum = (Mem$t[d[1]+k] - a) ** 2 + do j = 2, n1 + sum = sum + (Mem$t[d[j]+k] - a) ** 2 + sigma[i] = sqrt (sum * sigcor) + } + } + } else if (dflag == D_NONE) { + do i = 1, npts + sigma[i] = blank + } else { + if (dowts) { + do i = 1, npts { + n1 = n[i] + if (n1 > 0) { + k = i - 1 + if (n1 > 1) + sigcor = real (n1) / real (n1 -1) + else + sigcor = 1 + a = average[i] + wt = wts[Memi[m[1]+k]] + sum = (Mem$t[d[1]+k] - a) ** 2 * wt + sumwt = wt + do j = 2, n1 { + wt = wts[Memi[m[j]+k]] + sum = sum + (Mem$t[d[j]+k] - a) ** 2 * wt + sumwt = sumwt + wt + } + sigma[i] = sqrt (sum / sumwt * sigcor) + } else + sigma[i] = blank + } + } else { + do i = 1, npts { + n1 = n[i] + if (n1 > 0) { + k = i - 1 + if (n1 > 1) + sigcor = 1. / real (n1 - 1) + else + sigcor = 1. + a = average[i] + sum = (Mem$t[d[1]+k] - a) ** 2 + do j = 2, n1 + sum = sum + (Mem$t[d[j]+k] - a) ** 2 + sigma[i] = sqrt (sum * sigcor) + } else + sigma[i] = blank + } + } + } +end +$endfor diff --git a/noao/imred/ccdred/src/combine/icsort.gx b/noao/imred/ccdred/src/combine/icsort.gx new file mode 100644 index 00000000..2235dbd0 --- /dev/null +++ b/noao/imred/ccdred/src/combine/icsort.gx @@ -0,0 +1,386 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +define LOGPTR 32 # log2(maxpts) (4e9) + +$for (sr) +# IC_SORT -- Quicksort. This is based on the VOPS asrt except that +# the input is an array of pointers to image lines and the sort is done +# across the image lines at each point along the lines. The number of +# valid pixels at each point is allowed to vary. The cases of 1, 2, and 3 +# pixels per point are treated specially. + +procedure ic_sort$t (a, b, nvecs, npts) + +pointer a[ARB] # pointer to input vectors +PIXEL b[ARB] # work array +int nvecs[npts] # number of vectors +int npts # number of points in vectors + +PIXEL pivot, temp, temp3 +int i, j, k, l, p, npix, lv[LOGPTR], uv[LOGPTR] +define swap {temp=$1;$1=$2;$2=temp} +define copy_ 10 + +begin + do l = 0, npts-1 { + npix = nvecs[l+1] + if (npix <= 1) + next + + do i = 1, npix + b[i] = Mem$t[a[i]+l] + + # Special cases + $if (datatype == x) + if (npix <= 3) { + pivot = b[1] + temp = b[2] + if (npix == 2) { + if (abs (temp) < abs (pivot)) { + b[1] = temp + b[2] = pivot + } else + next + } else { + temp3 = b[3] + if (abs (temp) < abs (pivot)) { # bac|bca|cba + if (abs (temp) < abs (temp3)) { # bac|bca + b[1] = temp + if (abs (pivot) < abs (temp3)) # bac + b[2] = pivot + else { # bca + b[2] = temp3 + b[3] = pivot + } + } else { # cba + b[1] = temp3 + b[3] = pivot + } + } else if (abs (temp3) < abs (temp)) { # acb|cab + b[3] = temp + if (abs (pivot) < abs (temp3)) # acb + b[2] = temp3 + else { # cab + b[1] = temp3 + b[2] = pivot + } + } else + next + } + goto copy_ + } + $else + if (npix <= 3) { + pivot = b[1] + temp = b[2] + if (npix == 2) { + if (temp < pivot) { + b[1] = temp + b[2] = pivot + } else + next + } else { + temp3 = b[3] + if (temp < pivot) { # bac|bca|cba + if (temp < temp3) { # bac|bca + b[1] = temp + if (pivot < temp3) # bac + b[2] = pivot + else { # bca + b[2] = temp3 + b[3] = pivot + } + } else { # cba + b[1] = temp3 + b[3] = pivot + } + } else if (temp3 < temp) { # acb|cab + b[3] = temp + if (pivot < temp3) # acb + b[2] = temp3 + else { # cab + b[1] = temp3 + b[2] = pivot + } + } else + next + } + goto copy_ + } + $endif + + # General case + do i = 1, npix + b[i] = Mem$t[a[i]+l] + + lv[1] = 1 + uv[1] = npix + p = 1 + + while (p > 0) { + if (lv[p] >= uv[p]) # only one elem in this subset + p = p - 1 # pop stack + else { + # Dummy do loop to trigger the Fortran optimizer. + do p = p, ARB { + i = lv[p] - 1 + j = uv[p] + + # Select as the pivot the element at the center of the + # array, to avoid quadratic behavior on an already + # sorted array. + + k = (lv[p] + uv[p]) / 2 + swap (b[j], b[k]) + pivot = b[j] # pivot line + + while (i < j) { + $if (datatype == x) + for (i=i+1; abs(b[i]) < abs(pivot); i=i+1) + $else + for (i=i+1; b[i] < pivot; i=i+1) + $endif + ; + for (j=j-1; j > i; j=j-1) + $if (datatype == x) + if (abs(b[j]) <= abs(pivot)) + $else + if (b[j] <= pivot) + $endif + break + if (i < j) # out of order pair + swap (b[i], b[j]) # interchange elements + } + + j = uv[p] # move pivot to position i + swap (b[i], b[j]) # interchange elements + + 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 + } + + break + } + p = p + 1 # push onto stack + } + } + +copy_ + do i = 1, npix + Mem$t[a[i]+l] = b[i] + } +end + + +# IC_2SORT -- Quicksort. This is based on the VOPS asrt except that +# the input is an array of pointers to image lines and the sort is done +# across the image lines at each point along the lines. The number of +# valid pixels at each point is allowed to vary. The cases of 1, 2, and 3 +# pixels per point are treated specially. A second integer set of +# vectors is sorted. + +procedure ic_2sort$t (a, b, c, d, nvecs, npts) + +pointer a[ARB] # pointer to input vectors +PIXEL b[ARB] # work array +pointer c[ARB] # pointer to associated integer vectors +int d[ARB] # work array +int nvecs[npts] # number of vectors +int npts # number of points in vectors + +PIXEL pivot, temp, temp3 +int i, j, k, l, p, npix, lv[LOGPTR], uv[LOGPTR], itemp +define swap {temp=$1;$1=$2;$2=temp} +define iswap {itemp=$1;$1=$2;$2=itemp} +define copy_ 10 + +begin + do l = 0, npts-1 { + npix = nvecs[l+1] + if (npix <= 1) + next + + do i = 1, npix { + b[i] = Mem$t[a[i]+l] + d[i] = Memi[c[i]+l] + } + + # Special cases + $if (datatype == x) + if (npix <= 3) { + pivot = b[1] + temp = b[2] + if (npix == 2) { + if (abs (temp) < abs (pivot)) { + b[1] = temp + b[2] = pivot + iswap (d[1], d[2]) + } else + next + } else { + temp3 = b[3] + if (abs (temp) < abs (pivot)) { # bac|bca|cba + if (abs (temp) < abs (temp3)) { # bac|bca + b[1] = temp + if (abs (pivot) < abs (temp3)) { # bac + b[2] = pivot + iswap (d[1], d[2]) + } else { # bca + b[2] = temp3 + b[3] = pivot + itemp = d[2] + d[2] = d[3] + d[3] = d[1] + d[1] = itemp + } + } else { # cba + b[1] = temp3 + b[3] = pivot + iswap (d[1], d[3]) + } + } else if (abs (temp3) < abs (temp)) { # acb|cab + b[3] = temp + if (abs (pivot) < abs (temp3)) { # acb + b[2] = temp3 + iswap (d[2], d[3]) + } else { # cab + b[1] = temp3 + b[2] = pivot + itemp = d[2] + d[2] = d[1] + d[1] = d[3] + d[3] = itemp + } + } else + next + } + goto copy_ + } + $else + if (npix <= 3) { + pivot = b[1] + temp = b[2] + if (npix == 2) { + if (temp < pivot) { + b[1] = temp + b[2] = pivot + iswap (d[1], d[2]) + } else + next + } else { + temp3 = b[3] + if (temp < pivot) { # bac|bca|cba + if (temp < temp3) { # bac|bca + b[1] = temp + if (pivot < temp3) { # bac + b[2] = pivot + iswap (d[1], d[2]) + } else { # bca + b[2] = temp3 + b[3] = pivot + itemp = d[2] + d[2] = d[3] + d[3] = d[1] + d[1] = itemp + } + } else { # cba + b[1] = temp3 + b[3] = pivot + iswap (d[1], d[3]) + } + } else if (temp3 < temp) { # acb|cab + b[3] = temp + if (pivot < temp3) { # acb + b[2] = temp3 + iswap (d[2], d[3]) + } else { # cab + b[1] = temp3 + b[2] = pivot + itemp = d[2] + d[2] = d[1] + d[1] = d[3] + d[3] = itemp + } + } else + next + } + goto copy_ + } + $endif + + # General case + lv[1] = 1 + uv[1] = npix + p = 1 + + while (p > 0) { + if (lv[p] >= uv[p]) # only one elem in this subset + p = p - 1 # pop stack + else { + # Dummy do loop to trigger the Fortran optimizer. + do p = p, ARB { + i = lv[p] - 1 + j = uv[p] + + # Select as the pivot the element at the center of the + # array, to avoid quadratic behavior on an already + # sorted array. + + k = (lv[p] + uv[p]) / 2 + swap (b[j], b[k]); swap (d[j], d[k]) + pivot = b[j] # pivot line + + while (i < j) { + $if (datatype == x) + for (i=i+1; abs(b[i]) < abs(pivot); i=i+1) + $else + for (i=i+1; b[i] < pivot; i=i+1) + $endif + ; + for (j=j-1; j > i; j=j-1) + $if (datatype == x) + if (abs(b[j]) <= abs(pivot)) + $else + if (b[j] <= pivot) + $endif + break + if (i < j) { # out of order pair + swap (b[i], b[j]) # interchange elements + swap (d[i], d[j]) + } + } + + j = uv[p] # move pivot to position i + swap (b[i], b[j]) # interchange elements + swap (d[i], d[j]) + + 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 + } + + break + } + p = p + 1 # push onto stack + } + } + +copy_ + do i = 1, npix { + Mem$t[a[i]+l] = b[i] + Memi[c[i]+l] = d[i] + } + } +end +$endfor diff --git a/noao/imred/ccdred/src/combine/icstat.gx b/noao/imred/ccdred/src/combine/icstat.gx new file mode 100644 index 00000000..099ddf5e --- /dev/null +++ b/noao/imred/ccdred/src/combine/icstat.gx @@ -0,0 +1,237 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> +include "../icombine.h" + +define NMAX 10000 # Maximum number of pixels to sample + +$for (sr) +# IC_STAT -- Compute image statistics within specified section. +# The image section is relative to a reference image which may be +# different than the input image and may have an offset. Only a +# subsample of pixels is used. Masked and thresholded pixels are +# ignored. Only the desired statistics are computed to increase +# efficiency. + +procedure ic_stat$t (im, imref, section, offsets, image, nimages, + domode, domedian, domean, mode, median, mean) + +pointer im # Data image +pointer imref # Reference image for image section +char section[ARB] # Image section +int offsets[nimages,ARB] # Image section offset from data to reference +int image # Image index (for mask I/O) +int nimages # Number of images in offsets. +bool domode, domedian, domean # Statistics to compute +real mode, median, mean # Statistics + +int i, j, ndim, n, nv +real a +pointer sp, v1, v2, dv, va, vb +pointer data, mask, dp, lp, mp, imgnl$t() +PIXEL ic_mode$t() +$if (datatype == irs) +real asum$t() +$endif +$if (datatype == dl) +double asum$t() +$endif +$if (datatype == x) +complex asum$t() +$endif + + +include "../icombine.com" + +begin + call smark (sp) + call salloc (v1, IM_MAXDIM, TY_LONG) + call salloc (v2, IM_MAXDIM, TY_LONG) + call salloc (dv, IM_MAXDIM, TY_LONG) + call salloc (va, IM_MAXDIM, TY_LONG) + call salloc (vb, IM_MAXDIM, TY_LONG) + + # Determine the image section parameters. This must be in terms of + # the data image pixel coordinates though the section may be specified + # in terms of the reference image coordinates. Limit the number of + # pixels in each dimension to a maximum. + + ndim = IM_NDIM(im) + if (project) + ndim = ndim - 1 + call amovki (1, Memi[v1], IM_MAXDIM) + call amovki (1, Memi[va], IM_MAXDIM) + call amovki (1, Memi[dv], IM_MAXDIM) + call amovi (IM_LEN(imref,1), Memi[vb], ndim) + call ic_section (section, Memi[va], Memi[vb], Memi[dv], ndim) + if (im != imref) + do i = 1, ndim { + Memi[va+i-1] = Memi[va+i-1] - offsets[image,i] + Memi[vb+i-1] = Memi[vb+i-1] - offsets[image,i] + } + + do j = 1, 10 { + n = 1 + do i = 0, ndim-1 { + Memi[v1+i] = max (1, min (Memi[va+i], Memi[vb+i])) + Memi[v2+i] = min (IM_LEN(im,i+1), max (Memi[va+i], Memi[vb+i])) + Memi[dv+i] = j + nv = max (1, (Memi[v2+i] - Memi[v1+i]) / Memi[dv+i] + 1) + Memi[v2+i] = Memi[v1+i] + (nv - 1) * Memi[dv+i] + n = n * nv + } + if (n < NMAX) + break + } + + call amovl (Memi[v1], Memi[va], IM_MAXDIM) + Memi[va] = 1 + if (project) + Memi[va+ndim] = image + call amovl (Memi[va], Memi[vb], IM_MAXDIM) + + # Accumulate the pixel values within the section. Masked pixels and + # thresholded pixels are ignored. + + call salloc (data, n, TY_PIXEL) + dp = data + while (imgnl$t (im, lp, Memi[vb]) != EOF) { + call ic_mget1 (im, image, offsets[image,1], Memi[va], mask) + lp = lp + Memi[v1] - 1 + if (dflag == D_ALL) { + if (dothresh) { + do i = Memi[v1], Memi[v2], Memi[dv] { + a = Mem$t[lp] + if (a >= lthresh && a <= hthresh) { + Mem$t[dp] = a + dp = dp + 1 + } + lp = lp + Memi[dv] + } + } else { + do i = Memi[v1], Memi[v2], Memi[dv] { + Mem$t[dp] = Mem$t[lp] + dp = dp + 1 + lp = lp + Memi[dv] + } + } + } else if (dflag == D_MIX) { + mp = mask + Memi[v1] - 1 + if (dothresh) { + do i = Memi[v1], Memi[v2], Memi[dv] { + if (Memi[mp] == 0) { + a = Mem$t[lp] + if (a >= lthresh && a <= hthresh) { + Mem$t[dp] = a + dp = dp + 1 + } + } + mp = mp + Memi[dv] + lp = lp + Memi[dv] + } + } else { + do i = Memi[v1], Memi[v2], Memi[dv] { + if (Memi[mp] == 0) { + Mem$t[dp] = Mem$t[lp] + dp = dp + 1 + } + mp = mp + Memi[dv] + lp = lp + Memi[dv] + } + } + } + for (i=2; i<=ndim; i=i+1) { + Memi[va+i-1] = Memi[va+i-1] + Memi[dv+i-1] + if (Memi[va+i-1] <= Memi[v2+i-1]) + break + Memi[va+i-1] = Memi[v1+i-1] + } + if (i > ndim) + break + call amovl (Memi[va], Memi[vb], IM_MAXDIM) + } + + n = dp - data + if (n < 1) { + call sfree (sp) + call error (1, "Image section contains no pixels") + } + + # Compute only statistics needed. + if (domode || domedian) { + call asrt$t (Mem$t[data], Mem$t[data], n) + mode = ic_mode$t (Mem$t[data], n) + median = Mem$t[data+n/2-1] + } + if (domean) + mean = asum$t (Mem$t[data], n) / n + + call sfree (sp) +end + + +define NMIN 10 # Minimum number of pixels for mode calculation +define ZRANGE 0.8 # Fraction of pixels about median to use +define ZSTEP 0.01 # Step size for search for mode +define ZBIN 0.1 # Bin size for mode. + +# IC_MODE -- Compute mode of an array. The mode is found by binning +# with a bin size based on the data range over a fraction of the +# pixels about the median and a bin step which may be smaller than the +# bin size. If there are too few points the median is returned. +# The input array must be sorted. + +PIXEL procedure ic_mode$t (a, n) + +PIXEL a[n] # Data array +int n # Number of points + +int i, j, k, nmax +real z1, z2, zstep, zbin +PIXEL mode +bool fp_equalr() + +begin + if (n < NMIN) + return (a[n/2]) + + # Compute the mode. The array must be sorted. Consider a + # range of values about the median point. Use a bin size which + # is ZBIN of the range. Step the bin limits in ZSTEP fraction of + # the bin size. + + i = 1 + n * (1. - ZRANGE) / 2. + j = 1 + n * (1. + ZRANGE) / 2. + z1 = a[i] + z2 = a[j] + if (fp_equalr (z1, z2)) { + mode = z1 + return (mode) + } + + zstep = ZSTEP * (z2 - z1) + zbin = ZBIN * (z2 - z1) + $if (datatype == sil) + zstep = max (1., zstep) + zbin = max (1., zbin) + $endif + + z1 = z1 - zstep + k = i + nmax = 0 + repeat { + z1 = z1 + zstep + z2 = z1 + zbin + for (; i < j && a[i] < z1; i=i+1) + ; + for (; k < j && a[k] < z2; k=k+1) + ; + if (k - i > nmax) { + nmax = k - i + mode = a[(i+k)/2] + } + } until (k >= j) + + return (mode) +end +$endfor diff --git a/noao/imred/ccdred/src/combine/mkpkg b/noao/imred/ccdred/src/combine/mkpkg new file mode 100644 index 00000000..2c5c0795 --- /dev/null +++ b/noao/imred/ccdred/src/combine/mkpkg @@ -0,0 +1,51 @@ +# Make CCDRED Package. + +$checkout libpkg.a ../.. +$update libpkg.a +$checkin libpkg.a ../.. +$exit + +generic: + $set GEN = "$$generic -k" + + $ifolder (generic/icaclip.x, icaclip.gx) + $(GEN) icaclip.gx -o generic/icaclip.x $endif + $ifolder (generic/icaverage.x, icaverage.gx) + $(GEN) icaverage.gx -o generic/icaverage.x $endif + $ifolder (generic/iccclip.x, iccclip.gx) + $(GEN) iccclip.gx -o generic/iccclip.x $endif + $ifolder (generic/icgdata.x, icgdata.gx) + $(GEN) icgdata.gx -o generic/icgdata.x $endif + $ifolder (generic/icgrow.x, icgrow.gx) + $(GEN) icgrow.gx -o generic/icgrow.x $endif + $ifolder (generic/icmedian.x, icmedian.gx) + $(GEN) icmedian.gx -o generic/icmedian.x $endif + $ifolder (generic/icmm.x, icmm.gx) + $(GEN) icmm.gx -o generic/icmm.x $endif + $ifolder (generic/icombine.x, icombine.gx) + $(GEN) icombine.gx -o generic/icombine.x $endif + $ifolder (generic/icpclip.x, icpclip.gx) + $(GEN) icpclip.gx -o generic/icpclip.x $endif + $ifolder (generic/icsclip.x, icsclip.gx) + $(GEN) icsclip.gx -o generic/icsclip.x $endif + $ifolder (generic/icsigma.x, icsigma.gx) + $(GEN) icsigma.gx -o generic/icsigma.x $endif + $ifolder (generic/icsort.x, icsort.gx) + $(GEN) icsort.gx -o generic/icsort.x $endif + $ifolder (generic/icstat.x, icstat.gx) + $(GEN) icstat.gx -o generic/icstat.x $endif + ; + +libpkg.a: + $ifeq (USE_GENERIC, yes) $call generic $endif + @generic + + icimstack.x <error.h> <imhdr.h> + iclog.x icmask.h icombine.com icombine.h <imhdr.h> <imset.h>\ + <mach.h> + icmask.x icmask.h icombine.com icombine.h icombine.com <imhdr.h>\ + <pmset.h> + icscale.x icombine.com icombine.h <error.h> <imhdr.h> <imset.h> + icsection.x <ctype.h> + icsetout.x icombine.com <imhdr.h> <mwset.h> + ; diff --git a/noao/imred/ccdred/src/cor.gx b/noao/imred/ccdred/src/cor.gx new file mode 100644 index 00000000..189f9437 --- /dev/null +++ b/noao/imred/ccdred/src/cor.gx @@ -0,0 +1,362 @@ +include "ccdred.h" + + +.help cor Feb87 noao.imred.ccdred +.nf ---------------------------------------------------------------------------- +cor -- Process CCD image lines + +These procedures are the heart of the CCD processing. They do the desired +set of processing operations on the image line data as efficiently as +possible. They are called by the PROC procedures. There are four procedures +one for each readout axis and one for short and real image data. +Some sets of operations are coded as single compound operations for efficiency. +To keep the number of combinations managable only the most common +combinations are coded as compound operations. The combinations +consist of any set of line overscan, column overscan, zero level, dark +count, and flat field and any set of illumination and fringe +correction. The corrections are applied in place to the output vector. + +The column readout procedure is more complicated in order to handle +zero level and flat field corrections specified as one dimensional +readout corrections instead of two dimensional calibration images. +Column readout format is probably extremely rare and the 1D readout +corrections are used only for special types of data. +.ih +SEE ALSO +proc, ccdred.h +.endhelp ----------------------------------------------------------------------- + +$for (sr) +# COR1 -- Correct image lines with readout axis 1 (lines). + +procedure cor1$t (cors, out, overscan, zero, dark, flat, illum, + fringe, n, darkscale, flatscale, illumscale, frgscale) + +int cors[ARB] # Correction flags +PIXEL out[n] # Output data +real overscan # Overscan value +PIXEL zero[n] # Zero level correction +PIXEL dark[n] # Dark count correction +PIXEL flat[n] # Flat field correction +PIXEL illum[n] # Illumination correction +PIXEL fringe[n] # Fringe correction +int n # Number of pixels +real darkscale # Dark count scale factor +real flatscale # Flat field scale factor +real illumscale # Illumination scale factor +real frgscale # Fringe scale factor + +int i, op + +begin + op = cors[OVERSCAN] + cors[ZEROCOR] + cors[DARKCOR] + cors[FLATCOR] + switch (op) { + case O: # overscan + do i = 1, n + out[i] = out[i] - overscan + case Z: # zero level + do i = 1, n + out[i] = out[i] - zero[i] + + case ZO: # zero level + overscan + do i = 1, n + out[i] = out[i] - overscan - zero[i] + + case D: # dark count + do i = 1, n + out[i] = out[i] - darkscale * dark[i] + case DO: # dark count + overscan + do i = 1, n + out[i] = out[i] - overscan - darkscale * dark[i] + case DZ: # dark count + zero level + do i = 1, n + out[i] = out[i] - zero[i] - darkscale * dark[i] + case DZO: # dark count + zero level + overscan + do i = 1, n + out[i] = out[i] - overscan - zero[i] - darkscale * dark[i] + + case F: # flat field + do i = 1, n + out[i] = out[i] * flatscale / flat[i] + case FO: # flat field + overscan + do i = 1, n + out[i] = (out[i] - overscan) * flatscale / flat[i] + case FZ: # flat field + zero level + do i = 1, n + out[i] = (out[i] - zero[i]) * flatscale / flat[i] + case FZO: # flat field + zero level + overscan + do i = 1, n + out[i] = (out[i] - overscan - zero[i]) * flatscale / + flat[i] + case FD: # flat field + dark count + do i = 1, n + out[i] = (out[i] - darkscale * dark[i]) * flatscale / flat[i] + case FDO: # flat field + dark count + overscan + do i = 1, n + out[i] = (out[i] - overscan - darkscale * dark[i]) * + flatscale / flat[i] + case FDZ: # flat field + dark count + zero level + do i = 1, n + out[i] = (out[i] - zero[i] - darkscale * dark[i]) * + flatscale / flat[i] + case FDZO: # flat field + dark count + zero level + overscan + do i = 1, n + out[i] = (out[i] - overscan - zero[i] - + darkscale * dark[i]) * flatscale / flat[i] + } + + # Often these operations will not be performed so test for no + # correction rather than go through the switch. + + op = cors[ILLUMCOR] + cors[FRINGECOR] + if (op != 0) { + switch (op) { + case I: # illumination + do i = 1, n + out[i] = out[i] * illumscale / illum[i] + case Q: # fringe + do i = 1, n + out[i] = out[i] - frgscale * fringe[i] + case QI: # fringe + illumination + do i = 1, n + out[i] = out[i]*illumscale/illum[i] - frgscale*fringe[i] + } + } +end + + +# COR2 -- Correct lines for readout axis 2 (columns). This procedure is +# more complex than when the readout is along the image lines because the +# zero level and/or flat field corrections may be single readout column +# vectors. + +procedure cor2$t (line, cors, out, overscan, zero, dark, flat, illum, + fringe, n, zeroim, flatim, darkscale, flatscale, illumscale, frgscale) + +int line # Line to be corrected +int cors[ARB] # Correction flags +PIXEL out[n] # Output data +real overscan[n] # Overscan value +PIXEL zero[n] # Zero level correction +PIXEL dark[n] # Dark count correction +PIXEL flat[n] # Flat field correction +PIXEL illum[n] # Illumination correction +PIXEL fringe[n] # Fringe correction +int n # Number of pixels +pointer zeroim # Zero level IMIO pointer (NULL if 1D vector) +pointer flatim # Flat field IMIO pointer (NULL if 1D vector) +real darkscale # Dark count scale factor +real flatscale # Flat field scale factor +real illumscale # Illumination scale factor +real frgscale # Fringe scale factor + +PIXEL zeroval +real flatval +int i, op + +begin + op = cors[OVERSCAN] + cors[ZEROCOR] + cors[DARKCOR] + cors[FLATCOR] + switch (op) { + case O: # overscan + do i = 1, n + out[i] = out[i] - overscan[i] + case Z: # zero level + if (zeroim != NULL) + do i = 1, n + out[i] = out[i] - zero[i] + else { + zeroval = zero[line] + do i = 1, n + out[i] = out[i] - zeroval + } + + case ZO: # zero level + overscan + if (zeroim != NULL) + do i = 1, n + out[i] = out[i] - overscan[i] - zero[i] + else { + zeroval = zero[line] + do i = 1, n + out[i] = out[i] - overscan[i] - zeroval + } + + case D: # dark count + do i = 1, n + out[i] = out[i] - darkscale * dark[i] + case DO: # dark count + overscan + do i = 1, n + out[i] = out[i] - overscan[i] - darkscale * dark[i] + case DZ: # dark count + zero level + if (zeroim != NULL) + do i = 1, n + out[i] = out[i] - zero[i] - darkscale * dark[i] + else { + zeroval = zero[line] + do i = 1, n + out[i] = out[i] - zeroval - darkscale * dark[i] + } + case DZO: # dark count + zero level + overscan + if (zeroim != NULL) + do i = 1, n + out[i] = out[i] - overscan[i] - zero[i] - + darkscale * dark[i] + else { + zeroval = zero[line] + do i = 1, n + out[i] = out[i] - overscan[i] - zeroval - + darkscale * dark[i] + } + + case F: # flat field + if (flatim != NULL) { + do i = 1, n + out[i] = out[i] * flatscale / flat[i] + } else { + flatval = flatscale / flat[line] + do i = 1, n + out[i] = out[i] * flatval + } + case FO: # flat field + overscan + if (flatim != NULL) { + do i = 1, n + out[i] = (out[i] - overscan[i]) * flatscale / flat[i] + } else { + flatval = flatscale / flat[line] + do i = 1, n + out[i] = (out[i] - overscan[i]) * flatval + } + case FZ: # flat field + zero level + if (flatim != NULL) { + if (zeroim != NULL) { + do i = 1, n + out[i] = (out[i] - zero[i]) * flatscale / flat[i] + } else { + zeroval = zero[line] + do i = 1, n + out[i] = (out[i] - zeroval) * flatscale / flat[i] + } + } else { + flatval = flatscale / flat[line] + if (zeroim != NULL) { + do i = 1, n + out[i] = (out[i] - zero[i]) * flatval + } else { + zeroval = zero[line] + do i = 1, n + out[i] = (out[i] - zeroval) * flatval + } + } + case FZO: # flat field + zero level + overscan + if (flatim != NULL) { + if (zeroim != NULL) { + do i = 1, n + out[i] = (out[i] - overscan[i] - zero[i]) * + flatscale / flat[i] + } else { + zeroval = zero[line] + do i = 1, n + out[i] = (out[i] - overscan[i] - zeroval) * + flatscale / flat[i] + } + } else { + flatval = flatscale / flat[line] + if (zeroim != NULL) { + do i = 1, n + out[i] = (out[i] - overscan[i] - zero[i]) * flatval + } else { + zeroval = zero[line] + do i = 1, n + out[i] = (out[i] - overscan[i] - zeroval) * flatval + } + } + case FD: # flat field + dark count + if (flatim != NULL) { + do i = 1, n + out[i] = (out[i] - darkscale * dark[i]) * flatscale/flat[i] + } else { + flatval = flatscale / flat[line] + do i = 1, n + out[i] = (out[i] - darkscale * dark[i]) * flatval + } + case FDO: # flat field + dark count + overscan + if (flatim != NULL) { + do i = 1, n + out[i] = (out[i] - overscan[i] - darkscale * dark[i]) * + flatscale / flat[i] + } else { + flatval = flatscale / flat[line] + do i = 1, n + out[i] = (out[i] - overscan[i] - darkscale * dark[i]) * + flatval + } + case FDZ: # flat field + dark count + zero level + if (flatim != NULL) { + if (zeroim != NULL) { + do i = 1, n + out[i] = (out[i] - zero[i] - darkscale * dark[i]) * + flatscale / flat[i] + } else { + zeroval = zero[line] + do i = 1, n + out[i] = (out[i] - zeroval - darkscale * dark[i]) * + flatscale / flat[i] + } + } else { + flatval = flatscale / flat[line] + if (zeroim != NULL) { + do i = 1, n + out[i] = (out[i] - zero[i] - darkscale * dark[i]) * + flatval + } else { + zeroval = zero[line] + do i = 1, n + out[i] = (out[i] - zeroval - darkscale * dark[i]) * + flatval + } + } + case FDZO: # flat field + dark count + zero level + overscan + if (flatim != NULL) { + if (zeroim != NULL) { + do i = 1, n + out[i] = (out[i] - overscan[i] - zero[i] - + darkscale * dark[i]) * flatscale / flat[i] + } else { + zeroval = zero[line] + do i = 1, n + out[i] = (out[i] - overscan[i] - zeroval - + darkscale * dark[i]) * flatscale / flat[i] + } + } else { + flatval = flatscale / flat[line] + if (zeroim != NULL) { + do i = 1, n + out[i] = (out[i] - overscan[i] - zero[i] - + darkscale * dark[i]) * flatval + } else { + zeroval = zero[line] + do i = 1, n + out[i] = (out[i] - overscan[i] - zeroval - + darkscale * dark[i]) * flatval + } + } + } + + # Often these operations will not be performed so test for no + # correction rather than go through the switch. + + op = cors[ILLUMCOR] + cors[FRINGECOR] + if (op != 0) { + switch (op) { + case I: # illumination + do i = 1, n + out[i] = out[i] * illumscale / illum[i] + case Q: # fringe + do i = 1, n + out[i] = out[i] - frgscale * fringe[i] + case QI: # fringe + illumination + do i = 1, n + out[i] = out[i]*illumscale/illum[i] - frgscale*fringe[i] + } + } +end +$endfor diff --git a/noao/imred/ccdred/src/cosmic/cosmicrays.hlp b/noao/imred/ccdred/src/cosmic/cosmicrays.hlp new file mode 100644 index 00000000..bfb56e9c --- /dev/null +++ b/noao/imred/ccdred/src/cosmic/cosmicrays.hlp @@ -0,0 +1,338 @@ +.help cosmicrays Dec87 noao.imred.ccdred +.ih +NAME +cosmicrays -- Detect and replace cosmic rays +.ih +USAGE +cosmicrays input output +.ih +PARAMETERS +.ls input +List of input images in which to detect cosmic rays. +.le +.ls output +List of output images in which the detected cosmic rays will be replaced +by an average of neighboring pixels. If the output image name differs +from the input image name then a copy of the input image is made with +the detected cosmic rays replaced. If no output images are specified +then the input images are modified in place. In place modification of +an input image also occurs when the output image name is the same as +the input image name. +.le +.ls badpix = "" +List of bad pixel files to be created, one for each input image. If no +file names are given then no bad pixel file is created. The bad pixel +file is a simple list of pixel coordinates for each replaced cosmic ray. +This file may be used in conjunction with \fBbadpixelimage\fR to create +a mask image. +.le + +.ls ccdtype = "" +If specified only the input images of the desired CCD image type will be +selected. +.le +.ls threshold = 25. +Detection threshold above the mean of the surrounding pixels for cosmic +rays. The threshold will depend on the noise characteristics of the +image and how weak the cosmic rays may be for detection. A typical value +is 5 or more times the sigma of the background. +.le +.ls fluxratio = 2. +The ratio (as a percent) of the mean neighboring pixel flux to the candidate +cosmic ray pixel for rejection. The value depends on the seeing and the +characteristics of the cosmic rays. Typical values are in the range +2 to 10 percent. This value may be reset interactively from a plot +or defined by identifying selected objects as stars or cosmic rays. +.le +.ls npasses = 5 +Number of cosmic ray detection passes. Since only the locally strongest +pixel is considered a cosmic ray, multiple detection passes are needed to +detect and replace multiple pixel cosmic ray events. +.le +.ls window = 5 +Size of cosmic ray detection window. A square window of either 5 by 5 or +7 by 7 is used to detect cosmic rays. The smaller window allows detection +in the presence of greater background gradients but is less sensitive at +discriminating multiple event cosmic rays from stars. It is also marginally +faster. +.le +.ls interactive = yes +Examine parameters interactively? A plot of the mean flux within the +detection window (x100) vs the flux ratio (x100) is plotted and the user may +set the flux ratio threshold, delete and undelete specific events, and +examine specific events. This is useful for new data in which one is +uncertain of an appropriate flux ratio threshold. Once determined the +task need not be used interactively. +.le +.ls train = no +Define the flux ratio threshold by using a set of objects identified +as stars (or other astronomical objects) or cosmic rays? +.le +.ls objects = "" +Cursor list of coordinates of training objects. If null (the null string "") +then the image display cursor will be read. The user is responsible for first +displaying the image. Otherwise a file containing cursor coordinates +may be given. The format of the cursor file is "x y wcs key" where +x and y are the pixel coordinates, wcs is an arbitrary number such as 1, +and key may be 's' for star or 'c' for cosmic ray. +.le +.ls savefile = "" +File to save (by appending) the training object coordinates. This is of +use when the objects are identified using the image display cursor. The +saved file can then be input as the object cursor list for repeating the +execution. +.le +.ls answer +This parameter is used for interactive queries when processing a list of +images. The responses may be "no", "yes", "NO", or "YES". The upper case +responses permanently enable or disable the interactive review while +the lower case reponses allow selective examination of certain input +images. \fIThis parameter should not be specified on the command line. +If it is then the value will be ignored and the task will act as if +the answer "yes" is given for each image; i.e. it will enter the interactive +phase without prompting.\fR +.le +.ih +OTHER PARAMETERS +There are other parameters which may be defined by the package, as is the +case with \fBccdred\fR, or as part of the task, as is the case with +standalone version in the \fBgeneric\fR package. + +.ls verbose +If yes then a time stamped log of the operation is printed on the standard +output. +.le +.ls logfile +If a log file is specified then a time stamped log of the operation is +recorded. +.le +.ls plotfile +If a plot file is specified then the graph of the flux ratio (x100) vs +the mean flux (x100) is recorded as metacode. This may be spooled or examined +later. +.le +.ls graphics = "stdgraph" +Interactive graphic output device for interactive examination of the +detection parameters. +.le +.ls cursor = "" +Interactive graphics cursor input. If null the graphics display cursor +is used, otherwise a file containing cursor input may be specified. +.le +.ls instrument +The \fBccdred\fR instrument file is used for mapping header keywords and +CCD image types. +.le +.ih +IMAGE CURSOR COMMANDS + +.nf +? Help +c Identify the object as a cosmic ray +s Identify the object as a star +g Switch to the graphics plot +q Quit and continue with the cleaning +.fi + +GRAPHICS CURSOR COMMANDS + +.nf +? Help +a Toggle between showing all candidates and only the training points +d Mark candidate for replacement (applys to '+' points) +q Quit and return to image cursor or replace the selected pixels +r Redraw the graph +s Make a surface plot for the candidate nearest the cursor +t Set the flux ratio threshold at the y cursor position +u Mark candidate to not be replaced (applys to 'x' points) +w Adjust the graph window (see \fBgtools\fR) +<space> Print the pixel coordinates +.fi + +There are no colon commands except those for the windowing options (type +:\help or see \fBgtools\fR). +.ih +DESCRIPTION +Cosmic ray events in each input image are detected and replaced by the +average of the four neighbors. The replacement may be performed +directly on the input image if no output image is specified or if the +output image name is the same as the input image name. If a new image +is created it is a copy of the input image except for the replaced +pixels. The processing keyword CRCOR is added to the output image +header. Optional output includes a log file to which a processing log +is appended, a verbose log output to the standard output (the same as +that in the log file), a plot file showing the parameters of the +detected cosmic ray candidates and the flux ratio threshold used, a +bad pixel file containing the coordinates of the replaced pixels, and +a file of training objects marked with the image display cursor. The +bad pixel file may be used for plotting purposes or to create a mask +image for display and analysis using the task \fBbadpiximage\fR. This +bad pixel file will be replaced by the IRAF bad pixel facility when it +becomes available. If one wants more than a simple mask image then by +creating a different output image a difference image between the +original and the modified image may be made using \fBimarith\fR. + +This task may be applied to an image previously processed to detect +additional cosmic rays. A warning will be given (because of the +CRCOR header parameter) and the previous processing header keyword will +be overwritten. + +The cosmic ray detection algorithm consists of the following steps. +First a pixel must be the brightest pixel within the specified +detection window (either 5x5 or 7x7). The mean flux in the surrounding +pixels with the second brightest pixel excluded (which may also be a +cosmic ray event) is computed and the candidate pixel must exceed this +mean by the amount specified by the parameter \fIthreshold\fR. A plane +is fit to the border pixels of the window and the fitted background is +subtracted. The mean flux (now background subtracted) and the ratio of +this mean to the cosmic ray candidate (the brightest pixel) are +computed. The mean flux (x100) and the ratio (x100) are recorded for +interactive examination if desired. + +Once the list of cosmic ray candidates has been created and a threshold for +the flux ratio established (by the parameter \fIfluxratio\fR, by the +"training" method, or by using the graphics cursor in the interactive plot) +the pixels with ratios below the threshold are replaced in the output by +the average of the four neighboring pixels (with the second strongest pixel +in the detection window excluded if it is one of these pixels). Additonal +pixels may then be detected and replaced in further passes as specified by +the parameter \fInpasses\fR. Note that only pixels in the vicinity of +replaced pixels need be considered in further passes. + +The division between the peaks of real objects and cosmic rays is made +based on the flux ratio between the mean flux (excluding the center +pixel and the second strongest pixel) and the candidate pixel. This +threshold depends on the point spread function and the distribution of +multiple cosmic ray events and any additional neighboring light caused +by the events. This threshold is not strongly coupled to small changes +in the data so that once it is set for a new type of image data it may +be used for similar images. To set it initially one may examine the +scatter plot of the flux ratio as a function of the mean flux. This +may be done interactively or from the optional plot file produced. + +After the initial list of cosmic ray candidates has been created and before +the final replacing cosmic rays there are two optional steps to allow +examining the candidates and setting the flux ratio threshold dividing +cosmic rays from real objects. The first optional step is define the flux +ratio boundary by reference to user specified classifications; that is +"training". To do this step the \fItrain\fR parameter must be set to yes. +The user classified objects are specified by a cursor input list. This +list can be an actual file or the image display cursor as defined by the +\fIobjects\fR parameter. The \fIsavefile\fR parameter is also used during +the training to record the objects specified. The parameter specifies a +file to append the objects selected. This is useful when the objects are +defined by interactive image cursor and does not make much sense when using +an input list. + +If the \fIobjects\fR parameter is specified as a null string then +the image display cursor will be repeatedly read until a 'q' is +entered. The user first displays the image and then when the task +reads the display cursor the cursor shape will change. The user +points at objects and types 's' for a star (or other astronomical +object) and 'c' for a cosmic ray. Note that this input is used +to search for the matching object in the cosmic ray candidate list +and so it is possible the selected object is not in the list though +it is unlikely. The selection will be quietly ignored in that case. +To exit the interactive selection of training objects type 'q'. + +If 'g' is typed a graph of all the candidates is drawn showing +"flux" vs. "flux ratio" (see below for more). Training objects will +be shown with a box and the currently set flux ratio threshold will +also be shown. Exiting the plot will return to entering more training +objects. The plot will remain and additional objects will immediately +be shown with a new box. Thus, if one wants to see the training +objects identified in the plot as one selects them from the image +display first type a 'g' to draw the initial plot. Also by switching +to the plot with 'g' allows you to draw surface plots (with 's') or +get the pixel coordinates of a candidate (the space key) to be +found in the display using the coordinate readout of the display. +Note that the display interaction is simpler than might be desired +because this task does not directly connect to the display. + +The most likely use for training is with the interactive image display. +However one may prepare an input list by other means, one example +is with \fBrimcursor\fR, and then specify the file name. The savefile +may also be used a cursor input to repeat the cosmic ray operation +(but be careful not to have the cursor input and save file be the +same file!). + +The flux ratio threshold is determined from the training objects by +finding the point with the minimum number of misclassifications +(stars as cosmic rays or cosmic rays as stars). The threshold is +set at the lowest value so that it will always go through one of +the cosmic ray objects. There should be at least one of each type +of object defined for this to work. The following option of +examining the cosmic ray candidates and parameters may still be +used to modify the derived flux ratio threshold. One last point +about the training objects is that even if some of the points +lie on the wrong side of the threshold they will remain classified +as cosmic ray or non-cosmic ray. In other words, any object +classified by the user will remain in that classification regardless +of the final flux ratio threshold. + +After the training step the user will be queried to examine the candidates +in the flux vs flux ratio plane if the \fIinteractive\fR flag is set. +Responses may be made for specific images or for all images by using +lower or upper case answers respectively. When the parameters are +examined interactively the user may change the flux ratio threshold +('t' key). Changes made are stored in the parameter file and, thus, +learned for further images. Pixels to be deleted are marked by crosses +and pixels which are peaks of objects are marked by pluses. The user +may explicitly delete or undelete any point if desired but this is only +for special cases near the threshold. In the future keys for +interactive display of the specific detections will be added. +Currently a surface plot of any candidate may be displayed graphically +in four 90 degree rotated views using the 's' key. Note that the +initial graph does not show all the points some of which are clearly +cosmic rays because they have negative mean flux or flux ratio. To +view all data one must rewindow the graph with the 'w' key or ":/" +commands (see \fBgtools\fR). +.ih +EXAMPLES +1. To replace cosmic rays in a set of images ccd* without training: + +.nf + cl> cosmicrays ccd* new//ccd* + ccd001: Examine parameters interactively? (yes): + [A scatter plot graph is made. One can adjust the threshold.] + [Looking at a few points using the 's' key can be instructive.] + [When done type 'q'.] + ccd002: Examine parameters interactively? (yes): NO + [No further interactive examination is done.] +.fi + +After cleaning one typically displays the images and possibly blinks them. +A difference image or mask image may also be created. + +2. To use the interactive training method for setting the flux ratio threshold: + +.nf + # First display the image. + cl> display ccd001 1 + z1 = 123.45 z2= 543.21 + cl> cosmicrays ccd001 ccd001cr train+ + [After the cosmic ray candidates are found the image display + [cursor will be activated. Mark a cosmic ray with 'c' and + [a star with 's'. Type 'g' to get a plot showing the two + [points with boxes. Type 'q' to go back to the image display. + [As each new object is marked a box will appear in the plot and + [the threshold may change. To find the location of an object + [seen in the plot use 'g' to go to the graph, space key to find + [the pixel coordinates, 'q' to go back to the image display, + [and the image display coordinate box to find the object. + [When done with the training type 'q'. + ccd001: Examine parameters interactively? (yes): no +.fi + +3. To create a mask image a bad pixel file must be specified. In the +following we replace the cosmic rays in place and create a bad pixel +file and mask image: + +.nf + cl> cosmicrays ccd001 ccd001 badpix=ccd001.bp + cl> badpiximage ccd001.bp ccd001 ccd001bp +.fi +.ih +SEE ALSO +badpixelimage gtools imedit rimcursor +.endhelp diff --git a/noao/imred/ccdred/src/cosmic/crexamine.x b/noao/imred/ccdred/src/cosmic/crexamine.x new file mode 100644 index 00000000..d84961bc --- /dev/null +++ b/noao/imred/ccdred/src/cosmic/crexamine.x @@ -0,0 +1,486 @@ +include <error.h> +include <syserr.h> +include <imhdr.h> +include <gset.h> +include <mach.h> +include <pkg/gtools.h> +include "crlist.h" + +# CR_EXAMINE -- Examine cosmic ray candidates interactively. +# CR_GRAPH -- Make a graph +# CR_NEAREST -- Find the nearest cosmic ray to the cursor. +# CR_DELETE -- Set replace flag for cosmic ray candidate nearest cursor. +# CR_UNDELETE -- Set no replace flag for cosmic ray candidate nearest cursor. +# CR_UPDATE -- Change replacement flags, thresholds, and graphs. +# CR_PLOT -- Make log plot + +define HELP "noao$lib/scr/cosmicrays.key" +define PROMPT "cosmic ray options" + +# CR_EXAMINE -- Examine cosmic ray candidates interactively. + +procedure cr_examine (cr, gp, gt, im, fluxratio, first) + +pointer cr # Cosmic ray list +pointer gp # GIO pointer +pointer gt # GTOOLS pointer +pointer im # Image pointer +real fluxratio # Flux ratio threshold +int first # Initial key + +char cmd[SZ_LINE] +int i, newgraph, wcs, key, nc, nl, c1, c2, l1, l2, show +real wx, wy +pointer data + +int clgcur() +pointer imgs2r() + +begin + # Set up the graphics. + call gt_sets (gt, GTPARAMS, IM_TITLE(im)) + + # Set image limits + nc = IM_LEN(im, 1) + nl = IM_LEN(im, 2) + + # Enter cursor loop. + key = first + repeat { + switch (key) { + case '?': # Print help text. + call gpagefile (gp, HELP, PROMPT) + case ':': # Colon commands. + switch (cmd[1]) { + case '/': + call gt_colon (cmd, gp, gt, newgraph) + default: + call printf ("\007") + } + case 'a': # Toggle show all + if (show == 0) + show = 1 + else + show = 0 + newgraph = YES + case 'd': # Delete candidate + call cr_delete (gp, wx, wy, cr, i, show) + case 'q': # Quit + break + case 'r': # Redraw the graph. + newgraph = YES + case 's': # Make surface plots + call cr_nearest (gp, wx, wy, cr, i, show) + c1 = max (1, int (Memr[CR_COL(cr)+i-1]) - 5) + c2 = min (nc, int (Memr[CR_COL(cr)+i-1]) + 5) + l1 = max (1, int (Memr[CR_LINE(cr)+i-1]) - 5) + l2 = min (nl, int (Memr[CR_LINE(cr)+i-1]) + 5) + data = imgs2r (im, c1, c2, l1, l2) + call gclear (gp) + call gsview (gp, 0.03, 0.48, 0.53, 0.98) + call cr_surface (gp, Memr[data], c2-c1+1, l2-l1+1, -33., 25.) + call gsview (gp, 0.53, 0.98, 0.53, 0.98) + call cr_surface (gp, Memr[data], c2-c1+1, l2-l1+1, -123., 25.) + call gsview (gp, 0.03, 0.48, 0.03, 0.48) + call cr_surface (gp, Memr[data], c2-c1+1, l2-l1+1, 57., 25.) + call gsview (gp, 0.53, 0.98, 0.03, 0.48) + call cr_surface (gp, Memr[data], c2-c1+1, l2-l1+1, 147., 25.) + call fprintf (STDERR, "[Type any key to continue]") + i = clgcur ("cursor", wx, wy, wcs, key, cmd, SZ_LINE) + newgraph = YES + case 't': # Set threshold + call cr_update (gp, wy, cr, fluxratio, show) + call clputr ("fluxratio", fluxratio) + case 'u': # Undelete candidate + call cr_undelete (gp, wx, wy, cr, i, show) + case 'w':# Window the graph. + call gt_window (gt, gp, "cursor", newgraph) + case ' ': # Print info + call cr_nearest (gp, wx, wy, cr, i, show) + call printf ("%d %d\n") + call pargr (Memr[CR_COL(cr)+i-1]) + call pargr (Memr[CR_LINE(cr)+i-1]) + case 'z': # NOP + newgraph = NO + default: # Ring bell for unrecognized commands. + call printf ("\007") + } + + # Update the graph if needed. + if (newgraph == YES) { + call cr_graph (gp, gt, cr, fluxratio, show) + newgraph = NO + } + } until (clgcur ("cursor", wx, wy, wcs, key, cmd, SZ_LINE) == EOF) +end + + +# CR_GRAPH -- Make a graph + +procedure cr_graph (gp, gt, cr, fluxratio, show) + +pointer gp # GIO pointer +pointer gt # GTOOLS pointers +pointer cr # Cosmic ray list +real fluxratio # Flux ratio threshold +int show # Show (0=all, 1=train) + +int i, ncr +real x1, x2, y1, y2 +pointer sp, x, y, w, flag, index + +begin + call smark (sp) + + call cr_show (show, cr, x, y, w, flag, index, ncr) + if (ncr == 0) { + call sfree (sp) + return + } + + call gclear (gp) + call gt_ascale (gp, gt, Memr[x+1], Memr[y+1], ncr) + call gt_swind (gp, gt) + call gt_labax (gp, gt) + + do i = 1, ncr { + if ((Memi[flag+i] == NO) || (Memi[flag+i] == ALWAYSNO)) + call gmark (gp, Memr[x+i], Memr[y+i], GM_PLUS, 2., 2.) + else + call gmark (gp, Memr[x+i], Memr[y+i], GM_CROSS, 2., 2.) + if (Memr[w+i] != 0.) + call gmark (gp, Memr[x+i], Memr[y+i], GM_BOX, 2., 2.) + } + + call ggwind (gp, x1, x2, y1, y2) + call gseti (gp, G_PLTYPE, 2) + call gline (gp, x1, fluxratio, x2, fluxratio) + + call sfree (sp) +end + + +# CR_NEAREST -- Find the nearest cosmic ray to the cursor. + +procedure cr_nearest (gp, wx, wy, cr, nearest, show) + +pointer gp # GIO pointer +real wx, wy # Cursor position +pointer cr # Cosmic ray list +int nearest # Index of nearest point (returned) +int show # Show (0=all, 1=train) + +int i, ncr +real x0, y0, x1, y1, x2, y2, r2, r2min +pointer sp, x, y, w, flag, index + +begin + call smark (sp) + + call cr_show (show, cr, x, y, w, flag, index, ncr) + if (ncr == 0) { + call sfree (sp) + return + } + + # Search for nearest point in NDC. + r2min = MAX_REAL + call gctran (gp, wx, wy, wx, wy, 1, 0) + do i = 1, ncr { + x1 = Memr[x+i] + y1 = Memr[y+i] + call gctran (gp, x1, y1, x0, y0, 1, 0) + r2 = (x0 - wx) ** 2 + (y0 - wy) ** 2 + if (r2 < r2min) { + r2min = r2 + x2 = x1 + y2 = y1 + nearest = i + } + } + if (index != NULL) + nearest = Memi[index+nearest] + + # Move the cursor to the selected point. + call gscur (gp, x2, y2) + + call sfree (sp) +end + + +# CR_DELETE -- Set replace flag for cosmic ray candidate nearest cursor. + +procedure cr_delete (gp, wx, wy, cr, nearest, show) + +pointer gp # GIO pointer +real wx, wy # Cursor position +pointer cr # Cosmic ray list +int nearest # Index of nearest point (returned) +int show # Show (0=all, 1=train) + +int i, ncr +real x0, y0, x1, y1, x2, y2, r2, r2min +pointer sp, x, y, w, flag, index + +begin + call smark (sp) + + call cr_show (show, cr, x, y, w, flag, index, ncr) + if (ncr == 0) { + call sfree (sp) + return + } + + # Search for nearest point in NDC. + nearest = 0 + r2min = MAX_REAL + call gctran (gp, wx, wy, wx, wy, 1, 0) + do i = 1, ncr { + if ((Memi[flag+i] == YES) || (Memi[flag+i] == ALWAYSYES)) + next + x1 = Memr[x+i] + y1 = Memr[y+i] + call gctran (gp, x1, y1, x0, y0, 1, 0) + r2 = (x0 - wx) ** 2 + (y0 - wy) ** 2 + if (r2 < r2min) { + r2min = r2 + x2 = x1 + y2 = y1 + nearest = i + } + } + + # Move the cursor to the selected point and mark the deleted point. + if (nearest > 0) { + if (index != NULL) + nearest = Memi[index+nearest] + Memi[CR_FLAG(cr)+nearest-1] = ALWAYSYES + Memi[CR_WT(cr)+nearest-1] = -1 + call gscur (gp, x2, y2) + call gseti (gp, G_PMLTYPE, 0) + y2 = Memr[CR_RATIO(cr)+nearest-1] + call gmark (gp, x2, y2, GM_PLUS, 2., 2.) + call gseti (gp, G_PMLTYPE, 1) + call gmark (gp, x2, y2, GM_CROSS, 2., 2.) + } + + call sfree (sp) +end + + +# CR_UNDELETE -- Set no replace flag for cosmic ray candidate nearest cursor. + +procedure cr_undelete (gp, wx, wy, cr, nearest, show) + +pointer gp # GIO pointer +real wx, wy # Cursor position +pointer cr # Cosmic ray list +int nearest # Index of nearest point (returned) +int show # Show (0=all, 1=train) + +int i, ncr +real x0, y0, x1, y1, x2, y2, r2, r2min +pointer sp, x, y, w, flag, index + +begin + call smark (sp) + + call cr_show (show, cr, x, y, w, flag, index, ncr) + if (ncr == 0) { + call sfree (sp) + return + } + + # Search for nearest point in NDC. + nearest = 0 + r2min = MAX_REAL + call gctran (gp, wx, wy, wx, wy, 1, 0) + do i = 1, ncr { + if ((Memi[flag+i] == NO) || (Memi[flag+i] == ALWAYSNO)) + next + x1 = Memr[x+i] + y1 = Memr[y+i] + call gctran (gp, x1, y1, x0, y0, 1, 0) + r2 = (x0 - wx) ** 2 + (y0 - wy) ** 2 + if (r2 < r2min) { + r2min = r2 + x2 = x1 + y2 = y1 + nearest = i + } + } + + # Move the cursor to the selected point and mark the delete point. + if (nearest > 0) { + if (index != NULL) + nearest = Memi[index+nearest] + Memi[CR_FLAG(cr)+nearest-1] = ALWAYSNO + Memi[CR_WT(cr)+nearest-1] = 1 + call gscur (gp, x2, y2) + + call gseti (gp, G_PMLTYPE, 0) + y2 = Memr[CR_RATIO(cr)+nearest-1] + call gmark (gp, x2, y2, GM_CROSS, 2., 2.) + call gseti (gp, G_PMLTYPE, 1) + call gmark (gp, x2, y2, GM_PLUS, 2., 2.) + } + + call sfree (sp) +end + + +# CR_UPDATE -- Change replacement flags, thresholds, and graphs. + +procedure cr_update (gp, wy, cr, fluxratio, show) + +pointer gp # GIO pointer +real wy # Y cursor position +pointer cr # Cosmic ray list +real fluxratio # Flux ratio threshold +int show # Show (0=all, 1=train) + +int i, ncr, flag +real x1, x2, y1, y2 +pointer x, y, f + +begin + call gseti (gp, G_PLTYPE, 0) + call ggwind (gp, x1, x2, y1, y2) + call gline (gp, x1, fluxratio, x2, fluxratio) + fluxratio = wy + call gseti (gp, G_PLTYPE, 2) + call gline (gp, x1, fluxratio, x2, fluxratio) + + if (show == 1) + return + + ncr = CR_NCR(cr) + x = CR_FLUX(cr) - 1 + y = CR_RATIO(cr) - 1 + f = CR_FLAG(cr) - 1 + + do i = 1, ncr { + flag = Memi[f+i] + if ((flag == ALWAYSYES) || (flag == ALWAYSNO)) + next + x1 = Memr[x+i] + y1 = Memr[y+i] + if (flag == NO) { + if (y1 < fluxratio) { + Memi[f+i] = YES + call gseti (gp, G_PMLTYPE, 0) + call gmark (gp, x1, y1, GM_PLUS, 2., 2.) + call gseti (gp, G_PMLTYPE, 1) + call gmark (gp, x1, y1, GM_CROSS, 2., 2.) + } + } else { + if (y1 >= fluxratio) { + Memi[f+i] = NO + call gseti (gp, G_PMLTYPE, 0) + call gmark (gp, x1, y1, GM_CROSS, 2., 2.) + call gseti (gp, G_PMLTYPE, 1) + call gmark (gp, x1, y1, GM_PLUS, 2., 2.) + } + } + } +end + + +# CR_PLOT -- Make log plot + +procedure cr_plot (cr, im, fluxratio) + +pointer cr # Cosmic ray list +pointer im # Image pointer +real fluxratio # Flux ratio threshold + +int fd, open(), errcode() +pointer sp, fname, gp, gt, gopen(), gt_init() +errchk gopen + +begin + call smark (sp) + call salloc (fname, SZ_FNAME, TY_CHAR) + + # Open the plotfile. + call clgstr ("plotfile", Memc[fname], SZ_FNAME) + iferr (fd = open (Memc[fname], APPEND, BINARY_FILE)) { + if (errcode() != SYS_FNOFNAME) + call erract (EA_WARN) + return + } + + # Set up the graphics. + gp = gopen ("stdplot", NEW_FILE, fd) + gt = gt_init() + call gt_sets (gt, GTTYPE, "mark") + call gt_sets (gt, GTXTRAN, "log") + call gt_setr (gt, GTXMIN, 10.) + call gt_setr (gt, GTYMIN, 0.) + call gt_sets (gt, GTTITLE, "Parameters of cosmic rays candidates") + call gt_sets (gt, GTPARAMS, IM_TITLE(im)) + call gt_sets (gt, GTXLABEL, "Flux") + call gt_sets (gt, GTYLABEL, "Flux Ratio") + + call cr_graph (gp, gt, cr, fluxratio, 'r') + + call gt_free (gt) + call gclose (gp) + call close (fd) + call sfree (sp) +end + + +# CR_SHOW -- Select data to show. +# This returns pointers to the data. Note the pointers are salloc from +# the last smark which is done by the calling program. + +procedure cr_show (show, cr, x, y, w, flag, index, ncr) + +int show #I Data to show (0=all, 1=train) +pointer cr #I CR data +pointer x #O Fluxes +pointer y #O Ratios +pointer w #O Weights +pointer flag #O Flags +pointer index #O Index into CR data (if not null) +int ncr #O Number of selected data points + +int i + +begin + switch (show) { + case 0: + ncr = CR_NCR(cr) + x = CR_FLUX(cr) - 1 + y = CR_RATIO(cr) - 1 + w = CR_WT(cr) - 1 + flag = CR_FLAG(cr) - 1 + index = NULL + case 1: + ncr = CR_NCR(cr) + call salloc (x, ncr, TY_REAL) + call salloc (y, ncr, TY_REAL) + call salloc (w, ncr, TY_REAL) + call salloc (flag, ncr, TY_INT) + call salloc (index, ncr, TY_INT) + + ncr = 0 + x = x - 1 + y = y - 1 + w = w - 1 + flag = flag - 1 + index = index - 1 + + do i = 1, CR_NCR(cr) { + if (Memr[CR_WT(cr)+i-1] == 0.) + next + ncr = ncr + 1 + Memr[x+ncr] = Memr[CR_FLUX(cr)+i-1] + Memr[y+ncr] = Memr[CR_RATIO(cr)+i-1] + Memr[w+ncr] = Memr[CR_WT(cr)+i-1] + Memi[flag+ncr] = Memi[CR_FLAG(cr)+i-1] + Memi[index+ncr] = i + } + } +end diff --git a/noao/imred/ccdred/src/cosmic/crfind.x b/noao/imred/ccdred/src/cosmic/crfind.x new file mode 100644 index 00000000..58850940 --- /dev/null +++ b/noao/imred/ccdred/src/cosmic/crfind.x @@ -0,0 +1,305 @@ +include <math/gsurfit.h> + +# CR_FIND -- Find cosmic ray candidates. +# This procedure is an interface to special procedures specific to a given +# window size. + +procedure cr_find (cr, threshold, data, nc, nl, col, line, + sf1, sf2, x, y, z, w) + +pointer cr # Cosmic ray list +real threshold # Detection threshold +pointer data[ARB] # Data lines +int nc # Number of columns +int nl # Number of lines +int col # First column +int line # Center line +pointer sf1, sf2 # Surface fitting +real x[ARB], y[ARB], z[ARB], w[ARB] # Surface arrays + +pointer a, b, c, d, e, f, g + +begin + switch (nl) { + case 5: + a = data[1] + b = data[2] + c = data[3] + d = data[4] + e = data[5] + call cr_find5 (cr, threshold, col, line, Memr[a], Memr[b], + Memr[c], Memr[d], Memr[e], nc, sf1, sf2, x, y, z, w) + case 7: + a = data[1] + b = data[2] + c = data[3] + d = data[4] + e = data[5] + f = data[6] + g = data[7] + call cr_find7 (cr, threshold, col, line, Memr[a], Memr[b], + Memr[c], Memr[d], Memr[e], Memr[f], Memr[g], nc, + sf1, sf2, x, y, z, w) + } +end + + +# CR_FIND7 -- Find cosmic rays candidates in 7x7 window. +# This routine finds cosmic rays candidates with the following algorithm. +# 1. If the pixel is not a local maximum relative to it's 48 neighbors +# go on to the next pixel. +# 2. Identify the next strongest pixel in the 7x7 region. +# This suspect pixel is excluded in the following. +# 2. Compute the flux of the 7x7 region excluding the cosmic ray +# candidate and the suspect pixel. +# 3. The candidate must exceed the average flux per pixel by a specified +# threshold. If not go on to the next pixel. +# 4. Fit a plane to the border pixels (excluding the suspect pixel). +# 5. Subtract the background defined by the plane. +# 6. Determine a replacement value as the average of the four adjacent +# pixels (excluding the suspect pixels). +# 7. Add the pixel to the cosmic ray candidate list. + +procedure cr_find7 (cr, threshold, col, line, a, b, c, d, e, f, g, n, + sf1, sf2, x, y, z, w) + +pointer cr # Cosmic ray list +real threshold # Detection threshold +int col # First column +int line # Line +real a[ARB], b[ARB], c[ARB], d[ARB] # Image lines +real e[ARB], f[ARB], g[ARB] # Image lines +int n # Number of columns +pointer sf1, sf2 # Surface fitting +real x[49], y[49], z[49], w[49] # Surface arrays + +real bkgd[49] +int i1, i2, i3, i4, i5, i6, i7, j, j1, j2 +real p, flux, replace, asumr() +pointer sf + +begin + for (i4=4; i4<=n-3; i4=i4+1) { + # Must be local maxima. + p = d[i4] + if (p<a[i4]||p<b[i4]||p<c[i4]||p<e[i4]||p<f[i4]||p<g[i4]) + next + i1 = i4 - 3 + if (p<a[i1]||p<b[i1]||p<c[i1]||p<d[i1]||p<e[i1]||p<f[i1]||p<g[i1]) + next + i2 = i4 - 2 + if (p<a[i2]||p<b[i2]||p<c[i2]||p<d[i2]||p<e[i2]||p<f[i2]||p<g[i2]) + next + i3 = i4 - 1 + if (p<a[i3]||p<b[i3]||p<c[i3]||p<d[i3]||p<e[i3]||p<f[i3]||p<g[i3]) + next + i5 = i4 + 1 + if (p<a[i5]||p<b[i5]||p<c[i5]||p<d[i5]||p<e[i5]||p<f[i5]||p<g[i5]) + next + i6 = i4 + 2 + if (p<a[i6]||p<b[i6]||p<c[i6]||p<d[i6]||p<e[i6]||p<f[i6]||p<g[i6]) + next + i7 = i4 + 3 + if (p<a[i7]||p<b[i7]||p<c[i7]||p<d[i7]||p<e[i7]||p<f[i7]||p<g[i7]) + next + + # Convert to a single array in surface fitting order. + call amovr (a[i1], z[1], 7) + z[8] = b[i7]; z[9] = c[i7]; z[10] = d[i7]; z[11] = e[i7] + z[12] = f[i7]; z[13] = g[i7]; z[14] = g[i6]; z[15] = g[i5] + z[16] = f[i4]; z[17] = g[i3]; z[18] = g[i2]; z[19] = g[i1] + z[20] = f[i1]; z[21] = e[i1]; z[22] = d[i1]; z[23] = c[i1] + z[24] = b[i1] + call amovr (b[i2], z[25], 5) + call amovr (c[i2], z[30], 5) + call amovr (d[i2], z[35], 5) + call amovr (e[i2], z[40], 5) + call amovr (f[i2], z[45], 5) + + # Find the highest point excluding the center. + j1 = 37; j2 = 1 + do j = 2, 49 { + if (j == j1) + next + if (z[j] > z[j2]) + j2 = j + } + + # Compute the flux excluding the extreme points. + flux = (asumr (z, 49) - z[j1] - z[j2]) / 47 + + # Pixel must be exceed specified threshold. + if (p < flux + threshold) + next + + # Fit and subtract the background. + if (j2 < 25) { + w[j2] = 0 + sf = sf2 + call gsfit (sf, x, y, z, w, 24, WTS_USER, j) + w[j2] = 1 + } else { + sf = sf1 + call gsrefit (sf, x, y, z, w, j) + } + + call gsvector (sf, x, y, bkgd, 49) + call asubr (z, bkgd, z, 49) + p = z[j1] + + # Compute the flux excluding the extreme points. + flux = (asumr (z, 49) - z[j1] - z[j2]) / 47 + + # Determine replacement value from four nearest neighbors again + # excluding the most deviant pixels. + replace = 0 + j = 0 + if (j2 != 32) { + replace = replace + c[i4] + j = j + 1 + } + if (j2 != 36) { + replace = replace + d[i3] + j = j + 1 + } + if (j2 != 38) { + replace = replace + d[i5] + j = j + 1 + } + if (j2 != 42) { + replace = replace + e[i4] + j = j + 1 + } + replace = replace / j + + # Add pixel to cosmic ray list. + flux = 100. * flux + call cr_add (cr, col+i4-1, line, flux, flux/p, 0., replace, 0) + i4 = i7 + } +end + + +# CR_FIND5 -- Find cosmic rays candidates in 5x5 window. +# This routine finds cosmic rays candidates with the following algorithm. +# 1. If the pixel is not a local maximum relative to it's 24 neighbors +# go on to the next pixel. +# 2. Identify the next strongest pixel in the 5x5 region. +# This suspect pixel is excluded in the following. +# 2. Compute the flux of the 5x5 region excluding the cosmic ray +# candidate and the suspect pixel. +# 3. The candidate must exceed the average flux per pixel by a specified +# threshold. If not go on to the next pixel. +# 4. Fit a plane to the border pixels (excluding the suspect pixel). +# 5. Subtract the background defined by the plane. +# 6. Determine a replacement value as the average of the four adjacent +# pixels (excluding the suspect pixels). +# 7. Add the pixel to the cosmic ray candidate list. + +procedure cr_find5 (cr, threshold, col, line, a, b, c, d, e, n, + sf1, sf2, x, y, z, w) + +pointer cr # Cosmic ray list +real threshold # Detection threshold +int col # First column +int line # Line +real a[ARB], b[ARB], c[ARB], d[ARB], e[ARB] # Image lines +int n # Number of columns +pointer sf1, sf2 # Surface fitting +real x[25], y[25], z[25], w[25] # Surface arrays + +real bkgd[25] +int i1, i2, i3, i4, i5, j, j1, j2 +real p, flux, replace, asumr() +pointer sf + +begin + for (i3=3; i3<=n-2; i3=i3+1) { + # Must be local maxima. + p = c[i3] + if (p<a[i3]||p<b[i3]||p<d[i3]||p<e[i3]) + next + i1 = i3 - 2 + if (p<a[i1]||p<b[i1]||p<c[i1]||p<d[i1]||p<e[i1]) + next + i2 = i3 - 1 + if (p<a[i2]||p<b[i2]||p<c[i2]||p<d[i2]||p<e[i2]) + next + i4 = i3 + 1 + if (p<a[i4]||p<b[i4]||p<c[i4]||p<d[i4]||p<e[i4]) + next + i5 = i3 + 2 + if (p<a[i5]||p<b[i5]||p<c[i5]||p<d[i5]||p<e[i5]) + next + + # Convert to a single array in surface fitting order. + call amovr (a[i1], z[1], 5) + z[6] = b[i5]; z[7] = c[i5]; z[8] = d[i5]; z[9] = e[i5] + z[10] = e[i4]; z[11] = e[i3]; z[12] = e[i2]; z[13] = e[i1] + z[14] = d[i1]; z[15] = c[i1]; z[16] = b[i1] + call amovr (b[i2], z[17], 3) + call amovr (c[i2], z[20], 3) + call amovr (d[i2], z[23], 3) + + # Find the highest point excluding the center. + j1 = 21; j2 = 1 + do j = 2, 25 { + if (j == j1) + next + if (z[j] > z[j2]) + j2 = j + } + + # Compute the flux excluding the extreme points. + flux = (asumr (z, 25) - z[j1] - z[j2]) / 23 + + # Pixel must be exceed specified threshold. + if (p < flux + threshold) + next + + # Fit and subtract the background. + if (j2 < 17) { + w[j2] = 0 + sf = sf2 + call gsfit (sf, x, y, z, w, 16, WTS_USER, j) + w[j2] = 1 + } else { + sf = sf1 + call gsrefit (sf, x, y, z, w, j) + } + + call gsvector (sf, x, y, bkgd, 25) + call asubr (z, bkgd, z, 25) + p = z[j1] + + # Compute the flux excluding the extreme points. + flux = (asumr (z, 25) - z[j1] - z[j2]) / 23 + + # Determine replacement value from four nearest neighbors again + # excluding the most deviant pixels. + replace = 0 + j = 0 + if (j2 != 18) { + replace = replace + b[i3] + j = j + 1 + } + if (j2 != 20) { + replace = replace + c[i2] + j = j + 1 + } + if (j2 != 22) { + replace = replace + c[i4] + j = j + 1 + } + if (j2 != 24) { + replace = replace + d[i3] + j = j + 1 + } + replace = replace / j + + # Add pixel to cosmic ray list. + flux = 100. * flux + call cr_add (cr, col+i3-1, line, flux, flux/p, 0., replace, 0) + i3 = i5 + } +end diff --git a/noao/imred/ccdred/src/cosmic/crlist.h b/noao/imred/ccdred/src/cosmic/crlist.h new file mode 100644 index 00000000..1ed498a7 --- /dev/null +++ b/noao/imred/ccdred/src/cosmic/crlist.h @@ -0,0 +1,17 @@ +define CR_ALLOC 100 # Allocation block size +define CR_LENSTRUCT 9 # Length of structure + +define CR_NCR Memi[$1] # Number of cosmic rays +define CR_NALLOC Memi[$1+1] # Length of cosmic ray list +define CR_COL Memi[$1+2] # Pointer to columns +define CR_LINE Memi[$1+3] # Pointer to lines +define CR_FLUX Memi[$1+4] # Pointer to fluxes +define CR_RATIO Memi[$1+5] # Pointer to flux ratios +define CR_WT Memi[$1+6] # Pointer to training weights +define CR_REPLACE Memi[$1+7] # Pointer to replacement values +define CR_FLAG Memi[$1+8] # Pointer to rejection flag + +define ALWAYSNO 3 +define ALWAYSYES 4 + +define CR_RMAX 3. # Maximum radius for matching diff --git a/noao/imred/ccdred/src/cosmic/crlist.x b/noao/imred/ccdred/src/cosmic/crlist.x new file mode 100644 index 00000000..e0a8fd5c --- /dev/null +++ b/noao/imred/ccdred/src/cosmic/crlist.x @@ -0,0 +1,366 @@ +include <error.h> +include <syserr.h> +include <gset.h> +include "crlist.h" + +define HELP "noao$lib/scr/cosmicrays.key" +define PROMPT "cosmic ray options" + +# CR_OPEN -- Open cosmic ray list +# CR_CLOSE -- Close cosmic ray list +# CR_ADD -- Add a cosmic ray candidate to cosmic ray list. +# CR_TRAIN -- Set flux ratio threshold from a training set. +# CR_FINDTHRESH -- Find flux ratio. +# CR_WEIGHT -- Compute the training weight at a particular flux ratio. +# CR_FLAGS -- Set cosmic ray reject flags. +# CR_BADPIX -- Store cosmic rays in bad pixel list. +# CR_REPLACE -- Replace cosmic rays in image with replacement values. + +# CR_OPEN -- Open cosmic ray list + +procedure cr_open (cr) + +pointer cr # Cosmic ray list pointer +errchk malloc + +begin + call malloc (cr, CR_LENSTRUCT, TY_STRUCT) + call malloc (CR_COL(cr), CR_ALLOC, TY_REAL) + call malloc (CR_LINE(cr), CR_ALLOC, TY_REAL) + call malloc (CR_FLUX(cr), CR_ALLOC, TY_REAL) + call malloc (CR_RATIO(cr), CR_ALLOC, TY_REAL) + call malloc (CR_WT(cr), CR_ALLOC, TY_REAL) + call malloc (CR_REPLACE(cr), CR_ALLOC, TY_REAL) + call malloc (CR_FLAG(cr), CR_ALLOC, TY_INT) + CR_NCR(cr) = 0 + CR_NALLOC(cr) = CR_ALLOC +end + + +# CR_CLOSE -- Close cosmic ray list + +procedure cr_close (cr) + +pointer cr # Cosmic ray list pointer + +begin + call mfree (CR_COL(cr), TY_REAL) + call mfree (CR_LINE(cr), TY_REAL) + call mfree (CR_FLUX(cr), TY_REAL) + call mfree (CR_RATIO(cr), TY_REAL) + call mfree (CR_WT(cr), TY_REAL) + call mfree (CR_REPLACE(cr), TY_REAL) + call mfree (CR_FLAG(cr), TY_INT) + call mfree (cr, TY_STRUCT) +end + +# CR_ADD -- Add a cosmic ray candidate to cosmic ray list. + +procedure cr_add (cr, col, line, flux, ratio, wt, replace, flag) + +pointer cr # Cosmic ray list pointer +int col # Cofluxn +int line # Line +real flux # Luminosity +real ratio # Ratio +real wt # Weight +real replace # Sky value +int flag # Flag value + +int ncr +errchk realloc + +begin + if (CR_NCR(cr) == CR_NALLOC(cr)) { + CR_NALLOC(cr) = CR_NALLOC(cr) + CR_ALLOC + call realloc (CR_COL(cr), CR_NALLOC(cr), TY_REAL) + call realloc (CR_LINE(cr), CR_NALLOC(cr), TY_REAL) + call realloc (CR_FLUX(cr), CR_NALLOC(cr), TY_REAL) + call realloc (CR_RATIO(cr), CR_NALLOC(cr), TY_REAL) + call realloc (CR_WT(cr), CR_NALLOC(cr), TY_REAL) + call realloc (CR_REPLACE(cr), CR_NALLOC(cr), TY_REAL) + call realloc (CR_FLAG(cr), CR_NALLOC(cr), TY_INT) + } + + ncr = CR_NCR(cr) + CR_NCR(cr) = ncr + 1 + Memr[CR_COL(cr)+ncr] = col + Memr[CR_LINE(cr)+ncr] = line + Memr[CR_FLUX(cr)+ncr] = flux + Memr[CR_RATIO(cr)+ncr] = ratio + Memr[CR_WT(cr)+ncr] = wt + Memr[CR_REPLACE(cr)+ncr] = replace + Memi[CR_FLAG(cr)+ncr] = flag +end + + +# CR_TRAIN -- Set flux ratio threshold from a training set. + +procedure cr_train (cr, gp, gt, im, fluxratio, fname) + +pointer cr #I Cosmic ray list +pointer gp #I GIO pointer +pointer gt #I GTOOLS pointer +pointer im #I IMIO pointer +real fluxratio #O Flux ratio threshold +char fname[ARB] #I Save file name + +char cmd[10] +bool gflag +real x, y, y1, y2, w, r, rmin +int i, j, n, f, ncr, wcs, key, fd, clgcur(), open(), errcode() +pointer col, line, ratio, flux, wt, flag + +begin + # Open save file + iferr (fd = open (fname, APPEND, TEXT_FILE)) { + if (errcode() != SYS_FNOFNAME) + call erract (EA_WARN) + fd = 0 + } + + ncr = CR_NCR(cr) + col = CR_COL(cr) - 1 + line = CR_LINE(cr) - 1 + flux = CR_FLUX(cr) - 1 + ratio = CR_RATIO(cr) - 1 + wt = CR_WT(cr) - 1 + flag = CR_FLAG(cr) - 1 + + gflag = false + n = 0 + while (clgcur ("objects", x, y, wcs, key, cmd, 10) != EOF) { + switch (key) { + case '?': + call gpagefile (gp, HELP, PROMPT) + next + case 'q': + break + case 's': + w = 1 + f = ALWAYSNO + case 'c': + w = -1 + f = ALWAYSYES + case 'g': + if (gflag) + call cr_examine (cr, gp, gt, im, fluxratio, 'z') + else { + if (n > 1) + call cr_findthresh (cr, fluxratio) + call cr_flags (cr, fluxratio) + call cr_examine (cr, gp, gt, im, fluxratio, 'r') + gflag = true + } + next + default: + next + } + + y1 = y - CR_RMAX + y2 = y + CR_RMAX + for (i=10; i<ncr && y1>Memr[line+i]; i=i+10) + ; + j = i - 9 + rmin = (Memr[col+j] - x) ** 2 + (Memr[line+j] - y) ** 2 + for (i=j+1; i<ncr && y2>Memr[line+i]; i=i+1) { + r = (Memr[col+i] - x) ** 2 + (Memr[line+i] - y) ** 2 + if (r < rmin) { + rmin = r + j = i + } + } + if (sqrt (rmin) > CR_RMAX) + next + + Memr[wt+j] = w + Memi[flag+j] = f + n = n + 1 + + if (gflag) { + if (n > 1) { + call cr_findthresh (cr, r) + call cr_update (gp, r, cr, fluxratio, 0) + } + call gmark (gp, Memr[flux+j], Memr[ratio+j], GM_BOX, 2., 2.) + } + if (fd > 0) { + call fprintf (fd, "%g %g %d %c\n") + call pargr (x) + call pargr (y) + call pargi (wcs) + call pargi (key) + } + } + + if (fd > 0) + call close (fd) +end + + +# CR_FINDTHRESH -- Find flux ratio. + +procedure cr_findthresh (cr, fluxratio) + +pointer cr #I Cosmic ray list +real fluxratio #O Flux ratio threshold + +real w, r, rmin, cr_weight() +int i, ncr +pointer ratio, wt + +begin + ncr = CR_NCR(cr) + ratio = CR_RATIO(cr) - 1 + wt = CR_WT(cr) - 1 + + fluxratio = Memr[ratio+1] + rmin = cr_weight (fluxratio, Memr[ratio+1], Memr[wt+1], ncr) + do i = 2, ncr { + if (Memr[wt+i] == 0.) + next + r = Memr[ratio+i] + w = cr_weight (r, Memr[ratio+1], Memr[wt+1], ncr) + if (w <= rmin) { + if (w == rmin) + fluxratio = min (fluxratio, r) + else { + rmin = w + fluxratio = r + } + } + } +end + + +# CR_WEIGHT -- Compute the training weight at a particular flux ratio. + +real procedure cr_weight (fluxratio, ratio, wts, ncr) + +real fluxratio #I Flux ratio +real ratio[ARB] #I Ratio Values +real wts[ARB] #I Weights +int ncr #I Number of ratio values +real wt #O Sum of weights + +int i + +begin + wt = 0. + do i = 1, ncr { + if (ratio[i] > fluxratio) { + if (wts[i] < 0.) + wt = wt - wts[i] + } else { + if (wts[i] > 0.) + wt = wt + wts[i] + } + } + return (wt) +end + + +# CR_FLAGS -- Set cosmic ray reject flags. + +procedure cr_flags (cr, fluxratio) + +pointer cr # Cosmic ray candidate list +real fluxratio # Rejection limits + +int i, ncr +pointer ratio, flag + +begin + ncr = CR_NCR(cr) + ratio = CR_RATIO(cr) - 1 + flag = CR_FLAG(cr) - 1 + + do i = 1, ncr { + if ((Memi[flag+i] == ALWAYSYES) || (Memi[flag+i] == ALWAYSNO)) + next + if (Memr[ratio+i] > fluxratio) + Memi[flag+i] = NO + else + Memi[flag+i] = YES + } +end + + +# CR_BADPIX -- Store cosmic rays in bad pixel list. +# This is currently a temporary measure until a real bad pixel list is +# implemented. + +procedure cr_badpix (cr, fname) + +pointer cr # Cosmic ray list +char fname[ARB] # Bad pixel file name + +int i, ncr, c, l, f, fd, open(), errcode() +pointer col, line, ratio, flux, flag +errchk open + +begin + # Open bad pixel file + iferr (fd = open (fname, APPEND, TEXT_FILE)) { + if (errcode() != SYS_FNOFNAME) + call erract (EA_WARN) + return + } + + ncr = CR_NCR(cr) + col = CR_COL(cr) - 1 + line = CR_LINE(cr) - 1 + flux = CR_FLUX(cr) - 1 + ratio = CR_RATIO(cr) - 1 + flag = CR_FLAG(cr) - 1 + + do i = 1, ncr { + f = Memi[flag+i] + if ((f == NO) || (f == ALWAYSNO)) + next + + c = Memr[col+i] + l = Memr[line+i] + call fprintf (fd, "%d %d\n") + call pargi (c) + call pargi (l) + } + call close (fd) +end + + +# CR_REPLACE -- Replace cosmic rays in image with replacement values. + +procedure cr_replace (cr, offset, im, nreplaced) + +pointer cr # Cosmic ray list +int offset # Offset in list +pointer im # IMIO pointer of output image +int nreplaced # Number replaced (for log) + +int i, ncr, c, l, f +real r +pointer col, line, replace, flag, imps2r() + +begin + ncr = CR_NCR(cr) + if (ncr <= offset) + return + + col = CR_COL(cr) - 1 + line = CR_LINE(cr) - 1 + replace = CR_REPLACE(cr) - 1 + flag = CR_FLAG(cr) - 1 + + do i = offset+1, ncr { + f = Memi[flag+i] + if ((f == NO) || (f == ALWAYSNO)) + next + + c = Memr[col+i] + l = Memr[line+i] + r = Memr[replace+i] + Memr[imps2r (im, c, c, l, l)] = r + nreplaced = nreplaced + 1 + } +end diff --git a/noao/imred/ccdred/src/cosmic/crsurface.x b/noao/imred/ccdred/src/cosmic/crsurface.x new file mode 100644 index 00000000..32645ff4 --- /dev/null +++ b/noao/imred/ccdred/src/cosmic/crsurface.x @@ -0,0 +1,46 @@ +define DUMMY 6 + +# CR_SURFACE -- Draw a perspective view of a surface. The altitude +# and azimuth of the viewing angle are variable. + +procedure cr_surface(gp, data, ncols, nlines, angh, angv) + +pointer gp # GIO pointer +real data[ncols,nlines] # Surface data to be plotted +int ncols, nlines # Dimensions of surface +real angh, angv # Orientation of surface (degrees) + +int wkid +pointer sp, work + +int first +real vpx1, vpx2, vpy1, vpy2 +common /frstfg/ first +common /noaovp/ vpx1, vpx2, vpy1, vpy2 + +begin + call smark (sp) + call salloc (work, 2 * (2 * ncols * nlines + ncols + nlines), TY_REAL) + + # Initialize surface common blocks + first = 1 + call srfabd() + + # Define viewport. + call ggview (gp, vpx1, vpx2, vpy1, vpy2) + + # Link GKS to GIO + wkid = 1 + call gopks (STDERR) + call gopwk (wkid, DUMMY, gp) + call gacwk (wkid) + + call ezsrfc (data, ncols, nlines, angh, angv, Memr[work]) + + call gdawk (wkid) + # We don't want to close the GIO pointer. + #call gclwk (wkid) + call gclks () + + call sfree (sp) +end diff --git a/noao/imred/ccdred/src/cosmic/mkpkg b/noao/imred/ccdred/src/cosmic/mkpkg new file mode 100644 index 00000000..d63d9c2c --- /dev/null +++ b/noao/imred/ccdred/src/cosmic/mkpkg @@ -0,0 +1,16 @@ +# COSMIC RAY CLEANING + +$checkout libpkg.a ../.. +$update libpkg.a +$checkin libpkg.a ../.. +$exit + +libpkg.a: + crexamine.x crlist.h <error.h> <gset.h> <mach.h> <pkg/gtools.h>\ + <imhdr.h> <syserr.h> + crfind.x <math/gsurfit.h> + crlist.x crlist.h <error.h> <gset.h> <syserr.h> + crsurface.x + t_cosmicrays.x crlist.h <error.h> <gset.h> <math/gsurfit.h>\ + <pkg/gtools.h> <imhdr.h> <imset.h> + ; diff --git a/noao/imred/ccdred/src/cosmic/t_cosmicrays.x b/noao/imred/ccdred/src/cosmic/t_cosmicrays.x new file mode 100644 index 00000000..8640b639 --- /dev/null +++ b/noao/imred/ccdred/src/cosmic/t_cosmicrays.x @@ -0,0 +1,348 @@ +include <error.h> +include <imhdr.h> +include <imset.h> +include <math/gsurfit.h> +include <gset.h> +include <pkg/gtools.h> +include "crlist.h" + +# T_COSMICRAYS -- Detect and remove cosmic rays in images. +# A list of images is examined for cosmic rays which are then replaced +# by values from neighboring pixels. The output image may be the same +# as the input image. This is the top level procedure which manages +# the input and output image data. The actual algorithm for detecting +# cosmic rays is in CR_FIND. + +procedure t_cosmicrays () + +int list1 # List of input images to be cleaned +int list2 # List of output images +int list3 # List of output bad pixel files +real threshold # Detection threshold +real fluxratio # Luminosity boundary for stars +int npasses # Number of cleaning passes +int szwin # Size of detection window +bool train # Use training objects? +pointer savefile # Save file for training objects +bool interactive # Examine cosmic ray parameters? +char ans # Answer to interactive query + +int nc, nl, c, c1, c2, l, l1, l2, szhwin, szwin2 +int i, j, k, m, ncr, ncrlast, nreplaced, flag +pointer sp, input, output, badpix, str, gp, gt, im, in, out +pointer x, y, z, w, sf1, sf2, cr, data, ptr + +bool clgetb(), ccdflag(), streq(), strne() +char clgetc() +int imtopenp(), imtlen(), imtgetim(), clpopnu(), clgfil(), clgeti() +real clgetr() +pointer immap(), impl2r(), imgs2r(), gopen(), gt_init() +errchk immap, impl2r, imgs2r +errchk cr_find, cr_examine, cr_replace, cr_plot, cr_badpix + +begin + call smark (sp) + call salloc (input, SZ_FNAME, TY_CHAR) + call salloc (output, SZ_FNAME, TY_CHAR) + call salloc (badpix, SZ_FNAME, TY_CHAR) + call salloc (savefile, SZ_FNAME, TY_CHAR) + call salloc (str, SZ_LINE, TY_CHAR) + + # Get the task parameters. Check that the number of output images + # is either zero, in which case the cosmic rays will be removed + # in place, or equal to the number of input images. + + list1 = imtopenp ("input") + list2 = imtopenp ("output") + i = imtlen (list1) + j = imtlen (list2) + if (j > 0 && j != i) + call error (0, "Input and output image lists do not match") + + list3 = clpopnu ("badpix") + threshold = clgetr ("threshold") + fluxratio = clgetr ("fluxratio") + npasses = clgeti ("npasses") + szwin = clgeti ("window") + train = clgetb ("train") + call clgstr ("savefile", Memc[savefile], SZ_FNAME) + interactive = clgetb ("interactive") + call clpstr ("answer", "yes") + ans = 'y' + + # Set up the graphics. + call clgstr ("graphics", Memc[str], SZ_LINE) + if (interactive) { + gp = gopen (Memc[str], NEW_FILE+AW_DEFER, STDGRAPH) + gt = gt_init() + call gt_sets (gt, GTTYPE, "mark") + call gt_sets (gt, GTXTRAN, "log") + call gt_setr (gt, GTXMIN, 10.) + call gt_setr (gt, GTYMIN, 0.) + call gt_sets (gt, GTTITLE, "Parameters of cosmic rays candidates") + call gt_sets (gt, GTXLABEL, "Flux") + call gt_sets (gt, GTYLABEL, "Flux Ratio") + } + + # Use image header translation file. + call clgstr ("instrument", Memc[input], SZ_FNAME) + call hdmopen (Memc[input]) + + # Set up surface fitting. The background points are placed together + # at the beginning of the arrays. There are two surface pointers, + # one for using the fast refit if there are no points excluded and + # one for doing a full fit with points excluded. + + szhwin = szwin / 2 + szwin2 = szwin * szwin + call salloc (data, szwin, TY_INT) + call salloc (x, szwin2, TY_REAL) + call salloc (y, szwin2, TY_REAL) + call salloc (z, szwin2, TY_REAL) + call salloc (w, szwin2, TY_REAL) + + k = 0 + do i = 1, szwin { + Memr[x+k] = i + Memr[y+k] = 1 + k = k + 1 + } + do i = 2, szwin { + Memr[x+k] = szwin + Memr[y+k] = i + k = k + 1 + } + do i = szwin-1, 1, -1 { + Memr[x+k] = i + Memr[y+k] = szwin + k = k + 1 + } + do i = szwin-1, 2, -1 { + Memr[x+k] = 1 + Memr[y+k] = i + k = k + 1 + } + do i = 2, szwin-1 { + do j = 2, szwin-1 { + Memr[x+k] = j + Memr[y+k] = i + k = k + 1 + } + } + call aclrr (Memr[z], szwin2) + call amovkr (1., Memr[w], 4*szwin-4) + call gsinit (sf1, GS_POLYNOMIAL, 2, 2, NO, 1., real(szwin), + 1., real(szwin)) + call gsinit (sf2, GS_POLYNOMIAL, 2, 2, NO, 1., real(szwin), + 1., real(szwin)) + call gsfit (sf1, Memr[x], Memr[y], Memr[z], Memr[w], 4*szwin-4, + WTS_USER, j) + + # Process each input image. Either work in place or create a + # new output image. If an error mapping the images occurs + # issue a warning and go on to the next input image. + + while (imtgetim (list1, Memc[input], SZ_FNAME) != EOF) { + if (imtgetim (list2, Memc[output], SZ_FNAME) == EOF) + call strcpy (Memc[input], Memc[output], SZ_FNAME) + if (clgfil (list3, Memc[badpix], SZ_FNAME) == EOF) + Memc[badpix] = EOS + + iferr { + in = NULL + out = NULL + cr = NULL + + # Map the input image and check for image type and + # previous correction flag. If the output image is + # the same as the input image work in place. + # Initialize IMIO to use a scrolling buffer of lines. + + call set_input (Memc[input], im, i) + if (im == NULL) + call error (1, "Skipping input image") + + if (ccdflag (im, "crcor")) { + call eprintf ("WARNING: %s previously corrected\n") + call pargstr (Memc[input]) + #call imunmap (im) + #next + } + + if (streq (Memc[input], Memc[output])) { + call imunmap (im) + im = immap (Memc[input], READ_WRITE, 0) + } + in = im + + nc = IM_LEN(in,1) + nl = IM_LEN(in,2) + if ((nl < szwin) || (nc < szwin)) + call error (0, "Image size is too small") + call imseti (in, IM_NBUFS, szwin) + call imseti (in, IM_TYBNDRY, BT_NEAREST) + call imseti (in, IM_NBNDRYPIX, szhwin) + + # Open the output image if needed. + if (strne (Memc[input], Memc[output])) + im = immap (Memc[output], NEW_COPY, in) + out = im + + # Open a cosmic ray list structure. + call cr_open (cr) + ncrlast = 0 + nreplaced = 0 + + # Now proceed through the image line by line, scrolling + # the line buffers at each step. If creating a new image + # also write out each line as it is read. A procedure is + # called to find the cosmic ray candidates in the line + # and add them to the list maintained by CRLIST. + # Note that cosmic rays are not replaced at this point + # in order to allow the user to modify the criteria for + # a cosmic ray and review the results. + + c1 = 1-szhwin + c2 = nc+szhwin + do i = 1, szwin-1 + Memi[data+i] = + imgs2r (in, c1, c2, i-szhwin, i-szhwin) + + do l = 1, nl { + do i = 1, szwin-1 + Memi[data+i-1] = Memi[data+i] + Memi[data+szwin-1] = + imgs2r (in, c1, c2, l+szhwin, l+szhwin) + if (out != in) + call amovr (Memr[Memi[data+szhwin]+szhwin], + Memr[impl2r(out,l)], nc) + + call cr_find (cr, threshold, Memi[data], + c2-c1+1, szwin, c1, l, + sf1, sf2, Memr[x], Memr[y], Memr[z], Memr[w]) + } + if (interactive && train) { + call cr_train (cr, gp, gt, in, fluxratio, Memc[savefile]) + train = false + } + call cr_flags (cr, fluxratio) + + # If desired examine the cosmic ray list interactively. + if (interactive && ans != 'N') { + if (ans != 'Y') { + call eprintf ("%s - ") + call pargstr (Memc[input]) + call flush (STDERR) + ans = clgetc ("answer") + } + if ((ans == 'Y') || (ans == 'y')) + call cr_examine (cr, gp, gt, in, fluxratio, 'r') + } + + # Now replace the selected cosmic rays in the output image. + + call imflush (out) + call imseti (out, IM_ADVICE, RANDOM) + call cr_replace (cr, ncrlast, out, nreplaced) + + # Do additional passes through the data. We work in place + # in the output image. Note that we only have to look in + # the vicinity of replaced cosmic rays for secondary + # events since we've already looked at every pixel once. + # Instead of scrolling through the image we will extract + # subrasters around each replaced cosmic ray. However, + # we use pointers into the subraster to maintain the same + # format expected by CR_FIND. + + if (npasses > 1) { + if (out != in) + call imunmap (out) + call imunmap (in) + im = immap (Memc[output], READ_WRITE, 0) + in = im + out = im + call imseti (in, IM_TYBNDRY, BT_NEAREST) + call imseti (in, IM_NBNDRYPIX, szhwin) + + for (i=2; i<=npasses; i=i+1) { + # Loop through each cosmic ray in the previous pass. + ncr = CR_NCR(cr) + do j = ncrlast+1, ncr { + flag = Memi[CR_FLAG(cr)+j-1] + if (flag==NO || flag==ALWAYSNO) + next + c = Memr[CR_COL(cr)+j-1] + l = Memr[CR_LINE(cr)+j-1] + c1 = max (1-szhwin, c - (szwin-1)) + c2 = min (nc+szhwin, c + (szwin-1)) + k = c2 - c1 + 1 + l1 = max (1-szhwin, l - (szwin-1)) + l2 = min (nl+szhwin, l + (szwin-1)) + + # Set the line pointers off an image section + # centered on a previously replaced cosmic ray. + + ptr = imgs2r (in, c1, c2, l1, l2) - k + + l1 = max (1, l - szhwin) + l2 = min (nl, l + szhwin) + do l = l1, l2 { + do m = 1, szwin + Memi[data+m-1] = ptr + m * k + ptr = ptr + k + + call cr_find ( cr, threshold, Memi[data], + k, szwin, c1, l, sf1, sf2, + Memr[x], Memr[y], Memr[z], Memr[w]) + } + } + call cr_flags (cr, fluxratio) + + # Replace any new cosmic rays found. + call cr_replace (cr, ncr, in, nreplaced) + ncrlast = ncr + } + } + + # Output header log, log, plot, and bad pixels. + call sprintf (Memc[str], SZ_LINE, + "Threshold=%5.1f, fluxratio=%6.2f, removed=%d") + call pargr (threshold) + call pargr (fluxratio) + call pargi (nreplaced) + call timelog (Memc[str], SZ_LINE) + call ccdlog (out, Memc[str]) + call hdmpstr (out, "crcor", Memc[str]) + + call cr_plot (cr, in, fluxratio) + call cr_badpix (cr, Memc[badpix]) + + call cr_close (cr) + if (out != in) + call imunmap (out) + call imunmap (in) + } then { + # In case of error clean up and go on to the next image. + if (in != NULL) { + if (out != NULL && out != in) + call imunmap (out) + call imunmap (in) + } + if (cr != NULL) + call cr_close (cr) + call erract (EA_WARN) + } + } + + if (interactive) { + call gt_free (gt) + call gclose (gp) + } + call imtclose (list1) + call imtclose (list2) + call clpcls (list3) + call hdmclose () + call gsfree (sf1) + call gsfree (sf2) + call sfree (sp) +end diff --git a/noao/imred/ccdred/src/doproc.x b/noao/imred/ccdred/src/doproc.x new file mode 100644 index 00000000..909c6f12 --- /dev/null +++ b/noao/imred/ccdred/src/doproc.x @@ -0,0 +1,29 @@ +include "ccdred.h" + +# DOPROC -- Call the appropriate processing procedure. +# +# There are four data type paths depending on the readout axis and +# the calculation data type. + +procedure doproc (ccd) + +pointer ccd # CCD processing structure + +begin + switch (READAXIS (ccd)) { + case 1: + switch (CALCTYPE (ccd)) { + case TY_SHORT: + call proc1s (ccd) + default: + call proc1r (ccd) + } + case 2: + switch (CALCTYPE (ccd)) { + case TY_SHORT: + call proc2s (ccd) + default: + call proc2r (ccd) + } + } +end diff --git a/noao/imred/ccdred/src/generic/ccdred.h b/noao/imred/ccdred/src/generic/ccdred.h new file mode 100644 index 00000000..2d370d86 --- /dev/null +++ b/noao/imred/ccdred/src/generic/ccdred.h @@ -0,0 +1,150 @@ +# CCDRED Data Structures and Definitions + +# The CCD structure: This structure is used to communicate processing +# parameters between the package procedures. It contains pointers to +# data, calibration image IMIO pointers, scaling parameters, and the +# correction flags. The corrections flags indicate which processing +# operations are to be performed. The subsection parameters do not +# include a step size. A step size is assumed. If arbitrary subsampling +# is desired this would be the next generalization. + +define LEN_CCD 131 # Length of CCD structure + +# CCD data coordinates +define CCD_C1 Memi[$1] # CCD starting column +define CCD_C2 Memi[$1+1] # CCD ending column +define CCD_L1 Memi[$1+2] # CCD starting line +define CCD_L2 Memi[$1+3] # CCD ending line + +# Input data +define IN_IM Memi[$1+10] # Input image pointer +define IN_C1 Memi[$1+11] # Input data starting column +define IN_C2 Memi[$1+12] # Input data ending column +define IN_L1 Memi[$1+13] # Input data starting line +define IN_L2 Memi[$1+14] # Input data ending line + +# Output data +define OUT_IM Memi[$1+20] # Output image pointer +define OUT_C1 Memi[$1+21] # Output data starting column +define OUT_C2 Memi[$1+22] # Output data ending column +define OUT_L1 Memi[$1+23] # Output data starting line +define OUT_L2 Memi[$1+24] # Output data ending line + +# Mask data +define MASK_IM Memi[$1+30] # Mask image pointer +define MASK_C1 Memi[$1+31] # Mask data starting column +define MASK_C2 Memi[$1+32] # Mask data ending column +define MASK_L1 Memi[$1+33] # Mask data starting line +define MASK_L2 Memi[$1+34] # Mask data ending line +define MASK_PM Memi[$1+35] # Mask pointer +define MASK_FP Memi[$1+36] # Mask fixpix data + +# Zero level data +define ZERO_IM Memi[$1+40] # Zero level image pointer +define ZERO_C1 Memi[$1+41] # Zero level data starting column +define ZERO_C2 Memi[$1+42] # Zero level data ending column +define ZERO_L1 Memi[$1+43] # Zero level data starting line +define ZERO_L2 Memi[$1+44] # Zero level data ending line + +# Dark count data +define DARK_IM Memi[$1+50] # Dark count image pointer +define DARK_C1 Memi[$1+51] # Dark count data starting column +define DARK_C2 Memi[$1+52] # Dark count data ending column +define DARK_L1 Memi[$1+53] # Dark count data starting line +define DARK_L2 Memi[$1+54] # Dark count data ending line + +# Flat field data +define FLAT_IM Memi[$1+60] # Flat field image pointer +define FLAT_C1 Memi[$1+61] # Flat field data starting column +define FLAT_C2 Memi[$1+62] # Flat field data ending column +define FLAT_L1 Memi[$1+63] # Flat field data starting line +define FLAT_L2 Memi[$1+64] # Flat field data ending line + +# Illumination data +define ILLUM_IM Memi[$1+70] # Illumination image pointer +define ILLUM_C1 Memi[$1+71] # Illumination data starting column +define ILLUM_C2 Memi[$1+72] # Illumination data ending column +define ILLUM_L1 Memi[$1+73] # Illumination data starting line +define ILLUM_L2 Memi[$1+74] # Illumination data ending line + +# Fringe data +define FRINGE_IM Memi[$1+80] # Fringe image pointer +define FRINGE_C1 Memi[$1+81] # Fringe data starting column +define FRINGE_C2 Memi[$1+82] # Fringe data ending column +define FRINGE_L1 Memi[$1+83] # Fringe data starting line +define FRINGE_L2 Memi[$1+84] # Fringe data ending line + +# Trim section +define TRIM_C1 Memi[$1+90] # Trim starting column +define TRIM_C2 Memi[$1+91] # Trim ending column +define TRIM_L1 Memi[$1+92] # Trim starting line +define TRIM_L2 Memi[$1+93] # Trim ending line + +# Bias section +define BIAS_C1 Memi[$1+100] # Bias starting column +define BIAS_C2 Memi[$1+101] # Bias ending column +define BIAS_L1 Memi[$1+102] # Bias starting line +define BIAS_L2 Memi[$1+103] # Bias ending line + +define READAXIS Memi[$1+110] # Read out axis (1=cols, 2=lines) +define CALCTYPE Memi[$1+111] # Calculation data type +define OVERSCAN_TYPE Memi[$1+112] # Overscan type +define OVERSCAN_VEC Memi[$1+113] # Pointer to overscan vector +define DARKSCALE Memr[P2R($1+114)] # Dark count scale factor +define FRINGESCALE Memr[P2R($1+115)] # Fringe scale factor +define FLATSCALE Memr[P2R($1+116)] # Flat field scale factor +define ILLUMSCALE Memr[P2R($1+117)] # Illumination scale factor +define MINREPLACE Memr[P2R($1+118)] # Minimum replacement value +define MEAN Memr[P2R($1+119)] # Mean of output image +define COR Memi[$1+120] # Overall correction flag +define CORS Memi[$1+121+($2-1)] # Individual correction flags + +# The correction array contains the following elements with array indices +# given by the macro definitions. + +define NCORS 10 # Number of corrections + +define FIXPIX 1 # Fix bad pixels +define TRIM 2 # Trim image +define OVERSCAN 3 # Apply overscan correction +define ZEROCOR 4 # Apply zero level correction +define DARKCOR 5 # Apply dark count correction +define FLATCOR 6 # Apply flat field correction +define ILLUMCOR 7 # Apply illumination correction +define FRINGECOR 8 # Apply fringe correction +define FINDMEAN 9 # Find the mean of the output image +define MINREP 10 # Check and replace minimum value + +# The following definitions identify the correction values in the correction +# array. They are defined in terms of bit fields so that it is possible to +# add corrections to form unique combination corrections. Some of +# these combinations are implemented as compound operations for efficiency. + +define O 001B # overscan +define Z 002B # zero level +define D 004B # dark count +define F 010B # flat field +define I 020B # Illumination +define Q 040B # Fringe + +# The following correction combinations are recognized. + +define ZO 003B # zero level + overscan +define DO 005B # dark count + overscan +define DZ 006B # dark count + zero level +define DZO 007B # dark count + zero level + overscan +define FO 011B # flat field + overscan +define FZ 012B # flat field + zero level +define FZO 013B # flat field + zero level + overscan +define FD 014B # flat field + dark count +define FDO 015B # flat field + dark count + overscan +define FDZ 016B # flat field + dark count + zero level +define FDZO 017B # flat field + dark count + zero level + overscan +define QI 060B # fringe + illumination + +# The following overscan functions are recognized. +define OVERSCAN_TYPES "|mean|median|minmax|chebyshev|legendre|spline3|spline1|" +define OVERSCAN_MEAN 1 # Mean of overscan +define OVERSCAN_MEDIAN 2 # Median of overscan +define OVERSCAN_MINMAX 3 # Minmax of overscan +define OVERSCAN_FIT 4 # Following codes are function fits diff --git a/noao/imred/ccdred/src/generic/cor.x b/noao/imred/ccdred/src/generic/cor.x new file mode 100644 index 00000000..fd2a8d6b --- /dev/null +++ b/noao/imred/ccdred/src/generic/cor.x @@ -0,0 +1,694 @@ +include "ccdred.h" + + +.help cor Feb87 noao.imred.ccdred +.nf ---------------------------------------------------------------------------- +cor -- Process CCD image lines + +These procedures are the heart of the CCD processing. They do the desired +set of processing operations on the image line data as efficiently as +possible. They are called by the PROC procedures. There are four procedures +one for each readout axis and one for short and real image data. +Some sets of operations are coded as single compound operations for efficiency. +To keep the number of combinations managable only the most common +combinations are coded as compound operations. The combinations +consist of any set of line overscan, column overscan, zero level, dark +count, and flat field and any set of illumination and fringe +correction. The corrections are applied in place to the output vector. + +The column readout procedure is more complicated in order to handle +zero level and flat field corrections specified as one dimensional +readout corrections instead of two dimensional calibration images. +Column readout format is probably extremely rare and the 1D readout +corrections are used only for special types of data. +.ih +SEE ALSO +proc, ccdred.h +.endhelp ----------------------------------------------------------------------- + + +# COR1 -- Correct image lines with readout axis 1 (lines). + +procedure cor1s (cors, out, overscan, zero, dark, flat, illum, + fringe, n, darkscale, flatscale, illumscale, frgscale) + +int cors[ARB] # Correction flags +short out[n] # Output data +real overscan # Overscan value +short zero[n] # Zero level correction +short dark[n] # Dark count correction +short flat[n] # Flat field correction +short illum[n] # Illumination correction +short fringe[n] # Fringe correction +int n # Number of pixels +real darkscale # Dark count scale factor +real flatscale # Flat field scale factor +real illumscale # Illumination scale factor +real frgscale # Fringe scale factor + +int i, op + +begin + op = cors[OVERSCAN] + cors[ZEROCOR] + cors[DARKCOR] + cors[FLATCOR] + switch (op) { + case O: # overscan + do i = 1, n + out[i] = out[i] - overscan + case Z: # zero level + do i = 1, n + out[i] = out[i] - zero[i] + + case ZO: # zero level + overscan + do i = 1, n + out[i] = out[i] - overscan - zero[i] + + case D: # dark count + do i = 1, n + out[i] = out[i] - darkscale * dark[i] + case DO: # dark count + overscan + do i = 1, n + out[i] = out[i] - overscan - darkscale * dark[i] + case DZ: # dark count + zero level + do i = 1, n + out[i] = out[i] - zero[i] - darkscale * dark[i] + case DZO: # dark count + zero level + overscan + do i = 1, n + out[i] = out[i] - overscan - zero[i] - darkscale * dark[i] + + case F: # flat field + do i = 1, n + out[i] = out[i] * flatscale / flat[i] + case FO: # flat field + overscan + do i = 1, n + out[i] = (out[i] - overscan) * flatscale / flat[i] + case FZ: # flat field + zero level + do i = 1, n + out[i] = (out[i] - zero[i]) * flatscale / flat[i] + case FZO: # flat field + zero level + overscan + do i = 1, n + out[i] = (out[i] - overscan - zero[i]) * flatscale / + flat[i] + case FD: # flat field + dark count + do i = 1, n + out[i] = (out[i] - darkscale * dark[i]) * flatscale / flat[i] + case FDO: # flat field + dark count + overscan + do i = 1, n + out[i] = (out[i] - overscan - darkscale * dark[i]) * + flatscale / flat[i] + case FDZ: # flat field + dark count + zero level + do i = 1, n + out[i] = (out[i] - zero[i] - darkscale * dark[i]) * + flatscale / flat[i] + case FDZO: # flat field + dark count + zero level + overscan + do i = 1, n + out[i] = (out[i] - overscan - zero[i] - + darkscale * dark[i]) * flatscale / flat[i] + } + + # Often these operations will not be performed so test for no + # correction rather than go through the switch. + + op = cors[ILLUMCOR] + cors[FRINGECOR] + if (op != 0) { + switch (op) { + case I: # illumination + do i = 1, n + out[i] = out[i] * illumscale / illum[i] + case Q: # fringe + do i = 1, n + out[i] = out[i] - frgscale * fringe[i] + case QI: # fringe + illumination + do i = 1, n + out[i] = out[i]*illumscale/illum[i] - frgscale*fringe[i] + } + } +end + + +# COR2 -- Correct lines for readout axis 2 (columns). This procedure is +# more complex than when the readout is along the image lines because the +# zero level and/or flat field corrections may be single readout column +# vectors. + +procedure cor2s (line, cors, out, overscan, zero, dark, flat, illum, + fringe, n, zeroim, flatim, darkscale, flatscale, illumscale, frgscale) + +int line # Line to be corrected +int cors[ARB] # Correction flags +short out[n] # Output data +real overscan[n] # Overscan value +short zero[n] # Zero level correction +short dark[n] # Dark count correction +short flat[n] # Flat field correction +short illum[n] # Illumination correction +short fringe[n] # Fringe correction +int n # Number of pixels +pointer zeroim # Zero level IMIO pointer (NULL if 1D vector) +pointer flatim # Flat field IMIO pointer (NULL if 1D vector) +real darkscale # Dark count scale factor +real flatscale # Flat field scale factor +real illumscale # Illumination scale factor +real frgscale # Fringe scale factor + +short zeroval +real flatval +int i, op + +begin + op = cors[OVERSCAN] + cors[ZEROCOR] + cors[DARKCOR] + cors[FLATCOR] + switch (op) { + case O: # overscan + do i = 1, n + out[i] = out[i] - overscan[i] + case Z: # zero level + if (zeroim != NULL) + do i = 1, n + out[i] = out[i] - zero[i] + else { + zeroval = zero[line] + do i = 1, n + out[i] = out[i] - zeroval + } + + case ZO: # zero level + overscan + if (zeroim != NULL) + do i = 1, n + out[i] = out[i] - overscan[i] - zero[i] + else { + zeroval = zero[line] + do i = 1, n + out[i] = out[i] - overscan[i] - zeroval + } + + case D: # dark count + do i = 1, n + out[i] = out[i] - darkscale * dark[i] + case DO: # dark count + overscan + do i = 1, n + out[i] = out[i] - overscan[i] - darkscale * dark[i] + case DZ: # dark count + zero level + if (zeroim != NULL) + do i = 1, n + out[i] = out[i] - zero[i] - darkscale * dark[i] + else { + zeroval = zero[line] + do i = 1, n + out[i] = out[i] - zeroval - darkscale * dark[i] + } + case DZO: # dark count + zero level + overscan + if (zeroim != NULL) + do i = 1, n + out[i] = out[i] - overscan[i] - zero[i] - + darkscale * dark[i] + else { + zeroval = zero[line] + do i = 1, n + out[i] = out[i] - overscan[i] - zeroval - + darkscale * dark[i] + } + + case F: # flat field + if (flatim != NULL) { + do i = 1, n + out[i] = out[i] * flatscale / flat[i] + } else { + flatval = flatscale / flat[line] + do i = 1, n + out[i] = out[i] * flatval + } + case FO: # flat field + overscan + if (flatim != NULL) { + do i = 1, n + out[i] = (out[i] - overscan[i]) * flatscale / flat[i] + } else { + flatval = flatscale / flat[line] + do i = 1, n + out[i] = (out[i] - overscan[i]) * flatval + } + case FZ: # flat field + zero level + if (flatim != NULL) { + if (zeroim != NULL) { + do i = 1, n + out[i] = (out[i] - zero[i]) * flatscale / flat[i] + } else { + zeroval = zero[line] + do i = 1, n + out[i] = (out[i] - zeroval) * flatscale / flat[i] + } + } else { + flatval = flatscale / flat[line] + if (zeroim != NULL) { + do i = 1, n + out[i] = (out[i] - zero[i]) * flatval + } else { + zeroval = zero[line] + do i = 1, n + out[i] = (out[i] - zeroval) * flatval + } + } + case FZO: # flat field + zero level + overscan + if (flatim != NULL) { + if (zeroim != NULL) { + do i = 1, n + out[i] = (out[i] - overscan[i] - zero[i]) * + flatscale / flat[i] + } else { + zeroval = zero[line] + do i = 1, n + out[i] = (out[i] - overscan[i] - zeroval) * + flatscale / flat[i] + } + } else { + flatval = flatscale / flat[line] + if (zeroim != NULL) { + do i = 1, n + out[i] = (out[i] - overscan[i] - zero[i]) * flatval + } else { + zeroval = zero[line] + do i = 1, n + out[i] = (out[i] - overscan[i] - zeroval) * flatval + } + } + case FD: # flat field + dark count + if (flatim != NULL) { + do i = 1, n + out[i] = (out[i] - darkscale * dark[i]) * flatscale/flat[i] + } else { + flatval = flatscale / flat[line] + do i = 1, n + out[i] = (out[i] - darkscale * dark[i]) * flatval + } + case FDO: # flat field + dark count + overscan + if (flatim != NULL) { + do i = 1, n + out[i] = (out[i] - overscan[i] - darkscale * dark[i]) * + flatscale / flat[i] + } else { + flatval = flatscale / flat[line] + do i = 1, n + out[i] = (out[i] - overscan[i] - darkscale * dark[i]) * + flatval + } + case FDZ: # flat field + dark count + zero level + if (flatim != NULL) { + if (zeroim != NULL) { + do i = 1, n + out[i] = (out[i] - zero[i] - darkscale * dark[i]) * + flatscale / flat[i] + } else { + zeroval = zero[line] + do i = 1, n + out[i] = (out[i] - zeroval - darkscale * dark[i]) * + flatscale / flat[i] + } + } else { + flatval = flatscale / flat[line] + if (zeroim != NULL) { + do i = 1, n + out[i] = (out[i] - zero[i] - darkscale * dark[i]) * + flatval + } else { + zeroval = zero[line] + do i = 1, n + out[i] = (out[i] - zeroval - darkscale * dark[i]) * + flatval + } + } + case FDZO: # flat field + dark count + zero level + overscan + if (flatim != NULL) { + if (zeroim != NULL) { + do i = 1, n + out[i] = (out[i] - overscan[i] - zero[i] - + darkscale * dark[i]) * flatscale / flat[i] + } else { + zeroval = zero[line] + do i = 1, n + out[i] = (out[i] - overscan[i] - zeroval - + darkscale * dark[i]) * flatscale / flat[i] + } + } else { + flatval = flatscale / flat[line] + if (zeroim != NULL) { + do i = 1, n + out[i] = (out[i] - overscan[i] - zero[i] - + darkscale * dark[i]) * flatval + } else { + zeroval = zero[line] + do i = 1, n + out[i] = (out[i] - overscan[i] - zeroval - + darkscale * dark[i]) * flatval + } + } + } + + # Often these operations will not be performed so test for no + # correction rather than go through the switch. + + op = cors[ILLUMCOR] + cors[FRINGECOR] + if (op != 0) { + switch (op) { + case I: # illumination + do i = 1, n + out[i] = out[i] * illumscale / illum[i] + case Q: # fringe + do i = 1, n + out[i] = out[i] - frgscale * fringe[i] + case QI: # fringe + illumination + do i = 1, n + out[i] = out[i]*illumscale/illum[i] - frgscale*fringe[i] + } + } +end + +# COR1 -- Correct image lines with readout axis 1 (lines). + +procedure cor1r (cors, out, overscan, zero, dark, flat, illum, + fringe, n, darkscale, flatscale, illumscale, frgscale) + +int cors[ARB] # Correction flags +real out[n] # Output data +real overscan # Overscan value +real zero[n] # Zero level correction +real dark[n] # Dark count correction +real flat[n] # Flat field correction +real illum[n] # Illumination correction +real fringe[n] # Fringe correction +int n # Number of pixels +real darkscale # Dark count scale factor +real flatscale # Flat field scale factor +real illumscale # Illumination scale factor +real frgscale # Fringe scale factor + +int i, op + +begin + op = cors[OVERSCAN] + cors[ZEROCOR] + cors[DARKCOR] + cors[FLATCOR] + switch (op) { + case O: # overscan + do i = 1, n + out[i] = out[i] - overscan + case Z: # zero level + do i = 1, n + out[i] = out[i] - zero[i] + + case ZO: # zero level + overscan + do i = 1, n + out[i] = out[i] - overscan - zero[i] + + case D: # dark count + do i = 1, n + out[i] = out[i] - darkscale * dark[i] + case DO: # dark count + overscan + do i = 1, n + out[i] = out[i] - overscan - darkscale * dark[i] + case DZ: # dark count + zero level + do i = 1, n + out[i] = out[i] - zero[i] - darkscale * dark[i] + case DZO: # dark count + zero level + overscan + do i = 1, n + out[i] = out[i] - overscan - zero[i] - darkscale * dark[i] + + case F: # flat field + do i = 1, n + out[i] = out[i] * flatscale / flat[i] + case FO: # flat field + overscan + do i = 1, n + out[i] = (out[i] - overscan) * flatscale / flat[i] + case FZ: # flat field + zero level + do i = 1, n + out[i] = (out[i] - zero[i]) * flatscale / flat[i] + case FZO: # flat field + zero level + overscan + do i = 1, n + out[i] = (out[i] - overscan - zero[i]) * flatscale / + flat[i] + case FD: # flat field + dark count + do i = 1, n + out[i] = (out[i] - darkscale * dark[i]) * flatscale / flat[i] + case FDO: # flat field + dark count + overscan + do i = 1, n + out[i] = (out[i] - overscan - darkscale * dark[i]) * + flatscale / flat[i] + case FDZ: # flat field + dark count + zero level + do i = 1, n + out[i] = (out[i] - zero[i] - darkscale * dark[i]) * + flatscale / flat[i] + case FDZO: # flat field + dark count + zero level + overscan + do i = 1, n + out[i] = (out[i] - overscan - zero[i] - + darkscale * dark[i]) * flatscale / flat[i] + } + + # Often these operations will not be performed so test for no + # correction rather than go through the switch. + + op = cors[ILLUMCOR] + cors[FRINGECOR] + if (op != 0) { + switch (op) { + case I: # illumination + do i = 1, n + out[i] = out[i] * illumscale / illum[i] + case Q: # fringe + do i = 1, n + out[i] = out[i] - frgscale * fringe[i] + case QI: # fringe + illumination + do i = 1, n + out[i] = out[i]*illumscale/illum[i] - frgscale*fringe[i] + } + } +end + + +# COR2 -- Correct lines for readout axis 2 (columns). This procedure is +# more complex than when the readout is along the image lines because the +# zero level and/or flat field corrections may be single readout column +# vectors. + +procedure cor2r (line, cors, out, overscan, zero, dark, flat, illum, + fringe, n, zeroim, flatim, darkscale, flatscale, illumscale, frgscale) + +int line # Line to be corrected +int cors[ARB] # Correction flags +real out[n] # Output data +real overscan[n] # Overscan value +real zero[n] # Zero level correction +real dark[n] # Dark count correction +real flat[n] # Flat field correction +real illum[n] # Illumination correction +real fringe[n] # Fringe correction +int n # Number of pixels +pointer zeroim # Zero level IMIO pointer (NULL if 1D vector) +pointer flatim # Flat field IMIO pointer (NULL if 1D vector) +real darkscale # Dark count scale factor +real flatscale # Flat field scale factor +real illumscale # Illumination scale factor +real frgscale # Fringe scale factor + +real zeroval +real flatval +int i, op + +begin + op = cors[OVERSCAN] + cors[ZEROCOR] + cors[DARKCOR] + cors[FLATCOR] + switch (op) { + case O: # overscan + do i = 1, n + out[i] = out[i] - overscan[i] + case Z: # zero level + if (zeroim != NULL) + do i = 1, n + out[i] = out[i] - zero[i] + else { + zeroval = zero[line] + do i = 1, n + out[i] = out[i] - zeroval + } + + case ZO: # zero level + overscan + if (zeroim != NULL) + do i = 1, n + out[i] = out[i] - overscan[i] - zero[i] + else { + zeroval = zero[line] + do i = 1, n + out[i] = out[i] - overscan[i] - zeroval + } + + case D: # dark count + do i = 1, n + out[i] = out[i] - darkscale * dark[i] + case DO: # dark count + overscan + do i = 1, n + out[i] = out[i] - overscan[i] - darkscale * dark[i] + case DZ: # dark count + zero level + if (zeroim != NULL) + do i = 1, n + out[i] = out[i] - zero[i] - darkscale * dark[i] + else { + zeroval = zero[line] + do i = 1, n + out[i] = out[i] - zeroval - darkscale * dark[i] + } + case DZO: # dark count + zero level + overscan + if (zeroim != NULL) + do i = 1, n + out[i] = out[i] - overscan[i] - zero[i] - + darkscale * dark[i] + else { + zeroval = zero[line] + do i = 1, n + out[i] = out[i] - overscan[i] - zeroval - + darkscale * dark[i] + } + + case F: # flat field + if (flatim != NULL) { + do i = 1, n + out[i] = out[i] * flatscale / flat[i] + } else { + flatval = flatscale / flat[line] + do i = 1, n + out[i] = out[i] * flatval + } + case FO: # flat field + overscan + if (flatim != NULL) { + do i = 1, n + out[i] = (out[i] - overscan[i]) * flatscale / flat[i] + } else { + flatval = flatscale / flat[line] + do i = 1, n + out[i] = (out[i] - overscan[i]) * flatval + } + case FZ: # flat field + zero level + if (flatim != NULL) { + if (zeroim != NULL) { + do i = 1, n + out[i] = (out[i] - zero[i]) * flatscale / flat[i] + } else { + zeroval = zero[line] + do i = 1, n + out[i] = (out[i] - zeroval) * flatscale / flat[i] + } + } else { + flatval = flatscale / flat[line] + if (zeroim != NULL) { + do i = 1, n + out[i] = (out[i] - zero[i]) * flatval + } else { + zeroval = zero[line] + do i = 1, n + out[i] = (out[i] - zeroval) * flatval + } + } + case FZO: # flat field + zero level + overscan + if (flatim != NULL) { + if (zeroim != NULL) { + do i = 1, n + out[i] = (out[i] - overscan[i] - zero[i]) * + flatscale / flat[i] + } else { + zeroval = zero[line] + do i = 1, n + out[i] = (out[i] - overscan[i] - zeroval) * + flatscale / flat[i] + } + } else { + flatval = flatscale / flat[line] + if (zeroim != NULL) { + do i = 1, n + out[i] = (out[i] - overscan[i] - zero[i]) * flatval + } else { + zeroval = zero[line] + do i = 1, n + out[i] = (out[i] - overscan[i] - zeroval) * flatval + } + } + case FD: # flat field + dark count + if (flatim != NULL) { + do i = 1, n + out[i] = (out[i] - darkscale * dark[i]) * flatscale/flat[i] + } else { + flatval = flatscale / flat[line] + do i = 1, n + out[i] = (out[i] - darkscale * dark[i]) * flatval + } + case FDO: # flat field + dark count + overscan + if (flatim != NULL) { + do i = 1, n + out[i] = (out[i] - overscan[i] - darkscale * dark[i]) * + flatscale / flat[i] + } else { + flatval = flatscale / flat[line] + do i = 1, n + out[i] = (out[i] - overscan[i] - darkscale * dark[i]) * + flatval + } + case FDZ: # flat field + dark count + zero level + if (flatim != NULL) { + if (zeroim != NULL) { + do i = 1, n + out[i] = (out[i] - zero[i] - darkscale * dark[i]) * + flatscale / flat[i] + } else { + zeroval = zero[line] + do i = 1, n + out[i] = (out[i] - zeroval - darkscale * dark[i]) * + flatscale / flat[i] + } + } else { + flatval = flatscale / flat[line] + if (zeroim != NULL) { + do i = 1, n + out[i] = (out[i] - zero[i] - darkscale * dark[i]) * + flatval + } else { + zeroval = zero[line] + do i = 1, n + out[i] = (out[i] - zeroval - darkscale * dark[i]) * + flatval + } + } + case FDZO: # flat field + dark count + zero level + overscan + if (flatim != NULL) { + if (zeroim != NULL) { + do i = 1, n + out[i] = (out[i] - overscan[i] - zero[i] - + darkscale * dark[i]) * flatscale / flat[i] + } else { + zeroval = zero[line] + do i = 1, n + out[i] = (out[i] - overscan[i] - zeroval - + darkscale * dark[i]) * flatscale / flat[i] + } + } else { + flatval = flatscale / flat[line] + if (zeroim != NULL) { + do i = 1, n + out[i] = (out[i] - overscan[i] - zero[i] - + darkscale * dark[i]) * flatval + } else { + zeroval = zero[line] + do i = 1, n + out[i] = (out[i] - overscan[i] - zeroval - + darkscale * dark[i]) * flatval + } + } + } + + # Often these operations will not be performed so test for no + # correction rather than go through the switch. + + op = cors[ILLUMCOR] + cors[FRINGECOR] + if (op != 0) { + switch (op) { + case I: # illumination + do i = 1, n + out[i] = out[i] * illumscale / illum[i] + case Q: # fringe + do i = 1, n + out[i] = out[i] - frgscale * fringe[i] + case QI: # fringe + illumination + do i = 1, n + out[i] = out[i]*illumscale/illum[i] - frgscale*fringe[i] + } + } +end diff --git a/noao/imred/ccdred/src/generic/icaclip.x b/noao/imred/ccdred/src/generic/icaclip.x new file mode 100644 index 00000000..1530145c --- /dev/null +++ b/noao/imred/ccdred/src/generic/icaclip.x @@ -0,0 +1,1102 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "../icombine.h" + +define MINCLIP 3 # Minimum number of images for this algorithm + + +# IC_AAVSIGCLIP -- Reject pixels using an average sigma about the average +# The average sigma is normalized by the expected poisson sigma. + +procedure ic_aavsigclips (d, m, n, scales, zeros, nimages, npts, average) + +pointer d[nimages] # Data pointers +pointer m[nimages] # Image id pointers +int n[npts] # Number of good pixels +real scales[nimages] # Scales +real zeros[nimages] # Zeros +int nimages # Number of images +int npts # Number of output points per line +real average[npts] # Average + +int i, j, k, l, jj, n1, n2, nin, nk, maxkeep +real d1, low, high, sum, a, s, s1, r, one +data one /1.0/ +pointer sp, sums, resid, dp1, dp2, mp1, mp2 + +include "../icombine.com" + +begin + # If there are insufficient pixels go on to the combining. + if (nkeep < 0) + maxkeep = max (0, nimages + nkeep) + else + maxkeep = min (nimages, nkeep) + if (nimages < max (MINCLIP, maxkeep+1) || dflag == D_NONE) { + docombine = true + return + } + + call smark (sp) + call salloc (sums, npts, TY_REAL) + call salloc (resid, nimages+1, TY_REAL) + + # Since the unweighted average is computed here possibly skip combining + if (dowts || combine != AVERAGE) + docombine = true + else + docombine = false + + # Compute the unweighted average with the high and low rejected and + # the poisson scaled average sigma. There must be at least three + # pixels at each point to define the average and contributions to + # the mean sigma. Corrections for differences in the image + # scale factors are selected by the doscale1 flag. + + nin = n[1] + s = 0. + n2 = 0 + do i = 1, npts { + k = i - 1 + n1 = n[i] + if (n1 < 3) + next + + # Unweighted average with the high and low rejected + low = Mems[d[1]+k] + high = Mems[d[2]+k] + if (low > high) { + d1 = low + low = high + high = d1 + } + sum = 0. + do j = 3, n1 { + d1 = Mems[d[j]+k] + if (d1 < low) { + sum = sum + low + low = d1 + } else if (d1 > high) { + sum = sum + high + high = d1 + } else + sum = sum + d1 + } + a = sum / (n1 - 2) + sum = sum + low + high + + # Poisson scaled sigma accumulation + if (doscale1) { + do j = 1, n1 { + dp1 = d[j] + k + mp1 = m[j] + k + + d1 = Mems[dp1] + l = Memi[mp1] + s1 = max (one, (a + zeros[l]) / scales[l]) + s = s + (d1 - a) ** 2 / s1 + } + } else { + s1 = max (one, a) + do j = 1, n1 + s = s + (Mems[d[j]+k] - a) ** 2 / s1 + } + n2 = n2 + n1 + + # Save the average and sum for later. + average[i] = a + Memr[sums+k] = sum + } + + # Here is the final sigma. + if (n2 > 1) + s = sqrt (s / (n2 - 1)) + + # Reject pixels and compute the final average (if needed). + # There must be at least three pixels at each point for rejection. + # Iteratively scale the mean sigma and reject pixels + # Compact the data and keep track of the image IDs if needed. + + do i = 1, npts { + k = i - 1 + n1 = n[i] + if (nkeep < 0) + maxkeep = max (0, n1 + nkeep) + else + maxkeep = min (n1, nkeep) + if (n1 <= max (2, maxkeep)) { + if (!docombine) { + if (n1 == 0) + average[i] = blank + else { + sum = Mems[d[1]+k] + do j = 2, n1 + sum = sum + Mems[d[j]+k] + average[i] = sum / n1 + } + } + next + } + + a = average[i] + sum = Memr[sums+k] + + repeat { + n2 = n1 + if (s > 0.) { + if (doscale1) { + for (j=1; j<=n1; j=j+1) { + dp1 = d[j] + k + mp1 = m[j] + k + + d1 = Mems[dp1] + l = Memi[mp1] + s1 = s * sqrt (max (one, (a+zeros[l]) / scales[l])) + r = (d1 - a) / s1 + if (r < -lsigma || r > hsigma) { + Memr[resid+n1] = abs(r) + if (j < n1) { + dp2 = d[n1] + k + Mems[dp1] = Mems[dp2] + Mems[dp2] = d1 + mp2 = m[n1] + k + Memi[mp1] = Memi[mp2] + Memi[mp2] = l + j = j - 1 + } + sum = sum - d1 + n1 = n1 - 1 + } + } + } else { + s1 = s * sqrt (max (one, a)) + for (j=1; j<=n1; j=j+1) { + dp1 = d[j] + k + d1 = Mems[dp1] + r = (d1 - a) / s1 + if (r < -lsigma || r > hsigma) { + Memr[resid+n1] = abs(r) + if (j < n1) { + dp2 = d[n1] + k + Mems[dp1] = Mems[dp2] + Mems[dp2] = d1 + if (keepids) { + mp1 = m[j] + k + mp2 = m[n1] + k + l = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = l + } + j = j - 1 + } + sum = sum - d1 + n1 = n1 - 1 + } + } + } + } + if (n1 > 1) + a = sum / n1 + } until (n1 == n2 || n1 <= max (2, maxkeep)) + + # If too many are rejected add some back in. + # Pixels with equal residuals are added together. + if (n1 < maxkeep) { + nk = maxkeep + if (doscale1) { + for (j=n1+1; j<=nk; j=j+1) { + dp1 = d[j] + k + mp1 = m[j] + k + r = Memr[resid+j] + jj = 0 + do l = j+1, n2 { + s = Memr[resid+l] + if (s < r + TOL) { + if (s > r - TOL) + jj = jj + 1 + else { + jj = 0 + Memr[resid+l] = r + r = s + dp2 = d[l] + k + d1 = Mems[dp1] + Mems[dp1] = Mems[dp2] + Mems[dp2] = d1 + mp2 = m[l] + k + s = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = s + } + } + } + sum = sum + Mems[dp1] + n1 = n1 + 1 + nk = max (nk, j+jj) + } + } else { + for (j=n1+1; j<=nk; j=j+1) { + dp1 = d[j] + k + r = Memr[resid+j] + jj = 0 + do l = j+1, n2 { + s = Memr[resid+l] + if (s < r + TOL) { + if (s > r - TOL) + jj = jj + 1 + else { + jj = 0 + Memr[resid+l] = r + r = s + dp2 = d[l] + k + d1 = Mems[dp1] + Mems[dp1] = Mems[dp2] + Mems[dp2] = d1 + if (keepids) { + mp1 = m[j] + k + mp2 = m[l] + k + s = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = s + } + } + } + } + sum = sum + Mems[dp1] + n1 = n1 + 1 + nk = max (nk, j+jj) + } + } + if (n1 > 1) + a = sum / n1 + } + + # Save the average if needed. + n[i] = n1 + if (!docombine) { + if (n1 > 0) + average[i] = a + else + average[i] = blank + } + } + + # Check if the data flag has to be reset for rejected pixels + if (dflag == D_ALL) { + do i = 1, npts { + if (n[i] != nin) { + dflag = D_MIX + break + } + } + } + + call sfree (sp) +end + + +# IC_MAVSIGCLIP -- Reject pixels using an average sigma about the median +# The average sigma is normalized by the expected poisson sigma. + +procedure ic_mavsigclips (d, m, n, scales, zeros, nimages, npts, median) + +pointer d[nimages] # Data pointers +pointer m[nimages] # Image id pointers +int n[npts] # Number of good pixels +real scales[nimages] # Scales +real zeros[nimages] # Zeros +int nimages # Number of images +int npts # Number of output points per line +real median[npts] # Median + +int i, j, k, l, id, n1, n2, n3, nl, nh, nin, maxkeep +pointer sp, resid, mp1, mp2 +real med, low, high, r, s, s1, one +data one /1.0/ + +include "../icombine.com" + +begin + # If there are insufficient pixels go on to the combining. + if (nkeep < 0) + maxkeep = max (0, nimages + nkeep) + else + maxkeep = min (nimages, nkeep) + if (nimages < max (MINCLIP, maxkeep+1) || dflag == D_NONE) { + docombine = true + return + } + + call smark (sp) + call salloc (resid, nimages+1, TY_REAL) + + # Compute the poisson scaled average sigma about the median. + # There must be at least three pixels at each point to define + # the mean sigma. Corrections for differences in the image + # scale factors are selected by the doscale1 flag. + + s = 0. + n2 = 0 + nin = n[1] + do i = 1, npts { + k = i - 1 + n1 = n[i] + if (n1 < 3) { + if (n1 == 0) + median[i] = blank + else if (n1 == 1) + median[i] = Mems[d[1]+k] + else { + low = Mems[d[1]+k] + high = Mems[d[2]+k] + median[i] = (low + high) / 2. + } + next + } + + # Median + n3 = 1 + n1 / 2 + if (mod (n1, 2) == 0) { + low = Mems[d[n3-1]+k] + high = Mems[d[n3]+k] + med = (low + high) / 2. + } else + med = Mems[d[n3]+k] + + # Poisson scaled sigma accumulation + if (doscale1) { + do j = 1, n1 { + l = Memi[m[j]+k] + s1 = max (one, (med + zeros[l]) / scales[l]) + s = s + (Mems[d[j]+k] - med) ** 2 / s1 + } + } else { + s1 = max (one, med) + do j = 1, n1 + s = s + (Mems[d[j]+k] - med) ** 2 / s1 + } + n2 = n2 + n1 + + # Save the median for later. + median[i] = med + } + + # Here is the final sigma. + if (n2 > 1) + s = sqrt (s / (n2 - 1)) + else + return + + # Compute individual sigmas and iteratively clip. + do i = 1, npts { + k = i - 1 + n1 = n[i] + if (nkeep < 0) + maxkeep = max (0, n1 + nkeep) + else + maxkeep = min (n1, nkeep) + if (n1 < max (3, maxkeep+1)) + next + nl = 1 + nh = n1 + med = median[i] + + repeat { + n2 = n1 + n3 = nl + n1 / 2 + + if (n1 >= max (MINCLIP, maxkeep+1) && s > 0.) { + if (doscale1) { + for (; nl <= n2; nl = nl + 1) { + l = Memi[m[nl]+k] + s1 = s * sqrt (max (one, (med+zeros[l])/scales[l])) + r = (med - Mems[d[nl]+k]) / s1 + if (r <= lsigma) + break + Memr[resid+nl] = r + n1 = n1 - 1 + } + for (; nh >= nl; nh = nh - 1) { + l = Memi[m[nh]+k] + s1 = s * sqrt (max (one, (med+zeros[l])/scales[l])) + r = (Mems[d[nh]+k] - med) / s1 + if (r <= hsigma) + break + Memr[resid+nh] = r + n1 = n1 - 1 + } + } else { + s1 = s * sqrt (max (one, med)) + for (; nl <= n2; nl = nl + 1) { + r = (med - Mems[d[nl]+k]) / s1 + if (r <= lsigma) + break + Memr[resid+nl] = r + n1 = n1 - 1 + } + for (; nh >= nl; nh = nh - 1) { + r = (Mems[d[nh]+k] - med) / s1 + if (r <= hsigma) + break + Memr[resid+nh] = r + n1 = n1 - 1 + } + } + + # Recompute median + if (n1 < n2) { + if (n1 > 0) { + n3 = nl + n1 / 2 + if (mod (n1, 2) == 0) { + low = Mems[d[n3-1]+k] + high = Mems[d[n3]+k] + med = (low + high) / 2. + } else + med = Mems[d[n3]+k] + } else + med = blank + } + } + } until (n1 == n2 || n1 < max (MINCLIP, maxkeep+1)) + + # If too many are rejected add some back in. + # Pixels with equal residuals are added together. + while (n1 < maxkeep) { + if (nl == 1) + nh = nh + 1 + else if (nh == n[i]) + nl = nl - 1 + else { + r = Memr[resid+nl-1] + s = Memr[resid+nh+1] + if (r < s) { + nl = nl - 1 + r = r + TOL + if (s <= r) + nh = nh + 1 + if (nl > 1) { + if (Memr[resid+nl-1] <= r) + nl = nl - 1 + } + } else { + nh = nh + 1 + s = s + TOL + if (r <= s) + nl = nl - 1 + if (nh < n2) { + if (Memr[resid+nh+1] <= s) + nh = nh + 1 + } + } + } + n1 = nh - nl + 1 + + # Recompute median + if (n1 < n2) { + if (n1 > 0) { + n3 = nl + n1 / 2 + if (mod (n1, 2) == 0) { + low = Mems[d[n3-1]+k] + high = Mems[d[n3]+k] + med = (low + high) / 2. + } else + med = Mems[d[n3]+k] + } else + med = blank + } + } + + # Only set median and reorder if needed + n[i] = n1 + if (n1 > 0 && nl > 1 && (combine != MEDIAN || grow > 0)) { + j = max (nl, n1 + 1) + if (keepids) { + do l = 1, min (n1, nl-1) { + Mems[d[l]+k] = Mems[d[j]+k] + if (grow > 0) { + mp1 = m[l] + k + mp2 = m[j] + k + id = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = id + } else + Memi[m[l]+k] = Memi[m[j]+k] + j = j + 1 + } + } else { + do l = 1, min (n1, nl - 1) { + Mems[d[l]+k] = Mems[d[j]+k] + j = j + 1 + } + } + } + + if (combine == MEDIAN) + median[i] = med + } + + # Check if data flag needs to be reset for rejected pixels + if (dflag == D_ALL) { + do i = 1, npts { + if (n[i] != nin) { + dflag = D_MIX + break + } + } + } + + # Flag that the median is computed. + if (combine == MEDIAN) + docombine = false + else + docombine = true + + call sfree (sp) +end + +# IC_AAVSIGCLIP -- Reject pixels using an average sigma about the average +# The average sigma is normalized by the expected poisson sigma. + +procedure ic_aavsigclipr (d, m, n, scales, zeros, nimages, npts, average) + +pointer d[nimages] # Data pointers +pointer m[nimages] # Image id pointers +int n[npts] # Number of good pixels +real scales[nimages] # Scales +real zeros[nimages] # Zeros +int nimages # Number of images +int npts # Number of output points per line +real average[npts] # Average + +int i, j, k, l, jj, n1, n2, nin, nk, maxkeep +real d1, low, high, sum, a, s, s1, r, one +data one /1.0/ +pointer sp, sums, resid, dp1, dp2, mp1, mp2 + +include "../icombine.com" + +begin + # If there are insufficient pixels go on to the combining. + if (nkeep < 0) + maxkeep = max (0, nimages + nkeep) + else + maxkeep = min (nimages, nkeep) + if (nimages < max (MINCLIP, maxkeep+1) || dflag == D_NONE) { + docombine = true + return + } + + call smark (sp) + call salloc (sums, npts, TY_REAL) + call salloc (resid, nimages+1, TY_REAL) + + # Since the unweighted average is computed here possibly skip combining + if (dowts || combine != AVERAGE) + docombine = true + else + docombine = false + + # Compute the unweighted average with the high and low rejected and + # the poisson scaled average sigma. There must be at least three + # pixels at each point to define the average and contributions to + # the mean sigma. Corrections for differences in the image + # scale factors are selected by the doscale1 flag. + + nin = n[1] + s = 0. + n2 = 0 + do i = 1, npts { + k = i - 1 + n1 = n[i] + if (n1 < 3) + next + + # Unweighted average with the high and low rejected + low = Memr[d[1]+k] + high = Memr[d[2]+k] + if (low > high) { + d1 = low + low = high + high = d1 + } + sum = 0. + do j = 3, n1 { + d1 = Memr[d[j]+k] + if (d1 < low) { + sum = sum + low + low = d1 + } else if (d1 > high) { + sum = sum + high + high = d1 + } else + sum = sum + d1 + } + a = sum / (n1 - 2) + sum = sum + low + high + + # Poisson scaled sigma accumulation + if (doscale1) { + do j = 1, n1 { + dp1 = d[j] + k + mp1 = m[j] + k + + d1 = Memr[dp1] + l = Memi[mp1] + s1 = max (one, (a + zeros[l]) / scales[l]) + s = s + (d1 - a) ** 2 / s1 + } + } else { + s1 = max (one, a) + do j = 1, n1 + s = s + (Memr[d[j]+k] - a) ** 2 / s1 + } + n2 = n2 + n1 + + # Save the average and sum for later. + average[i] = a + Memr[sums+k] = sum + } + + # Here is the final sigma. + if (n2 > 1) + s = sqrt (s / (n2 - 1)) + + # Reject pixels and compute the final average (if needed). + # There must be at least three pixels at each point for rejection. + # Iteratively scale the mean sigma and reject pixels + # Compact the data and keep track of the image IDs if needed. + + do i = 1, npts { + k = i - 1 + n1 = n[i] + if (nkeep < 0) + maxkeep = max (0, n1 + nkeep) + else + maxkeep = min (n1, nkeep) + if (n1 <= max (2, maxkeep)) { + if (!docombine) { + if (n1 == 0) + average[i] = blank + else { + sum = Memr[d[1]+k] + do j = 2, n1 + sum = sum + Memr[d[j]+k] + average[i] = sum / n1 + } + } + next + } + + a = average[i] + sum = Memr[sums+k] + + repeat { + n2 = n1 + if (s > 0.) { + if (doscale1) { + for (j=1; j<=n1; j=j+1) { + dp1 = d[j] + k + mp1 = m[j] + k + + d1 = Memr[dp1] + l = Memi[mp1] + s1 = s * sqrt (max (one, (a+zeros[l]) / scales[l])) + r = (d1 - a) / s1 + if (r < -lsigma || r > hsigma) { + Memr[resid+n1] = abs(r) + if (j < n1) { + dp2 = d[n1] + k + Memr[dp1] = Memr[dp2] + Memr[dp2] = d1 + mp2 = m[n1] + k + Memi[mp1] = Memi[mp2] + Memi[mp2] = l + j = j - 1 + } + sum = sum - d1 + n1 = n1 - 1 + } + } + } else { + s1 = s * sqrt (max (one, a)) + for (j=1; j<=n1; j=j+1) { + dp1 = d[j] + k + d1 = Memr[dp1] + r = (d1 - a) / s1 + if (r < -lsigma || r > hsigma) { + Memr[resid+n1] = abs(r) + if (j < n1) { + dp2 = d[n1] + k + Memr[dp1] = Memr[dp2] + Memr[dp2] = d1 + if (keepids) { + mp1 = m[j] + k + mp2 = m[n1] + k + l = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = l + } + j = j - 1 + } + sum = sum - d1 + n1 = n1 - 1 + } + } + } + } + if (n1 > 1) + a = sum / n1 + } until (n1 == n2 || n1 <= max (2, maxkeep)) + + # If too many are rejected add some back in. + # Pixels with equal residuals are added together. + if (n1 < maxkeep) { + nk = maxkeep + if (doscale1) { + for (j=n1+1; j<=nk; j=j+1) { + dp1 = d[j] + k + mp1 = m[j] + k + r = Memr[resid+j] + jj = 0 + do l = j+1, n2 { + s = Memr[resid+l] + if (s < r + TOL) { + if (s > r - TOL) + jj = jj + 1 + else { + jj = 0 + Memr[resid+l] = r + r = s + dp2 = d[l] + k + d1 = Memr[dp1] + Memr[dp1] = Memr[dp2] + Memr[dp2] = d1 + mp2 = m[l] + k + s = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = s + } + } + } + sum = sum + Memr[dp1] + n1 = n1 + 1 + nk = max (nk, j+jj) + } + } else { + for (j=n1+1; j<=nk; j=j+1) { + dp1 = d[j] + k + r = Memr[resid+j] + jj = 0 + do l = j+1, n2 { + s = Memr[resid+l] + if (s < r + TOL) { + if (s > r - TOL) + jj = jj + 1 + else { + jj = 0 + Memr[resid+l] = r + r = s + dp2 = d[l] + k + d1 = Memr[dp1] + Memr[dp1] = Memr[dp2] + Memr[dp2] = d1 + if (keepids) { + mp1 = m[j] + k + mp2 = m[l] + k + s = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = s + } + } + } + } + sum = sum + Memr[dp1] + n1 = n1 + 1 + nk = max (nk, j+jj) + } + } + if (n1 > 1) + a = sum / n1 + } + + # Save the average if needed. + n[i] = n1 + if (!docombine) { + if (n1 > 0) + average[i] = a + else + average[i] = blank + } + } + + # Check if the data flag has to be reset for rejected pixels + if (dflag == D_ALL) { + do i = 1, npts { + if (n[i] != nin) { + dflag = D_MIX + break + } + } + } + + call sfree (sp) +end + + +# IC_MAVSIGCLIP -- Reject pixels using an average sigma about the median +# The average sigma is normalized by the expected poisson sigma. + +procedure ic_mavsigclipr (d, m, n, scales, zeros, nimages, npts, median) + +pointer d[nimages] # Data pointers +pointer m[nimages] # Image id pointers +int n[npts] # Number of good pixels +real scales[nimages] # Scales +real zeros[nimages] # Zeros +int nimages # Number of images +int npts # Number of output points per line +real median[npts] # Median + +int i, j, k, l, id, n1, n2, n3, nl, nh, nin, maxkeep +pointer sp, resid, mp1, mp2 +real med, low, high, r, s, s1, one +data one /1.0/ + +include "../icombine.com" + +begin + # If there are insufficient pixels go on to the combining. + if (nkeep < 0) + maxkeep = max (0, nimages + nkeep) + else + maxkeep = min (nimages, nkeep) + if (nimages < max (MINCLIP, maxkeep+1) || dflag == D_NONE) { + docombine = true + return + } + + call smark (sp) + call salloc (resid, nimages+1, TY_REAL) + + # Compute the poisson scaled average sigma about the median. + # There must be at least three pixels at each point to define + # the mean sigma. Corrections for differences in the image + # scale factors are selected by the doscale1 flag. + + s = 0. + n2 = 0 + nin = n[1] + do i = 1, npts { + k = i - 1 + n1 = n[i] + if (n1 < 3) { + if (n1 == 0) + median[i] = blank + else if (n1 == 1) + median[i] = Memr[d[1]+k] + else { + low = Memr[d[1]+k] + high = Memr[d[2]+k] + median[i] = (low + high) / 2. + } + next + } + + # Median + n3 = 1 + n1 / 2 + if (mod (n1, 2) == 0) { + low = Memr[d[n3-1]+k] + high = Memr[d[n3]+k] + med = (low + high) / 2. + } else + med = Memr[d[n3]+k] + + # Poisson scaled sigma accumulation + if (doscale1) { + do j = 1, n1 { + l = Memi[m[j]+k] + s1 = max (one, (med + zeros[l]) / scales[l]) + s = s + (Memr[d[j]+k] - med) ** 2 / s1 + } + } else { + s1 = max (one, med) + do j = 1, n1 + s = s + (Memr[d[j]+k] - med) ** 2 / s1 + } + n2 = n2 + n1 + + # Save the median for later. + median[i] = med + } + + # Here is the final sigma. + if (n2 > 1) + s = sqrt (s / (n2 - 1)) + else + return + + # Compute individual sigmas and iteratively clip. + do i = 1, npts { + k = i - 1 + n1 = n[i] + if (nkeep < 0) + maxkeep = max (0, n1 + nkeep) + else + maxkeep = min (n1, nkeep) + if (n1 < max (3, maxkeep+1)) + next + nl = 1 + nh = n1 + med = median[i] + + repeat { + n2 = n1 + n3 = nl + n1 / 2 + + if (n1 >= max (MINCLIP, maxkeep+1) && s > 0.) { + if (doscale1) { + for (; nl <= n2; nl = nl + 1) { + l = Memi[m[nl]+k] + s1 = s * sqrt (max (one, (med+zeros[l])/scales[l])) + r = (med - Memr[d[nl]+k]) / s1 + if (r <= lsigma) + break + Memr[resid+nl] = r + n1 = n1 - 1 + } + for (; nh >= nl; nh = nh - 1) { + l = Memi[m[nh]+k] + s1 = s * sqrt (max (one, (med+zeros[l])/scales[l])) + r = (Memr[d[nh]+k] - med) / s1 + if (r <= hsigma) + break + Memr[resid+nh] = r + n1 = n1 - 1 + } + } else { + s1 = s * sqrt (max (one, med)) + for (; nl <= n2; nl = nl + 1) { + r = (med - Memr[d[nl]+k]) / s1 + if (r <= lsigma) + break + Memr[resid+nl] = r + n1 = n1 - 1 + } + for (; nh >= nl; nh = nh - 1) { + r = (Memr[d[nh]+k] - med) / s1 + if (r <= hsigma) + break + Memr[resid+nh] = r + n1 = n1 - 1 + } + } + + # Recompute median + if (n1 < n2) { + if (n1 > 0) { + n3 = nl + n1 / 2 + if (mod (n1, 2) == 0) { + low = Memr[d[n3-1]+k] + high = Memr[d[n3]+k] + med = (low + high) / 2. + } else + med = Memr[d[n3]+k] + } else + med = blank + } + } + } until (n1 == n2 || n1 < max (MINCLIP, maxkeep+1)) + + # If too many are rejected add some back in. + # Pixels with equal residuals are added together. + while (n1 < maxkeep) { + if (nl == 1) + nh = nh + 1 + else if (nh == n[i]) + nl = nl - 1 + else { + r = Memr[resid+nl-1] + s = Memr[resid+nh+1] + if (r < s) { + nl = nl - 1 + r = r + TOL + if (s <= r) + nh = nh + 1 + if (nl > 1) { + if (Memr[resid+nl-1] <= r) + nl = nl - 1 + } + } else { + nh = nh + 1 + s = s + TOL + if (r <= s) + nl = nl - 1 + if (nh < n2) { + if (Memr[resid+nh+1] <= s) + nh = nh + 1 + } + } + } + n1 = nh - nl + 1 + + # Recompute median + if (n1 < n2) { + if (n1 > 0) { + n3 = nl + n1 / 2 + if (mod (n1, 2) == 0) { + low = Memr[d[n3-1]+k] + high = Memr[d[n3]+k] + med = (low + high) / 2. + } else + med = Memr[d[n3]+k] + } else + med = blank + } + } + + # Only set median and reorder if needed + n[i] = n1 + if (n1 > 0 && nl > 1 && (combine != MEDIAN || grow > 0)) { + j = max (nl, n1 + 1) + if (keepids) { + do l = 1, min (n1, nl-1) { + Memr[d[l]+k] = Memr[d[j]+k] + if (grow > 0) { + mp1 = m[l] + k + mp2 = m[j] + k + id = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = id + } else + Memi[m[l]+k] = Memi[m[j]+k] + j = j + 1 + } + } else { + do l = 1, min (n1, nl - 1) { + Memr[d[l]+k] = Memr[d[j]+k] + j = j + 1 + } + } + } + + if (combine == MEDIAN) + median[i] = med + } + + # Check if data flag needs to be reset for rejected pixels + if (dflag == D_ALL) { + do i = 1, npts { + if (n[i] != nin) { + dflag = D_MIX + break + } + } + } + + # Flag that the median is computed. + if (combine == MEDIAN) + docombine = false + else + docombine = true + + call sfree (sp) +end diff --git a/noao/imred/ccdred/src/generic/icaverage.x b/noao/imred/ccdred/src/generic/icaverage.x new file mode 100644 index 00000000..3646b725 --- /dev/null +++ b/noao/imred/ccdred/src/generic/icaverage.x @@ -0,0 +1,163 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> +include "../icombine.h" + + +# IC_AVERAGE -- Compute the average image line. +# Options include a weight average. + +procedure ic_averages (d, m, n, wts, npts, average) + +pointer d[ARB] # Data pointers +pointer m[ARB] # Image ID pointers +int n[npts] # Number of points +real wts[ARB] # Weights +int npts # Number of output points per line +real average[npts] # Average (returned) + +int i, j, k +real sumwt, wt +real sum + +include "../icombine.com" + +begin + # If no data has been excluded do the average without checking the + # number of points and using the fact that the weights are normalized. + # If all the data has been excluded set the average to the blank value. + + if (dflag == D_ALL) { + if (dowts) { + do i = 1, npts { + k = i - 1 + wt = wts[Memi[m[1]+k]] + sum = Mems[d[1]+k] * wt + do j = 2, n[i] { + wt = wts[Memi[m[j]+k]] + sum = sum + Mems[d[j]+k] * wt + } + average[i] = sum + } + } else { + do i = 1, npts { + k = i - 1 + sum = Mems[d[1]+k] + do j = 2, n[i] + sum = sum + Mems[d[j]+k] + average[i] = sum / n[i] + } + } + } else if (dflag == D_NONE) { + do i = 1, npts + average[i] = blank + } else { + if (dowts) { + do i = 1, npts { + if (n[i] > 0) { + k = i - 1 + wt = wts[Memi[m[1]+k]] + sum = Mems[d[1]+k] * wt + sumwt = wt + do j = 2, n[i] { + wt = wts[Memi[m[j]+k]] + sum = sum + Mems[d[j]+k] * wt + sumwt = sumwt + wt + } + average[i] = sum / sumwt + } else + average[i] = blank + } + } else { + do i = 1, npts { + if (n[i] > 0) { + k = i - 1 + sum = Mems[d[1]+k] + do j = 2, n[i] + sum = sum + Mems[d[j]+k] + average[i] = sum / n[i] + } else + average[i] = blank + } + } + } +end + +# IC_AVERAGE -- Compute the average image line. +# Options include a weight average. + +procedure ic_averager (d, m, n, wts, npts, average) + +pointer d[ARB] # Data pointers +pointer m[ARB] # Image ID pointers +int n[npts] # Number of points +real wts[ARB] # Weights +int npts # Number of output points per line +real average[npts] # Average (returned) + +int i, j, k +real sumwt, wt +real sum + +include "../icombine.com" + +begin + # If no data has been excluded do the average without checking the + # number of points and using the fact that the weights are normalized. + # If all the data has been excluded set the average to the blank value. + + if (dflag == D_ALL) { + if (dowts) { + do i = 1, npts { + k = i - 1 + wt = wts[Memi[m[1]+k]] + sum = Memr[d[1]+k] * wt + do j = 2, n[i] { + wt = wts[Memi[m[j]+k]] + sum = sum + Memr[d[j]+k] * wt + } + average[i] = sum + } + } else { + do i = 1, npts { + k = i - 1 + sum = Memr[d[1]+k] + do j = 2, n[i] + sum = sum + Memr[d[j]+k] + average[i] = sum / n[i] + } + } + } else if (dflag == D_NONE) { + do i = 1, npts + average[i] = blank + } else { + if (dowts) { + do i = 1, npts { + if (n[i] > 0) { + k = i - 1 + wt = wts[Memi[m[1]+k]] + sum = Memr[d[1]+k] * wt + sumwt = wt + do j = 2, n[i] { + wt = wts[Memi[m[j]+k]] + sum = sum + Memr[d[j]+k] * wt + sumwt = sumwt + wt + } + average[i] = sum / sumwt + } else + average[i] = blank + } + } else { + do i = 1, npts { + if (n[i] > 0) { + k = i - 1 + sum = Memr[d[1]+k] + do j = 2, n[i] + sum = sum + Memr[d[j]+k] + average[i] = sum / n[i] + } else + average[i] = blank + } + } + } +end diff --git a/noao/imred/ccdred/src/generic/iccclip.x b/noao/imred/ccdred/src/generic/iccclip.x new file mode 100644 index 00000000..57709064 --- /dev/null +++ b/noao/imred/ccdred/src/generic/iccclip.x @@ -0,0 +1,898 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "../icombine.h" + +define MINCLIP 2 # Mininum number of images for algorithm + + +# IC_ACCDCLIP -- Reject pixels using CCD noise parameters about the average + +procedure ic_accdclips (d, m, n, scales, zeros, nm, nimages, npts, average) + +pointer d[nimages] # Data pointers +pointer m[nimages] # Image id pointers +int n[npts] # Number of good pixels +real scales[nimages] # Scales +real zeros[nimages] # Zeros +real nm[3,nimages] # Noise model parameters +int nimages # Number of images +int npts # Number of output points per line +real average[npts] # Average + +int i, j, k, l, jj, n1, n2, nin, nk, maxkeep +real d1, low, high, sum, a, s, r, zero +data zero /0.0/ +pointer sp, resid, dp1, dp2, mp1, mp2 + +include "../icombine.com" + +begin + # If there are no pixels go on to the combining. Since the unweighted + # average is computed here possibly skip the combining later. + + # There must be at least max (1, nkeep) pixels. + if (nkeep < 0) + maxkeep = max (0, nimages + nkeep) + else + maxkeep = min (nimages, nkeep) + if (nimages < max (MINCLIP, maxkeep+1) || dflag == D_NONE) { + docombine = true + return + } else if (dowts || combine != AVERAGE) + docombine = true + else + docombine = false + + call smark (sp) + call salloc (resid, nimages+1, TY_REAL) + + # There must be at least two pixels for rejection. The initial + # average is the low/high rejected average except in the case of + # just two pixels. The rejections are iterated and the average + # is recomputed. Corrections for scaling may be performed. + # Depending on other flags the image IDs may also need to be adjusted. + + nin = n[1] + do i = 1, npts { + k = i - 1 + n1 = n[i] + if (nkeep < 0) + maxkeep = max (0, n1 + nkeep) + else + maxkeep = min (n1, nkeep) + if (n1 <= max (MINCLIP-1, maxkeep)) { + if (!docombine) { + if (n1 == 0) + average[i] = blank + else { + sum = Mems[d[1]+k] + do j = 2, n1 + sum = sum + Mems[d[j]+k] + average[i] = sum / n1 + } + } + next + } + + repeat { + if (n1 == 2) { + sum = Mems[d[1]+k] + sum = sum + Mems[d[2]+k] + a = sum / 2 + } else { + low = Mems[d[1]+k] + high = Mems[d[2]+k] + if (low > high) { + d1 = low + low = high + high = d1 + } + sum = 0. + do j = 3, n1 { + d1 = Mems[d[j]+k] + if (d1 < low) { + sum = sum + low + low = d1 + } else if (d1 > high) { + sum = sum + high + high = d1 + } else + sum = sum + d1 + } + a = sum / (n1 - 2) + sum = sum + low + high + } + n2 = n1 + if (doscale1) { + for (j=1; j<=n1; j=j+1) { + dp1 = d[j] + k + mp1 = m[j] + k + + l = Memi[mp1] + s = scales[l] + d1 = max (zero, s * (a + zeros[l])) + s = sqrt (nm[1,l] + d1/nm[2,l] + (d1*nm[3,l])**2) / s + + d1 = Mems[dp1] + r = (d1 - a) / s + if (r < -lsigma || r > hsigma) { + Memr[resid+n1] = abs(r) + if (j < n1) { + dp2 = d[n1] + k + Mems[dp1] = Mems[dp2] + Mems[dp2] = d1 + mp2 = m[n1] + k + Memi[mp1] = Memi[mp2] + Memi[mp2] = l + j = j - 1 + } + sum = sum - d1 + n1 = n1 - 1 + } + } + } else { + if (!keepids) { + s = max (zero, a) + s = sqrt (nm[1,1] + s/nm[2,1] + (s*nm[3,1])**2) + } + for (j=1; j<=n1; j=j+1) { + if (keepids) { + l = Memi[m[j]+k] + s = max (zero, a) + s = sqrt (nm[1,l] + s/nm[2,l] + (s*nm[3,l])**2) + } + dp1 = d[j] + k + d1 = Mems[dp1] + r = (d1 - a) / s + if (r < -lsigma || r > hsigma) { + Memr[resid+n1] = abs(r) + if (j < n1) { + dp2 = d[n1] + k + Mems[dp1] = Mems[dp2] + Mems[dp2] = d1 + if (keepids) { + mp1 = m[j] + k + mp2 = m[n1] + k + l = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = l + } + j = j - 1 + } + sum = sum - d1 + n1 = n1 - 1 + } + } + } + } until (n1 == n2 || n1 < max (MINCLIP, maxkeep+1)) + + if (n1 < maxkeep) { + nk = maxkeep + if (doscale1) { + for (j=n1+1; j<=nk; j=j+1) { + dp1 = d[j] + k + mp1 = m[j] + k + r = Memr[resid+j] + jj = 0 + do l = j+1, n2 { + s = Memr[resid+l] + if (s < r + TOL) { + if (s > r - TOL) + jj = jj + 1 + else { + jj = 0 + Memr[resid+l] = r + r = s + dp2 = d[l] + k + d1 = Mems[dp1] + Mems[dp1] = Mems[dp2] + Mems[dp2] = d1 + mp2 = m[l] + k + s = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = s + } + } + } + sum = sum + Mems[dp1] + n1 = n1 + 1 + nk = max (nk, j+jj) + } + } else { + for (j=n1+1; j<=nk; j=j+1) { + dp1 = d[j] + k + r = Memr[resid+j] + jj = 0 + do l = j+1, n2 { + s = Memr[resid+l] + if (s < r + TOL) { + if (s > r - TOL) + jj = jj + 1 + else { + jj = 0 + Memr[resid+l] = r + r = s + dp2 = d[l] + k + d1 = Mems[dp1] + Mems[dp1] = Mems[dp2] + Mems[dp2] = d1 + if (keepids) { + mp1 = m[j] + k + mp2 = m[l] + k + s = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = s + } + } + } + } + sum = sum + Mems[dp1] + n1 = n1 + 1 + nk = max (nk, j+jj) + } + } + } + + n[i] = n1 + if (!docombine) + if (n1 > 0) + average[i] = sum / n1 + else + average[i] = blank + } + + # Check if the data flag has to be reset for rejected pixels + if (dflag == D_ALL) { + do i = 1, npts { + if (n[i] != nin) { + dflag = D_MIX + break + } + } + } + + call sfree (sp) +end + + +# IC_CCDCLIP -- Reject pixels using CCD noise parameters about the median + +procedure ic_mccdclips (d, m, n, scales, zeros, nm, nimages, npts, median) + +pointer d[nimages] # Data pointers +pointer m[nimages] # Image id pointers +int n[npts] # Number of good pixels +real scales[nimages] # Scales +real zeros[nimages] # Zeros +real nm[3,nimages] # Noise model +int nimages # Number of images +int npts # Number of output points per line +real median[npts] # Median + +int i, j, k, l, id, n1, n2, n3, nl, nh, nin, maxkeep +real r, s +pointer sp, resid, mp1, mp2 +real med, zero +data zero /0.0/ + +include "../icombine.com" + +begin + # There must be at least max (MINCLIP, nkeep+1) pixels. + if (nkeep < 0) + maxkeep = max (0, nimages + nkeep) + else + maxkeep = min (nimages, nkeep) + if (nimages < max (MINCLIP, maxkeep+1) || dflag == D_NONE) { + docombine = true + return + } + + call smark (sp) + call salloc (resid, nimages+1, TY_REAL) + + # Compute median and sigma and iteratively clip. + nin = n[1] + do i = 1, npts { + k = i - 1 + n1 = n[i] + if (nkeep < 0) + maxkeep = max (0, n1 + nkeep) + else + maxkeep = min (n1, nkeep) + nl = 1 + nh = n1 + + repeat { + n2 = n1 + n3 = nl + n1 / 2 + + if (n1 == 0) + med = blank + else if (mod (n1, 2) == 0) { + med = Mems[d[n3-1]+k] + med = (med + Mems[d[n3]+k]) / 2. + } else + med = Mems[d[n3]+k] + + if (n1 >= max (MINCLIP, maxkeep+1)) { + if (doscale1) { + for (; nl <= n2; nl = nl + 1) { + l = Memi[m[nl]+k] + s = scales[l] + r = max (zero, s * (med + zeros[l])) + s = sqrt (nm[1,l] + r/nm[2,l] + (r*nm[3,l])**2) / s + r = (med - Mems[d[nl]+k]) / s + if (r <= lsigma) + break + Memr[resid+nl] = r + n1 = n1 - 1 + } + for (; nh >= nl; nh = nh - 1) { + l = Memi[m[nh]+k] + s = scales[l] + r = max (zero, s * (med + zeros[l])) + s = sqrt (nm[1,l] + r/nm[2,l] + (r*nm[3,l])**2) / s + r = (Mems[d[nh]+k] - med) / s + if (r <= hsigma) + break + Memr[resid+nh] = r + n1 = n1 - 1 + } + } else { + if (!keepids) { + s = max (zero, med) + s = sqrt (nm[1,1] + s/nm[2,1] + (s*nm[3,1])**2) + } + for (; nl <= n2; nl = nl + 1) { + if (keepids) { + l = Memi[m[nl]+k] + s = max (zero, med) + s = sqrt (nm[1,l] + s/nm[2,l] + (s*nm[3,l])**2) + } + r = (med - Mems[d[nl]+k]) / s + if (r <= lsigma) + break + Memr[resid+nl] = r + n1 = n1 - 1 + } + for (; nh >= nl; nh = nh - 1) { + if (keepids) { + l = Memi[m[nh]+k] + s = max (zero, med) + s = sqrt (nm[1,l] + s/nm[2,l] + (s*nm[3,l])**2) + } + r = (Mems[d[nh]+k] - med) / s + if (r <= hsigma) + break + Memr[resid+nh] = r + n1 = n1 - 1 + } + } + } + } until (n1 == n2 || n1 < max (MINCLIP, maxkeep+1)) + + while (n1 < maxkeep) { + if (nl == 1) + nh = nh + 1 + else if (nh == n[i]) + nl = nl - 1 + else { + r = Memr[resid+nl-1] + s = Memr[resid+nh+1] + if (r < s) { + nl = nl - 1 + r = r + TOL + if (s <= r) + nh = nh + 1 + if (nl > 1) { + if (Memr[resid+nl-1] <= r) + nl = nl - 1 + } + } else { + nh = nh + 1 + s = s + TOL + if (r <= s) + nl = nl - 1 + if (nh < n2) { + if (Memr[resid+nh+1] <= s) + nh = nh + 1 + } + } + } + n1 = nh - nl + 1 + } + + # Only set median and reorder if needed + n[i] = n1 + if (n1 > 0 && nl > 1 && (combine != MEDIAN || grow > 0)) { + j = max (nl, n1 + 1) + if (keepids) { + do l = 1, min (n1, nl-1) { + Mems[d[l]+k] = Mems[d[j]+k] + if (grow > 0) { + mp1 = m[l] + k + mp2 = m[j] + k + id = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = id + } else + Memi[m[l]+k] = Memi[m[j]+k] + j = j + 1 + } + } else { + do l = 1, min (n1, nl - 1) { + Mems[d[l]+k] = Mems[d[j]+k] + j = j + 1 + } + } + } + + if (combine == MEDIAN) + median[i] = med + } + + # Check if data flag needs to be reset for rejected pixels + if (dflag == D_ALL) { + do i = 1, npts { + if (n[i] != nin) { + dflag = D_MIX + break + } + } + } + + # Flag that the median is computed. + if (combine == MEDIAN) + docombine = false + else + docombine = true + + call sfree (sp) +end + +# IC_ACCDCLIP -- Reject pixels using CCD noise parameters about the average + +procedure ic_accdclipr (d, m, n, scales, zeros, nm, nimages, npts, average) + +pointer d[nimages] # Data pointers +pointer m[nimages] # Image id pointers +int n[npts] # Number of good pixels +real scales[nimages] # Scales +real zeros[nimages] # Zeros +real nm[3,nimages] # Noise model parameters +int nimages # Number of images +int npts # Number of output points per line +real average[npts] # Average + +int i, j, k, l, jj, n1, n2, nin, nk, maxkeep +real d1, low, high, sum, a, s, r, zero +data zero /0.0/ +pointer sp, resid, dp1, dp2, mp1, mp2 + +include "../icombine.com" + +begin + # If there are no pixels go on to the combining. Since the unweighted + # average is computed here possibly skip the combining later. + + # There must be at least max (1, nkeep) pixels. + if (nkeep < 0) + maxkeep = max (0, nimages + nkeep) + else + maxkeep = min (nimages, nkeep) + if (nimages < max (MINCLIP, maxkeep+1) || dflag == D_NONE) { + docombine = true + return + } else if (dowts || combine != AVERAGE) + docombine = true + else + docombine = false + + call smark (sp) + call salloc (resid, nimages+1, TY_REAL) + + # There must be at least two pixels for rejection. The initial + # average is the low/high rejected average except in the case of + # just two pixels. The rejections are iterated and the average + # is recomputed. Corrections for scaling may be performed. + # Depending on other flags the image IDs may also need to be adjusted. + + nin = n[1] + do i = 1, npts { + k = i - 1 + n1 = n[i] + if (nkeep < 0) + maxkeep = max (0, n1 + nkeep) + else + maxkeep = min (n1, nkeep) + if (n1 <= max (MINCLIP-1, maxkeep)) { + if (!docombine) { + if (n1 == 0) + average[i] = blank + else { + sum = Memr[d[1]+k] + do j = 2, n1 + sum = sum + Memr[d[j]+k] + average[i] = sum / n1 + } + } + next + } + + repeat { + if (n1 == 2) { + sum = Memr[d[1]+k] + sum = sum + Memr[d[2]+k] + a = sum / 2 + } else { + low = Memr[d[1]+k] + high = Memr[d[2]+k] + if (low > high) { + d1 = low + low = high + high = d1 + } + sum = 0. + do j = 3, n1 { + d1 = Memr[d[j]+k] + if (d1 < low) { + sum = sum + low + low = d1 + } else if (d1 > high) { + sum = sum + high + high = d1 + } else + sum = sum + d1 + } + a = sum / (n1 - 2) + sum = sum + low + high + } + n2 = n1 + if (doscale1) { + for (j=1; j<=n1; j=j+1) { + dp1 = d[j] + k + mp1 = m[j] + k + + l = Memi[mp1] + s = scales[l] + d1 = max (zero, s * (a + zeros[l])) + s = sqrt (nm[1,l] + d1/nm[2,l] + (d1*nm[3,l])**2) / s + + d1 = Memr[dp1] + r = (d1 - a) / s + if (r < -lsigma || r > hsigma) { + Memr[resid+n1] = abs(r) + if (j < n1) { + dp2 = d[n1] + k + Memr[dp1] = Memr[dp2] + Memr[dp2] = d1 + mp2 = m[n1] + k + Memi[mp1] = Memi[mp2] + Memi[mp2] = l + j = j - 1 + } + sum = sum - d1 + n1 = n1 - 1 + } + } + } else { + if (!keepids) { + s = max (zero, a) + s = sqrt (nm[1,1] + s/nm[2,1] + (s*nm[3,1])**2) + } + for (j=1; j<=n1; j=j+1) { + if (keepids) { + l = Memi[m[j]+k] + s = max (zero, a) + s = sqrt (nm[1,l] + s/nm[2,l] + (s*nm[3,l])**2) + } + dp1 = d[j] + k + d1 = Memr[dp1] + r = (d1 - a) / s + if (r < -lsigma || r > hsigma) { + Memr[resid+n1] = abs(r) + if (j < n1) { + dp2 = d[n1] + k + Memr[dp1] = Memr[dp2] + Memr[dp2] = d1 + if (keepids) { + mp1 = m[j] + k + mp2 = m[n1] + k + l = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = l + } + j = j - 1 + } + sum = sum - d1 + n1 = n1 - 1 + } + } + } + } until (n1 == n2 || n1 < max (MINCLIP, maxkeep+1)) + + if (n1 < maxkeep) { + nk = maxkeep + if (doscale1) { + for (j=n1+1; j<=nk; j=j+1) { + dp1 = d[j] + k + mp1 = m[j] + k + r = Memr[resid+j] + jj = 0 + do l = j+1, n2 { + s = Memr[resid+l] + if (s < r + TOL) { + if (s > r - TOL) + jj = jj + 1 + else { + jj = 0 + Memr[resid+l] = r + r = s + dp2 = d[l] + k + d1 = Memr[dp1] + Memr[dp1] = Memr[dp2] + Memr[dp2] = d1 + mp2 = m[l] + k + s = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = s + } + } + } + sum = sum + Memr[dp1] + n1 = n1 + 1 + nk = max (nk, j+jj) + } + } else { + for (j=n1+1; j<=nk; j=j+1) { + dp1 = d[j] + k + r = Memr[resid+j] + jj = 0 + do l = j+1, n2 { + s = Memr[resid+l] + if (s < r + TOL) { + if (s > r - TOL) + jj = jj + 1 + else { + jj = 0 + Memr[resid+l] = r + r = s + dp2 = d[l] + k + d1 = Memr[dp1] + Memr[dp1] = Memr[dp2] + Memr[dp2] = d1 + if (keepids) { + mp1 = m[j] + k + mp2 = m[l] + k + s = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = s + } + } + } + } + sum = sum + Memr[dp1] + n1 = n1 + 1 + nk = max (nk, j+jj) + } + } + } + + n[i] = n1 + if (!docombine) + if (n1 > 0) + average[i] = sum / n1 + else + average[i] = blank + } + + # Check if the data flag has to be reset for rejected pixels + if (dflag == D_ALL) { + do i = 1, npts { + if (n[i] != nin) { + dflag = D_MIX + break + } + } + } + + call sfree (sp) +end + + +# IC_CCDCLIP -- Reject pixels using CCD noise parameters about the median + +procedure ic_mccdclipr (d, m, n, scales, zeros, nm, nimages, npts, median) + +pointer d[nimages] # Data pointers +pointer m[nimages] # Image id pointers +int n[npts] # Number of good pixels +real scales[nimages] # Scales +real zeros[nimages] # Zeros +real nm[3,nimages] # Noise model +int nimages # Number of images +int npts # Number of output points per line +real median[npts] # Median + +int i, j, k, l, id, n1, n2, n3, nl, nh, nin, maxkeep +real r, s +pointer sp, resid, mp1, mp2 +real med, zero +data zero /0.0/ + +include "../icombine.com" + +begin + # There must be at least max (MINCLIP, nkeep+1) pixels. + if (nkeep < 0) + maxkeep = max (0, nimages + nkeep) + else + maxkeep = min (nimages, nkeep) + if (nimages < max (MINCLIP, maxkeep+1) || dflag == D_NONE) { + docombine = true + return + } + + call smark (sp) + call salloc (resid, nimages+1, TY_REAL) + + # Compute median and sigma and iteratively clip. + nin = n[1] + do i = 1, npts { + k = i - 1 + n1 = n[i] + if (nkeep < 0) + maxkeep = max (0, n1 + nkeep) + else + maxkeep = min (n1, nkeep) + nl = 1 + nh = n1 + + repeat { + n2 = n1 + n3 = nl + n1 / 2 + + if (n1 == 0) + med = blank + else if (mod (n1, 2) == 0) { + med = Memr[d[n3-1]+k] + med = (med + Memr[d[n3]+k]) / 2. + } else + med = Memr[d[n3]+k] + + if (n1 >= max (MINCLIP, maxkeep+1)) { + if (doscale1) { + for (; nl <= n2; nl = nl + 1) { + l = Memi[m[nl]+k] + s = scales[l] + r = max (zero, s * (med + zeros[l])) + s = sqrt (nm[1,l] + r/nm[2,l] + (r*nm[3,l])**2) / s + r = (med - Memr[d[nl]+k]) / s + if (r <= lsigma) + break + Memr[resid+nl] = r + n1 = n1 - 1 + } + for (; nh >= nl; nh = nh - 1) { + l = Memi[m[nh]+k] + s = scales[l] + r = max (zero, s * (med + zeros[l])) + s = sqrt (nm[1,l] + r/nm[2,l] + (r*nm[3,l])**2) / s + r = (Memr[d[nh]+k] - med) / s + if (r <= hsigma) + break + Memr[resid+nh] = r + n1 = n1 - 1 + } + } else { + if (!keepids) { + s = max (zero, med) + s = sqrt (nm[1,1] + s/nm[2,1] + (s*nm[3,1])**2) + } + for (; nl <= n2; nl = nl + 1) { + if (keepids) { + l = Memi[m[nl]+k] + s = max (zero, med) + s = sqrt (nm[1,l] + s/nm[2,l] + (s*nm[3,l])**2) + } + r = (med - Memr[d[nl]+k]) / s + if (r <= lsigma) + break + Memr[resid+nl] = r + n1 = n1 - 1 + } + for (; nh >= nl; nh = nh - 1) { + if (keepids) { + l = Memi[m[nh]+k] + s = max (zero, med) + s = sqrt (nm[1,l] + s/nm[2,l] + (s*nm[3,l])**2) + } + r = (Memr[d[nh]+k] - med) / s + if (r <= hsigma) + break + Memr[resid+nh] = r + n1 = n1 - 1 + } + } + } + } until (n1 == n2 || n1 < max (MINCLIP, maxkeep+1)) + + while (n1 < maxkeep) { + if (nl == 1) + nh = nh + 1 + else if (nh == n[i]) + nl = nl - 1 + else { + r = Memr[resid+nl-1] + s = Memr[resid+nh+1] + if (r < s) { + nl = nl - 1 + r = r + TOL + if (s <= r) + nh = nh + 1 + if (nl > 1) { + if (Memr[resid+nl-1] <= r) + nl = nl - 1 + } + } else { + nh = nh + 1 + s = s + TOL + if (r <= s) + nl = nl - 1 + if (nh < n2) { + if (Memr[resid+nh+1] <= s) + nh = nh + 1 + } + } + } + n1 = nh - nl + 1 + } + + # Only set median and reorder if needed + n[i] = n1 + if (n1 > 0 && nl > 1 && (combine != MEDIAN || grow > 0)) { + j = max (nl, n1 + 1) + if (keepids) { + do l = 1, min (n1, nl-1) { + Memr[d[l]+k] = Memr[d[j]+k] + if (grow > 0) { + mp1 = m[l] + k + mp2 = m[j] + k + id = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = id + } else + Memi[m[l]+k] = Memi[m[j]+k] + j = j + 1 + } + } else { + do l = 1, min (n1, nl - 1) { + Memr[d[l]+k] = Memr[d[j]+k] + j = j + 1 + } + } + } + + if (combine == MEDIAN) + median[i] = med + } + + # Check if data flag needs to be reset for rejected pixels + if (dflag == D_ALL) { + do i = 1, npts { + if (n[i] != nin) { + dflag = D_MIX + break + } + } + } + + # Flag that the median is computed. + if (combine == MEDIAN) + docombine = false + else + docombine = true + + call sfree (sp) +end diff --git a/noao/imred/ccdred/src/generic/icgdata.x b/noao/imred/ccdred/src/generic/icgdata.x new file mode 100644 index 00000000..5c6ac18c --- /dev/null +++ b/noao/imred/ccdred/src/generic/icgdata.x @@ -0,0 +1,459 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> +include <mach.h> +include "../icombine.h" + + +# IC_GDATA -- Get line of image and mask data and apply threshold and scaling. +# Entirely empty lines are excluded. The data are compacted within the +# input data buffers. If it is required, the connection to the original +# image index is keeped in the returned m data pointers. + +procedure ic_gdatas (in, out, dbuf, d, id, n, m, lflag, offsets, scales, + zeros, nimages, npts, v1, v2) + +pointer in[nimages] # Input images +pointer out[ARB] # Output images +pointer dbuf[nimages] # Data buffers for nonaligned images +pointer d[nimages] # Data pointers +pointer id[nimages] # ID pointers +int n[npts] # Number of good pixels +pointer m[nimages] # Mask pointers +int lflag[nimages] # Empty mask flags +int offsets[nimages,ARB] # Image offsets +real scales[nimages] # Scale factors +real zeros[nimages] # Zero offset factors +int nimages # Number of input images +int npts # NUmber of output points per line +long v1[ARB], v2[ARB] # Line vectors + +int i, j, k, l, ndim, nused +real a, b +pointer buf, dp, ip, mp, imgnls() + +include "../icombine.com" + +begin + # Get masks and return if there is no data + call ic_mget (in, out, offsets, v1, v2, m, lflag, nimages) + if (dflag == D_NONE) + return + + # Get data and fill data buffers. Correct for offsets if needed. + ndim = IM_NDIM(out[1]) + do i = 1, nimages { + if (lflag[i] == D_NONE) + next + if (aligned) { + call amovl (v1, v2, IM_MAXDIM) + if (project) + v2[ndim+1] = i + j = imgnls (in[i], d[i], v2) + } else { + v2[1] = v1[1] + do j = 2, ndim + v2[j] = v1[j] - offsets[i,j] + if (project) + v2[ndim+1] = i + j = imgnls (in[i], buf, v2) + call amovs (Mems[buf], Mems[dbuf[i]+offsets[i,1]], + IM_LEN(in[i],1)) + d[i] = dbuf[i] + } + } + + # Apply threshold if needed + if (dothresh) { + do i = 1, nimages { + dp = d[i] + if (lflag[i] == D_ALL) { + do j = 1, npts { + a = Mems[dp] + if (a < lthresh || a > hthresh) { + Memi[m[i]+j-1] = 1 + lflag[i] = D_MIX + dflag = D_MIX + } + dp = dp + 1 + } + } else if (lflag[i] == D_MIX) { + mp = m[i] + do j = 1, npts { + if (Memi[mp] == 0) { + a = Mems[dp] + if (a < lthresh || a > hthresh) { + Memi[m[i]+j-1] = 1 + dflag = D_MIX + } + } + dp = dp + 1 + mp = mp + 1 + } + } + + # Check for completely empty lines + if (lflag[i] == D_MIX) { + lflag[i] = D_NONE + mp = m[i] + do j = 1, npts { + if (Memi[mp] == 0) { + lflag[i] = D_MIX + break + } + mp = mp + 1 + } + } + } + } + + # Apply scaling (avoiding masked pixels which might overflow?) + if (doscale) { + if (dflag == D_ALL) { + do i = 1, nimages { + dp = d[i] + a = scales[i] + b = -zeros[i] + do j = 1, npts { + Mems[dp] = Mems[dp] / a + b + dp = dp + 1 + } + } + } else if (dflag == D_MIX) { + do i = 1, nimages { + dp = d[i] + a = scales[i] + b = -zeros[i] + if (lflag[i] == D_ALL) { + do j = 1, npts { + Mems[dp] = Mems[dp] / a + b + dp = dp + 1 + } + } else if (lflag[i] == D_MIX) { + mp = m[i] + do j = 1, npts { + if (Memi[mp] == 0) + Mems[dp] = Mems[dp] / a + b + dp = dp + 1 + mp = mp + 1 + } + } + } + } + } + + # Sort pointers to exclude unused images. + # Use the lflag array to keep track of the image index. + + if (dflag == D_ALL) + nused = nimages + else { + nused = 0 + do i = 1, nimages + if (lflag[i] != D_NONE) { + nused = nused + 1 + d[nused] = d[i] + m[nused] = m[i] + lflag[nused] = i + } + if (nused == 0) + dflag = D_NONE + } + + # Compact data to remove bad pixels + # Keep track of the image indices if needed + # If growing mark the end of the included image indices with zero + + if (dflag == D_ALL) { + call amovki (nused, n, npts) + if (keepids) + do i = 1, nimages + call amovki (i, Memi[id[i]], npts) + } else if (dflag == D_NONE) + call aclri (n, npts) + else { + call aclri (n, npts) + if (keepids) { + do i = 1, nused { + l = lflag[i] + dp = d[i] + ip = id[i] + mp = m[i] + do j = 1, npts { + if (Memi[mp] == 0) { + n[j] = n[j] + 1 + k = n[j] + if (k < i) { + Mems[d[k]+j-1] = Mems[dp] + Memi[id[k]+j-1] = l + } else + Memi[ip] = l + } + dp = dp + 1 + ip = ip + 1 + mp = mp + 1 + } + } + if (grow > 0) { + do j = 1, npts { + do i = n[j]+1, nimages + Memi[id[i]+j-1] = 0 + } + } + } else { + do i = 1, nused { + dp = d[i] + mp = m[i] + do j = 1, npts { + if (Memi[mp] == 0) { + n[j] = n[j] + 1 + k = n[j] + if (k < i) + Mems[d[k]+j-1] = Mems[dp] + } + dp = dp + 1 + mp = mp + 1 + } + } + } + } + + # Sort the pixels and IDs if needed + if (mclip) { + call malloc (dp, nimages, TY_SHORT) + if (keepids) { + call malloc (ip, nimages, TY_INT) + call ic_2sorts (d, Mems[dp], id, Memi[ip], n, npts) + call mfree (ip, TY_INT) + } else + call ic_sorts (d, Mems[dp], n, npts) + call mfree (dp, TY_SHORT) + } +end + +# IC_GDATA -- Get line of image and mask data and apply threshold and scaling. +# Entirely empty lines are excluded. The data are compacted within the +# input data buffers. If it is required, the connection to the original +# image index is keeped in the returned m data pointers. + +procedure ic_gdatar (in, out, dbuf, d, id, n, m, lflag, offsets, scales, + zeros, nimages, npts, v1, v2) + +pointer in[nimages] # Input images +pointer out[ARB] # Output images +pointer dbuf[nimages] # Data buffers for nonaligned images +pointer d[nimages] # Data pointers +pointer id[nimages] # ID pointers +int n[npts] # Number of good pixels +pointer m[nimages] # Mask pointers +int lflag[nimages] # Empty mask flags +int offsets[nimages,ARB] # Image offsets +real scales[nimages] # Scale factors +real zeros[nimages] # Zero offset factors +int nimages # Number of input images +int npts # NUmber of output points per line +long v1[ARB], v2[ARB] # Line vectors + +int i, j, k, l, ndim, nused +real a, b +pointer buf, dp, ip, mp, imgnlr() + +include "../icombine.com" + +begin + # Get masks and return if there is no data + call ic_mget (in, out, offsets, v1, v2, m, lflag, nimages) + if (dflag == D_NONE) + return + + # Get data and fill data buffers. Correct for offsets if needed. + ndim = IM_NDIM(out[1]) + do i = 1, nimages { + if (lflag[i] == D_NONE) + next + if (aligned) { + call amovl (v1, v2, IM_MAXDIM) + if (project) + v2[ndim+1] = i + j = imgnlr (in[i], d[i], v2) + } else { + v2[1] = v1[1] + do j = 2, ndim + v2[j] = v1[j] - offsets[i,j] + if (project) + v2[ndim+1] = i + j = imgnlr (in[i], buf, v2) + call amovr (Memr[buf], Memr[dbuf[i]+offsets[i,1]], + IM_LEN(in[i],1)) + d[i] = dbuf[i] + } + } + + # Apply threshold if needed + if (dothresh) { + do i = 1, nimages { + dp = d[i] + if (lflag[i] == D_ALL) { + do j = 1, npts { + a = Memr[dp] + if (a < lthresh || a > hthresh) { + Memi[m[i]+j-1] = 1 + lflag[i] = D_MIX + dflag = D_MIX + } + dp = dp + 1 + } + } else if (lflag[i] == D_MIX) { + mp = m[i] + do j = 1, npts { + if (Memi[mp] == 0) { + a = Memr[dp] + if (a < lthresh || a > hthresh) { + Memi[m[i]+j-1] = 1 + dflag = D_MIX + } + } + dp = dp + 1 + mp = mp + 1 + } + } + + # Check for completely empty lines + if (lflag[i] == D_MIX) { + lflag[i] = D_NONE + mp = m[i] + do j = 1, npts { + if (Memi[mp] == 0) { + lflag[i] = D_MIX + break + } + mp = mp + 1 + } + } + } + } + + # Apply scaling (avoiding masked pixels which might overflow?) + if (doscale) { + if (dflag == D_ALL) { + do i = 1, nimages { + dp = d[i] + a = scales[i] + b = -zeros[i] + do j = 1, npts { + Memr[dp] = Memr[dp] / a + b + dp = dp + 1 + } + } + } else if (dflag == D_MIX) { + do i = 1, nimages { + dp = d[i] + a = scales[i] + b = -zeros[i] + if (lflag[i] == D_ALL) { + do j = 1, npts { + Memr[dp] = Memr[dp] / a + b + dp = dp + 1 + } + } else if (lflag[i] == D_MIX) { + mp = m[i] + do j = 1, npts { + if (Memi[mp] == 0) + Memr[dp] = Memr[dp] / a + b + dp = dp + 1 + mp = mp + 1 + } + } + } + } + } + + # Sort pointers to exclude unused images. + # Use the lflag array to keep track of the image index. + + if (dflag == D_ALL) + nused = nimages + else { + nused = 0 + do i = 1, nimages + if (lflag[i] != D_NONE) { + nused = nused + 1 + d[nused] = d[i] + m[nused] = m[i] + lflag[nused] = i + } + if (nused == 0) + dflag = D_NONE + } + + # Compact data to remove bad pixels + # Keep track of the image indices if needed + # If growing mark the end of the included image indices with zero + + if (dflag == D_ALL) { + call amovki (nused, n, npts) + if (keepids) + do i = 1, nimages + call amovki (i, Memi[id[i]], npts) + } else if (dflag == D_NONE) + call aclri (n, npts) + else { + call aclri (n, npts) + if (keepids) { + do i = 1, nused { + l = lflag[i] + dp = d[i] + ip = id[i] + mp = m[i] + do j = 1, npts { + if (Memi[mp] == 0) { + n[j] = n[j] + 1 + k = n[j] + if (k < i) { + Memr[d[k]+j-1] = Memr[dp] + Memi[id[k]+j-1] = l + } else + Memi[ip] = l + } + dp = dp + 1 + ip = ip + 1 + mp = mp + 1 + } + } + if (grow > 0) { + do j = 1, npts { + do i = n[j]+1, nimages + Memi[id[i]+j-1] = 0 + } + } + } else { + do i = 1, nused { + dp = d[i] + mp = m[i] + do j = 1, npts { + if (Memi[mp] == 0) { + n[j] = n[j] + 1 + k = n[j] + if (k < i) + Memr[d[k]+j-1] = Memr[dp] + } + dp = dp + 1 + mp = mp + 1 + } + } + } + } + + # Sort the pixels and IDs if needed + if (mclip) { + call malloc (dp, nimages, TY_REAL) + if (keepids) { + call malloc (ip, nimages, TY_INT) + call ic_2sortr (d, Memr[dp], id, Memi[ip], n, npts) + call mfree (ip, TY_INT) + } else + call ic_sortr (d, Memr[dp], n, npts) + call mfree (dp, TY_REAL) + } +end + diff --git a/noao/imred/ccdred/src/generic/icgrow.x b/noao/imred/ccdred/src/generic/icgrow.x new file mode 100644 index 00000000..b94e1cbc --- /dev/null +++ b/noao/imred/ccdred/src/generic/icgrow.x @@ -0,0 +1,148 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "../icombine.h" + + +# IC_GROW -- Reject neigbors of rejected pixels. +# The rejected pixels are marked by having nonzero ids beyond the number +# of included pixels. The pixels rejected here are given zero ids +# to avoid growing of the pixels rejected here. The unweighted average +# can be updated but any rejected pixels requires the median to be +# recomputed. When the number of pixels at a grow point reaches nkeep +# no further pixels are rejected. Note that the rejection order is not +# based on the magnitude of the residuals and so a grow from a weakly +# rejected image pixel may take precedence over a grow from a strongly +# rejected image pixel. + +procedure ic_grows (d, m, n, nimages, npts, average) + +pointer d[ARB] # Data pointers +pointer m[ARB] # Image id pointers +int n[npts] # Number of good pixels +int nimages # Number of images +int npts # Number of output points per line +real average[npts] # Average + +int i1, i2, j1, j2, k1, k2, l, is, ie, n2, maxkeep +pointer mp1, mp2 + +include "../icombine.com" + +begin + if (dflag == D_NONE) + return + + do i1 = 1, npts { + k1 = i1 - 1 + is = max (1, i1 - grow) + ie = min (npts, i1 + grow) + do j1 = n[i1]+1, nimages { + l = Memi[m[j1]+k1] + if (l == 0) + next + if (combine == MEDIAN) + docombine = true + + do i2 = is, ie { + if (i2 == i1) + next + k2 = i2 - 1 + n2 = n[i2] + if (nkeep < 0) + maxkeep = max (0, n2 + nkeep) + else + maxkeep = min (n2, nkeep) + if (n2 <= maxkeep) + next + do j2 = 1, n2 { + mp1 = m[j2] + k2 + if (Memi[mp1] == l) { + if (!docombine && n2 > 1) + average[i2] = + (n2*average[i2] - Mems[d[j2]+k2]) / (n2-1) + mp2 = m[n2] + k2 + if (j2 < n2) { + Mems[d[j2]+k2] = Mems[d[n2]+k2] + Memi[mp1] = Memi[mp2] + } + Memi[mp2] = 0 + n[i2] = n2 - 1 + break + } + } + } + } + } +end + +# IC_GROW -- Reject neigbors of rejected pixels. +# The rejected pixels are marked by having nonzero ids beyond the number +# of included pixels. The pixels rejected here are given zero ids +# to avoid growing of the pixels rejected here. The unweighted average +# can be updated but any rejected pixels requires the median to be +# recomputed. When the number of pixels at a grow point reaches nkeep +# no further pixels are rejected. Note that the rejection order is not +# based on the magnitude of the residuals and so a grow from a weakly +# rejected image pixel may take precedence over a grow from a strongly +# rejected image pixel. + +procedure ic_growr (d, m, n, nimages, npts, average) + +pointer d[ARB] # Data pointers +pointer m[ARB] # Image id pointers +int n[npts] # Number of good pixels +int nimages # Number of images +int npts # Number of output points per line +real average[npts] # Average + +int i1, i2, j1, j2, k1, k2, l, is, ie, n2, maxkeep +pointer mp1, mp2 + +include "../icombine.com" + +begin + if (dflag == D_NONE) + return + + do i1 = 1, npts { + k1 = i1 - 1 + is = max (1, i1 - grow) + ie = min (npts, i1 + grow) + do j1 = n[i1]+1, nimages { + l = Memi[m[j1]+k1] + if (l == 0) + next + if (combine == MEDIAN) + docombine = true + + do i2 = is, ie { + if (i2 == i1) + next + k2 = i2 - 1 + n2 = n[i2] + if (nkeep < 0) + maxkeep = max (0, n2 + nkeep) + else + maxkeep = min (n2, nkeep) + if (n2 <= maxkeep) + next + do j2 = 1, n2 { + mp1 = m[j2] + k2 + if (Memi[mp1] == l) { + if (!docombine && n2 > 1) + average[i2] = + (n2*average[i2] - Memr[d[j2]+k2]) / (n2-1) + mp2 = m[n2] + k2 + if (j2 < n2) { + Memr[d[j2]+k2] = Memr[d[n2]+k2] + Memi[mp1] = Memi[mp2] + } + Memi[mp2] = 0 + n[i2] = n2 - 1 + break + } + } + } + } + } +end diff --git a/noao/imred/ccdred/src/generic/icmedian.x b/noao/imred/ccdred/src/generic/icmedian.x new file mode 100644 index 00000000..ec0166ba --- /dev/null +++ b/noao/imred/ccdred/src/generic/icmedian.x @@ -0,0 +1,343 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "../icombine.h" + + +# IC_MEDIAN -- Median of lines + +procedure ic_medians (d, n, npts, median) + +pointer d[ARB] # Input data line pointers +int n[npts] # Number of good pixels +int npts # Number of output points per line +real median[npts] # Median + +int i, j, k, j1, j2, n1, lo, up, lo1, up1 +bool even +real val1, val2, val3 +short temp, wtemp + +include "../icombine.com" + +begin + # If no data return after possibly setting blank values. + if (dflag == D_NONE) { + do i = 1, npts + median[i]= blank + return + } + + # If the data were previously sorted then directly compute the median. + if (mclip) { + if (dflag == D_ALL) { + n1 = n[1] + even = (mod (n1, 2) == 0) + j1 = n1 / 2 + 1 + j2 = n1 / 2 + do i = 1, npts { + k = i - 1 + if (even) { + val1 = Mems[d[j1]+k] + val2 = Mems[d[j2]+k] + median[i] = (val1 + val2) / 2. + } else + median[i] = Mems[d[j1]+k] + } + } else { + do i = 1, npts { + k = i - 1 + n1 = n[i] + if (n1 > 0) { + j1 = n1 / 2 + 1 + if (mod (n1, 2) == 0) { + j2 = n1 / 2 + val1 = Mems[d[j1]+k] + val2 = Mems[d[j2]+k] + median[i] = (val1 + val2) / 2. + } else + median[i] = Mems[d[j1]+k] + } else + median[i] = blank + } + } + return + } + + # Compute the median. + do i = 1, npts { + k = i - 1 + n1 = n[i] + + # If there are more than 3 points use Wirth algorithm. This + # is the same as vops$amed.gx except for an even number of + # points it selects the middle two and averages. + if (n1 > 3) { + lo = 1 + up = n1 + j = max (lo, min (up, (up+1)/2)) + + while (lo < up) { + if (! (lo < up)) + break + + temp = Mems[d[j]+k]; lo1 = lo; up1 = up + + repeat { + while (Mems[d[lo1]+k] < temp) + lo1 = lo1 + 1 + while (temp < Mems[d[up1]+k]) + up1 = up1 - 1 + if (lo1 <= up1) { + wtemp = Mems[d[lo1]+k] + Mems[d[lo1]+k] = Mems[d[up1]+k] + Mems[d[up1]+k] = wtemp + lo1 = lo1 + 1; up1 = up1 - 1 + } + } until (lo1 > up1) + + if (up1 < j) + lo = lo1 + if (j < lo1) + up = up1 + } + + median[i] = Mems[d[j]+k] + + if (mod (n1,2) == 0) { + lo = 1 + up = n1 + j = max (lo, min (up, (up+1)/2)+1) + + while (lo < up) { + if (! (lo < up)) + break + + temp = Mems[d[j]+k]; lo1 = lo; up1 = up + + repeat { + while (Mems[d[lo1]+k] < temp) + lo1 = lo1 + 1 + while (temp < Mems[d[up1]+k]) + up1 = up1 - 1 + if (lo1 <= up1) { + wtemp = Mems[d[lo1]+k] + Mems[d[lo1]+k] = Mems[d[up1]+k] + Mems[d[up1]+k] = wtemp + lo1 = lo1 + 1; up1 = up1 - 1 + } + } until (lo1 > up1) + + if (up1 < j) + lo = lo1 + if (j < lo1) + up = up1 + } + median[i] = (median[i] + Mems[d[j]+k]) / 2 + } + + # If 3 points find the median directly. + } else if (n1 == 3) { + val1 = Mems[d[1]+k] + val2 = Mems[d[2]+k] + val3 = Mems[d[3]+k] + if (val1 < val2) { + if (val2 < val3) # abc + median[i] = val2 + else if (val1 < val3) # acb + median[i] = val3 + else # cab + median[i] = val1 + } else { + if (val2 > val3) # cba + median[i] = val2 + else if (val1 > val3) # bca + median[i] = val3 + else # bac + median[i] = val1 + } + + # If 2 points average. + } else if (n1 == 2) { + val1 = Mems[d[1]+k] + val2 = Mems[d[2]+k] + median[i] = (val1 + val2) / 2 + + # If 1 point return the value. + } else if (n1 == 1) + median[i] = Mems[d[1]+k] + + # If no points return with a possibly blank value. + else + median[i] = blank + } +end + +# IC_MEDIAN -- Median of lines + +procedure ic_medianr (d, n, npts, median) + +pointer d[ARB] # Input data line pointers +int n[npts] # Number of good pixels +int npts # Number of output points per line +real median[npts] # Median + +int i, j, k, j1, j2, n1, lo, up, lo1, up1 +bool even +real val1, val2, val3 +real temp, wtemp + +include "../icombine.com" + +begin + # If no data return after possibly setting blank values. + if (dflag == D_NONE) { + do i = 1, npts + median[i]= blank + return + } + + # If the data were previously sorted then directly compute the median. + if (mclip) { + if (dflag == D_ALL) { + n1 = n[1] + even = (mod (n1, 2) == 0) + j1 = n1 / 2 + 1 + j2 = n1 / 2 + do i = 1, npts { + k = i - 1 + if (even) { + val1 = Memr[d[j1]+k] + val2 = Memr[d[j2]+k] + median[i] = (val1 + val2) / 2. + } else + median[i] = Memr[d[j1]+k] + } + } else { + do i = 1, npts { + k = i - 1 + n1 = n[i] + if (n1 > 0) { + j1 = n1 / 2 + 1 + if (mod (n1, 2) == 0) { + j2 = n1 / 2 + val1 = Memr[d[j1]+k] + val2 = Memr[d[j2]+k] + median[i] = (val1 + val2) / 2. + } else + median[i] = Memr[d[j1]+k] + } else + median[i] = blank + } + } + return + } + + # Compute the median. + do i = 1, npts { + k = i - 1 + n1 = n[i] + + # If there are more than 3 points use Wirth algorithm. This + # is the same as vops$amed.gx except for an even number of + # points it selects the middle two and averages. + if (n1 > 3) { + lo = 1 + up = n1 + j = max (lo, min (up, (up+1)/2)) + + while (lo < up) { + if (! (lo < up)) + break + + temp = Memr[d[j]+k]; lo1 = lo; up1 = up + + repeat { + while (Memr[d[lo1]+k] < temp) + lo1 = lo1 + 1 + while (temp < Memr[d[up1]+k]) + up1 = up1 - 1 + if (lo1 <= up1) { + wtemp = Memr[d[lo1]+k] + Memr[d[lo1]+k] = Memr[d[up1]+k] + Memr[d[up1]+k] = wtemp + lo1 = lo1 + 1; up1 = up1 - 1 + } + } until (lo1 > up1) + + if (up1 < j) + lo = lo1 + if (j < lo1) + up = up1 + } + + median[i] = Memr[d[j]+k] + + if (mod (n1,2) == 0) { + lo = 1 + up = n1 + j = max (lo, min (up, (up+1)/2)+1) + + while (lo < up) { + if (! (lo < up)) + break + + temp = Memr[d[j]+k]; lo1 = lo; up1 = up + + repeat { + while (Memr[d[lo1]+k] < temp) + lo1 = lo1 + 1 + while (temp < Memr[d[up1]+k]) + up1 = up1 - 1 + if (lo1 <= up1) { + wtemp = Memr[d[lo1]+k] + Memr[d[lo1]+k] = Memr[d[up1]+k] + Memr[d[up1]+k] = wtemp + lo1 = lo1 + 1; up1 = up1 - 1 + } + } until (lo1 > up1) + + if (up1 < j) + lo = lo1 + if (j < lo1) + up = up1 + } + median[i] = (median[i] + Memr[d[j]+k]) / 2 + } + + # If 3 points find the median directly. + } else if (n1 == 3) { + val1 = Memr[d[1]+k] + val2 = Memr[d[2]+k] + val3 = Memr[d[3]+k] + if (val1 < val2) { + if (val2 < val3) # abc + median[i] = val2 + else if (val1 < val3) # acb + median[i] = val3 + else # cab + median[i] = val1 + } else { + if (val2 > val3) # cba + median[i] = val2 + else if (val1 > val3) # bca + median[i] = val3 + else # bac + median[i] = val1 + } + + # If 2 points average. + } else if (n1 == 2) { + val1 = Memr[d[1]+k] + val2 = Memr[d[2]+k] + median[i] = (val1 + val2) / 2 + + # If 1 point return the value. + } else if (n1 == 1) + median[i] = Memr[d[1]+k] + + # If no points return with a possibly blank value. + else + median[i] = blank + } +end + diff --git a/noao/imred/ccdred/src/generic/icmm.x b/noao/imred/ccdred/src/generic/icmm.x new file mode 100644 index 00000000..259759bd --- /dev/null +++ b/noao/imred/ccdred/src/generic/icmm.x @@ -0,0 +1,300 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "../icombine.h" + + +# IC_MM -- Reject a specified number of high and low pixels + +procedure ic_mms (d, m, n, npts) + +pointer d[ARB] # Data pointers +pointer m[ARB] # Image ID pointers +int n[npts] # Number of good pixels +int npts # Number of output points per line + +int n1, ncombine, npairs, nlow, nhigh, np +int i, i1, j, jmax, jmin +pointer k, kmax, kmin +short d1, d2, dmin, dmax + +include "../icombine.com" + +begin + if (dflag == D_NONE) + return + + if (dflag == D_ALL) { + n1 = n[1] + nlow = flow * n1 + 0.001 + nhigh = fhigh * n1 + 0.001 + ncombine = n1 - nlow - nhigh + npairs = min (nlow, nhigh) + nlow = nlow - npairs + nhigh = nhigh - npairs + } + + do i = 1, npts { + i1 = i - 1 + n1 = n[i] + if (dflag == D_MIX) { + nlow = flow * n1 + 0.001 + nhigh = fhigh * n1 + 0.001 + ncombine = max (ncombine, n1 - nlow - nhigh) + npairs = min (nlow, nhigh) + nlow = nlow - npairs + nhigh = nhigh - npairs + } + + # Reject the npairs low and high points. + do np = 1, npairs { + k = d[1] + i1 + d1 = Mems[k] + dmax = d1; dmin = d1; jmax = 1; jmin = 1; kmax = k; kmin = k + do j = 2, n1 { + d2 = d1 + k = d[j] + i1 + d1 = Mems[k] + if (d1 > dmax) { + dmax = d1; jmax = j; kmax = k + } else if (d1 < dmin) { + dmin = d1; jmin = j; kmin = k + } + } + j = n1 - 1 + if (keepids) { + if (jmax < j) { + if (jmin != j) { + Mems[kmax] = d2 + Memi[m[jmax]+i1] = Memi[m[j]+i1] + } else { + Mems[kmax] = d1 + Memi[m[jmax]+i1] = Memi[m[n1]+i1] + } + } + if (jmin < j) { + if (jmax != n1) { + Mems[kmin] = d1 + Memi[m[jmin]+i1] = Memi[m[n1]+i1] + } else { + Mems[kmin] = d2 + Memi[m[jmin]+i1] = Memi[m[j]+i1] + } + } + } else { + if (jmax < j) { + if (jmin != j) + Mems[kmax] = d2 + else + Mems[kmax] = d1 + } + if (jmin < j) { + if (jmax != n1) + Mems[kmin] = d1 + else + Mems[kmin] = d2 + } + } + n1 = n1 - 2 + } + + # Reject the excess low points. + do np = 1, nlow { + k = d[1] + i1 + d1 = Mems[k] + dmin = d1; jmin = 1; kmin = k + do j = 2, n1 { + k = d[j] + i1 + d1 = Mems[k] + if (d1 < dmin) { + dmin = d1; jmin = j; kmin = k + } + } + if (keepids) { + if (jmin < n1) { + Mems[kmin] = d1 + Memi[m[jmin]+i1] = Memi[m[n1]+i1] + } + } else { + if (jmin < n1) + Mems[kmin] = d1 + } + n1 = n1 - 1 + } + + # Reject the excess high points. + do np = 1, nhigh { + k = d[1] + i1 + d1 = Mems[k] + dmax = d1; jmax = 1; kmax = k + do j = 2, n1 { + k = d[j] + i1 + d1 = Mems[k] + if (d1 > dmax) { + dmax = d1; jmax = j; kmax = k + } + } + if (keepids) { + if (jmax < n1) { + Mems[kmax] = d1 + Memi[m[jmax]+i1] = Memi[m[n1]+i1] + } + } else { + if (jmax < n1) + Mems[kmax] = d1 + } + n1 = n1 - 1 + } + n[i] = n1 + } + + if (dflag == D_ALL && npairs + nlow + nhigh > 0) + dflag = D_MIX +end + +# IC_MM -- Reject a specified number of high and low pixels + +procedure ic_mmr (d, m, n, npts) + +pointer d[ARB] # Data pointers +pointer m[ARB] # Image ID pointers +int n[npts] # Number of good pixels +int npts # Number of output points per line + +int n1, ncombine, npairs, nlow, nhigh, np +int i, i1, j, jmax, jmin +pointer k, kmax, kmin +real d1, d2, dmin, dmax + +include "../icombine.com" + +begin + if (dflag == D_NONE) + return + + if (dflag == D_ALL) { + n1 = n[1] + nlow = flow * n1 + 0.001 + nhigh = fhigh * n1 + 0.001 + ncombine = n1 - nlow - nhigh + npairs = min (nlow, nhigh) + nlow = nlow - npairs + nhigh = nhigh - npairs + } + + do i = 1, npts { + i1 = i - 1 + n1 = n[i] + if (dflag == D_MIX) { + nlow = flow * n1 + 0.001 + nhigh = fhigh * n1 + 0.001 + ncombine = max (ncombine, n1 - nlow - nhigh) + npairs = min (nlow, nhigh) + nlow = nlow - npairs + nhigh = nhigh - npairs + } + + # Reject the npairs low and high points. + do np = 1, npairs { + k = d[1] + i1 + d1 = Memr[k] + dmax = d1; dmin = d1; jmax = 1; jmin = 1; kmax = k; kmin = k + do j = 2, n1 { + d2 = d1 + k = d[j] + i1 + d1 = Memr[k] + if (d1 > dmax) { + dmax = d1; jmax = j; kmax = k + } else if (d1 < dmin) { + dmin = d1; jmin = j; kmin = k + } + } + j = n1 - 1 + if (keepids) { + if (jmax < j) { + if (jmin != j) { + Memr[kmax] = d2 + Memi[m[jmax]+i1] = Memi[m[j]+i1] + } else { + Memr[kmax] = d1 + Memi[m[jmax]+i1] = Memi[m[n1]+i1] + } + } + if (jmin < j) { + if (jmax != n1) { + Memr[kmin] = d1 + Memi[m[jmin]+i1] = Memi[m[n1]+i1] + } else { + Memr[kmin] = d2 + Memi[m[jmin]+i1] = Memi[m[j]+i1] + } + } + } else { + if (jmax < j) { + if (jmin != j) + Memr[kmax] = d2 + else + Memr[kmax] = d1 + } + if (jmin < j) { + if (jmax != n1) + Memr[kmin] = d1 + else + Memr[kmin] = d2 + } + } + n1 = n1 - 2 + } + + # Reject the excess low points. + do np = 1, nlow { + k = d[1] + i1 + d1 = Memr[k] + dmin = d1; jmin = 1; kmin = k + do j = 2, n1 { + k = d[j] + i1 + d1 = Memr[k] + if (d1 < dmin) { + dmin = d1; jmin = j; kmin = k + } + } + if (keepids) { + if (jmin < n1) { + Memr[kmin] = d1 + Memi[m[jmin]+i1] = Memi[m[n1]+i1] + } + } else { + if (jmin < n1) + Memr[kmin] = d1 + } + n1 = n1 - 1 + } + + # Reject the excess high points. + do np = 1, nhigh { + k = d[1] + i1 + d1 = Memr[k] + dmax = d1; jmax = 1; kmax = k + do j = 2, n1 { + k = d[j] + i1 + d1 = Memr[k] + if (d1 > dmax) { + dmax = d1; jmax = j; kmax = k + } + } + if (keepids) { + if (jmax < n1) { + Memr[kmax] = d1 + Memi[m[jmax]+i1] = Memi[m[n1]+i1] + } + } else { + if (jmax < n1) + Memr[kmax] = d1 + } + n1 = n1 - 1 + } + n[i] = n1 + } + + if (dflag == D_ALL && npairs + nlow + nhigh > 0) + dflag = D_MIX +end diff --git a/noao/imred/ccdred/src/generic/icombine.x b/noao/imred/ccdred/src/generic/icombine.x new file mode 100644 index 00000000..b4ff60be --- /dev/null +++ b/noao/imred/ccdred/src/generic/icombine.x @@ -0,0 +1,607 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> +include <imset.h> +include <error.h> +include <syserr.h> +include <mach.h> +include "../icombine.h" + + +# ICOMBINE -- Combine images +# +# The memory and open file descriptor limits are checked and an attempt +# to recover is made either by setting the image pixel files to be +# closed after I/O or by notifying the calling program that memory +# ran out and the IMIO buffer size should be reduced. After the checks +# a procedure for the selected combine option is called. +# Because there may be several failure modes when reaching the file +# limits we first assume an error is due to the file limit, except for +# out of memory, and close some pixel files. If the error then repeats +# on accessing the pixels the error is passed back. + + +procedure icombines (in, out, offsets, nimages, bufsize) + +pointer in[nimages] # Input images +pointer out[ARB] # Output images +int offsets[nimages,ARB] # Input image offsets +int nimages # Number of input images +int bufsize # IMIO buffer size + +char str[1] +int i, j, npts, fd, stropen(), errcode(), imstati() +pointer sp, d, id, n, m, lflag, scales, zeros, wts, dbuf +pointer buf, imgl1s(), impl1i() +errchk stropen, imgl1s, impl1i +pointer impl1r() +errchk impl1r + +include "../icombine.com" + +begin + npts = IM_LEN(out[1],1) + + # Allocate memory. + call smark (sp) + call salloc (d, nimages, TY_POINTER) + call salloc (id, nimages, TY_POINTER) + call salloc (n, npts, TY_INT) + call salloc (m, nimages, TY_POINTER) + call salloc (lflag, nimages, TY_INT) + call salloc (scales, nimages, TY_REAL) + call salloc (zeros, nimages, TY_REAL) + call salloc (wts, nimages, TY_REAL) + call amovki (D_ALL, Memi[lflag], nimages) + + # If aligned use the IMIO buffer otherwise we need vectors of + # output length. + + if (!aligned) { + call salloc (dbuf, nimages, TY_POINTER) + do i = 1, nimages + call salloc (Memi[dbuf+i-1], npts, TY_SHORT) + } + + if (project) { + call imseti (in[1], IM_NBUFS, nimages) + call imseti (in[1], IM_BUFSIZE, bufsize) + do i = 1, 3 { + if (out[i] != NULL) + call imseti (out[i], IM_BUFSIZE, bufsize) + } + } else { + # Reserve FD for string operations. + fd = stropen (str, 1, NEW_FILE) + + # Do I/O to the images. + do i = 1, 3 { + if (out[i] != NULL) + call imseti (out[i], IM_BUFSIZE, bufsize) + } + buf = impl1r (out[1]) + call aclrr (Memr[buf], npts) + if (out[3] != NULL) { + buf = impl1r (out[3]) + call aclrr (Memr[buf], npts) + } + if (out[2] != NULL) { + buf = impl1i (out[2]) + call aclri (Memi[buf], npts) + } + + do i = 1, nimages { + call imseti (in[i], IM_BUFSIZE, bufsize) + iferr (buf = imgl1s (in[i])) { + switch (errcode()) { + case SYS_MFULL: + call sfree (sp) + call strclose (fd) + call erract (EA_ERROR) + case SYS_FTOOMANYFILES, SYS_IKIOPIX: + if (imstati (in[i], IM_CLOSEFD) == YES) { + call sfree (sp) + call strclose (fd) + call erract (EA_ERROR) + } + do j = i-2, nimages + call imseti (in[j], IM_CLOSEFD, YES) + buf = imgl1s (in[i]) + default: + call sfree (sp) + call strclose (fd) + call erract (EA_ERROR) + } + } + } + + call strclose (fd) + } + + call ic_combines (in, out, Memi[dbuf], Memi[d], Memi[id], Memi[n], + Memi[m], Memi[lflag], offsets, Memr[scales], Memr[zeros], + Memr[wts], nimages, npts) +end + + +# IC_COMBINE -- Combine images. + +procedure ic_combines (in, out, dbuf, d, id, n, m, lflag, offsets, + scales, zeros, wts, nimages, npts) + +pointer in[nimages] # Input images +pointer out[ARB] # Output image +pointer dbuf[nimages] # Data buffers for nonaligned images +pointer d[nimages] # Data pointers +pointer id[nimages] # Image index ID pointers +int n[npts] # Number of good pixels +pointer m[nimages] # Mask pointers +int lflag[nimages] # Line flags +int offsets[nimages,ARB] # Input image offsets +real scales[nimages] # Scale factors +real zeros[nimages] # Zero offset factors +real wts[nimages] # Combining weights +int nimages # Number of input images +int npts # Number of points per output line + +int i, ctor() +real r, imgetr() +pointer sp, v1, v2, v3, outdata, buf, nm, impnli() +pointer impnlr() +errchk ic_scale, imgetr + +include "../icombine.com" + +begin + call smark (sp) + call salloc (v1, IM_MAXDIM, TY_LONG) + call salloc (v2, IM_MAXDIM, TY_LONG) + call salloc (v3, IM_MAXDIM, TY_LONG) + call amovkl (long(1), Meml[v1], IM_MAXDIM) + call amovkl (long(1), Meml[v2], IM_MAXDIM) + call amovkl (long(1), Meml[v3], IM_MAXDIM) + + call ic_scale (in, out, offsets, scales, zeros, wts, nimages) + + # Set combine parameters + switch (combine) { + case AVERAGE: + if (dowts) + keepids = true + else + keepids = false + case MEDIAN: + dowts = false + keepids = false + } + docombine = true + + # Set rejection algorithm specific parameters + switch (reject) { + case CCDCLIP, CRREJECT: + call salloc (nm, 3*nimages, TY_REAL) + i = 1 + if (ctor (Memc[rdnoise], i, r) > 0) { + do i = 1, nimages + Memr[nm+3*(i-1)] = r + } else { + do i = 1, nimages + Memr[nm+3*(i-1)] = imgetr (in[i], Memc[rdnoise]) + } + i = 1 + if (ctor (Memc[gain], i, r) > 0) { + do i = 1, nimages { + Memr[nm+3*(i-1)+1] = r + Memr[nm+3*(i-1)] = + max ((Memr[nm+3*(i-1)] / r) ** 2, 1e4 / MAX_REAL) + } + } else { + do i = 1, nimages { + r = imgetr (in[i], Memc[gain]) + Memr[nm+3*(i-1)+1] = r + Memr[nm+3*(i-1)] = + max ((Memr[nm+3*(i-1)] / r) ** 2, 1e4 / MAX_REAL) + } + } + i = 1 + if (ctor (Memc[snoise], i, r) > 0) { + do i = 1, nimages + Memr[nm+3*(i-1)+2] = r + } else { + do i = 1, nimages { + r = imgetr (in[i], Memc[snoise]) + Memr[nm+3*(i-1)+2] = r + } + } + if (!keepids) { + if (doscale1 || grow > 0) + keepids = true + else { + do i = 2, nimages { + if (Memr[nm+3*(i-1)] != Memr[nm] || + Memr[nm+3*(i-1)+1] != Memr[nm+1] || + Memr[nm+3*(i-1)+2] != Memr[nm+2]) { + keepids = true + break + } + } + } + } + if (reject == CRREJECT) + lsigma = MAX_REAL + case MINMAX: + mclip = false + if (grow > 0) + keepids = true + case PCLIP: + mclip = true + if (grow > 0) + keepids = true + case AVSIGCLIP, SIGCLIP: + if (doscale1 || grow > 0) + keepids = true + case NONE: + mclip = false + grow = 0 + } + + if (keepids) { + do i = 1, nimages + call salloc (id[i], npts, TY_INT) + } + + while (impnlr (out[1], outdata, Meml[v1]) != EOF) { + call ic_gdatas (in, out, dbuf, d, id, n, m, lflag, offsets, + scales, zeros, nimages, npts, Meml[v2], Meml[v3]) + + switch (reject) { + case CCDCLIP, CRREJECT: + if (mclip) + call ic_mccdclips (d, id, n, scales, zeros, Memr[nm], + nimages, npts, Memr[outdata]) + else + call ic_accdclips (d, id, n, scales, zeros, Memr[nm], + nimages, npts, Memr[outdata]) + case MINMAX: + call ic_mms (d, id, n, npts) + case PCLIP: + call ic_pclips (d, id, n, nimages, npts, Memr[outdata]) + case SIGCLIP: + if (mclip) + call ic_msigclips (d, id, n, scales, zeros, nimages, npts, + Memr[outdata]) + else + call ic_asigclips (d, id, n, scales, zeros, nimages, npts, + Memr[outdata]) + case AVSIGCLIP: + if (mclip) + call ic_mavsigclips (d, id, n, scales, zeros, nimages, + npts, Memr[outdata]) + else + call ic_aavsigclips (d, id, n, scales, zeros, nimages, + npts, Memr[outdata]) + } + + if (grow > 0) + call ic_grows (d, id, n, nimages, npts, Memr[outdata]) + + if (docombine) { + switch (combine) { + case AVERAGE: + call ic_averages (d, id, n, wts, npts, Memr[outdata]) + case MEDIAN: + call ic_medians (d, n, npts, Memr[outdata]) + } + } + + if (out[2] != NULL) { + call amovl (Meml[v2], Meml[v1], IM_MAXDIM) + i = impnli (out[2], buf, Meml[v1]) + call amovki (nimages, Memi[buf], npts) + call asubi (Memi[buf], n, Memi[buf], npts) + } + + if (out[3] != NULL) { + call amovl (Meml[v2], Meml[v1], IM_MAXDIM) + i = impnlr (out[3], buf, Meml[v1]) + call ic_sigmas (d, id, n, wts, npts, Memr[outdata], + Memr[buf]) + } + call amovl (Meml[v1], Meml[v2], IM_MAXDIM) + } + + call sfree (sp) +end + +procedure icombiner (in, out, offsets, nimages, bufsize) + +pointer in[nimages] # Input images +pointer out[ARB] # Output images +int offsets[nimages,ARB] # Input image offsets +int nimages # Number of input images +int bufsize # IMIO buffer size + +char str[1] +int i, j, npts, fd, stropen(), errcode(), imstati() +pointer sp, d, id, n, m, lflag, scales, zeros, wts, dbuf +pointer buf, imgl1r(), impl1i() +errchk stropen, imgl1r, impl1i +pointer impl1r() +errchk impl1r + +include "../icombine.com" + +begin + npts = IM_LEN(out[1],1) + + # Allocate memory. + call smark (sp) + call salloc (d, nimages, TY_POINTER) + call salloc (id, nimages, TY_POINTER) + call salloc (n, npts, TY_INT) + call salloc (m, nimages, TY_POINTER) + call salloc (lflag, nimages, TY_INT) + call salloc (scales, nimages, TY_REAL) + call salloc (zeros, nimages, TY_REAL) + call salloc (wts, nimages, TY_REAL) + call amovki (D_ALL, Memi[lflag], nimages) + + # If aligned use the IMIO buffer otherwise we need vectors of + # output length. + + if (!aligned) { + call salloc (dbuf, nimages, TY_POINTER) + do i = 1, nimages + call salloc (Memi[dbuf+i-1], npts, TY_REAL) + } + + if (project) { + call imseti (in[1], IM_NBUFS, nimages) + call imseti (in[1], IM_BUFSIZE, bufsize) + do i = 1, 3 { + if (out[i] != NULL) + call imseti (out[i], IM_BUFSIZE, bufsize) + } + } else { + # Reserve FD for string operations. + fd = stropen (str, 1, NEW_FILE) + + # Do I/O to the images. + do i = 1, 3 { + if (out[i] != NULL) + call imseti (out[i], IM_BUFSIZE, bufsize) + } + buf = impl1r (out[1]) + call aclrr (Memr[buf], npts) + if (out[3] != NULL) { + buf = impl1r (out[3]) + call aclrr (Memr[buf], npts) + } + if (out[2] != NULL) { + buf = impl1i (out[2]) + call aclri (Memi[buf], npts) + } + + do i = 1, nimages { + call imseti (in[i], IM_BUFSIZE, bufsize) + iferr (buf = imgl1r (in[i])) { + switch (errcode()) { + case SYS_MFULL: + call sfree (sp) + call strclose (fd) + call erract (EA_ERROR) + case SYS_FTOOMANYFILES, SYS_IKIOPIX: + if (imstati (in[i], IM_CLOSEFD) == YES) { + call sfree (sp) + call strclose (fd) + call erract (EA_ERROR) + } + do j = i-2, nimages + call imseti (in[j], IM_CLOSEFD, YES) + buf = imgl1r (in[i]) + default: + call sfree (sp) + call strclose (fd) + call erract (EA_ERROR) + } + } + } + + call strclose (fd) + } + + call ic_combiner (in, out, Memi[dbuf], Memi[d], Memi[id], Memi[n], + Memi[m], Memi[lflag], offsets, Memr[scales], Memr[zeros], + Memr[wts], nimages, npts) +end + + +# IC_COMBINE -- Combine images. + +procedure ic_combiner (in, out, dbuf, d, id, n, m, lflag, offsets, + scales, zeros, wts, nimages, npts) + +pointer in[nimages] # Input images +pointer out[ARB] # Output image +pointer dbuf[nimages] # Data buffers for nonaligned images +pointer d[nimages] # Data pointers +pointer id[nimages] # Image index ID pointers +int n[npts] # Number of good pixels +pointer m[nimages] # Mask pointers +int lflag[nimages] # Line flags +int offsets[nimages,ARB] # Input image offsets +real scales[nimages] # Scale factors +real zeros[nimages] # Zero offset factors +real wts[nimages] # Combining weights +int nimages # Number of input images +int npts # Number of points per output line + +int i, ctor() +real r, imgetr() +pointer sp, v1, v2, v3, outdata, buf, nm, impnli() +pointer impnlr() +errchk ic_scale, imgetr + +include "../icombine.com" + +begin + call smark (sp) + call salloc (v1, IM_MAXDIM, TY_LONG) + call salloc (v2, IM_MAXDIM, TY_LONG) + call salloc (v3, IM_MAXDIM, TY_LONG) + call amovkl (long(1), Meml[v1], IM_MAXDIM) + call amovkl (long(1), Meml[v2], IM_MAXDIM) + call amovkl (long(1), Meml[v3], IM_MAXDIM) + + call ic_scale (in, out, offsets, scales, zeros, wts, nimages) + + # Set combine parameters + switch (combine) { + case AVERAGE: + if (dowts) + keepids = true + else + keepids = false + case MEDIAN: + dowts = false + keepids = false + } + docombine = true + + # Set rejection algorithm specific parameters + switch (reject) { + case CCDCLIP, CRREJECT: + call salloc (nm, 3*nimages, TY_REAL) + i = 1 + if (ctor (Memc[rdnoise], i, r) > 0) { + do i = 1, nimages + Memr[nm+3*(i-1)] = r + } else { + do i = 1, nimages + Memr[nm+3*(i-1)] = imgetr (in[i], Memc[rdnoise]) + } + i = 1 + if (ctor (Memc[gain], i, r) > 0) { + do i = 1, nimages { + Memr[nm+3*(i-1)+1] = r + Memr[nm+3*(i-1)] = + max ((Memr[nm+3*(i-1)] / r) ** 2, 1e4 / MAX_REAL) + } + } else { + do i = 1, nimages { + r = imgetr (in[i], Memc[gain]) + Memr[nm+3*(i-1)+1] = r + Memr[nm+3*(i-1)] = + max ((Memr[nm+3*(i-1)] / r) ** 2, 1e4 / MAX_REAL) + } + } + i = 1 + if (ctor (Memc[snoise], i, r) > 0) { + do i = 1, nimages + Memr[nm+3*(i-1)+2] = r + } else { + do i = 1, nimages { + r = imgetr (in[i], Memc[snoise]) + Memr[nm+3*(i-1)+2] = r + } + } + if (!keepids) { + if (doscale1 || grow > 0) + keepids = true + else { + do i = 2, nimages { + if (Memr[nm+3*(i-1)] != Memr[nm] || + Memr[nm+3*(i-1)+1] != Memr[nm+1] || + Memr[nm+3*(i-1)+2] != Memr[nm+2]) { + keepids = true + break + } + } + } + } + if (reject == CRREJECT) + lsigma = MAX_REAL + case MINMAX: + mclip = false + if (grow > 0) + keepids = true + case PCLIP: + mclip = true + if (grow > 0) + keepids = true + case AVSIGCLIP, SIGCLIP: + if (doscale1 || grow > 0) + keepids = true + case NONE: + mclip = false + grow = 0 + } + + if (keepids) { + do i = 1, nimages + call salloc (id[i], npts, TY_INT) + } + + while (impnlr (out[1], outdata, Meml[v1]) != EOF) { + call ic_gdatar (in, out, dbuf, d, id, n, m, lflag, offsets, + scales, zeros, nimages, npts, Meml[v2], Meml[v3]) + + switch (reject) { + case CCDCLIP, CRREJECT: + if (mclip) + call ic_mccdclipr (d, id, n, scales, zeros, Memr[nm], + nimages, npts, Memr[outdata]) + else + call ic_accdclipr (d, id, n, scales, zeros, Memr[nm], + nimages, npts, Memr[outdata]) + case MINMAX: + call ic_mmr (d, id, n, npts) + case PCLIP: + call ic_pclipr (d, id, n, nimages, npts, Memr[outdata]) + case SIGCLIP: + if (mclip) + call ic_msigclipr (d, id, n, scales, zeros, nimages, npts, + Memr[outdata]) + else + call ic_asigclipr (d, id, n, scales, zeros, nimages, npts, + Memr[outdata]) + case AVSIGCLIP: + if (mclip) + call ic_mavsigclipr (d, id, n, scales, zeros, nimages, + npts, Memr[outdata]) + else + call ic_aavsigclipr (d, id, n, scales, zeros, nimages, + npts, Memr[outdata]) + } + + if (grow > 0) + call ic_growr (d, id, n, nimages, npts, Memr[outdata]) + + if (docombine) { + switch (combine) { + case AVERAGE: + call ic_averager (d, id, n, wts, npts, Memr[outdata]) + case MEDIAN: + call ic_medianr (d, n, npts, Memr[outdata]) + } + } + + if (out[2] != NULL) { + call amovl (Meml[v2], Meml[v1], IM_MAXDIM) + i = impnli (out[2], buf, Meml[v1]) + call amovki (nimages, Memi[buf], npts) + call asubi (Memi[buf], n, Memi[buf], npts) + } + + if (out[3] != NULL) { + call amovl (Meml[v2], Meml[v1], IM_MAXDIM) + i = impnlr (out[3], buf, Meml[v1]) + call ic_sigmar (d, id, n, wts, npts, Memr[outdata], + Memr[buf]) + } + call amovl (Meml[v1], Meml[v2], IM_MAXDIM) + } + + call sfree (sp) +end + diff --git a/noao/imred/ccdred/src/generic/icpclip.x b/noao/imred/ccdred/src/generic/icpclip.x new file mode 100644 index 00000000..da09bb75 --- /dev/null +++ b/noao/imred/ccdred/src/generic/icpclip.x @@ -0,0 +1,442 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "../icombine.h" + +define MINCLIP 3 # Minimum number for clipping + + +# IC_PCLIP -- Percentile clip +# +# 1) Find the median +# 2) Find the pixel which is the specified order index away +# 3) Use the data value difference as a sigma and apply clipping +# 4) Since the median is known return it so it does not have to be recomputed + +procedure ic_pclips (d, m, n, nimages, npts, median) + +pointer d[ARB] # Data pointers +pointer m[ARB] # Image id pointers +int n[npts] # Number of good pixels +int nimages # Number of input images +int npts # Number of output points per line +real median[npts] # Median + +int i, j, k, l, id, n1, n2, n3, n4, n5, nl, nh, nin, maxkeep +bool even, fp_equalr() +real sigma, r, s, t +pointer sp, resid, mp1, mp2 +real med + +include "../icombine.com" + +begin + # There must be at least MINCLIP and more than nkeep pixels. + if (nkeep < 0) + maxkeep = max (0, nimages + nkeep) + else + maxkeep = min (nimages, nkeep) + if (nimages < max (MINCLIP, maxkeep+1) || dflag == D_NONE) { + docombine = true + return + } + + call smark (sp) + call salloc (resid, nimages+1, TY_REAL) + + # Set sign of pclip parameter + if (pclip < 0) + t = -1. + else + t = 1. + + # If there are no rejected pixels compute certain parameters once. + if (dflag == D_ALL) { + n1 = n[1] + if (nkeep < 0) + maxkeep = max (0, n1 + nkeep) + else + maxkeep = min (n1, nkeep) + n2 = 1 + n1 / 2 + even = (mod (n1, 2) == 0) + if (pclip < 0.) { + if (even) + n3 = max (1, nint (n2 - 1 + pclip)) + else + n3 = max (1, nint (n2 + pclip)) + } else + n3 = min (n1, nint (n2 + pclip)) + nin = n1 + } + + # Now apply clipping. + do i = 1, npts { + # Compute median. + if (dflag == D_MIX) { + n1 = n[i] + if (nkeep < 0) + maxkeep = max (0, n1 + nkeep) + else + maxkeep = min (n1, nkeep) + if (n1 == 0) { + if (combine == MEDIAN) + median[i] = blank + next + } + n2 = 1 + n1 / 2 + even = (mod (n1, 2) == 0) + if (pclip < 0) { + if (even) + n3 = max (1, nint (n2 - 1 + pclip)) + else + n3 = max (1, nint (n2 + pclip)) + } else + n3 = min (n1, nint (n2 + pclip)) + } + + j = i - 1 + if (even) { + med = Mems[d[n2-1]+j] + med = (med + Mems[d[n2]+j]) / 2. + } else + med = Mems[d[n2]+j] + + if (n1 < max (MINCLIP, maxkeep+1)) { + if (combine == MEDIAN) + median[i] = med + next + } + + # Define sigma for clipping + sigma = t * (Mems[d[n3]+j] - med) + if (fp_equalr (sigma, 0.)) { + if (combine == MEDIAN) + median[i] = med + next + } + + # Reject pixels and save residuals. + # Check if any pixels are clipped. + # If so recompute the median and reset the number of good pixels. + # Only reorder if needed. + + for (nl=1; nl<=n1; nl=nl+1) { + r = (med - Mems[d[nl]+j]) / sigma + if (r < lsigma) + break + Memr[resid+nl] = r + } + for (nh=n1; nh>=1; nh=nh-1) { + r = (Mems[d[nh]+j] - med) / sigma + if (r < hsigma) + break + Memr[resid+nh] = r + } + n4 = nh - nl + 1 + + # If too many pixels are rejected add some back in. + # All pixels with the same residual are added. + while (n4 < maxkeep) { + if (nl == 1) + nh = nh + 1 + else if (nh == n[i]) + nl = nl - 1 + else { + r = Memr[resid+nl-1] + s = Memr[resid+nh+1] + if (r < s) { + nl = nl - 1 + r = r + TOL + if (s <= r) + nh = nh + 1 + if (nl > 1) { + if (Memr[resid+nl-1] <= r) + nl = nl - 1 + } + } else { + nh = nh + 1 + s = s + TOL + if (r <= s) + nl = nl - 1 + if (nh < n2) { + if (Memr[resid+nh+1] <= s) + nh = nh + 1 + } + } + } + n4 = nh - nl + 1 + } + + # If any pixels are rejected recompute the median. + if (nl > 1 || nh < n1) { + n5 = nl + n4 / 2 + if (mod (n4, 2) == 0) { + med = Mems[d[n5-1]+j] + med = (med + Mems[d[n5]+j]) / 2. + } else + med = Mems[d[n5]+j] + n[i] = n4 + } + if (combine == MEDIAN) + median[i] = med + + # Reorder if pixels only if necessary. + if (nl > 1 && (combine != MEDIAN || grow > 0)) { + k = max (nl, n4 + 1) + if (keepids) { + do l = 1, min (n1, nl-1) { + Mems[d[l]+j] = Mems[d[k]+j] + if (grow > 0) { + mp1 = m[l] + j + mp2 = m[k] + j + id = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = id + } else + Memi[m[l]+j] = Memi[m[k]+j] + k = k + 1 + } + } else { + do l = 1, min (n1, nl - 1) { + Mems[d[l]+j] = Mems[d[k]+j] + k = k + 1 + } + } + } + } + + # Check if data flag needs to be reset for rejected pixels. + if (dflag == D_ALL) { + do i = 1, npts { + if (n[i] != nin) { + dflag = D_MIX + break + } + } + } + + # Flag whether the median has been computed. + if (combine == MEDIAN) + docombine = false + else + docombine = true + + call sfree (sp) +end + +# IC_PCLIP -- Percentile clip +# +# 1) Find the median +# 2) Find the pixel which is the specified order index away +# 3) Use the data value difference as a sigma and apply clipping +# 4) Since the median is known return it so it does not have to be recomputed + +procedure ic_pclipr (d, m, n, nimages, npts, median) + +pointer d[ARB] # Data pointers +pointer m[ARB] # Image id pointers +int n[npts] # Number of good pixels +int nimages # Number of input images +int npts # Number of output points per line +real median[npts] # Median + +int i, j, k, l, id, n1, n2, n3, n4, n5, nl, nh, nin, maxkeep +bool even, fp_equalr() +real sigma, r, s, t +pointer sp, resid, mp1, mp2 +real med + +include "../icombine.com" + +begin + # There must be at least MINCLIP and more than nkeep pixels. + if (nkeep < 0) + maxkeep = max (0, nimages + nkeep) + else + maxkeep = min (nimages, nkeep) + if (nimages < max (MINCLIP, maxkeep+1) || dflag == D_NONE) { + docombine = true + return + } + + call smark (sp) + call salloc (resid, nimages+1, TY_REAL) + + # Set sign of pclip parameter + if (pclip < 0) + t = -1. + else + t = 1. + + # If there are no rejected pixels compute certain parameters once. + if (dflag == D_ALL) { + n1 = n[1] + if (nkeep < 0) + maxkeep = max (0, n1 + nkeep) + else + maxkeep = min (n1, nkeep) + n2 = 1 + n1 / 2 + even = (mod (n1, 2) == 0) + if (pclip < 0.) { + if (even) + n3 = max (1, nint (n2 - 1 + pclip)) + else + n3 = max (1, nint (n2 + pclip)) + } else + n3 = min (n1, nint (n2 + pclip)) + nin = n1 + } + + # Now apply clipping. + do i = 1, npts { + # Compute median. + if (dflag == D_MIX) { + n1 = n[i] + if (nkeep < 0) + maxkeep = max (0, n1 + nkeep) + else + maxkeep = min (n1, nkeep) + if (n1 == 0) { + if (combine == MEDIAN) + median[i] = blank + next + } + n2 = 1 + n1 / 2 + even = (mod (n1, 2) == 0) + if (pclip < 0) { + if (even) + n3 = max (1, nint (n2 - 1 + pclip)) + else + n3 = max (1, nint (n2 + pclip)) + } else + n3 = min (n1, nint (n2 + pclip)) + } + + j = i - 1 + if (even) { + med = Memr[d[n2-1]+j] + med = (med + Memr[d[n2]+j]) / 2. + } else + med = Memr[d[n2]+j] + + if (n1 < max (MINCLIP, maxkeep+1)) { + if (combine == MEDIAN) + median[i] = med + next + } + + # Define sigma for clipping + sigma = t * (Memr[d[n3]+j] - med) + if (fp_equalr (sigma, 0.)) { + if (combine == MEDIAN) + median[i] = med + next + } + + # Reject pixels and save residuals. + # Check if any pixels are clipped. + # If so recompute the median and reset the number of good pixels. + # Only reorder if needed. + + for (nl=1; nl<=n1; nl=nl+1) { + r = (med - Memr[d[nl]+j]) / sigma + if (r < lsigma) + break + Memr[resid+nl] = r + } + for (nh=n1; nh>=1; nh=nh-1) { + r = (Memr[d[nh]+j] - med) / sigma + if (r < hsigma) + break + Memr[resid+nh] = r + } + n4 = nh - nl + 1 + + # If too many pixels are rejected add some back in. + # All pixels with the same residual are added. + while (n4 < maxkeep) { + if (nl == 1) + nh = nh + 1 + else if (nh == n[i]) + nl = nl - 1 + else { + r = Memr[resid+nl-1] + s = Memr[resid+nh+1] + if (r < s) { + nl = nl - 1 + r = r + TOL + if (s <= r) + nh = nh + 1 + if (nl > 1) { + if (Memr[resid+nl-1] <= r) + nl = nl - 1 + } + } else { + nh = nh + 1 + s = s + TOL + if (r <= s) + nl = nl - 1 + if (nh < n2) { + if (Memr[resid+nh+1] <= s) + nh = nh + 1 + } + } + } + n4 = nh - nl + 1 + } + + # If any pixels are rejected recompute the median. + if (nl > 1 || nh < n1) { + n5 = nl + n4 / 2 + if (mod (n4, 2) == 0) { + med = Memr[d[n5-1]+j] + med = (med + Memr[d[n5]+j]) / 2. + } else + med = Memr[d[n5]+j] + n[i] = n4 + } + if (combine == MEDIAN) + median[i] = med + + # Reorder if pixels only if necessary. + if (nl > 1 && (combine != MEDIAN || grow > 0)) { + k = max (nl, n4 + 1) + if (keepids) { + do l = 1, min (n1, nl-1) { + Memr[d[l]+j] = Memr[d[k]+j] + if (grow > 0) { + mp1 = m[l] + j + mp2 = m[k] + j + id = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = id + } else + Memi[m[l]+j] = Memi[m[k]+j] + k = k + 1 + } + } else { + do l = 1, min (n1, nl - 1) { + Memr[d[l]+j] = Memr[d[k]+j] + k = k + 1 + } + } + } + } + + # Check if data flag needs to be reset for rejected pixels. + if (dflag == D_ALL) { + do i = 1, npts { + if (n[i] != nin) { + dflag = D_MIX + break + } + } + } + + # Flag whether the median has been computed. + if (combine == MEDIAN) + docombine = false + else + docombine = true + + call sfree (sp) +end diff --git a/noao/imred/ccdred/src/generic/icsclip.x b/noao/imred/ccdred/src/generic/icsclip.x new file mode 100644 index 00000000..d7ccfd84 --- /dev/null +++ b/noao/imred/ccdred/src/generic/icsclip.x @@ -0,0 +1,964 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "../icombine.h" + +define MINCLIP 3 # Mininum number of images for algorithm + + +# IC_ASIGCLIP -- Reject pixels using sigma clipping about the average +# The initial average rejects the high and low pixels. A correction for +# different scalings of the images may be made. Weights are not used. + +procedure ic_asigclips (d, m, n, scales, zeros, nimages, npts, average) + +pointer d[nimages] # Data pointers +pointer m[nimages] # Image id pointers +int n[npts] # Number of good pixels +real scales[nimages] # Scales +real zeros[nimages] # Zeros +int nimages # Number of images +int npts # Number of output points per line +real average[npts] # Average + +int i, j, k, l, jj, n1, n2, nin, nk, maxkeep +real d1, low, high, sum, a, s, r, one +data one /1.0/ +pointer sp, resid, w, wp, dp1, dp2, mp1, mp2 + +include "../icombine.com" + +begin + # If there are insufficient pixels go on to the combining + if (nkeep < 0) + maxkeep = max (0, nimages + nkeep) + else + maxkeep = min (nimages, nkeep) + if (nimages < max (MINCLIP, maxkeep+1) || dflag == D_NONE) { + docombine = true + return + } + + # Flag whether returned average needs to be recomputed. + if (dowts || combine != AVERAGE) + docombine = true + else + docombine = false + + # Save the residuals and the sigma scaling corrections if needed. + call smark (sp) + call salloc (resid, nimages+1, TY_REAL) + if (doscale1) + call salloc (w, nimages, TY_REAL) + + # Do sigma clipping. + nin = n[1] + do i = 1, npts { + k = i - 1 + n1 = n[i] + if (nkeep < 0) + maxkeep = max (0, n1 + nkeep) + else + maxkeep = min (n1, nkeep) + + # If there are not enough pixels simply compute the average. + if (n1 < max (3, maxkeep)) { + if (!docombine) { + if (n1 == 0) + average[i] = blank + else { + sum = Mems[d[1]+k] + do j = 2, n1 + sum = sum + Mems[d[j]+k] + average[i] = sum / n1 + } + } + next + } + + # Compute average with the high and low rejected. + low = Mems[d[1]+k] + high = Mems[d[2]+k] + if (low > high) { + d1 = low + low = high + high = d1 + } + sum = 0. + do j = 3, n1 { + d1 = Mems[d[j]+k] + if (d1 < low) { + sum = sum + low + low = d1 + } else if (d1 > high) { + sum = sum + high + high = d1 + } else + sum = sum + d1 + } + a = sum / (n1 - 2) + sum = sum + low + high + + # Iteratively reject pixels and compute the final average if needed. + # Compact the data and keep track of the image IDs if needed. + + repeat { + n2 = n1 + if (doscale1) { + # Compute sigma corrected for scaling. + s = 0. + wp = w - 1 + do j = 1, n1 { + dp1 = d[j] + k + mp1 = m[j] + k + wp = wp + 1 + + d1 = Mems[dp1] + l = Memi[mp1] + r = sqrt (max (one, (a + zeros[l]) / scales[l])) + s = s + ((d1 - a) / r) ** 2 + Memr[wp] = r + } + s = sqrt (s / (n1 - 1)) + + # Reject pixels. Save the residuals and data values. + wp = w - 1 + if (s > 0.) { + for (j=1; j<=n1; j=j+1) { + dp1 = d[j] + k + mp1 = m[j] + k + wp = wp + 1 + + d1 = Mems[dp1] + r = (d1 - a) / (s * Memr[wp]) + if (r < -lsigma || r > hsigma) { + Memr[resid+n1] = abs (r) + if (j < n1) { + dp2 = d[n1] + k + Mems[dp1] = Mems[dp2] + Mems[dp2] = d1 + Memr[wp] = Memr[w+n1-1] + mp2 = m[n1] + k + l = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = l + j = j - 1 + } + sum = sum - d1 + n1 = n1 - 1 + } + } + } + } else { + # Compute the sigma without scale correction. + s = 0. + do j = 1, n1 + s = s + (Mems[d[j]+k] - a) ** 2 + s = sqrt (s / (n1 - 1)) + + # Reject pixels. Save the residuals and data values. + if (s > 0.) { + for (j=1; j<=n1; j=j+1) { + dp1 = d[j] + k + d1 = Mems[dp1] + r = (d1 - a) / s + if (r < -lsigma || r > hsigma) { + Memr[resid+n1] = abs (r) + if (j < n1) { + dp2 = d[n1] + k + Mems[dp1] = Mems[dp2] + Mems[dp2] = d1 + if (keepids) { + mp1 = m[j] + k + mp2 = m[n1] + k + l = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = l + } + j = j - 1 + } + sum = sum - d1 + n1 = n1 - 1 + } + } + } + } + + # Recompute the average. + if (n1 > 1) + a = sum / n1 + } until (n1 == n2 || n1 <= max (2, maxkeep)) + + # If too many pixels are rejected add some back. + # All pixels with equal residuals are added back. + if (n1 < maxkeep) { + nk = maxkeep + if (doscale1) { + for (j=n1+1; j<=nk; j=j+1) { + dp1 = d[j] + k + mp1 = m[j] + k + r = Memr[resid+j] + jj = 0 + do l = j+1, n2 { + s = Memr[resid+l] + if (s < r + TOL) { + if (s > r - TOL) + jj = jj + 1 + else { + jj = 0 + Memr[resid+l] = r + r = s + dp2 = d[l] + k + d1 = Mems[dp1] + Mems[dp1] = Mems[dp2] + Mems[dp2] = d1 + mp2 = m[l] + k + s = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = s + } + } + } + sum = sum + Mems[dp1] + n1 = n1 + 1 + nk = max (nk, j+jj) + } + } else { + for (j=n1+1; j<=nk; j=j+1) { + dp1 = d[j] + k + r = Memr[resid+j] + jj = 0 + do l = j+1, n2 { + s = Memr[resid+l] + if (s < r + TOL) { + if (s > r - TOL) + jj = jj + 1 + else { + jj = 0 + Memr[resid+l] = r + r = s + dp2 = d[l] + k + d1 = Mems[dp1] + Mems[dp1] = Mems[dp2] + Mems[dp2] = d1 + if (keepids) { + mp1 = m[j] + k + mp2 = m[l] + k + s = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = s + } + } + } + } + sum = sum + Mems[dp1] + n1 = n1 + 1 + nk = max (nk, j+jj) + } + } + + # Recompute the average. + if (n1 > 1) + a = sum / n1 + } + + # Save the average if needed. + n[i] = n1 + if (!docombine) { + if (n1 > 0) + average[i] = a + else + average[i] = blank + } + } + + # Check if the data flag has to be reset for rejected pixels + if (dflag == D_ALL) { + do i = 1, npts { + if (n[i] != nin) { + dflag = D_MIX + break + } + } + } + + call sfree (sp) +end + + +# IC_MSIGCLIP -- Reject pixels using sigma clipping about the median + +procedure ic_msigclips (d, m, n, scales, zeros, nimages, npts, median) + +pointer d[nimages] # Data pointers +pointer m[nimages] # Image id pointers +int n[npts] # Number of good pixels +real scales[nimages] # Scales +real zeros[nimages] # Zeros +int nimages # Number of images +int npts # Number of output points per line +real median[npts] # Median + +int i, j, k, l, id, n1, n2, n3, nl, nh, nin, maxkeep +real r, s +pointer sp, resid, w, mp1, mp2 +real med, one +data one /1.0/ + +include "../icombine.com" + +begin + # If there are insufficient pixels go on to the combining + if (nkeep < 0) + maxkeep = max (0, nimages + nkeep) + else + maxkeep = min (nimages, nkeep) + if (nimages < max (MINCLIP, maxkeep+1) || dflag == D_NONE) { + docombine = true + return + } + + # Save the residuals and sigma scaling corrections if needed. + call smark (sp) + call salloc (resid, nimages+1, TY_REAL) + if (doscale1) + call salloc (w, nimages, TY_REAL) + + # Compute median and sigma and iteratively clip. + nin = n[1] + do i = 1, npts { + k = i - 1 + n1 = n[i] + if (nkeep < 0) + maxkeep = max (0, n1 + nkeep) + else + maxkeep = min (n1, nkeep) + nl = 1 + nh = n1 + + repeat { + n2 = n1 + n3 = nl + n1 / 2 + + if (n1 == 0) + med = blank + else if (mod (n1, 2) == 0) + med = (Mems[d[n3-1]+k] + Mems[d[n3]+k]) / 2. + else + med = Mems[d[n3]+k] + + if (n1 >= max (MINCLIP, maxkeep+1)) { + if (doscale1) { + # Compute the sigma with scaling correction. + s = 0. + do j = nl, nh { + l = Memi[m[j]+k] + r = sqrt (max (one, (med + zeros[l]) / scales[l])) + s = s + ((Mems[d[j]+k] - med) / r) ** 2 + Memr[w+j-1] = r + } + s = sqrt (s / (n1 - 1)) + + # Reject pixels and save the residuals. + if (s > 0.) { + for (; nl <= n2; nl = nl + 1) { + r = (med - Mems[d[nl]+k]) / (s * Memr[w+nl-1]) + if (r <= lsigma) + break + Memr[resid+nl] = r + n1 = n1 - 1 + } + for (; nh >= nl; nh = nh - 1) { + r = (Mems[d[nh]+k] - med) / (s * Memr[w+nh-1]) + if (r <= hsigma) + break + Memr[resid+nh] = r + n1 = n1 - 1 + } + } + } else { + # Compute the sigma without scaling correction. + s = 0. + do j = nl, nh + s = s + (Mems[d[j]+k] - med) ** 2 + s = sqrt (s / (n1 - 1)) + + # Reject pixels and save the residuals. + if (s > 0.) { + for (; nl <= n2; nl = nl + 1) { + r = (med - Mems[d[nl]+k]) / s + if (r <= lsigma) + break + Memr[resid+nl] = r + n1 = n1 - 1 + } + for (; nh >= nl; nh = nh - 1) { + r = (Mems[d[nh]+k] - med) / s + if (r <= hsigma) + break + Memr[resid+nh] = r + n1 = n1 - 1 + } + } + } + } + } until (n1 == n2 || n1 < max (MINCLIP, maxkeep+1)) + + # If too many pixels are rejected add some back. + # All pixels with equal residuals are added back. + while (n1 < maxkeep) { + if (nl == 1) + nh = nh + 1 + else if (nh == n[i]) + nl = nl - 1 + else { + r = Memr[resid+nl-1] + s = Memr[resid+nh+1] + if (r < s) { + nl = nl - 1 + r = r + TOL + if (s <= r) + nh = nh + 1 + if (nl > 1) { + if (Memr[resid+nl-1] <= r) + nl = nl - 1 + } + } else { + nh = nh + 1 + s = s + TOL + if (r <= s) + nl = nl - 1 + if (nh < n2) { + if (Memr[resid+nh+1] <= s) + nh = nh + 1 + } + } + } + n1 = nh - nl + 1 + } + + # Only set median and reorder if needed + n[i] = n1 + if (n1 > 0 && nl > 1 && (combine != MEDIAN || grow > 0)) { + j = max (nl, n1 + 1) + if (keepids) { + do l = 1, min (n1, nl-1) { + Mems[d[l]+k] = Mems[d[j]+k] + if (grow > 0) { + mp1 = m[l] + k + mp2 = m[j] + k + id = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = id + } else + Memi[m[l]+k] = Memi[m[j]+k] + j = j + 1 + } + } else { + do l = 1, min (n1, nl - 1) { + Mems[d[l]+k] = Mems[d[j]+k] + j = j + 1 + } + } + } + + if (combine == MEDIAN) + median[i] = med + } + + # Check if data flag needs to be reset for rejected pixels + if (dflag == D_ALL) { + do i = 1, npts { + if (n[i] != nin) { + dflag = D_MIX + break + } + } + } + + # Flag that the median has been computed. + if (combine == MEDIAN) + docombine = false + else + docombine = true + + call sfree (sp) +end + +# IC_ASIGCLIP -- Reject pixels using sigma clipping about the average +# The initial average rejects the high and low pixels. A correction for +# different scalings of the images may be made. Weights are not used. + +procedure ic_asigclipr (d, m, n, scales, zeros, nimages, npts, average) + +pointer d[nimages] # Data pointers +pointer m[nimages] # Image id pointers +int n[npts] # Number of good pixels +real scales[nimages] # Scales +real zeros[nimages] # Zeros +int nimages # Number of images +int npts # Number of output points per line +real average[npts] # Average + +int i, j, k, l, jj, n1, n2, nin, nk, maxkeep +real d1, low, high, sum, a, s, r, one +data one /1.0/ +pointer sp, resid, w, wp, dp1, dp2, mp1, mp2 + +include "../icombine.com" + +begin + # If there are insufficient pixels go on to the combining + if (nkeep < 0) + maxkeep = max (0, nimages + nkeep) + else + maxkeep = min (nimages, nkeep) + if (nimages < max (MINCLIP, maxkeep+1) || dflag == D_NONE) { + docombine = true + return + } + + # Flag whether returned average needs to be recomputed. + if (dowts || combine != AVERAGE) + docombine = true + else + docombine = false + + # Save the residuals and the sigma scaling corrections if needed. + call smark (sp) + call salloc (resid, nimages+1, TY_REAL) + if (doscale1) + call salloc (w, nimages, TY_REAL) + + # Do sigma clipping. + nin = n[1] + do i = 1, npts { + k = i - 1 + n1 = n[i] + if (nkeep < 0) + maxkeep = max (0, n1 + nkeep) + else + maxkeep = min (n1, nkeep) + + # If there are not enough pixels simply compute the average. + if (n1 < max (3, maxkeep)) { + if (!docombine) { + if (n1 == 0) + average[i] = blank + else { + sum = Memr[d[1]+k] + do j = 2, n1 + sum = sum + Memr[d[j]+k] + average[i] = sum / n1 + } + } + next + } + + # Compute average with the high and low rejected. + low = Memr[d[1]+k] + high = Memr[d[2]+k] + if (low > high) { + d1 = low + low = high + high = d1 + } + sum = 0. + do j = 3, n1 { + d1 = Memr[d[j]+k] + if (d1 < low) { + sum = sum + low + low = d1 + } else if (d1 > high) { + sum = sum + high + high = d1 + } else + sum = sum + d1 + } + a = sum / (n1 - 2) + sum = sum + low + high + + # Iteratively reject pixels and compute the final average if needed. + # Compact the data and keep track of the image IDs if needed. + + repeat { + n2 = n1 + if (doscale1) { + # Compute sigma corrected for scaling. + s = 0. + wp = w - 1 + do j = 1, n1 { + dp1 = d[j] + k + mp1 = m[j] + k + wp = wp + 1 + + d1 = Memr[dp1] + l = Memi[mp1] + r = sqrt (max (one, (a + zeros[l]) / scales[l])) + s = s + ((d1 - a) / r) ** 2 + Memr[wp] = r + } + s = sqrt (s / (n1 - 1)) + + # Reject pixels. Save the residuals and data values. + wp = w - 1 + if (s > 0.) { + for (j=1; j<=n1; j=j+1) { + dp1 = d[j] + k + mp1 = m[j] + k + wp = wp + 1 + + d1 = Memr[dp1] + r = (d1 - a) / (s * Memr[wp]) + if (r < -lsigma || r > hsigma) { + Memr[resid+n1] = abs (r) + if (j < n1) { + dp2 = d[n1] + k + Memr[dp1] = Memr[dp2] + Memr[dp2] = d1 + Memr[wp] = Memr[w+n1-1] + mp2 = m[n1] + k + l = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = l + j = j - 1 + } + sum = sum - d1 + n1 = n1 - 1 + } + } + } + } else { + # Compute the sigma without scale correction. + s = 0. + do j = 1, n1 + s = s + (Memr[d[j]+k] - a) ** 2 + s = sqrt (s / (n1 - 1)) + + # Reject pixels. Save the residuals and data values. + if (s > 0.) { + for (j=1; j<=n1; j=j+1) { + dp1 = d[j] + k + d1 = Memr[dp1] + r = (d1 - a) / s + if (r < -lsigma || r > hsigma) { + Memr[resid+n1] = abs (r) + if (j < n1) { + dp2 = d[n1] + k + Memr[dp1] = Memr[dp2] + Memr[dp2] = d1 + if (keepids) { + mp1 = m[j] + k + mp2 = m[n1] + k + l = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = l + } + j = j - 1 + } + sum = sum - d1 + n1 = n1 - 1 + } + } + } + } + + # Recompute the average. + if (n1 > 1) + a = sum / n1 + } until (n1 == n2 || n1 <= max (2, maxkeep)) + + # If too many pixels are rejected add some back. + # All pixels with equal residuals are added back. + if (n1 < maxkeep) { + nk = maxkeep + if (doscale1) { + for (j=n1+1; j<=nk; j=j+1) { + dp1 = d[j] + k + mp1 = m[j] + k + r = Memr[resid+j] + jj = 0 + do l = j+1, n2 { + s = Memr[resid+l] + if (s < r + TOL) { + if (s > r - TOL) + jj = jj + 1 + else { + jj = 0 + Memr[resid+l] = r + r = s + dp2 = d[l] + k + d1 = Memr[dp1] + Memr[dp1] = Memr[dp2] + Memr[dp2] = d1 + mp2 = m[l] + k + s = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = s + } + } + } + sum = sum + Memr[dp1] + n1 = n1 + 1 + nk = max (nk, j+jj) + } + } else { + for (j=n1+1; j<=nk; j=j+1) { + dp1 = d[j] + k + r = Memr[resid+j] + jj = 0 + do l = j+1, n2 { + s = Memr[resid+l] + if (s < r + TOL) { + if (s > r - TOL) + jj = jj + 1 + else { + jj = 0 + Memr[resid+l] = r + r = s + dp2 = d[l] + k + d1 = Memr[dp1] + Memr[dp1] = Memr[dp2] + Memr[dp2] = d1 + if (keepids) { + mp1 = m[j] + k + mp2 = m[l] + k + s = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = s + } + } + } + } + sum = sum + Memr[dp1] + n1 = n1 + 1 + nk = max (nk, j+jj) + } + } + + # Recompute the average. + if (n1 > 1) + a = sum / n1 + } + + # Save the average if needed. + n[i] = n1 + if (!docombine) { + if (n1 > 0) + average[i] = a + else + average[i] = blank + } + } + + # Check if the data flag has to be reset for rejected pixels + if (dflag == D_ALL) { + do i = 1, npts { + if (n[i] != nin) { + dflag = D_MIX + break + } + } + } + + call sfree (sp) +end + + +# IC_MSIGCLIP -- Reject pixels using sigma clipping about the median + +procedure ic_msigclipr (d, m, n, scales, zeros, nimages, npts, median) + +pointer d[nimages] # Data pointers +pointer m[nimages] # Image id pointers +int n[npts] # Number of good pixels +real scales[nimages] # Scales +real zeros[nimages] # Zeros +int nimages # Number of images +int npts # Number of output points per line +real median[npts] # Median + +int i, j, k, l, id, n1, n2, n3, nl, nh, nin, maxkeep +real r, s +pointer sp, resid, w, mp1, mp2 +real med, one +data one /1.0/ + +include "../icombine.com" + +begin + # If there are insufficient pixels go on to the combining + if (nkeep < 0) + maxkeep = max (0, nimages + nkeep) + else + maxkeep = min (nimages, nkeep) + if (nimages < max (MINCLIP, maxkeep+1) || dflag == D_NONE) { + docombine = true + return + } + + # Save the residuals and sigma scaling corrections if needed. + call smark (sp) + call salloc (resid, nimages+1, TY_REAL) + if (doscale1) + call salloc (w, nimages, TY_REAL) + + # Compute median and sigma and iteratively clip. + nin = n[1] + do i = 1, npts { + k = i - 1 + n1 = n[i] + if (nkeep < 0) + maxkeep = max (0, n1 + nkeep) + else + maxkeep = min (n1, nkeep) + nl = 1 + nh = n1 + + repeat { + n2 = n1 + n3 = nl + n1 / 2 + + if (n1 == 0) + med = blank + else if (mod (n1, 2) == 0) + med = (Memr[d[n3-1]+k] + Memr[d[n3]+k]) / 2. + else + med = Memr[d[n3]+k] + + if (n1 >= max (MINCLIP, maxkeep+1)) { + if (doscale1) { + # Compute the sigma with scaling correction. + s = 0. + do j = nl, nh { + l = Memi[m[j]+k] + r = sqrt (max (one, (med + zeros[l]) / scales[l])) + s = s + ((Memr[d[j]+k] - med) / r) ** 2 + Memr[w+j-1] = r + } + s = sqrt (s / (n1 - 1)) + + # Reject pixels and save the residuals. + if (s > 0.) { + for (; nl <= n2; nl = nl + 1) { + r = (med - Memr[d[nl]+k]) / (s * Memr[w+nl-1]) + if (r <= lsigma) + break + Memr[resid+nl] = r + n1 = n1 - 1 + } + for (; nh >= nl; nh = nh - 1) { + r = (Memr[d[nh]+k] - med) / (s * Memr[w+nh-1]) + if (r <= hsigma) + break + Memr[resid+nh] = r + n1 = n1 - 1 + } + } + } else { + # Compute the sigma without scaling correction. + s = 0. + do j = nl, nh + s = s + (Memr[d[j]+k] - med) ** 2 + s = sqrt (s / (n1 - 1)) + + # Reject pixels and save the residuals. + if (s > 0.) { + for (; nl <= n2; nl = nl + 1) { + r = (med - Memr[d[nl]+k]) / s + if (r <= lsigma) + break + Memr[resid+nl] = r + n1 = n1 - 1 + } + for (; nh >= nl; nh = nh - 1) { + r = (Memr[d[nh]+k] - med) / s + if (r <= hsigma) + break + Memr[resid+nh] = r + n1 = n1 - 1 + } + } + } + } + } until (n1 == n2 || n1 < max (MINCLIP, maxkeep+1)) + + # If too many pixels are rejected add some back. + # All pixels with equal residuals are added back. + while (n1 < maxkeep) { + if (nl == 1) + nh = nh + 1 + else if (nh == n[i]) + nl = nl - 1 + else { + r = Memr[resid+nl-1] + s = Memr[resid+nh+1] + if (r < s) { + nl = nl - 1 + r = r + TOL + if (s <= r) + nh = nh + 1 + if (nl > 1) { + if (Memr[resid+nl-1] <= r) + nl = nl - 1 + } + } else { + nh = nh + 1 + s = s + TOL + if (r <= s) + nl = nl - 1 + if (nh < n2) { + if (Memr[resid+nh+1] <= s) + nh = nh + 1 + } + } + } + n1 = nh - nl + 1 + } + + # Only set median and reorder if needed + n[i] = n1 + if (n1 > 0 && nl > 1 && (combine != MEDIAN || grow > 0)) { + j = max (nl, n1 + 1) + if (keepids) { + do l = 1, min (n1, nl-1) { + Memr[d[l]+k] = Memr[d[j]+k] + if (grow > 0) { + mp1 = m[l] + k + mp2 = m[j] + k + id = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = id + } else + Memi[m[l]+k] = Memi[m[j]+k] + j = j + 1 + } + } else { + do l = 1, min (n1, nl - 1) { + Memr[d[l]+k] = Memr[d[j]+k] + j = j + 1 + } + } + } + + if (combine == MEDIAN) + median[i] = med + } + + # Check if data flag needs to be reset for rejected pixels + if (dflag == D_ALL) { + do i = 1, npts { + if (n[i] != nin) { + dflag = D_MIX + break + } + } + } + + # Flag that the median has been computed. + if (combine == MEDIAN) + docombine = false + else + docombine = true + + call sfree (sp) +end diff --git a/noao/imred/ccdred/src/generic/icsigma.x b/noao/imred/ccdred/src/generic/icsigma.x new file mode 100644 index 00000000..bc0d9788 --- /dev/null +++ b/noao/imred/ccdred/src/generic/icsigma.x @@ -0,0 +1,205 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> +include "../icombine.h" + + +# IC_SIGMA -- Compute the sigma image line. +# The estimated sigma includes a correction for the finite population. +# Weights are used if desired. + +procedure ic_sigmas (d, m, n, wts, npts, average, sigma) + +pointer d[ARB] # Data pointers +pointer m[ARB] # Image ID pointers +int n[npts] # Number of points +real wts[ARB] # Weights +int npts # Number of output points per line +real average[npts] # Average +real sigma[npts] # Sigma line (returned) + +int i, j, k, n1 +real wt, sigcor, sumwt +real a, sum + +include "../icombine.com" + +begin + if (dflag == D_ALL) { + n1 = n[1] + if (dowts) { + if (n1 > 1) + sigcor = real (n1) / real (n1 - 1) + else + sigcor = 1. + do i = 1, npts { + k = i - 1 + a = average[i] + wt = wts[Memi[m[1]+k]] + sum = (Mems[d[1]+k] - a) ** 2 * wt + do j = 2, n1 { + wt = wts[Memi[m[j]+k]] + sum = sum + (Mems[d[j]+k] - a) ** 2 * wt + } + sigma[i] = sqrt (sum * sigcor) + } + } else { + if (n1 > 1) + sigcor = 1. / real (n1 - 1) + else + sigcor = 1. + do i = 1, npts { + k = i - 1 + a = average[i] + sum = (Mems[d[1]+k] - a) ** 2 + do j = 2, n1 + sum = sum + (Mems[d[j]+k] - a) ** 2 + sigma[i] = sqrt (sum * sigcor) + } + } + } else if (dflag == D_NONE) { + do i = 1, npts + sigma[i] = blank + } else { + if (dowts) { + do i = 1, npts { + n1 = n[i] + if (n1 > 0) { + k = i - 1 + if (n1 > 1) + sigcor = real (n1) / real (n1 -1) + else + sigcor = 1 + a = average[i] + wt = wts[Memi[m[1]+k]] + sum = (Mems[d[1]+k] - a) ** 2 * wt + sumwt = wt + do j = 2, n1 { + wt = wts[Memi[m[j]+k]] + sum = sum + (Mems[d[j]+k] - a) ** 2 * wt + sumwt = sumwt + wt + } + sigma[i] = sqrt (sum / sumwt * sigcor) + } else + sigma[i] = blank + } + } else { + do i = 1, npts { + n1 = n[i] + if (n1 > 0) { + k = i - 1 + if (n1 > 1) + sigcor = 1. / real (n1 - 1) + else + sigcor = 1. + a = average[i] + sum = (Mems[d[1]+k] - a) ** 2 + do j = 2, n1 + sum = sum + (Mems[d[j]+k] - a) ** 2 + sigma[i] = sqrt (sum * sigcor) + } else + sigma[i] = blank + } + } + } +end + +# IC_SIGMA -- Compute the sigma image line. +# The estimated sigma includes a correction for the finite population. +# Weights are used if desired. + +procedure ic_sigmar (d, m, n, wts, npts, average, sigma) + +pointer d[ARB] # Data pointers +pointer m[ARB] # Image ID pointers +int n[npts] # Number of points +real wts[ARB] # Weights +int npts # Number of output points per line +real average[npts] # Average +real sigma[npts] # Sigma line (returned) + +int i, j, k, n1 +real wt, sigcor, sumwt +real a, sum + +include "../icombine.com" + +begin + if (dflag == D_ALL) { + n1 = n[1] + if (dowts) { + if (n1 > 1) + sigcor = real (n1) / real (n1 - 1) + else + sigcor = 1. + do i = 1, npts { + k = i - 1 + a = average[i] + wt = wts[Memi[m[1]+k]] + sum = (Memr[d[1]+k] - a) ** 2 * wt + do j = 2, n1 { + wt = wts[Memi[m[j]+k]] + sum = sum + (Memr[d[j]+k] - a) ** 2 * wt + } + sigma[i] = sqrt (sum * sigcor) + } + } else { + if (n1 > 1) + sigcor = 1. / real (n1 - 1) + else + sigcor = 1. + do i = 1, npts { + k = i - 1 + a = average[i] + sum = (Memr[d[1]+k] - a) ** 2 + do j = 2, n1 + sum = sum + (Memr[d[j]+k] - a) ** 2 + sigma[i] = sqrt (sum * sigcor) + } + } + } else if (dflag == D_NONE) { + do i = 1, npts + sigma[i] = blank + } else { + if (dowts) { + do i = 1, npts { + n1 = n[i] + if (n1 > 0) { + k = i - 1 + if (n1 > 1) + sigcor = real (n1) / real (n1 -1) + else + sigcor = 1 + a = average[i] + wt = wts[Memi[m[1]+k]] + sum = (Memr[d[1]+k] - a) ** 2 * wt + sumwt = wt + do j = 2, n1 { + wt = wts[Memi[m[j]+k]] + sum = sum + (Memr[d[j]+k] - a) ** 2 * wt + sumwt = sumwt + wt + } + sigma[i] = sqrt (sum / sumwt * sigcor) + } else + sigma[i] = blank + } + } else { + do i = 1, npts { + n1 = n[i] + if (n1 > 0) { + k = i - 1 + if (n1 > 1) + sigcor = 1. / real (n1 - 1) + else + sigcor = 1. + a = average[i] + sum = (Memr[d[1]+k] - a) ** 2 + do j = 2, n1 + sum = sum + (Memr[d[j]+k] - a) ** 2 + sigma[i] = sqrt (sum * sigcor) + } else + sigma[i] = blank + } + } + } +end diff --git a/noao/imred/ccdred/src/generic/icsort.x b/noao/imred/ccdred/src/generic/icsort.x new file mode 100644 index 00000000..a39b68e2 --- /dev/null +++ b/noao/imred/ccdred/src/generic/icsort.x @@ -0,0 +1,550 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +define LOGPTR 32 # log2(maxpts) (4e9) + + +# IC_SORT -- Quicksort. This is based on the VOPS asrt except that +# the input is an array of pointers to image lines and the sort is done +# across the image lines at each point along the lines. The number of +# valid pixels at each point is allowed to vary. The cases of 1, 2, and 3 +# pixels per point are treated specially. + +procedure ic_sorts (a, b, nvecs, npts) + +pointer a[ARB] # pointer to input vectors +short b[ARB] # work array +int nvecs[npts] # number of vectors +int npts # number of points in vectors + +short pivot, temp, temp3 +int i, j, k, l, p, npix, lv[LOGPTR], uv[LOGPTR] +define swap {temp=$1;$1=$2;$2=temp} +define copy_ 10 + +begin + do l = 0, npts-1 { + npix = nvecs[l+1] + if (npix <= 1) + next + + do i = 1, npix + b[i] = Mems[a[i]+l] + + # Special cases + if (npix <= 3) { + pivot = b[1] + temp = b[2] + if (npix == 2) { + if (temp < pivot) { + b[1] = temp + b[2] = pivot + } else + next + } else { + temp3 = b[3] + if (temp < pivot) { # bac|bca|cba + if (temp < temp3) { # bac|bca + b[1] = temp + if (pivot < temp3) # bac + b[2] = pivot + else { # bca + b[2] = temp3 + b[3] = pivot + } + } else { # cba + b[1] = temp3 + b[3] = pivot + } + } else if (temp3 < temp) { # acb|cab + b[3] = temp + if (pivot < temp3) # acb + b[2] = temp3 + else { # cab + b[1] = temp3 + b[2] = pivot + } + } else + next + } + goto copy_ + } + + # General case + do i = 1, npix + b[i] = Mems[a[i]+l] + + lv[1] = 1 + uv[1] = npix + p = 1 + + while (p > 0) { + if (lv[p] >= uv[p]) # only one elem in this subset + p = p - 1 # pop stack + else { + # Dummy do loop to trigger the Fortran optimizer. + do p = p, ARB { + i = lv[p] - 1 + j = uv[p] + + # Select as the pivot the element at the center of the + # array, to avoid quadratic behavior on an already + # sorted array. + + k = (lv[p] + uv[p]) / 2 + swap (b[j], b[k]) + pivot = b[j] # pivot line + + while (i < j) { + for (i=i+1; b[i] < pivot; i=i+1) + ; + for (j=j-1; j > i; j=j-1) + if (b[j] <= pivot) + break + if (i < j) # out of order pair + swap (b[i], b[j]) # interchange elements + } + + j = uv[p] # move pivot to position i + swap (b[i], b[j]) # interchange elements + + 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 + } + + break + } + p = p + 1 # push onto stack + } + } + +copy_ + do i = 1, npix + Mems[a[i]+l] = b[i] + } +end + + +# IC_2SORT -- Quicksort. This is based on the VOPS asrt except that +# the input is an array of pointers to image lines and the sort is done +# across the image lines at each point along the lines. The number of +# valid pixels at each point is allowed to vary. The cases of 1, 2, and 3 +# pixels per point are treated specially. A second integer set of +# vectors is sorted. + +procedure ic_2sorts (a, b, c, d, nvecs, npts) + +pointer a[ARB] # pointer to input vectors +short b[ARB] # work array +pointer c[ARB] # pointer to associated integer vectors +int d[ARB] # work array +int nvecs[npts] # number of vectors +int npts # number of points in vectors + +short pivot, temp, temp3 +int i, j, k, l, p, npix, lv[LOGPTR], uv[LOGPTR], itemp +define swap {temp=$1;$1=$2;$2=temp} +define iswap {itemp=$1;$1=$2;$2=itemp} +define copy_ 10 + +begin + do l = 0, npts-1 { + npix = nvecs[l+1] + if (npix <= 1) + next + + do i = 1, npix { + b[i] = Mems[a[i]+l] + d[i] = Memi[c[i]+l] + } + + # Special cases + if (npix <= 3) { + pivot = b[1] + temp = b[2] + if (npix == 2) { + if (temp < pivot) { + b[1] = temp + b[2] = pivot + iswap (d[1], d[2]) + } else + next + } else { + temp3 = b[3] + if (temp < pivot) { # bac|bca|cba + if (temp < temp3) { # bac|bca + b[1] = temp + if (pivot < temp3) { # bac + b[2] = pivot + iswap (d[1], d[2]) + } else { # bca + b[2] = temp3 + b[3] = pivot + itemp = d[2] + d[2] = d[3] + d[3] = d[1] + d[1] = itemp + } + } else { # cba + b[1] = temp3 + b[3] = pivot + iswap (d[1], d[3]) + } + } else if (temp3 < temp) { # acb|cab + b[3] = temp + if (pivot < temp3) { # acb + b[2] = temp3 + iswap (d[2], d[3]) + } else { # cab + b[1] = temp3 + b[2] = pivot + itemp = d[2] + d[2] = d[1] + d[1] = d[3] + d[3] = itemp + } + } else + next + } + goto copy_ + } + + # General case + lv[1] = 1 + uv[1] = npix + p = 1 + + while (p > 0) { + if (lv[p] >= uv[p]) # only one elem in this subset + p = p - 1 # pop stack + else { + # Dummy do loop to trigger the Fortran optimizer. + do p = p, ARB { + i = lv[p] - 1 + j = uv[p] + + # Select as the pivot the element at the center of the + # array, to avoid quadratic behavior on an already + # sorted array. + + k = (lv[p] + uv[p]) / 2 + swap (b[j], b[k]); swap (d[j], d[k]) + pivot = b[j] # pivot line + + while (i < j) { + for (i=i+1; b[i] < pivot; i=i+1) + ; + for (j=j-1; j > i; j=j-1) + if (b[j] <= pivot) + break + if (i < j) { # out of order pair + swap (b[i], b[j]) # interchange elements + swap (d[i], d[j]) + } + } + + j = uv[p] # move pivot to position i + swap (b[i], b[j]) # interchange elements + swap (d[i], d[j]) + + 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 + } + + break + } + p = p + 1 # push onto stack + } + } + +copy_ + do i = 1, npix { + Mems[a[i]+l] = b[i] + Memi[c[i]+l] = d[i] + } + } +end + +# IC_SORT -- Quicksort. This is based on the VOPS asrt except that +# the input is an array of pointers to image lines and the sort is done +# across the image lines at each point along the lines. The number of +# valid pixels at each point is allowed to vary. The cases of 1, 2, and 3 +# pixels per point are treated specially. + +procedure ic_sortr (a, b, nvecs, npts) + +pointer a[ARB] # pointer to input vectors +real b[ARB] # work array +int nvecs[npts] # number of vectors +int npts # number of points in vectors + +real pivot, temp, temp3 +int i, j, k, l, p, npix, lv[LOGPTR], uv[LOGPTR] +define swap {temp=$1;$1=$2;$2=temp} +define copy_ 10 + +begin + do l = 0, npts-1 { + npix = nvecs[l+1] + if (npix <= 1) + next + + do i = 1, npix + b[i] = Memr[a[i]+l] + + # Special cases + if (npix <= 3) { + pivot = b[1] + temp = b[2] + if (npix == 2) { + if (temp < pivot) { + b[1] = temp + b[2] = pivot + } else + next + } else { + temp3 = b[3] + if (temp < pivot) { # bac|bca|cba + if (temp < temp3) { # bac|bca + b[1] = temp + if (pivot < temp3) # bac + b[2] = pivot + else { # bca + b[2] = temp3 + b[3] = pivot + } + } else { # cba + b[1] = temp3 + b[3] = pivot + } + } else if (temp3 < temp) { # acb|cab + b[3] = temp + if (pivot < temp3) # acb + b[2] = temp3 + else { # cab + b[1] = temp3 + b[2] = pivot + } + } else + next + } + goto copy_ + } + + # General case + do i = 1, npix + b[i] = Memr[a[i]+l] + + lv[1] = 1 + uv[1] = npix + p = 1 + + while (p > 0) { + if (lv[p] >= uv[p]) # only one elem in this subset + p = p - 1 # pop stack + else { + # Dummy do loop to trigger the Fortran optimizer. + do p = p, ARB { + i = lv[p] - 1 + j = uv[p] + + # Select as the pivot the element at the center of the + # array, to avoid quadratic behavior on an already + # sorted array. + + k = (lv[p] + uv[p]) / 2 + swap (b[j], b[k]) + pivot = b[j] # pivot line + + while (i < j) { + for (i=i+1; b[i] < pivot; i=i+1) + ; + for (j=j-1; j > i; j=j-1) + if (b[j] <= pivot) + break + if (i < j) # out of order pair + swap (b[i], b[j]) # interchange elements + } + + j = uv[p] # move pivot to position i + swap (b[i], b[j]) # interchange elements + + 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 + } + + break + } + p = p + 1 # push onto stack + } + } + +copy_ + do i = 1, npix + Memr[a[i]+l] = b[i] + } +end + + +# IC_2SORT -- Quicksort. This is based on the VOPS asrt except that +# the input is an array of pointers to image lines and the sort is done +# across the image lines at each point along the lines. The number of +# valid pixels at each point is allowed to vary. The cases of 1, 2, and 3 +# pixels per point are treated specially. A second integer set of +# vectors is sorted. + +procedure ic_2sortr (a, b, c, d, nvecs, npts) + +pointer a[ARB] # pointer to input vectors +real b[ARB] # work array +pointer c[ARB] # pointer to associated integer vectors +int d[ARB] # work array +int nvecs[npts] # number of vectors +int npts # number of points in vectors + +real pivot, temp, temp3 +int i, j, k, l, p, npix, lv[LOGPTR], uv[LOGPTR], itemp +define swap {temp=$1;$1=$2;$2=temp} +define iswap {itemp=$1;$1=$2;$2=itemp} +define copy_ 10 + +begin + do l = 0, npts-1 { + npix = nvecs[l+1] + if (npix <= 1) + next + + do i = 1, npix { + b[i] = Memr[a[i]+l] + d[i] = Memi[c[i]+l] + } + + # Special cases + if (npix <= 3) { + pivot = b[1] + temp = b[2] + if (npix == 2) { + if (temp < pivot) { + b[1] = temp + b[2] = pivot + iswap (d[1], d[2]) + } else + next + } else { + temp3 = b[3] + if (temp < pivot) { # bac|bca|cba + if (temp < temp3) { # bac|bca + b[1] = temp + if (pivot < temp3) { # bac + b[2] = pivot + iswap (d[1], d[2]) + } else { # bca + b[2] = temp3 + b[3] = pivot + itemp = d[2] + d[2] = d[3] + d[3] = d[1] + d[1] = itemp + } + } else { # cba + b[1] = temp3 + b[3] = pivot + iswap (d[1], d[3]) + } + } else if (temp3 < temp) { # acb|cab + b[3] = temp + if (pivot < temp3) { # acb + b[2] = temp3 + iswap (d[2], d[3]) + } else { # cab + b[1] = temp3 + b[2] = pivot + itemp = d[2] + d[2] = d[1] + d[1] = d[3] + d[3] = itemp + } + } else + next + } + goto copy_ + } + + # General case + lv[1] = 1 + uv[1] = npix + p = 1 + + while (p > 0) { + if (lv[p] >= uv[p]) # only one elem in this subset + p = p - 1 # pop stack + else { + # Dummy do loop to trigger the Fortran optimizer. + do p = p, ARB { + i = lv[p] - 1 + j = uv[p] + + # Select as the pivot the element at the center of the + # array, to avoid quadratic behavior on an already + # sorted array. + + k = (lv[p] + uv[p]) / 2 + swap (b[j], b[k]); swap (d[j], d[k]) + pivot = b[j] # pivot line + + while (i < j) { + for (i=i+1; b[i] < pivot; i=i+1) + ; + for (j=j-1; j > i; j=j-1) + if (b[j] <= pivot) + break + if (i < j) { # out of order pair + swap (b[i], b[j]) # interchange elements + swap (d[i], d[j]) + } + } + + j = uv[p] # move pivot to position i + swap (b[i], b[j]) # interchange elements + swap (d[i], d[j]) + + 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 + } + + break + } + p = p + 1 # push onto stack + } + } + +copy_ + do i = 1, npix { + Memr[a[i]+l] = b[i] + Memi[c[i]+l] = d[i] + } + } +end diff --git a/noao/imred/ccdred/src/generic/icstat.x b/noao/imred/ccdred/src/generic/icstat.x new file mode 100644 index 00000000..41512ccb --- /dev/null +++ b/noao/imred/ccdred/src/generic/icstat.x @@ -0,0 +1,444 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> +include "../icombine.h" + +define NMAX 10000 # Maximum number of pixels to sample + + +# IC_STAT -- Compute image statistics within specified section. +# The image section is relative to a reference image which may be +# different than the input image and may have an offset. Only a +# subsample of pixels is used. Masked and thresholded pixels are +# ignored. Only the desired statistics are computed to increase +# efficiency. + +procedure ic_stats (im, imref, section, offsets, image, nimages, + domode, domedian, domean, mode, median, mean) + +pointer im # Data image +pointer imref # Reference image for image section +char section[ARB] # Image section +int offsets[nimages,ARB] # Image section offset from data to reference +int image # Image index (for mask I/O) +int nimages # Number of images in offsets. +bool domode, domedian, domean # Statistics to compute +real mode, median, mean # Statistics + +int i, j, ndim, n, nv +real a +pointer sp, v1, v2, dv, va, vb +pointer data, mask, dp, lp, mp, imgnls() +short ic_modes() +real asums() + + +include "../icombine.com" + +begin + call smark (sp) + call salloc (v1, IM_MAXDIM, TY_LONG) + call salloc (v2, IM_MAXDIM, TY_LONG) + call salloc (dv, IM_MAXDIM, TY_LONG) + call salloc (va, IM_MAXDIM, TY_LONG) + call salloc (vb, IM_MAXDIM, TY_LONG) + + # Determine the image section parameters. This must be in terms of + # the data image pixel coordinates though the section may be specified + # in terms of the reference image coordinates. Limit the number of + # pixels in each dimension to a maximum. + + ndim = IM_NDIM(im) + if (project) + ndim = ndim - 1 + call amovki (1, Memi[v1], IM_MAXDIM) + call amovki (1, Memi[va], IM_MAXDIM) + call amovki (1, Memi[dv], IM_MAXDIM) + call amovi (IM_LEN(imref,1), Memi[vb], ndim) + call ic_section (section, Memi[va], Memi[vb], Memi[dv], ndim) + if (im != imref) + do i = 1, ndim { + Memi[va+i-1] = Memi[va+i-1] - offsets[image,i] + Memi[vb+i-1] = Memi[vb+i-1] - offsets[image,i] + } + + do j = 1, 10 { + n = 1 + do i = 0, ndim-1 { + Memi[v1+i] = max (1, min (Memi[va+i], Memi[vb+i])) + Memi[v2+i] = min (IM_LEN(im,i+1), max (Memi[va+i], Memi[vb+i])) + Memi[dv+i] = j + nv = max (1, (Memi[v2+i] - Memi[v1+i]) / Memi[dv+i] + 1) + Memi[v2+i] = Memi[v1+i] + (nv - 1) * Memi[dv+i] + n = n * nv + } + if (n < NMAX) + break + } + + call amovl (Memi[v1], Memi[va], IM_MAXDIM) + Memi[va] = 1 + if (project) + Memi[va+ndim] = image + call amovl (Memi[va], Memi[vb], IM_MAXDIM) + + # Accumulate the pixel values within the section. Masked pixels and + # thresholded pixels are ignored. + + call salloc (data, n, TY_SHORT) + dp = data + while (imgnls (im, lp, Memi[vb]) != EOF) { + call ic_mget1 (im, image, offsets[image,1], Memi[va], mask) + lp = lp + Memi[v1] - 1 + if (dflag == D_ALL) { + if (dothresh) { + do i = Memi[v1], Memi[v2], Memi[dv] { + a = Mems[lp] + if (a >= lthresh && a <= hthresh) { + Mems[dp] = a + dp = dp + 1 + } + lp = lp + Memi[dv] + } + } else { + do i = Memi[v1], Memi[v2], Memi[dv] { + Mems[dp] = Mems[lp] + dp = dp + 1 + lp = lp + Memi[dv] + } + } + } else if (dflag == D_MIX) { + mp = mask + Memi[v1] - 1 + if (dothresh) { + do i = Memi[v1], Memi[v2], Memi[dv] { + if (Memi[mp] == 0) { + a = Mems[lp] + if (a >= lthresh && a <= hthresh) { + Mems[dp] = a + dp = dp + 1 + } + } + mp = mp + Memi[dv] + lp = lp + Memi[dv] + } + } else { + do i = Memi[v1], Memi[v2], Memi[dv] { + if (Memi[mp] == 0) { + Mems[dp] = Mems[lp] + dp = dp + 1 + } + mp = mp + Memi[dv] + lp = lp + Memi[dv] + } + } + } + for (i=2; i<=ndim; i=i+1) { + Memi[va+i-1] = Memi[va+i-1] + Memi[dv+i-1] + if (Memi[va+i-1] <= Memi[v2+i-1]) + break + Memi[va+i-1] = Memi[v1+i-1] + } + if (i > ndim) + break + call amovl (Memi[va], Memi[vb], IM_MAXDIM) + } + + n = dp - data + if (n < 1) { + call sfree (sp) + call error (1, "Image section contains no pixels") + } + + # Compute only statistics needed. + if (domode || domedian) { + call asrts (Mems[data], Mems[data], n) + mode = ic_modes (Mems[data], n) + median = Mems[data+n/2-1] + } + if (domean) + mean = asums (Mems[data], n) / n + + call sfree (sp) +end + + +define NMIN 10 # Minimum number of pixels for mode calculation +define ZRANGE 0.8 # Fraction of pixels about median to use +define ZSTEP 0.01 # Step size for search for mode +define ZBIN 0.1 # Bin size for mode. + +# IC_MODE -- Compute mode of an array. The mode is found by binning +# with a bin size based on the data range over a fraction of the +# pixels about the median and a bin step which may be smaller than the +# bin size. If there are too few points the median is returned. +# The input array must be sorted. + +short procedure ic_modes (a, n) + +short a[n] # Data array +int n # Number of points + +int i, j, k, nmax +real z1, z2, zstep, zbin +short mode +bool fp_equalr() + +begin + if (n < NMIN) + return (a[n/2]) + + # Compute the mode. The array must be sorted. Consider a + # range of values about the median point. Use a bin size which + # is ZBIN of the range. Step the bin limits in ZSTEP fraction of + # the bin size. + + i = 1 + n * (1. - ZRANGE) / 2. + j = 1 + n * (1. + ZRANGE) / 2. + z1 = a[i] + z2 = a[j] + if (fp_equalr (z1, z2)) { + mode = z1 + return (mode) + } + + zstep = ZSTEP * (z2 - z1) + zbin = ZBIN * (z2 - z1) + zstep = max (1., zstep) + zbin = max (1., zbin) + + z1 = z1 - zstep + k = i + nmax = 0 + repeat { + z1 = z1 + zstep + z2 = z1 + zbin + for (; i < j && a[i] < z1; i=i+1) + ; + for (; k < j && a[k] < z2; k=k+1) + ; + if (k - i > nmax) { + nmax = k - i + mode = a[(i+k)/2] + } + } until (k >= j) + + return (mode) +end + +# IC_STAT -- Compute image statistics within specified section. +# The image section is relative to a reference image which may be +# different than the input image and may have an offset. Only a +# subsample of pixels is used. Masked and thresholded pixels are +# ignored. Only the desired statistics are computed to increase +# efficiency. + +procedure ic_statr (im, imref, section, offsets, image, nimages, + domode, domedian, domean, mode, median, mean) + +pointer im # Data image +pointer imref # Reference image for image section +char section[ARB] # Image section +int offsets[nimages,ARB] # Image section offset from data to reference +int image # Image index (for mask I/O) +int nimages # Number of images in offsets. +bool domode, domedian, domean # Statistics to compute +real mode, median, mean # Statistics + +int i, j, ndim, n, nv +real a +pointer sp, v1, v2, dv, va, vb +pointer data, mask, dp, lp, mp, imgnlr() +real ic_moder() +real asumr() + + +include "../icombine.com" + +begin + call smark (sp) + call salloc (v1, IM_MAXDIM, TY_LONG) + call salloc (v2, IM_MAXDIM, TY_LONG) + call salloc (dv, IM_MAXDIM, TY_LONG) + call salloc (va, IM_MAXDIM, TY_LONG) + call salloc (vb, IM_MAXDIM, TY_LONG) + + # Determine the image section parameters. This must be in terms of + # the data image pixel coordinates though the section may be specified + # in terms of the reference image coordinates. Limit the number of + # pixels in each dimension to a maximum. + + ndim = IM_NDIM(im) + if (project) + ndim = ndim - 1 + call amovki (1, Memi[v1], IM_MAXDIM) + call amovki (1, Memi[va], IM_MAXDIM) + call amovki (1, Memi[dv], IM_MAXDIM) + call amovi (IM_LEN(imref,1), Memi[vb], ndim) + call ic_section (section, Memi[va], Memi[vb], Memi[dv], ndim) + if (im != imref) + do i = 1, ndim { + Memi[va+i-1] = Memi[va+i-1] - offsets[image,i] + Memi[vb+i-1] = Memi[vb+i-1] - offsets[image,i] + } + + do j = 1, 10 { + n = 1 + do i = 0, ndim-1 { + Memi[v1+i] = max (1, min (Memi[va+i], Memi[vb+i])) + Memi[v2+i] = min (IM_LEN(im,i+1), max (Memi[va+i], Memi[vb+i])) + Memi[dv+i] = j + nv = max (1, (Memi[v2+i] - Memi[v1+i]) / Memi[dv+i] + 1) + Memi[v2+i] = Memi[v1+i] + (nv - 1) * Memi[dv+i] + n = n * nv + } + if (n < NMAX) + break + } + + call amovl (Memi[v1], Memi[va], IM_MAXDIM) + Memi[va] = 1 + if (project) + Memi[va+ndim] = image + call amovl (Memi[va], Memi[vb], IM_MAXDIM) + + # Accumulate the pixel values within the section. Masked pixels and + # thresholded pixels are ignored. + + call salloc (data, n, TY_REAL) + dp = data + while (imgnlr (im, lp, Memi[vb]) != EOF) { + call ic_mget1 (im, image, offsets[image,1], Memi[va], mask) + lp = lp + Memi[v1] - 1 + if (dflag == D_ALL) { + if (dothresh) { + do i = Memi[v1], Memi[v2], Memi[dv] { + a = Memr[lp] + if (a >= lthresh && a <= hthresh) { + Memr[dp] = a + dp = dp + 1 + } + lp = lp + Memi[dv] + } + } else { + do i = Memi[v1], Memi[v2], Memi[dv] { + Memr[dp] = Memr[lp] + dp = dp + 1 + lp = lp + Memi[dv] + } + } + } else if (dflag == D_MIX) { + mp = mask + Memi[v1] - 1 + if (dothresh) { + do i = Memi[v1], Memi[v2], Memi[dv] { + if (Memi[mp] == 0) { + a = Memr[lp] + if (a >= lthresh && a <= hthresh) { + Memr[dp] = a + dp = dp + 1 + } + } + mp = mp + Memi[dv] + lp = lp + Memi[dv] + } + } else { + do i = Memi[v1], Memi[v2], Memi[dv] { + if (Memi[mp] == 0) { + Memr[dp] = Memr[lp] + dp = dp + 1 + } + mp = mp + Memi[dv] + lp = lp + Memi[dv] + } + } + } + for (i=2; i<=ndim; i=i+1) { + Memi[va+i-1] = Memi[va+i-1] + Memi[dv+i-1] + if (Memi[va+i-1] <= Memi[v2+i-1]) + break + Memi[va+i-1] = Memi[v1+i-1] + } + if (i > ndim) + break + call amovl (Memi[va], Memi[vb], IM_MAXDIM) + } + + n = dp - data + if (n < 1) { + call sfree (sp) + call error (1, "Image section contains no pixels") + } + + # Compute only statistics needed. + if (domode || domedian) { + call asrtr (Memr[data], Memr[data], n) + mode = ic_moder (Memr[data], n) + median = Memr[data+n/2-1] + } + if (domean) + mean = asumr (Memr[data], n) / n + + call sfree (sp) +end + + +define NMIN 10 # Minimum number of pixels for mode calculation +define ZRANGE 0.8 # Fraction of pixels about median to use +define ZSTEP 0.01 # Step size for search for mode +define ZBIN 0.1 # Bin size for mode. + +# IC_MODE -- Compute mode of an array. The mode is found by binning +# with a bin size based on the data range over a fraction of the +# pixels about the median and a bin step which may be smaller than the +# bin size. If there are too few points the median is returned. +# The input array must be sorted. + +real procedure ic_moder (a, n) + +real a[n] # Data array +int n # Number of points + +int i, j, k, nmax +real z1, z2, zstep, zbin +real mode +bool fp_equalr() + +begin + if (n < NMIN) + return (a[n/2]) + + # Compute the mode. The array must be sorted. Consider a + # range of values about the median point. Use a bin size which + # is ZBIN of the range. Step the bin limits in ZSTEP fraction of + # the bin size. + + i = 1 + n * (1. - ZRANGE) / 2. + j = 1 + n * (1. + ZRANGE) / 2. + z1 = a[i] + z2 = a[j] + if (fp_equalr (z1, z2)) { + mode = z1 + return (mode) + } + + zstep = ZSTEP * (z2 - z1) + zbin = ZBIN * (z2 - z1) + + z1 = z1 - zstep + k = i + nmax = 0 + repeat { + z1 = z1 + zstep + z2 = z1 + zbin + for (; i < j && a[i] < z1; i=i+1) + ; + for (; k < j && a[k] < z2; k=k+1) + ; + if (k - i > nmax) { + nmax = k - i + mode = a[(i+k)/2] + } + } until (k >= j) + + return (mode) +end + diff --git a/noao/imred/ccdred/src/generic/mkpkg b/noao/imred/ccdred/src/generic/mkpkg new file mode 100644 index 00000000..3d841680 --- /dev/null +++ b/noao/imred/ccdred/src/generic/mkpkg @@ -0,0 +1,11 @@ +# Make CCDRED Package. + +$checkout libpkg.a ../.. +$update libpkg.a +$checkin libpkg.a ../.. +$exit + +libpkg.a: + cor.x ccdred.h + proc.x ccdred.h <imhdr.h> + ; diff --git a/noao/imred/ccdred/src/generic/proc.x b/noao/imred/ccdred/src/generic/proc.x new file mode 100644 index 00000000..242da9c9 --- /dev/null +++ b/noao/imred/ccdred/src/generic/proc.x @@ -0,0 +1,735 @@ +include <imhdr.h> +include "ccdred.h" + + +.help proc Feb87 noao.imred.ccdred +.nf ---------------------------------------------------------------------------- +proc -- Process CCD images + +These are the main CCD reduction procedures. There is one for each +readout axis (lines or columns) and one for short and real image data. +They apply corrections for bad pixels, overscan levels, zero levels, +dark counts, flat field response, illumination response, and fringe +effects. The image is also trimmed if it was mapped with an image +section. The mean value for the output image is computed when the flat +field or illumination image is processed to form the scale factor for +these calibrations in order to avoid reading through these image a +second time. + +The processing information and parameters are specified in the CCD +structure. The processing operations to be performed are specified by +the correction array CORS in the ccd structure. There is one array +element for each operation with indices defined symbolically by macro +definitions (see ccdred.h); i.e. FLATCOR. The value of the array +element is an integer bit field in which the bit set is the same as the +array index; i.e element 3 will have the third bit set for an operation +with array value 2**(3-1)=4. If an operation is not to be performed +the bit is not set and the array element has the numeric value zero. +Note that the addition of several correction elements gives a unique +bit field describing a combination of operations. For efficiency the +most common combinations are implemented as separate units. + +The CCD structure also contains the correction or calibration data +consisting either pointers to data, IMIO pointers for the calibration +images, and scale factors. + +The processing is performed line-by-line. The procedure CORINPUT is +called to get an input line. This procedure trims and fixes bad pixels by +interpolation. The output line and lines from the various calibration +images are read. The image vectors as well as the overscan vector and +the scale factors are passed to the procedure COR (which also +dereferences the pointer data into simple arrays and variables). That +procedure does the actual corrections apart from bad pixel +corrections. + +The final optional step is to add each corrected output line to form a +mean. This adds efficiency since the operation is done only if desired +and the output image data is already in memory so there is no I/O +penalty. + +SEE ALSO + ccdred.h, cor, fixpix, setfixpix, setoverscan, settrim, + setzero, setdark, setflat, setillum, setfringe +.endhelp ---------------------------------------------------------------------- + + + +# PROC1 -- Process CCD images with readout axis 1 (lines). + +procedure proc1s (ccd) + +pointer ccd # CCD structure + +int line, ncols, nlines, findmean, rep +int overscan_type, overscan_c1, noverscan +real overscan, darkscale, flatscale, illumscale, frgscale, mean +short minrep +pointer in, out, zeroim, darkim, flatim, illumim, fringeim, overscan_vec +pointer inbuf, outbuf, zerobuf, darkbuf, flatbuf, illumbuf, fringebuf + +real asums() +real find_overscans() +pointer imgl2s(), impl2s(), ccd_gls(), xt_fpss() + +begin + # Initialize. If the correction image is 1D then just get the + # data once. + + in = IN_IM(ccd) + out = OUT_IM(ccd) + ncols = OUT_C2(ccd) - OUT_C1(ccd) + 1 + nlines = OUT_L2(ccd) - OUT_L1(ccd) + 1 + + findmean = CORS(ccd, FINDMEAN) + if (findmean == YES) + mean = 0. + rep = CORS(ccd, MINREP) + if (rep == YES) + minrep = MINREPLACE(ccd) + + if (CORS(ccd, OVERSCAN) == 0) + overscan_type = 0 + else { + overscan_type = OVERSCAN_TYPE(ccd) + overscan_vec = OVERSCAN_VEC(ccd) + overscan_c1 = BIAS_C1(ccd) - 1 + noverscan = BIAS_C2(ccd) - overscan_c1 + } + + if (CORS(ccd, ZEROCOR) == 0) { + zeroim = NULL + zerobuf = 1 + } else if (IM_LEN(ZERO_IM(ccd),2) == 1) { + zeroim = NULL + zerobuf = ccd_gls (ZERO_IM(ccd), ZERO_C1(ccd), ZERO_C2(ccd), 1) + } else + zeroim = ZERO_IM(ccd) + + if (CORS(ccd, DARKCOR) == 0) { + darkim = NULL + darkbuf = 1 + } else if (IM_LEN(DARK_IM(ccd),2) == 1) { + darkim = NULL + darkbuf = ccd_gls (DARK_IM(ccd), DARK_C1(ccd), DARK_C2(ccd), 1) + darkscale = FLATSCALE(ccd) + } else { + darkim = DARK_IM(ccd) + darkscale = DARKSCALE(ccd) + } + + if (CORS(ccd, FLATCOR) == 0) { + flatim = NULL + flatbuf = 1 + } else if (IM_LEN(FLAT_IM(ccd),2) == 1) { + flatim = NULL + flatbuf = ccd_gls (FLAT_IM(ccd), FLAT_C1(ccd), FLAT_C2(ccd), 1) + flatscale = FLATSCALE(ccd) + } else { + flatim = FLAT_IM(ccd) + flatscale = FLATSCALE(ccd) + } + + if (CORS(ccd, ILLUMCOR) == 0) { + illumim = NULL + illumbuf = 1 + } else { + illumim = ILLUM_IM(ccd) + illumscale = ILLUMSCALE(ccd) + } + + if (CORS(ccd, FRINGECOR) == 0) { + fringeim = NULL + fringebuf = 1 + } else { + fringeim = FRINGE_IM(ccd) + frgscale = FRINGESCALE(ccd) + } + + # For each line read lines from the input. Procedure XT_FPS replaces + # bad pixels by interpolation. The trimmed region is copied to the + # output. Get lines from the output image and from the zero level, + # dark count, flat field, illumination, and fringe images. Call COR1 + # to do the actual pixel corrections. Finally, add the output pixels + # to a sum for computing the mean. We must copy data outside of the + # output data section. + + do line = 2 - OUT_L1(ccd), 0 + call amovs ( + Mems[imgl2s(in,IN_L1(ccd)+line-1)+IN_C1(ccd)-OUT_C1(ccd)], + Mems[impl2s(out,OUT_L1(ccd)+line-1)], IM_LEN(out,1)) + + do line = 1, nlines { + outbuf = impl2s (out, OUT_L1(ccd)+line-1) + + inbuf = xt_fpss (MASK_FP(ccd), in, IN_L1(ccd)+line-1, IN_C1(ccd), + IN_C2(ccd), IN_L1(ccd), IN_L2(ccd), NULL) + call amovs (Mems[inbuf+IN_C1(ccd)-OUT_C1(ccd)], Mems[outbuf], + IM_LEN(out,1)) + + outbuf = outbuf + OUT_C1(ccd) - 1 + if (overscan_type != 0) { + if (overscan_type < OVERSCAN_FIT) + overscan = find_overscans (Mems[inbuf+overscan_c1], + noverscan, overscan_type) + else + overscan = Memr[overscan_vec+line-1] + } + if (zeroim != NULL) + zerobuf = ccd_gls (zeroim, ZERO_C1(ccd), ZERO_C2(ccd), + ZERO_L1(ccd)+line-1) + if (darkim != NULL) + darkbuf = ccd_gls (darkim, DARK_C1(ccd), DARK_C2(ccd), + DARK_L1(ccd)+line-1) + if (flatim != NULL) + flatbuf = ccd_gls (flatim, FLAT_C1(ccd), FLAT_C2(ccd), + FLAT_L1(ccd)+line-1) + if (illumim != NULL) + illumbuf = ccd_gls (illumim, ILLUM_C1(ccd), ILLUM_C2(ccd), + ILLUM_L1(ccd)+line-1) + if (fringeim != NULL) + fringebuf = ccd_gls (fringeim, FRINGE_C1(ccd), FRINGE_C2(ccd), + FRINGE_L1(ccd)+line-1) + + call cor1s (CORS(ccd,1), Mems[outbuf], + overscan, Mems[zerobuf], Mems[darkbuf], + Mems[flatbuf], Mems[illumbuf], Mems[fringebuf], ncols, + darkscale, flatscale, illumscale, frgscale) + + if (rep == YES) + call amaxks (Mems[outbuf], minrep, Mems[outbuf], ncols) + if (findmean == YES) + mean = mean + asums (Mems[outbuf], ncols) + } + + do line = nlines+1, IM_LEN(out,2)-OUT_L1(ccd)+1 + call amovs ( + Mems[imgl2s(in,IN_L1(ccd)+line-1)+IN_C1(ccd)-OUT_C1(ccd)], + Mems[impl2s(out,OUT_L1(ccd)+line-1)], IM_LEN(out,1)) + + # Compute the mean from the sum of the output pixels. + if (findmean == YES) + MEAN(ccd) = mean / ncols / nlines +end + + +# PROC2 -- Process CCD images with readout axis 2 (columns). + +procedure proc2s (ccd) + +pointer ccd # CCD structure + +int line, ncols, nlines, findmean, rep +real darkscale, flatscale, illumscale, frgscale, mean +short minrep +pointer in, out, zeroim, darkim, flatim, illumim, fringeim, overscan_vec +pointer inbuf, outbuf, zerobuf, darkbuf, flatbuf, illumbuf, fringebuf + +real asums() +pointer imgl2s(), impl2s(), imgs2s(), ccd_gls(), xt_fpss() + +begin + # Initialize. If the correction image is 1D then just get the + # data once. + + in = IN_IM(ccd) + out = OUT_IM(ccd) + ncols = OUT_C2(ccd) - OUT_C1(ccd) + 1 + nlines = OUT_L2(ccd) - OUT_L1(ccd) + 1 + + findmean = CORS(ccd, FINDMEAN) + if (findmean == YES) + mean = 0. + rep = CORS(ccd, MINREP) + if (rep == YES) + minrep = MINREPLACE(ccd) + + overscan_vec = OVERSCAN_VEC(ccd) + + if (CORS(ccd, ZEROCOR) == 0) { + zeroim = NULL + zerobuf = 1 + } else if (IM_LEN(ZERO_IM(ccd),1) == 1) { + zeroim = NULL + zerobuf = imgs2s (ZERO_IM(ccd), 1, 1, ZERO_L1(ccd), ZERO_L2(ccd)) + } else + zeroim = ZERO_IM(ccd) + + if (CORS(ccd, DARKCOR) == 0) { + darkim = NULL + darkbuf = 1 + } else if (IM_LEN(DARK_IM(ccd),1) == 1) { + darkim = NULL + darkbuf = imgs2s (DARK_IM(ccd), 1, 1, DARK_L1(ccd), DARK_L2(ccd)) + darkscale = DARKSCALE(ccd) + } else { + darkim = DARK_IM(ccd) + darkscale = DARKSCALE(ccd) + } + + if (CORS(ccd, FLATCOR) == 0) { + flatim = NULL + flatbuf = 1 + } else if (IM_LEN(FLAT_IM(ccd),1) == 1) { + flatim = NULL + flatbuf = imgs2s (FLAT_IM(ccd), 1, 1, FLAT_L1(ccd), FLAT_L2(ccd)) + flatscale = FLATSCALE(ccd) + } else { + flatim = FLAT_IM(ccd) + flatscale = FLATSCALE(ccd) + } + + if (CORS(ccd, ILLUMCOR) == 0) { + illumim = NULL + illumbuf = 1 + } else { + illumim = ILLUM_IM(ccd) + illumscale = ILLUMSCALE(ccd) + } + + if (CORS(ccd, FRINGECOR) == 0) { + fringeim = NULL + fringebuf = 1 + } else { + fringeim = FRINGE_IM(ccd) + frgscale = FRINGESCALE(ccd) + } + + # For each line read lines from the input. Procedure CORINPUT + # replaces bad pixels by interpolation and applies a trim to the + # input. Get lines from the output image and from the zero level, + # dark count, flat field, illumination, and fringe images. + # Call COR2 to do the actual pixel corrections. Finally, add the + # output pixels to a sum for computing the mean. + # We must copy data outside of the output data section. + + do line = 2 - OUT_L1(ccd), 0 + call amovs ( + Mems[imgl2s(in,IN_L1(ccd)+line-1)+IN_C1(ccd)-OUT_C1(ccd)], + Mems[impl2s(out,OUT_L1(ccd)+line-1)], IM_LEN(out,1)) + + do line = 1, nlines { + outbuf = impl2s (out, OUT_L1(ccd)+line-1) + + inbuf = xt_fpss (MASK_FP(ccd), in, IN_L1(ccd)+line-1, IN_C1(ccd), + IN_C2(ccd), IN_L1(ccd), IN_L2(ccd), NULL) + call amovs (Mems[inbuf+IN_C1(ccd)-OUT_C1(ccd)], Mems[outbuf], + IM_LEN(out,1)) + + outbuf = outbuf + OUT_C1(ccd) - 1 + if (zeroim != NULL) + zerobuf = ccd_gls (zeroim, ZERO_C1(ccd), ZERO_C2(ccd), + ZERO_L1(ccd)+line-1) + if (darkim != NULL) + darkbuf = ccd_gls (darkim, DARK_C1(ccd), DARK_C2(ccd), + DARK_L1(ccd)+line-1) + if (flatim != NULL) + flatbuf = ccd_gls (flatim, FLAT_C1(ccd), FLAT_C2(ccd), + FLAT_L1(ccd)+line-1) + if (illumim != NULL) + illumbuf = ccd_gls (illumim, ILLUM_C1(ccd), ILLUM_C2(ccd), + ILLUM_L1(ccd)+line-1) + if (fringeim != NULL) + fringebuf = ccd_gls (fringeim, FRINGE_C1(ccd), FRINGE_C2(ccd), + FRINGE_L1(ccd)+line-1) + + call cor2s (line, CORS(ccd,1), Mems[outbuf], + Memr[overscan_vec], Mems[zerobuf], Mems[darkbuf], + Mems[flatbuf], Mems[illumbuf], Mems[fringebuf], ncols, + zeroim, flatim, darkscale, flatscale, illumscale, frgscale) + + if (rep == YES) + call amaxks (Mems[outbuf], minrep, Mems[outbuf], ncols) + if (findmean == YES) + mean = mean + asums (Mems[outbuf], ncols) + } + + do line = nlines+1, IM_LEN(out,2)-OUT_L1(ccd)+1 + call amovs ( + Mems[imgl2s(in,IN_L1(ccd)+line-1)+IN_C1(ccd)-OUT_C1(ccd)], + Mems[impl2s(out,OUT_L1(ccd)+line-1)], IM_LEN(out,1)) + + # Compute the mean from the sum of the output pixels. + if (findmean == YES) + MEAN(ccd) = mean / ncols / nlines +end + + +# FIND_OVERSCAN -- Find the overscan value for a line. +# No check is made on the number of pixels. +# The median is the (npix+1)/2 element. + +real procedure find_overscans (data, npix, type) + +short data[npix] #I Overscan data +int npix #I Number of overscan points +int type #I Type of overscan calculation + +int i +real overscan, d, dmin, dmax +short asoks() + +begin + if (type == OVERSCAN_MINMAX) { + overscan = data[1] + dmin = data[1] + dmax = data[1] + do i = 2, npix { + d = data[i] + overscan = overscan + d + if (d < dmin) + dmin = d + else if (d > dmax) + dmax = d + } + overscan = (overscan - dmin - dmax) / (npix - 2) + } else if (type == OVERSCAN_MEDIAN) + overscan = asoks (data, npix, (npix + 1) / 2) + else { + overscan = data[1] + do i = 2, npix + overscan = overscan + data[i] + overscan = overscan / npix + } + + return (overscan) +end + +# PROC1 -- Process CCD images with readout axis 1 (lines). + +procedure proc1r (ccd) + +pointer ccd # CCD structure + +int line, ncols, nlines, findmean, rep +int overscan_type, overscan_c1, noverscan +real overscan, darkscale, flatscale, illumscale, frgscale, mean +real minrep +pointer in, out, zeroim, darkim, flatim, illumim, fringeim, overscan_vec +pointer inbuf, outbuf, zerobuf, darkbuf, flatbuf, illumbuf, fringebuf + +real asumr() +real find_overscanr() +pointer imgl2r(), impl2r(), ccd_glr(), xt_fpsr() + +begin + # Initialize. If the correction image is 1D then just get the + # data once. + + in = IN_IM(ccd) + out = OUT_IM(ccd) + ncols = OUT_C2(ccd) - OUT_C1(ccd) + 1 + nlines = OUT_L2(ccd) - OUT_L1(ccd) + 1 + + findmean = CORS(ccd, FINDMEAN) + if (findmean == YES) + mean = 0. + rep = CORS(ccd, MINREP) + if (rep == YES) + minrep = MINREPLACE(ccd) + + if (CORS(ccd, OVERSCAN) == 0) + overscan_type = 0 + else { + overscan_type = OVERSCAN_TYPE(ccd) + overscan_vec = OVERSCAN_VEC(ccd) + overscan_c1 = BIAS_C1(ccd) - 1 + noverscan = BIAS_C2(ccd) - overscan_c1 + } + + if (CORS(ccd, ZEROCOR) == 0) { + zeroim = NULL + zerobuf = 1 + } else if (IM_LEN(ZERO_IM(ccd),2) == 1) { + zeroim = NULL + zerobuf = ccd_glr (ZERO_IM(ccd), ZERO_C1(ccd), ZERO_C2(ccd), 1) + } else + zeroim = ZERO_IM(ccd) + + if (CORS(ccd, DARKCOR) == 0) { + darkim = NULL + darkbuf = 1 + } else if (IM_LEN(DARK_IM(ccd),2) == 1) { + darkim = NULL + darkbuf = ccd_glr (DARK_IM(ccd), DARK_C1(ccd), DARK_C2(ccd), 1) + darkscale = FLATSCALE(ccd) + } else { + darkim = DARK_IM(ccd) + darkscale = DARKSCALE(ccd) + } + + if (CORS(ccd, FLATCOR) == 0) { + flatim = NULL + flatbuf = 1 + } else if (IM_LEN(FLAT_IM(ccd),2) == 1) { + flatim = NULL + flatbuf = ccd_glr (FLAT_IM(ccd), FLAT_C1(ccd), FLAT_C2(ccd), 1) + flatscale = FLATSCALE(ccd) + } else { + flatim = FLAT_IM(ccd) + flatscale = FLATSCALE(ccd) + } + + if (CORS(ccd, ILLUMCOR) == 0) { + illumim = NULL + illumbuf = 1 + } else { + illumim = ILLUM_IM(ccd) + illumscale = ILLUMSCALE(ccd) + } + + if (CORS(ccd, FRINGECOR) == 0) { + fringeim = NULL + fringebuf = 1 + } else { + fringeim = FRINGE_IM(ccd) + frgscale = FRINGESCALE(ccd) + } + + # For each line read lines from the input. Procedure XT_FPS replaces + # bad pixels by interpolation. The trimmed region is copied to the + # output. Get lines from the output image and from the zero level, + # dark count, flat field, illumination, and fringe images. Call COR1 + # to do the actual pixel corrections. Finally, add the output pixels + # to a sum for computing the mean. We must copy data outside of the + # output data section. + + do line = 2 - OUT_L1(ccd), 0 + call amovr ( + Memr[imgl2r(in,IN_L1(ccd)+line-1)+IN_C1(ccd)-OUT_C1(ccd)], + Memr[impl2r(out,OUT_L1(ccd)+line-1)], IM_LEN(out,1)) + + do line = 1, nlines { + outbuf = impl2r (out, OUT_L1(ccd)+line-1) + + inbuf = xt_fpsr (MASK_FP(ccd), in, IN_L1(ccd)+line-1, IN_C1(ccd), + IN_C2(ccd), IN_L1(ccd), IN_L2(ccd), NULL) + call amovr (Memr[inbuf+IN_C1(ccd)-OUT_C1(ccd)], Memr[outbuf], + IM_LEN(out,1)) + + outbuf = outbuf + OUT_C1(ccd) - 1 + if (overscan_type != 0) { + if (overscan_type < OVERSCAN_FIT) + overscan = find_overscanr (Memr[inbuf+overscan_c1], + noverscan, overscan_type) + else + overscan = Memr[overscan_vec+line-1] + } + if (zeroim != NULL) + zerobuf = ccd_glr (zeroim, ZERO_C1(ccd), ZERO_C2(ccd), + ZERO_L1(ccd)+line-1) + if (darkim != NULL) + darkbuf = ccd_glr (darkim, DARK_C1(ccd), DARK_C2(ccd), + DARK_L1(ccd)+line-1) + if (flatim != NULL) + flatbuf = ccd_glr (flatim, FLAT_C1(ccd), FLAT_C2(ccd), + FLAT_L1(ccd)+line-1) + if (illumim != NULL) + illumbuf = ccd_glr (illumim, ILLUM_C1(ccd), ILLUM_C2(ccd), + ILLUM_L1(ccd)+line-1) + if (fringeim != NULL) + fringebuf = ccd_glr (fringeim, FRINGE_C1(ccd), FRINGE_C2(ccd), + FRINGE_L1(ccd)+line-1) + + call cor1r (CORS(ccd,1), Memr[outbuf], + overscan, Memr[zerobuf], Memr[darkbuf], + Memr[flatbuf], Memr[illumbuf], Memr[fringebuf], ncols, + darkscale, flatscale, illumscale, frgscale) + + if (rep == YES) + call amaxkr (Memr[outbuf], minrep, Memr[outbuf], ncols) + if (findmean == YES) + mean = mean + asumr (Memr[outbuf], ncols) + } + + do line = nlines+1, IM_LEN(out,2)-OUT_L1(ccd)+1 + call amovr ( + Memr[imgl2r(in,IN_L1(ccd)+line-1)+IN_C1(ccd)-OUT_C1(ccd)], + Memr[impl2r(out,OUT_L1(ccd)+line-1)], IM_LEN(out,1)) + + # Compute the mean from the sum of the output pixels. + if (findmean == YES) + MEAN(ccd) = mean / ncols / nlines +end + + +# PROC2 -- Process CCD images with readout axis 2 (columns). + +procedure proc2r (ccd) + +pointer ccd # CCD structure + +int line, ncols, nlines, findmean, rep +real darkscale, flatscale, illumscale, frgscale, mean +real minrep +pointer in, out, zeroim, darkim, flatim, illumim, fringeim, overscan_vec +pointer inbuf, outbuf, zerobuf, darkbuf, flatbuf, illumbuf, fringebuf + +real asumr() +pointer imgl2r(), impl2r(), imgs2r(), ccd_glr(), xt_fpsr() + +begin + # Initialize. If the correction image is 1D then just get the + # data once. + + in = IN_IM(ccd) + out = OUT_IM(ccd) + ncols = OUT_C2(ccd) - OUT_C1(ccd) + 1 + nlines = OUT_L2(ccd) - OUT_L1(ccd) + 1 + + findmean = CORS(ccd, FINDMEAN) + if (findmean == YES) + mean = 0. + rep = CORS(ccd, MINREP) + if (rep == YES) + minrep = MINREPLACE(ccd) + + overscan_vec = OVERSCAN_VEC(ccd) + + if (CORS(ccd, ZEROCOR) == 0) { + zeroim = NULL + zerobuf = 1 + } else if (IM_LEN(ZERO_IM(ccd),1) == 1) { + zeroim = NULL + zerobuf = imgs2r (ZERO_IM(ccd), 1, 1, ZERO_L1(ccd), ZERO_L2(ccd)) + } else + zeroim = ZERO_IM(ccd) + + if (CORS(ccd, DARKCOR) == 0) { + darkim = NULL + darkbuf = 1 + } else if (IM_LEN(DARK_IM(ccd),1) == 1) { + darkim = NULL + darkbuf = imgs2r (DARK_IM(ccd), 1, 1, DARK_L1(ccd), DARK_L2(ccd)) + darkscale = DARKSCALE(ccd) + } else { + darkim = DARK_IM(ccd) + darkscale = DARKSCALE(ccd) + } + + if (CORS(ccd, FLATCOR) == 0) { + flatim = NULL + flatbuf = 1 + } else if (IM_LEN(FLAT_IM(ccd),1) == 1) { + flatim = NULL + flatbuf = imgs2r (FLAT_IM(ccd), 1, 1, FLAT_L1(ccd), FLAT_L2(ccd)) + flatscale = FLATSCALE(ccd) + } else { + flatim = FLAT_IM(ccd) + flatscale = FLATSCALE(ccd) + } + + if (CORS(ccd, ILLUMCOR) == 0) { + illumim = NULL + illumbuf = 1 + } else { + illumim = ILLUM_IM(ccd) + illumscale = ILLUMSCALE(ccd) + } + + if (CORS(ccd, FRINGECOR) == 0) { + fringeim = NULL + fringebuf = 1 + } else { + fringeim = FRINGE_IM(ccd) + frgscale = FRINGESCALE(ccd) + } + + # For each line read lines from the input. Procedure CORINPUT + # replaces bad pixels by interpolation and applies a trim to the + # input. Get lines from the output image and from the zero level, + # dark count, flat field, illumination, and fringe images. + # Call COR2 to do the actual pixel corrections. Finally, add the + # output pixels to a sum for computing the mean. + # We must copy data outside of the output data section. + + do line = 2 - OUT_L1(ccd), 0 + call amovr ( + Memr[imgl2r(in,IN_L1(ccd)+line-1)+IN_C1(ccd)-OUT_C1(ccd)], + Memr[impl2r(out,OUT_L1(ccd)+line-1)], IM_LEN(out,1)) + + do line = 1, nlines { + outbuf = impl2r (out, OUT_L1(ccd)+line-1) + + inbuf = xt_fpsr (MASK_FP(ccd), in, IN_L1(ccd)+line-1, IN_C1(ccd), + IN_C2(ccd), IN_L1(ccd), IN_L2(ccd), NULL) + call amovr (Memr[inbuf+IN_C1(ccd)-OUT_C1(ccd)], Memr[outbuf], + IM_LEN(out,1)) + + outbuf = outbuf + OUT_C1(ccd) - 1 + if (zeroim != NULL) + zerobuf = ccd_glr (zeroim, ZERO_C1(ccd), ZERO_C2(ccd), + ZERO_L1(ccd)+line-1) + if (darkim != NULL) + darkbuf = ccd_glr (darkim, DARK_C1(ccd), DARK_C2(ccd), + DARK_L1(ccd)+line-1) + if (flatim != NULL) + flatbuf = ccd_glr (flatim, FLAT_C1(ccd), FLAT_C2(ccd), + FLAT_L1(ccd)+line-1) + if (illumim != NULL) + illumbuf = ccd_glr (illumim, ILLUM_C1(ccd), ILLUM_C2(ccd), + ILLUM_L1(ccd)+line-1) + if (fringeim != NULL) + fringebuf = ccd_glr (fringeim, FRINGE_C1(ccd), FRINGE_C2(ccd), + FRINGE_L1(ccd)+line-1) + + call cor2r (line, CORS(ccd,1), Memr[outbuf], + Memr[overscan_vec], Memr[zerobuf], Memr[darkbuf], + Memr[flatbuf], Memr[illumbuf], Memr[fringebuf], ncols, + zeroim, flatim, darkscale, flatscale, illumscale, frgscale) + + if (rep == YES) + call amaxkr (Memr[outbuf], minrep, Memr[outbuf], ncols) + if (findmean == YES) + mean = mean + asumr (Memr[outbuf], ncols) + } + + do line = nlines+1, IM_LEN(out,2)-OUT_L1(ccd)+1 + call amovr ( + Memr[imgl2r(in,IN_L1(ccd)+line-1)+IN_C1(ccd)-OUT_C1(ccd)], + Memr[impl2r(out,OUT_L1(ccd)+line-1)], IM_LEN(out,1)) + + # Compute the mean from the sum of the output pixels. + if (findmean == YES) + MEAN(ccd) = mean / ncols / nlines +end + + +# FIND_OVERSCAN -- Find the overscan value for a line. +# No check is made on the number of pixels. +# The median is the (npix+1)/2 element. + +real procedure find_overscanr (data, npix, type) + +real data[npix] #I Overscan data +int npix #I Number of overscan points +int type #I Type of overscan calculation + +int i +real overscan, d, dmin, dmax +real asokr() + +begin + if (type == OVERSCAN_MINMAX) { + overscan = data[1] + dmin = data[1] + dmax = data[1] + do i = 2, npix { + d = data[i] + overscan = overscan + d + if (d < dmin) + dmin = d + else if (d > dmax) + dmax = d + } + overscan = (overscan - dmin - dmax) / (npix - 2) + } else if (type == OVERSCAN_MEDIAN) + overscan = asokr (data, npix, (npix + 1) / 2) + else { + overscan = data[1] + do i = 2, npix + overscan = overscan + data[i] + overscan = overscan / npix + } + + return (overscan) +end diff --git a/noao/imred/ccdred/src/hdrmap.com b/noao/imred/ccdred/src/hdrmap.com new file mode 100644 index 00000000..5aa74185 --- /dev/null +++ b/noao/imred/ccdred/src/hdrmap.com @@ -0,0 +1,4 @@ +# Common for HDRMAP package. + +pointer stp # Symbol table pointer +common /hdmcom/ stp diff --git a/noao/imred/ccdred/src/hdrmap.x b/noao/imred/ccdred/src/hdrmap.x new file mode 100644 index 00000000..ebcb253e --- /dev/null +++ b/noao/imred/ccdred/src/hdrmap.x @@ -0,0 +1,544 @@ +include <error.h> +include <syserr.h> + +.help hdrmap +.nf----------------------------------------------------------------------------- +HDRMAP -- Map translation between task parameters and image header parameters. + +In order for tasks to be partially independent of the image header +parameter names used by different instruments and observatories a +translation is made between task parameters and image header +parameters. This translation is given in a file consisting of the task +parameter name, the image header parameter name, and an optional +default value. This file is turned into a symbol table. If the +translation file is not found a null pointer is returned. The package will +then use the task parameter names directly. Also if there is no +translation given in the file for a particular parameter it is passed +on directly. If a parameter is not in the image header then the symbol +table default value, if given, is returned. This package is layered on +the IMIO header package. + + hdmopen (fname) + hdmclose () + hdmwrite (fname, mode) + hdmname (parameter, str, max_char) + hdmgdef (parameter, str, max_char) + hdmpdef (parameter, str, max_char) + y/n = hdmaccf (im, parameter) + hdmgstr (im, parameter, str, max_char) + ival = hdmgeti (im, parameter) + rval = hdmgetr (im, parameter) + hdmpstr (im, parameter, str) + hdmputi (im, parameter, value) + hdmputr (im, parameter, value) + hdmgstp (stp) + hdmpstp (stp) + hdmdelf (im, parameter) + hdmparm (name, parameter, max_char) + +hdmopen -- Open the translation file and map it into a symbol table pointer. +hdmclose -- Close the symbol table pointer. +hdmwrite -- Write out translation file. +hdmname -- Return the image header parameter name. +hdmpname -- Put the image header parameter name. +hdmgdef -- Get the default value as a string (null if none). +hdmpdef -- Put the default value as a string. +hdmaccf -- Return whether the image header parameter exists (regardless of + whether there is a default value). +hdmgstr -- Get a string valued parameter. Return default value if not in the + image header. Return null string if no default or image value. +hdmgeti -- Get an integer valued parameter. Return default value if not in + the image header and error condition if no default or image value. +hdmgetr -- Get a real valued parameter. Return default value if not in + the image header or error condition if no default or image value. +hdmpstr -- Put a string valued parameter in the image header. +hdmputi -- Put an integer valued parameter in the image header. +hdmputr -- Put a real valued parameter in the image header. +hdmgstp -- Get the symbol table pointer to save it while another map is used. +hdmpstp -- Put the symbol table pointer to restore a map. +hdmdelf -- Delete a field. +hdmparm -- Return the parameter name corresponding to an image header name. +.endhelp ----------------------------------------------------------------------- + +# Symbol table definitions. +define LEN_INDEX 32 # Length of symtab index +define LEN_STAB 1024 # Length of symtab string buffer +define SZ_SBUF 128 # Size of symtab string buffer + +define SZ_NAME 79 # Size of translation symbol name +define SZ_DEFAULT 79 # Size of default string +define SYMLEN 80 # Length of symbol structure + +# Symbol table structure +define NAME Memc[P2C($1)] # Translation name for symbol +define DEFAULT Memc[P2C($1+40)] # Default value of parameter + + +# HDMOPEN -- Open the translation file and map it into a symbol table pointer. + +procedure hdmopen (fname) + +char fname[ARB] # Image header map file + +int fd, open(), fscan(), nscan(), errcode() +pointer sp, parameter, sym, stopen(), stenter() +include "hdrmap.com" + +begin + # Create an empty symbol table. + stp = stopen (fname, LEN_INDEX, LEN_STAB, SZ_SBUF) + + # Return if file not found. + iferr (fd = open (fname, READ_ONLY, TEXT_FILE)) { + if (errcode () != SYS_FNOFNAME) + call erract (EA_WARN) + return + } + + call smark (sp) + call salloc (parameter, SZ_NAME, TY_CHAR) + + # Read the file an enter the translations in the symbol table. + while (fscan(fd) != EOF) { + call gargwrd (Memc[parameter], SZ_NAME) + if ((nscan() == 0) || (Memc[parameter] == '#')) + next + sym = stenter (stp, Memc[parameter], SYMLEN) + call gargwrd (NAME(sym), SZ_NAME) + call gargwrd (DEFAULT(sym), SZ_DEFAULT) + } + + call close (fd) + call sfree (sp) +end + + +# HDMCLOSE -- Close the symbol table pointer. + +procedure hdmclose () + +include "hdrmap.com" + +begin + if (stp != NULL) + call stclose (stp) +end + + +# HDMWRITE -- Write out translation file. + +procedure hdmwrite (fname, mode) + +char fname[ARB] # Image header map file +int mode # Access mode (APPEND, NEW_FILE) + +int fd, open(), stridxs() +pointer sym, sthead(), stnext(), stname() +errchk open +include "hdrmap.com" + +begin + # If there is no symbol table do nothing. + if (stp == NULL) + return + + fd = open (fname, mode, TEXT_FILE) + + sym = sthead (stp) + for (sym = sthead (stp); sym != NULL; sym = stnext (stp, sym)) { + if (stridxs (" ", Memc[stname (stp, sym)]) > 0) + call fprintf (fd, "'%s'%30t") + else + call fprintf (fd, "%s%30t") + call pargstr (Memc[stname (stp, sym)]) + if (stridxs (" ", NAME(sym)) > 0) + call fprintf (fd, " '%s'%10t") + else + call fprintf (fd, " %s%10t") + call pargstr (NAME(sym)) + if (DEFAULT(sym) != EOS) { + if (stridxs (" ", DEFAULT(sym)) > 0) + call fprintf (fd, " '%s'") + else + call fprintf (fd, " %s") + call pargstr (DEFAULT(sym)) + } + call fprintf (fd, "\n") + } + + call close (fd) +end + + +# HDMNAME -- Return the image header parameter name + +procedure hdmname (parameter, str, max_char) + +char parameter[ARB] # Parameter name +char str[max_char] # String containing mapped parameter name +int max_char # Maximum characters in string + +pointer sym, stfind() +include "hdrmap.com" + +begin + if (stp != NULL) + sym = stfind (stp, parameter) + else + sym = NULL + + if (sym != NULL) + call strcpy (NAME(sym), str, max_char) + else + call strcpy (parameter, str, max_char) +end + + +# HDMPNAME -- Put the image header parameter name + +procedure hdmpname (parameter, str) + +char parameter[ARB] # Parameter name +char str[ARB] # String containing mapped parameter name + +pointer sym, stfind(), stenter() +include "hdrmap.com" + +begin + if (stp == NULL) + return + + sym = stfind (stp, parameter) + if (sym == NULL) { + sym = stenter (stp, parameter, SYMLEN) + DEFAULT(sym) = EOS + } + + call strcpy (str, NAME(sym), SZ_NAME) +end + + +# HDMGDEF -- Get the default value as a string (null string if none). + +procedure hdmgdef (parameter, str, max_char) + +char parameter[ARB] # Parameter name +char str[max_char] # String containing default value +int max_char # Maximum characters in string + +pointer sym, stfind() +include "hdrmap.com" + +begin + if (stp != NULL) + sym = stfind (stp, parameter) + else + sym = NULL + + if (sym != NULL) + call strcpy (DEFAULT(sym), str, max_char) + else + str[1] = EOS +end + + +# HDMPDEF -- PUt the default value as a string. + +procedure hdmpdef (parameter, str) + +char parameter[ARB] # Parameter name +char str[ARB] # String containing default value + +pointer sym, stfind(), stenter() +include "hdrmap.com" + +begin + if (stp == NULL) + return + + sym = stfind (stp, parameter) + if (sym == NULL) { + sym = stenter (stp, parameter, SYMLEN) + call strcpy (parameter, NAME(sym), SZ_NAME) + } + + call strcpy (str, DEFAULT(sym), SZ_DEFAULT) +end + + +# HDMACCF -- Return whether the image header parameter exists (regardless of +# whether there is a default value). + +int procedure hdmaccf (im, parameter) + +pointer im # IMIO pointer +char parameter[ARB] # Parameter name + +int imaccf() +pointer sym, stfind() +include "hdrmap.com" + +begin + if (stp != NULL) + sym = stfind (stp, parameter) + else + sym = NULL + + if (sym != NULL) + return (imaccf (im, NAME(sym))) + else + return (imaccf (im, parameter)) +end + + +# HDMGSTR -- Get a string valued parameter. Return default value if not in +# the image header. Return null string if no default or image value. + +procedure hdmgstr (im, parameter, str, max_char) + +pointer im # IMIO pointer +char parameter[ARB] # Parameter name +char str[max_char] # String value to return +int max_char # Maximum characters in returned string + +pointer sym, stfind() +include "hdrmap.com" + +begin + if (stp != NULL) + sym = stfind (stp, parameter) + else + sym = NULL + + if (sym != NULL) { + iferr (call imgstr (im, NAME(sym), str, max_char)) + call strcpy (DEFAULT(sym), str, max_char) + } else { + iferr (call imgstr (im, parameter, str, max_char)) + str[1] = EOS + } +end + + +# HDMGETR -- Get a real valued parameter. Return default value if not in +# the image header. Return error condition if no default or image value. + +real procedure hdmgetr (im, parameter) + +pointer im # IMIO pointer +char parameter[ARB] # Parameter name + +int ip, ctor() +real value, imgetr() +pointer sym, stfind() +include "hdrmap.com" + +begin + if (stp != NULL) + sym = stfind (stp, parameter) + else + sym = NULL + + if (sym != NULL) { + iferr (value = imgetr (im, NAME(sym))) { + ip = 1 + if (ctor (DEFAULT(sym), ip, value) == 0) + call error (0, "HDMGETR: No value found") + } + } else + value = imgetr (im, parameter) + + return (value) +end + + +# HDMGETI -- Get an integer valued parameter. Return default value if not in +# the image header. Return error condition if no default or image value. + +int procedure hdmgeti (im, parameter) + +pointer im # IMIO pointer +char parameter[ARB] # Parameter name + +int ip, ctoi() +int value, imgeti() +pointer sym, stfind() +include "hdrmap.com" + +begin + if (stp != NULL) + sym = stfind (stp, parameter) + else + sym = NULL + + if (sym != NULL) { + iferr (value = imgeti (im, NAME(sym))) { + ip = 1 + if (ctoi (DEFAULT(sym), ip, value) == 0) + call error (0, "HDMGETI: No value found") + } + } else + value = imgeti (im, parameter) + + return (value) +end + + +# HDMPSTR -- Put a string valued parameter in the image header. + +procedure hdmpstr (im, parameter, str) + +pointer im # IMIO pointer +char parameter[ARB] # Parameter name +char str[ARB] # String value + +int imaccf(), imgftype() +pointer sym, stfind() +include "hdrmap.com" + +begin + if (stp != NULL) + sym = stfind (stp, parameter) + else + sym = NULL + + if (sym != NULL) { + if (imaccf (im, NAME(sym)) == YES) + if (imgftype (im, NAME(sym)) != TY_CHAR) + call imdelf (im, NAME(sym)) + call imastr (im, NAME(sym), str) + } else { + if (imaccf (im, parameter) == YES) + if (imgftype (im, parameter) != TY_CHAR) + call imdelf (im, parameter) + call imastr (im, parameter, str) + } +end + + +# HDMPUTI -- Put an integer valued parameter in the image header. + +procedure hdmputi (im, parameter, value) + +pointer im # IMIO pointer +char parameter[ARB] # Parameter name +int value # Integer value to put + +pointer sym, stfind() +include "hdrmap.com" + +begin + if (stp != NULL) + sym = stfind (stp, parameter) + else + sym = NULL + + if (sym != NULL) + call imaddi (im, NAME(sym), value) + else + call imaddi (im, parameter, value) +end + + +# HDMPUTR -- Put a real valued parameter in the image header. + +procedure hdmputr (im, parameter, value) + +pointer im # IMIO pointer +char parameter[ARB] # Parameter name +real value # Real value to put + +pointer sym, stfind() +include "hdrmap.com" + +begin + if (stp != NULL) + sym = stfind (stp, parameter) + else + sym = NULL + + if (sym != NULL) + call imaddr (im, NAME(sym), value) + else + call imaddr (im, parameter, value) +end + + +# HDMGSTP -- Get the symbol table pointer to save a translation map. +# The symbol table is restored with HDMPSTP. + +procedure hdmgstp (ptr) + +pointer ptr # Symbol table pointer to return + +include "hdrmap.com" + +begin + ptr = stp +end + + +# HDMPSTP -- Put a symbol table pointer to restore a header map. +# The symbol table is optained with HDMGSTP. + +procedure hdmpstp (ptr) + +pointer ptr # Symbol table pointer to restore + +include "hdrmap.com" + +begin + stp = ptr +end + + +# HDMDELF -- Delete a field. It is an error if the field does not exist. + +procedure hdmdelf (im, parameter) + +pointer im # IMIO pointer +char parameter[ARB] # Parameter name + +pointer sym, stfind() +include "hdrmap.com" + +begin + if (stp != NULL) + sym = stfind (stp, parameter) + else + sym = NULL + + if (sym != NULL) + call imdelf (im, NAME(sym)) + else + call imdelf (im, parameter) +end + + +# HDMPARAM -- Get parameter given the image header name. + +procedure hdmparam (name, parameter, max_char) + +char name[ARB] # Image header name +char parameter[max_char] # Parameter +int max_char # Maximum size of parameter string + +bool streq() +pointer sym, sthead(), stname(), stnext() +include "hdrmap.com" + +begin + if (stp != NULL) + sym = sthead (stp) + else + sym = NULL + + while (sym != NULL) { + if (streq (NAME(sym), name)) { + call strcpy (Memc[stname(stp, sym)], parameter, max_char) + return + } + sym = stnext (stp, sym) + } + call strcpy (name, parameter, max_char) +end diff --git a/noao/imred/ccdred/src/icaclip.gx b/noao/imred/ccdred/src/icaclip.gx new file mode 100644 index 00000000..bb592542 --- /dev/null +++ b/noao/imred/ccdred/src/icaclip.gx @@ -0,0 +1,573 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "../icombine.h" + +define MINCLIP 3 # Minimum number of images for this algorithm + +$for (sr) +# IC_AAVSIGCLIP -- Reject pixels using an average sigma about the average +# The average sigma is normalized by the expected poisson sigma. + +procedure ic_aavsigclip$t (d, m, n, scales, zeros, nimages, npts, average) + +pointer d[nimages] # Data pointers +pointer m[nimages] # Image id pointers +int n[npts] # Number of good pixels +real scales[nimages] # Scales +real zeros[nimages] # Zeros +int nimages # Number of images +int npts # Number of output points per line +$if (datatype == sil) +real average[npts] # Average +$else +PIXEL average[npts] # Average +$endif + +int i, j, k, l, jj, n1, n2, nin, nk, maxkeep +$if (datatype == sil) +real d1, low, high, sum, a, s, s1, r, one +data one /1.0/ +$else +PIXEL d1, low, high, sum, a, s, s1, r, one +data one /1$f/ +$endif +pointer sp, sums, resid, dp1, dp2, mp1, mp2 + +include "../icombine.com" + +begin + # If there are insufficient pixels go on to the combining. + if (nkeep < 0) + maxkeep = max (0, nimages + nkeep) + else + maxkeep = min (nimages, nkeep) + if (nimages < max (MINCLIP, maxkeep+1) || dflag == D_NONE) { + docombine = true + return + } + + call smark (sp) + call salloc (sums, npts, TY_REAL) + call salloc (resid, nimages+1, TY_REAL) + + # Since the unweighted average is computed here possibly skip combining + if (dowts || combine != AVERAGE) + docombine = true + else + docombine = false + + # Compute the unweighted average with the high and low rejected and + # the poisson scaled average sigma. There must be at least three + # pixels at each point to define the average and contributions to + # the mean sigma. Corrections for differences in the image + # scale factors are selected by the doscale1 flag. + + nin = n[1] + s = 0. + n2 = 0 + do i = 1, npts { + k = i - 1 + n1 = n[i] + if (n1 < 3) + next + + # Unweighted average with the high and low rejected + low = Mem$t[d[1]+k] + high = Mem$t[d[2]+k] + if (low > high) { + d1 = low + low = high + high = d1 + } + sum = 0. + do j = 3, n1 { + d1 = Mem$t[d[j]+k] + if (d1 < low) { + sum = sum + low + low = d1 + } else if (d1 > high) { + sum = sum + high + high = d1 + } else + sum = sum + d1 + } + a = sum / (n1 - 2) + sum = sum + low + high + + # Poisson scaled sigma accumulation + if (doscale1) { + do j = 1, n1 { + dp1 = d[j] + k + mp1 = m[j] + k + + d1 = Mem$t[dp1] + l = Memi[mp1] + s1 = max (one, (a + zeros[l]) / scales[l]) + s = s + (d1 - a) ** 2 / s1 + } + } else { + s1 = max (one, a) + do j = 1, n1 + s = s + (Mem$t[d[j]+k] - a) ** 2 / s1 + } + n2 = n2 + n1 + + # Save the average and sum for later. + average[i] = a + Memr[sums+k] = sum + } + + # Here is the final sigma. + if (n2 > 1) + s = sqrt (s / (n2 - 1)) + + # Reject pixels and compute the final average (if needed). + # There must be at least three pixels at each point for rejection. + # Iteratively scale the mean sigma and reject pixels + # Compact the data and keep track of the image IDs if needed. + + do i = 1, npts { + k = i - 1 + n1 = n[i] + if (nkeep < 0) + maxkeep = max (0, n1 + nkeep) + else + maxkeep = min (n1, nkeep) + if (n1 <= max (2, maxkeep)) { + if (!docombine) { + if (n1 == 0) + average[i] = blank + else { + sum = Mem$t[d[1]+k] + do j = 2, n1 + sum = sum + Mem$t[d[j]+k] + average[i] = sum / n1 + } + } + next + } + + a = average[i] + sum = Memr[sums+k] + + repeat { + n2 = n1 + if (s > 0.) { + if (doscale1) { + for (j=1; j<=n1; j=j+1) { + dp1 = d[j] + k + mp1 = m[j] + k + + d1 = Mem$t[dp1] + l = Memi[mp1] + s1 = s * sqrt (max (one, (a+zeros[l]) / scales[l])) + r = (d1 - a) / s1 + if (r < -lsigma || r > hsigma) { + Memr[resid+n1] = abs(r) + if (j < n1) { + dp2 = d[n1] + k + Mem$t[dp1] = Mem$t[dp2] + Mem$t[dp2] = d1 + mp2 = m[n1] + k + Memi[mp1] = Memi[mp2] + Memi[mp2] = l + j = j - 1 + } + sum = sum - d1 + n1 = n1 - 1 + } + } + } else { + s1 = s * sqrt (max (one, a)) + for (j=1; j<=n1; j=j+1) { + dp1 = d[j] + k + d1 = Mem$t[dp1] + r = (d1 - a) / s1 + if (r < -lsigma || r > hsigma) { + Memr[resid+n1] = abs(r) + if (j < n1) { + dp2 = d[n1] + k + Mem$t[dp1] = Mem$t[dp2] + Mem$t[dp2] = d1 + if (keepids) { + mp1 = m[j] + k + mp2 = m[n1] + k + l = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = l + } + j = j - 1 + } + sum = sum - d1 + n1 = n1 - 1 + } + } + } + } + if (n1 > 1) + a = sum / n1 + } until (n1 == n2 || n1 <= max (2, maxkeep)) + + # If too many are rejected add some back in. + # Pixels with equal residuals are added together. + if (n1 < maxkeep) { + nk = maxkeep + if (doscale1) { + for (j=n1+1; j<=nk; j=j+1) { + dp1 = d[j] + k + mp1 = m[j] + k + r = Memr[resid+j] + jj = 0 + do l = j+1, n2 { + s = Memr[resid+l] + if (s < r + TOL) { + if (s > r - TOL) + jj = jj + 1 + else { + jj = 0 + Memr[resid+l] = r + r = s + dp2 = d[l] + k + d1 = Mem$t[dp1] + Mem$t[dp1] = Mem$t[dp2] + Mem$t[dp2] = d1 + mp2 = m[l] + k + s = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = s + } + } + } + sum = sum + Mem$t[dp1] + n1 = n1 + 1 + nk = max (nk, j+jj) + } + } else { + for (j=n1+1; j<=nk; j=j+1) { + dp1 = d[j] + k + r = Memr[resid+j] + jj = 0 + do l = j+1, n2 { + s = Memr[resid+l] + if (s < r + TOL) { + if (s > r - TOL) + jj = jj + 1 + else { + jj = 0 + Memr[resid+l] = r + r = s + dp2 = d[l] + k + d1 = Mem$t[dp1] + Mem$t[dp1] = Mem$t[dp2] + Mem$t[dp2] = d1 + if (keepids) { + mp1 = m[j] + k + mp2 = m[l] + k + s = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = s + } + } + } + } + sum = sum + Mem$t[dp1] + n1 = n1 + 1 + nk = max (nk, j+jj) + } + } + if (n1 > 1) + a = sum / n1 + } + + # Save the average if needed. + n[i] = n1 + if (!docombine) { + if (n1 > 0) + average[i] = a + else + average[i] = blank + } + } + + # Check if the data flag has to be reset for rejected pixels + if (dflag == D_ALL) { + do i = 1, npts { + if (n[i] != nin) { + dflag = D_MIX + break + } + } + } + + call sfree (sp) +end + + +# IC_MAVSIGCLIP -- Reject pixels using an average sigma about the median +# The average sigma is normalized by the expected poisson sigma. + +procedure ic_mavsigclip$t (d, m, n, scales, zeros, nimages, npts, median) + +pointer d[nimages] # Data pointers +pointer m[nimages] # Image id pointers +int n[npts] # Number of good pixels +real scales[nimages] # Scales +real zeros[nimages] # Zeros +int nimages # Number of images +int npts # Number of output points per line +$if (datatype == sil) +real median[npts] # Median +$else +PIXEL median[npts] # Median +$endif + +int i, j, k, l, id, n1, n2, n3, nl, nh, nin, maxkeep +pointer sp, resid, mp1, mp2 +$if (datatype == sil) +real med, low, high, r, s, s1, one +data one /1.0/ +$else +PIXEL med, low, high, r, s, s1, one +data one /1$f/ +$endif + +include "../icombine.com" + +begin + # If there are insufficient pixels go on to the combining. + if (nkeep < 0) + maxkeep = max (0, nimages + nkeep) + else + maxkeep = min (nimages, nkeep) + if (nimages < max (MINCLIP, maxkeep+1) || dflag == D_NONE) { + docombine = true + return + } + + call smark (sp) + call salloc (resid, nimages+1, TY_REAL) + + # Compute the poisson scaled average sigma about the median. + # There must be at least three pixels at each point to define + # the mean sigma. Corrections for differences in the image + # scale factors are selected by the doscale1 flag. + + s = 0. + n2 = 0 + nin = n[1] + do i = 1, npts { + k = i - 1 + n1 = n[i] + if (n1 < 3) { + if (n1 == 0) + median[i] = blank + else if (n1 == 1) + median[i] = Mem$t[d[1]+k] + else { + low = Mem$t[d[1]+k] + high = Mem$t[d[2]+k] + median[i] = (low + high) / 2. + } + next + } + + # Median + n3 = 1 + n1 / 2 + if (mod (n1, 2) == 0) { + low = Mem$t[d[n3-1]+k] + high = Mem$t[d[n3]+k] + med = (low + high) / 2. + } else + med = Mem$t[d[n3]+k] + + # Poisson scaled sigma accumulation + if (doscale1) { + do j = 1, n1 { + l = Memi[m[j]+k] + s1 = max (one, (med + zeros[l]) / scales[l]) + s = s + (Mem$t[d[j]+k] - med) ** 2 / s1 + } + } else { + s1 = max (one, med) + do j = 1, n1 + s = s + (Mem$t[d[j]+k] - med) ** 2 / s1 + } + n2 = n2 + n1 + + # Save the median for later. + median[i] = med + } + + # Here is the final sigma. + if (n2 > 1) + s = sqrt (s / (n2 - 1)) + else + return + + # Compute individual sigmas and iteratively clip. + do i = 1, npts { + k = i - 1 + n1 = n[i] + if (nkeep < 0) + maxkeep = max (0, n1 + nkeep) + else + maxkeep = min (n1, nkeep) + if (n1 < max (3, maxkeep+1)) + next + nl = 1 + nh = n1 + med = median[i] + + repeat { + n2 = n1 + n3 = nl + n1 / 2 + + if (n1 >= max (MINCLIP, maxkeep+1) && s > 0.) { + if (doscale1) { + for (; nl <= n2; nl = nl + 1) { + l = Memi[m[nl]+k] + s1 = s * sqrt (max (one, (med+zeros[l])/scales[l])) + r = (med - Mem$t[d[nl]+k]) / s1 + if (r <= lsigma) + break + Memr[resid+nl] = r + n1 = n1 - 1 + } + for (; nh >= nl; nh = nh - 1) { + l = Memi[m[nh]+k] + s1 = s * sqrt (max (one, (med+zeros[l])/scales[l])) + r = (Mem$t[d[nh]+k] - med) / s1 + if (r <= hsigma) + break + Memr[resid+nh] = r + n1 = n1 - 1 + } + } else { + s1 = s * sqrt (max (one, med)) + for (; nl <= n2; nl = nl + 1) { + r = (med - Mem$t[d[nl]+k]) / s1 + if (r <= lsigma) + break + Memr[resid+nl] = r + n1 = n1 - 1 + } + for (; nh >= nl; nh = nh - 1) { + r = (Mem$t[d[nh]+k] - med) / s1 + if (r <= hsigma) + break + Memr[resid+nh] = r + n1 = n1 - 1 + } + } + + # Recompute median + if (n1 < n2) { + if (n1 > 0) { + n3 = nl + n1 / 2 + if (mod (n1, 2) == 0) { + low = Mem$t[d[n3-1]+k] + high = Mem$t[d[n3]+k] + med = (low + high) / 2. + } else + med = Mem$t[d[n3]+k] + } else + med = blank + } + } + } until (n1 == n2 || n1 < max (MINCLIP, maxkeep+1)) + + # If too many are rejected add some back in. + # Pixels with equal residuals are added together. + while (n1 < maxkeep) { + if (nl == 1) + nh = nh + 1 + else if (nh == n[i]) + nl = nl - 1 + else { + r = Memr[resid+nl-1] + s = Memr[resid+nh+1] + if (r < s) { + nl = nl - 1 + r = r + TOL + if (s <= r) + nh = nh + 1 + if (nl > 1) { + if (Memr[resid+nl-1] <= r) + nl = nl - 1 + } + } else { + nh = nh + 1 + s = s + TOL + if (r <= s) + nl = nl - 1 + if (nh < n2) { + if (Memr[resid+nh+1] <= s) + nh = nh + 1 + } + } + } + n1 = nh - nl + 1 + + # Recompute median + if (n1 < n2) { + if (n1 > 0) { + n3 = nl + n1 / 2 + if (mod (n1, 2) == 0) { + low = Mem$t[d[n3-1]+k] + high = Mem$t[d[n3]+k] + med = (low + high) / 2. + } else + med = Mem$t[d[n3]+k] + } else + med = blank + } + } + + # Only set median and reorder if needed + n[i] = n1 + if (n1 > 0 && nl > 1 && (combine != MEDIAN || grow > 0)) { + j = max (nl, n1 + 1) + if (keepids) { + do l = 1, min (n1, nl-1) { + Mem$t[d[l]+k] = Mem$t[d[j]+k] + if (grow > 0) { + mp1 = m[l] + k + mp2 = m[j] + k + id = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = id + } else + Memi[m[l]+k] = Memi[m[j]+k] + j = j + 1 + } + } else { + do l = 1, min (n1, nl - 1) { + Mem$t[d[l]+k] = Mem$t[d[j]+k] + j = j + 1 + } + } + } + + if (combine == MEDIAN) + median[i] = med + } + + # Check if data flag needs to be reset for rejected pixels + if (dflag == D_ALL) { + do i = 1, npts { + if (n[i] != nin) { + dflag = D_MIX + break + } + } + } + + # Flag that the median is computed. + if (combine == MEDIAN) + docombine = false + else + docombine = true + + call sfree (sp) +end +$endfor diff --git a/noao/imred/ccdred/src/icaverage.gx b/noao/imred/ccdred/src/icaverage.gx new file mode 100644 index 00000000..c145bb33 --- /dev/null +++ b/noao/imred/ccdred/src/icaverage.gx @@ -0,0 +1,93 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> +include "../icombine.h" + +$for (sr) +# IC_AVERAGE -- Compute the average image line. +# Options include a weight average. + +procedure ic_average$t (d, m, n, wts, npts, average) + +pointer d[ARB] # Data pointers +pointer m[ARB] # Image ID pointers +int n[npts] # Number of points +real wts[ARB] # Weights +int npts # Number of output points per line +$if (datatype == sil) +real average[npts] # Average (returned) +$else +PIXEL average[npts] # Average (returned) +$endif + +int i, j, k +real sumwt, wt +$if (datatype == sil) +real sum +$else +PIXEL sum +$endif + +include "../icombine.com" + +begin + # If no data has been excluded do the average without checking the + # number of points and using the fact that the weights are normalized. + # If all the data has been excluded set the average to the blank value. + + if (dflag == D_ALL) { + if (dowts) { + do i = 1, npts { + k = i - 1 + wt = wts[Memi[m[1]+k]] + sum = Mem$t[d[1]+k] * wt + do j = 2, n[i] { + wt = wts[Memi[m[j]+k]] + sum = sum + Mem$t[d[j]+k] * wt + } + average[i] = sum + } + } else { + do i = 1, npts { + k = i - 1 + sum = Mem$t[d[1]+k] + do j = 2, n[i] + sum = sum + Mem$t[d[j]+k] + average[i] = sum / n[i] + } + } + } else if (dflag == D_NONE) { + do i = 1, npts + average[i] = blank + } else { + if (dowts) { + do i = 1, npts { + if (n[i] > 0) { + k = i - 1 + wt = wts[Memi[m[1]+k]] + sum = Mem$t[d[1]+k] * wt + sumwt = wt + do j = 2, n[i] { + wt = wts[Memi[m[j]+k]] + sum = sum + Mem$t[d[j]+k] * wt + sumwt = sumwt + wt + } + average[i] = sum / sumwt + } else + average[i] = blank + } + } else { + do i = 1, npts { + if (n[i] > 0) { + k = i - 1 + sum = Mem$t[d[1]+k] + do j = 2, n[i] + sum = sum + Mem$t[d[j]+k] + average[i] = sum / n[i] + } else + average[i] = blank + } + } + } +end +$endfor diff --git a/noao/imred/ccdred/src/iccclip.gx b/noao/imred/ccdred/src/iccclip.gx new file mode 100644 index 00000000..69df984c --- /dev/null +++ b/noao/imred/ccdred/src/iccclip.gx @@ -0,0 +1,471 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "../icombine.h" + +define MINCLIP 2 # Mininum number of images for algorithm + +$for (sr) +# IC_ACCDCLIP -- Reject pixels using CCD noise parameters about the average + +procedure ic_accdclip$t (d, m, n, scales, zeros, nm, nimages, npts, average) + +pointer d[nimages] # Data pointers +pointer m[nimages] # Image id pointers +int n[npts] # Number of good pixels +real scales[nimages] # Scales +real zeros[nimages] # Zeros +real nm[3,nimages] # Noise model parameters +int nimages # Number of images +int npts # Number of output points per line +$if (datatype == sil) +real average[npts] # Average +$else +PIXEL average[npts] # Average +$endif + +int i, j, k, l, jj, n1, n2, nin, nk, maxkeep +$if (datatype == sil) +real d1, low, high, sum, a, s, r, zero +data zero /0.0/ +$else +PIXEL d1, low, high, sum, a, s, r, zero +data zero /0$f/ +$endif +pointer sp, resid, dp1, dp2, mp1, mp2 + +include "../icombine.com" + +begin + # If there are no pixels go on to the combining. Since the unweighted + # average is computed here possibly skip the combining later. + + # There must be at least max (1, nkeep) pixels. + if (nkeep < 0) + maxkeep = max (0, nimages + nkeep) + else + maxkeep = min (nimages, nkeep) + if (nimages < max (MINCLIP, maxkeep+1) || dflag == D_NONE) { + docombine = true + return + } else if (dowts || combine != AVERAGE) + docombine = true + else + docombine = false + + call smark (sp) + call salloc (resid, nimages+1, TY_REAL) + + # There must be at least two pixels for rejection. The initial + # average is the low/high rejected average except in the case of + # just two pixels. The rejections are iterated and the average + # is recomputed. Corrections for scaling may be performed. + # Depending on other flags the image IDs may also need to be adjusted. + + nin = n[1] + do i = 1, npts { + k = i - 1 + n1 = n[i] + if (nkeep < 0) + maxkeep = max (0, n1 + nkeep) + else + maxkeep = min (n1, nkeep) + if (n1 <= max (MINCLIP-1, maxkeep)) { + if (!docombine) { + if (n1 == 0) + average[i] = blank + else { + sum = Mem$t[d[1]+k] + do j = 2, n1 + sum = sum + Mem$t[d[j]+k] + average[i] = sum / n1 + } + } + next + } + + repeat { + if (n1 == 2) { + sum = Mem$t[d[1]+k] + sum = sum + Mem$t[d[2]+k] + a = sum / 2 + } else { + low = Mem$t[d[1]+k] + high = Mem$t[d[2]+k] + if (low > high) { + d1 = low + low = high + high = d1 + } + sum = 0. + do j = 3, n1 { + d1 = Mem$t[d[j]+k] + if (d1 < low) { + sum = sum + low + low = d1 + } else if (d1 > high) { + sum = sum + high + high = d1 + } else + sum = sum + d1 + } + a = sum / (n1 - 2) + sum = sum + low + high + } + n2 = n1 + if (doscale1) { + for (j=1; j<=n1; j=j+1) { + dp1 = d[j] + k + mp1 = m[j] + k + + l = Memi[mp1] + s = scales[l] + d1 = max (zero, s * (a + zeros[l])) + s = sqrt (nm[1,l] + d1/nm[2,l] + (d1*nm[3,l])**2) / s + + d1 = Mem$t[dp1] + r = (d1 - a) / s + if (r < -lsigma || r > hsigma) { + Memr[resid+n1] = abs(r) + if (j < n1) { + dp2 = d[n1] + k + Mem$t[dp1] = Mem$t[dp2] + Mem$t[dp2] = d1 + mp2 = m[n1] + k + Memi[mp1] = Memi[mp2] + Memi[mp2] = l + j = j - 1 + } + sum = sum - d1 + n1 = n1 - 1 + } + } + } else { + if (!keepids) { + s = max (zero, a) + s = sqrt (nm[1,1] + s/nm[2,1] + (s*nm[3,1])**2) + } + for (j=1; j<=n1; j=j+1) { + if (keepids) { + l = Memi[m[j]+k] + s = max (zero, a) + s = sqrt (nm[1,l] + s/nm[2,l] + (s*nm[3,l])**2) + } + dp1 = d[j] + k + d1 = Mem$t[dp1] + r = (d1 - a) / s + if (r < -lsigma || r > hsigma) { + Memr[resid+n1] = abs(r) + if (j < n1) { + dp2 = d[n1] + k + Mem$t[dp1] = Mem$t[dp2] + Mem$t[dp2] = d1 + if (keepids) { + mp1 = m[j] + k + mp2 = m[n1] + k + l = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = l + } + j = j - 1 + } + sum = sum - d1 + n1 = n1 - 1 + } + } + } + } until (n1 == n2 || n1 < max (MINCLIP, maxkeep+1)) + + if (n1 < maxkeep) { + nk = maxkeep + if (doscale1) { + for (j=n1+1; j<=nk; j=j+1) { + dp1 = d[j] + k + mp1 = m[j] + k + r = Memr[resid+j] + jj = 0 + do l = j+1, n2 { + s = Memr[resid+l] + if (s < r + TOL) { + if (s > r - TOL) + jj = jj + 1 + else { + jj = 0 + Memr[resid+l] = r + r = s + dp2 = d[l] + k + d1 = Mem$t[dp1] + Mem$t[dp1] = Mem$t[dp2] + Mem$t[dp2] = d1 + mp2 = m[l] + k + s = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = s + } + } + } + sum = sum + Mem$t[dp1] + n1 = n1 + 1 + nk = max (nk, j+jj) + } + } else { + for (j=n1+1; j<=nk; j=j+1) { + dp1 = d[j] + k + r = Memr[resid+j] + jj = 0 + do l = j+1, n2 { + s = Memr[resid+l] + if (s < r + TOL) { + if (s > r - TOL) + jj = jj + 1 + else { + jj = 0 + Memr[resid+l] = r + r = s + dp2 = d[l] + k + d1 = Mem$t[dp1] + Mem$t[dp1] = Mem$t[dp2] + Mem$t[dp2] = d1 + if (keepids) { + mp1 = m[j] + k + mp2 = m[l] + k + s = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = s + } + } + } + } + sum = sum + Mem$t[dp1] + n1 = n1 + 1 + nk = max (nk, j+jj) + } + } + } + + n[i] = n1 + if (!docombine) + if (n1 > 0) + average[i] = sum / n1 + else + average[i] = blank + } + + # Check if the data flag has to be reset for rejected pixels + if (dflag == D_ALL) { + do i = 1, npts { + if (n[i] != nin) { + dflag = D_MIX + break + } + } + } + + call sfree (sp) +end + + +# IC_CCDCLIP -- Reject pixels using CCD noise parameters about the median + +procedure ic_mccdclip$t (d, m, n, scales, zeros, nm, nimages, npts, median) + +pointer d[nimages] # Data pointers +pointer m[nimages] # Image id pointers +int n[npts] # Number of good pixels +real scales[nimages] # Scales +real zeros[nimages] # Zeros +real nm[3,nimages] # Noise model +int nimages # Number of images +int npts # Number of output points per line +$if (datatype == sil) +real median[npts] # Median +$else +PIXEL median[npts] # Median +$endif + +int i, j, k, l, id, n1, n2, n3, nl, nh, nin, maxkeep +real r, s +pointer sp, resid, mp1, mp2 +$if (datatype == sil) +real med, zero +data zero /0.0/ +$else +PIXEL med, zero +data zero /0$f/ +$endif + +include "../icombine.com" + +begin + # There must be at least max (MINCLIP, nkeep+1) pixels. + if (nkeep < 0) + maxkeep = max (0, nimages + nkeep) + else + maxkeep = min (nimages, nkeep) + if (nimages < max (MINCLIP, maxkeep+1) || dflag == D_NONE) { + docombine = true + return + } + + call smark (sp) + call salloc (resid, nimages+1, TY_REAL) + + # Compute median and sigma and iteratively clip. + nin = n[1] + do i = 1, npts { + k = i - 1 + n1 = n[i] + if (nkeep < 0) + maxkeep = max (0, n1 + nkeep) + else + maxkeep = min (n1, nkeep) + nl = 1 + nh = n1 + + repeat { + n2 = n1 + n3 = nl + n1 / 2 + + if (n1 == 0) + med = blank + else if (mod (n1, 2) == 0) { + med = Mem$t[d[n3-1]+k] + med = (med + Mem$t[d[n3]+k]) / 2. + } else + med = Mem$t[d[n3]+k] + + if (n1 >= max (MINCLIP, maxkeep+1)) { + if (doscale1) { + for (; nl <= n2; nl = nl + 1) { + l = Memi[m[nl]+k] + s = scales[l] + r = max (zero, s * (med + zeros[l])) + s = sqrt (nm[1,l] + r/nm[2,l] + (r*nm[3,l])**2) / s + r = (med - Mem$t[d[nl]+k]) / s + if (r <= lsigma) + break + Memr[resid+nl] = r + n1 = n1 - 1 + } + for (; nh >= nl; nh = nh - 1) { + l = Memi[m[nh]+k] + s = scales[l] + r = max (zero, s * (med + zeros[l])) + s = sqrt (nm[1,l] + r/nm[2,l] + (r*nm[3,l])**2) / s + r = (Mem$t[d[nh]+k] - med) / s + if (r <= hsigma) + break + Memr[resid+nh] = r + n1 = n1 - 1 + } + } else { + if (!keepids) { + s = max (zero, med) + s = sqrt (nm[1,1] + s/nm[2,1] + (s*nm[3,1])**2) + } + for (; nl <= n2; nl = nl + 1) { + if (keepids) { + l = Memi[m[nl]+k] + s = max (zero, med) + s = sqrt (nm[1,l] + s/nm[2,l] + (s*nm[3,l])**2) + } + r = (med - Mem$t[d[nl]+k]) / s + if (r <= lsigma) + break + Memr[resid+nl] = r + n1 = n1 - 1 + } + for (; nh >= nl; nh = nh - 1) { + if (keepids) { + l = Memi[m[nh]+k] + s = max (zero, med) + s = sqrt (nm[1,l] + s/nm[2,l] + (s*nm[3,l])**2) + } + r = (Mem$t[d[nh]+k] - med) / s + if (r <= hsigma) + break + Memr[resid+nh] = r + n1 = n1 - 1 + } + } + } + } until (n1 == n2 || n1 < max (MINCLIP, maxkeep+1)) + + while (n1 < maxkeep) { + if (nl == 1) + nh = nh + 1 + else if (nh == n[i]) + nl = nl - 1 + else { + r = Memr[resid+nl-1] + s = Memr[resid+nh+1] + if (r < s) { + nl = nl - 1 + r = r + TOL + if (s <= r) + nh = nh + 1 + if (nl > 1) { + if (Memr[resid+nl-1] <= r) + nl = nl - 1 + } + } else { + nh = nh + 1 + s = s + TOL + if (r <= s) + nl = nl - 1 + if (nh < n2) { + if (Memr[resid+nh+1] <= s) + nh = nh + 1 + } + } + } + n1 = nh - nl + 1 + } + + # Only set median and reorder if needed + n[i] = n1 + if (n1 > 0 && nl > 1 && (combine != MEDIAN || grow > 0)) { + j = max (nl, n1 + 1) + if (keepids) { + do l = 1, min (n1, nl-1) { + Mem$t[d[l]+k] = Mem$t[d[j]+k] + if (grow > 0) { + mp1 = m[l] + k + mp2 = m[j] + k + id = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = id + } else + Memi[m[l]+k] = Memi[m[j]+k] + j = j + 1 + } + } else { + do l = 1, min (n1, nl - 1) { + Mem$t[d[l]+k] = Mem$t[d[j]+k] + j = j + 1 + } + } + } + + if (combine == MEDIAN) + median[i] = med + } + + # Check if data flag needs to be reset for rejected pixels + if (dflag == D_ALL) { + do i = 1, npts { + if (n[i] != nin) { + dflag = D_MIX + break + } + } + } + + # Flag that the median is computed. + if (combine == MEDIAN) + docombine = false + else + docombine = true + + call sfree (sp) +end +$endfor diff --git a/noao/imred/ccdred/src/icgdata.gx b/noao/imred/ccdred/src/icgdata.gx new file mode 100644 index 00000000..41cf5810 --- /dev/null +++ b/noao/imred/ccdred/src/icgdata.gx @@ -0,0 +1,233 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> +include <mach.h> +include "../icombine.h" + +$for (sr) +# IC_GDATA -- Get line of image and mask data and apply threshold and scaling. +# Entirely empty lines are excluded. The data are compacted within the +# input data buffers. If it is required, the connection to the original +# image index is keeped in the returned m data pointers. + +procedure ic_gdata$t (in, out, dbuf, d, id, n, m, lflag, offsets, scales, + zeros, nimages, npts, v1, v2) + +pointer in[nimages] # Input images +pointer out[ARB] # Output images +pointer dbuf[nimages] # Data buffers for nonaligned images +pointer d[nimages] # Data pointers +pointer id[nimages] # ID pointers +int n[npts] # Number of good pixels +pointer m[nimages] # Mask pointers +int lflag[nimages] # Empty mask flags +int offsets[nimages,ARB] # Image offsets +real scales[nimages] # Scale factors +real zeros[nimages] # Zero offset factors +int nimages # Number of input images +int npts # NUmber of output points per line +long v1[ARB], v2[ARB] # Line vectors + +int i, j, k, l, ndim, nused +real a, b +pointer buf, dp, ip, mp, imgnl$t() + +include "../icombine.com" + +begin + # Get masks and return if there is no data + call ic_mget (in, out, offsets, v1, v2, m, lflag, nimages) + if (dflag == D_NONE) + return + + # Get data and fill data buffers. Correct for offsets if needed. + ndim = IM_NDIM(out[1]) + do i = 1, nimages { + if (lflag[i] == D_NONE) + next + if (aligned) { + call amovl (v1, v2, IM_MAXDIM) + if (project) + v2[ndim+1] = i + j = imgnl$t (in[i], d[i], v2) + } else { + v2[1] = v1[1] + do j = 2, ndim + v2[j] = v1[j] - offsets[i,j] + if (project) + v2[ndim+1] = i + j = imgnl$t (in[i], buf, v2) + call amov$t (Mem$t[buf], Mem$t[dbuf[i]+offsets[i,1]], + IM_LEN(in[i],1)) + d[i] = dbuf[i] + } + } + + # Apply threshold if needed + if (dothresh) { + do i = 1, nimages { + dp = d[i] + if (lflag[i] == D_ALL) { + do j = 1, npts { + a = Mem$t[dp] + if (a < lthresh || a > hthresh) { + Memi[m[i]+j-1] = 1 + lflag[i] = D_MIX + dflag = D_MIX + } + dp = dp + 1 + } + } else if (lflag[i] == D_MIX) { + mp = m[i] + do j = 1, npts { + if (Memi[mp] == 0) { + a = Mem$t[dp] + if (a < lthresh || a > hthresh) { + Memi[m[i]+j-1] = 1 + dflag = D_MIX + } + } + dp = dp + 1 + mp = mp + 1 + } + } + + # Check for completely empty lines + if (lflag[i] == D_MIX) { + lflag[i] = D_NONE + mp = m[i] + do j = 1, npts { + if (Memi[mp] == 0) { + lflag[i] = D_MIX + break + } + mp = mp + 1 + } + } + } + } + + # Apply scaling (avoiding masked pixels which might overflow?) + if (doscale) { + if (dflag == D_ALL) { + do i = 1, nimages { + dp = d[i] + a = scales[i] + b = -zeros[i] + do j = 1, npts { + Mem$t[dp] = Mem$t[dp] / a + b + dp = dp + 1 + } + } + } else if (dflag == D_MIX) { + do i = 1, nimages { + dp = d[i] + a = scales[i] + b = -zeros[i] + if (lflag[i] == D_ALL) { + do j = 1, npts { + Mem$t[dp] = Mem$t[dp] / a + b + dp = dp + 1 + } + } else if (lflag[i] == D_MIX) { + mp = m[i] + do j = 1, npts { + if (Memi[mp] == 0) + Mem$t[dp] = Mem$t[dp] / a + b + dp = dp + 1 + mp = mp + 1 + } + } + } + } + } + + # Sort pointers to exclude unused images. + # Use the lflag array to keep track of the image index. + + if (dflag == D_ALL) + nused = nimages + else { + nused = 0 + do i = 1, nimages + if (lflag[i] != D_NONE) { + nused = nused + 1 + d[nused] = d[i] + m[nused] = m[i] + lflag[nused] = i + } + if (nused == 0) + dflag = D_NONE + } + + # Compact data to remove bad pixels + # Keep track of the image indices if needed + # If growing mark the end of the included image indices with zero + + if (dflag == D_ALL) { + call amovki (nused, n, npts) + if (keepids) + do i = 1, nimages + call amovki (i, Memi[id[i]], npts) + } else if (dflag == D_NONE) + call aclri (n, npts) + else { + call aclri (n, npts) + if (keepids) { + do i = 1, nused { + l = lflag[i] + dp = d[i] + ip = id[i] + mp = m[i] + do j = 1, npts { + if (Memi[mp] == 0) { + n[j] = n[j] + 1 + k = n[j] + if (k < i) { + Mem$t[d[k]+j-1] = Mem$t[dp] + Memi[id[k]+j-1] = l + } else + Memi[ip] = l + } + dp = dp + 1 + ip = ip + 1 + mp = mp + 1 + } + } + if (grow > 0) { + do j = 1, npts { + do i = n[j]+1, nimages + Memi[id[i]+j-1] = 0 + } + } + } else { + do i = 1, nused { + dp = d[i] + mp = m[i] + do j = 1, npts { + if (Memi[mp] == 0) { + n[j] = n[j] + 1 + k = n[j] + if (k < i) + Mem$t[d[k]+j-1] = Mem$t[dp] + } + dp = dp + 1 + mp = mp + 1 + } + } + } + } + + # Sort the pixels and IDs if needed + if (mclip) { + call malloc (dp, nimages, TY_PIXEL) + if (keepids) { + call malloc (ip, nimages, TY_INT) + call ic_2sort$t (d, Mem$t[dp], id, Memi[ip], n, npts) + call mfree (ip, TY_INT) + } else + call ic_sort$t (d, Mem$t[dp], n, npts) + call mfree (dp, TY_PIXEL) + } +end +$endfor diff --git a/noao/imred/ccdred/src/icgrow.gx b/noao/imred/ccdred/src/icgrow.gx new file mode 100644 index 00000000..e3cf6228 --- /dev/null +++ b/noao/imred/ccdred/src/icgrow.gx @@ -0,0 +1,81 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "../icombine.h" + +$for (sr) +# IC_GROW -- Reject neigbors of rejected pixels. +# The rejected pixels are marked by having nonzero ids beyond the number +# of included pixels. The pixels rejected here are given zero ids +# to avoid growing of the pixels rejected here. The unweighted average +# can be updated but any rejected pixels requires the median to be +# recomputed. When the number of pixels at a grow point reaches nkeep +# no further pixels are rejected. Note that the rejection order is not +# based on the magnitude of the residuals and so a grow from a weakly +# rejected image pixel may take precedence over a grow from a strongly +# rejected image pixel. + +procedure ic_grow$t (d, m, n, nimages, npts, average) + +pointer d[ARB] # Data pointers +pointer m[ARB] # Image id pointers +int n[npts] # Number of good pixels +int nimages # Number of images +int npts # Number of output points per line +$if (datatype == sil) +real average[npts] # Average +$else +PIXEL average[npts] # Average +$endif + +int i1, i2, j1, j2, k1, k2, l, is, ie, n2, maxkeep +pointer mp1, mp2 + +include "../icombine.com" + +begin + if (dflag == D_NONE) + return + + do i1 = 1, npts { + k1 = i1 - 1 + is = max (1, i1 - grow) + ie = min (npts, i1 + grow) + do j1 = n[i1]+1, nimages { + l = Memi[m[j1]+k1] + if (l == 0) + next + if (combine == MEDIAN) + docombine = true + + do i2 = is, ie { + if (i2 == i1) + next + k2 = i2 - 1 + n2 = n[i2] + if (nkeep < 0) + maxkeep = max (0, n2 + nkeep) + else + maxkeep = min (n2, nkeep) + if (n2 <= maxkeep) + next + do j2 = 1, n2 { + mp1 = m[j2] + k2 + if (Memi[mp1] == l) { + if (!docombine && n2 > 1) + average[i2] = + (n2*average[i2] - Mem$t[d[j2]+k2]) / (n2-1) + mp2 = m[n2] + k2 + if (j2 < n2) { + Mem$t[d[j2]+k2] = Mem$t[d[n2]+k2] + Memi[mp1] = Memi[mp2] + } + Memi[mp2] = 0 + n[i2] = n2 - 1 + break + } + } + } + } + } +end +$endfor diff --git a/noao/imred/ccdred/src/icimstack.x b/noao/imred/ccdred/src/icimstack.x new file mode 100644 index 00000000..2a19751d --- /dev/null +++ b/noao/imred/ccdred/src/icimstack.x @@ -0,0 +1,125 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <error.h> +include <imhdr.h> + + +# IC_IMSTACK -- Stack images into a single image of higher dimension. + +procedure ic_imstack (images, nimages, output) + +char images[SZ_FNAME-1, nimages] #I Input images +int nimages #I Number of images +char output #I Name of output image + +int i, j, npix +long line_in[IM_MAXDIM], line_out[IM_MAXDIM] +pointer sp, key, in, out, buf_in, buf_out, ptr + +int imgnls(), imgnli(), imgnll(), imgnlr(), imgnld(), imgnlx() +int impnls(), impnli(), impnll(), impnlr(), impnld(), impnlx() +pointer immap() +errchk immap + +begin + call smark (sp) + call salloc (key, SZ_FNAME, TY_CHAR) + + iferr { + # Add each input image to the output image. + out = NULL + do i = 1, nimages { + in = NULL + ptr = immap (images[1,i], READ_ONLY, 0) + in = ptr + + # For the first input image map the output image as a copy + # and increment the dimension. Set the output line counter. + + if (i == 1) { + ptr = immap (output, NEW_COPY, in) + out = ptr + IM_NDIM(out) = IM_NDIM(out) + 1 + IM_LEN(out, IM_NDIM(out)) = nimages + npix = IM_LEN(out, 1) + call amovkl (long(1), line_out, IM_MAXDIM) + } + + # Check next input image for consistency with the output image. + if (IM_NDIM(in) != IM_NDIM(out) - 1) + call error (0, "Input images not consistent") + do j = 1, IM_NDIM(in) { + if (IM_LEN(in, j) != IM_LEN(out, j)) + call error (0, "Input images not consistent") + } + + call sprintf (Memc[key], SZ_FNAME, "stck%04d") + call pargi (i) + call imastr (out, Memc[key], images[1,i]) + + # Copy the input lines from the image to the next lines of + # the output image. Switch on the output data type to optimize + # IMIO. + + call amovkl (long(1), line_in, IM_MAXDIM) + switch (IM_PIXTYPE (out)) { + case TY_SHORT: + while (imgnls (in, buf_in, line_in) != EOF) { + if (impnls (out, buf_out, line_out) == EOF) + call error (0, "Error writing output image") + call amovs (Mems[buf_in], Mems[buf_out], npix) + } + case TY_INT: + while (imgnli (in, buf_in, line_in) != EOF) { + if (impnli (out, buf_out, line_out) == EOF) + call error (0, "Error writing output image") + call amovi (Memi[buf_in], Memi[buf_out], npix) + } + case TY_USHORT, TY_LONG: + while (imgnll (in, buf_in, line_in) != EOF) { + if (impnll (out, buf_out, line_out) == EOF) + call error (0, "Error writing output image") + call amovl (Meml[buf_in], Meml[buf_out], npix) + } + case TY_REAL: + while (imgnlr (in, buf_in, line_in) != EOF) { + if (impnlr (out, buf_out, line_out) == EOF) + call error (0, "Error writing output image") + call amovr (Memr[buf_in], Memr[buf_out], npix) + } + case TY_DOUBLE: + while (imgnld (in, buf_in, line_in) != EOF) { + if (impnld (out, buf_out, line_out) == EOF) + call error (0, "Error writing output image") + call amovd (Memd[buf_in], Memd[buf_out], npix) + } + case TY_COMPLEX: + while (imgnlx (in, buf_in, line_in) != EOF) { + if (impnlx (out, buf_out, line_out) == EOF) + call error (0, "Error writing output image") + call amovx (Memx[buf_in], Memx[buf_out], npix) + } + default: + while (imgnlr (in, buf_in, line_in) != EOF) { + if (impnlr (out, buf_out, line_out) == EOF) + call error (0, "Error writing output image") + call amovr (Memr[buf_in], Memr[buf_out], npix) + } + } + call imunmap (in) + } + } then { + if (out != NULL) { + call imunmap (out) + call imdelete (out) + } + if (in != NULL) + call imunmap (in) + call sfree (sp) + call erract (EA_ERROR) + } + + # Finish up. + call imunmap (out) + call sfree (sp) +end diff --git a/noao/imred/ccdred/src/iclog.x b/noao/imred/ccdred/src/iclog.x new file mode 100644 index 00000000..82135866 --- /dev/null +++ b/noao/imred/ccdred/src/iclog.x @@ -0,0 +1,378 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> +include <imset.h> +include <mach.h> +include "icombine.h" +include "icmask.h" + +# IC_LOG -- Output log information is a log file has been specfied. + +procedure ic_log (in, out, ncombine, exptime, sname, zname, wname, + mode, median, mean, scales, zeros, wts, offsets, nimages, + dozero, nout, expname, exposure) + +pointer in[nimages] # Input images +pointer out[ARB] # Output images +int ncombine[nimages] # Number of previous combined images +real exptime[nimages] # Exposure times +char sname[ARB] # Scale name +char zname[ARB] # Zero name +char wname[ARB] # Weight name +real mode[nimages] # Modes +real median[nimages] # Medians +real mean[nimages] # Means +real scales[nimages] # Scale factors +real zeros[nimages] # Zero or sky levels +real wts[nimages] # Weights +int offsets[nimages,ARB] # Image offsets +int nimages # Number of images +bool dozero # Zero flag +int nout # Number of images combined in output +char expname[ARB] # Exposure name +real exposure # Output exposure + +int i, j, stack, ctor() +real rval, imgetr() +long clktime() +bool prncombine, prexptime, prmode, prmedian, prmean, prmask +bool prrdn, prgain, prsn +pointer sp, fname, key +errchk imgetr + +include "icombine.com" + +begin + if (logfd == NULL) + return + + call smark (sp) + call salloc (fname, SZ_LINE, TY_CHAR) + + stack = NO + if (project) { + ifnoerr (call imgstr (in[1], "stck0001", Memc[fname], SZ_LINE)) + stack = YES + } + if (stack == YES) + call salloc (key, SZ_FNAME, TY_CHAR) + + # Time stamp the log and print parameter information. + + call cnvdate (clktime(0), Memc[fname], SZ_LINE) + call fprintf (logfd, "\n%s: IMCOMBINE\n") + call pargstr (Memc[fname]) + switch (combine) { + case AVERAGE: + call fprintf (logfd, " combine = average, ") + case MEDIAN: + call fprintf (logfd, " combine = median, ") + } + call fprintf (logfd, "scale = %s, zero = %s, weight = %s\n") + call pargstr (sname) + call pargstr (zname) + call pargstr (wname) + + switch (reject) { + case MINMAX: + call fprintf (logfd, " reject = minmax, nlow = %d, nhigh = %d\n") + call pargi (nint (flow * nimages)) + call pargi (nint (fhigh * nimages)) + case CCDCLIP: + call fprintf (logfd, " reject = ccdclip, mclip = %b, nkeep = %d\n") + call pargb (mclip) + call pargi (nkeep) + call fprintf (logfd, + " rdnoise = %s, gain = %s, snoise = %s, sigma = %g, hsigma = %g\n") + call pargstr (Memc[rdnoise]) + call pargstr (Memc[gain]) + call pargstr (Memc[snoise]) + call pargr (lsigma) + call pargr (hsigma) + case CRREJECT: + call fprintf (logfd, + " reject = crreject, mclip = %b, nkeep = %d\n") + call pargb (mclip) + call pargi (nkeep) + call fprintf (logfd, + " rdnoise = %s, gain = %s, snoise = %s, hsigma = %g\n") + call pargstr (Memc[rdnoise]) + call pargstr (Memc[gain]) + call pargstr (Memc[snoise]) + call pargr (hsigma) + case PCLIP: + call fprintf (logfd, " reject = pclip, nkeep = %d\n") + call pargi (nkeep) + call fprintf (logfd, " pclip = %g, lsigma = %g, hsigma = %g\n") + call pargr (pclip) + call pargr (lsigma) + call pargr (hsigma) + case SIGCLIP: + call fprintf (logfd, " reject = sigclip, mclip = %b, nkeep = %d\n") + call pargb (mclip) + call pargi (nkeep) + call fprintf (logfd, " lsigma = %g, hsigma = %g\n") + call pargr (lsigma) + call pargr (hsigma) + case AVSIGCLIP: + call fprintf (logfd, + " reject = avsigclip, mclip = %b, nkeep = %d\n") + call pargb (mclip) + call pargi (nkeep) + call fprintf (logfd, " lsigma = %g, hsigma = %g\n") + call pargr (lsigma) + call pargr (hsigma) + } + if (reject != NONE && grow > 0) { + call fprintf (logfd, " grow = %d\n") + call pargi (grow) + } + if (dothresh) { + if (lthresh > -MAX_REAL && hthresh < MAX_REAL) { + call fprintf (logfd, " lthreshold = %g, hthreshold = %g\n") + call pargr (lthresh) + call pargr (hthresh) + } else if (lthresh > -MAX_REAL) { + call fprintf (logfd, " lthreshold = %g\n") + call pargr (lthresh) + } else { + call fprintf (logfd, " hthreshold = %g\n") + call pargr (hthresh) + } + } + call fprintf (logfd, " blank = %g\n") + call pargr (blank) + call clgstr ("statsec", Memc[fname], SZ_LINE) + if (Memc[fname] != EOS) { + call fprintf (logfd, " statsec = %s\n") + call pargstr (Memc[fname]) + } + + if (ICM_TYPE(icm) != M_NONE) { + switch (ICM_TYPE(icm)) { + case M_BOOLEAN, M_GOODVAL: + call fprintf (logfd, " masktype = goodval, maskval = %d\n") + call pargi (ICM_VALUE(icm)) + case M_BADVAL: + call fprintf (logfd, " masktype = badval, maskval = %d\n") + call pargi (ICM_VALUE(icm)) + case M_GOODBITS: + call fprintf (logfd, " masktype = goodbits, maskval = %d\n") + call pargi (ICM_VALUE(icm)) + case M_BADBITS: + call fprintf (logfd, " masktype = badbits, maskval = %d\n") + call pargi (ICM_VALUE(icm)) + } + } + + # Print information pertaining to individual images as a set of + # columns with the image name being the first column. Determine + # what information is relevant and print the appropriate header. + + prncombine = false + prexptime = false + prmode = false + prmedian = false + prmean = false + prmask = false + prrdn = false + prgain = false + prsn = false + do i = 1, nimages { + if (ncombine[i] != ncombine[1]) + prncombine = true + if (exptime[i] != exptime[1]) + prexptime = true + if (mode[i] != mode[1]) + prmode = true + if (median[i] != median[1]) + prmedian = true + if (mean[i] != mean[1]) + prmean = true + if (ICM_TYPE(icm) != M_NONE && Memi[ICM_PMS(icm)+i-1] != NULL) + prmask = true + if (reject == CCDCLIP || reject == CRREJECT) { + j = 1 + if (ctor (Memc[rdnoise], j, rval) == 0) + prrdn = true + j = 1 + if (ctor (Memc[gain], j, rval) == 0) + prgain = true + j = 1 + if (ctor (Memc[snoise], j, rval) == 0) + prsn = true + } + } + + call fprintf (logfd, " %20s ") + call pargstr ("Images") + if (prncombine) { + call fprintf (logfd, " %6s") + call pargstr ("N") + } + if (prexptime) { + call fprintf (logfd, " %6s") + call pargstr ("Exp") + } + if (prmode) { + call fprintf (logfd, " %7s") + call pargstr ("Mode") + } + if (prmedian) { + call fprintf (logfd, " %7s") + call pargstr ("Median") + } + if (prmean) { + call fprintf (logfd, " %7s") + call pargstr ("Mean") + } + if (prrdn) { + call fprintf (logfd, " %7s") + call pargstr ("Rdnoise") + } + if (prgain) { + call fprintf (logfd, " %6s") + call pargstr ("Gain") + } + if (prsn) { + call fprintf (logfd, " %6s") + call pargstr ("Snoise") + } + if (doscale) { + call fprintf (logfd, " %6s") + call pargstr ("Scale") + } + if (dozero) { + call fprintf (logfd, " %7s") + call pargstr ("Zero") + } + if (dowts) { + call fprintf (logfd, " %6s") + call pargstr ("Weight") + } + if (!aligned) { + call fprintf (logfd, " %9s") + call pargstr ("Offsets") + } + if (prmask) { + call fprintf (logfd, " %s") + call pargstr ("Maskfile") + } + call fprintf (logfd, "\n") + + do i = 1, nimages { + if (stack == YES) { + call sprintf (Memc[key], SZ_FNAME, "stck%04d") + call pargi (i) + ifnoerr (call imgstr (in[i], Memc[key], Memc[fname], SZ_LINE)) { + call fprintf (logfd, " %21s") + call pargstr (Memc[fname]) + } else { + call imstats (in[i], IM_IMAGENAME, Memc[fname], SZ_LINE) + call fprintf (logfd, " %16s[%3d]") + call pargstr (Memc[fname]) + call pargi (i) + } + } else if (project) { + call imstats (in[i], IM_IMAGENAME, Memc[fname], SZ_LINE) + call fprintf (logfd, " %16s[%3d]") + call pargstr (Memc[fname]) + call pargi (i) + } else { + call imstats (in[i], IM_IMAGENAME, Memc[fname], SZ_LINE) + call fprintf (logfd, " %21s") + call pargstr (Memc[fname]) + } + if (prncombine) { + call fprintf (logfd, " %6d") + call pargi (ncombine[i]) + } + if (prexptime) { + call fprintf (logfd, " %6.1f") + call pargr (exptime[i]) + } + if (prmode) { + call fprintf (logfd, " %7.5g") + call pargr (mode[i]) + } + if (prmedian) { + call fprintf (logfd, " %7.5g") + call pargr (median[i]) + } + if (prmean) { + call fprintf (logfd, " %7.5g") + call pargr (mean[i]) + } + if (prrdn) { + rval = imgetr (in[i], Memc[rdnoise]) + call fprintf (logfd, " %7g") + call pargr (rval) + } + if (prgain) { + rval = imgetr (in[i], Memc[gain]) + call fprintf (logfd, " %6g") + call pargr (rval) + } + if (prsn) { + rval = imgetr (in[i], Memc[snoise]) + call fprintf (logfd, " %6g") + call pargr (rval) + } + if (doscale) { + call fprintf (logfd, " %6.3f") + call pargr (1./scales[i]) + } + if (dozero) { + call fprintf (logfd, " %7.5g") + call pargr (-zeros[i]) + } + if (dowts) { + call fprintf (logfd, " %6.3f") + call pargr (wts[i]) + } + if (!aligned) { + if (IM_NDIM(out[1]) == 1) { + call fprintf (logfd, " %9d") + call pargi (offsets[i,1]) + } else { + do j = 1, IM_NDIM(out[1]) { + call fprintf (logfd, " %4d") + call pargi (offsets[i,j]) + } + } + } + if (prmask && Memi[ICM_PMS(icm)+i-1] != NULL) { + call imgstr (in[i], "BPM", Memc[fname], SZ_LINE) + call fprintf (logfd, " %s") + call pargstr (Memc[fname]) + } + call fprintf (logfd, "\n") + } + + # Log information about the output images. + call imstats (out[1], IM_IMAGENAME, Memc[fname], SZ_LINE) + call fprintf (logfd, "\n Output image = %s, ncombine = %d") + call pargstr (Memc[fname]) + call pargi (nout) + if (expname[1] != EOS) { + call fprintf (logfd, ", %s = %g") + call pargstr (expname) + call pargr (exposure) + } + call fprintf (logfd, "\n") + + if (out[2] != NULL) { + call imstats (out[2], IM_IMAGENAME, Memc[fname], SZ_LINE) + call fprintf (logfd, " Pixel list image = %s\n") + call pargstr (Memc[fname]) + } + + if (out[3] != NULL) { + call imstats (out[3], IM_IMAGENAME, Memc[fname], SZ_LINE) + call fprintf (logfd, " Sigma image = %s\n") + call pargstr (Memc[fname]) + } + + call flush (logfd) + call sfree (sp) +end diff --git a/noao/imred/ccdred/src/icmask.com b/noao/imred/ccdred/src/icmask.com new file mode 100644 index 00000000..baba6f6a --- /dev/null +++ b/noao/imred/ccdred/src/icmask.com @@ -0,0 +1,8 @@ +# IMCMASK -- Common for IMCOMBINE mask interface. + +int mtype # Mask type +int mvalue # Mask value +pointer bufs # Pointer to data line buffers +pointer pms # Pointer to array of PMIO pointers + +common /imcmask/ mtype, mvalue, bufs, pms diff --git a/noao/imred/ccdred/src/icmask.h b/noao/imred/ccdred/src/icmask.h new file mode 100644 index 00000000..b2d30530 --- /dev/null +++ b/noao/imred/ccdred/src/icmask.h @@ -0,0 +1,7 @@ +# ICMASK -- Data structure for IMCOMBINE mask interface. + +define ICM_LEN 4 # Structure length +define ICM_TYPE Memi[$1] # Mask type +define ICM_VALUE Memi[$1+1] # Mask value +define ICM_BUFS Memi[$1+2] # Pointer to data line buffers +define ICM_PMS Memi[$1+3] # Pointer to array of PMIO pointers diff --git a/noao/imred/ccdred/src/icmask.x b/noao/imred/ccdred/src/icmask.x new file mode 100644 index 00000000..ba448b68 --- /dev/null +++ b/noao/imred/ccdred/src/icmask.x @@ -0,0 +1,354 @@ +include <imhdr.h> +include <pmset.h> +include "icombine.h" +include "icmask.h" + +# IC_MASK -- ICOMBINE mask interface +# +# IC_MOPEN -- Open masks +# IC_MCLOSE -- Close the mask interface +# IC_MGET -- Get lines of mask pixels for all the images +# IC_MGET1 -- Get a line of mask pixels for the specified image + + +# IC_MOPEN -- Open masks. +# Parse and interpret the mask selection parameters. + +procedure ic_mopen (in, out, nimages) + +pointer in[nimages] #I Input images +pointer out[ARB] #I Output images +int nimages #I Number of images + +int mtype # Mask type +int mvalue # Mask value +pointer bufs # Pointer to data line buffers +pointer pms # Pointer to array of PMIO pointers + +int i, npix, npms, clgwrd() +real clgetr() +pointer sp, fname, title, pm, pm_open() +bool invert, pm_empty() +errchk calloc, pm_open, pm_loadf + +include "icombine.com" + +begin + icm = NULL + if (IM_NDIM(out[1]) == 0) + return + + call smark (sp) + call salloc (fname, SZ_FNAME, TY_CHAR) + call salloc (title, SZ_FNAME, TY_CHAR) + + # Determine the mask parameters and allocate memory. + # The mask buffers are initialize to all excluded so that + # output points outside the input data are always excluded + # and don't need to be set on a line-by-line basis. + + mtype = clgwrd ("masktype", Memc[title], SZ_FNAME, MASKTYPES) + mvalue = clgetr ("maskvalue") + npix = IM_LEN(out[1],1) + call calloc (pms, nimages, TY_POINTER) + call calloc (bufs, nimages, TY_POINTER) + do i = 1, nimages { + call malloc (Memi[bufs+i-1], npix, TY_INT) + call amovki (1, Memi[Memi[bufs+i-1]], npix) + } + + # Check for special cases. The BOOLEAN type is used when only + # zero and nonzero are significant; i.e. the actual mask values are + # not important. The invert flag is used to indicate that + # empty masks are all bad rather the all good. + + if (mtype == 0) + mtype = M_NONE + if (mtype == M_BADBITS && mvalue == 0) + mtype = M_NONE + if (mvalue == 0 && (mtype == M_GOODVAL || mtype == M_GOODBITS)) + mtype = M_BOOLEAN + if ((mtype == M_BADVAL && mvalue == 0) || + (mtype == M_GOODVAL && mvalue != 0) || + (mtype == M_GOODBITS && mvalue == 0)) + invert = true + else + invert = false + + # If mask images are to be used, get the mask name from the image + # header and open it saving the descriptor in the pms array. + # Empty masks (all good) are treated as if there was no mask image. + + npms = 0 + do i = 1, nimages { + if (mtype != M_NONE) { + ifnoerr (call imgstr (in[i], "BPM", Memc[fname], SZ_FNAME)) { + pm = pm_open (NULL) + call pm_loadf (pm, Memc[fname], Memc[title], SZ_FNAME) + call pm_seti (pm, P_REFIM, in[i]) + if (pm_empty (pm) && !invert) + call pm_close (pm) + else { + if (project) { + npms = nimages + call amovki (pm, Memi[pms], nimages) + } else { + npms = npms + 1 + Memi[pms+i-1] = pm + } + } + if (project) + break + } + } + } + + # If no mask images are found and the mask parameters imply that + # good values are 0 then use the special case of no masks. + + if (npms == 0) { + if (!invert) + mtype = M_NONE + } + + # Set up mask structure. + call calloc (icm, ICM_LEN, TY_STRUCT) + ICM_TYPE(icm) = mtype + ICM_VALUE(icm) = mvalue + ICM_BUFS(icm) = bufs + ICM_PMS(icm) = pms + + call sfree (sp) +end + + +# IC_MCLOSE -- Close the mask interface. + +procedure ic_mclose (nimages) + +int nimages # Number of images + +int i +include "icombine.com" + +begin + if (icm == NULL) + return + + do i = 1, nimages + call mfree (Memi[ICM_BUFS(icm)+i-1], TY_INT) + do i = 1, nimages { + if (Memi[ICM_PMS(icm)+i-1] != NULL) + call pm_close (Memi[ICM_PMS(icm)+i-1]) + if (project) + break + } + call mfree (ICM_BUFS(icm), TY_POINTER) + call mfree (ICM_PMS(icm), TY_POINTER) + call mfree (icm, TY_STRUCT) +end + + +# IC_MGET -- Get lines of mask pixels in the output coordinate system. +# This converts the mask format to an array where zero is good and nonzero +# is bad. This has special cases for optimization. + +procedure ic_mget (in, out, offsets, v1, v2, m, lflag, nimages) + +pointer in[nimages] # Input image pointers +pointer out[ARB] # Output image pointer +int offsets[nimages,ARB] # Offsets to output image +long v1[IM_MAXDIM] # Data vector desired in output image +long v2[IM_MAXDIM] # Data vector in input image +pointer m[nimages] # Pointer to mask pointers +int lflag[nimages] # Line flags +int nimages # Number of images + +int mtype # Mask type +int mvalue # Mask value +pointer bufs # Pointer to data line buffers +pointer pms # Pointer to array of PMIO pointers + +int i, j, ndim, nout, npix +pointer buf, pm +bool pm_linenotempty() +errchk pm_glpi + +include "icombine.com" + +begin + # Determine if masks are needed at all. Note that the threshold + # is applied by simulating mask values so the mask pointers have to + # be set. + + dflag = D_ALL + if (icm == NULL) + return + if (ICM_TYPE(icm) == M_NONE && aligned && !dothresh) + return + + mtype = ICM_TYPE(icm) + mvalue = ICM_VALUE(icm) + bufs = ICM_BUFS(icm) + pms = ICM_PMS(icm) + + # Set the mask pointers and line flags and apply offsets if needed. + + ndim = IM_NDIM(out[1]) + nout = IM_LEN(out[1],1) + do i = 1, nimages { + npix = IM_LEN(in[i],1) + j = offsets[i,1] + m[i] = Memi[bufs+i-1] + buf = Memi[bufs+i-1] + j + pm = Memi[pms+i-1] + if (npix == nout) + lflag[i] = D_ALL + else + lflag[i] = D_MIX + + v2[1] = v1[1] + do j = 2, ndim { + v2[j] = v1[j] - offsets[i,j] + if (v2[j] < 1 || v2[j] > IM_LEN(in[i],j)) { + lflag[i] = D_NONE + break + } + } + if (project) + v2[ndim+1] = i + + if (lflag[i] == D_NONE) + next + + if (pm == NULL) { + call aclri (Memi[buf], npix) + next + } + + # Do mask I/O and convert to appropriate values in order of + # expected usage. + + if (pm_linenotempty (pm, v2)) { + call pm_glpi (pm, v2, Memi[buf], 32, npix, 0) + + if (mtype == M_BOOLEAN) + ; + else if (mtype == M_BADBITS) + call aandki (Memi[buf], mvalue, Memi[buf], npix) + else if (mtype == M_BADVAL) + call abeqki (Memi[buf], mvalue, Memi[buf], npix) + else if (mtype == M_GOODBITS) { + call aandki (Memi[buf], mvalue, Memi[buf], npix) + call abeqki (Memi[buf], 0, Memi[buf], npix) + } else if (mtype == M_GOODVAL) + call abneki (Memi[buf], mvalue, Memi[buf], npix) + + lflag[i] = D_NONE + do j = 1, npix + if (Memi[buf+j-1] == 0) { + lflag[i] = D_MIX + break + } + } else { + if (mtype == M_BOOLEAN || mtype == M_BADBITS) { + call aclri (Memi[buf], npix) + } else if ((mtype == M_BADVAL && mvalue != 0) || + (mtype == M_GOODVAL && mvalue == 0)) { + call aclri (Memi[buf], npix) + } else { + call amovki (1, Memi[buf], npix) + lflag[i] = D_NONE + } + } + } + + # Set overall data flag + dflag = lflag[1] + do i = 2, nimages { + if (lflag[i] != dflag) { + dflag = D_MIX + break + } + } +end + + +# IC_MGET1 -- Get line of mask pixels from a specified image. +# This is used by the IC_STAT procedure. This procedure converts the +# stored mask format to an array where zero is good and nonzero is bad. +# The data vector and returned mask array are in the input image pixel system. + +procedure ic_mget1 (in, image, offset, v, m) + +pointer in # Input image pointer +int image # Image index +int offset # Column offset +long v[IM_MAXDIM] # Data vector desired +pointer m # Pointer to mask + +int mtype # Mask type +int mvalue # Mask value +pointer bufs # Pointer to data line buffers +pointer pms # Pointer to array of PMIO pointers + +int i, npix +pointer buf, pm +bool pm_linenotempty() +errchk pm_glpi + +include "icombine.com" + +begin + dflag = D_ALL + if (icm == NULL) + return + if (ICM_TYPE(icm) == M_NONE) + return + + mtype = ICM_TYPE(icm) + mvalue = ICM_VALUE(icm) + bufs = ICM_BUFS(icm) + pms = ICM_PMS(icm) + + npix = IM_LEN(in,1) + m = Memi[bufs+image-1] + offset + pm = Memi[pms+image-1] + if (pm == NULL) + return + + # Do mask I/O and convert to appropriate values in order of + # expected usage. + + buf = m + if (pm_linenotempty (pm, v)) { + call pm_glpi (pm, v, Memi[buf], 32, npix, 0) + + if (mtype == M_BOOLEAN) + ; + else if (mtype == M_BADBITS) + call aandki (Memi[buf], mvalue, Memi[buf], npix) + else if (mtype == M_BADVAL) + call abeqki (Memi[buf], mvalue, Memi[buf], npix) + else if (mtype == M_GOODBITS) { + call aandki (Memi[buf], mvalue, Memi[buf], npix) + call abeqki (Memi[buf], 0, Memi[buf], npix) + } else if (mtype == M_GOODVAL) + call abneki (Memi[buf], mvalue, Memi[buf], npix) + + dflag = D_NONE + do i = 1, npix + if (Memi[buf+i-1] == 0) { + dflag = D_MIX + break + } + } else { + if (mtype == M_BOOLEAN || mtype == M_BADBITS) { + ; + } else if ((mtype == M_BADVAL && mvalue != 0) || + (mtype == M_GOODVAL && mvalue == 0)) { + ; + } else + dflag = D_NONE + } +end diff --git a/noao/imred/ccdred/src/icmedian.gx b/noao/imred/ccdred/src/icmedian.gx new file mode 100644 index 00000000..dc8488d9 --- /dev/null +++ b/noao/imred/ccdred/src/icmedian.gx @@ -0,0 +1,228 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "../icombine.h" + +$for (sr) +# IC_MEDIAN -- Median of lines + +procedure ic_median$t (d, n, npts, median) + +pointer d[ARB] # Input data line pointers +int n[npts] # Number of good pixels +int npts # Number of output points per line +$if (datatype == sil) +real median[npts] # Median +$else +PIXEL median[npts] # Median +$endif + +int i, j, k, j1, j2, n1, lo, up, lo1, up1 +bool even +$if (datatype == silx) +real val1, val2, val3 +$else +PIXEL val1, val2, val3 +$endif +PIXEL temp, wtemp +$if (datatype == x) +real abs_temp +$endif + +include "../icombine.com" + +begin + # If no data return after possibly setting blank values. + if (dflag == D_NONE) { + do i = 1, npts + median[i]= blank + return + } + + # If the data were previously sorted then directly compute the median. + if (mclip) { + if (dflag == D_ALL) { + n1 = n[1] + even = (mod (n1, 2) == 0) + j1 = n1 / 2 + 1 + j2 = n1 / 2 + do i = 1, npts { + k = i - 1 + if (even) { + val1 = Mem$t[d[j1]+k] + val2 = Mem$t[d[j2]+k] + median[i] = (val1 + val2) / 2. + } else + median[i] = Mem$t[d[j1]+k] + } + } else { + do i = 1, npts { + k = i - 1 + n1 = n[i] + if (n1 > 0) { + j1 = n1 / 2 + 1 + if (mod (n1, 2) == 0) { + j2 = n1 / 2 + val1 = Mem$t[d[j1]+k] + val2 = Mem$t[d[j2]+k] + median[i] = (val1 + val2) / 2. + } else + median[i] = Mem$t[d[j1]+k] + } else + median[i] = blank + } + } + return + } + + # Compute the median. + do i = 1, npts { + k = i - 1 + n1 = n[i] + + # If there are more than 3 points use Wirth algorithm. This + # is the same as vops$amed.gx except for an even number of + # points it selects the middle two and averages. + if (n1 > 3) { + lo = 1 + up = n1 + j = max (lo, min (up, (up+1)/2)) + + while (lo < up) { + if (! (lo < up)) + break + + temp = Mem$t[d[j]+k]; lo1 = lo; up1 = up + $if (datatype == x) + abs_temp = abs (temp) + $endif + + repeat { + $if (datatype == x) + while (abs (Mem$t[d[lo1]+k]) < abs_temp) + $else + while (Mem$t[d[lo1]+k] < temp) + $endif + lo1 = lo1 + 1 + $if (datatype == x) + while (abs_temp < abs (Mem$t[d[up1]+k])) + $else + while (temp < Mem$t[d[up1]+k]) + $endif + up1 = up1 - 1 + if (lo1 <= up1) { + wtemp = Mem$t[d[lo1]+k] + Mem$t[d[lo1]+k] = Mem$t[d[up1]+k] + Mem$t[d[up1]+k] = wtemp + lo1 = lo1 + 1; up1 = up1 - 1 + } + } until (lo1 > up1) + + if (up1 < j) + lo = lo1 + if (j < lo1) + up = up1 + } + + median[i] = Mem$t[d[j]+k] + + if (mod (n1,2) == 0) { + lo = 1 + up = n1 + j = max (lo, min (up, (up+1)/2)+1) + + while (lo < up) { + if (! (lo < up)) + break + + temp = Mem$t[d[j]+k]; lo1 = lo; up1 = up + $if (datatype == x) + abs_temp = abs (temp) + $endif + + repeat { + $if (datatype == x) + while (abs (Mem$t[d[lo1]+k]) < abs_temp) + $else + while (Mem$t[d[lo1]+k] < temp) + $endif + lo1 = lo1 + 1 + $if (datatype == x) + while (abs_temp < abs (Mem$t[d[up1]+k])) + $else + while (temp < Mem$t[d[up1]+k]) + $endif + up1 = up1 - 1 + if (lo1 <= up1) { + wtemp = Mem$t[d[lo1]+k] + Mem$t[d[lo1]+k] = Mem$t[d[up1]+k] + Mem$t[d[up1]+k] = wtemp + lo1 = lo1 + 1; up1 = up1 - 1 + } + } until (lo1 > up1) + + if (up1 < j) + lo = lo1 + if (j < lo1) + up = up1 + } + median[i] = (median[i] + Mem$t[d[j]+k]) / 2 + } + + # If 3 points find the median directly. + } else if (n1 == 3) { + $if (datatype == x) + val1 = abs (Mem$t[d[1]+k]) + val2 = abs (Mem$t[d[2]+k]) + val3 = abs (Mem$t[d[3]+k]) + if (val1 < val2) { + if (val2 < val3) # abc + median[i] = Mem$t[d[2]+k] + else if (val1 < val3) # acb + median[i] = Mem$t[d[3]+k] + else # cab + median[i] = Mem$t[d[1]+k] + } else { + if (val2 > val3) # cba + median[i] = Mem$t[d[2]+k] + else if (val1 > val3) # bca + median[i] = Mem$t[d[3]+k] + else # bac + median[i] = Mem$t[d[1]+k] + } + $else + val1 = Mem$t[d[1]+k] + val2 = Mem$t[d[2]+k] + val3 = Mem$t[d[3]+k] + if (val1 < val2) { + if (val2 < val3) # abc + median[i] = val2 + else if (val1 < val3) # acb + median[i] = val3 + else # cab + median[i] = val1 + } else { + if (val2 > val3) # cba + median[i] = val2 + else if (val1 > val3) # bca + median[i] = val3 + else # bac + median[i] = val1 + } + $endif + + # If 2 points average. + } else if (n1 == 2) { + val1 = Mem$t[d[1]+k] + val2 = Mem$t[d[2]+k] + median[i] = (val1 + val2) / 2 + + # If 1 point return the value. + } else if (n1 == 1) + median[i] = Mem$t[d[1]+k] + + # If no points return with a possibly blank value. + else + median[i] = blank + } +end +$endfor diff --git a/noao/imred/ccdred/src/icmm.gx b/noao/imred/ccdred/src/icmm.gx new file mode 100644 index 00000000..90837ae5 --- /dev/null +++ b/noao/imred/ccdred/src/icmm.gx @@ -0,0 +1,177 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "../icombine.h" + +$for (sr) +# IC_MM -- Reject a specified number of high and low pixels + +procedure ic_mm$t (d, m, n, npts) + +pointer d[ARB] # Data pointers +pointer m[ARB] # Image ID pointers +int n[npts] # Number of good pixels +int npts # Number of output points per line + +int n1, ncombine, npairs, nlow, nhigh, np +int i, i1, j, jmax, jmin +pointer k, kmax, kmin +PIXEL d1, d2, dmin, dmax + +include "../icombine.com" + +begin + if (dflag == D_NONE) + return + + if (dflag == D_ALL) { + n1 = n[1] + nlow = flow * n1 + 0.001 + nhigh = fhigh * n1 + 0.001 + ncombine = n1 - nlow - nhigh + npairs = min (nlow, nhigh) + nlow = nlow - npairs + nhigh = nhigh - npairs + } + + do i = 1, npts { + i1 = i - 1 + n1 = n[i] + if (dflag == D_MIX) { + nlow = flow * n1 + 0.001 + nhigh = fhigh * n1 + 0.001 + ncombine = max (ncombine, n1 - nlow - nhigh) + npairs = min (nlow, nhigh) + nlow = nlow - npairs + nhigh = nhigh - npairs + } + + # Reject the npairs low and high points. + do np = 1, npairs { + k = d[1] + i1 + $if (datatype == x) + d1 = abs (Mem$t[k]) + $else + d1 = Mem$t[k] + $endif + dmax = d1; dmin = d1; jmax = 1; jmin = 1; kmax = k; kmin = k + do j = 2, n1 { + d2 = d1 + k = d[j] + i1 + $if (datatype == x) + d1 = abs (Mem$t[k]) + $else + d1 = Mem$t[k] + $endif + if (d1 > dmax) { + dmax = d1; jmax = j; kmax = k + } else if (d1 < dmin) { + dmin = d1; jmin = j; kmin = k + } + } + j = n1 - 1 + if (keepids) { + if (jmax < j) { + if (jmin != j) { + Mem$t[kmax] = d2 + Memi[m[jmax]+i1] = Memi[m[j]+i1] + } else { + Mem$t[kmax] = d1 + Memi[m[jmax]+i1] = Memi[m[n1]+i1] + } + } + if (jmin < j) { + if (jmax != n1) { + Mem$t[kmin] = d1 + Memi[m[jmin]+i1] = Memi[m[n1]+i1] + } else { + Mem$t[kmin] = d2 + Memi[m[jmin]+i1] = Memi[m[j]+i1] + } + } + } else { + if (jmax < j) { + if (jmin != j) + Mem$t[kmax] = d2 + else + Mem$t[kmax] = d1 + } + if (jmin < j) { + if (jmax != n1) + Mem$t[kmin] = d1 + else + Mem$t[kmin] = d2 + } + } + n1 = n1 - 2 + } + + # Reject the excess low points. + do np = 1, nlow { + k = d[1] + i1 + $if (datatype == x) + d1 = abs (Mem$t[k]) + $else + d1 = Mem$t[k] + $endif + dmin = d1; jmin = 1; kmin = k + do j = 2, n1 { + k = d[j] + i1 + $if (datatype == x) + d1 = abs (Mem$t[k]) + $else + d1 = Mem$t[k] + $endif + if (d1 < dmin) { + dmin = d1; jmin = j; kmin = k + } + } + if (keepids) { + if (jmin < n1) { + Mem$t[kmin] = d1 + Memi[m[jmin]+i1] = Memi[m[n1]+i1] + } + } else { + if (jmin < n1) + Mem$t[kmin] = d1 + } + n1 = n1 - 1 + } + + # Reject the excess high points. + do np = 1, nhigh { + k = d[1] + i1 + $if (datatype == x) + d1 = abs (Mem$t[k]) + $else + d1 = Mem$t[k] + $endif + dmax = d1; jmax = 1; kmax = k + do j = 2, n1 { + k = d[j] + i1 + $if (datatype == x) + d1 = abs (Mem$t[k]) + $else + d1 = Mem$t[k] + $endif + if (d1 > dmax) { + dmax = d1; jmax = j; kmax = k + } + } + if (keepids) { + if (jmax < n1) { + Mem$t[kmax] = d1 + Memi[m[jmax]+i1] = Memi[m[n1]+i1] + } + } else { + if (jmax < n1) + Mem$t[kmax] = d1 + } + n1 = n1 - 1 + } + n[i] = n1 + } + + if (dflag == D_ALL && npairs + nlow + nhigh > 0) + dflag = D_MIX +end +$endfor diff --git a/noao/imred/ccdred/src/icombine.com b/noao/imred/ccdred/src/icombine.com new file mode 100644 index 00000000..cb826d58 --- /dev/null +++ b/noao/imred/ccdred/src/icombine.com @@ -0,0 +1,40 @@ +# ICOMBINE Common + +int combine # Combine algorithm +int reject # Rejection algorithm +bool project # Combine across the highest dimension? +real blank # Blank value +pointer rdnoise # CCD read noise +pointer gain # CCD gain +pointer snoise # CCD sensitivity noise +real lthresh # Low threshold +real hthresh # High threshold +int nkeep # Minimum to keep +real lsigma # Low sigma cutoff +real hsigma # High sigma cutoff +real pclip # Number or fraction of pixels from median +real flow # Fraction of low pixels to reject +real fhigh # Fraction of high pixels to reject +int grow # Grow radius +bool mclip # Use median in sigma clipping? +real sigscale # Sigma scaling tolerance +int logfd # Log file descriptor + +# These flags allow special conditions to be optimized. + +int dflag # Data flag (D_ALL, D_NONE, D_MIX) +bool aligned # Are the images aligned? +bool doscale # Do the images have to be scaled? +bool doscale1 # Do the sigma calculations have to be scaled? +bool dothresh # Check pixels outside specified thresholds? +bool dowts # Does the final average have to be weighted? +bool keepids # Keep track of the image indices? +bool docombine # Call the combine procedure? +bool sort # Sort data? + +pointer icm # Mask data structure + +common /imccom/ combine, reject, blank, rdnoise, gain, snoise, lsigma, hsigma, + lthresh, hthresh, nkeep, pclip, flow, fhigh, grow, logfd, + dflag, sigscale, project, mclip, aligned, doscale, doscale1, + dothresh, dowts, keepids, docombine, sort, icm diff --git a/noao/imred/ccdred/src/icombine.gx b/noao/imred/ccdred/src/icombine.gx new file mode 100644 index 00000000..d6e93ef0 --- /dev/null +++ b/noao/imred/ccdred/src/icombine.gx @@ -0,0 +1,395 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> +include <imset.h> +include <error.h> +include <syserr.h> +include <mach.h> +include "../icombine.h" + + +# ICOMBINE -- Combine images +# +# The memory and open file descriptor limits are checked and an attempt +# to recover is made either by setting the image pixel files to be +# closed after I/O or by notifying the calling program that memory +# ran out and the IMIO buffer size should be reduced. After the checks +# a procedure for the selected combine option is called. +# Because there may be several failure modes when reaching the file +# limits we first assume an error is due to the file limit, except for +# out of memory, and close some pixel files. If the error then repeats +# on accessing the pixels the error is passed back. + +$for (sr) +procedure icombine$t (in, out, offsets, nimages, bufsize) + +pointer in[nimages] # Input images +pointer out[ARB] # Output images +int offsets[nimages,ARB] # Input image offsets +int nimages # Number of input images +int bufsize # IMIO buffer size + +char str[1] +int i, j, npts, fd, stropen(), errcode(), imstati() +pointer sp, d, id, n, m, lflag, scales, zeros, wts, dbuf +pointer buf, imgl1$t(), impl1i() +errchk stropen, imgl1$t, impl1i +$if (datatype == sil) +pointer impl1r() +errchk impl1r +$else +pointer impl1$t() +errchk impl1$t +$endif + +include "../icombine.com" + +begin + npts = IM_LEN(out[1],1) + + # Allocate memory. + call smark (sp) + call salloc (d, nimages, TY_POINTER) + call salloc (id, nimages, TY_POINTER) + call salloc (n, npts, TY_INT) + call salloc (m, nimages, TY_POINTER) + call salloc (lflag, nimages, TY_INT) + call salloc (scales, nimages, TY_REAL) + call salloc (zeros, nimages, TY_REAL) + call salloc (wts, nimages, TY_REAL) + call amovki (D_ALL, Memi[lflag], nimages) + + # If aligned use the IMIO buffer otherwise we need vectors of + # output length. + + if (!aligned) { + call salloc (dbuf, nimages, TY_POINTER) + do i = 1, nimages + call salloc (Memi[dbuf+i-1], npts, TY_PIXEL) + } + + if (project) { + call imseti (in[1], IM_NBUFS, nimages) + call imseti (in[1], IM_BUFSIZE, bufsize) + do i = 1, 3 { + if (out[i] != NULL) + call imseti (out[i], IM_BUFSIZE, bufsize) + } + } else { + # Reserve FD for string operations. + fd = stropen (str, 1, NEW_FILE) + + # Do I/O to the images. + do i = 1, 3 { + if (out[i] != NULL) + call imseti (out[i], IM_BUFSIZE, bufsize) + } + $if (datatype == sil) + buf = impl1r (out[1]) + call aclrr (Memr[buf], npts) + if (out[3] != NULL) { + buf = impl1r (out[3]) + call aclrr (Memr[buf], npts) + } + $else + buf = impl1$t (out[1]) + call aclr$t (Mem$t[buf], npts) + if (out[3] != NULL) { + buf = impl1$t (out[3]) + call aclr$t (Mem$t[buf], npts) + } + $endif + if (out[2] != NULL) { + buf = impl1i (out[2]) + call aclri (Memi[buf], npts) + } + + do i = 1, nimages { + call imseti (in[i], IM_BUFSIZE, bufsize) + iferr (buf = imgl1$t (in[i])) { + switch (errcode()) { + case SYS_MFULL: + call sfree (sp) + call strclose (fd) + call erract (EA_ERROR) + case SYS_FTOOMANYFILES, SYS_IKIOPIX: + if (imstati (in[i], IM_CLOSEFD) == YES) { + call sfree (sp) + call strclose (fd) + call erract (EA_ERROR) + } + do j = i-2, nimages + call imseti (in[j], IM_CLOSEFD, YES) + buf = imgl1$t (in[i]) + default: + call sfree (sp) + call strclose (fd) + call erract (EA_ERROR) + } + } + } + + call strclose (fd) + } + + call ic_combine$t (in, out, Memi[dbuf], Memi[d], Memi[id], Memi[n], + Memi[m], Memi[lflag], offsets, Memr[scales], Memr[zeros], + Memr[wts], nimages, npts) +end + + +# IC_COMBINE -- Combine images. + +procedure ic_combine$t (in, out, dbuf, d, id, n, m, lflag, offsets, + scales, zeros, wts, nimages, npts) + +pointer in[nimages] # Input images +pointer out[ARB] # Output image +pointer dbuf[nimages] # Data buffers for nonaligned images +pointer d[nimages] # Data pointers +pointer id[nimages] # Image index ID pointers +int n[npts] # Number of good pixels +pointer m[nimages] # Mask pointers +int lflag[nimages] # Line flags +int offsets[nimages,ARB] # Input image offsets +real scales[nimages] # Scale factors +real zeros[nimages] # Zero offset factors +real wts[nimages] # Combining weights +int nimages # Number of input images +int npts # Number of points per output line + +int i, ctor() +real r, imgetr() +pointer sp, v1, v2, v3, outdata, buf, nm, impnli() +$if (datatype == sil) +pointer impnlr() +$else +pointer impnl$t() +$endif +errchk ic_scale, imgetr + +include "../icombine.com" + +begin + call smark (sp) + call salloc (v1, IM_MAXDIM, TY_LONG) + call salloc (v2, IM_MAXDIM, TY_LONG) + call salloc (v3, IM_MAXDIM, TY_LONG) + call amovkl (long(1), Meml[v1], IM_MAXDIM) + call amovkl (long(1), Meml[v2], IM_MAXDIM) + call amovkl (long(1), Meml[v3], IM_MAXDIM) + + call ic_scale (in, out, offsets, scales, zeros, wts, nimages) + + # Set combine parameters + switch (combine) { + case AVERAGE: + if (dowts) + keepids = true + else + keepids = false + case MEDIAN: + dowts = false + keepids = false + } + docombine = true + + # Set rejection algorithm specific parameters + switch (reject) { + case CCDCLIP, CRREJECT: + call salloc (nm, 3*nimages, TY_REAL) + i = 1 + if (ctor (Memc[rdnoise], i, r) > 0) { + do i = 1, nimages + Memr[nm+3*(i-1)] = r + } else { + do i = 1, nimages + Memr[nm+3*(i-1)] = imgetr (in[i], Memc[rdnoise]) + } + i = 1 + if (ctor (Memc[gain], i, r) > 0) { + do i = 1, nimages { + Memr[nm+3*(i-1)+1] = r + Memr[nm+3*(i-1)] = + max ((Memr[nm+3*(i-1)] / r) ** 2, 1e4 / MAX_REAL) + } + } else { + do i = 1, nimages { + r = imgetr (in[i], Memc[gain]) + Memr[nm+3*(i-1)+1] = r + Memr[nm+3*(i-1)] = + max ((Memr[nm+3*(i-1)] / r) ** 2, 1e4 / MAX_REAL) + } + } + i = 1 + if (ctor (Memc[snoise], i, r) > 0) { + do i = 1, nimages + Memr[nm+3*(i-1)+2] = r + } else { + do i = 1, nimages { + r = imgetr (in[i], Memc[snoise]) + Memr[nm+3*(i-1)+2] = r + } + } + if (!keepids) { + if (doscale1 || grow > 0) + keepids = true + else { + do i = 2, nimages { + if (Memr[nm+3*(i-1)] != Memr[nm] || + Memr[nm+3*(i-1)+1] != Memr[nm+1] || + Memr[nm+3*(i-1)+2] != Memr[nm+2]) { + keepids = true + break + } + } + } + } + if (reject == CRREJECT) + lsigma = MAX_REAL + case MINMAX: + mclip = false + if (grow > 0) + keepids = true + case PCLIP: + mclip = true + if (grow > 0) + keepids = true + case AVSIGCLIP, SIGCLIP: + if (doscale1 || grow > 0) + keepids = true + case NONE: + mclip = false + grow = 0 + } + + if (keepids) { + do i = 1, nimages + call salloc (id[i], npts, TY_INT) + } + + $if (datatype == sil) + while (impnlr (out[1], outdata, Meml[v1]) != EOF) { + call ic_gdata$t (in, out, dbuf, d, id, n, m, lflag, offsets, + scales, zeros, nimages, npts, Meml[v2], Meml[v3]) + + switch (reject) { + case CCDCLIP, CRREJECT: + if (mclip) + call ic_mccdclip$t (d, id, n, scales, zeros, Memr[nm], + nimages, npts, Memr[outdata]) + else + call ic_accdclip$t (d, id, n, scales, zeros, Memr[nm], + nimages, npts, Memr[outdata]) + case MINMAX: + call ic_mm$t (d, id, n, npts) + case PCLIP: + call ic_pclip$t (d, id, n, nimages, npts, Memr[outdata]) + case SIGCLIP: + if (mclip) + call ic_msigclip$t (d, id, n, scales, zeros, nimages, npts, + Memr[outdata]) + else + call ic_asigclip$t (d, id, n, scales, zeros, nimages, npts, + Memr[outdata]) + case AVSIGCLIP: + if (mclip) + call ic_mavsigclip$t (d, id, n, scales, zeros, nimages, + npts, Memr[outdata]) + else + call ic_aavsigclip$t (d, id, n, scales, zeros, nimages, + npts, Memr[outdata]) + } + + if (grow > 0) + call ic_grow$t (d, id, n, nimages, npts, Memr[outdata]) + + if (docombine) { + switch (combine) { + case AVERAGE: + call ic_average$t (d, id, n, wts, npts, Memr[outdata]) + case MEDIAN: + call ic_median$t (d, n, npts, Memr[outdata]) + } + } + + if (out[2] != NULL) { + call amovl (Meml[v2], Meml[v1], IM_MAXDIM) + i = impnli (out[2], buf, Meml[v1]) + call amovki (nimages, Memi[buf], npts) + call asubi (Memi[buf], n, Memi[buf], npts) + } + + if (out[3] != NULL) { + call amovl (Meml[v2], Meml[v1], IM_MAXDIM) + i = impnlr (out[3], buf, Meml[v1]) + call ic_sigma$t (d, id, n, wts, npts, Memr[outdata], + Memr[buf]) + } + call amovl (Meml[v1], Meml[v2], IM_MAXDIM) + } + $else + while (impnl$t (out[1], outdata, Meml[v1]) != EOF) { + call ic_gdata$t (in, out, dbuf, d, id, n, m, lflag, offsets, + scales, zeros, nimages, npts, Meml[v2], Meml[v3]) + + switch (reject) { + case CCDCLIP, CRREJECT: + if (mclip) + call ic_mccdclip$t (d, id, n, scales, zeros, Memr[nm], + nimages, npts, Mem$t[outdata]) + else + call ic_accdclip$t (d, id, n, scales, zeros, Memr[nm], + nimages, npts, Mem$t[outdata]) + case MINMAX: + call ic_mm$t (d, id, n, npts) + case PCLIP: + call ic_pclip$t (d, id, n, nimages, npts, Mem$t[outdata]) + case SIGCLIP: + if (mclip) + call ic_msigclip$t (d, id, n, scales, zeros, nimages, npts, + Mem$t[outdata]) + else + call ic_asigclip$t (d, id, n, scales, zeros, nimages, npts, + Mem$t[outdata]) + case AVSIGCLIP: + if (mclip) + call ic_mavsigclip$t (d, id, n, scales, zeros, nimages, + npts, Mem$t[outdata]) + else + call ic_aavsigclip$t (d, id, n, scales, zeros, nimages, + npts, Mem$t[outdata]) + } + + if (grow > 0) + call ic_grow$t (d, id, n, nimages, npts, Mem$t[outdata]) + + if (docombine) { + switch (combine) { + case AVERAGE: + call ic_average$t (d, id, n, wts, npts, Mem$t[outdata]) + case MEDIAN: + call ic_median$t (d, n, npts, Mem$t[outdata]) + } + } + + if (out[2] != NULL) { + call amovl (Meml[v2], Meml[v1], IM_MAXDIM) + i = impnli (out[2], buf, Meml[v1]) + call amovki (nimages, Memi[buf], npts) + call asubi (Memi[buf], n, Memi[buf], npts) + } + + if (out[3] != NULL) { + call amovl (Meml[v2], Meml[v1], IM_MAXDIM) + i = impnl$t (out[3], buf, Meml[v1]) + call ic_sigma$t (d, id, n, wts, npts, Mem$t[outdata], + Mem$t[buf]) + } + call amovl (Meml[v1], Meml[v2], IM_MAXDIM) + } + $endif + + call sfree (sp) +end +$endfor diff --git a/noao/imred/ccdred/src/icombine.h b/noao/imred/ccdred/src/icombine.h new file mode 100644 index 00000000..13b77117 --- /dev/null +++ b/noao/imred/ccdred/src/icombine.h @@ -0,0 +1,52 @@ +# ICOMBINE Definitions + +# Memory management parameters; +define DEFBUFSIZE 65536 # default IMIO buffer size +define FUDGE 0.8 # fudge factor + +# Rejection options: +define REJECT "|none|ccdclip|crreject|minmax|pclip|sigclip|avsigclip|" +define NONE 1 # No rejection algorithm +define CCDCLIP 2 # CCD noise function clipping +define CRREJECT 3 # CCD noise function clipping +define MINMAX 4 # Minmax rejection +define PCLIP 5 # Percentile clip +define SIGCLIP 6 # Sigma clip +define AVSIGCLIP 7 # Sigma clip with average poisson sigma + +# Combine options: +define COMBINE "|average|median|" +define AVERAGE 1 +define MEDIAN 2 + +# Scaling options: +define STYPES "|none|mode|median|mean|exposure|" +define ZTYPES "|none|mode|median|mean|" +define WTYPES "|none|mode|median|mean|exposure|" +define S_NONE 1 +define S_MODE 2 +define S_MEDIAN 3 +define S_MEAN 4 +define S_EXPOSURE 5 +define S_FILE 6 +define S_KEYWORD 7 +define S_SECTION "|input|output|overlap|" +define S_INPUT 1 +define S_OUTPUT 2 +define S_OVERLAP 3 + +# Mask options +define MASKTYPES "|none|goodvalue|badvalue|goodbits|badbits|" +define M_NONE 1 # Don't use mask images +define M_GOODVAL 2 # Value selecting good pixels +define M_BADVAL 3 # Value selecting bad pixels +define M_GOODBITS 4 # Bits selecting good pixels +define M_BADBITS 5 # Bits selecting bad pixels +define M_BOOLEAN -1 # Ignore mask values + +# Data flag +define D_ALL 0 # All pixels are good +define D_NONE 1 # All pixels are bad or rejected +define D_MIX 2 # Mixture of good and bad pixels + +define TOL 0.001 # Tolerance for equal residuals diff --git a/noao/imred/ccdred/src/icpclip.gx b/noao/imred/ccdred/src/icpclip.gx new file mode 100644 index 00000000..223396c3 --- /dev/null +++ b/noao/imred/ccdred/src/icpclip.gx @@ -0,0 +1,233 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "../icombine.h" + +define MINCLIP 3 # Minimum number for clipping + +$for (sr) +# IC_PCLIP -- Percentile clip +# +# 1) Find the median +# 2) Find the pixel which is the specified order index away +# 3) Use the data value difference as a sigma and apply clipping +# 4) Since the median is known return it so it does not have to be recomputed + +procedure ic_pclip$t (d, m, n, nimages, npts, median) + +pointer d[ARB] # Data pointers +pointer m[ARB] # Image id pointers +int n[npts] # Number of good pixels +int nimages # Number of input images +int npts # Number of output points per line +$if (datatype == sil) +real median[npts] # Median +$else +PIXEL median[npts] # Median +$endif + +int i, j, k, l, id, n1, n2, n3, n4, n5, nl, nh, nin, maxkeep +bool even, fp_equalr() +real sigma, r, s, t +pointer sp, resid, mp1, mp2 +$if (datatype == sil) +real med +$else +PIXEL med +$endif + +include "../icombine.com" + +begin + # There must be at least MINCLIP and more than nkeep pixels. + if (nkeep < 0) + maxkeep = max (0, nimages + nkeep) + else + maxkeep = min (nimages, nkeep) + if (nimages < max (MINCLIP, maxkeep+1) || dflag == D_NONE) { + docombine = true + return + } + + call smark (sp) + call salloc (resid, nimages+1, TY_REAL) + + # Set sign of pclip parameter + if (pclip < 0) + t = -1. + else + t = 1. + + # If there are no rejected pixels compute certain parameters once. + if (dflag == D_ALL) { + n1 = n[1] + if (nkeep < 0) + maxkeep = max (0, n1 + nkeep) + else + maxkeep = min (n1, nkeep) + n2 = 1 + n1 / 2 + even = (mod (n1, 2) == 0) + if (pclip < 0.) { + if (even) + n3 = max (1, nint (n2 - 1 + pclip)) + else + n3 = max (1, nint (n2 + pclip)) + } else + n3 = min (n1, nint (n2 + pclip)) + nin = n1 + } + + # Now apply clipping. + do i = 1, npts { + # Compute median. + if (dflag == D_MIX) { + n1 = n[i] + if (nkeep < 0) + maxkeep = max (0, n1 + nkeep) + else + maxkeep = min (n1, nkeep) + if (n1 == 0) { + if (combine == MEDIAN) + median[i] = blank + next + } + n2 = 1 + n1 / 2 + even = (mod (n1, 2) == 0) + if (pclip < 0) { + if (even) + n3 = max (1, nint (n2 - 1 + pclip)) + else + n3 = max (1, nint (n2 + pclip)) + } else + n3 = min (n1, nint (n2 + pclip)) + } + + j = i - 1 + if (even) { + med = Mem$t[d[n2-1]+j] + med = (med + Mem$t[d[n2]+j]) / 2. + } else + med = Mem$t[d[n2]+j] + + if (n1 < max (MINCLIP, maxkeep+1)) { + if (combine == MEDIAN) + median[i] = med + next + } + + # Define sigma for clipping + sigma = t * (Mem$t[d[n3]+j] - med) + if (fp_equalr (sigma, 0.)) { + if (combine == MEDIAN) + median[i] = med + next + } + + # Reject pixels and save residuals. + # Check if any pixels are clipped. + # If so recompute the median and reset the number of good pixels. + # Only reorder if needed. + + for (nl=1; nl<=n1; nl=nl+1) { + r = (med - Mem$t[d[nl]+j]) / sigma + if (r < lsigma) + break + Memr[resid+nl] = r + } + for (nh=n1; nh>=1; nh=nh-1) { + r = (Mem$t[d[nh]+j] - med) / sigma + if (r < hsigma) + break + Memr[resid+nh] = r + } + n4 = nh - nl + 1 + + # If too many pixels are rejected add some back in. + # All pixels with the same residual are added. + while (n4 < maxkeep) { + if (nl == 1) + nh = nh + 1 + else if (nh == n[i]) + nl = nl - 1 + else { + r = Memr[resid+nl-1] + s = Memr[resid+nh+1] + if (r < s) { + nl = nl - 1 + r = r + TOL + if (s <= r) + nh = nh + 1 + if (nl > 1) { + if (Memr[resid+nl-1] <= r) + nl = nl - 1 + } + } else { + nh = nh + 1 + s = s + TOL + if (r <= s) + nl = nl - 1 + if (nh < n2) { + if (Memr[resid+nh+1] <= s) + nh = nh + 1 + } + } + } + n4 = nh - nl + 1 + } + + # If any pixels are rejected recompute the median. + if (nl > 1 || nh < n1) { + n5 = nl + n4 / 2 + if (mod (n4, 2) == 0) { + med = Mem$t[d[n5-1]+j] + med = (med + Mem$t[d[n5]+j]) / 2. + } else + med = Mem$t[d[n5]+j] + n[i] = n4 + } + if (combine == MEDIAN) + median[i] = med + + # Reorder if pixels only if necessary. + if (nl > 1 && (combine != MEDIAN || grow > 0)) { + k = max (nl, n4 + 1) + if (keepids) { + do l = 1, min (n1, nl-1) { + Mem$t[d[l]+j] = Mem$t[d[k]+j] + if (grow > 0) { + mp1 = m[l] + j + mp2 = m[k] + j + id = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = id + } else + Memi[m[l]+j] = Memi[m[k]+j] + k = k + 1 + } + } else { + do l = 1, min (n1, nl - 1) { + Mem$t[d[l]+j] = Mem$t[d[k]+j] + k = k + 1 + } + } + } + } + + # Check if data flag needs to be reset for rejected pixels. + if (dflag == D_ALL) { + do i = 1, npts { + if (n[i] != nin) { + dflag = D_MIX + break + } + } + } + + # Flag whether the median has been computed. + if (combine == MEDIAN) + docombine = false + else + docombine = true + + call sfree (sp) +end +$endfor diff --git a/noao/imred/ccdred/src/icscale.x b/noao/imred/ccdred/src/icscale.x new file mode 100644 index 00000000..fc4efb2f --- /dev/null +++ b/noao/imred/ccdred/src/icscale.x @@ -0,0 +1,376 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> +include <imset.h> +include <error.h> +include "icombine.h" + +# IC_SCALE -- Get the scale factors for the images. +# 1. This procedure does CLIO to determine the type of scaling desired. +# 2. The output header parameters for exposure time and NCOMBINE are set. + +procedure ic_scale (in, out, offsets, scales, zeros, wts, nimages) + +pointer in[nimages] # Input images +pointer out[ARB] # Output images +int offsets[nimages,ARB] # Image offsets +real scales[nimages] # Scale factors +real zeros[nimages] # Zero or sky levels +real wts[nimages] # Weights +int nimages # Number of images + +int stype, ztype, wtype +int i, j, k, l, nout +real mode, median, mean, exposure, zmean, darktime, dark +pointer sp, ncombine, exptime, modes, medians, means +pointer section, str, sname, zname, wname, imref +bool domode, domedian, domean, dozero, snorm, znorm, wflag + +bool clgetb() +int hdmgeti(), strdic(), ic_gscale() +real hdmgetr(), asumr(), asumi() +errchk ic_gscale, ic_statr + +include "icombine.com" + +begin + call smark (sp) + call salloc (ncombine, nimages, TY_INT) + call salloc (exptime, nimages, TY_REAL) + call salloc (modes, nimages, TY_REAL) + call salloc (medians, nimages, TY_REAL) + call salloc (means, nimages, TY_REAL) + call salloc (section, SZ_FNAME, TY_CHAR) + call salloc (str, SZ_LINE, TY_CHAR) + call salloc (sname, SZ_FNAME, TY_CHAR) + call salloc (zname, SZ_FNAME, TY_CHAR) + call salloc (wname, SZ_FNAME, TY_CHAR) + + # Set the defaults. + call amovki (1, Memi[ncombine], nimages) + call amovkr (0., Memr[exptime], nimages) + call amovkr (INDEF, Memr[modes], nimages) + call amovkr (INDEF, Memr[medians], nimages) + call amovkr (INDEF, Memr[means], nimages) + call amovkr (1., scales, nimages) + call amovkr (0., zeros, nimages) + call amovkr (1., wts, nimages) + + # Get the number of images previously combined and the exposure times. + # The default combine number is 1 and the default exposure is 0. + + do i = 1, nimages { + iferr (Memi[ncombine+i-1] = hdmgeti (in[i], "ncombine")) + Memi[ncombine+i-1] = 1 + iferr (Memr[exptime+i-1] = hdmgetr (in[i], "exptime")) + Memr[exptime+i-1] = 0. + if (project) { + call amovki (Memi[ncombine], Memi[ncombine], nimages) + call amovkr (Memr[exptime], Memr[exptime], nimages) + break + } + } + + # Set scaling factors. + + stype = ic_gscale ("scale", Memc[sname], STYPES, in, Memr[exptime], + scales, nimages) + ztype = ic_gscale ("zero", Memc[zname], ZTYPES, in, Memr[exptime], + zeros, nimages) + wtype = ic_gscale ("weight", Memc[wname], WTYPES, in, Memr[exptime], + wts, nimages) + + # Get image statistics only if needed. + domode = ((stype==S_MODE)||(ztype==S_MODE)||(wtype==S_MODE)) + domedian = ((stype==S_MEDIAN)||(ztype==S_MEDIAN)||(wtype==S_MEDIAN)) + domean = ((stype==S_MEAN)||(ztype==S_MEAN)||(wtype==S_MEAN)) + if (domode || domedian || domean) { + Memc[section] = EOS + Memc[str] = EOS + call clgstr ("statsec", Memc[section], SZ_FNAME) + call sscan (Memc[section]) + call gargwrd (Memc[section], SZ_FNAME) + call gargwrd (Memc[str], SZ_LINE) + + i = strdic (Memc[section], Memc[section], SZ_FNAME, S_SECTION) + switch (i) { + case S_INPUT: + call strcpy (Memc[str], Memc[section], SZ_FNAME) + imref = NULL + case S_OUTPUT: + call strcpy (Memc[str], Memc[section], SZ_FNAME) + imref = out[1] + case S_OVERLAP: + call strcpy ("[", Memc[section], SZ_FNAME) + do i = 1, IM_NDIM(out[1]) { + k = offsets[1,i] + 1 + l = offsets[1,i] + IM_LEN(in[1],i) + do j = 2, nimages { + k = max (k, offsets[j,i]+1) + l = min (l, offsets[j,i]+IM_LEN(in[j],i)) + } + if (i < IM_NDIM(out[1])) + call sprintf (Memc[str], SZ_LINE, "%d:%d,") + else + call sprintf (Memc[str], SZ_LINE, "%d:%d]") + call pargi (k) + call pargi (l) + call strcat (Memc[str], Memc[section], SZ_FNAME) + } + imref = out[1] + default: + imref = NULL + } + + do i = 1, nimages { + if (imref != out[1]) + imref = in[i] + call ic_statr (in[i], imref, Memc[section], offsets, + i, nimages, domode, domedian, domean, mode, median, mean) + if (domode) { + Memr[modes+i-1] = mode + if (stype == S_MODE) + scales[i] = mode + if (ztype == S_MODE) + zeros[i] = mode + if (wtype == S_MODE) + wts[i] = mode + } + if (domedian) { + Memr[medians+i-1] = median + if (stype == S_MEDIAN) + scales[i] = median + if (ztype == S_MEDIAN) + zeros[i] = median + if (wtype == S_MEDIAN) + wts[i] = median + } + if (domean) { + Memr[means+i-1] = mean + if (stype == S_MEAN) + scales[i] = mean + if (ztype == S_MEAN) + zeros[i] = mean + if (wtype == S_MEAN) + wts[i] = mean + } + } + } + + do i = 1, nimages + if (scales[i] <= 0.) { + call eprintf ("WARNING: Negative scale factors") + call eprintf (" -- ignoring scaling\n") + call amovkr (1., scales, nimages) + break + } + + # Convert to relative factors if needed. + snorm = (stype == S_FILE || stype == S_KEYWORD) + znorm = (ztype == S_FILE || ztype == S_KEYWORD) + wflag = (wtype == S_FILE || wtype == S_KEYWORD) + if (snorm) + call arcpr (1., scales, scales, nimages) + else { + mean = asumr (scales, nimages) / nimages + call adivkr (scales, mean, scales, nimages) + } + call adivr (zeros, scales, zeros, nimages) + zmean = asumr (zeros, nimages) / nimages + + if (wtype != S_NONE) { + do i = 1, nimages { + if (wts[i] <= 0.) { + call eprintf ("WARNING: Negative weights") + call eprintf (" -- using only NCOMBINE weights\n") + do j = 1, nimages + wts[j] = Memi[ncombine+j-1] + break + } + if (ztype == S_NONE || znorm || wflag) + wts[i] = Memi[ncombine+i-1] * wts[i] + else { + if (zeros[i] <= 0.) { + call eprintf ("WARNING: Negative zero offsets") + call eprintf (" -- ignoring zero weight adjustments\n") + do j = 1, nimages + wts[j] = Memi[ncombine+j-1] * wts[j] + break + } + wts[i] = Memi[ncombine+i-1] * wts[i] * zmean / zeros[i] + } + } + } + + if (znorm) + call anegr (zeros, zeros, nimages) + else { + # Because of finite arithmetic it is possible for the zero offsets + # to be nonzero even when they are all equal. Just for the sake of + # a nice log set the zero offsets in this case. + + call asubkr (zeros, zmean, zeros, nimages) + for (i=2; (i<=nimages)&&(zeros[i]==zeros[1]); i=i+1) + ; + if (i > nimages) + call aclrr (zeros, nimages) + } + mean = asumr (wts, nimages) + call adivkr (wts, mean, wts, nimages) + + # Set flags for scaling, zero offsets, sigma scaling, weights. + # Sigma scaling may be suppressed if the scales or zeros are + # different by a specified tolerance. + + doscale = false + dozero = false + doscale1 = false + dowts = false + do i = 2, nimages { + if (snorm || scales[i] != scales[1]) + doscale = true + if (znorm || zeros[i] != zeros[1]) + dozero = true + if (wts[i] != wts[1]) + dowts = true + } + if (doscale && sigscale != 0.) { + do i = 1, nimages { + if (abs (scales[i] - 1) > sigscale) { + doscale1 = true + break + } + } + if (!doscale1 && zmean > 0.) { + do i = 1, nimages { + if (abs (zeros[i] / zmean) > sigscale) { + doscale1 = true + break + } + } + } + } + + # Set the output header parameters. + nout = asumi (Memi[ncombine], nimages) + call hdmputi (out[1], "ncombine", nout) + exposure = 0. + darktime = 0. + mean = 0. + do i = 1, nimages { + exposure = exposure + wts[i] * Memr[exptime+i-1] / scales[i] + ifnoerr (dark = hdmgetr (in[i], "darktime")) + darktime = darktime + wts[i] * dark / scales[i] + else + darktime = darktime + wts[i] * Memr[exptime+i-1] / scales[i] + ifnoerr (mode = hdmgetr (in[i], "ccdmean")) + mean = mean + wts[i] * mode / scales[i] + } + call hdmputr (out[1], "exptime", exposure) + call hdmputr (out[1], "darktime", darktime) + ifnoerr (mode = hdmgetr (out[1], "ccdmean")) { + call hdmputr (out[1], "ccdmean", mean) + iferr (call imdelf (out[1], "ccdmeant")) + ; + } + if (out[2] != NULL) { + call imstats (out[2], IM_IMAGENAME, Memc[str], SZ_FNAME) + call imastr (out[1], "BPM", Memc[str]) + } + + # Start the log here since much of the info is only available here. + if (clgetb ("verbose")) { + i = logfd + logfd = STDOUT + call ic_log (in, out, Memi[ncombine], Memr[exptime], Memc[sname], + Memc[zname], Memc[wname], Memr[modes], Memr[medians], + Memr[means], scales, zeros, wts, offsets, nimages, dozero, + nout, "", exposure) + + logfd = i + } + call ic_log (in, out, Memi[ncombine], Memr[exptime], Memc[sname], + Memc[zname], Memc[wname], Memr[modes], Memr[medians], Memr[means], + scales, zeros, wts, offsets, nimages, dozero, nout, + "", exposure) + + doscale = (doscale || dozero) + + call sfree (sp) +end + + +# IC_GSCALE -- Get scale values as directed by CL parameter +# The values can be one of those in the dictionary, from a file specified +# with a @ prefix, or from an image header keyword specified by a ! prefix. + +int procedure ic_gscale (param, name, dic, in, exptime, values, nimages) + +char param[ARB] #I CL parameter name +char name[SZ_FNAME] #O Parameter value +char dic[ARB] #I Dictionary string +pointer in[nimages] #I IMIO pointers +real exptime[nimages] #I Exposure times +real values[nimages] #O Values +int nimages #I Number of images + +int type #O Type of value + +int fd, i, nowhite(), open(), fscan(), nscan(), strdic() +real rval, hdmgetr() +pointer errstr +errchk open, hdmgetr() + +include "icombine.com" + +begin + call clgstr (param, name, SZ_FNAME) + if (nowhite (name, name, SZ_FNAME) == 0) + type = S_NONE + else if (name[1] == '@') { + type = S_FILE + fd = open (name[2], READ_ONLY, TEXT_FILE) + i = 0 + while (fscan (fd) != EOF) { + call gargr (rval) + if (nscan() != 1) + next + if (i == nimages) { + call eprintf ( + "Warning: Ignoring additional %s values in %s\n") + call pargstr (param) + call pargstr (name[2]) + break + } + i = i + 1 + values[i] = rval + } + call close (fd) + if (i < nimages) { + call salloc (errstr, SZ_LINE, TY_CHAR) + call sprintf (Memc[errstr], SZ_FNAME, + "Insufficient %s values in %s") + call pargstr (param) + call pargstr (name[2]) + call error (1, Memc[errstr]) + } + } else if (name[1] == '!') { + type = S_KEYWORD + do i = 1, nimages { + values[i] = hdmgetr (in[i], name[2]) + if (project) { + call amovkr (values, values, nimages) + break + } + } + } else { + type = strdic (name, name, SZ_FNAME, dic) + if (type == 0) + call error (1, "Unknown scale, zero, or weight type") + if (type==S_EXPOSURE) + do i = 1, nimages + values[i] = max (0.001, exptime[i]) + } + + return (type) +end diff --git a/noao/imred/ccdred/src/icsclip.gx b/noao/imred/ccdred/src/icsclip.gx new file mode 100644 index 00000000..f70611aa --- /dev/null +++ b/noao/imred/ccdred/src/icsclip.gx @@ -0,0 +1,504 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "../icombine.h" + +define MINCLIP 3 # Mininum number of images for algorithm + +$for (sr) +# IC_ASIGCLIP -- Reject pixels using sigma clipping about the average +# The initial average rejects the high and low pixels. A correction for +# different scalings of the images may be made. Weights are not used. + +procedure ic_asigclip$t (d, m, n, scales, zeros, nimages, npts, average) + +pointer d[nimages] # Data pointers +pointer m[nimages] # Image id pointers +int n[npts] # Number of good pixels +real scales[nimages] # Scales +real zeros[nimages] # Zeros +int nimages # Number of images +int npts # Number of output points per line +$if (datatype == sil) +real average[npts] # Average +$else +PIXEL average[npts] # Average +$endif + +int i, j, k, l, jj, n1, n2, nin, nk, maxkeep +$if (datatype == sil) +real d1, low, high, sum, a, s, r, one +data one /1.0/ +$else +PIXEL d1, low, high, sum, a, s, r, one +data one /1$f/ +$endif +pointer sp, resid, w, wp, dp1, dp2, mp1, mp2 + +include "../icombine.com" + +begin + # If there are insufficient pixels go on to the combining + if (nkeep < 0) + maxkeep = max (0, nimages + nkeep) + else + maxkeep = min (nimages, nkeep) + if (nimages < max (MINCLIP, maxkeep+1) || dflag == D_NONE) { + docombine = true + return + } + + # Flag whether returned average needs to be recomputed. + if (dowts || combine != AVERAGE) + docombine = true + else + docombine = false + + # Save the residuals and the sigma scaling corrections if needed. + call smark (sp) + call salloc (resid, nimages+1, TY_REAL) + if (doscale1) + call salloc (w, nimages, TY_REAL) + + # Do sigma clipping. + nin = n[1] + do i = 1, npts { + k = i - 1 + n1 = n[i] + if (nkeep < 0) + maxkeep = max (0, n1 + nkeep) + else + maxkeep = min (n1, nkeep) + + # If there are not enough pixels simply compute the average. + if (n1 < max (3, maxkeep)) { + if (!docombine) { + if (n1 == 0) + average[i] = blank + else { + sum = Mem$t[d[1]+k] + do j = 2, n1 + sum = sum + Mem$t[d[j]+k] + average[i] = sum / n1 + } + } + next + } + + # Compute average with the high and low rejected. + low = Mem$t[d[1]+k] + high = Mem$t[d[2]+k] + if (low > high) { + d1 = low + low = high + high = d1 + } + sum = 0. + do j = 3, n1 { + d1 = Mem$t[d[j]+k] + if (d1 < low) { + sum = sum + low + low = d1 + } else if (d1 > high) { + sum = sum + high + high = d1 + } else + sum = sum + d1 + } + a = sum / (n1 - 2) + sum = sum + low + high + + # Iteratively reject pixels and compute the final average if needed. + # Compact the data and keep track of the image IDs if needed. + + repeat { + n2 = n1 + if (doscale1) { + # Compute sigma corrected for scaling. + s = 0. + wp = w - 1 + do j = 1, n1 { + dp1 = d[j] + k + mp1 = m[j] + k + wp = wp + 1 + + d1 = Mem$t[dp1] + l = Memi[mp1] + r = sqrt (max (one, (a + zeros[l]) / scales[l])) + s = s + ((d1 - a) / r) ** 2 + Memr[wp] = r + } + s = sqrt (s / (n1 - 1)) + + # Reject pixels. Save the residuals and data values. + wp = w - 1 + if (s > 0.) { + for (j=1; j<=n1; j=j+1) { + dp1 = d[j] + k + mp1 = m[j] + k + wp = wp + 1 + + d1 = Mem$t[dp1] + r = (d1 - a) / (s * Memr[wp]) + if (r < -lsigma || r > hsigma) { + Memr[resid+n1] = abs (r) + if (j < n1) { + dp2 = d[n1] + k + Mem$t[dp1] = Mem$t[dp2] + Mem$t[dp2] = d1 + Memr[wp] = Memr[w+n1-1] + mp2 = m[n1] + k + l = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = l + j = j - 1 + } + sum = sum - d1 + n1 = n1 - 1 + } + } + } + } else { + # Compute the sigma without scale correction. + s = 0. + do j = 1, n1 + s = s + (Mem$t[d[j]+k] - a) ** 2 + s = sqrt (s / (n1 - 1)) + + # Reject pixels. Save the residuals and data values. + if (s > 0.) { + for (j=1; j<=n1; j=j+1) { + dp1 = d[j] + k + d1 = Mem$t[dp1] + r = (d1 - a) / s + if (r < -lsigma || r > hsigma) { + Memr[resid+n1] = abs (r) + if (j < n1) { + dp2 = d[n1] + k + Mem$t[dp1] = Mem$t[dp2] + Mem$t[dp2] = d1 + if (keepids) { + mp1 = m[j] + k + mp2 = m[n1] + k + l = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = l + } + j = j - 1 + } + sum = sum - d1 + n1 = n1 - 1 + } + } + } + } + + # Recompute the average. + if (n1 > 1) + a = sum / n1 + } until (n1 == n2 || n1 <= max (2, maxkeep)) + + # If too many pixels are rejected add some back. + # All pixels with equal residuals are added back. + if (n1 < maxkeep) { + nk = maxkeep + if (doscale1) { + for (j=n1+1; j<=nk; j=j+1) { + dp1 = d[j] + k + mp1 = m[j] + k + r = Memr[resid+j] + jj = 0 + do l = j+1, n2 { + s = Memr[resid+l] + if (s < r + TOL) { + if (s > r - TOL) + jj = jj + 1 + else { + jj = 0 + Memr[resid+l] = r + r = s + dp2 = d[l] + k + d1 = Mem$t[dp1] + Mem$t[dp1] = Mem$t[dp2] + Mem$t[dp2] = d1 + mp2 = m[l] + k + s = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = s + } + } + } + sum = sum + Mem$t[dp1] + n1 = n1 + 1 + nk = max (nk, j+jj) + } + } else { + for (j=n1+1; j<=nk; j=j+1) { + dp1 = d[j] + k + r = Memr[resid+j] + jj = 0 + do l = j+1, n2 { + s = Memr[resid+l] + if (s < r + TOL) { + if (s > r - TOL) + jj = jj + 1 + else { + jj = 0 + Memr[resid+l] = r + r = s + dp2 = d[l] + k + d1 = Mem$t[dp1] + Mem$t[dp1] = Mem$t[dp2] + Mem$t[dp2] = d1 + if (keepids) { + mp1 = m[j] + k + mp2 = m[l] + k + s = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = s + } + } + } + } + sum = sum + Mem$t[dp1] + n1 = n1 + 1 + nk = max (nk, j+jj) + } + } + + # Recompute the average. + if (n1 > 1) + a = sum / n1 + } + + # Save the average if needed. + n[i] = n1 + if (!docombine) { + if (n1 > 0) + average[i] = a + else + average[i] = blank + } + } + + # Check if the data flag has to be reset for rejected pixels + if (dflag == D_ALL) { + do i = 1, npts { + if (n[i] != nin) { + dflag = D_MIX + break + } + } + } + + call sfree (sp) +end + + +# IC_MSIGCLIP -- Reject pixels using sigma clipping about the median + +procedure ic_msigclip$t (d, m, n, scales, zeros, nimages, npts, median) + +pointer d[nimages] # Data pointers +pointer m[nimages] # Image id pointers +int n[npts] # Number of good pixels +real scales[nimages] # Scales +real zeros[nimages] # Zeros +int nimages # Number of images +int npts # Number of output points per line +$if (datatype == sil) +real median[npts] # Median +$else +PIXEL median[npts] # Median +$endif + +int i, j, k, l, id, n1, n2, n3, nl, nh, nin, maxkeep +real r, s +pointer sp, resid, w, mp1, mp2 +$if (datatype == sil) +real med, one +data one /1.0/ +$else +PIXEL med, one +data one /1$f/ +$endif + +include "../icombine.com" + +begin + # If there are insufficient pixels go on to the combining + if (nkeep < 0) + maxkeep = max (0, nimages + nkeep) + else + maxkeep = min (nimages, nkeep) + if (nimages < max (MINCLIP, maxkeep+1) || dflag == D_NONE) { + docombine = true + return + } + + # Save the residuals and sigma scaling corrections if needed. + call smark (sp) + call salloc (resid, nimages+1, TY_REAL) + if (doscale1) + call salloc (w, nimages, TY_REAL) + + # Compute median and sigma and iteratively clip. + nin = n[1] + do i = 1, npts { + k = i - 1 + n1 = n[i] + if (nkeep < 0) + maxkeep = max (0, n1 + nkeep) + else + maxkeep = min (n1, nkeep) + nl = 1 + nh = n1 + + repeat { + n2 = n1 + n3 = nl + n1 / 2 + + if (n1 == 0) + med = blank + else if (mod (n1, 2) == 0) + med = (Mem$t[d[n3-1]+k] + Mem$t[d[n3]+k]) / 2. + else + med = Mem$t[d[n3]+k] + + if (n1 >= max (MINCLIP, maxkeep+1)) { + if (doscale1) { + # Compute the sigma with scaling correction. + s = 0. + do j = nl, nh { + l = Memi[m[j]+k] + r = sqrt (max (one, (med + zeros[l]) / scales[l])) + s = s + ((Mem$t[d[j]+k] - med) / r) ** 2 + Memr[w+j-1] = r + } + s = sqrt (s / (n1 - 1)) + + # Reject pixels and save the residuals. + if (s > 0.) { + for (; nl <= n2; nl = nl + 1) { + r = (med - Mem$t[d[nl]+k]) / (s * Memr[w+nl-1]) + if (r <= lsigma) + break + Memr[resid+nl] = r + n1 = n1 - 1 + } + for (; nh >= nl; nh = nh - 1) { + r = (Mem$t[d[nh]+k] - med) / (s * Memr[w+nh-1]) + if (r <= hsigma) + break + Memr[resid+nh] = r + n1 = n1 - 1 + } + } + } else { + # Compute the sigma without scaling correction. + s = 0. + do j = nl, nh + s = s + (Mem$t[d[j]+k] - med) ** 2 + s = sqrt (s / (n1 - 1)) + + # Reject pixels and save the residuals. + if (s > 0.) { + for (; nl <= n2; nl = nl + 1) { + r = (med - Mem$t[d[nl]+k]) / s + if (r <= lsigma) + break + Memr[resid+nl] = r + n1 = n1 - 1 + } + for (; nh >= nl; nh = nh - 1) { + r = (Mem$t[d[nh]+k] - med) / s + if (r <= hsigma) + break + Memr[resid+nh] = r + n1 = n1 - 1 + } + } + } + } + } until (n1 == n2 || n1 < max (MINCLIP, maxkeep+1)) + + # If too many pixels are rejected add some back. + # All pixels with equal residuals are added back. + while (n1 < maxkeep) { + if (nl == 1) + nh = nh + 1 + else if (nh == n[i]) + nl = nl - 1 + else { + r = Memr[resid+nl-1] + s = Memr[resid+nh+1] + if (r < s) { + nl = nl - 1 + r = r + TOL + if (s <= r) + nh = nh + 1 + if (nl > 1) { + if (Memr[resid+nl-1] <= r) + nl = nl - 1 + } + } else { + nh = nh + 1 + s = s + TOL + if (r <= s) + nl = nl - 1 + if (nh < n2) { + if (Memr[resid+nh+1] <= s) + nh = nh + 1 + } + } + } + n1 = nh - nl + 1 + } + + # Only set median and reorder if needed + n[i] = n1 + if (n1 > 0 && nl > 1 && (combine != MEDIAN || grow > 0)) { + j = max (nl, n1 + 1) + if (keepids) { + do l = 1, min (n1, nl-1) { + Mem$t[d[l]+k] = Mem$t[d[j]+k] + if (grow > 0) { + mp1 = m[l] + k + mp2 = m[j] + k + id = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = id + } else + Memi[m[l]+k] = Memi[m[j]+k] + j = j + 1 + } + } else { + do l = 1, min (n1, nl - 1) { + Mem$t[d[l]+k] = Mem$t[d[j]+k] + j = j + 1 + } + } + } + + if (combine == MEDIAN) + median[i] = med + } + + # Check if data flag needs to be reset for rejected pixels + if (dflag == D_ALL) { + do i = 1, npts { + if (n[i] != nin) { + dflag = D_MIX + break + } + } + } + + # Flag that the median has been computed. + if (combine == MEDIAN) + docombine = false + else + docombine = true + + call sfree (sp) +end +$endfor diff --git a/noao/imred/ccdred/src/icsection.x b/noao/imred/ccdred/src/icsection.x new file mode 100644 index 00000000..746c1f51 --- /dev/null +++ b/noao/imred/ccdred/src/icsection.x @@ -0,0 +1,94 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <ctype.h> + +# IC_SECTION -- Parse an image section into its elements. +# 1. The default values must be set by the caller. +# 2. A null image section is OK. +# 3. The first nonwhitespace character must be '['. +# 4. The last interpreted character must be ']'. +# +# This procedure should be replaced with an IMIO procedure at some +# point. + +procedure ic_section (section, x1, x2, xs, ndim) + +char section[ARB] # Image section +int x1[ndim] # Starting pixel +int x2[ndim] # Ending pixel +int xs[ndim] # Step +int ndim # Number of dimensions + +int i, ip, a, b, c, temp, ctoi() +define error_ 99 + +begin + # Decode the section string. + ip = 1 + while (IS_WHITE(section[ip])) + ip = ip + 1 + if (section[ip] == '[') + ip = ip + 1 + else if (section[ip] == EOS) + return + else + goto error_ + + do i = 1, ndim { + while (IS_WHITE(section[ip])) + ip = ip + 1 + if (section[ip] == ']') + break + + # Default values + a = x1[i] + b = x2[i] + c = xs[i] + + # 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 = temp + if (section[ip] == ':') { + ip = ip + 1 + if (ctoi (section, ip, b) == 0) # a:b + goto error_ + } else + b = a + } else if (section[ip] == '-') { # -* + temp = a + a = b + b = 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) == 0) + goto error_ + else if (c == 0) + goto error_ + } + if (a > b && c > 0) + c = -c + + x1[i] = a + x2[i] = b + xs[i] = c + + while (IS_WHITE(section[ip])) + ip = ip + 1 + if (section[ip] == ',') + ip = ip + 1 + } + + if (section[ip] != ']') + goto error_ + + return +error_ + call error (0, "Error in image section specification") +end diff --git a/noao/imred/ccdred/src/icsetout.x b/noao/imred/ccdred/src/icsetout.x new file mode 100644 index 00000000..bd1d75ec --- /dev/null +++ b/noao/imred/ccdred/src/icsetout.x @@ -0,0 +1,193 @@ +include <imhdr.h> +include <mwset.h> + +# IC_SETOUT -- Set output image size and offsets of input images. + +procedure ic_setout (in, out, offsets, nimages) + +pointer in[nimages] # Input images +pointer out[ARB] # Output images +int offsets[nimages,ARB] # Offsets +int nimages # Number of images + +int i, j, indim, outdim, mwdim, a, b, amin, bmax, fd +real val +bool reloff, streq() +pointer sp, fname, lref, wref, cd, coord, shift, axno, axval +pointer mw, ct, mw_openim(), mw_sctran() +int open(), fscan(), nscan(), mw_stati() +errchk mw_openim, mw_gwtermd, mw_gltermd, mw_gaxmap +errchk mw_sctran, mw_ctrand, open + +include "icombine.com" +define newscan_ 10 + +begin + call smark (sp) + call salloc (fname, SZ_FNAME, TY_CHAR) + call salloc (lref, IM_MAXDIM, TY_DOUBLE) + call salloc (wref, IM_MAXDIM, TY_DOUBLE) + call salloc (cd, IM_MAXDIM*IM_MAXDIM, TY_DOUBLE) + call salloc (coord, IM_MAXDIM, TY_DOUBLE) + call salloc (shift, IM_MAXDIM, TY_REAL) + call salloc (axno, IM_MAXDIM, TY_INT) + call salloc (axval, IM_MAXDIM, TY_INT) + + # Check and set the image dimensionality. + indim = IM_NDIM(in[1]) + outdim = IM_NDIM(out[1]) + if (project) { + outdim = indim - 1 + IM_NDIM(out[1]) = outdim + } else { + do i = 1, nimages + if (IM_NDIM(in[i]) != outdim) { + call sfree (sp) + call error (1, "Image dimensions are not the same") + } + } + + # Set the reference point to that of the first image. + mw = mw_openim (in[1]) + mwdim = mw_stati (mw, MW_NPHYSDIM) + call mw_gwtermd (mw, Memd[lref], Memd[wref], Memd[cd], mwdim) + ct = mw_sctran (mw, "world", "logical", 0) + call mw_ctrand (ct, Memd[wref], Memd[lref], mwdim) + call mw_ctfree (ct) + if (project) + Memd[lref+outdim] = 1 + + # Parse the user offset string. If "none" then there are no offsets. + # If "wcs" then set the offsets based on the image WCS. + # If "grid" then set the offsets based on the input grid parameters. + # If a file scan it. + + call clgstr ("offsets", Memc[fname], SZ_FNAME) + call sscan (Memc[fname]) + call gargwrd (Memc[fname], SZ_FNAME) + if (nscan() == 0 || streq (Memc[fname], "none")) { + call aclri (offsets, outdim*nimages) + reloff = true + } else if (streq (Memc[fname], "wcs")) { + do j = 1, outdim + offsets[1,j] = 0 + if (project) { + ct = mw_sctran (mw, "world", "logical", 0) + do i = 2, nimages { + Memd[wref+outdim] = i + call mw_ctrand (ct, Memd[wref], Memd[coord], indim) + do j = 1, outdim + offsets[i,j] = nint (Memd[lref+j-1] - Memd[coord+j-1]) + } + call mw_ctfree (ct) + call mw_close (mw) + } else { + do i = 2, nimages { + call mw_close (mw) + mw = mw_openim (in[i]) + ct = mw_sctran (mw, "world", "logical", 0) + call mw_ctrand (ct, Memd[wref], Memd[coord], indim) + do j = 1, outdim + offsets[i,j] = nint (Memd[lref+j-1] - Memd[coord+j-1]) + call mw_ctfree (ct) + } + } + reloff = true + } else if (streq (Memc[fname], "grid")) { + amin = 1 + do j = 1, outdim { + call gargi (a) + call gargi (b) + if (nscan() < 1+2*j) + break + do i = 1, nimages + offsets[i,j] = mod ((i-1)/amin, a) * b + amin = amin * a + } + reloff = true + } else { + reloff = true + fd = open (Memc[fname], READ_ONLY, TEXT_FILE) + do i = 1, nimages { +newscan_ if (fscan (fd) == EOF) + call error (1, "IMCOMBINE: Offset list too short") + call gargwrd (Memc[fname], SZ_FNAME) + if (Memc[fname] == '#') { + call gargwrd (Memc[fname], SZ_FNAME) + call strlwr (Memc[fname]) + if (streq (Memc[fname], "absolute")) + reloff = false + else if (streq (Memc[fname], "relative")) + reloff = true + goto newscan_ + } + call reset_scan () + do j = 1, outdim { + call gargr (val) + offsets[i,j] = nint (val) + } + if (nscan() < outdim) + call error (1, "IMCOMBINE: Error in offset list") + } + call close (fd) + } + + # Set the output image size and the aligned flag + aligned = true + do j = 1, outdim { + a = offsets[1,j] + b = IM_LEN(in[1],j) + a + amin = a + bmax = b + do i = 2, nimages { + a = offsets[i,j] + b = IM_LEN(in[i],j) + a + if (a != amin || b != bmax || !reloff) + aligned = false + amin = min (a, amin) + bmax = max (b, bmax) + } + IM_LEN(out[1],j) = bmax + if (reloff || amin < 0) { + do i = 1, nimages + offsets[i,j] = offsets[i,j] - amin + IM_LEN(out[1],j) = IM_LEN(out[1],j) - amin + } + } + + # Update the WCS. + if (project || !aligned || !reloff) { + call mw_close (mw) + mw = mw_openim (out[1]) + mwdim = mw_stati (mw, MW_NPHYSDIM) + call mw_gaxmap (mw, Memi[axno], Memi[axval], mwdim) + if (!aligned || !reloff) { + call mw_gltermd (mw, Memd[cd], Memd[lref], mwdim) + do i = 1, mwdim { + j = Memi[axno+i-1] + if (j > 0 && j <= indim) + Memd[lref+i-1] = Memd[lref+i-1] + offsets[1,j] + } + call mw_sltermd (mw, Memd[cd], Memd[lref], mwdim) + } + if (project) { + # Apply dimensional reduction. + do i = 1, mwdim { + j = Memi[axno+i-1] + if (j <= outdim) + next + else if (j > outdim+1) + Memi[axno+i-1] = j - 1 + else { + Memi[axno+i-1] = 0 + Memi[axval+i-1] = 0 + } + } + call mw_saxmap (mw, Memi[axno], Memi[axval], mwdim) + } + call mw_saveim (mw, out) + } + call mw_close (mw) + + call sfree (sp) +end diff --git a/noao/imred/ccdred/src/icsigma.gx b/noao/imred/ccdred/src/icsigma.gx new file mode 100644 index 00000000..d0ae28d4 --- /dev/null +++ b/noao/imred/ccdred/src/icsigma.gx @@ -0,0 +1,115 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> +include "../icombine.h" + +$for (sr) +# IC_SIGMA -- Compute the sigma image line. +# The estimated sigma includes a correction for the finite population. +# Weights are used if desired. + +procedure ic_sigma$t (d, m, n, wts, npts, average, sigma) + +pointer d[ARB] # Data pointers +pointer m[ARB] # Image ID pointers +int n[npts] # Number of points +real wts[ARB] # Weights +int npts # Number of output points per line +$if (datatype == sil) +real average[npts] # Average +real sigma[npts] # Sigma line (returned) +$else +PIXEL average[npts] # Average +PIXEL sigma[npts] # Sigma line (returned) +$endif + +int i, j, k, n1 +real wt, sigcor, sumwt +$if (datatype == sil) +real a, sum +$else +PIXEL a, sum +$endif + +include "../icombine.com" + +begin + if (dflag == D_ALL) { + n1 = n[1] + if (dowts) { + if (n1 > 1) + sigcor = real (n1) / real (n1 - 1) + else + sigcor = 1. + do i = 1, npts { + k = i - 1 + a = average[i] + wt = wts[Memi[m[1]+k]] + sum = (Mem$t[d[1]+k] - a) ** 2 * wt + do j = 2, n1 { + wt = wts[Memi[m[j]+k]] + sum = sum + (Mem$t[d[j]+k] - a) ** 2 * wt + } + sigma[i] = sqrt (sum * sigcor) + } + } else { + if (n1 > 1) + sigcor = 1. / real (n1 - 1) + else + sigcor = 1. + do i = 1, npts { + k = i - 1 + a = average[i] + sum = (Mem$t[d[1]+k] - a) ** 2 + do j = 2, n1 + sum = sum + (Mem$t[d[j]+k] - a) ** 2 + sigma[i] = sqrt (sum * sigcor) + } + } + } else if (dflag == D_NONE) { + do i = 1, npts + sigma[i] = blank + } else { + if (dowts) { + do i = 1, npts { + n1 = n[i] + if (n1 > 0) { + k = i - 1 + if (n1 > 1) + sigcor = real (n1) / real (n1 -1) + else + sigcor = 1 + a = average[i] + wt = wts[Memi[m[1]+k]] + sum = (Mem$t[d[1]+k] - a) ** 2 * wt + sumwt = wt + do j = 2, n1 { + wt = wts[Memi[m[j]+k]] + sum = sum + (Mem$t[d[j]+k] - a) ** 2 * wt + sumwt = sumwt + wt + } + sigma[i] = sqrt (sum / sumwt * sigcor) + } else + sigma[i] = blank + } + } else { + do i = 1, npts { + n1 = n[i] + if (n1 > 0) { + k = i - 1 + if (n1 > 1) + sigcor = 1. / real (n1 - 1) + else + sigcor = 1. + a = average[i] + sum = (Mem$t[d[1]+k] - a) ** 2 + do j = 2, n1 + sum = sum + (Mem$t[d[j]+k] - a) ** 2 + sigma[i] = sqrt (sum * sigcor) + } else + sigma[i] = blank + } + } + } +end +$endfor diff --git a/noao/imred/ccdred/src/icsort.gx b/noao/imred/ccdred/src/icsort.gx new file mode 100644 index 00000000..2235dbd0 --- /dev/null +++ b/noao/imred/ccdred/src/icsort.gx @@ -0,0 +1,386 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +define LOGPTR 32 # log2(maxpts) (4e9) + +$for (sr) +# IC_SORT -- Quicksort. This is based on the VOPS asrt except that +# the input is an array of pointers to image lines and the sort is done +# across the image lines at each point along the lines. The number of +# valid pixels at each point is allowed to vary. The cases of 1, 2, and 3 +# pixels per point are treated specially. + +procedure ic_sort$t (a, b, nvecs, npts) + +pointer a[ARB] # pointer to input vectors +PIXEL b[ARB] # work array +int nvecs[npts] # number of vectors +int npts # number of points in vectors + +PIXEL pivot, temp, temp3 +int i, j, k, l, p, npix, lv[LOGPTR], uv[LOGPTR] +define swap {temp=$1;$1=$2;$2=temp} +define copy_ 10 + +begin + do l = 0, npts-1 { + npix = nvecs[l+1] + if (npix <= 1) + next + + do i = 1, npix + b[i] = Mem$t[a[i]+l] + + # Special cases + $if (datatype == x) + if (npix <= 3) { + pivot = b[1] + temp = b[2] + if (npix == 2) { + if (abs (temp) < abs (pivot)) { + b[1] = temp + b[2] = pivot + } else + next + } else { + temp3 = b[3] + if (abs (temp) < abs (pivot)) { # bac|bca|cba + if (abs (temp) < abs (temp3)) { # bac|bca + b[1] = temp + if (abs (pivot) < abs (temp3)) # bac + b[2] = pivot + else { # bca + b[2] = temp3 + b[3] = pivot + } + } else { # cba + b[1] = temp3 + b[3] = pivot + } + } else if (abs (temp3) < abs (temp)) { # acb|cab + b[3] = temp + if (abs (pivot) < abs (temp3)) # acb + b[2] = temp3 + else { # cab + b[1] = temp3 + b[2] = pivot + } + } else + next + } + goto copy_ + } + $else + if (npix <= 3) { + pivot = b[1] + temp = b[2] + if (npix == 2) { + if (temp < pivot) { + b[1] = temp + b[2] = pivot + } else + next + } else { + temp3 = b[3] + if (temp < pivot) { # bac|bca|cba + if (temp < temp3) { # bac|bca + b[1] = temp + if (pivot < temp3) # bac + b[2] = pivot + else { # bca + b[2] = temp3 + b[3] = pivot + } + } else { # cba + b[1] = temp3 + b[3] = pivot + } + } else if (temp3 < temp) { # acb|cab + b[3] = temp + if (pivot < temp3) # acb + b[2] = temp3 + else { # cab + b[1] = temp3 + b[2] = pivot + } + } else + next + } + goto copy_ + } + $endif + + # General case + do i = 1, npix + b[i] = Mem$t[a[i]+l] + + lv[1] = 1 + uv[1] = npix + p = 1 + + while (p > 0) { + if (lv[p] >= uv[p]) # only one elem in this subset + p = p - 1 # pop stack + else { + # Dummy do loop to trigger the Fortran optimizer. + do p = p, ARB { + i = lv[p] - 1 + j = uv[p] + + # Select as the pivot the element at the center of the + # array, to avoid quadratic behavior on an already + # sorted array. + + k = (lv[p] + uv[p]) / 2 + swap (b[j], b[k]) + pivot = b[j] # pivot line + + while (i < j) { + $if (datatype == x) + for (i=i+1; abs(b[i]) < abs(pivot); i=i+1) + $else + for (i=i+1; b[i] < pivot; i=i+1) + $endif + ; + for (j=j-1; j > i; j=j-1) + $if (datatype == x) + if (abs(b[j]) <= abs(pivot)) + $else + if (b[j] <= pivot) + $endif + break + if (i < j) # out of order pair + swap (b[i], b[j]) # interchange elements + } + + j = uv[p] # move pivot to position i + swap (b[i], b[j]) # interchange elements + + 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 + } + + break + } + p = p + 1 # push onto stack + } + } + +copy_ + do i = 1, npix + Mem$t[a[i]+l] = b[i] + } +end + + +# IC_2SORT -- Quicksort. This is based on the VOPS asrt except that +# the input is an array of pointers to image lines and the sort is done +# across the image lines at each point along the lines. The number of +# valid pixels at each point is allowed to vary. The cases of 1, 2, and 3 +# pixels per point are treated specially. A second integer set of +# vectors is sorted. + +procedure ic_2sort$t (a, b, c, d, nvecs, npts) + +pointer a[ARB] # pointer to input vectors +PIXEL b[ARB] # work array +pointer c[ARB] # pointer to associated integer vectors +int d[ARB] # work array +int nvecs[npts] # number of vectors +int npts # number of points in vectors + +PIXEL pivot, temp, temp3 +int i, j, k, l, p, npix, lv[LOGPTR], uv[LOGPTR], itemp +define swap {temp=$1;$1=$2;$2=temp} +define iswap {itemp=$1;$1=$2;$2=itemp} +define copy_ 10 + +begin + do l = 0, npts-1 { + npix = nvecs[l+1] + if (npix <= 1) + next + + do i = 1, npix { + b[i] = Mem$t[a[i]+l] + d[i] = Memi[c[i]+l] + } + + # Special cases + $if (datatype == x) + if (npix <= 3) { + pivot = b[1] + temp = b[2] + if (npix == 2) { + if (abs (temp) < abs (pivot)) { + b[1] = temp + b[2] = pivot + iswap (d[1], d[2]) + } else + next + } else { + temp3 = b[3] + if (abs (temp) < abs (pivot)) { # bac|bca|cba + if (abs (temp) < abs (temp3)) { # bac|bca + b[1] = temp + if (abs (pivot) < abs (temp3)) { # bac + b[2] = pivot + iswap (d[1], d[2]) + } else { # bca + b[2] = temp3 + b[3] = pivot + itemp = d[2] + d[2] = d[3] + d[3] = d[1] + d[1] = itemp + } + } else { # cba + b[1] = temp3 + b[3] = pivot + iswap (d[1], d[3]) + } + } else if (abs (temp3) < abs (temp)) { # acb|cab + b[3] = temp + if (abs (pivot) < abs (temp3)) { # acb + b[2] = temp3 + iswap (d[2], d[3]) + } else { # cab + b[1] = temp3 + b[2] = pivot + itemp = d[2] + d[2] = d[1] + d[1] = d[3] + d[3] = itemp + } + } else + next + } + goto copy_ + } + $else + if (npix <= 3) { + pivot = b[1] + temp = b[2] + if (npix == 2) { + if (temp < pivot) { + b[1] = temp + b[2] = pivot + iswap (d[1], d[2]) + } else + next + } else { + temp3 = b[3] + if (temp < pivot) { # bac|bca|cba + if (temp < temp3) { # bac|bca + b[1] = temp + if (pivot < temp3) { # bac + b[2] = pivot + iswap (d[1], d[2]) + } else { # bca + b[2] = temp3 + b[3] = pivot + itemp = d[2] + d[2] = d[3] + d[3] = d[1] + d[1] = itemp + } + } else { # cba + b[1] = temp3 + b[3] = pivot + iswap (d[1], d[3]) + } + } else if (temp3 < temp) { # acb|cab + b[3] = temp + if (pivot < temp3) { # acb + b[2] = temp3 + iswap (d[2], d[3]) + } else { # cab + b[1] = temp3 + b[2] = pivot + itemp = d[2] + d[2] = d[1] + d[1] = d[3] + d[3] = itemp + } + } else + next + } + goto copy_ + } + $endif + + # General case + lv[1] = 1 + uv[1] = npix + p = 1 + + while (p > 0) { + if (lv[p] >= uv[p]) # only one elem in this subset + p = p - 1 # pop stack + else { + # Dummy do loop to trigger the Fortran optimizer. + do p = p, ARB { + i = lv[p] - 1 + j = uv[p] + + # Select as the pivot the element at the center of the + # array, to avoid quadratic behavior on an already + # sorted array. + + k = (lv[p] + uv[p]) / 2 + swap (b[j], b[k]); swap (d[j], d[k]) + pivot = b[j] # pivot line + + while (i < j) { + $if (datatype == x) + for (i=i+1; abs(b[i]) < abs(pivot); i=i+1) + $else + for (i=i+1; b[i] < pivot; i=i+1) + $endif + ; + for (j=j-1; j > i; j=j-1) + $if (datatype == x) + if (abs(b[j]) <= abs(pivot)) + $else + if (b[j] <= pivot) + $endif + break + if (i < j) { # out of order pair + swap (b[i], b[j]) # interchange elements + swap (d[i], d[j]) + } + } + + j = uv[p] # move pivot to position i + swap (b[i], b[j]) # interchange elements + swap (d[i], d[j]) + + 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 + } + + break + } + p = p + 1 # push onto stack + } + } + +copy_ + do i = 1, npix { + Mem$t[a[i]+l] = b[i] + Memi[c[i]+l] = d[i] + } + } +end +$endfor diff --git a/noao/imred/ccdred/src/icstat.gx b/noao/imred/ccdred/src/icstat.gx new file mode 100644 index 00000000..099ddf5e --- /dev/null +++ b/noao/imred/ccdred/src/icstat.gx @@ -0,0 +1,237 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> +include "../icombine.h" + +define NMAX 10000 # Maximum number of pixels to sample + +$for (sr) +# IC_STAT -- Compute image statistics within specified section. +# The image section is relative to a reference image which may be +# different than the input image and may have an offset. Only a +# subsample of pixels is used. Masked and thresholded pixels are +# ignored. Only the desired statistics are computed to increase +# efficiency. + +procedure ic_stat$t (im, imref, section, offsets, image, nimages, + domode, domedian, domean, mode, median, mean) + +pointer im # Data image +pointer imref # Reference image for image section +char section[ARB] # Image section +int offsets[nimages,ARB] # Image section offset from data to reference +int image # Image index (for mask I/O) +int nimages # Number of images in offsets. +bool domode, domedian, domean # Statistics to compute +real mode, median, mean # Statistics + +int i, j, ndim, n, nv +real a +pointer sp, v1, v2, dv, va, vb +pointer data, mask, dp, lp, mp, imgnl$t() +PIXEL ic_mode$t() +$if (datatype == irs) +real asum$t() +$endif +$if (datatype == dl) +double asum$t() +$endif +$if (datatype == x) +complex asum$t() +$endif + + +include "../icombine.com" + +begin + call smark (sp) + call salloc (v1, IM_MAXDIM, TY_LONG) + call salloc (v2, IM_MAXDIM, TY_LONG) + call salloc (dv, IM_MAXDIM, TY_LONG) + call salloc (va, IM_MAXDIM, TY_LONG) + call salloc (vb, IM_MAXDIM, TY_LONG) + + # Determine the image section parameters. This must be in terms of + # the data image pixel coordinates though the section may be specified + # in terms of the reference image coordinates. Limit the number of + # pixels in each dimension to a maximum. + + ndim = IM_NDIM(im) + if (project) + ndim = ndim - 1 + call amovki (1, Memi[v1], IM_MAXDIM) + call amovki (1, Memi[va], IM_MAXDIM) + call amovki (1, Memi[dv], IM_MAXDIM) + call amovi (IM_LEN(imref,1), Memi[vb], ndim) + call ic_section (section, Memi[va], Memi[vb], Memi[dv], ndim) + if (im != imref) + do i = 1, ndim { + Memi[va+i-1] = Memi[va+i-1] - offsets[image,i] + Memi[vb+i-1] = Memi[vb+i-1] - offsets[image,i] + } + + do j = 1, 10 { + n = 1 + do i = 0, ndim-1 { + Memi[v1+i] = max (1, min (Memi[va+i], Memi[vb+i])) + Memi[v2+i] = min (IM_LEN(im,i+1), max (Memi[va+i], Memi[vb+i])) + Memi[dv+i] = j + nv = max (1, (Memi[v2+i] - Memi[v1+i]) / Memi[dv+i] + 1) + Memi[v2+i] = Memi[v1+i] + (nv - 1) * Memi[dv+i] + n = n * nv + } + if (n < NMAX) + break + } + + call amovl (Memi[v1], Memi[va], IM_MAXDIM) + Memi[va] = 1 + if (project) + Memi[va+ndim] = image + call amovl (Memi[va], Memi[vb], IM_MAXDIM) + + # Accumulate the pixel values within the section. Masked pixels and + # thresholded pixels are ignored. + + call salloc (data, n, TY_PIXEL) + dp = data + while (imgnl$t (im, lp, Memi[vb]) != EOF) { + call ic_mget1 (im, image, offsets[image,1], Memi[va], mask) + lp = lp + Memi[v1] - 1 + if (dflag == D_ALL) { + if (dothresh) { + do i = Memi[v1], Memi[v2], Memi[dv] { + a = Mem$t[lp] + if (a >= lthresh && a <= hthresh) { + Mem$t[dp] = a + dp = dp + 1 + } + lp = lp + Memi[dv] + } + } else { + do i = Memi[v1], Memi[v2], Memi[dv] { + Mem$t[dp] = Mem$t[lp] + dp = dp + 1 + lp = lp + Memi[dv] + } + } + } else if (dflag == D_MIX) { + mp = mask + Memi[v1] - 1 + if (dothresh) { + do i = Memi[v1], Memi[v2], Memi[dv] { + if (Memi[mp] == 0) { + a = Mem$t[lp] + if (a >= lthresh && a <= hthresh) { + Mem$t[dp] = a + dp = dp + 1 + } + } + mp = mp + Memi[dv] + lp = lp + Memi[dv] + } + } else { + do i = Memi[v1], Memi[v2], Memi[dv] { + if (Memi[mp] == 0) { + Mem$t[dp] = Mem$t[lp] + dp = dp + 1 + } + mp = mp + Memi[dv] + lp = lp + Memi[dv] + } + } + } + for (i=2; i<=ndim; i=i+1) { + Memi[va+i-1] = Memi[va+i-1] + Memi[dv+i-1] + if (Memi[va+i-1] <= Memi[v2+i-1]) + break + Memi[va+i-1] = Memi[v1+i-1] + } + if (i > ndim) + break + call amovl (Memi[va], Memi[vb], IM_MAXDIM) + } + + n = dp - data + if (n < 1) { + call sfree (sp) + call error (1, "Image section contains no pixels") + } + + # Compute only statistics needed. + if (domode || domedian) { + call asrt$t (Mem$t[data], Mem$t[data], n) + mode = ic_mode$t (Mem$t[data], n) + median = Mem$t[data+n/2-1] + } + if (domean) + mean = asum$t (Mem$t[data], n) / n + + call sfree (sp) +end + + +define NMIN 10 # Minimum number of pixels for mode calculation +define ZRANGE 0.8 # Fraction of pixels about median to use +define ZSTEP 0.01 # Step size for search for mode +define ZBIN 0.1 # Bin size for mode. + +# IC_MODE -- Compute mode of an array. The mode is found by binning +# with a bin size based on the data range over a fraction of the +# pixels about the median and a bin step which may be smaller than the +# bin size. If there are too few points the median is returned. +# The input array must be sorted. + +PIXEL procedure ic_mode$t (a, n) + +PIXEL a[n] # Data array +int n # Number of points + +int i, j, k, nmax +real z1, z2, zstep, zbin +PIXEL mode +bool fp_equalr() + +begin + if (n < NMIN) + return (a[n/2]) + + # Compute the mode. The array must be sorted. Consider a + # range of values about the median point. Use a bin size which + # is ZBIN of the range. Step the bin limits in ZSTEP fraction of + # the bin size. + + i = 1 + n * (1. - ZRANGE) / 2. + j = 1 + n * (1. + ZRANGE) / 2. + z1 = a[i] + z2 = a[j] + if (fp_equalr (z1, z2)) { + mode = z1 + return (mode) + } + + zstep = ZSTEP * (z2 - z1) + zbin = ZBIN * (z2 - z1) + $if (datatype == sil) + zstep = max (1., zstep) + zbin = max (1., zbin) + $endif + + z1 = z1 - zstep + k = i + nmax = 0 + repeat { + z1 = z1 + zstep + z2 = z1 + zbin + for (; i < j && a[i] < z1; i=i+1) + ; + for (; k < j && a[k] < z2; k=k+1) + ; + if (k - i > nmax) { + nmax = k - i + mode = a[(i+k)/2] + } + } until (k >= j) + + return (mode) +end +$endfor diff --git a/noao/imred/ccdred/src/mkpkg b/noao/imred/ccdred/src/mkpkg new file mode 100644 index 00000000..d2d46598 --- /dev/null +++ b/noao/imred/ccdred/src/mkpkg @@ -0,0 +1,75 @@ +# Make CCDRED Package. + +$checkout libpkg.a .. +$update libpkg.a +$checkin libpkg.a .. +$exit + +generic: + $set GEN = "$$generic -k" + + $ifolder (generic/ccdred.h, ccdred.h) + $copy ccdred.h generic/ccdred.h $endif + $ifolder (generic/proc.x, proc.gx) + $(GEN) proc.gx -o generic/proc.x $endif + $ifolder (generic/cor.x, cor.gx) + $(GEN) cor.gx -o generic/cor.x $endif + ; + +libpkg.a: + $ifeq (USE_GENERIC, yes) $call generic $endif + @generic + + @combine + + calimage.x ccdtypes.h <error.h> <imset.h> + ccdcache.x ccdcache.com ccdcache.h ccdcache.com <imhdr.h>\ + <imset.h> <mach.h> + ccdcheck.x ccdtypes.h <imhdr.h> + ccdcmp.x + ccdcopy.x <imhdr.h> + ccddelete.x + ccdflag.x + ccdlog.x <imhdr.h> <imset.h> + ccdmean.x <imhdr.h> + ccdnscan.x ccdtypes.h + ccdproc.x ccdred.h ccdtypes.h <error.h> + ccdsection.x <ctype.h> + ccdsubsets.x <ctype.h> + ccdtypes.x ccdtypes.h + doproc.x ccdred.h + hdrmap.x hdrmap.com <error.h> <syserr.h> + readcor.x <imhdr.h> + scancor.x <imhdr.h> <imset.h> + setdark.x ccdred.h ccdtypes.h <imhdr.h> + setfixpix.x ccdred.h <imhdr.h> <imset.h> <pmset.h> + setflat.x ccdred.h ccdtypes.h <imhdr.h> + setfringe.x ccdred.h ccdtypes.h <imhdr.h> + setheader.x ccdred.h <imhdr.h> + setillum.x ccdred.h ccdtypes.h <imhdr.h> + setinput.x ccdtypes.h <error.h> + setinteract.x <pkg/xtanswer.h> + setoutput.x <imhdr.h> <imset.h> + setoverscan.x ccdred.h <imhdr.h> <imset.h> <pkg/xtanswer.h>\ + <pkg/gtools.h> + setproc.x ccdred.h <imhdr.h> + setsections.x ccdred.h <imhdr.h> <mwset.h> + settrim.x ccdred.h <imhdr.h> <imset.h> + setzero.x ccdred.h ccdtypes.h <imhdr.h> + t_badpixim.x <imhdr.h> + t_ccdgroups.x <error.h> <math.h> + t_ccdhedit.x <error.h> + t_ccdinst.x ccdtypes.h <error.h> <imhdr.h> <imio.h> + t_ccdlist.x ccdtypes.h <error.h> <imhdr.h> + t_ccdmask.x <imhdr.h> + t_ccdproc.x ccdred.h ccdtypes.h <error.h> <imhdr.h> + t_combine.x ccdred.h combine/icombine.com combine/icombine.h\ + <error.h> <imhdr.h> <mach.h> <syserr.h> + t_mkfringe.x ccdred.h <imhdr.h> + t_mkillumcor.x ccdred.h + t_mkillumft.x ccdred.h <imhdr.h> + t_mkskycor.x ccdred.h <mach.h> <imhdr.h> <imset.h> + t_mkskyflat.x ccdred.h ccdtypes.h <imhdr.h> + t_skyreplace.x <imhdr.h> + timelog.x <time.h> + ; diff --git a/noao/imred/ccdred/src/proc.gx b/noao/imred/ccdred/src/proc.gx new file mode 100644 index 00000000..3161d2e6 --- /dev/null +++ b/noao/imred/ccdred/src/proc.gx @@ -0,0 +1,408 @@ +include <imhdr.h> +include "ccdred.h" + + +.help proc Feb87 noao.imred.ccdred +.nf ---------------------------------------------------------------------------- +proc -- Process CCD images + +These are the main CCD reduction procedures. There is one for each +readout axis (lines or columns) and one for short and real image data. +They apply corrections for bad pixels, overscan levels, zero levels, +dark counts, flat field response, illumination response, and fringe +effects. The image is also trimmed if it was mapped with an image +section. The mean value for the output image is computed when the flat +field or illumination image is processed to form the scale factor for +these calibrations in order to avoid reading through these image a +second time. + +The processing information and parameters are specified in the CCD +structure. The processing operations to be performed are specified by +the correction array CORS in the ccd structure. There is one array +element for each operation with indices defined symbolically by macro +definitions (see ccdred.h); i.e. FLATCOR. The value of the array +element is an integer bit field in which the bit set is the same as the +array index; i.e element 3 will have the third bit set for an operation +with array value 2**(3-1)=4. If an operation is not to be performed +the bit is not set and the array element has the numeric value zero. +Note that the addition of several correction elements gives a unique +bit field describing a combination of operations. For efficiency the +most common combinations are implemented as separate units. + +The CCD structure also contains the correction or calibration data +consisting either pointers to data, IMIO pointers for the calibration +images, and scale factors. + +The processing is performed line-by-line. The procedure CORINPUT is +called to get an input line. This procedure trims and fixes bad pixels by +interpolation. The output line and lines from the various calibration +images are read. The image vectors as well as the overscan vector and +the scale factors are passed to the procedure COR (which also +dereferences the pointer data into simple arrays and variables). That +procedure does the actual corrections apart from bad pixel +corrections. + +The final optional step is to add each corrected output line to form a +mean. This adds efficiency since the operation is done only if desired +and the output image data is already in memory so there is no I/O +penalty. + +SEE ALSO + ccdred.h, cor, fixpix, setfixpix, setoverscan, settrim, + setzero, setdark, setflat, setillum, setfringe +.endhelp ---------------------------------------------------------------------- + + +$for (sr) +# PROC1 -- Process CCD images with readout axis 1 (lines). + +procedure proc1$t (ccd) + +pointer ccd # CCD structure + +int line, ncols, nlines, findmean, rep +int overscan_type, overscan_c1, noverscan +real overscan, darkscale, flatscale, illumscale, frgscale, mean +PIXEL minrep +pointer in, out, zeroim, darkim, flatim, illumim, fringeim, overscan_vec +pointer inbuf, outbuf, zerobuf, darkbuf, flatbuf, illumbuf, fringebuf + +$if (datatype == csir) +real asum$t() +$else $if (datatype == ld) +double asum$t() +$else +PIXEL asum$t() +$endif $endif +real find_overscan$t() +pointer imgl2$t(), impl2$t(), ccd_gl$t(), xt_fps$t() + +begin + # Initialize. If the correction image is 1D then just get the + # data once. + + in = IN_IM(ccd) + out = OUT_IM(ccd) + ncols = OUT_C2(ccd) - OUT_C1(ccd) + 1 + nlines = OUT_L2(ccd) - OUT_L1(ccd) + 1 + + findmean = CORS(ccd, FINDMEAN) + if (findmean == YES) + mean = 0. + rep = CORS(ccd, MINREP) + if (rep == YES) + minrep = MINREPLACE(ccd) + + if (CORS(ccd, OVERSCAN) == 0) + overscan_type = 0 + else { + overscan_type = OVERSCAN_TYPE(ccd) + overscan_vec = OVERSCAN_VEC(ccd) + overscan_c1 = BIAS_C1(ccd) - 1 + noverscan = BIAS_C2(ccd) - overscan_c1 + } + + if (CORS(ccd, ZEROCOR) == 0) { + zeroim = NULL + zerobuf = 1 + } else if (IM_LEN(ZERO_IM(ccd),2) == 1) { + zeroim = NULL + zerobuf = ccd_gl$t (ZERO_IM(ccd), ZERO_C1(ccd), ZERO_C2(ccd), 1) + } else + zeroim = ZERO_IM(ccd) + + if (CORS(ccd, DARKCOR) == 0) { + darkim = NULL + darkbuf = 1 + } else if (IM_LEN(DARK_IM(ccd),2) == 1) { + darkim = NULL + darkbuf = ccd_gl$t (DARK_IM(ccd), DARK_C1(ccd), DARK_C2(ccd), 1) + darkscale = FLATSCALE(ccd) + } else { + darkim = DARK_IM(ccd) + darkscale = DARKSCALE(ccd) + } + + if (CORS(ccd, FLATCOR) == 0) { + flatim = NULL + flatbuf = 1 + } else if (IM_LEN(FLAT_IM(ccd),2) == 1) { + flatim = NULL + flatbuf = ccd_gl$t (FLAT_IM(ccd), FLAT_C1(ccd), FLAT_C2(ccd), 1) + flatscale = FLATSCALE(ccd) + } else { + flatim = FLAT_IM(ccd) + flatscale = FLATSCALE(ccd) + } + + if (CORS(ccd, ILLUMCOR) == 0) { + illumim = NULL + illumbuf = 1 + } else { + illumim = ILLUM_IM(ccd) + illumscale = ILLUMSCALE(ccd) + } + + if (CORS(ccd, FRINGECOR) == 0) { + fringeim = NULL + fringebuf = 1 + } else { + fringeim = FRINGE_IM(ccd) + frgscale = FRINGESCALE(ccd) + } + + # For each line read lines from the input. Procedure XT_FPS replaces + # bad pixels by interpolation. The trimmed region is copied to the + # output. Get lines from the output image and from the zero level, + # dark count, flat field, illumination, and fringe images. Call COR1 + # to do the actual pixel corrections. Finally, add the output pixels + # to a sum for computing the mean. We must copy data outside of the + # output data section. + + do line = 2 - OUT_L1(ccd), 0 + call amov$t ( + Mem$t[imgl2$t(in,IN_L1(ccd)+line-1)+IN_C1(ccd)-OUT_C1(ccd)], + Mem$t[impl2$t(out,OUT_L1(ccd)+line-1)], IM_LEN(out,1)) + + do line = 1, nlines { + outbuf = impl2$t (out, OUT_L1(ccd)+line-1) + + inbuf = xt_fps$t (MASK_FP(ccd), in, IN_L1(ccd)+line-1, IN_C1(ccd), + IN_C2(ccd), IN_L1(ccd), IN_L2(ccd), NULL) + call amov$t (Mem$t[inbuf+IN_C1(ccd)-OUT_C1(ccd)], Mem$t[outbuf], + IM_LEN(out,1)) + + outbuf = outbuf + OUT_C1(ccd) - 1 + if (overscan_type != 0) { + if (overscan_type < OVERSCAN_FIT) + overscan = find_overscan$t (Mem$t[inbuf+overscan_c1], + noverscan, overscan_type) + else + overscan = Memr[overscan_vec+line-1] + } + if (zeroim != NULL) + zerobuf = ccd_gl$t (zeroim, ZERO_C1(ccd), ZERO_C2(ccd), + ZERO_L1(ccd)+line-1) + if (darkim != NULL) + darkbuf = ccd_gl$t (darkim, DARK_C1(ccd), DARK_C2(ccd), + DARK_L1(ccd)+line-1) + if (flatim != NULL) + flatbuf = ccd_gl$t (flatim, FLAT_C1(ccd), FLAT_C2(ccd), + FLAT_L1(ccd)+line-1) + if (illumim != NULL) + illumbuf = ccd_gl$t (illumim, ILLUM_C1(ccd), ILLUM_C2(ccd), + ILLUM_L1(ccd)+line-1) + if (fringeim != NULL) + fringebuf = ccd_gl$t (fringeim, FRINGE_C1(ccd), FRINGE_C2(ccd), + FRINGE_L1(ccd)+line-1) + + call cor1$t (CORS(ccd,1), Mem$t[outbuf], + overscan, Mem$t[zerobuf], Mem$t[darkbuf], + Mem$t[flatbuf], Mem$t[illumbuf], Mem$t[fringebuf], ncols, + darkscale, flatscale, illumscale, frgscale) + + if (rep == YES) + call amaxk$t (Mem$t[outbuf], minrep, Mem$t[outbuf], ncols) + if (findmean == YES) + mean = mean + asum$t (Mem$t[outbuf], ncols) + } + + do line = nlines+1, IM_LEN(out,2)-OUT_L1(ccd)+1 + call amov$t ( + Mem$t[imgl2$t(in,IN_L1(ccd)+line-1)+IN_C1(ccd)-OUT_C1(ccd)], + Mem$t[impl2$t(out,OUT_L1(ccd)+line-1)], IM_LEN(out,1)) + + # Compute the mean from the sum of the output pixels. + if (findmean == YES) + MEAN(ccd) = mean / ncols / nlines +end + + +# PROC2 -- Process CCD images with readout axis 2 (columns). + +procedure proc2$t (ccd) + +pointer ccd # CCD structure + +int line, ncols, nlines, findmean, rep +real darkscale, flatscale, illumscale, frgscale, mean +PIXEL minrep +pointer in, out, zeroim, darkim, flatim, illumim, fringeim, overscan_vec +pointer inbuf, outbuf, zerobuf, darkbuf, flatbuf, illumbuf, fringebuf + +$if (datatype == csir) +real asum$t() +$else $if (datatype == ld) +double asum$t() +$else +PIXEL asum$t() +$endif $endif +pointer imgl2$t(), impl2$t(), imgs2$t(), ccd_gl$t(), xt_fps$t() + +begin + # Initialize. If the correction image is 1D then just get the + # data once. + + in = IN_IM(ccd) + out = OUT_IM(ccd) + ncols = OUT_C2(ccd) - OUT_C1(ccd) + 1 + nlines = OUT_L2(ccd) - OUT_L1(ccd) + 1 + + findmean = CORS(ccd, FINDMEAN) + if (findmean == YES) + mean = 0. + rep = CORS(ccd, MINREP) + if (rep == YES) + minrep = MINREPLACE(ccd) + + overscan_vec = OVERSCAN_VEC(ccd) + + if (CORS(ccd, ZEROCOR) == 0) { + zeroim = NULL + zerobuf = 1 + } else if (IM_LEN(ZERO_IM(ccd),1) == 1) { + zeroim = NULL + zerobuf = imgs2$t (ZERO_IM(ccd), 1, 1, ZERO_L1(ccd), ZERO_L2(ccd)) + } else + zeroim = ZERO_IM(ccd) + + if (CORS(ccd, DARKCOR) == 0) { + darkim = NULL + darkbuf = 1 + } else if (IM_LEN(DARK_IM(ccd),1) == 1) { + darkim = NULL + darkbuf = imgs2$t (DARK_IM(ccd), 1, 1, DARK_L1(ccd), DARK_L2(ccd)) + darkscale = DARKSCALE(ccd) + } else { + darkim = DARK_IM(ccd) + darkscale = DARKSCALE(ccd) + } + + if (CORS(ccd, FLATCOR) == 0) { + flatim = NULL + flatbuf = 1 + } else if (IM_LEN(FLAT_IM(ccd),1) == 1) { + flatim = NULL + flatbuf = imgs2$t (FLAT_IM(ccd), 1, 1, FLAT_L1(ccd), FLAT_L2(ccd)) + flatscale = FLATSCALE(ccd) + } else { + flatim = FLAT_IM(ccd) + flatscale = FLATSCALE(ccd) + } + + if (CORS(ccd, ILLUMCOR) == 0) { + illumim = NULL + illumbuf = 1 + } else { + illumim = ILLUM_IM(ccd) + illumscale = ILLUMSCALE(ccd) + } + + if (CORS(ccd, FRINGECOR) == 0) { + fringeim = NULL + fringebuf = 1 + } else { + fringeim = FRINGE_IM(ccd) + frgscale = FRINGESCALE(ccd) + } + + # For each line read lines from the input. Procedure CORINPUT + # replaces bad pixels by interpolation and applies a trim to the + # input. Get lines from the output image and from the zero level, + # dark count, flat field, illumination, and fringe images. + # Call COR2 to do the actual pixel corrections. Finally, add the + # output pixels to a sum for computing the mean. + # We must copy data outside of the output data section. + + do line = 2 - OUT_L1(ccd), 0 + call amov$t ( + Mem$t[imgl2$t(in,IN_L1(ccd)+line-1)+IN_C1(ccd)-OUT_C1(ccd)], + Mem$t[impl2$t(out,OUT_L1(ccd)+line-1)], IM_LEN(out,1)) + + do line = 1, nlines { + outbuf = impl2$t (out, OUT_L1(ccd)+line-1) + + inbuf = xt_fps$t (MASK_FP(ccd), in, IN_L1(ccd)+line-1, IN_C1(ccd), + IN_C2(ccd), IN_L1(ccd), IN_L2(ccd), NULL) + call amov$t (Mem$t[inbuf+IN_C1(ccd)-OUT_C1(ccd)], Mem$t[outbuf], + IM_LEN(out,1)) + + outbuf = outbuf + OUT_C1(ccd) - 1 + if (zeroim != NULL) + zerobuf = ccd_gl$t (zeroim, ZERO_C1(ccd), ZERO_C2(ccd), + ZERO_L1(ccd)+line-1) + if (darkim != NULL) + darkbuf = ccd_gl$t (darkim, DARK_C1(ccd), DARK_C2(ccd), + DARK_L1(ccd)+line-1) + if (flatim != NULL) + flatbuf = ccd_gl$t (flatim, FLAT_C1(ccd), FLAT_C2(ccd), + FLAT_L1(ccd)+line-1) + if (illumim != NULL) + illumbuf = ccd_gl$t (illumim, ILLUM_C1(ccd), ILLUM_C2(ccd), + ILLUM_L1(ccd)+line-1) + if (fringeim != NULL) + fringebuf = ccd_gl$t (fringeim, FRINGE_C1(ccd), FRINGE_C2(ccd), + FRINGE_L1(ccd)+line-1) + + call cor2$t (line, CORS(ccd,1), Mem$t[outbuf], + Memr[overscan_vec], Mem$t[zerobuf], Mem$t[darkbuf], + Mem$t[flatbuf], Mem$t[illumbuf], Mem$t[fringebuf], ncols, + zeroim, flatim, darkscale, flatscale, illumscale, frgscale) + + if (rep == YES) + call amaxk$t (Mem$t[outbuf], minrep, Mem$t[outbuf], ncols) + if (findmean == YES) + mean = mean + asum$t (Mem$t[outbuf], ncols) + } + + do line = nlines+1, IM_LEN(out,2)-OUT_L1(ccd)+1 + call amov$t ( + Mem$t[imgl2$t(in,IN_L1(ccd)+line-1)+IN_C1(ccd)-OUT_C1(ccd)], + Mem$t[impl2$t(out,OUT_L1(ccd)+line-1)], IM_LEN(out,1)) + + # Compute the mean from the sum of the output pixels. + if (findmean == YES) + MEAN(ccd) = mean / ncols / nlines +end + + +# FIND_OVERSCAN -- Find the overscan value for a line. +# No check is made on the number of pixels. +# The median is the (npix+1)/2 element. + +real procedure find_overscan$t (data, npix, type) + +PIXEL data[npix] #I Overscan data +int npix #I Number of overscan points +int type #I Type of overscan calculation + +int i +real overscan, d, dmin, dmax +PIXEL asok$t() + +begin + if (type == OVERSCAN_MINMAX) { + overscan = data[1] + dmin = data[1] + dmax = data[1] + do i = 2, npix { + d = data[i] + overscan = overscan + d + if (d < dmin) + dmin = d + else if (d > dmax) + dmax = d + } + overscan = (overscan - dmin - dmax) / (npix - 2) + } else if (type == OVERSCAN_MEDIAN) + overscan = asok$t (data, npix, (npix + 1) / 2) + else { + overscan = data[1] + do i = 2, npix + overscan = overscan + data[i] + overscan = overscan / npix + } + + return (overscan) +end +$endfor diff --git a/noao/imred/ccdred/src/readcor.x b/noao/imred/ccdred/src/readcor.x new file mode 100644 index 00000000..61fbd836 --- /dev/null +++ b/noao/imred/ccdred/src/readcor.x @@ -0,0 +1,138 @@ +include <imhdr.h> + +# READCOR -- Create a readout image. +# Assume it is appropriate to perform this operation on the input image. +# There is no CCD type checking. + +procedure readcor (input) + +char input[ARB] # Input image +int readaxis # Readout axis + +int i, nc, nl, c1, c2, cs, l1, l2, ls +int in_c1, in_c2, in_l1, in_l2, ccd_c1, ccd_c2, ccd_l1, ccd_l2 +pointer sp, output, str, in, out, data + +real asumr() +int clgwrd() +bool clgetb(), ccdflag() +pointer immap(), imgl2r(), impl2r(), imps2r() +errchk immap, ccddelete + +begin + # Check if this operation is desired. + if (!clgetb ("readcor")) + return + + # Check if this operation has been done. Unfortunately this requires + # mapping the image. + + in = immap (input, READ_ONLY, 0) + if (ccdflag (in, "readcor")) { + call imunmap (in) + return + } + + if (clgetb ("noproc")) { + call eprintf ( + " [TO BE DONE] Convert %s to readout correction\n") + call pargstr (input) + call imunmap (in) + return + } + + call smark (sp) + call salloc (output, SZ_FNAME, TY_CHAR) + call salloc (str, SZ_LINE, TY_CHAR) + + # The default data section is the entire image. + nc = IM_LEN(in,1) + nl = IM_LEN(in,2) + c1 = 1 + c2 = nc + cs = 1 + l1 = 1 + l2 = nl + ls = 1 + call hdmgstr (in, "datasec", Memc[str], SZ_LINE) + call ccd_section (Memc[str], c1, c2, cs, l1, l2, ls) + if ((c1<1)||(c2>nc)||(l1<1)||(l2>nl)||(cs!=1)||(ls!=1)) + call error (0, "Error in DATASEC parameter") + in_c1 = c1 + in_c2 = c2 + in_l1 = l1 + in_l2 = l2 + + # The default ccd section is the data section. + call hdmgstr (in, "ccdsec", Memc[str], SZ_LINE) + call ccd_section (Memc[str], c1, c2, cs, l1, l2, ls) + if ((cs != 1) || (ls != 1)) + call error (0, "Error in CCDSEC parameter") + ccd_c1 = c1 + ccd_c2 = c2 + ccd_l1 = l1 + ccd_l2 = l2 + if ((in_c2-in_c1 != ccd_c2-ccd_c1) || (in_l2-in_l1 != ccd_l2-ccd_l1)) + call error (0, "Size of DATASEC and CCDSEC do not agree") + + # Determine the readout axis. + readaxis = clgwrd ("readaxis", Memc[str], SZ_LINE, "|lines|columns|") + + # Create output. + call mktemp ("tmp", Memc[output], SZ_FNAME) + call set_output (in, out, Memc[output]) + + # Average across the readout axis. + switch (readaxis) { + case 1: + IM_LEN(out,2) = 1 + data = impl2r (out, 1) + call aclrr (Memr[data], nc) + nc = in_c2 - in_c1 + 1 + nl = in_l2 - in_l1 + 1 + data = data + in_c1 - 1 + do i = in_l1, in_l2 + call aaddr (Memr[imgl2r(in,i)+in_c1-1], Memr[data], + Memr[data], nc) + call adivkr (Memr[data], real (nl), Memr[data], nc) + call sprintf (Memc[str], SZ_LINE, "[%d:%d,1:1]") + call pargi (in_c1) + call pargi (in_c2) + call hdmpstr (out, "datasec", Memc[str]) + call sprintf (Memc[str], SZ_LINE, "[%d:%d,*]") + call pargi (ccd_c1) + call pargi (ccd_c2) + call hdmpstr (out, "ccdsec", Memc[str]) + case 2: + IM_LEN(out,1) = 1 + data = imps2r (out, 1, 1, 1, nl) + call aclrr (Memr[data], nl) + nc = in_c2 - in_c1 + 1 + nl = in_l2 - in_l1 + 1 + do i = in_l1, in_l2 + Memr[data+i-1] = asumr (Memr[imgl2r(in,i)+in_c1-1], nc) / nc + call sprintf (Memc[str], SZ_LINE, "[1:1,%d:%d]") + call pargi (in_l1) + call pargi (in_l2) + call hdmpstr (out, "datasec", Memc[str]) + call sprintf (Memc[str], SZ_LINE, "[*,%d:%d]") + call pargi (ccd_l1) + call pargi (ccd_l2) + call hdmpstr (out, "ccdsec", Memc[str]) + } + + # Log the operation. + call sprintf (Memc[str], SZ_LINE, + "Converted to readout format") + call timelog (Memc[str], SZ_LINE) + call ccdlog (in, Memc[str]) + call hdmpstr (out, "readcor", Memc[str]) + + # Replace the input image by the output image. + call imunmap (in) + call imunmap (out) + call ccddelete (input) + call imrename (Memc[output], input) + + call sfree (sp) +end diff --git a/noao/imred/ccdred/src/scancor.x b/noao/imred/ccdred/src/scancor.x new file mode 100644 index 00000000..6a5eb84c --- /dev/null +++ b/noao/imred/ccdred/src/scancor.x @@ -0,0 +1,340 @@ +include <imhdr.h> +include <imset.h> + +define SCANTYPES "|shortscan|longscan|" +define SHORTSCAN 1 # Short scan accumulation, normal readout +define LONGSCAN 2 # Long scan continuous readout + +# SCANCOR -- Create a scanned image from an unscanned image. + +procedure scancor (input, output, nscan, minreplace) + +char input[ARB] # Input image +char output[ARB] # Output image (must be new image) +int nscan # Number of scan lines +real minreplace # Minmum value of output + +int scantype # Type of scan format +int readaxis # Readout axis + +int clgwrd() +pointer sp, str, in, out, immap() +errchk immap + +begin + call smark (sp) + call salloc (str, SZ_LINE, TY_CHAR) + + # Determine readout axis and create the temporary output image. + scantype = clgwrd ("scantype", Memc[str], SZ_LINE, SCANTYPES) + readaxis = clgwrd ("readaxis", Memc[str], SZ_LINE, "|lines|columns|") + + # Make the output scanned image. + in = immap (input, READ_ONLY, 0) + call set_output (in, out, output) + + switch (scantype) { + case SHORTSCAN: + call shortscan (in, out, nscan, minreplace, readaxis) + case LONGSCAN: + call longscan (in, out, readaxis) + } + + # Log the operation. + switch (scantype) { + case SHORTSCAN: + call sprintf (Memc[str], SZ_LINE, + "Converted to shortscan from %s with nscan=%d") + call pargstr (input) + call pargi (nscan) + call hdmputi (out, "nscanrow", nscan) + case LONGSCAN: + call sprintf (Memc[str], SZ_LINE, "Converted to longscan from %s") + call pargstr (input) + } + call timelog (Memc[str], SZ_LINE) + call ccdlog (out, Memc[str]) + call hdmpstr (out, "scancor", Memc[str]) + + call imunmap (in) + call imunmap (out) + + call sfree (sp) +end + + +# SHORTSCAN -- Make a shortscan mode image by using a moving average. +# +# NOTE!! The value of nscan used here is increased by 1 because the +# current information in the image header is actually the number of +# scan steps and NOT the number of rows. + +procedure shortscan (in, out, nscan, minreplace, readaxis) + +pointer in # Input image +pointer out # Output image +int nscan # Number of lines scanned before readout +real minreplace # Minimum output value +int readaxis # Readout axis + +bool replace +real nscanr, sum, mean, asumr() +int i, j, k, l, len1, len2, nc, nl, nscani, c1, c2, cs, l1, l2, ls +pointer sp, str, bufs, datain, dataout, data, imgl2r(), impl2r() +long clktime() +errchk malloc, calloc + +begin + call smark (sp) + call salloc (str, SZ_LINE, TY_CHAR) + + # The default data section is the entire image. + len1 = IM_LEN(in,1) + len2 = IM_LEN(in,2) + c1 = 1 + c2 = len1 + cs = 1 + l1 = 1 + l2 = len2 + ls = 1 + call hdmgstr (in, "datasec", Memc[str], SZ_LINE) + call ccd_section (Memc[str], c1, c2, cs, l1, l2, ls) + if ((c1<1)||(c2>len1)||(l1<1)||(l2>len2)||(cs!=1)||(ls!=1)) + call error (0, "Error in DATASEC parameter") + nc = c2 - c1 + 1 + nl = l2 - l1 + 1 + + # Copy initial lines. + do i = 1, l1 - 1 + call amovr (Memr[imgl2r(in,i)], Memr[impl2r(out,i)], len1) + + replace = !IS_INDEF(minreplace) + mean = 0. + switch (readaxis) { + case 1: + nscani = max (1, min (nscan, nl) + 1) + nscanr = nscani + call imseti (in, IM_NBUFS, nscani) + call malloc (bufs, nscani, TY_INT) + call calloc (data, nc, TY_REAL) + j = 1 + k = 1 + l = 1 + + # Ramp up + while (j <= nscani) { + i = j + l1 - 1 + datain = imgl2r (in, i) + if (nc < len1) + call amovr (Memr[datain], Memr[impl2r(out,i)], len1) + datain = datain + c1 - 1 + Memi[bufs+mod(j,nscani)] = datain + call aaddr (Memr[data], Memr[datain], Memr[data], nc) + j = j + 1 + } + dataout = impl2r (out, l+l1-1) + c1 - 1 + call adivkr (Memr[data], nscanr, Memr[dataout], nc) + if (replace) + call amaxkr (Memr[dataout], minreplace, Memr[dataout], nc) + mean = mean + asumr (Memr[dataout], nc) + l = l + 1 + + # Moving average + while (j <= nl) { + datain = Memi[bufs+mod(k,nscani)] + call asubr (Memr[data], Memr[datain], Memr[data], nc) + i = j + l1 - 1 + datain = imgl2r (in, i) + if (nc < len1) + call amovr (Memr[datain], Memr[impl2r(out,i)], len1) + datain = datain + c1 - 1 + Memi[bufs+mod(j,nscani)] = datain + call aaddr (Memr[data], Memr[datain], Memr[data], nc) + dataout = impl2r (out, l+l1-1) + c1 - 1 + call adivkr (Memr[data], nscanr, Memr[dataout], nc) + if (replace) + call amaxkr (Memr[dataout], minreplace, Memr[dataout], nc) + mean = mean + asumr (Memr[dataout], nc) + + j = j + 1 + k = k + 1 + l = l + 1 + } + + # Ramp down. + while (l <= nl) { + datain = Memi[bufs+mod(k,nscani)] + call asubr (Memr[data], Memr[datain], Memr[data], nc) + dataout = impl2r (out, l+l1-1) + c1 - 1 + call adivkr (Memr[data], nscanr, Memr[dataout], nc) + if (replace) + call amaxkr (Memr[dataout], minreplace, Memr[dataout], nc) + mean = mean + asumr (Memr[dataout], nc) + + k = k + 1 + l = l + 1 + } + + call mfree (bufs, TY_INT) + call mfree (data, TY_REAL) + + case 2: + nscani = max (1, min (nscan, nc) + 1) + nscanr = nscani + do i = 1, nl { + datain = imgl2r (in, i + l1 - 1) + datain = datain + c1 - 1 + data = impl2r (out, i + l1 - 1) + call amovr (Memr[datain], Memr[data], len1) + datain = datain + c1 - 1 + data = data + c1 - 1 + sum = 0 + j = 0 + k = 0 + l = 0 + + # Ramp up + while (j < nscani) { + sum = sum + Memr[datain+j] + j = j + 1 + } + if (replace) + Memr[data] = max (minreplace, sum / nscani) + else + Memr[data] = sum / nscani + mean = mean + Memr[data] + l = l + 1 + + # Moving average + while (j < nl) { + sum = sum + Memr[datain+j] - Memr[datain+k] + if (replace) + Memr[data+l] = max (minreplace, sum / nscani) + else + Memr[data+l] = sum / nscani + mean = mean + Memr[data+l] + j = j + 1 + k = k + 1 + l = l + 1 + } + + # Ramp down + while (l < nl) { + sum = sum - Memr[datain+k] + if (replace) + Memr[data+l] = max (minreplace, sum / nscani) + else + Memr[data+l] = sum / nscani + mean = mean + Memr[data+l] + k = k + 1 + l = l + 1 + } + } + } + + # Copy final lines. + do i = l2+1, len2 + call amovr (Memr[imgl2r(in,i)], Memr[impl2r(out,i)], len1) + + mean = mean / nc / nl + call hdmputr (out, "ccdmean", mean) + call hdmputi (out, "ccdmeant", int (clktime (long (0)))) + + call sfree (sp) +end + + +# LONGSCAN -- Make a longscan mode readout flat field correction by averaging +# across the readout axis. + +procedure longscan (in, out, readaxis) + +pointer in # Input image +pointer out # Output image +int readaxis # Readout axis + +int i, nc, nl, c1, c2, cs, l1, l2, ls +int in_c1, in_c2, in_l1, in_l2, ccd_c1, ccd_c2, ccd_l1, ccd_l2 +real mean, asumr() +long clktime() +pointer sp, str, data, imgl2r(), impl2r(), imps2r() + +begin + call smark (sp) + call salloc (str, SZ_LINE, TY_CHAR) + + # The default data section is the entire image. + nc = IM_LEN(in,1) + nl = IM_LEN(in,2) + c1 = 1 + c2 = nc + cs = 1 + l1 = 1 + l2 = nl + ls = 1 + call hdmgstr (in, "datasec", Memc[str], SZ_LINE) + call ccd_section (Memc[str], c1, c2, cs, l1, l2, ls) + if ((c1<1)||(c2>nc)||(l1<1)||(l2>nl)||(cs!=1)||(ls!=1)) + call error (0, "Error in DATASEC parameter") + in_c1 = c1 + in_c2 = c2 + in_l1 = l1 + in_l2 = l2 + + # The default ccd section is the data section. + call hdmgstr (in, "ccdsec", Memc[str], SZ_LINE) + call ccd_section (Memc[str], c1, c2, cs, l1, l2, ls) + if ((cs != 1) || (ls != 1)) + call error (0, "Error in CCDSEC parameter") + ccd_c1 = c1 + ccd_c2 = c2 + ccd_l1 = l1 + ccd_l2 = l2 + if ((in_c2-in_c1 != ccd_c2-ccd_c1) || (in_l2-in_l1 != ccd_l2-ccd_l1)) + call error (0, "Size of DATASEC and CCDSEC do not agree") + + switch (readaxis) { + case 1: + IM_LEN(out,2) = 1 + data = impl2r (out, 1) + call aclrr (Memr[data], nc) + nc = in_c2 - in_c1 + 1 + nl = in_l2 - in_l1 + 1 + data = data + in_c1 - 1 + do i = in_l1, in_l2 + call aaddr (Memr[imgl2r(in,i)+in_c1-1], Memr[data], + Memr[data], nc) + call adivkr (Memr[data], real (nl), Memr[data], nc) + call sprintf (Memc[str], SZ_LINE, "[%d:%d,1:1]") + call pargi (in_c1) + call pargi (in_c2) + call hdmpstr (out, "datasec", Memc[str]) + call sprintf (Memc[str], SZ_LINE, "[%d:%d,*]") + call pargi (ccd_c1) + call pargi (ccd_c2) + call hdmpstr (out, "ccdsec", Memc[str]) + mean = asumr (Memr[data], nc) / nl + case 2: + IM_LEN(out,1) = 1 + data = imps2r (out, 1, 1, 1, nl) + call aclrr (Memr[data], nl) + nc = in_c2 - in_c1 + 1 + nl = in_l2 - in_l1 + 1 + do i = in_l1, in_l2 + Memr[data+i-1] = asumr (Memr[imgl2r(in,i)+in_c1-1], nc) / nc + call sprintf (Memc[str], SZ_LINE, "[1:1,%d:%d]") + call pargi (in_l1) + call pargi (in_l2) + call hdmpstr (out, "datasec", Memc[str]) + call sprintf (Memc[str], SZ_LINE, "[*,%d:%d]") + call pargi (ccd_l1) + call pargi (ccd_l2) + call hdmpstr (out, "ccdsec", Memc[str]) + mean = asumr (Memr[data], nl) / nc + } + + call hdmputr (out, "ccdmean", mean) + call hdmputi (out, "ccdmeant", int (clktime (long (0)))) + + call sfree (sp) +end diff --git a/noao/imred/ccdred/src/setdark.x b/noao/imred/ccdred/src/setdark.x new file mode 100644 index 00000000..c872aba4 --- /dev/null +++ b/noao/imred/ccdred/src/setdark.x @@ -0,0 +1,160 @@ +include <imhdr.h> +include "ccdred.h" +include "ccdtypes.h" + + +# SET_DARK -- Set parameters for dark count correction. +# +# 1. Return immediately if the dark count correction is not requested or +# if the image has been previously corrected. +# 2. Get the dark count correction image and return an error if not found. +# 3. If the dark count image has not been processed call PROC. +# 4. Compute the dark count integration time scale factor. +# 5. Set the processing flags. +# 6. Log the operation (to user, logfile, and output image header). + +procedure set_dark (ccd) + +pointer ccd # CCD structure + +int nscan, nc, nl, c1, c2, cs, l1, l2, ls, data_c1, ccd_c1, data_l1, ccd_l1 +real darktime1, darktime2 +pointer sp, image, str, im + +bool clgetb(), ccdflag(), ccdcheck() +int ccdnscan(), ccdtypei() +real hdmgetr() +pointer ccd_cache() +errchk cal_image, ccd_cache, ccdproc, hdmgetr + +begin + # Check if the user wants this operation or it has already been done. + if (!clgetb ("darkcor") || ccdflag (IN_IM(ccd), "darkcor")) + return + + call smark (sp) + call salloc (image, SZ_FNAME, TY_CHAR) + call salloc (str, SZ_LINE, TY_CHAR) + + # Get the dark count correction image name. + if (clgetb ("scancor")) + nscan = ccdnscan (IN_IM(ccd), ccdtypei(IN_IM(ccd))) + else + nscan = 1 + call cal_image (IN_IM(ccd), DARK, nscan, Memc[image], SZ_FNAME) + + # If no processing is desired print dark count image and return. + if (clgetb ("noproc")) { + call eprintf (" [TO BE DONE] Dark count correction image is %s.\n") + call pargstr (Memc[image]) + call sfree (sp) + return + } + + # Map the image and return on an error. + # Process the dark count image if necessary. + # If nscan > 1 then the dark may not yet exist so create it + # from the unscanned dark. + + iferr (im = ccd_cache (Memc[image], DARK)) { + call cal_image (IN_IM(ccd), DARK, 1, Memc[str], SZ_LINE) + im = ccd_cache (Memc[str], DARK) + if (ccdcheck (im, DARK)) { + call ccd_flush (im) + call ccdproc (Memc[str], DARK) + } + call scancor (Memc[str], Memc[image], nscan, INDEF) + im = ccd_cache (Memc[image], DARK) + } + + if (ccdcheck (im, DARK)) { + call ccd_flush (im) + call ccdproc (Memc[image], DARK) + im = ccd_cache (Memc[image], DARK) + } + + # Set the processing parameters in the CCD structure. + nc = IM_LEN(im,1) + nl = IM_LEN(im,2) + c1 = 1 + c2 = nc + l1 = 1 + l2 = nl + cs = 1 + ls = 1 + call hdmgstr (im, "datasec", Memc[str], SZ_FNAME) + call ccd_section (Memc[str], c1, c2, cs, l1, l2, ls) + if ((c1<1)||(c2>nc)||(l1<1)||(l2>nl)||(cs!=1)||(ls!=1)) { + call sprintf (Memc[str], SZ_LINE, + "Data section error: image=%s[%d,%d], datasec=[%d:%d,%d:%d]") + call pargstr (Memc[image]) + call pargi (nc) + call pargi (nl) + call pargi (c1) + call pargi (c2) + call pargi (l1) + call pargi (l2) + call error (0, Memc[str]) + } + data_c1 = c1 + data_l1 = l1 + call hdmgstr (im, "ccdsec", Memc[str], SZ_FNAME) + call ccd_section (Memc[str], c1, c2, cs, l1, l2, ls) + if (nc == 1) { + c1 = CCD_C1(ccd) + c2 = CCD_C2(ccd) + } + if (nl == 1) { + l1 = CCD_L1(ccd) + l2 = CCD_L2(ccd) + } + ccd_c1 = c1 + ccd_l1 = l1 + if ((c1 > CCD_C1(ccd)) || (c2 < CCD_C2(ccd)) || + (l1 > CCD_L1(ccd)) || (l2 < CCD_L2(ccd))) { + call sprintf (Memc[str], SZ_LINE, + "CCD section error: input=[%d:%d,%d:%d], %s=[%d:%d,%d:%d]") + call pargi (CCD_C1(ccd)) + call pargi (CCD_C2(ccd)) + call pargi (CCD_L1(ccd)) + call pargi (CCD_L2(ccd)) + call pargstr (Memc[image]) + call pargi (c1) + call pargi (c2) + call pargi (l1) + call pargi (l2) + call error (0, Memc[str]) + } + + DARK_IM(ccd) = im + DARK_C1(ccd) = CCD_C1(ccd) - ccd_c1 + data_c1 + DARK_C2(ccd) = CCD_C2(ccd) - ccd_c1 + data_c1 + DARK_L1(ccd) = CCD_L1(ccd) - ccd_l1 + data_l1 + DARK_L2(ccd) = CCD_L2(ccd) - ccd_l1 + data_l1 + + # Get the dark count integration times. Return an error if not found. + iferr (darktime1 = hdmgetr (IN_IM(ccd), "darktime")) + darktime1 = hdmgetr (IN_IM(ccd), "exptime") + iferr (darktime2 = hdmgetr (im, "darktime")) + darktime2 = hdmgetr (im, "exptime") + if (darktime2 <= 0.) { + call sprintf (Memc[str], SZ_LINE, "Dark time is zero for `%s'") + call pargstr (Memc[image]) + call error (1, Memc[str]) + } + + DARKSCALE(ccd) = darktime1 / darktime2 + CORS(ccd, DARKCOR) = D + COR(ccd) = YES + + # Record the operation in the output image and write a log record. + call sprintf (Memc[str], SZ_LINE, + "Dark count correction image is %s with scale=%g") + call pargstr (Memc[image]) + call pargr (DARKSCALE(ccd)) + call timelog (Memc[str], SZ_LINE) + call ccdlog (IN_IM(ccd), Memc[str]) + call hdmpstr (OUT_IM(ccd), "darkcor", Memc[str]) + + call sfree (sp) +end diff --git a/noao/imred/ccdred/src/setfixpix.x b/noao/imred/ccdred/src/setfixpix.x new file mode 100644 index 00000000..e6b96298 --- /dev/null +++ b/noao/imred/ccdred/src/setfixpix.x @@ -0,0 +1,74 @@ +include <imhdr.h> +include <imset.h> +include <pmset.h> +include "ccdred.h" + + +# SET_FIXPIX -- Set parameters for bad pixel correction. +# 1. Return immediately if the bad pixel correction is not requested or +# if the image has been previously corrected. +# 2. Get the bad pixel mask. Return an error if not found. +# 3. If the bad pixel mask has not been processed call PROC. +# 4. Set the processing flag. +# 5. Log the operation (to user, logfile, and output image header). +# +# This routine relies on the physical coordinate system and assumes +# XT_PMMAP has taken care of matching the pixel mask to the input image. + +procedure set_fixpix (ccd) + +pointer ccd # CCD structure + +pointer sp, image, str, im + +int imstati() +bool clgetb(), streq(), ccdflag() +pointer xt_pmmap(), xt_fpinit() +errchk xt_pmmap(), xt_fpinit() + +begin + # Check if the user wants this operation or it has been done. + if (!clgetb ("fixpix") || ccdflag (IN_IM(ccd), "fixpix")) + return + + call smark (sp) + call salloc (image, SZ_FNAME, TY_CHAR) + call salloc (str, SZ_LINE, TY_CHAR) + + # Get the bad pixel file. If the name is "image" then get the file + # name from the image header or symbol table. + + call clgstr ("fixfile", Memc[image], SZ_FNAME) + if (streq (Memc[image], "image")) + call hdmgstr (IN_IM(ccd), "fixfile", Memc[image], SZ_FNAME) + + # If no processing is desired print message and return. + if (clgetb ("noproc")) { + call eprintf (" [TO BE DONE] Bad pixel file is %s\n") + call pargstr (Memc[image]) + call sfree (sp) + return + } + + # Map the bad pixel image and return on an error. + im = xt_pmmap (Memc[image], IN_IM(ccd), Memc[image], SZ_FNAME) + if (Memc[image] == EOS) + call error (1, "No bad pixel mask found") + if (im != NULL) { + MASK_IM(ccd) = im + MASK_PM(ccd) = imstati (im, IM_PMDES) + MASK_FP(ccd) = xt_fpinit (MASK_PM(ccd), 2, 3) + + CORS(ccd, FIXPIX) = YES + COR(ccd) = YES + } + + # Log the operation. + call sprintf (Memc[str], SZ_LINE, "Bad pixel file is %s") + call pargstr (Memc[image]) + call timelog (Memc[str], SZ_LINE) + call ccdlog (IN_IM(ccd), Memc[str]) + call hdmpstr (OUT_IM(ccd), "fixpix", Memc[str]) + + call sfree (sp) +end diff --git a/noao/imred/ccdred/src/setflat.x b/noao/imred/ccdred/src/setflat.x new file mode 100644 index 00000000..87713404 --- /dev/null +++ b/noao/imred/ccdred/src/setflat.x @@ -0,0 +1,146 @@ +include <imhdr.h> +include "ccdred.h" +include "ccdtypes.h" + +# SET_FLAT -- Set parameters for flat field correction. +# +# 1. Return immediately if the flat field correction is not requested or +# if the image has been previously corrected. +# 2. Get the flat field image and return on an error. +# 3. If the flat field image has not been processed call PROC. +# 4. Set the processing flags and record the operation in the output +# image and write a log record. + +procedure set_flat (ccd) + +pointer ccd # CCD structure + +int nc, nl, c1, c2, cs, l1, l2, ls, data_c1, ccd_c1, data_l1, ccd_l1 +pointer sp, str, image, im, ccd_cache() +bool clgetb(), ccdflag(), ccdcheck() +int nscan, ccdnscan(), ccdtypei() +real hdmgetr() +errchk cal_image, ccd_cache, ccdproc, hdmgetr + +begin + # Check if the user wants this operation or if it has been done. + if (!clgetb ("flatcor") || ccdflag (IN_IM(ccd), "flatcor")) + return + + call smark (sp) + call salloc (image, SZ_FNAME, TY_CHAR) + call salloc (str, SZ_LINE, TY_CHAR) + + # Get the flat field correction image. + if (clgetb ("scancor")) + nscan = ccdnscan (IN_IM(ccd), ccdtypei(IN_IM(ccd))) + else + nscan = 1 + call cal_image (IN_IM(ccd), FLAT, nscan, Memc[image], SZ_FNAME) + + # If no processing is desired print flat field image name and return. + if (clgetb ("noproc")) { + call eprintf (" [TO BE DONE] Flat correction image is %s.\n") + call pargstr (Memc[image]) + call sfree (sp) + return + } + + # Map the image and return on an error. + # Process the flat field image if necessary. + # If nscan > 1 then the flat field may not yet exist so create it + # from the unscanned flat field. + + iferr (im = ccd_cache (Memc[image], FLAT)) { + call cal_image (IN_IM(ccd), FLAT, 1, Memc[str], SZ_LINE) + im = ccd_cache (Memc[str], FLAT) + if (ccdcheck (im, FLAT)) { + call ccd_flush (im) + call ccdproc (Memc[str], FLAT) + } + call scancor (Memc[str], Memc[image], nscan, MINREPLACE(ccd)) + im = ccd_cache (Memc[image], FLAT) + } + + if (ccdcheck (im, FLAT)) { + call ccd_flush (im) + call ccdproc (Memc[image], FLAT) + im = ccd_cache (Memc[image], FLAT) + } + + # Set the processing parameters in the CCD structure. + nc = IM_LEN(im,1) + nl = IM_LEN(im,2) + c1 = 1 + c2 = nc + l1 = 1 + l2 = nl + cs = 1 + ls = 1 + call hdmgstr (im, "datasec", Memc[str], SZ_FNAME) + call ccd_section (Memc[str], c1, c2, cs, l1, l2, ls) + if ((c1<1)||(c2>nc)||(l1<1)||(l2>nl)||(cs!=1)||(ls!=1)) { + call sprintf (Memc[str], SZ_LINE, + "Data section error: image=%s[%d,%d], datasec=[%d:%d,%d:%d]") + call pargstr (Memc[image]) + call pargi (nc) + call pargi (nl) + call pargi (c1) + call pargi (c2) + call pargi (l1) + call pargi (l2) + call error (0, Memc[str]) + } + data_c1 = c1 + data_l1 = l1 + call hdmgstr (im, "ccdsec", Memc[str], SZ_FNAME) + call ccd_section (Memc[str], c1, c2, cs, l1, l2, ls) + if (nc == 1) { + c1 = CCD_C1(ccd) + c2 = CCD_C2(ccd) + } + if (nl == 1) { + l1 = CCD_L1(ccd) + l2 = CCD_L2(ccd) + } + ccd_c1 = c1 + ccd_l1 = l1 + if ((c1 > CCD_C1(ccd)) || (c2 < CCD_C2(ccd)) || + (l1 > CCD_L1(ccd)) || (l2 < CCD_L2(ccd))) { + call sprintf (Memc[str], SZ_LINE, + "CCD section error: input=[%d:%d,%d:%d], %s=[%d:%d,%d:%d]") + call pargi (CCD_C1(ccd)) + call pargi (CCD_C2(ccd)) + call pargi (CCD_L1(ccd)) + call pargi (CCD_L2(ccd)) + call pargstr (Memc[image]) + call pargi (c1) + call pargi (c2) + call pargi (l1) + call pargi (l2) + call error (0, Memc[str]) + } + + FLAT_IM(ccd) = im + FLAT_C1(ccd) = CCD_C1(ccd) - ccd_c1 + data_c1 + FLAT_C2(ccd) = CCD_C2(ccd) - ccd_c1 + data_c1 + FLAT_L1(ccd) = CCD_L1(ccd) - ccd_l1 + data_l1 + FLAT_L2(ccd) = CCD_L2(ccd) - ccd_l1 + data_l1 + + # If no mean value use 1 as the scale factor. + iferr (FLATSCALE(ccd) = hdmgetr (im, "ccdmean")) + FLATSCALE(ccd) = 1. + CORS(ccd, FLATCOR) = F + COR(ccd) = YES + + # Log the operation. + call sprintf (Memc[str], SZ_LINE, + "Flat field image is %s with scale=%g") + call pargstr (Memc[image]) + call pargr (FLATSCALE(ccd)) + call timelog (Memc[str], SZ_LINE) + call ccdlog (IN_IM(ccd), Memc[str]) + call hdmpstr (OUT_IM(ccd), "flatcor", Memc[str]) + + call sfree (sp) +end diff --git a/noao/imred/ccdred/src/setfringe.x b/noao/imred/ccdred/src/setfringe.x new file mode 100644 index 00000000..7055f35f --- /dev/null +++ b/noao/imred/ccdred/src/setfringe.x @@ -0,0 +1,123 @@ +include <imhdr.h> +include "ccdred.h" +include "ccdtypes.h" + +# SET_FRINGE -- Set parameters for fringe correction. +# +# 1. Return immediately if the fringe correction is not requested or +# if the image has been previously corrected. +# 2. Get the fringe image and return error if the mkfringe flag is missing. +# 3. Set the processing flags and record the operation in the output +# image and write a log record. + +procedure set_fringe (ccd) + +pointer ccd # CCD structure + +int nc, nl, c1, c2, cs, l1, l2, ls, data_c1, ccd_c1, data_l1, ccd_l1 +real exptime1, exptime2, fringescale +pointer sp, str, image, im + +bool clgetb(), ccdflag() +real hdmgetr() +pointer ccd_cache() +errchk cal_image, ccd_cache, ccdproc, hdmgetr + +begin + # Check if the user wants this operation or if it has been done. + if (!clgetb ("fringecor") || ccdflag (IN_IM(ccd), "fringcor")) + return + + call smark (sp) + call salloc (image, SZ_FNAME, TY_CHAR) + call salloc (str, SZ_LINE, TY_CHAR) + + # Get the fringe correction image. + call cal_image (IN_IM(ccd), FRINGE, 1, Memc[image], SZ_FNAME) + + # If no processing is desired print fringe image name and return. + if (clgetb ("noproc")) { + call eprintf ( + " [TO BE DONE] Fringe correction image is %s.\n") + call pargstr (Memc[image]) + call sfree (sp) + return + } + + # Return an error if the fringe flag is missing. + im = ccd_cache (Memc[image], FRINGE) + if (!ccdflag (im, "mkfringe")) + call error (0, "MKFRINGE flag missing from fringe image.") + + # Set the processing parameters in the CCD structure. + nc = IM_LEN(im,1) + nl = IM_LEN(im,2) + c1 = 1 + c2 = nc + l1 = 1 + l2 = nl + cs = 1 + ls = 1 + call hdmgstr (im, "datasec", Memc[str], SZ_FNAME) + call ccd_section (Memc[str], c1, c2, cs, l1, l2, ls) + if ((c1<1)||(c2>nc)||(l1<1)||(l2>nl)||(cs!=1)||(ls!=1)) { + call sprintf (Memc[str], SZ_LINE, + "Data section error: image=%s[%d,%d], datasec=[%d:%d,%d:%d]") + call pargstr (Memc[image]) + call pargi (nc) + call pargi (nl) + call pargi (c1) + call pargi (c2) + call pargi (l1) + call pargi (l2) + call error (0, Memc[str]) + } + data_c1 = c1 + data_l1 = l1 + call hdmgstr (im, "ccdsec", Memc[str], SZ_FNAME) + call ccd_section (Memc[str], c1, c2, cs, l1, l2, ls) + ccd_c1 = c1 + ccd_l1 = l1 + if ((c1 > CCD_C1(ccd)) || (c2 < CCD_C2(ccd)) || + (l1 > CCD_L1(ccd)) || (l2 < CCD_L2(ccd))) { + call sprintf (Memc[str], SZ_LINE, + "CCD section error: input=[%d:%d,%d:%d], %s=[%d:%d,%d:%d]") + call pargi (CCD_C1(ccd)) + call pargi (CCD_C2(ccd)) + call pargi (CCD_L1(ccd)) + call pargi (CCD_L2(ccd)) + call pargstr (Memc[image]) + call pargi (c1) + call pargi (c2) + call pargi (l1) + call pargi (l2) + call error (0, Memc[str]) + } + + FRINGE_IM(ccd) = im + FRINGE_C1(ccd) = CCD_C1(ccd) - ccd_c1 + data_c1 + FRINGE_C2(ccd) = CCD_C2(ccd) - ccd_c1 + data_c1 + FRINGE_L1(ccd) = CCD_L1(ccd) - ccd_l1 + data_l1 + FRINGE_L2(ccd) = CCD_L2(ccd) - ccd_l1 + data_l1 + + # Get the scaling factors. If no fringe scale factor assume 1. + exptime1 = hdmgetr (IN_IM(ccd), "exptime") + exptime2 = hdmgetr (im, "exptime") + iferr (fringescale = hdmgetr (im, "fringscl")) + fringescale = 1. + + FRINGESCALE(ccd) = exptime1 / exptime2 * fringescale + CORS(ccd, FRINGECOR) = Q + COR(ccd) = YES + + # Log the operation. + call sprintf (Memc[str], SZ_LINE, + "Fringe image is %s with scale=%g") + call pargstr (Memc[image]) + call pargr (FRINGESCALE(ccd)) + call timelog (Memc[str], SZ_LINE) + call ccdlog (IN_IM(ccd), Memc[str]) + call hdmpstr (OUT_IM(ccd), "fringcor", Memc[str]) + + call sfree (sp) +end diff --git a/noao/imred/ccdred/src/setheader.x b/noao/imred/ccdred/src/setheader.x new file mode 100644 index 00000000..aa13730a --- /dev/null +++ b/noao/imred/ccdred/src/setheader.x @@ -0,0 +1,83 @@ +include <imhdr.h> +include "ccdred.h" + +# SET_HEADER -- Set the output image header. + +procedure set_header (ccd) + +pointer ccd # CCD structure + +int nc, nl +real shift[2] +pointer sp, str, out, mw, mw_openim() +long clktime() + +begin + call smark (sp) + call salloc (str, SZ_LINE, TY_CHAR) + + out = OUT_IM(ccd) + nc = IM_LEN(out,1) + nl = IM_LEN(out,2) + + # Set the data section if it is not the whole image. + if ((OUT_C1(ccd) != 1) || (OUT_C2(ccd) != nc) || + (OUT_L1(ccd) != 1) || (OUT_L2(ccd) != nl)) { + call sprintf (Memc[str], SZ_LINE, "[%d:%d,%d:%d]") + call pargi (OUT_C1(ccd)) + call pargi (OUT_C2(ccd)) + call pargi (OUT_L1(ccd)) + call pargi (OUT_L2(ccd)) + call hdmpstr (out, "datasec", Memc[str]) + } else { + iferr (call hdmdelf (out, "datasec")) + ; + } + + # Set the CCD section. + call sprintf (Memc[str], SZ_LINE, "[%d:%d,%d:%d]") + call pargi (CCD_C1(ccd)) + call pargi (CCD_C2(ccd)) + call pargi (CCD_L1(ccd)) + call pargi (CCD_L2(ccd)) + call hdmpstr (out, "ccdsec", Memc[str]) + + # If trimming update the trim and bias section parameters. + if (CORS(ccd, TRIM) == YES) { + iferr (call hdmdelf (out, "trimsec")) + ; + iferr (call hdmdelf (out, "biassec")) + ; + BIAS_C1(ccd) = max (1, BIAS_C1(ccd) - TRIM_C1(ccd) + 1) + BIAS_C2(ccd) = min (nc, BIAS_C2(ccd) - TRIM_C1(ccd) + 1) + BIAS_L1(ccd) = max (1, BIAS_L1(ccd) - TRIM_L1(ccd) + 1) + BIAS_L2(ccd) = min (nl, BIAS_L2(ccd) - TRIM_L1(ccd) + 1) + if ((BIAS_C1(ccd)<=BIAS_C2(ccd)) && (BIAS_L1(ccd)<=BIAS_L2(ccd))) { + call sprintf (Memc[str], SZ_LINE, "[%d:%d,%d:%d]") + call pargi (BIAS_C1(ccd)) + call pargi (BIAS_C2(ccd)) + call pargi (BIAS_L1(ccd)) + call pargi (BIAS_L2(ccd)) + call hdmpstr (out, "biassec", Memc[str]) + } + + mw = mw_openim (out) + shift[1] = 1 - IN_C1(ccd) + shift[2] = 1 - IN_L1(ccd) + call mw_shift (mw, shift, 3) + call mw_saveim (mw, out) + } + + # Set mean value if desired. + if (CORS(ccd, FINDMEAN) == YES) { + call hdmputr (out, "ccdmean", MEAN(ccd)) + call hdmputi (out, "ccdmeant", int (clktime (long (0)))) + } + + # Mark image as processed. + call sprintf (Memc[str], SZ_LINE, "CCD processing done") + call timelog (Memc[str], SZ_LINE) + call hdmpstr (out, "ccdproc", Memc[str]) + + call sfree (sp) +end diff --git a/noao/imred/ccdred/src/setillum.x b/noao/imred/ccdred/src/setillum.x new file mode 100644 index 00000000..d1677301 --- /dev/null +++ b/noao/imred/ccdred/src/setillum.x @@ -0,0 +1,132 @@ +include <imhdr.h> +include "ccdred.h" +include "ccdtypes.h" + +# SET_ILLUM -- Set parameters for illumination correction. +# +# 1. Return immediately if the illumination correction is not requested or +# if the image has been previously corrected. +# 2. Get the illumination image and return error if mkillum flag missing. +# 3. Set the processing flags and record the operation in the output +# image and write a log record. + +procedure set_illum (ccd) + +pointer ccd # CCD structure + +int nc, nl, c1, c2, cs, l1, l2, ls, data_c1, ccd_c1, data_l1, ccd_l1 +long time +pointer sp, str, image, im + +bool clgetb(), ccdflag() +long hdmgeti() +real hdmgetr() +pointer ccd_cache() +errchk cal_image, ccd_cache, ccdproc, hdmgetr, hdmgeti + +begin + # Check if the user wants this operation or if it has been done. + if (!clgetb ("illumcor") || ccdflag (IN_IM(ccd), "illumcor")) + return + + call smark (sp) + call salloc (image, SZ_FNAME, TY_CHAR) + call salloc (str, SZ_LINE, TY_CHAR) + + # Get the illumcor correction image. + call cal_image (IN_IM(ccd), ILLUM, 1, Memc[image], SZ_FNAME) + + # If no processing is desired print illumination image name and return. + if (clgetb ("noproc")) { + call eprintf ( + " [TO BE DONE] Illumination correction image is %s.\n") + call pargstr (Memc[image]) + call sfree (sp) + return + } + + # Return a warning if the illumination flag is missing. + im = ccd_cache (Memc[image], ILLUM) + if (!ccdflag (im, "mkillum")) { + call ccd_flush (im) + call error (0, "MKILLUM flag missing from illumination image") + } + + # If no mean value for the scale factor compute it. + iferr (ILLUMSCALE(ccd) = hdmgetr (im, "ccdmean")) + ILLUMSCALE(ccd) = INDEF + iferr (time = hdmgeti (im, "ccdmeant")) + time = IM_MTIME(im) + if (IS_INDEF(ILLUMSCALE(ccd)) || time < IM_MTIME(im)) { + call ccd_flush (im) + call ccdmean (Memc[image]) + im = ccd_cache (Memc[image], ILLUM) + } + iferr (ILLUMSCALE(ccd) = hdmgetr (im, "ccdmean")) + ILLUMSCALE(ccd) = 1. + + # Set the processing parameters in the CCD structure. + nc = IM_LEN(im,1) + nl = IM_LEN(im,2) + c1 = 1 + c2 = nc + l1 = 1 + l2 = nl + cs = 1 + ls = 1 + call hdmgstr (im, "datasec", Memc[str], SZ_FNAME) + call ccd_section (Memc[str], c1, c2, cs, l1, l2, ls) + if ((c1<1)||(c2>nc)||(l1<1)||(l2>nl)||(cs!=1)||(ls!=1)) { + call sprintf (Memc[str], SZ_LINE, + "Data section error: image=%s[%d,%d], datasec=[%d:%d,%d:%d]") + call pargstr (Memc[image]) + call pargi (nc) + call pargi (nl) + call pargi (c1) + call pargi (c2) + call pargi (l1) + call pargi (l2) + call error (0, Memc[str]) + } + data_c1 = c1 + data_l1 = l1 + call hdmgstr (im, "ccdsec", Memc[str], SZ_FNAME) + call ccd_section (Memc[str], c1, c2, cs, l1, l2, ls) + ccd_c1 = c1 + ccd_l1 = l1 + if ((c1 > CCD_C1(ccd)) || (c2 < CCD_C2(ccd)) || + (l1 > CCD_L1(ccd)) || (l2 < CCD_L2(ccd))) { + call sprintf (Memc[str], SZ_LINE, + "CCD section error: input=[%d:%d,%d:%d], %s=[%d:%d,%d:%d]") + call pargi (CCD_C1(ccd)) + call pargi (CCD_C2(ccd)) + call pargi (CCD_L1(ccd)) + call pargi (CCD_L2(ccd)) + call pargstr (Memc[image]) + call pargi (c1) + call pargi (c2) + call pargi (l1) + call pargi (l2) + call error (0, Memc[str]) + } + + ILLUM_IM(ccd) = im + ILLUM_C1(ccd) = CCD_C1(ccd) - ccd_c1 + data_c1 + ILLUM_C2(ccd) = CCD_C2(ccd) - ccd_c1 + data_c1 + ILLUM_L1(ccd) = CCD_L1(ccd) - ccd_l1 + data_l1 + ILLUM_L2(ccd) = CCD_L2(ccd) - ccd_l1 + data_l1 + + CORS(ccd, ILLUMCOR) = I + COR(ccd) = YES + + # Log the operation. + call sprintf (Memc[str], SZ_LINE, + "Illumination image is %s with scale=%g") + call pargstr (Memc[image]) + call pargr (ILLUMSCALE(ccd)) + call timelog (Memc[str], SZ_LINE) + call ccdlog (IN_IM(ccd), Memc[str]) + call hdmpstr (OUT_IM(ccd), "illumcor", Memc[str]) + + call sfree (sp) +end diff --git a/noao/imred/ccdred/src/setinput.x b/noao/imred/ccdred/src/setinput.x new file mode 100644 index 00000000..3d3170db --- /dev/null +++ b/noao/imred/ccdred/src/setinput.x @@ -0,0 +1,48 @@ +include <error.h> +include "ccdtypes.h" + +# SET_INPUT -- Set the input image and image type. +# +# 1. Open the input image. Return warning and NULL pointer for an error. +# 2. Get the requested CCD image type. +# a. If no type is requested then accept the image. +# b. If a type is requested then match against the image type. +# Unmap the image if no match. +# 3. If the image is acceptable then get the CCD type code. + +procedure set_input (image, im, ccdtype) + +char image[ARB] # Input image name +pointer im # IMIO pointer (returned) +int ccdtype # CCD image type + +bool strne() +int ccdtypei() +pointer sp, str1, str2, immap() + +begin + # Open the image. Return a warning and NULL pointer for an error. + iferr (im = immap (image, READ_ONLY, 0)) { + call erract (EA_WARN) + im = NULL + return + } + + call smark (sp) + call salloc (str1, SZ_LINE, TY_CHAR) + call salloc (str2, SZ_LINE, TY_CHAR) + + # Get the requested CCD type. + call clgstr ("ccdtype", Memc[str1], SZ_LINE) + call xt_stripwhite (Memc[str1]) + if (Memc[str1] != EOS) { + call ccdtypes (im, Memc[str2], SZ_LINE) + if (strne (Memc[str1], Memc[str2])) + call imunmap (im) + } + + if (im != NULL) + ccdtype = ccdtypei (im) + + call sfree (sp) +end diff --git a/noao/imred/ccdred/src/setinteract.x b/noao/imred/ccdred/src/setinteract.x new file mode 100644 index 00000000..05bc0f71 --- /dev/null +++ b/noao/imred/ccdred/src/setinteract.x @@ -0,0 +1,31 @@ +include <pkg/xtanswer.h> + +# SET_INTERACTIVE -- Set the interactive flag. Query the user if necessary. +# +# This procedure initializes the interactive flag if there is no query. +# If there is a query it is issued by XT_ANSWER. The four valued +# interactive flag is returned. + +procedure set_interactive (query, interactive) + +char query[ARB] # Query prompt +int interactive # Fit overscan interactively? (returned) + +int interact # Saves last value of interactive flag +bool clgetb() + +begin + # If the query is null then initialize from the CL otherwise + # query the user. This response is four valued to allow the user + # to turn off the query when processing multiple images. + + if (query[1] == EOS) { + if (clgetb ("interactive")) + interact = YES + else + interact = ALWAYSNO + } else + call xt_answer (query, interact) + + interactive = interact +end diff --git a/noao/imred/ccdred/src/setoutput.x b/noao/imred/ccdred/src/setoutput.x new file mode 100644 index 00000000..b401b5aa --- /dev/null +++ b/noao/imred/ccdred/src/setoutput.x @@ -0,0 +1,52 @@ +include <imhdr.h> +include <imset.h> + +# SET_OUTPUT -- Setup the output image. +# The output image is a NEW_COPY of the input image. +# The user may select a pixel datatype with higher precision though not +# lower. + +procedure set_output (in, out, output) + +pointer in # Input IMIO pointer to copy +pointer out # Output IMIO pointer +char output[SZ_FNAME] # Output image name + +int i, clscan(), nscan() +char type[1] +pointer immap() +errchk immap + +begin + out = immap (output, NEW_COPY, in) + IM_PIXTYPE(out) = TY_REAL + if (clscan ("pixeltype") != EOF) { + call gargwrd (type, 1) + if (nscan() == 1) { + i = IM_PIXTYPE(in) + IM_PIXTYPE(out) = i + switch (type[1]) { + case 's': + if (i == TY_USHORT) + IM_PIXTYPE(out) = TY_SHORT + case 'u': + if (i == TY_SHORT) + IM_PIXTYPE(out) = TY_USHORT + case 'i': + if (i == TY_SHORT || i == TY_USHORT) + IM_PIXTYPE(out) = TY_INT + case 'l': + if (i == TY_SHORT || i == TY_USHORT || i == TY_INT) + IM_PIXTYPE(out) = TY_LONG + case 'r': + if (i != TY_DOUBLE) + IM_PIXTYPE(out) = TY_REAL + case 'd': + IM_PIXTYPE(out) = TY_DOUBLE + default: + call imunmap (out) + call error (0, "Unknown pixel type") + } + } + } +end diff --git a/noao/imred/ccdred/src/setoverscan.x b/noao/imred/ccdred/src/setoverscan.x new file mode 100644 index 00000000..e344aa92 --- /dev/null +++ b/noao/imred/ccdred/src/setoverscan.x @@ -0,0 +1,310 @@ +include <imhdr.h> +include <imset.h> +include <pkg/gtools.h> +include <pkg/xtanswer.h> +include "ccdred.h" + + +# SET_OVERSCAN -- Set the overscan vector. +# +# 1. Return immediately if the overscan correction is not requested or +# if the image has been previously corrected. +# 2. Determine the overscan columns or lines. This may be specifed +# directly or indirectly through the image header or symbol table. +# 3. Determine the type of overscan. +# 4. If fitting the overscan average the overscan columns or lines and +# fit a function with the ICFIT routines to smooth the overscan vector. +# 5. Set the processing flag. +# 6. Log the operation (to user, logfile, and output image header). + +procedure set_overscan (ccd) + +pointer ccd # CCD structure pointer + +int i, first, last, navg, npts, type +int nc, nl, c1, c2, l1, l2 +pointer sp, str, errstr, func, buf, x, overscan + +int clgwrd() +real asumr() +bool clgetb(), ccdflag() +pointer imgl2r(), imgs2r() +errchk imgl2r, imgs2r, fit_overscan + +begin + # Check if the user wants this operation or if it has been done. + if (!clgetb ("overscan") || ccdflag (IN_IM(ccd), "overscan")) + return + + call smark (sp) + call salloc (str, SZ_LINE, TY_CHAR) + call salloc (errstr, SZ_LINE, TY_CHAR) + call salloc (func, SZ_LINE, TY_CHAR) + call imstats (IN_IM(ccd), IM_IMAGENAME, Memc[str], SZ_LINE) + + # Check bias section. + nc = IM_LEN(IN_IM(ccd),1) + nl = IM_LEN(IN_IM(ccd),2) + c1 = BIAS_C1(ccd) + c2 = BIAS_C2(ccd) + l1 = BIAS_L1(ccd) + l2 = BIAS_L2(ccd) + if ((c1 < 1) || (c2 > nc) || (l1 < 1) || (l2 > nl)) { + call sprintf (Memc[errstr], SZ_LINE, + "Error in bias section: image=%s[%d,%d], biassec=[%d:%d,%d:%d]") + call pargstr (Memc[str]) + call pargi (nc) + call pargi (nl) + call pargi (c1) + call pargi (c2) + call pargi (l1) + call pargi (l2) + call error (0, Memc[errstr]) + } + if ((c1 == 1) && (c2 == nc) && (l1 == 1) && (l2 == nl)) { + call error (0, "Bias section not specified or given as full image") + } + + # If no processing is desired then print overscan strip and return. + if (clgetb ("noproc")) { + call eprintf (" [TO BE DONE] Overscan section is [%d:%d,%d:%d].\n") + call pargi (c1) + call pargi (c2) + call pargi (l1) + call pargi (l2) + call sfree (sp) + return + } + + # Determine the overscan section parameters. The readout axis + # determines the type of overscan. The step sizes are ignored. + # The limits in the long dimension are replaced by the trim limits. + + type = clgwrd ("function", Memc[func], SZ_LINE, OVERSCAN_TYPES) + if (type < OVERSCAN_FIT) { + overscan = NULL + if (READAXIS(ccd) == 2) + call error (1, + "Overscan function type not allowed with readaxis of 2") + } else { + if (READAXIS(ccd) == 1) { + first = c1 + last = c2 + navg = last - first + 1 + npts = nl + call salloc (buf, npts, TY_REAL) + do i = 1, npts + Memr[buf+i-1] = asumr (Memr[imgs2r (IN_IM(ccd), first, last, + i, i)], navg) + if (navg > 1) + call adivkr (Memr[buf], real (navg), Memr[buf], npts) + + # Trim the overscan vector and set the pixel coordinate. + npts = CCD_L2(ccd) - CCD_L1(ccd) + 1 + call malloc (overscan, npts, TY_REAL) + call salloc (x, npts, TY_REAL) + call trim_overscan (Memr[buf], npts, IN_L1(ccd), Memr[x], + Memr[overscan]) + + call fit_overscan (Memc[str], c1, c2, l1, l2, Memr[x], + Memr[overscan], npts) + + } else { + first = l1 + last = l2 + navg = last - first + 1 + npts = nc + call salloc (buf, npts, TY_REAL) + call aclrr (Memr[buf], npts) + do i = first, last + call aaddr (Memr[imgl2r(IN_IM(ccd),i)], Memr[buf], + Memr[buf], npts) + if (navg > 1) + call adivkr (Memr[buf], real (navg), Memr[buf], npts) + + # Trim the overscan vector and set the pixel coordinate. + npts = CCD_C2(ccd) - CCD_C1(ccd) + 1 + call malloc (overscan, npts, TY_REAL) + call salloc (x, npts, TY_REAL) + call trim_overscan (Memr[buf], npts, IN_C1(ccd), Memr[x], + Memr[overscan]) + + call fit_overscan (Memc[str], c1, c2, l1, l2, Memr[x], + Memr[overscan], npts) + } + } + + # Set the CCD structure overscan parameters. + CORS(ccd, OVERSCAN) = O + COR(ccd) = YES + OVERSCAN_TYPE(ccd) = type + OVERSCAN_VEC(ccd) = overscan + + # Log the operation. + if (type < OVERSCAN_FIT) { + call sprintf (Memc[str], SZ_LINE, + "Overscan section is [%d:%d,%d:%d] with function=%s") + call pargi (c1) + call pargi (c2) + call pargi (l1) + call pargi (l2) + call pargstr (Memc[func]) + } else { + call sprintf (Memc[str], SZ_LINE, + "Overscan section is [%d:%d,%d:%d] with mean=%g") + call pargi (c1) + call pargi (c2) + call pargi (l1) + call pargi (l2) + call pargr (asumr (Memr[overscan], npts) / npts) + } + call timelog (Memc[str], SZ_LINE) + call ccdlog (IN_IM(ccd), Memc[str]) + call hdmpstr (OUT_IM(ccd), "overscan", Memc[str]) + + call sfree (sp) +end + + +# FIT_OVERSCAN -- Fit a function to smooth the overscan vector. +# The fitting uses the ICFIT procedures which may be interactive. +# Changes to these parameters are "learned". The user is queried with a four +# valued logical query (XT_ANSWER routine) which may be turned off when +# multiple images are processed. + +procedure fit_overscan (image, c1, c2, l1, l2, x, overscan, npts) + +char image[ARB] # Image name for query and title +int c1, c2, l1, l2 # Overscan strip +real x[npts] # Pixel coordinates of overscan +real overscan[npts] # Input overscan and output fitted overscan +int npts # Number of data points + +int interactive, fd +pointer sp, str, w, ic, cv, gp, gt + +int clgeti(), ic_geti(), open() +real clgetr(), ic_getr() +pointer gopen(), gt_init() +errchk gopen, open + +begin + call smark (sp) + call salloc (str, SZ_LINE, TY_CHAR) + call salloc (w, npts, TY_REAL) + call amovkr (1., Memr[w], npts) + + # Open the ICFIT procedures, get the fitting parameters, and + # set the fitting limits. + + call ic_open (ic) + call clgstr ("function", Memc[str], SZ_LINE) + call ic_pstr (ic, "function", Memc[str]) + call ic_puti (ic, "order", clgeti ("order")) + call clgstr ("sample", Memc[str], SZ_LINE) + call ic_pstr (ic, "sample", Memc[str]) + call ic_puti (ic, "naverage", clgeti ("naverage")) + call ic_puti (ic, "niterate", clgeti ("niterate")) + call ic_putr (ic, "low", clgetr ("low_reject")) + call ic_putr (ic, "high", clgetr ("high_reject")) + call ic_putr (ic, "grow", clgetr ("grow")) + call ic_putr (ic, "xmin", min (x[1], x[npts])) + call ic_putr (ic, "xmax", max (x[1], x[npts])) + call ic_pstr (ic, "xlabel", "Pixel") + call ic_pstr (ic, "ylabel", "Overscan") + + # If the fitting is done interactively set the GTOOLS and GIO + # pointers. Also "learn" the fitting parameters since they may + # be changed when fitting interactively. + + call sprintf (Memc[str], SZ_LINE, + "Fit overscan vector for %s interactively") + call pargstr (image) + call set_interactive (Memc[str], interactive) + if ((interactive == YES) || (interactive == ALWAYSYES)) { + gt = gt_init () + call sprintf (Memc[str], SZ_LINE, + "Overscan vector for %s from section [%d:%d,%d:%d]\n") + call pargstr (image) + call pargi (c1) + call pargi (c2) + call pargi (l1) + call pargi (l2) + call gt_sets (gt, GTTITLE, Memc[str]) + call gt_sets (gt, GTTYPE, "line") + call gt_setr (gt, GTXMIN, x[1]) + call gt_setr (gt, GTXMAX, x[npts]) + call clgstr ("graphics", Memc[str], SZ_FNAME) + gp = gopen (Memc[str], NEW_FILE, STDGRAPH) + + call icg_fit (ic, gp, "cursor", gt, cv, x, overscan, Memr[w], npts) + + call ic_gstr (ic, "function", Memc[str], SZ_LINE) + call clpstr ("function", Memc[str]) + call clputi ("order", ic_geti (ic, "order")) + call ic_gstr (ic, "sample", Memc[str], SZ_LINE) + call clpstr ("sample", Memc[str]) + call clputi ("naverage", ic_geti (ic, "naverage")) + call clputi ("niterate", ic_geti (ic, "niterate")) + call clputr ("low_reject", ic_getr (ic, "low")) + call clputr ("high_reject", ic_getr (ic, "high")) + call clputr ("grow", ic_getr (ic, "grow")) + + call gclose (gp) + call gt_free (gt) + } else + call ic_fit (ic, cv, x, overscan, Memr[w], npts, YES, YES, YES, YES) + + # Make a log of the fit in the plot file if given. + call clgstr ("plotfile", Memc[str], SZ_LINE) + call xt_stripwhite (Memc[str]) + if (Memc[str] != EOS) { + fd = open (Memc[str], APPEND, BINARY_FILE) + gp = gopen ("stdvdm", NEW_FILE, fd) + gt = gt_init () + call sprintf (Memc[str], SZ_LINE, + "Overscan vector for %s from section [%d:%d,%d:%d]\n") + call pargstr (image) + call pargi (c1) + call pargi (c2) + call pargi (l1) + call pargi (l2) + call gt_sets (gt, GTTITLE, Memc[str]) + call gt_sets (gt, GTTYPE, "line") + call gt_setr (gt, GTXMIN, 1.) + call gt_setr (gt, GTXMAX, real (npts)) + call icg_graphr (ic, gp, gt, cv, x, overscan, Memr[w], npts) + call gclose (gp) + call close (fd) + call gt_free (gt) + } + + # Replace the raw overscan vector with the smooth fit. + call cvvector (cv, x, overscan, npts) + + # Finish up. + call ic_closer (ic) + call cvfree (cv) + call sfree (sp) +end + + +# TRIM_OVERSCAN -- Trim the overscan vector. + +procedure trim_overscan (data, npts, start, x, overscan) + +real data[ARB] # Full overscan vector +int npts # Length of trimmed vector +int start # Trim start +real x[npts] # Trimmed pixel coordinates (returned) +real overscan[npts] # Trimmed overscan vector (returned) + +int i, j + +begin + do i = 1, npts { + j = start + i - 1 + x[i] = j + overscan[i] = data[j] + } +end diff --git a/noao/imred/ccdred/src/setproc.x b/noao/imred/ccdred/src/setproc.x new file mode 100644 index 00000000..06c7977b --- /dev/null +++ b/noao/imred/ccdred/src/setproc.x @@ -0,0 +1,77 @@ +include <imhdr.h> +include "ccdred.h" + +# SET_PROC -- Set the processing parameter structure pointer. + +procedure set_proc (in, out, ccd) + +pointer in # Input IMIO pointer +pointer out # Output IMIO pointer +pointer ccd # CCD structure (returned) + +int clgwrd(), clscan(), nscan() +real clgetr() +pointer sp, str + +begin + call smark (sp) + call salloc (str, SZ_LINE, TY_CHAR) + + # Allocate the ccd structure. + call calloc (ccd, LEN_CCD, TY_STRUCT) + + IN_IM(ccd) = in + OUT_IM(ccd) = out + COR(ccd) = NO + CORS(ccd, FIXPIX) = NO + CORS(ccd, OVERSCAN) = NO + CORS(ccd, TRIM) = NO + READAXIS(ccd) = clgwrd ("readaxis",Memc[str],SZ_LINE,"|line|columns|") + MINREPLACE(ccd) = clgetr ("minreplace") + + CALCTYPE(ccd) = TY_REAL + if (clscan ("pixeltype") != EOF) { + call gargwrd (Memc[str], SZ_LINE) + call gargwrd (Memc[str], SZ_LINE) + if (nscan() == 2) { + if (Memc[str] == 'r') + CALCTYPE(ccd) = TY_REAL + else if (Memc[str] == 's') + CALCTYPE(ccd) = TY_SHORT + else + call error (1, "Invalid calculation datatype") + } + } + + call sfree (sp) +end + + +# FREE_PROC -- Free the processing structure pointer. + +procedure free_proc (ccd) + +pointer ccd # CCD structure + +begin + # Unmap calibration images. + if (MASK_IM(ccd) != NULL) + call imunmap (MASK_IM(ccd)) + if (ZERO_IM(ccd) != NULL) + call ccd_unmap (ZERO_IM(ccd)) + if (DARK_IM(ccd) != NULL) + call ccd_unmap (DARK_IM(ccd)) + if (FLAT_IM(ccd) != NULL) + call ccd_unmap (FLAT_IM(ccd)) + if (ILLUM_IM(ccd) != NULL) + call ccd_unmap (ILLUM_IM(ccd)) + if (FRINGE_IM(ccd) != NULL) + call ccd_unmap (FRINGE_IM(ccd)) + + # Free memory + if (OVERSCAN_VEC(ccd) != NULL) + call mfree (OVERSCAN_VEC(ccd), TY_REAL) + if (MASK_FP(ccd) != NULL) + call xt_fpfree (MASK_FP(ccd)) + call mfree (ccd, TY_STRUCT) +end diff --git a/noao/imred/ccdred/src/setsections.x b/noao/imred/ccdred/src/setsections.x new file mode 100644 index 00000000..80e61e49 --- /dev/null +++ b/noao/imred/ccdred/src/setsections.x @@ -0,0 +1,113 @@ +include <imhdr.h> +include <mwset.h> +include "ccdred.h" + +# SET_SECTIONS -- Set the data section, ccd section, trim section and +# bias section. Also set the WCS. + +procedure set_sections (ccd) + +pointer ccd # CCD structure (returned) + +pointer sp, str, mw, lterm, mw_openim() +int nc, nl, c1, c2, cs, l1, l2, ls, ndim, mw_stati() +bool streq() + +begin + call smark (sp) + call salloc (str, SZ_LINE, TY_CHAR) + + nc = IM_LEN(IN_IM(ccd),1) + nl = IM_LEN(IN_IM(ccd),2) + + # The default data section is the entire image. + c1 = 1 + c2 = nc + cs = 1 + l1 = 1 + l2 = nl + ls = 1 + call hdmgstr (IN_IM(ccd), "datasec", Memc[str], SZ_LINE) + call ccd_section (Memc[str], c1, c2, cs, l1, l2, ls) + if ((c1<1)||(c2>nc)||(l1<1)||(l2>nl)||(cs!=1)||(ls!=1)) + call error (0, "Error in DATASEC parameter") + IN_C1(ccd) = c1 + IN_C2(ccd) = c2 + IN_L1(ccd) = l1 + IN_L2(ccd) = l2 + + # The default trim section is the data section. + # Defer limit checking until actually used. + c1 = IN_C1(ccd) + c2 = IN_C2(ccd) + l1 = IN_L1(ccd) + l2 = IN_L2(ccd) + call clgstr ("trimsec", Memc[str], SZ_LINE) + if (streq (Memc[str], "image")) + call hdmgstr (IN_IM(ccd), "trimsec", Memc[str], SZ_LINE) + call ccd_section (Memc[str], c1, c2, cs, l1, l2, ls) + if ((cs!=1)||(ls!=1)) + call error (0, "Error in TRIMSEC parameter") + TRIM_C1(ccd) = c1 + TRIM_C2(ccd) = c2 + TRIM_L1(ccd) = l1 + TRIM_L2(ccd) = l2 + + # The default bias section is the whole image. + # Defer limit checking until actually used. + c1 = 1 + c2 = nc + l1 = 1 + l2 = nl + call clgstr ("biassec", Memc[str], SZ_LINE) + if (streq (Memc[str], "image")) + call hdmgstr (IN_IM(ccd), "biassec", Memc[str], SZ_LINE) + call ccd_section (Memc[str], c1, c2, cs, l1, l2, ls) + if ((cs!=1)||(ls!=1)) + call error (0, "Error in BIASSEC parameter") + BIAS_C1(ccd) = c1 + BIAS_C2(ccd) = c2 + BIAS_L1(ccd) = l1 + BIAS_L2(ccd) = l2 + + # The default ccd section is the size of the data section. + c1 = 1 + c2 = IN_C2(ccd) - IN_C1(ccd) + 1 + l1 = 1 + l2 = IN_L2(ccd) - IN_L1(ccd) + 1 + call hdmgstr (IN_IM(ccd), "ccdsec", Memc[str], SZ_LINE) + call ccd_section (Memc[str], c1, c2, cs, l1, l2, ls) + if ((cs != 1) || (ls != 1)) + call error (0, "Error in CCDSEC parameter") + CCD_C1(ccd) = c1 + CCD_C2(ccd) = c2 + CCD_L1(ccd) = l1 + CCD_L2(ccd) = l2 + if ((IN_C2(ccd)-IN_C1(ccd) != CCD_C2(ccd)-CCD_C1(ccd)) || + (IN_L2(ccd)-IN_L1(ccd) != CCD_L2(ccd)-CCD_L1(ccd))) + call error (0, "Size of DATASEC and CCDSEC do not agree") + + # The default output data section is the input data section. + OUT_C1(ccd) = IN_C1(ccd) + OUT_C2(ccd) = IN_C2(ccd) + OUT_L1(ccd) = IN_L1(ccd) + OUT_L2(ccd) = IN_L2(ccd) + + # Set the physical WCS to be CCD coordinates. + mw = mw_openim (IN_IM(ccd)) + ndim = mw_stati (mw, MW_NPHYSDIM) + call salloc (lterm, ndim * (1 + ndim), TY_REAL) + call mw_gltermr (mw, Memr[lterm+ndim], Memr[lterm], ndim) + Memr[lterm] = IN_C1(ccd) - CCD_C1(ccd) + Memr[lterm+1] = IN_L1(ccd) - CCD_L1(ccd) + Memr[lterm+ndim] = 1. / cs + Memr[lterm+ndim+1] = 0. + Memr[lterm+ndim+ndim] = 0. + Memr[lterm+ndim+ndim+1] = 1. / ls + call mw_sltermr (mw, Memr[lterm+ndim], Memr[lterm], ndim) + call mw_saveim (mw, IN_IM(ccd)) + call mw_saveim (mw, OUT_IM(ccd)) + call mw_close (mw) + + call sfree (sp) +end diff --git a/noao/imred/ccdred/src/settrim.x b/noao/imred/ccdred/src/settrim.x new file mode 100644 index 00000000..65d5d09c --- /dev/null +++ b/noao/imred/ccdred/src/settrim.x @@ -0,0 +1,99 @@ +include <imhdr.h> +include <imset.h> +include "ccdred.h" + +# SET_TRIM -- Set the trim parameters. +# +# 1. Return immediately if the trim correction is not requested or +# if the image has been previously corrected. +# 2. Determine the trim section. This may be specifed directly or +# indirectly through the image header or symbol table. +# 3. Parse the trim section and apply it to the output image. +# 4. If the image is trimmed then log the operation and reset the output +# image size. + +procedure set_trim (ccd) + +pointer ccd # CCD structure + +int xt1, xt2, yt1, yt2 +int nc, nl, c1, c2, l1, l2 +pointer sp, str, image +bool clgetb(), ccdflag() + +begin + # Check if the user wants this operation or it has been done. + if (!clgetb ("trim") || ccdflag (IN_IM(ccd), "trim")) + return + + # Check trim section. + nc = IM_LEN(IN_IM(ccd),1) + nl = IM_LEN(IN_IM(ccd),2) + c1 = TRIM_C1(ccd) + c2 = TRIM_C2(ccd) + l1 = TRIM_L1(ccd) + l2 = TRIM_L2(ccd) + if ((c1 < 1) || (c2 > nc) || (l1 < 1) || (l2 > nl)) { + call smark (sp) + call salloc (str, SZ_LINE, TY_CHAR) + call salloc (image, SZ_LINE, TY_CHAR) + call imstats (IN_IM(ccd), IM_IMAGENAME, Memc[image], SZ_FNAME) + call sprintf (Memc[str], SZ_LINE, + "Error in trim section: image=%s[%d,%d], trimsec=[%d:%d,%d:%d]") + call pargstr (Memc[image]) + call pargi (nc) + call pargi (nl) + call pargi (c1) + call pargi (c2) + call pargi (l1) + call pargi (l2) + call error (0, Memc[str]) + } + + # If no processing is desired print trim section and return. + if (clgetb ("noproc")) { + call eprintf (" [TO BE DONE] Trim section is [%d:%d,%d:%d].\n") + call pargi (c1) + call pargi (c2) + call pargi (l1) + call pargi (l2) + return + } + + call smark (sp) + call salloc (str, SZ_LINE, TY_CHAR) + + xt1 = max (0, c1 - IN_C1(ccd)) + xt2 = min (0, c2 - IN_C2(ccd)) + yt1 = max (0, l1 - IN_L1(ccd)) + yt2 = min (0, l2 - IN_L2(ccd)) + + CCD_C1(ccd) = CCD_C1(ccd) + xt1 + CCD_C2(ccd) = CCD_C2(ccd) + xt2 + CCD_L1(ccd) = CCD_L1(ccd) + yt1 + CCD_L2(ccd) = CCD_L2(ccd) + yt2 + IN_C1(ccd) = IN_C1(ccd) + xt1 + IN_C2(ccd) = IN_C2(ccd) + xt2 + IN_L1(ccd) = IN_L1(ccd) + yt1 + IN_L2(ccd) = IN_L2(ccd) + yt2 + OUT_C1(ccd) = IN_C1(ccd) - c1 + 1 + OUT_C2(ccd) = IN_C2(ccd) - c1 + 1 + OUT_L1(ccd) = IN_L1(ccd) - l1 + 1 + OUT_L2(ccd) = IN_L2(ccd) - l1 + 1 + IM_LEN(OUT_IM(ccd),1) = c2 - c1 + 1 + IM_LEN(OUT_IM(ccd),2) = l2 - l1 + 1 + + CORS(ccd, TRIM) = YES + COR(ccd) = YES + + call sprintf (Memc[str], SZ_LINE, "Trim data section is [%d:%d,%d:%d]") + call pargi (c1) + call pargi (c2) + call pargi (l1) + call pargi (l2) + call timelog (Memc[str], SZ_LINE) + call ccdlog (IN_IM(ccd), Memc[str]) + call hdmpstr (OUT_IM(ccd), "trim", Memc[str]) + + call sfree (sp) +end diff --git a/noao/imred/ccdred/src/setzero.x b/noao/imred/ccdred/src/setzero.x new file mode 100644 index 00000000..610aeee7 --- /dev/null +++ b/noao/imred/ccdred/src/setzero.x @@ -0,0 +1,141 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> +include "ccdred.h" +include "ccdtypes.h" + +# SET_ZERO -- Set parameters for zero level correction. +# 1. Return immediately if the zero level correction is not requested or +# if the image has been previously corrected. +# 2. Get the zero level correction image. Return an error if not found. +# 3. If the zero level image has not been processed call ZEROPROC. +# 4. Set the processing flag. +# 5. Log the operation (to user, logfile, and output image header). + +procedure set_zero (ccd) + +pointer ccd # CCD structure + +int nscan, nc, nl, c1, c2, cs, l1, l2, ls, data_c1, ccd_c1, data_l1, ccd_l1 +pointer sp, str, image, im, ccd_cache() +bool clgetb(), ccdflag(), ccdcheck() +int ccdtypei(), ccdnscan() +errchk cal_image, ccd_cache, ccdproc + +begin + # Check if the user wants this operation or it has been done. + if (!clgetb ("zerocor") || ccdflag (IN_IM(ccd), "zerocor")) + return + + call smark (sp) + call salloc (image, SZ_FNAME, TY_CHAR) + call salloc (str, SZ_LINE, TY_CHAR) + + # Get the zero level correction image. + if (clgetb ("scancor")) + nscan = ccdnscan (IN_IM(ccd), ccdtypei(IN_IM(ccd))) + else + nscan = 1 + call cal_image (IN_IM(ccd), ZERO, nscan, Memc[image], SZ_FNAME) + + # If no processing is desired print zero correction image and return. + if (clgetb ("noproc")) { + call eprintf (" [TO BE DONE] Zero level correction image is %s.\n") + call pargstr (Memc[image]) + call sfree (sp) + return + } + + # Map the image and return on an error. + # Process the zero image if necessary. + # If nscan > 1 then the zero may not yet exist so create it + # from the unscanned zero. + + iferr (im = ccd_cache (Memc[image], ZERO)) { + call cal_image (IN_IM(ccd), ZERO, 1, Memc[str], SZ_LINE) + im = ccd_cache (Memc[str], ZERO) + if (ccdcheck (im, ZERO)) { + call ccd_flush (im) + call ccdproc (Memc[str], ZERO) + } + call scancor (Memc[str], Memc[image], nscan, INDEF) + im = ccd_cache (Memc[image], ZERO) + } + + if (ccdcheck (im, ZERO)) { + call ccd_flush (im) + call ccdproc (Memc[image], ZERO) + im = ccd_cache (Memc[image], ZERO) + } + + # Set the processing parameters in the CCD structure. + nc = IM_LEN(im,1) + nl = IM_LEN(im,2) + c1 = 1 + c2 = nc + l1 = 1 + l2 = nl + cs = 1 + ls = 1 + call hdmgstr (im, "datasec", Memc[str], SZ_FNAME) + call ccd_section (Memc[str], c1, c2, cs, l1, l2, ls) + if ((c1<1)||(c2>nc)||(l1<1)||(l2>nl)||(cs!=1)||(ls!=1)) { + call sprintf (Memc[str], SZ_LINE, + "Data section error: image=%s[%d,%d], datasec=[%d:%d,%d:%d]") + call pargstr (Memc[image]) + call pargi (nc) + call pargi (nl) + call pargi (c1) + call pargi (c2) + call pargi (l1) + call pargi (l2) + call error (0, Memc[str]) + } + data_c1 = c1 + data_l1 = l1 + call hdmgstr (im, "ccdsec", Memc[str], SZ_FNAME) + call ccd_section (Memc[str], c1, c2, cs, l1, l2, ls) + if (nc == 1) { + c1 = CCD_C1(ccd) + c2 = CCD_C2(ccd) + } + if (nl == 1) { + l1 = CCD_L1(ccd) + l2 = CCD_L2(ccd) + } + ccd_c1 = c1 + ccd_l1 = l1 + if ((c1 > CCD_C1(ccd)) || (c2 < CCD_C2(ccd)) || + (l1 > CCD_L1(ccd)) || (l2 < CCD_L2(ccd))) { + call sprintf (Memc[str], SZ_LINE, + "CCD section error: input=[%d:%d,%d:%d], %s=[%d:%d,%d:%d]") + call pargi (CCD_C1(ccd)) + call pargi (CCD_C2(ccd)) + call pargi (CCD_L1(ccd)) + call pargi (CCD_L2(ccd)) + call pargstr (Memc[image]) + call pargi (c1) + call pargi (c2) + call pargi (l1) + call pargi (l2) + call error (0, Memc[str]) + } + + ZERO_IM(ccd) = im + ZERO_C1(ccd) = CCD_C1(ccd) - ccd_c1 + data_c1 + ZERO_C2(ccd) = CCD_C2(ccd) - ccd_c1 + data_c1 + ZERO_L1(ccd) = CCD_L1(ccd) - ccd_l1 + data_l1 + ZERO_L2(ccd) = CCD_L2(ccd) - ccd_l1 + data_l1 + + CORS(ccd, ZEROCOR) = Z + COR(ccd) = YES + + # Log the operation. + call sprintf (Memc[str], SZ_LINE, "Zero level correction image is %s") + call pargstr (Memc[image]) + call timelog (Memc[str], SZ_LINE) + call ccdlog (IN_IM(ccd), Memc[str]) + call hdmpstr (OUT_IM(ccd), "zerocor", Memc[str]) + + call sfree (sp) +end diff --git a/noao/imred/ccdred/src/sigma.gx b/noao/imred/ccdred/src/sigma.gx new file mode 100644 index 00000000..8b59f1f6 --- /dev/null +++ b/noao/imred/ccdred/src/sigma.gx @@ -0,0 +1,89 @@ +$for (sr) +# SIGMA -- Compute sigma line from image lines with rejection. + +procedure sigma$t (data, nimages, mean, sigma, npts) + +pointer data[nimages] # Data vectors +int nimages # Number of data vectors +$if (datatype == sil) +real mean[npts] # Mean vector +real sigma[npts] # Sigma vector (returned) +$else +PIXEL mean[npts] # Mean vector +PIXEL sigma[npts] # Sigma vector (returned) +$endif +int npts # Number of points in each vector + +$if (datatype == sil) +real val, sig, pixval +$else +PIXEL val, sig, pixval +$endif +int i, j, n, n1 + +begin + n = nimages - 1 + do i = 1, npts { + val = mean[i] + sig = 0. + n1 = n + do j = 1, nimages { + pixval = Mem$t[data[j]+i-1] + if (IS_INDEF (pixval)) + n1 = n1 - 1 + else + sig = sig + (pixval - val) ** 2 + } + if (n1 > 0) + sigma[i] = sqrt (sig / n1) + else + sigma[i] = 0. + } +end + + +# WTSIGMA -- Compute scaled and weighted sigma line from image lines with +# rejection. + +procedure wtsigma$t (data, scales, zeros, wts, nimages, mean, sigma, npts) + +pointer data[nimages] # Data vectors +real scales[nimages] # Scale factors +real zeros[nimages] # Zero levels +real wts[nimages] # Weights +int nimages # Number of data vectors +$if (datatype == sil) +real mean[npts] # Mean vector +real sigma[npts] # Sigma vector (returned) +real val, sig, pixval +$else +PIXEL mean[npts] # Mean vector +PIXEL sigma[npts] # Sigma vector (returned) +PIXEL val, sig, pixval +$endif +int npts # Number of points in each vector + +int i, j, n +real sumwts + +begin + do i = 1, npts { + val = mean[i] + n = 0 + sig = 0. + sumwts = 0. + do j = 1, nimages { + pixval = Mem$t[data[j]+i-1] + if (!IS_INDEF (pixval)) { + n = n + 1 + sig = sig + wts[j]*(pixval/scales[j]-zeros[j]-val) ** 2 + sumwts = sumwts + wts[j] + } + } + if (n > 1) + sigma[i] = sqrt (sig / sumwts * n / (n - 1)) + else + sigma[i] = 0. + } +end +$endfor diff --git a/noao/imred/ccdred/src/t_badpixim.x b/noao/imred/ccdred/src/t_badpixim.x new file mode 100644 index 00000000..3a44dfa0 --- /dev/null +++ b/noao/imred/ccdred/src/t_badpixim.x @@ -0,0 +1,114 @@ +include <imhdr.h> + +# T_BADPIXIMAGE -- Create a bad pixel image mask from a bad pixel file. + +procedure t_badpiximage () + +pointer bpfile # Bad pixel file +pointer bpimage # Bad pixel image +pointer template # Template image +short goodval, badval # Good and bad values + +int i, nc, nl, c1, c2, l1, l2, fd, x1, x2, xstep, y1, y2, ystep +pointer sp, str, im, im1 + +short clgets() +bool ccdflag() +pointer immap(), impl2s(), imps2s() +int open(), fscan(), nscan(), stridxs(), strmatch() +errchk open, immap + +begin + call smark (sp) + call salloc (bpfile, SZ_FNAME, TY_CHAR) + call salloc (bpimage, SZ_FNAME, TY_CHAR) + call salloc (template, SZ_FNAME, TY_CHAR) + call salloc (str, SZ_LINE, TY_CHAR) + + # Get task parameters. + call clgstr ("fixfile", Memc[bpfile], SZ_FNAME) + call clgstr ("template", Memc[template], SZ_FNAME) + call clgstr ("image", Memc[bpimage], SZ_FNAME) + goodval = clgets ("goodvalue") + badval = clgets ("badvalue") + + # Open the files and abort on an error. + fd = open (Memc[bpfile], READ_ONLY, TEXT_FILE) + im1 = immap (Memc[template], READ_ONLY, 0) + im = immap (Memc[bpimage], NEW_COPY, im1) + + # Set the output image. + IM_PIXTYPE(im) = TY_SHORT + call sprintf (IM_TITLE(im), SZ_IMTITLE, + "Bad pixel image from bad pixel file %s") + call pargstr (Memc[bpfile]) + + # Set the good pixel values. + nc = IM_LEN(im,1) + nl = IM_LEN(im,2) + do i = 1, nl + call amovks (goodval, Mems[impl2s(im,i)], nc) + + # Set the bad pixel values. By default the bad pixel coordinates + # refer to the image directly but if the word "untrimmed" appears + # in a comment then the coordinates refer to the untrimmed image. + # This is the same algorithm as used in SETFIXPIX for CCDPROC. + + x1 = 1 + xstep = 1 + y1 = 1 + ystep = 1 + while (fscan (fd) != EOF) { + call gargwrd (Memc[str], SZ_LINE) + if (Memc[str] == '#') { + call gargstr (Memc[str], SZ_LINE) + if (strmatch (Memc[str], "{untrimmed}") != 0) { + if (ccdflag (im, "trim")) { + call hdmgstr (im, "trim", Memc[str], SZ_LINE) + x2 = stridxs ("[", Memc[str]) + if (x2 != 0) { + x1 = 1 + x2 = IM_LEN(im,1) + xstep = 1 + y1 = 1 + y2 = IM_LEN(im,2) + ystep = 1 + call ccd_section (Memc[str+x2-1], x1, x2, xstep, + y1, y2, ystep) + } + } + } + next + } + + call reset_scan() + 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 - x1 + xstep - 1) / xstep + 1) + c2 = min (nc, (c2 - x1) / xstep + 1) + l1 = max (1, (l1 - y1 + ystep - 1) / ystep + 1) + l2 = min (nl, (l2 - y1) / ystep + 1) + + if ((c1 > c2) || (l1 > l2)) + next + + i = (c2 - c1 + 1) * (l2 - l1 + 1) + call amovks (badval, Mems[imps2s(im,c1,c2,l1,l2)], i) + } + + # Finish up. + call imunmap (im) + call imunmap (im1) + call close (fd) +end diff --git a/noao/imred/ccdred/src/t_ccdgroups.x b/noao/imred/ccdred/src/t_ccdgroups.x new file mode 100644 index 00000000..225589e5 --- /dev/null +++ b/noao/imred/ccdred/src/t_ccdgroups.x @@ -0,0 +1,258 @@ +include <error.h> +include <math.h> + +# Group type definitions. +define GROUPS "|position|title|date|ccdtype|subset|" +define POSITION 1 # Group by position +define TITLE 2 # Group by title +define DATE 3 # Group by date +define CCDTYPE 4 # Group by ccdtype +define SUBSET 5 # Group by subset + +define NALLOC 10 # Allocate memory in this size block + +# T_CCDGROUPS -- Group images into files based on parameters with common values. +# The output consists of files containing the image names of images from the +# input image list which have the same group type such as position, date, +# or title. + +procedure t_ccdgroups () + +int images # List of images +pointer root # Output group root name +int group # Group type +real radius # Position radius +bool verbose # Verbose output (package parameter) + +int ngroup, fd, ntitles, npositions, ndates, ccdtype +pointer im, sp, image, output, suffix, titles, positions, dates + +bool clgetb() +real clgetr() +int position_group(), title_group(), date_group() +int imtopenp(), imtgetim(), open(), clgwrd() +errchk set_input, position_group, title_group, date_group, open + +begin + call smark (sp) + call salloc (image, SZ_FNAME, TY_CHAR) + call salloc (root, SZ_FNAME, TY_CHAR) + call salloc (output, SZ_FNAME, TY_CHAR) + call salloc (suffix, SZ_FNAME, TY_CHAR) + + # Get the task parameters. + images = imtopenp ("images") + call clgstr ("output", Memc[root], SZ_FNAME) + group = clgwrd ("group", Memc[image], SZ_FNAME, GROUPS) + radius = clgetr ("radius") + call clgstr ("instrument", Memc[image], SZ_FNAME) + if (Memc[image] == EOS) + call error (1, "No 'instrument' translation file specified.") + call hdmopen (Memc[image]) + verbose = clgetb ("verbose") + + # Loop through the images and place them into groups. + positions = NULL + npositions = 0 + titles = NULL + ntitles = 0 + dates = NULL + ndates = 0 + while (imtgetim (images, Memc[image], SZ_FNAME) != EOF) { + call set_input (Memc[image], im, ccdtype) + if (im == NULL) + next + + iferr { + switch (group) { + case POSITION: + ngroup = position_group (im, positions, npositions, radius) + case TITLE: + ngroup = title_group (im, titles, ntitles) + case DATE: + ngroup = date_group (im, dates, ndates) + } + + # Define the output group file. + switch (group) { + case POSITION, TITLE, DATE: + call sprintf (Memc[output], SZ_FNAME, "%s%d") + call pargstr (Memc[root]) + call pargi (ngroup) + case CCDTYPE: + call ccdtypes (im, Memc[suffix], SZ_FNAME) + call sprintf (Memc[output], SZ_FNAME, "%s%d") + call pargstr (Memc[root]) + call pargstr (Memc[suffix]) + case SUBSET: + call ccdsubset (im, Memc[suffix], SZ_FNAME) + call sprintf (Memc[output], SZ_FNAME, "%s%d") + call pargstr (Memc[root]) + call pargstr (Memc[suffix]) + } + + # Print the operation if verbose. + if (verbose) { + call printf ("%s --> %s\n") + call pargstr (Memc[image]) + call pargstr (Memc[output]) + } + + # Enter the image in the appropriate group file. + fd = open (Memc[output], APPEND, TEXT_FILE) + call fprintf (fd, "%s\n") + call pargstr (Memc[image]) + call close (fd) + } then + call erract (EA_WARN) + + call imunmap (im) + } + + # Finish up. + call imtclose (images) + if (positions != NULL) + call mfree (positions, TY_REAL) + if (titles != NULL) + call mfree (titles, TY_CHAR) + if (dates != NULL) + call mfree (dates, TY_CHAR) + call sfree (sp) +end + + +# TITLE_GROUP -- Group images by title. + +int procedure title_group (im, titles, ntitles) + +pointer im # Image +pointer titles # Pointer to title strings +int ntitles # Number of titles + +int i, nalloc +pointer sp, title, ptr +bool streq() +errchk hdmgstr + +begin + call smark (sp) + call salloc (title, SZ_LINE, TY_CHAR) + call hdmgstr (im, "title", Memc[title], SZ_LINE) + + for (i=1; i<=ntitles; i=i+1) { + ptr = titles + (i - 1) * SZ_LINE + if (streq (Memc[title], Memc[ptr])) + break + } + if (i > ntitles) { + if (i == 1) { + nalloc = NALLOC + call malloc (titles, nalloc * SZ_LINE, TY_CHAR) + } else if (i > nalloc) { + nalloc = nalloc + NALLOC + call realloc (titles, nalloc * SZ_LINE, TY_CHAR) + } + ptr = titles + (i - 1) * SZ_LINE + call strcpy (Memc[title], Memc[ptr], SZ_LINE-1) + ntitles = i + } + + call sfree (sp) + return (i) +end + + +# POSITION_GROUP -- Group by RA and DEC position. The RA is in hours and +# the DEC is in degrees. The radius is in seconds of arc. + +int procedure position_group (im, positions, npositions, radius) + +pointer im # Image +pointer positions # Positions +int npositions # Number of positions +real radius # Matching radius + +real ra, dec, dra, ddec, r, hdmgetr() +int i, nalloc +pointer ptr +errchk hdmgetr + +begin + ra = hdmgetr (im, "ra") + dec = hdmgetr (im, "dec") + + for (i=1; i<=npositions; i=i+1) { + ptr = positions + 2 * i - 2 + dra = ra - Memr[ptr] + ddec = dec - Memr[ptr+1] + if (dra > 12.) + dra = dra - 24. + if (dra < -12.) + dra = dra + 24. + dra = dra * cos (DEGTORAD (dec)) * 15. + r = sqrt (dra ** 2 + ddec ** 2) * 3600. + if (r < radius) + break + } + if (i > npositions) { + if (i == 1) { + nalloc = NALLOC + call malloc (positions, nalloc * 2, TY_REAL) + } else if (i > nalloc) { + nalloc = nalloc + NALLOC + call realloc (positions, nalloc * 2, TY_REAL) + } + ptr = positions + 2 * i - 2 + Memr[ptr] = ra + Memr[ptr+1] = dec + npositions = i + } + + return (i) +end + + +# DATE_GROUP -- Group by date. + +int procedure date_group (im, dates, ndates) + +pointer im # Image +pointer dates # Pointer to date strings +int ndates # Number of dates + +int i, nalloc, stridxs() +pointer sp, date, ptr +bool streq() +errchk hdmgstr + +begin + call smark (sp) + call salloc (date, SZ_LINE, TY_CHAR) + call hdmgstr (im, "date-obs", Memc[date], SZ_LINE) + + # Strip time if present. + i = stridxs ("T", Memc[date]) + if (i > 0) + Memc[date+i-1] = EOS + + for (i=1; i<=ndates; i=i+1) { + ptr = dates + (i - 1) * SZ_LINE + if (streq (Memc[date], Memc[ptr])) + break + } + if (i > ndates) { + if (i == 1) { + nalloc = NALLOC + call malloc (dates, nalloc * SZ_LINE, TY_CHAR) + } else if (i > nalloc) { + nalloc = nalloc + NALLOC + call realloc (dates, nalloc * SZ_LINE, TY_CHAR) + } + ptr = dates + (i - 1) * SZ_LINE + call strcpy (Memc[date], Memc[ptr], SZ_LINE-1) + ndates = i + } + + call sfree (sp) + return (i) +end diff --git a/noao/imred/ccdred/src/t_ccdhedit.x b/noao/imred/ccdred/src/t_ccdhedit.x new file mode 100644 index 00000000..a7fd9121 --- /dev/null +++ b/noao/imred/ccdred/src/t_ccdhedit.x @@ -0,0 +1,87 @@ +include <error.h> + +define TYPES "|string|real|integer|" +define SVAL 1 # String value +define RVAL 2 # Real value +define IVAL 3 # Integer value + +# T_CCDHEDIT -- Add, delete, or change CCD image header parameters. +# This task differs from HEDIT in that it uses the CCD instrument translation +# file. + +procedure t_ccdhedit () + +int list # List of CCD images +pointer param # Parameter name +int type # Parameter type +pointer sval # Parameter value +pointer instrument # Instrument file + +int ip, ival, imtopenp(), imtgetim(), clgwrd(), ctoi(), ctor() +real rval +bool streq() +pointer sp, im, immap() +errchk hdmpstr, hdmputr, hdmputi + +begin + call smark (sp) + call salloc (param, SZ_LINE, TY_CHAR) + call salloc (sval, SZ_LINE, TY_CHAR) + call salloc (instrument, SZ_FNAME, TY_CHAR) + + # Get the task parameters. + list = imtopenp ("images") + call clgstr ("parameter", Memc[param], SZ_LINE) + type = clgwrd ("type", Memc[sval], SZ_LINE, TYPES) + call clgstr ("value", Memc[sval], SZ_LINE) + call clgstr ("instrument", Memc[instrument], SZ_FNAME) + call xt_stripwhite (Memc[sval]) + + # Open the instrument translation file. + call hdmopen (Memc[instrument]) + + # If the parameter is IMAGETYP then change the parameter value from + # the package form to the image form using the inverse mapping in the + # translation file. + + if (streq (Memc[param], "imagetyp")) + call hdmparm (Memc[sval], Memc[sval], SZ_LINE) + + # Edit each image in the input list. + while (imtgetim (list, Memc[instrument], SZ_FNAME) != EOF) { + iferr (im = immap (Memc[instrument], READ_WRITE, 0)) { + call erract (EA_WARN) + next + } + + # If the parameter value is null then delete the entry. + if (Memc[sval] == EOS) { + iferr (call hdmdelf (im, Memc[param])) + call erract (EA_WARN) + + # Otherwise add the parameter of the specified type. + } else { + switch (type) { + case SVAL: + call hdmpstr (im, Memc[param], Memc[sval]) + case RVAL: + ip = 1 + if (ctor (Memc[sval], ip, rval) == 0) + call error (0, "Parameter value is not a number") + call hdmputr (im, Memc[param], rval) + case IVAL: + ip = 1 + if (ctoi (Memc[sval], ip, ival) == 0) + call error (0, "Parameter value is not a number") + call hdmputi (im, Memc[param], ival) + } + } + + call imunmap (im) + } + + # Finish up. + call hdmclose () + call imtclose (list) + call sfree (sp) +end diff --git a/noao/imred/ccdred/src/t_ccdinst.x b/noao/imred/ccdred/src/t_ccdinst.x new file mode 100644 index 00000000..e98763fd --- /dev/null +++ b/noao/imred/ccdred/src/t_ccdinst.x @@ -0,0 +1,667 @@ +include <imhdr.h> +include <imio.h> +include <error.h> +include "ccdtypes.h" + +define HELP1 "noao$imred/ccdred/src/ccdinst1.key" +define HELP2 "noao$imred/ccdred/src/ccdinst2.key" +define HELP3 "noao$imred/ccdred/src/ccdinst3.key" + +define LEVELS "|basic|common|all|" + +define CMDS "|quit|?|help|show|instrument|imheader|read|write|newimage\ + |translate|imagetyp|subset|exptime|darktime|fixfile|biassec\ + |ccdsec|datasec|trimsec|darkcor|fixpix|flatcor|fringcor\ + |illumcor|overscan|readcor|scancor|trim|zerocor|ccdmean\ + |fringscl|illumflt|mkfringe|mkillum|skyflat|ncombine\ + |date-obs|dec|ra|title|next|nscanrow|" + +define QUIT 1 # Quit +define QUESTION 2 # Help +define HELP 3 # Help +define SHOW 4 # Show current translations +define INST 5 # Show instrument file +define IMHEADER 6 # Print image header +define READ 7 # Read instrument file +define WRITE 8 # Write instrument file +define NEWIMAGE 9 # Change image +define TRANSLATE 10 # Translate image type +define IMAGETYPE 11 # Image type +define SUBSET 12 # Subset parameter +define EXPTIME 13 # Exposure time +define DARKTIME 14 # Dark time +define FIXFILE 15 # Bad pixel file +define BIASSEC 16 # Bias section +define CCDSEC 17 # CCD section +define DATASEC 18 # Data section +define TRIMSEC 19 # Trim section +define DARKCOR 20 # Dark count flag +define FIXPIX 21 # Bad pixel flag +define FLATCOR 22 # Flat field flag +define FRINGCOR 23 # Fringe flag +define ILLUMCOR 24 # Illumination flag +define OVERSCAN 25 # Overscan flag +define READCOR 26 # Readout flag +define SCANCOR 27 # Scan mode flag +define NSCANROW 42 # Number of scan rows +define TRIM 28 # Trim flag +define ZEROCOR 29 # Zero level flag +define CCDMEAN 30 # CCD mean value +define FRINGSCL 31 # Fringe scale value +define ILLUMFLT 32 # Illumination flat flag +define MKFRINGE 33 # Illumination flag +define MKILLUM 34 # Illumination flag +define SKYFLAT 35 # Sky flat flag +define NCOMBINE 36 # NCOMBINE parameter +define DATEOBS 37 # Date +define DEC 38 # Dec +define RA 39 # RA +define TITLE 40 # Title +define NEXT 41 # Next image + +# T_CCDINST -- Check and modify instrument translations + +procedure t_ccdinst () + +int list, level, ncmd, imtopenp(), imtgetim(), scan(), access(), clgwrd() +pointer sp, image, inst, ssfile, im, immap() +bool update, clgetb() +errchk delete, hdmwrite + +begin + call smark (sp) + call salloc (image, SZ_FNAME, TY_CHAR) + call salloc (inst, SZ_FNAME, TY_CHAR) + call salloc (ssfile, SZ_FNAME, TY_CHAR) + + # Get the task parameters, open the translation file, set defaults. + list = imtopenp ("images") + call clgstr ("instrument", Memc[inst], SZ_FNAME) + call clgstr ("ssfile", Memc[ssfile], SZ_FNAME) + level = clgwrd ("parameters", Memc[image], SZ_FNAME, LEVELS) + if (Memc[image] == EOS) + call error (1, "No 'parameters' file value specified.") + call hdmopen (Memc[inst]) + ncmd = NEXT + update = false + + # Process each image. + while (imtgetim (list, Memc[image], SZ_FNAME) != EOF) { + iferr (im = immap (Memc[image], READ_ONLY, 0)) { + call erract (EA_WARN) + next + } + + if (clgetb ("edit")) + call ccdinst_edit (im, Memc[image], Memc[inst], Memc[ssfile], + level, ncmd, update) + else + call ccdinst_hdr (im, Memc[image], Memc[inst], Memc[ssfile], + level) + call imunmap (im) + if (ncmd == QUIT) + break + } + + # Update instrument file if necessary. + if (update) { + call printf ("Update instrument file %s (%b)? ") + call pargstr (Memc[inst]) + call pargb (update) + call flush (STDOUT) + if (scan() != EOF) + call gargb (update) + if (update) { + iferr { + if (access (Memc[inst], 0, 0) == YES) + call delete (Memc[inst]) + call hdmwrite (Memc[inst], NEW_FILE) + } then + call erract (EA_WARN) + } + } + + # Finish up. + call hdmclose () + call imtclose (list) + call sfree (sp) +end + + +# CCDINST_EDIT -- Main instrument file editor loop. +# This returns the last command (quit or next) and the update flag. +# The image name may also be changed. + +procedure ccdinst_edit (im, image, inst, ssfile, level, ncmd, update) + +pointer im # Image pointer +char image[SZ_FNAME] # Image name +char inst[SZ_FNAME] # Instrument file +char ssfile[SZ_FNAME] # Subset file +int level # Parameter level +int ncmd # Last command +bool update # Update? + +bool strne() +int scan(), nscan(), strdic(), access() +pointer sp, cmd, key, def, imval, im1, immap() +errchk delete, hdmwrite + +begin + call smark (sp) + call salloc (cmd, SZ_LINE, TY_CHAR) + call salloc (key, SZ_FNAME, TY_CHAR) + call salloc (def, SZ_LINE, TY_CHAR) + call salloc (imval, SZ_LINE, TY_CHAR) + + call sscan ("show") + repeat { + call gargwrd (Memc[cmd], SZ_LINE) + ncmd = strdic (Memc[cmd], Memc[cmd], SZ_LINE, CMDS) + switch (ncmd) { + case NEXT, QUIT: + break + case QUESTION, HELP: + if (level == 1) + call pagefile (HELP1, "ccdinstrument") + else if (level == 2) + call pagefile (HELP2, "ccdinstrument") + else if (level == 3) + call pagefile (HELP3, "ccdinstrument") + case SHOW: + call ccdinst_hdr (im, image, inst, ssfile, level) + case INST: + call hdmwrite ("STDOUT", APPEND) + call printf ("\n") + case IMHEADER: + call ccdinst_i (im, image) + case READ: + call gargwrd (Memc[imval], SZ_LINE) + if (nscan() < 2) + call ccdinst_g ("Instrument file", inst, Memc[imval]) + if (update) + call printf ("WARNING: Previous changes lost\n") + call hdmclose () + update = false + if (strne (inst, Memc[imval])) { + iferr (call hdmopen (Memc[imval])) { + call erract (EA_WARN) + call hdmopen (inst) + } else { + call ccdinst_hdr (im, image, inst, ssfile, level) + update = true + } + } + case WRITE: + call gargwrd (Memc[imval], SZ_LINE) + if (nscan() < 2) + call ccdinst_g ("Instrument file", inst, Memc[imval]) + iferr { + if (access (Memc[imval], 0, 0) == YES) + call delete (Memc[imval]) + call hdmwrite (Memc[imval], NEW_FILE) + update = false + } then + call erract (EA_WARN) + case NEWIMAGE: + call gargwrd (Memc[imval], SZ_LINE) + if (nscan() < 2) + call ccdinst_g ("New image name", image, Memc[imval]) + if (strne (image, Memc[imval])) { + iferr (im1 = immap (Memc[imval], READ_ONLY, 0)) { + call erract (EA_WARN) + im1 = NULL + } + if (im1 != NULL) { + call imunmap (im) + im = im1 + call strcpy (Memc[imval], image, SZ_FNAME) + call ccdinst_hdr (im, image, inst, ssfile, level) + } + } + case TRANSLATE: + call ccdtypes (im, Memc[cmd], SZ_LINE) + call hdmgstr (im, "imagetyp", Memc[imval], SZ_LINE) + + call gargwrd (Memc[def], SZ_FNAME) + if (nscan() < 2) { + call printf ("CCDRED image type for '%s' (%s): ") + call pargstr (Memc[imval]) + call pargstr (Memc[cmd]) + call flush (STDOUT) + if (scan() != EOF) + call gargwrd (Memc[def], SZ_FNAME) + if (nscan() == 0) + call strcpy (Memc[cmd], Memc[def], SZ_LINE) + } + if (strdic (Memc[def], Memc[def], SZ_LINE, CCDTYPES) == 0) { + call printf ("Unknown CCDRED image type\n") + call strcpy (Memc[cmd], Memc[def], SZ_LINE) + } + if (strne (Memc[def], Memc[cmd])) { + call hdmpname (Memc[imval], Memc[def]) + call ccdinst_p (im, "imagetyp", + Memc[key], Memc[def], Memc[imval]) + update = true + } + case IMAGETYPE: + call ccdinst_e (im, "image type", "imagetyp", + Memc[key], Memc[def], Memc[imval], update) + case SUBSET: + call ccdinst_e (im, "subset parameter", "subset", + Memc[key], Memc[def], Memc[imval], update) + case EXPTIME: + call ccdinst_e (im, "exposure time", "exptime", + Memc[key], Memc[def], Memc[imval], update) + case DARKTIME: + call ccdinst_e (im, "dark time", "darktime", + Memc[key], Memc[def], Memc[imval], update) + case FIXFILE: + call ccdinst_e (im, "bad pixel file", "fixfile", + Memc[key], Memc[def], Memc[imval], update) + case BIASSEC: + call ccdinst_e (im, "bias section", "biassec", + Memc[key], Memc[def], Memc[imval], update) + case CCDSEC: + call ccdinst_e (im, "original CCD section", "ccdsec", + Memc[key], Memc[def], Memc[imval], update) + case DATASEC: + call ccdinst_e (im, "data section", "datasec", + Memc[key], Memc[def], Memc[imval], update) + case TRIMSEC: + call ccdinst_e (im, "trim section", "trimsec", + Memc[key], Memc[def], Memc[imval], update) + case DARKCOR: + call ccdinst_e (im, "dark count flag", "darkcor", + Memc[key], Memc[def], Memc[imval], update) + case FIXPIX: + call ccdinst_e (im, "bad pixel flag", "fixpix", + Memc[key], Memc[def], Memc[imval], update) + case FLATCOR: + call ccdinst_e (im, "flat field flag", "flatcor", + Memc[key], Memc[def], Memc[imval], update) + case FRINGCOR: + call ccdinst_e (im, "fringe flag", "fringcor", + Memc[key], Memc[def], Memc[imval], update) + case ILLUMCOR: + call ccdinst_e (im, "illumination flag", "illumcor", + Memc[key], Memc[def], Memc[imval], update) + case OVERSCAN: + call ccdinst_e (im, "overscan flag", "overscan", + Memc[key], Memc[def], Memc[imval], update) + case READCOR: + call ccdinst_e (im, "read correction flag", "readcor", + Memc[key], Memc[def], Memc[imval], update) + case SCANCOR: + call ccdinst_e (im, "scan mode flag", "scancor", + Memc[key], Memc[def], Memc[imval], update) + case NSCANROW: + call ccdinst_e (im, "scan mode rows", "nscanrow", + Memc[key], Memc[def], Memc[imval], update) + case TRIM: + call ccdinst_e (im, "trim flag", "trim", + Memc[key], Memc[def], Memc[imval], update) + case ZEROCOR: + call ccdinst_e (im, "zero level flag", "zerocor", + Memc[key], Memc[def], Memc[imval], update) + case CCDMEAN: + call ccdinst_e (im, "mean value", "ccdmean", + Memc[key], Memc[def], Memc[imval], update) + case FRINGSCL: + call ccdinst_e (im, "fringe scale", "fringscl", + Memc[key], Memc[def], Memc[imval], update) + case ILLUMFLT: + call ccdinst_e (im, "illumination flat image", "illumflt", + Memc[key], Memc[def], Memc[imval], update) + case MKFRINGE: + call ccdinst_e (im, "fringe image", "mkfringe", + Memc[key], Memc[def], Memc[imval], update) + case MKILLUM: + call ccdinst_e (im, "illumination image", "mkillum", + Memc[key], Memc[def], Memc[imval], update) + case SKYFLAT: + call ccdinst_e (im, "sky flat image", "skyflat", + Memc[key], Memc[def], Memc[imval], update) + case NCOMBINE: + call ccdinst_e (im, "number of images combined", "ncombine", + Memc[key], Memc[def], Memc[imval], update) + case DATEOBS: + call ccdinst_e (im, "date of observation", "date-obs", + Memc[key], Memc[def], Memc[imval], update) + case DEC: + call ccdinst_e (im, "declination", "dec", + Memc[key], Memc[def], Memc[imval], update) + case RA: + call ccdinst_e (im, "ra", "ra", + Memc[key], Memc[def], Memc[imval], update) + case TITLE: + call ccdinst_e (im, "title", "title", + Memc[key], Memc[def], Memc[imval], update) + default: + if (nscan() > 0) + call eprintf ("Unrecognized or ambiguous command\007\n") + } + call printf ("ccdinstrument> ") + call flush (STDOUT) + } until (scan() == EOF) + + call sfree (sp) +end + + +# CCDINST_HDR -- Print the current instrument translations for an image. + +procedure ccdinst_hdr (im, image, inst, ssfile, level) + +pointer im # Image pointer +char image[SZ_FNAME] # Image name +char inst[SZ_FNAME] # Instrument file +char ssfile[SZ_FNAME] # Subset file +int level # Parameter level + +pointer sp, key, def, ccdval, imval + +begin + call smark (sp) + call salloc (key, SZ_FNAME, TY_CHAR) + call salloc (def, SZ_LINE, TY_CHAR) + call salloc (ccdval, SZ_LINE, TY_CHAR) + call salloc (imval, SZ_LINE, TY_CHAR) + + # General stuff + call printf ("Image: %s\n") + call pargstr (image) + call printf ("Instrument file: %s\n") + call pargstr (inst) + call printf ("Subset file: %s\n") + call pargstr (ssfile) + + # Table labels + call printf ("\n%-8s %-8s %-8s %-8s %-8s\n") + call pargstr ("CCDRED") + call pargstr ("IMAGE") + call pargstr ("DEFAULT") + call pargstr ("CCDRED") + call pargstr ("IMAGE") + call printf ("%-8s %-8s %-8s %-8s %-8s\n") + call pargstr ("PARAM") + call pargstr ("KEYWORD") + call pargstr ("VALUE") + call pargstr ("VALUE") + call pargstr ("VALUE") + call printf ("---------------------------------------") + call printf ("---------------------------------------\n") + + # Print translations. Select those printed only with the all parameter. + call ccdinst_p (im, "imagetyp", Memc[key], Memc[def], Memc[imval]) + call ccdinst_p (im, "subset", Memc[key], Memc[def], Memc[imval]) + call ccdinst_p (im, "exptime", Memc[key], Memc[def], Memc[imval]) + call ccdinst_p (im, "darktime", Memc[key], Memc[def], Memc[imval]) + if (level > 1) { + call printf ("\n") + call ccdinst_p (im, "biassec", Memc[key], Memc[def], Memc[imval]) + call ccdinst_p (im, "trimsec", Memc[key], Memc[def], Memc[imval]) + call printf ("\n") + call ccdinst_p (im, "fixpix", Memc[key], Memc[def], Memc[imval]) + call ccdinst_p (im, "overscan", Memc[key], Memc[def], Memc[imval]) + call ccdinst_p (im, "trim", Memc[key], Memc[def], Memc[imval]) + call ccdinst_p (im, "zerocor", Memc[key], Memc[def], Memc[imval]) + call ccdinst_p (im, "darkcor", Memc[key], Memc[def], Memc[imval]) + call ccdinst_p (im, "flatcor", Memc[key], Memc[def], Memc[imval]) + } + if (level > 2) { + call ccdinst_p (im, "datasec", Memc[key], Memc[def], Memc[imval]) + call ccdinst_p (im, "ccdsec", Memc[key], Memc[def], Memc[imval]) + call ccdinst_p (im, "fixfile", Memc[key], Memc[def], Memc[imval]) + call printf ("\n") + call ccdinst_p (im, "illumcor", Memc[key], Memc[def], Memc[imval]) + call ccdinst_p (im, "fringcor", Memc[key], Memc[def], Memc[imval]) + call ccdinst_p (im, "readcor", Memc[key], Memc[def], Memc[imval]) + call ccdinst_p (im, "scancor", Memc[key], Memc[def], Memc[imval]) + call ccdinst_p (im, "nscanrow", Memc[key], Memc[def], Memc[imval]) + call printf ("\n") + call ccdinst_p (im, "illumflt", Memc[key], Memc[def], Memc[imval]) + call ccdinst_p (im, "mkfringe", Memc[key], Memc[def], Memc[imval]) + call ccdinst_p (im, "mkillum", Memc[key], Memc[def], Memc[imval]) + call ccdinst_p (im, "skyflat", Memc[key], Memc[def], Memc[imval]) + call printf ("\n") + call ccdinst_p (im, "ccdmean", Memc[key], Memc[def], Memc[imval]) + call ccdinst_p (im, "fringscl", Memc[key], Memc[def], Memc[imval]) + call ccdinst_p (im, "ncombine", Memc[key], Memc[def], Memc[imval]) + call ccdinst_p (im, "date-obs", Memc[key], Memc[def], Memc[imval]) + call ccdinst_p (im, "dec", Memc[key], Memc[def], Memc[imval]) + call ccdinst_p (im, "ra", Memc[key], Memc[def], Memc[imval]) + call ccdinst_p (im, "title", Memc[key], Memc[def], Memc[imval]) + } + + call printf ("\n") + call flush (STDOUT) + call sfree (sp) +end + + +# CCDINST_P -- Print the translation for the specified translation name. + +procedure ccdinst_p (im, name, key, def, value) + +pointer im # Image pointer +char name[SZ_FNAME] # CCDRED name +char key[SZ_FNAME] # Image header keyword +char def[SZ_LINE] # Default value +char value[SZ_LINE] # Value + +int i, strdic(), hdmaccf() +bool bval, ccdflag() + +begin + i = strdic (name, key, SZ_FNAME, CMDS) + if (i == 0) + return + + # Get translaltion image keyword, default, and image value. + call hdmname (name, key, SZ_FNAME) + call hdmgdef (name, def, SZ_LINE) + call hdmgstr (im, name, value, SZ_LINE) + if (value[1] == EOS) + call strcpy ("?", value, SZ_LINE) + + switch (i) { + case IMAGETYPE: + call printf ("%-8s %-8s %-8s") + call pargstr (name) + call pargstr (key) + call pargstr (def) + call ccdtypes (im, def, SZ_LINE) + call printf (" %-8s %-.39s\n") + call pargstr (def) + call pargstr (value) + case SUBSET: + call printf ("%-8s %-8s %-8s") + call pargstr (name) + call pargstr (key) + call pargstr (def) + call ccdsubset (im, def, SZ_LINE) + call printf (" %-8s %-.39s\n") + call pargstr (def) + call pargstr (value) + case FIXPIX, OVERSCAN, TRIM, ZEROCOR, DARKCOR, FLATCOR, ILLUMCOR, + FRINGCOR, READCOR, SCANCOR, ILLUMFLT, MKFRINGE, MKILLUM, + SKYFLAT: + bval = ccdflag (im, name) + if (hdmaccf (im, name) == NO) + call strcpy ("?", value, SZ_LINE) + call printf ("%-8s %-8s %-8s %-8b %-.39s\n") + call pargstr (name) + call pargstr (key) + call pargstr (def) + call pargb (bval) + call pargstr (value) + default: + call printf ("%-8s %-8s %-8s %-8s") + call pargstr (name) + call pargstr (key) + call pargstr (def) + call pargstr (value) + if (hdmaccf (im, name) == NO) + call strcpy ("?", value, SZ_LINE) + call printf (" %-.39s\n") + call pargstr (value) + } +end + + +# CCDINST_E -- Edit a single translation entry. +# This checks for parameters on the command line and if missing queries. +# The default value may only be changed on the command line. + +procedure ccdinst_e (im, prompt, name, key, def, imval, update) + +pointer im # Image pointer +char prompt[ARB] # Parameter prompt name +char name[SZ_FNAME] # CCDRED name +char key[SZ_FNAME] # Image header keyword +char def[SZ_LINE] # Default value +char imval[SZ_LINE] # Value +bool update # Update translation file? + +bool strne() +int i, scan(), nscan() +pointer sp, oldkey, olddef + +begin + call smark (sp) + call salloc (oldkey, SZ_FNAME, TY_CHAR) + call salloc (olddef, SZ_LINE, TY_CHAR) + + # Get command line values + call gargwrd (key, SZ_FNAME) + call gargwrd (def, SZ_LINE) + + # Get current values + call hdmname (name, Memc[oldkey], SZ_FNAME) + call hdmgdef (name, Memc[olddef], SZ_LINE) + + # Query for keyword if needed. + i = nscan() + if (i < 2) { + call printf ("Image keyword for %s (%s): ") + call pargstr (prompt) + call pargstr (Memc[oldkey]) + call flush (STDOUT) + if (scan() != EOF) + call gargwrd (key, SZ_FNAME) + if (nscan() == 0) + call strcpy (Memc[oldkey], key, SZ_FNAME) + } + if (i < 3) { + #call printf ("Default %s (%s): ") + # call pargstr (prompt) + # call pargstr (Memc[olddef]) + #call flush (STDOUT) + #if (scan() != EOF) + # call gargwrd (def, SZ_LINE) + #if (nscan() == 0) + call strcpy (Memc[olddef], def, SZ_LINE) + } + + # Update only if the new value is different from the old value. + if (strne (key, Memc[oldkey])) { + call hdmpname (name, key) + update = true + } + if (strne (def, Memc[olddef])) { + call hdmpdef (name, def) + update = true + } + + # Print the revised translation. + call ccdinst_p (im, name, key, def, imval) + call sfree (sp) +end + + +# CCDINST_G -- General procedure to prompt for value. + +procedure ccdinst_g (prompt, def, val) + +char prompt[ARB] # Prompt +char def[ARB] # Default value +char val[SZ_LINE] # Value + +int scan(), nscan() + +begin + call printf ("%s (%s): ") + call pargstr (prompt) + call pargstr (def) + call flush (STDOUT) + if (scan() != EOF) + call gargwrd (val, SZ_FNAME) + if (nscan() == 0) + call strcpy (def, val, SZ_LINE) +end + + +define USER_AREA Memc[($1+IMU-1)*SZ_STRUCT + 1] + +# CCDINST_IMH -- Print the user area of the image, if nonzero length +# and it contains only ascii values. This copied from the code for +# IMHEADER. It differs in including the OBJECT keyword, using a temporary +# file to page the header, and no leading blanks. + +procedure ccdinst_i (im, image) + +pointer im # image descriptor +char image[ARB] # image name + +pointer sp, tmp, lbuf, ip +int in, out, ncols, min_lenuserarea +int open(), stropen(), getline(), envgeti() + +begin + call smark (sp) + call salloc (tmp, SZ_FNAME, TY_CHAR) + call salloc (lbuf, SZ_LINE, TY_CHAR) + + # Open user area in header. + min_lenuserarea = (LEN_IMDES + IM_LENHDRMEM(im) - IMU) * SZ_STRUCT - 1 + in = stropen (USER_AREA(im), min_lenuserarea, READ_ONLY) + ncols = envgeti ("ttyncols") + + # Open temporary output file. + call mktemp ("tmp$", Memc[tmp], SZ_FNAME) + iferr (out = open (Memc[tmp], NEW_FILE, TEXT_FILE)) { + call erract (EA_WARN) + call sfree (sp) + return + } + + # Copy standard header records. + call fprintf (out, "OBJECT = '%s'\n") + call pargstr (IM_TITLE(im)) + + # Copy header records to the output, stripping any trailing + # whitespace and clipping at the right margin. + + while (getline (in, Memc[lbuf]) != EOF) { + for (ip=lbuf; Memc[ip] != EOS && Memc[ip] != '\n'; ip=ip+1) + ; + while (ip > lbuf && Memc[ip-1] == ' ') + ip = ip - 1 + if (ip - lbuf > ncols) + ip = lbuf + ncols + Memc[ip] = '\n' + Memc[ip+1] = EOS + + call putline (out, Memc[lbuf]) + } + call putline (out, "\n") + + call close (in) + call close (out) + + call pagefile (Memc[tmp], image) + call delete (Memc[tmp]) + + call sfree (sp) +end diff --git a/noao/imred/ccdred/src/t_ccdlist.x b/noao/imred/ccdred/src/t_ccdlist.x new file mode 100644 index 00000000..1b438b27 --- /dev/null +++ b/noao/imred/ccdred/src/t_ccdlist.x @@ -0,0 +1,325 @@ +include <imhdr.h> +include <error.h> +include "ccdtypes.h" + +define SZ_CCDLINE 80 # Size of line for output + + +# T_CCDLIST -- List CCD image information and processing status. +# +# Each input image of the specified image type is listed in either a one +# line short format, a name only format, or a longer format. The image +# name, size, pixel type, image type, subset ID, processing flags and +# title are printed on one line. For the long format image details of +# the processing operations are printed. + +procedure t_ccdlist () + +int list, ccdtype +bool names, lformat +pointer sp, image, im + +bool clgetb() +int imtopenp(), imtgetim() + +begin + call smark (sp) + call salloc (image, SZ_FNAME, TY_CHAR) + + # Get the task parameters and open the translation file. + list = imtopenp ("images") + names = clgetb ("names") + lformat = clgetb ("long") + call clgstr ("instrument", Memc[image], SZ_FNAME) + if (Memc[image] == EOS) + call error (1, "No 'instrument' translation file specified.") + call hdmopen (Memc[image]) + + # List each iamge. + while (imtgetim (list, Memc[image], SZ_FNAME) != EOF) { + # Map the image and the instrument header translation. + # Check the image type. + call set_input (Memc[image], im, ccdtype) + if (im == NULL) + next + + # Select the output format. + if (names) { + call printf ("%s\n") + call pargstr (Memc[image]) + } else if (lformat) { + call shortlist (Memc[image], ccdtype, im) + call longlist (im, ccdtype) + } else + call shortlist (Memc[image], ccdtype, im) + call flush (STDOUT) + + call imunmap (im) + } + + # Finish up. + call hdmclose () + call imtclose (list) + call sfree (sp) +end + + +# SHORTLIST -- List the one line short format consisting of the image name, +# iamge size, pixel type, image type, subset ID, processing flags, and +# title. + +procedure shortlist (image, ccdtype, im) + +char image # Image name +int ccdtype # CCD image type +pointer im # IMIO pointer + +bool ccdflag() +pointer sp, str, subset + +begin + call smark (sp) + call salloc (str, SZ_CCDLINE, TY_CHAR) + call salloc (subset, SZ_CCDLINE, TY_CHAR) + + # Get the image type and subset ID. + call ccdtypes (im, Memc[str], SZ_CCDLINE) + call ccdsubset (im, Memc[subset], SZ_CCDLINE) + + # List the image name, size, pixel type, image type, and subset. + call printf ("%s[%d,%d][%s][%s][%d]") + call pargstr (image) + call pargi (IM_LEN(im,1)) + call pargi (IM_LEN(im,2)) + call pargtype1 (IM_PIXTYPE(im)) + call pargstr (Memc[str]) + call pargstr (Memc[subset]) + + # Format and list the processing flags. + Memc[str] = EOS + if (ccdflag (im, "fixpix")) + call strcat ("B", Memc[str], SZ_CCDLINE) + if (ccdflag (im, "overscan")) + call strcat ("O", Memc[str], SZ_CCDLINE) + if (ccdflag (im, "trim")) + call strcat ("T", Memc[str], SZ_CCDLINE) + if (ccdflag (im, "zerocor")) + call strcat ("Z", Memc[str], SZ_CCDLINE) + if (ccdflag (im, "darkcor")) + call strcat ("D", Memc[str], SZ_CCDLINE) + if (ccdflag (im, "flatcor")) + call strcat ("F", Memc[str], SZ_CCDLINE) + if (ccdflag (im, "illumcor")) + call strcat ("I", Memc[str], SZ_CCDLINE) + if (ccdflag (im, "fringcor")) + call strcat ("Q", Memc[str], SZ_CCDLINE) + if (Memc[str] != EOS) { + call printf ("[%s]") + call pargstr (Memc[str]) + } + + # List the title. + call printf (":%s\n") + call pargstr (IM_TITLE(im)) + + call sfree (sp) +end + + +# LONGLIST -- Add the long format listing. +# List some instrument parameters and information about each processing +# step indicated by the processing parameters. If the processing step has +# not been done yet indicate this and the parameters to be used. + +procedure longlist (im, ccdtype) + +pointer im # IMIO pointer +int ccdtype # CCD image type + +real rval, hdmgetr() +pointer sp, instr, outstr +bool clgetb(), ccdflag(), streq() +define done_ 99 + +begin + call smark (sp) + call salloc (instr, SZ_LINE, TY_CHAR) + call salloc (outstr, SZ_LINE, TY_CHAR) + + # List some image parameters. + Memc[outstr] = EOS + ifnoerr (rval = hdmgetr (im, "exptime")) { + call sprintf (Memc[instr], SZ_LINE, " exposure=%d") + call pargr (rval) + call strcat (Memc[instr], Memc[outstr], SZ_LINE) + } + ifnoerr (rval = hdmgetr (im, "darktime")) { + call sprintf (Memc[instr], SZ_LINE, " darktime=%d") + call pargr (rval) + call strcat (Memc[instr], Memc[outstr], SZ_LINE) + } + call printf (" %s\n") + call pargstr (Memc[outstr]) + + # List the processing strings. + if (ccdflag (im, "fixpix")) { + call hdmgstr (im, "fixpix", Memc[outstr], SZ_LINE) + call printf (" %s\n") + call pargstr (Memc[outstr]) + } else if (clgetb ("fixpix")) { + call clgstr ("fixfile", Memc[outstr], SZ_LINE) + if (streq (Memc[outstr], "image")) + call hdmgstr (im, "fixfile", Memc[outstr], SZ_LINE) + if (Memc[outstr] != EOS) { + call printf (" [TO BE DONE] Bad pixel file is %s\n") + call pargstr (Memc[outstr]) + } else + call printf ( + " [TO BE DONE] Bad pixel file needs to be specified\n") + } + + if (ccdflag (im, "overscan")) { + call hdmgstr (im, "overscan", Memc[outstr], SZ_LINE) + call printf (" %s\n") + call pargstr (Memc[outstr]) + } else if (clgetb ("overscan")) { + call clgstr ("biassec", Memc[outstr], SZ_LINE) + if (streq (Memc[outstr], "image")) + call hdmgstr (im, "biassec", Memc[outstr], SZ_LINE) + call printf (" [TO BE DONE] Overscan strip is %s\n") + call pargstr (Memc[outstr]) + } + + if (ccdflag (im, "trim")) { + call hdmgstr (im, "trim", Memc[outstr], SZ_LINE) + call printf (" %s\n") + call pargstr (Memc[outstr]) + } else if (clgetb ("trim")) { + call clgstr ("trimsec", Memc[outstr], SZ_LINE) + if (streq (Memc[outstr], "image")) + call hdmgstr (im, "trimsec", Memc[outstr], SZ_LINE) + call printf (" [TO BE DONE] Trim image section is %s\n") + call pargstr (Memc[outstr]) + } + + if (ccdtype == ZERO) { + if (ccdflag (im, "readcor")) { + call hdmgstr (im, "readcor", Memc[outstr], SZ_LINE) + call printf (" %s\n") + call pargstr (Memc[outstr]) + } else if (clgetb ("readcor")) + call printf ( + " [TO BE DONE] Convert to readout format\n") + goto done_ + } + if (ccdflag (im, "zerocor")) { + call hdmgstr (im, "zerocor", Memc[outstr], SZ_LINE) + call printf (" %s\n") + call pargstr (Memc[outstr]) + } else if (clgetb ("zerocor")) + call printf (" [TO BE DONE] Zero level correction\n") + + if (ccdtype == DARK) + goto done_ + if (ccdflag (im, "darkcor")) { + call hdmgstr (im, "darkcor", Memc[outstr], SZ_LINE) + call printf (" %s\n") + call pargstr (Memc[outstr]) + } else if (clgetb ("darkcor")) + call printf (" [TO BE DONE] Dark count correction\n") + + if (ccdtype == FLAT) { + if (ccdflag (im, "scancor")) { + call hdmgstr (im, "scancor", Memc[outstr], SZ_LINE) + call printf (" %s\n") + call pargstr (Memc[outstr]) + } else if (clgetb ("scancor")) + call printf ( + " [TO BE DONE] Convert to scan format\n") + if (ccdflag (im, "skyflat")) { + call hdmgstr (im, "skyflat", Memc[outstr], SZ_LINE) + call printf (" %s\n") + call pargstr (Memc[outstr]) + } + if (ccdflag (im, "illumflt")) { + call hdmgstr (im, "illumflt", Memc[outstr], SZ_LINE) + call printf (" %s\n") + call pargstr (Memc[outstr]) + } + goto done_ + } + if (ccdflag (im, "flatcor")) { + call hdmgstr (im, "flatcor", Memc[outstr], SZ_LINE) + call printf (" %s\n") + call pargstr (Memc[outstr]) + } else if (clgetb ("flatcor")) + call printf (" [TO BE DONE] Flat field correction\n") + + if (ccdtype == ILLUM) { + if (ccdflag (im, "mkillum")) { + call hdmgstr (im, "mkillum", Memc[outstr], SZ_LINE) + call printf (" %s\n") + call pargstr (Memc[outstr]) + } else + call printf ( + " [TO BE DONE] Convert to illumination correction\n") + goto done_ + } + if (ccdflag (im, "illumcor")) { + call hdmgstr (im, "illumcor", Memc[outstr], SZ_LINE) + call printf (" %s\n") + call pargstr (Memc[outstr]) + } else if (clgetb ("illumcor")) + call printf (" [TO BE DONE] Illumination correction\n") + + if (ccdtype == FRINGE) + goto done_ + if (ccdflag (im, "fringcor")) { + call hdmgstr (im, "fringecor", Memc[outstr], SZ_LINE) + call printf (" %s\n") + call pargstr (Memc[outstr]) + } else if (clgetb ("fringecor")) + call printf (" [TO BE DONE] Fringe correction\n") + +done_ + call sfree (sp) +end + + +# PARGTYPE1 -- Convert an integer type code into a string, and output the +# string with PARGSTR to FMTIO. Taken from IMHEADER. + +procedure pargtype1 (dtype) + +int dtype + +begin + switch (dtype) { + case TY_UBYTE: + call pargstr ("ubyte") + case TY_BOOL: + call pargstr ("bool") + case TY_CHAR: + call pargstr ("char") + case TY_SHORT: + call pargstr ("short") + case TY_USHORT: + call pargstr ("ushort") + case TY_INT: + call pargstr ("int") + case TY_LONG: + call pargstr ("long") + case TY_REAL: + call pargstr ("real") + case TY_DOUBLE: + call pargstr ("double") + case TY_COMPLEX: + call pargstr ("complex") + case TY_POINTER: + call pargstr ("pointer") + case TY_STRUCT: + call pargstr ("struct") + default: + call pargstr ("unknown datatype") + } +end diff --git a/noao/imred/ccdred/src/t_ccdmask.x b/noao/imred/ccdred/src/t_ccdmask.x new file mode 100644 index 00000000..d5d074cb --- /dev/null +++ b/noao/imred/ccdred/src/t_ccdmask.x @@ -0,0 +1,384 @@ +include <imhdr.h> + + +define MAXBUF 500000 # Maximum pixel buffer + +define PLSIG 30.9 # Low percentile +define PHSIG 69.1 # High percentile + + +# T_CCDMASK -- Create a bad pixel mask from CCD images. +# Deviant pixels relative to a local median and sigma are detected and +# written to a pixel mask file. There is a special algorithm for detecting +# long column oriented features typical of CCD defects. This task +# is intended for use on flat fields or, even better, the ratio of +# two flat fields at different exposure levels. + +procedure t_ccdmask () + +pointer image # Input image +pointer mask # Output mask +int ncmed, nlmed # Median box size +int ncsig, nlsig # Sigma box size +real lsig, hsig # Threshold sigmas +int ngood # Minmum good pixel sequence +short linterp # Mask value for line interpolation +short cinterp # Mask value for column interpolation +short eqinterp # Mask value for equal interpolation + +int i, j, c1, c2, c3, c4, nc, nl, ncstep, nc1 +pointer sp, in, out, inbuf, outbuf +real clgetr() +int clgeti(), nowhite(), strmatch() +pointer immap(), imgs2r(), imps2s(), imgl2s(), impl2s() +errchk immap, imgs2r, imps2r, imgl2s, impl2s, cm_mask + +begin + call smark (sp) + call salloc (image, SZ_FNAME, TY_CHAR) + call salloc (mask, SZ_FNAME, TY_CHAR) + + # Get parameters. + call clgstr ("image", Memc[image], SZ_FNAME) + call clgstr ("mask", Memc[mask], SZ_FNAME) + ncmed = clgeti ("ncmed") + nlmed = clgeti ("nlmed") + ncsig = clgeti ("ncsig") + nlsig = clgeti ("nlsig") + lsig = clgetr ("lsigma") + hsig = clgetr ("hsigma") + ngood = clgeti ("ngood") + linterp = clgeti ("linterp") + cinterp = clgeti ("cinterp") + eqinterp = clgeti ("eqinterp") + + # Force a pixel list format. + i = nowhite (Memc[mask], Memc[mask], SZ_FNAME) + if (strmatch (Memc[mask], ".pl$") == 0) + call strcat (".pl", Memc[mask], SZ_FNAME) + + # Map the input and output images. + in = immap (Memc[image], READ_ONLY, 0) + out = immap (Memc[mask], NEW_COPY, in) + + # Go through the input in large blocks of columns. If the + # block is smaller than the whole image overlap the blocks + # so the median only has boundaries at the ends of the image. + # Set the mask values based on the distances to the nearest + # good pixels. + + nc = IM_LEN(in,1) + nl = IM_LEN(in,2) + ncstep = max (1, MAXBUF / nl - ncmed) + + outbuf = NULL + do i = 1, nc, ncstep { + c1 = i + c2 = min (nc, i + ncstep - 1) + c3 = max (1, c1 - ncmed / 2) + c4 = min (nc, c2 + ncmed / 2) + nc1 = c4 - c3 + 1 + inbuf = imgs2r (in, c3, c4, 1, nl) + if (outbuf == NULL) + call malloc (outbuf, nc1*nl, TY_SHORT) + else + call realloc (outbuf, nc1*nl, TY_SHORT) + call aclrs (Memc[outbuf], nc1*nl) + call cm_mask (Memr[inbuf], Mems[outbuf], nc1, nl, c1-c3+1, + c2-c3+1, ncmed, nlmed, ncsig, nlsig, lsig, hsig, ngood) + call cm_interp (Mems[outbuf], nc1, nl, c1-c3+1, c2-c3+1, nc, + linterp, cinterp, eqinterp) + do j = 1, nl + call amovs (Mems[outbuf+(j-1)*nc1+c1-c3], + Mems[imps2s(out,c1,c2,j,j)], c2-c1+1) + } + call mfree (outbuf, TY_SHORT) + + call imunmap (out) + call imunmap (in) + + # If the image was searched in blocks we need another pass to find + # the lengths of bad pixel regions along lines since they may + # span the block edges. Previously the mask values were set + # to the column lengths so in this pass we can just look at + # whole lines sequentially. + + if (nc1 != nc) { + out = immap (Memc[mask], READ_WRITE, 0) + do i = 1, nl { + inbuf = imgl2s (out, i) + outbuf = impl2s (out, i) + call cm_interp1 (Mems[inbuf], Mems[outbuf], nc, nl, + linterp, cinterp, eqinterp) + } + call imunmap (out) + } + + call sfree (sp) +end + + +# CM_MASK -- Compute the mask image. +# A local background is computed using moving box medians to avoid +# contaminating bad pixels. The local sigma is computed in blocks (it is not +# a moving box for efficiency) by using a percentile point of the sorted +# pixel values to estimate the width of the distribution uncontaminated by +# bad pixels). Once the background and sigma are known deviant pixels are +# found by using sigma threshold factors. Sums of pixels along columns are +# checked at various scales from single pixels to whole columns with the +# sigma level set appropriately. The provides sensitivity to weaker column +# features such as CCD traps. + +procedure cm_mask (data, bp, nc, nl, nc1, nc2, ncmed, nlmed, ncsig, nlsig, + lsig, hsig, ngood) + +real data[nc,nl] #I Pixel array +short bp[nc,nl] #U Bad pixel array (0=good, 1=bad) +int nc, nl #I Number of columns and lines +int nc1, nc2 #I Columns to compute +int ncmed, nlmed #I Median box size +int ncsig, nlsig #I Sigma box size +real lsig, hsig #I Threshold sigmas +int ngood #I Minimum good pixel sequence + +int i, j, k, l, m, nsum, plsig, phsig, jsig +real back, sigma, sum1, sum2, low, high, amedr() +pointer sp, bkg, sig, work, bp1, ptr + +begin + call smark (sp) + call salloc (bkg, nl, TY_REAL) + call salloc (sig, nl/nlsig, TY_REAL) + call salloc (work, max (ncsig*nlsig, ncmed*nlmed), TY_REAL) + call salloc (bp1, nl, TY_SHORT) + + bkg = bkg - 1 + sig = sig - 1 + + i = nlsig * ncsig + plsig = nint (PLSIG*i/100.-1) + phsig = nint (PHSIG*i/100.-1) + + do i = nc1, nc2 { + + # Compute median background. This is a moving median. + l = min (nc, i+ncmed/2) + l = max (1, l-ncmed+1) + do j = 1, nl { + k = min (nl, j+nlmed/2) + k = max (1, k-nlmed+1) + ptr = work + do m = k, k+nlmed-1 { + call amovr (data[l,m], Memr[ptr], ncmed) + ptr = ptr + ncmed + } + back = amedr (Memr[work], ncmed * nlmed) + Memr[bkg+j] = back + } + + # Compute sigmas from percentiles. This is done in blocks. + if (mod (i-nc1, ncsig) == 0 && i<nc-ncsig+1) { + do j = 1, nl-nlsig+1, nlsig { + ptr = work + do k = j, j+nlsig-1 { + call amovr (data[i,k], Memr[ptr], ncsig) + ptr = ptr + ncsig + } + call asrtr (Memr[work], Memr[work], ncsig*nlsig) + sigma = Memr[work+phsig] - Memr[work+plsig] + jsig = (j+nlsig-1) / nlsig + Memr[sig+jsig] = sigma**2 + } + } + + # Single pixel iterative rejection. + k = 0 + do j = 1, nl { + if (bp[i,j] == 1) + k = k + 1 + else { + jsig = min ((j+nlsig-1)/nlsig, nl/nlsig) + back = Memr[bkg+j] + sigma = sqrt (Memr[sig+jsig]) + low = back - lsig * sigma + high = back + hsig * sigma + if (data[i,j] < low || data[i,j] > high) { + bp[i,j] = 1 + k = k + 1 + } + } + } + if (k == nl) + next + + # Reject over column sums at various scales. + # Ignore previously rejected pixels. + + l = 2 + while (l <= nl) { + do j = 1, nl + Mems[bp1+j-1] = bp[i,j] + sum1 = 0 + sum2 = 0 + nsum = 0 + k = 1 + do j = k, l-1 { + if (bp[i,j] == 1) + next + jsig = min ((j+nlsig-1)/nlsig, nl/nlsig) + sum1 = sum1 + data[i,j] - Memr[bkg+j] + sum2 = sum2 + Memr[sig+jsig] + nsum = nsum + 1 + } + do j = l, nl { + if (bp[i,j] == 0) { + jsig = min ((j+nlsig-1)/nlsig, nl/nlsig) + sum1 = sum1 + data[i,j] - Memr[bkg+j] + sum2 = sum2 + Memr[sig+jsig] + nsum = nsum + 1 + } + if (nsum > 0) { + sigma = sqrt (sum2) + low = -lsig * sigma + high = hsig * sigma + if (sum1 < low || sum1 > high) + do m = k, j + bp[i,m] = 1 + } + if (Mems[bp1+k-1] == 0) { + jsig = min ((k+nlsig-1)/nlsig, nl/nlsig) + sum1 = sum1 - data[i,k] + Memr[bkg+k] + sum2 = sum2 - Memr[sig+jsig] + nsum = nsum - 1 + } + k = k + 1 + } + + if (l == nl) + break + else if (l < 10) + l = l + 1 + else + l = min (l * 2, nl) + } + + # Coalesce small good regions along columns. + if (ngood > 1) { + for (k=1; k<=nl && bp[i,k]!=0; k=k+1) + ; + while (k < nl) { + for (l=k+1; l<=nl && bp[i,l]==0; l=l+1) + ; + if (l-k < ngood) + do j = k, l-1 + bp[i,j] = 1 + for (k=l+1; k<=nl && bp[i,k]!=0; k=k+1) + ; + } + } + } + + call sfree (sp) +end + + +# CM_INTERP -- Compute the lengths of bad regions along columns and lines. +# If only part of the image is buffered set the pixel mask values +# to the column lengths so a later pass can compare these values against +# the full line lengths. If the whole image is buffered then both +# the column and line lengths can be determined and the the mask values +# set based on these lengths. + +procedure cm_interp (bp, nc, nl, nc1, nc2, ncimage, linterp, cinterp, eqinterp) + +short bp[nc,nl] #U Bad pixel array +int nc, nl #I Number of columns and lines +int nc1, nc2 #I Columns to compute +int ncimage #I Number of columns in image +short linterp #I Mask value for line interpolation +short cinterp #I Mask value for column interpolation +short eqinterp #I Mask value for equal interpolation + +int i, j, k, l, m, n + +begin + do i = nc1, nc2 { + + # Set values to column length. + for (k=1; k<=nl && bp[i,k]==0; k=k+1) + ; + while (k <= nl) { + for (l=k+1; l<=nl && bp[i,l]!=0; l=l+1) + ; + m = l - k + do j = k, l-1 + bp[i,j] = m + for (k=l+1; k<=nl && bp[i,k]==0; k=k+1) + ; + } + } + + # Set values to minimum axis length for interpolation. + if (nc == ncimage) { + do j = 1, nl { + for (k=1; k<=nc && bp[k,j]==0; k=k+1) + ; + while (k <= nc) { + for (l=k+1; l<=nc && bp[l,j]!=0; l=l+1) + ; + m = l - k + do i = k, l-1 { + n = bp[i,j] + if (n > m || n == nl) + bp[i,j] = linterp + else if (n < m) + bp[i,j] = cinterp + else + bp[i,j] = eqinterp + } + for (k=l+1; k<=nc && bp[k,j]==0; k=k+1) + ; + } + } + } +end + + +# CM_INTERP1 -- Set the mask values based on the column and line lengths +# of the bad pixel regions. If this routine is called the pixel mask +# is open READ/WRITE and the pixel mask values have been previously set +# to the column lengths. So here we just need to compute the line +# lengths across the entire image and reset the mask values to the +# appropriate interpolation mask code. + +procedure cm_interp1 (in, out, nc, nl, linterp, cinterp, eqinterp) + +short in[nc] #I Bad pixel array with column length codes +short out[nc] #O Bad pixel array with interp axis codes +int nc, nl #I Image dimensions +short linterp #I Mask value for line interpolation +short cinterp #I Mask value for column interpolation +short eqinterp #I Mask value for equal interpolation + +int i, j, l, m, n + +begin + for (j=1; j<=nc && in[j]==0; j=j+1) + out[j] = 0 + while (j < nc) { + for (l=j+1; l<=nc && in[l]!=0; l=l+1) + ; + m = l - j + do i = j, l-1 { + n = in[i] + if (n > m || n == nl) + out[i] = linterp + else if (n < m) + out[i] = cinterp + else + out[i] = eqinterp + } + for (j=l+1; j<=nc && in[j]==0; j=j+1) + out[j] = 0 + } +end diff --git a/noao/imred/ccdred/src/t_ccdproc.x b/noao/imred/ccdred/src/t_ccdproc.x new file mode 100644 index 00000000..31e9ae6e --- /dev/null +++ b/noao/imred/ccdred/src/t_ccdproc.x @@ -0,0 +1,176 @@ +include <imhdr.h> +include <error.h> +include "ccdred.h" +include "ccdtypes.h" + +define CACHEUNIT 1000000. # Units of max_cache parameter + +# T_CCDPROC -- Process CCD images +# +# This is the main procedure for processing CCD images. The images are +# corrected for bad pixels, overscan levels, zero levels, dark counts, +# flat field response, illumination errors, and fringe response. They +# may also be trimmed. The input is a list of images to be processed. +# Each image must match any image type requested. The checking of +# whether to apply each correction, getting the required parameters, and +# logging the operations is left to separate procedures, one for each +# correction. The actual processing is done by a specialized procedure +# designed to be very efficient. These procedures may also process +# calibration images if necessary. There are two data type paths; one +# for short pixel types and one for all other pixel types (usually +# real). + +procedure t_ccdproc () + +int list # List of CCD images to process +int outlist # LIst of output images +int ccdtype # CCD image type +int interactive # Fit overscan interactively? +int max_cache # Maximum image cache size + +bool clgetb() +real clgetr() +int imtopenp(), imtgetim(), imtlen() +pointer sp, input, output, str, in, out, ccd +errchk set_input, set_output, ccddelete, cal_open +errchk set_fixpix, set_zero, set_dark, set_flat, set_illum, set_fringe + +begin + call smark (sp) + call salloc (input, SZ_FNAME, TY_CHAR) + call salloc (output, SZ_FNAME, TY_CHAR) + call salloc (str, SZ_LINE, TY_CHAR) + + # Get input and output lists and check they make sense. + list = imtopenp ("images") + outlist = imtopenp ("output") + if (imtlen (outlist) > 0 && imtlen (outlist) != imtlen (list)) + call error (1, "Input and output lists do not match") + + # Get instrument translation file. Open the translation + # file. Initialize the interactive flag and the calibration images. + + call clgstr ("instrument", Memc[input], SZ_FNAME) + if (Memc[input] == EOS) + call error (1, "No 'instrument' translation file specified.") + call hdmopen (Memc[input]) + call set_interactive ("", interactive) + call cal_open (list) + if (imtlen (list) < 3) + max_cache = 0. + else + max_cache = CACHEUNIT * clgetr ("max_cache") + call ccd_open (max_cache) + + # Process each image. + while (imtgetim (list, Memc[input], SZ_FNAME) != EOF) { + if (clgetb ("noproc")) { + call printf ("%s:\n") + call pargstr (Memc[input]) + } + call set_input (Memc[input], in, ccdtype) + if (in == NULL) + next + + # Set output image. + if (imtlen (outlist) == 0) + call mktemp ("tmp", Memc[output], SZ_FNAME) + else if (imtgetim (outlist, Memc[output], SZ_FNAME) == EOF) + call error (1, "Premature end of output list") + call set_output (in, out, Memc[output]) + + # Set processing parameters applicable to all images. + call set_proc (in, out, ccd) + call set_sections (ccd) + call set_trim (ccd) + call set_fixpix (ccd) + call set_overscan (ccd) + + # Set processing parameters for the standard CCD image types. + switch (ccdtype) { + case ZERO: + case DARK: + call set_zero (ccd) + case FLAT: + call set_zero (ccd) + call set_dark (ccd) + CORS(ccd, FINDMEAN) = YES + CORS(ccd, MINREP) = YES + case ILLUM: + call set_zero (ccd) + call set_dark (ccd) + call set_flat (ccd) + case OBJECT, COMP: + call set_zero (ccd) + call set_dark (ccd) + call set_flat (ccd) + iferr { + call set_illum (ccd) + call set_fringe (ccd) + } then + call erract (EA_WARN) + default: + call set_zero (ccd) + call set_dark (ccd) + call set_flat (ccd) + iferr { + call set_illum (ccd) + call set_fringe (ccd) + } then + call erract (EA_WARN) + CORS(ccd, FINDMEAN) = YES + } + + # Do the processing if the COR flag is set. + + if (COR(ccd) == YES) { + call doproc (ccd) + call set_header (ccd) + + call imunmap (in) + call imunmap (out) + if (imtlen (outlist) == 0) { + # Replace the input image by the corrected image. + iferr (call ccddelete (Memc[input])) { + call imdelete (Memc[output]) + call error (1, + "Can't delete or make backup of original image") + } + call imrename (Memc[output], Memc[input]) + } + } else { + # Delete the output image. + call imunmap (in) + iferr (call imunmap (out)) + ; + iferr (call imdelete (Memc[output])) + ; + } + call free_proc (ccd) + + # Do special processing on certain image types. + if (imtlen (outlist) == 0) { + switch (ccdtype) { + case ZERO: + call readcor (Memc[input]) + case FLAT: + call ccdmean (Memc[input]) + } + } else { + switch (ccdtype) { + case ZERO: + call readcor (Memc[output]) + case FLAT: + call ccdmean (Memc[output]) + } + } + } + + # Finish up. + call hdmclose () + call imtclose (list) + call imtclose (outlist) + call cal_close () + call ccd_close () + call sfree (sp) +end diff --git a/noao/imred/ccdred/src/t_combine.x b/noao/imred/ccdred/src/t_combine.x new file mode 100644 index 00000000..66c14089 --- /dev/null +++ b/noao/imred/ccdred/src/t_combine.x @@ -0,0 +1,653 @@ +include <imhdr.h> +include <error.h> +include <syserr.h> +include <mach.h> +include "ccdred.h" +include "icombine.h" + + +# T_COMBINE -- Combine CCD images. +# This task is a copy of IMAGES.IMCOMBINE except that it recognizes the +# CCD types and can group images by AMP and SUBSET. It also uses header +# keyword translation for the exposure times. + +procedure t_combine () + +pointer images # Images +pointer extns # Image extensions for each subset +pointer subsets # Subsets +pointer nimages # Number of images in each subset +int nsubsets # Number of subsets +pointer outroot # Output root image name +pointer plroot # Output pixel list root name +pointer sigroot # Output root sigma image name +pointer logfile # Log filename +bool delete # Delete input images? + +int i +pointer sp, output, plfile, sigma + +bool clgetb() +int clgeti(), clgwrd() +real clgetr() + +include "icombine.com" + +begin + call smark (sp) + call salloc (outroot, SZ_FNAME, TY_CHAR) + call salloc (plroot, SZ_FNAME, TY_CHAR) + call salloc (sigroot, SZ_FNAME, TY_CHAR) + call salloc (logfile, SZ_FNAME, TY_CHAR) + call salloc (output, SZ_FNAME, TY_CHAR) + call salloc (plfile, SZ_FNAME, TY_CHAR) + call salloc (sigma, SZ_FNAME, TY_CHAR) + call salloc (gain, SZ_FNAME, TY_CHAR) + call salloc (snoise, SZ_FNAME, TY_CHAR) + call salloc (rdnoise, SZ_FNAME, TY_CHAR) + call salloc (logfile, SZ_FNAME, TY_CHAR) + + # Open the header translation which is needed to determine the + # amps, subsets and ccdtypes. Get the input images. + # There must be a least one image in order to continue. + + call clgstr ("instrument", Memc[output], SZ_FNAME) + if (Memc[output] == EOS) + call error (1, "No 'instrument' translation file specified.") + call hdmopen (Memc[output]) + call cmb_images (images, extns, subsets, nimages, nsubsets) + if (nsubsets == 0) + call error (0, "No images to combine") + + # Get task parameters. Some additional parameters are obtained later. + call clgstr ("output", Memc[outroot], SZ_FNAME) + call clgstr ("plfile", Memc[plroot], SZ_FNAME) + call clgstr ("sigma", Memc[sigroot], SZ_FNAME) + call clgstr ("logfile", Memc[logfile], SZ_FNAME) + call xt_stripwhite (Memc[outroot]) + call xt_stripwhite (Memc[sigroot]) + call xt_stripwhite (Memc[logfile]) + + project = clgetb ("project") + combine = clgwrd ("combine", Memc[output], SZ_FNAME, COMBINE) + reject = clgwrd ("reject", Memc[output], SZ_FNAME, REJECT) + blank = clgetr ("blank") + call clgstr ("gain", Memc[gain], SZ_FNAME) + call clgstr ("rdnoise", Memc[rdnoise], SZ_FNAME) + call clgstr ("snoise", Memc[snoise], SZ_FNAME) + lthresh = clgetr ("lthreshold") + hthresh = clgetr ("hthreshold") + lsigma = clgetr ("lsigma") + hsigma = clgetr ("hsigma") + grow = clgeti ("grow") + mclip = clgetb ("mclip") + sigscale = clgetr ("sigscale") + delete = clgetb ("delete") + + # Check parameters, map INDEFs, and set threshold flag + if (IS_INDEFR (blank)) + blank = 0. + if (IS_INDEFR (lsigma)) + lsigma = MAX_REAL + if (IS_INDEFR (hsigma)) + hsigma = MAX_REAL + if (IS_INDEFI (grow)) + grow = 0 + if (IS_INDEF (sigscale)) + sigscale = 0. + + if (IS_INDEF(lthresh) && IS_INDEF(hthresh)) + dothresh = false + else { + dothresh = true + if (IS_INDEF(lthresh)) + lthresh = -MAX_REAL + if (IS_INDEF(hthresh)) + hthresh = MAX_REAL + } + + # This is here for backward compatibility. + if (clgetb ("clobber")) + call error (1, "Clobber option is no longer supported") + + # Combine each input subset. + do i = 1, nsubsets { + # Set the output, pl, and sigma image names with subset extension. + + call strcpy (Memc[outroot], Memc[output], SZ_FNAME) + call sprintf (Memc[output], SZ_FNAME, "%s%s") + call pargstr (Memc[outroot]) + call pargstr (Memc[Memi[extns+i-1]]) + + call strcpy (Memc[plroot], Memc[plfile], SZ_FNAME) + if (Memc[plfile] != EOS) { + call sprintf (Memc[plfile], SZ_FNAME, "%s%s") + call pargstr (Memc[plroot]) + # Use this if we can append pl files. + #call pargstr (Memc[Memi[extns+i-1]]) + call pargstr (Memc[Memi[subsets+i-1]]) + } + + call strcpy (Memc[sigroot], Memc[sigma], SZ_FNAME) + if (Memc[sigma] != EOS) { + call sprintf (Memc[sigma], SZ_FNAME, "%s%s") + call pargstr (Memc[sigroot]) + call pargstr (Memc[Memi[extns+i-1]]) + } + + # Combine all images from the (subset) list. + iferr (call icombine (Memc[Memi[images+i-1]], Memi[nimages+i-1], + Memc[output], Memc[plfile], Memc[sigma], + Memc[logfile], NO, delete)) { + call erract (EA_WARN) + } + call mfree (Memi[images+i-1], TY_CHAR) + call mfree (Memi[extns+i-1], TY_CHAR) + call mfree (Memi[subsets+i-1], TY_CHAR) + } + + # Finish up. + call mfree (images, TY_POINTER) + call mfree (extns, TY_POINTER) + call mfree (subsets, TY_POINTER) + call mfree (nimages, TY_INT) + call hdmclose () + call sfree (sp) +end + + +# CMB_IMAGES -- Get images from a list of images. +# The images are filtered by ccdtype and sorted by amplifier and subset. +# The allocated lists must be freed by the caller. + +procedure cmb_images (images, extns, subsets, nimages, nsubsets) + +pointer images # Pointer to lists of subsets (allocated) +pointer extns # Image extensions for each subset (allocated) +pointer subsets # Subset names (allocated) +pointer nimages # Number of images in subset (allocated) +int nsubsets # Number of subsets + +int list # List of input images +bool doamps # Divide input into subsets by amplifier? +bool dosubsets # Divide input into subsets by subset parameter? +bool extend # Add extensions to output image names? + +int i, nimage, ccdtype +pointer sp, type, image, extn, subset, str, ptr, im +#int imtopenp(), imtlen(), imtgetim(), ccdtypecl(), ccdtypes() +int imtopenp(), imtlen(), imtgetim() +pointer immap() +bool clgetb(), streq() + +begin + # Get the input image list and check that there is at least one image. + nsubsets = 0 + list = imtopenp ("input") + nimage = imtlen (list) + if (nimage == 0) { + call imtclose (list) + return + } + + # Determine whether to divide images into subsets and append extensions. + #doamps = clgetb ("amps") + doamps = false + dosubsets = clgetb ("subsets") + #extend = clgetb ("extensions") + extend = true + + call smark (sp) + call salloc (type, SZ_FNAME, TY_CHAR) + call salloc (image, SZ_FNAME, TY_CHAR) + call salloc (extn, SZ_FNAME, TY_CHAR) + call salloc (subset, SZ_FNAME, TY_CHAR) + call salloc (str, SZ_FNAME, TY_CHAR) + + # Go through the input list and eliminate images not satisfying the + # CCD image type. Separate into subsets if desired. Create image + # and subset lists. + + #ccdtype = ccdtypecl ("ccdtype", Memc[type], SZ_FNAME) + ccdtype = 0 + call clgstr ("ccdtype", Memc[type], SZ_FNAME) + call xt_stripwhite (Memc[type]) + + while (imtgetim (list, Memc[image], SZ_FNAME)!=EOF) { + iferr (im = immap (Memc[image], READ_ONLY, 0)) { + call erract (EA_WARN) + next + } + #ccdtype = ccdtypes (im, Memc[str], SZ_FNAME) + call ccdtypes (im, Memc[str], SZ_FNAME) + if (Memc[type] != EOS && !streq (Memc[str], Memc[type])) + next + + Memc[extn] = EOS + Memc[subset] = EOS + if (doamps) { + #call ccdamp (im, Memc[str], SZ_FNAME) + Memc[str] = EOS + if (extend) + call strcat (Memc[str], Memc[extn], SZ_FNAME) + call strcat (Memc[str], Memc[subset], SZ_FNAME) + } + if (dosubsets) { + call ccdsubset (im, Memc[str], SZ_FNAME) + call strcat (Memc[str], Memc[extn], SZ_FNAME) + call strcat (Memc[str], Memc[subset], SZ_FNAME) + } + for (i=1; i <= nsubsets; i=i+1) + if (streq (Memc[subset], Memc[Memi[subsets+i-1]])) + break + + if (i > nsubsets) { + if (nsubsets == 0) { + call malloc (images, nimage, TY_POINTER) + call malloc (extns, nimage, TY_POINTER) + call malloc (subsets, nimage, TY_POINTER) + call malloc (nimages, nimage, TY_INT) + } else if (mod (nsubsets, nimage) == 0) { + call realloc (images, nsubsets+nimage, TY_POINTER) + call realloc (extns, nsubsets+nimage, TY_POINTER) + call realloc (subsets, nsubsets+nimage, TY_POINTER) + call realloc (nimages, nsubsets+nimage, TY_INT) + } + nsubsets = i + call malloc (ptr, SZ_FNAME, TY_CHAR) + call strcpy (Memc[image], Memc[ptr], SZ_FNAME-1) + Memi[images+i-1] = ptr + call malloc (ptr, SZ_FNAME, TY_CHAR) + call strcpy (Memc[extn], Memc[ptr], SZ_FNAME) + Memi[extns+i-1] = ptr + call malloc (ptr, SZ_FNAME, TY_CHAR) + call strcpy (Memc[subset], Memc[ptr], SZ_FNAME) + Memi[subsets+i-1] = ptr + Memi[nimages+i-1] = 1 + } else { + ptr = Memi[images+i-1] + nimage = Memi[nimages+i-1] + 1 + call realloc (ptr, nimage * SZ_FNAME, TY_CHAR) + Memi[images+i-1] = ptr + Memi[nimages+i-1] = nimage + ptr = ptr + (nimage - 1) * SZ_FNAME + call strcpy (Memc[image], Memc[ptr], SZ_FNAME-1) + } + + call imunmap (im) + } + call realloc (images, nsubsets, TY_POINTER) + call realloc (extns, nsubsets, TY_POINTER) + call realloc (subsets, nsubsets, TY_POINTER) + call realloc (nimages, nsubsets, TY_INT) + call imtclose (list) + call sfree (sp) +end + + +# ICOMBINE -- Combine the CCD images in a list. +# This procedure maps the images, sets the output dimensions and datatype, +# opens the logfile, and sets IMIO parameters. It attempts to adjust +# buffer sizes and memory requirements for maximum efficiency. + +procedure icombine (images, nims, output, plfile, sigma, logfile, stack, + delete) + +char images[SZ_FNAME-1, nims] # Input images +int nims # Number of images in list +char output[ARB] # Output image +char plfile[ARB] # Pixel list file +char sigma[ARB] # Output sigma image +char logfile[ARB] # Log filename +int stack # Stack input images? +bool delete # Delete input images? + +char errstr[SZ_LINE] +int i, j, nimages, intype, bufsize, maxsize, memory, oldsize, stack1, err +pointer sp, sp1, in, out[3], offsets, temp, key, tmp + +int getdatatype() +real clgetr() +char clgetc() +int clgeti(), begmem(), errget(), open(), ty_max(), sizeof() +pointer immap(), ic_plfile() +errchk ic_imstack, immap, ic_plfile, ic_setout, ccddelete + +include "icombine.com" + +define retry_ 98 +define done_ 99 + +begin + call smark (sp) + + # Set number of images to combine. + if (project) { + if (nims > 1) { + call sfree (sp) + call error (1, "Cannot project combine a list of images") + } + tmp = immap (images[1,1], READ_ONLY, 0); out[1] = tmp + if (IM_NDIM(out[1]) == 1) + call error (1, "Can't project one dimensional images") + nimages = IM_LEN(out[1],IM_NDIM(out[1])) + call imunmap (out[1]) + } else + nimages = nims + + # Convert the nkeep parameter if needed. + # Convert the pclip parameter to a number of pixels rather than + # a fraction. This number stays constant even if pixels are + # rejected. The number of low and high pixel rejected, however, + # are converted to a fraction of the valid pixels. + + nkeep = clgeti ("nkeep") + if (nkeep < 0) + nkeep = max (0, nimages + nkeep) + + if (reject == PCLIP) { + pclip = clgetr ("pclip") + if (pclip == 0.) + call error (1, "Pclip parameter may not be zero") + if (IS_INDEFR (pclip)) + pclip = -0.5 + + i = nimages / 2. + if (abs (pclip) < 1.) + pclip = pclip * i + if (pclip < 0.) + pclip = min (-1, max (-i, int (pclip))) + else + pclip = max (1, min (i, int (pclip))) + } + + if (reject == MINMAX) { + flow = clgetr ("nlow") + fhigh = clgetr ("nhigh") + if (IS_INDEFR (flow)) + flow = 0 + if (IS_INDEFR (fhigh)) + fhigh = 0 + + if (flow >= 1) + flow = flow / nimages + if (fhigh >= 1) + fhigh = fhigh / nimages + i = flow * nimages + j = fhigh * nimages + if (i + j == 0) + reject = NONE + else if (i + j >= nimages) { + call eprintf ("Bad minmax rejection parameters\n") + call sfree (sp) + return + } + } + + # Map the input images. + bufsize = 0 + stack1 = stack +retry_ + iferr { + out[1] = NULL + out[2] = NULL + out[3] = NULL + icm = NULL + logfd = NULL + + call smark (sp1) + if (stack1 == YES) { + call salloc (temp, SZ_FNAME, TY_CHAR) + call mktemp ("tmp", Memc[temp], SZ_FNAME) + call ic_imstack (images, nimages, Memc[temp]) + project = true + } + + # Map the input image(s). + if (project) { + if (stack1 == YES) { + tmp = immap (Memc[temp], READ_ONLY, 0); out[1] = tmp + } else { + tmp = immap (images[1,1], READ_ONLY, 0); out[1] = tmp + } + nimages = IM_LEN(out[1],IM_NDIM(out[1])) + call calloc (in, nimages, TY_POINTER) + call amovki (out[1], Memi[in], nimages) + } else { + call calloc (in, nimages, TY_POINTER) + do i = 1, nimages { + tmp = immap (images[1,i], READ_ONLY, 0); Memi[in+i-1] = tmp + } + } + + # Map the output image and set dimensions and offsets. + tmp = immap (output, NEW_COPY, Memi[in]); out[1] = tmp + if (stack1 == YES) { + call salloc (key, SZ_FNAME, TY_CHAR) + do i = 1, nimages { + call sprintf (Memc[key], SZ_FNAME, "stck%04d") + call pargi (i) + call imdelf (out[1], Memc[key]) + } + } + call salloc (offsets, nimages*IM_NDIM(out[1]), TY_INT) + call ic_setout (Memi[in], out, Memi[offsets], nimages) + + # Determine the highest precedence datatype and set output datatype. + intype = IM_PIXTYPE(Memi[in]) + do i = 2, nimages + intype = ty_max (intype, IM_PIXTYPE(Memi[in+i-1])) + IM_PIXTYPE(out[1]) = getdatatype (clgetc ("outtype")) + if (IM_PIXTYPE(out[1]) == ERR) + IM_PIXTYPE(out[1]) = intype + + # Open pixel list file if given. + if (plfile[1] != EOS) { + tmp = ic_plfile (plfile, NEW_COPY, out[1]); out[2] = tmp + } else + out[2] = NULL + + # Open the sigma image if given. + if (sigma[1] != EOS) { + tmp = immap (sigma, NEW_COPY, out[1]); out[3] = tmp + IM_PIXTYPE(out[3]) = ty_max (TY_REAL, IM_PIXTYPE(out[1])) + call sprintf (IM_TITLE(out[3]), SZ_IMTITLE, + "Combine sigma images for %s") + call pargstr (output) + } else + out[3] = NULL + + # This is done here to work around problem adding a keyword to + # an NEW_COPY header and then using that header in a NEW_COPY. + + # Open masks. + call ic_mopen (Memi[in], out, nimages) + + # Open the log file. + logfd = NULL + if (logfile[1] != EOS) { + iferr (logfd = open (logfile, APPEND, TEXT_FILE)) { + logfd = NULL + call erract (EA_WARN) + } + } + + if (bufsize == 0) { + # Set initial IMIO buffer size based on the number of images + # and maximum amount of working memory available. The buffer + # size may be adjusted later if the task runs out of memory. + # The FUDGE factor is used to allow for the size of the + # program, memory allocator inefficiencies, and any other + # memory requirements besides IMIO. + + bufsize = 1 + do i = 1, IM_NDIM(out[1]) + bufsize = bufsize * IM_LEN(out[1],i) + bufsize = bufsize * sizeof (intype) + bufsize = min (bufsize, DEFBUFSIZE) + memory = begmem ((nimages + 1) * bufsize, oldsize, maxsize) + memory = min (memory, int (FUDGE * maxsize)) + bufsize = memory / (nimages + 1) + } + + # Combine the images. If an out of memory error occurs close all + # images and files, divide the IMIO buffer size in half and try + # again. + + switch (intype) { + case TY_SHORT: + call icombines (Memi[in], out, Memi[offsets], nimages, + bufsize) + default: + call icombiner (Memi[in], out, Memi[offsets], nimages, + bufsize) + } + } then { + err = errget (errstr, SZ_LINE) + if (icm != NULL) + call ic_mclose (nimages) + if (!project) { + do j = 2, nimages + if (Memi[in+j-1] != NULL) + call imunmap (Memi[in+j-1]) + } + if (out[2] != NULL) { + call imunmap (out[2]) + call imdelete (plfile) + } + if (out[3] != NULL) { + call imunmap (out[3]) + call imdelete (sigma) + } + if (out[1] != NULL) { + call imunmap (out[1]) + call imdelete (output) + } + if (Memi[in] != NULL) + call imunmap (Memi[in]) + if (logfd != NULL) + call close (logfd) + + switch (err) { + case SYS_MFULL: + bufsize = bufsize / 2 + call sfree (sp1) + goto retry_ + case SYS_FTOOMANYFILES, SYS_IKIOPIX: + if (!project) { + stack1 = YES + call sfree (sp1) + goto retry_ + } + if (stack1 == YES) + call imdelete (Memc[temp]) + call fixmem (oldsize) + call sfree (sp1) + call error (err, errstr) + default: + if (stack1 == YES) + call imdelete (Memc[temp]) + call fixmem (oldsize) + call sfree (sp1) + call error (err, errstr) + } + } + + # Unmap all the images, close the log file, and restore memory. + # The input images must be unmapped first to insure that there + # is a FD for the output images since the headers are opened to + # update them. However, the order of the NEW_COPY pointers must + # be preserved; i.e. the output depends on the first input image, + # and the extra output images depend on the output image. + + if (!project) { + do i = 2, nimages { + if (Memi[in+i-1] != NULL) { + call imunmap (Memi[in+i-1]) + if (delete) + call ccddelete (images[1,i]) + } + } + } + if (out[2] != NULL) + call imunmap (out[2]) + if (out[3] != NULL) + call imunmap (out[3]) + if (out[1] != NULL) + call imunmap (out[1]) + if (Memi[in] != NULL) + call imunmap (Memi[in]) + if (stack1 == YES) + call imdelete (Memc[temp]) + if (delete) + call ccddelete (images[1,1]) + if (logfd != NULL) + call close (logfd) + if (icm != NULL) + call ic_mclose (nimages) + + call fixmem (oldsize) + call sfree (sp) +end + + +# TY_MAX -- Return the datatype of highest precedence. + +int procedure ty_max (type1, type2) + +int type1, type2 # Datatypes + +int i, j, type, order[8] +data order/TY_SHORT,TY_USHORT,TY_INT,TY_LONG,TY_REAL,TY_DOUBLE,TY_COMPLEX,TY_REAL/ + +begin + for (i=1; (i<=7) && (type1!=order[i]); i=i+1) + ; + for (j=1; (j<=7) && (type2!=order[j]); j=j+1) + ; + type = order[max(i,j)] + + # Special case of mixing short and unsigned short. + if (type == TY_USHORT && type1 != type2) + type = TY_INT + + return (type) +end + + +# IC_PLFILE -- Map pixel list file +# This routine strips any image extensions and then adds .pl. + +pointer procedure ic_plfile (plfile, mode, refim) + +char plfile[ARB] # Pixel list file name +int mode # Image mode +pointer refim # Reference image +pointer pl # IMIO pointer (returned) + +int i, strlen() +bool streq +pointer sp, str, immap() + +begin + call smark (sp) + call salloc (str, SZ_FNAME, TY_CHAR) + + call imgimage (plfile, Memc[str], SZ_FNAME) + + # Strip any existing extensions + i = strlen(Memc[str]) + switch (Memc[str+i-1]) { + case 'h': + if (i > 3 && Memc[str+i-4] == '.') + Memc[str+i-4] = EOS + case 'l': + if (i > 2 && streq (Memc[str+i-3], ".pl")) + Memc[str+i-3] = EOS + } + + call strcat (".pl", Memc[str], SZ_FNAME) + pl = immap (Memc[str], NEW_COPY, refim) + call sfree (sp) + return (pl) +end diff --git a/noao/imred/ccdred/src/t_mkfringe.x b/noao/imred/ccdred/src/t_mkfringe.x new file mode 100644 index 00000000..d3e2e82d --- /dev/null +++ b/noao/imred/ccdred/src/t_mkfringe.x @@ -0,0 +1,191 @@ +include <imhdr.h> +include "ccdred.h" + + +# T_MKFRINGECOR -- CL task to make fringe correction image. The large scale +# background of the input images is subtracted from the input image to obtain +# the output fringe correction image. The image is first processed if needed. + +procedure t_mkfringecor() + +int listin # List of input CCD images +int listout # List of output CCD images +int ccdtype # CCD image type +int interactive # Fit overscan interactively? + +bool clgetb(), streq() +int imtopenp(), imtgetim() +pointer sp, input, output, tmp, str, in, out, ccd +errchk set_input, set_output, ccddelete + +begin + call smark (sp) + call salloc (input, SZ_FNAME, TY_CHAR) + call salloc (output, SZ_FNAME, TY_CHAR) + call salloc (tmp, SZ_FNAME, TY_CHAR) + call salloc (str, SZ_LINE, TY_CHAR) + + # Get the lists and instrument translation file. Open the translation + # file. Initialize the interactive flag and the calibration images. + + listin = imtopenp ("input") + listout = imtopenp ("mkfringecor.output") + call clgstr ("instrument", Memc[input], SZ_FNAME) + if (Memc[input] == EOS) + call error (1, "No 'instrument' translation file specified.") + call hdmopen (Memc[input]) + call set_interactive ("", interactive) + call cal_open (NULL) + call ccd_open (0) + + # Process each image. + while (imtgetim (listin, Memc[input], SZ_FNAME) != EOF) { + if (clgetb ("noproc")) { + call printf ("%s: mkfringecor\n") + call pargstr (Memc[input]) + } + + # Set input and output images. Use temporary image if needed. + call set_input (Memc[input], in, ccdtype) + if (in == NULL) + next + + if (imtgetim (listout, Memc[output], SZ_FNAME) == EOF) + call strcpy (Memc[input], Memc[output], SZ_FNAME) + if (Memc[output] == EOS) + call strcpy (Memc[input], Memc[output], SZ_FNAME) + if (streq (Memc[input], Memc[output])) + call mktemp ("tmp", Memc[tmp], SZ_FNAME) + else + call strcpy (Memc[output], Memc[tmp], SZ_FNAME) + call set_output (in, out, Memc[tmp]) + + # Process image as a flat field image. + call set_proc (in, out, ccd) + call set_sections (ccd) + call set_trim (ccd) + call set_fixpix (ccd) + call set_overscan (ccd) + call set_zero (ccd) + call set_dark (ccd) + call set_flat (ccd) + call set_illum (ccd) + + # Do the processing. + if (CORS(ccd) == YES) { + call doproc (ccd) + call set_header (ccd) + + # Finish up + call imunmap (in) + call imunmap (out) + if (streq (Memc[input], Memc[output])) { + call ccddelete (Memc[input]) + call imrename (Memc[tmp], Memc[input]) + } else + call strcpy (Memc[output], Memc[input], SZ_FNAME) + } else { + # Delete the temporary output image. Make a copy if needed. + call imunmap (in) + call imunmap (out) + call imdelete (Memc[tmp]) + } + call free_proc (ccd) + + # Do special processing. + call mkfringecor (Memc[input], Memc[output]) + if (!streq (Memc[input], Memc[output])) + call ccdcopy (Memc[input], Memc[output]) + } + + # Finish up. + call hdmclose () + call imtclose (listin) + call imtclose (listout) + call cal_close () + call ccd_close () + call sfree (sp) +end + + +# MKFRINGECOR -- Given an input image which has been processed make the output +# fringe correction image. + +procedure mkfringecor (input, output) + +char input[SZ_FNAME] # Input image +char output[SZ_FNAME] # Output image + +int i, nc, nl +pointer sp, str, illum, tmp, in, im, out, out1 +bool clgetb(), ccdflag(), streq() +pointer immap(), imgl2r(), impl2r() +errchk immap, ccddelete + +begin + # Check if this operation has been done. + in = immap (input, READ_ONLY, 0) + if (ccdflag (in, "mkfringe")) { + call imunmap (in) + return + } + + # Print operation if not processing. + if (clgetb ("noproc")) { + call eprintf ( + " [TO BE DONE] Make fringe correction\n") + call pargstr (input) + call imunmap (in) + return + } + + call smark (sp) + call salloc (str, SZ_LINE, TY_CHAR) + call salloc (illum, SZ_FNAME, TY_CHAR) + call salloc (tmp, SZ_FNAME, TY_CHAR) + + # Make the illumination image. + call imunmap (in) + call strcpy (input, Memc[tmp], SZ_FNAME) + call mktemp ("tmp", Memc[illum], SZ_FNAME) + call mkillumination (Memc[tmp], Memc[illum], NO, NO) + + in = immap (input, READ_ONLY, 0) + im = immap (Memc[illum], READ_ONLY, 0) + + # Create the temporary output. + if (streq (input, output)) { + call mktemp ("tmp", Memc[tmp], SZ_FNAME) + call set_output (in, out, Memc[tmp]) + out1 = in + } else { + call set_output (in, out, output) + out1 = out + } + + # Subtract the illumination from input image. + nc = IM_LEN(out,1) + nl = IM_LEN(out,2) + do i = 1, nl + call asubr (Memr[imgl2r(in,i)], Memr[imgl2r(im,i)], + Memr[impl2r(out,i)], nc) + + # Log the operation. + call sprintf (Memc[str], SZ_LINE, "Fringe correction created") + call timelog (Memc[str], SZ_LINE) + call ccdlog (out1, Memc[str]) + call hdmpstr (out, "mkfringe", Memc[str]) + call hdmpstr (out, "imagetyp", "fringe") + + # Finish up + call imunmap (in) + call imunmap (im) + call imunmap (out) + call imdelete (Memc[illum]) + if (streq (input, output)) { + call ccddelete (input) + call imrename (Memc[tmp], input) + } else + call strcpy (output, input, SZ_FNAME) + call sfree (sp) +end diff --git a/noao/imred/ccdred/src/t_mkillumcor.x b/noao/imred/ccdred/src/t_mkillumcor.x new file mode 100644 index 00000000..e9113f01 --- /dev/null +++ b/noao/imred/ccdred/src/t_mkillumcor.x @@ -0,0 +1,108 @@ +include "ccdred.h" + +# T_MKILLUMCOR -- Make flat field illumination correction images. +# +# The input flat field images are processed and smoothed to obtain +# illumination correction images. These illumination correction images +# are used to correct already processed images for illumination effects +# introduced by the flat field. + +procedure t_mkillumcor() + +int listin # List of input CCD images +int listout # List of output CCD images +int ccdtype # CCD image type +int interactive # Fit overscan interactively? + +bool clgetb(), streq() +int imtopenp(), imtgetim() +pointer sp, input, output, tmp, str, in, out, ccd +errchk set_input, set_output, ccddelete + +begin + call smark (sp) + call salloc (input, SZ_FNAME, TY_CHAR) + call salloc (output, SZ_FNAME, TY_CHAR) + call salloc (tmp, SZ_FNAME, TY_CHAR) + call salloc (str, SZ_LINE, TY_CHAR) + + # Get the lists and instrument translation file. Open the translation + # file. Initialize the interactive flag and the calibration images. + + listin = imtopenp ("input") + listout = imtopenp ("mkillumcor.output") + call clgstr ("instrument", Memc[input], SZ_FNAME) + if (Memc[input] == EOS) + call error (1, "No 'instrument' translation file specified.") + call hdmopen (Memc[input]) + call set_interactive ("", interactive) + call cal_open (NULL) + call ccd_open (0) + + # Process each image. + while (imtgetim (listin, Memc[input], SZ_FNAME) != EOF) { + if (clgetb ("noproc")) { + call printf ("%s: mkillumcor\n") + call pargstr (Memc[input]) + } + + # Set input and output images. + call set_input (Memc[input], in, ccdtype) + if (in == NULL) + next + + if (imtgetim (listout, Memc[output], SZ_FNAME) == EOF) + call strcpy (Memc[input], Memc[output], SZ_FNAME) + if (Memc[output] == EOS) + call strcpy (Memc[input], Memc[output], SZ_FNAME) + if (streq (Memc[input], Memc[output])) + call mktemp ("tmp", Memc[tmp], SZ_FNAME) + else + call strcpy (Memc[output], Memc[tmp], SZ_FNAME) + call set_output (in, out, Memc[tmp]) + + # Process image as an illumination image. + call set_proc (in, out, ccd) + call set_sections (ccd) + call set_trim (ccd) + call set_fixpix (ccd) + call set_overscan (ccd) + call set_zero (ccd) + call set_dark (ccd) + CORS(ccd, FINDMEAN) = YES + + # Do the processing if the COR flag is set. + if (COR(ccd) == YES) { + call doproc (ccd) + call set_header (ccd) + + # Replace the input image by the corrected image. + call imunmap (in) + call imunmap (out) + if (streq (Memc[input], Memc[output])) { + call ccddelete (Memc[input]) + call imrename (Memc[tmp], Memc[input]) + } else + call strcpy (Memc[output], Memc[input], SZ_FNAME) + } else { + # Make a copy if necessary. + call imunmap (in) + call imunmap (out) + call imdelete (Memc[tmp]) + } + call free_proc (ccd) + + # Do special processing. + call mkillumination (Memc[input], Memc[output], YES, YES) + if (!streq (Memc[input], Memc[output])) + call ccdcopy (Memc[input], Memc[output]) + } + + # Finish up. + call hdmclose () + call imtclose (listin) + call imtclose (listout) + call cal_close () + call ccd_close () + call sfree (sp) +end diff --git a/noao/imred/ccdred/src/t_mkillumft.x b/noao/imred/ccdred/src/t_mkillumft.x new file mode 100644 index 00000000..ecb66a8e --- /dev/null +++ b/noao/imred/ccdred/src/t_mkillumft.x @@ -0,0 +1,229 @@ +include <imhdr.h> +include "ccdred.h" + + +# T_MKILLUMFLAT -- Make illumination corrected flat field images. +# +# The input flat field images are processed and smoothed to obtain +# illumination pattern. The illumination pattern is then divided out +# of the input image to make the output illumination corrected flat field +# image. + +procedure t_mkillumflat() + +int listin # List of input CCD images +int listout # List of output CCD images +int ccdtype # CCD image type +int interactive # Fit overscan interactively? + +bool clgetb(), streq() +int imtopenp(), imtgetim() +pointer sp, input, output, tmp, str, in, out, ccd +errchk set_input, set_output, ccddelete + +begin + call smark (sp) + call salloc (input, SZ_FNAME, TY_CHAR) + call salloc (output, SZ_FNAME, TY_CHAR) + call salloc (tmp, SZ_FNAME, TY_CHAR) + call salloc (str, SZ_LINE, TY_CHAR) + + # Get the lists and instrument translation file. Open the translation + # file. Initialize the interactive flag and the calibration images. + + listin = imtopenp ("input") + listout = imtopenp ("mkillumflat.output") + call clgstr ("instrument", Memc[input], SZ_FNAME) + call hdmopen (Memc[input]) + call set_interactive ("", interactive) + call cal_open (NULL) + call ccd_open (0) + + # Process each image. + while (imtgetim (listin, Memc[input], SZ_FNAME) != EOF) { + if (clgetb ("noproc")) { + call printf ("%s: mkillumflat\n") + call pargstr (Memc[input]) + } + + # Set input and output images. Use temporary image if needed. + call set_input (Memc[input], in, ccdtype) + if (in == NULL) + next + + if (imtgetim (listout, Memc[output], SZ_FNAME) == EOF) + call strcpy (Memc[input], Memc[output], SZ_FNAME) + if (Memc[output] == EOS) + call strcpy (Memc[input], Memc[output], SZ_FNAME) + if (streq (Memc[input], Memc[output])) + call mktemp ("tmp", Memc[tmp], SZ_FNAME) + else + call strcpy (Memc[output], Memc[tmp], SZ_FNAME) + call set_output (in, out, Memc[tmp]) + + # Process image as a flat field image. + call set_proc (in, out, ccd) + call set_sections (ccd) + call set_trim (ccd) + call set_fixpix (ccd) + call set_overscan (ccd) + call set_zero (ccd) + call set_dark (ccd) + + # Do the processing. + if (CORS(ccd) == YES) { + call doproc (ccd) + call set_header (ccd) + + # Finish up + call imunmap (in) + call imunmap (out) + if (streq (Memc[input], Memc[output])) { + call ccddelete (Memc[input]) + call imrename (Memc[tmp], Memc[input]) + } else + call strcpy (Memc[output], Memc[input], SZ_FNAME) + } else { + # Delete the temporary output image. Make a copy if needed. + call imunmap (in) + call imunmap (out) + call imdelete (Memc[tmp]) + } + call free_proc (ccd) + + # Do special processing. + call mkillumflat (Memc[input], Memc[output]) + if (!streq (Memc[input], Memc[output])) + call ccdcopy (Memc[input], Memc[output]) + } + + # Finish up. + call hdmclose () + call imtclose (listin) + call imtclose (listout) + call cal_close () + call ccd_close () + call sfree (sp) +end + + +# MKILLUMFLAT -- Take the processed input image and make the illumination +# corrected flat field output image. The illumination pattern is created +# as a temporary image and then the applied to the input flat field +# image to make the final output flat field image. If the input and +# output names are the same the operation is done in place. + +procedure mkillumflat (input, output) + +char input[SZ_FNAME] # Input image +char output[SZ_FNAME] # Output image + +int i, nc, nl +real scale +long time +pointer sp, str, illum, tmp, in, im, out, out1, data + +bool clgetb(), ccdflag(), streq() +int hdmgeti() +real hdmgetr(), clgetr(), divzero() +pointer immap(), imgl2r(), impl2r() +errchk immap, ccddelete +extern divzero() + +real rdivzero # Result for divion by zero +int ndivzero # Number of zero divisions +common /cdivzero/ rdivzero, ndivzero + +begin + # Check if this operation has been done. + in = immap (input, READ_ONLY, 0) + if (ccdflag (in, "illumflt")) { + call imunmap (in) + return + } + + # Print operation if not processing. + if (clgetb ("noproc")) { + call eprintf ( + " [TO BE DONE] Remove illumination\n") + call pargstr (input) + call imunmap (in) + return + } + + # Get and set task parameters for division by zero. + rdivzero = clgetr ("divbyzero") + ndivzero = 0 + + call smark (sp) + call salloc (str, SZ_LINE, TY_CHAR) + call salloc (illum, SZ_FNAME, TY_CHAR) + call salloc (tmp, SZ_FNAME, TY_CHAR) + + # Make the illumination image. + call imunmap (in) + call strcpy (input, Memc[tmp], SZ_FNAME) + call mktemp ("tmp", Memc[illum], SZ_FNAME) + call mkillumination (Memc[tmp], Memc[illum], NO, NO) + + in = immap (input, READ_ONLY, 0) + im = immap (Memc[illum], READ_ONLY, 0) + iferr (scale = hdmgetr (im, "ccdmean")) + scale = 1. + iferr (time = hdmgeti (im, "ccdmeant")) + time = IM_MTIME(im) + if (time < IM_MTIME(im)) + scale = 1. + + # Create the temporary output. + if (streq (input, output)) { + call mktemp ("tmp", Memc[tmp], SZ_FNAME) + call set_output (in, out, Memc[tmp]) + out1 = in + } else { + call set_output (in, out, output) + out1 = out + } + + # Divide the illumination and flat field images with scaling. + nc = IM_LEN(out,1) + nl = IM_LEN(out,2) + do i = 1, nl { + data = impl2r (out, i) + call advzr (Memr[imgl2r(in,i)], Memr[imgl2r(im,i)], + Memr[data], nc, divzero) + if (scale != 1.) + call amulkr (Memr[data], scale, Memr[data], nc) + } + + # Log the operation. + if (ndivzero > 0) { + call sprintf (Memc[str], SZ_LINE, + "Warning: %d divisions by zero replaced by %g") + call pargi (ndivzero) + call pargr (rdivzero) + call ccdlog (out1, Memc[str]) + } + call sprintf (Memc[str], SZ_LINE, "Removed illumination from flat") + call sprintf (Memc[str], SZ_LINE, + "Illumination flat created from %s") + call pargstr (input) + call timelog (Memc[str], SZ_LINE) + call ccdlog (out1, Memc[str]) + call hdmpstr (out, "illumflt", Memc[str]) + call hdmpstr (out, "imagetyp", "flat") + + # Finish up + call imunmap (in) + call imunmap (im) + call imunmap (out) + call imdelete (Memc[illum]) + + # The input name is changed to the output name for further processing. + if (streq (input, output)) { + call ccddelete (input) + call imrename (Memc[tmp], input) + } else + call strcpy (output, input, SZ_FNAME) + call sfree (sp) +end diff --git a/noao/imred/ccdred/src/t_mkskycor.x b/noao/imred/ccdred/src/t_mkskycor.x new file mode 100644 index 00000000..fa3f3cd4 --- /dev/null +++ b/noao/imred/ccdred/src/t_mkskycor.x @@ -0,0 +1,694 @@ +include <imhdr.h> +include <imset.h> +include <mach.h> +include "ccdred.h" + +define MINSIGMA 1. # Minimum sigma +define NITERATE 10 # Maximum number of clipping iterations + +# T_MKSKYCOR -- Make sky illumination correction images. +# +# The input images processed and smoothed to obtain an illumination correction +# image. This task is a version of T_CCDPROC which treats the images as +# illumination images regardless of there CCD image type. + +procedure t_mkskycor() + +int listin # List of input CCD images +int listout # List of output CCD images +int ccdtype # CCD image type +int interactive # Fit overscan interactively? + +bool flatcor, ccdflag(), clgetb(), streq() +int imtopenp(), imtgetim() +pointer sp, input, output, tmp, str, in, out, ccd +errchk set_input, set_output, ccddelete + +begin + call smark (sp) + call salloc (input, SZ_FNAME, TY_CHAR) + call salloc (output, SZ_FNAME, TY_CHAR) + call salloc (tmp, SZ_FNAME, TY_CHAR) + call salloc (str, SZ_LINE, TY_CHAR) + + # Get the lists and instrument translation file. Open the translation + # file. Initialize the interactive flag and the calibration images. + + listin = imtopenp ("input") + listout = imtopenp ("mkskycor.output") + call clgstr ("instrument", Memc[input], SZ_FNAME) + if (Memc[input] == EOS) + call error (1, "No 'instrument' translation file specified.") + call hdmopen (Memc[input]) + call set_interactive ("", interactive) + call cal_open (NULL) + call ccd_open (0) + + # Process each image. + while (imtgetim (listin, Memc[input], SZ_FNAME) != EOF) { + if (clgetb ("noproc")) { + call printf ("%s: mkskycor\n") + call pargstr (Memc[input]) + } + + # Set input and output images. + call set_input (Memc[input], in, ccdtype) + if (in == NULL) + next + + if (imtgetim (listout, Memc[output], SZ_FNAME) == EOF) + call strcpy (Memc[input], Memc[output], SZ_FNAME) + if (Memc[output] == EOS) + call strcpy (Memc[input], Memc[output], SZ_FNAME) + if (streq (Memc[input], Memc[output])) + call mktemp ("tmp", Memc[tmp], SZ_FNAME) + else + call strcpy (Memc[output], Memc[tmp], SZ_FNAME) + call set_output (in, out, Memc[tmp]) + + # Process image as an illumination image. + call set_proc (in, out, ccd) + call set_sections (ccd) + call set_trim (ccd) + call set_fixpix (ccd) + call set_overscan (ccd) + call set_zero (ccd) + call set_dark (ccd) + call set_flat (ccd) + + # Do the processing if the COR flag is set. + if (COR(ccd) == YES) { + call doproc (ccd) + call set_header (ccd) + + # Replace the input image by the corrected image. + flatcor = ccdflag (out, "flatcor") + call imunmap (in) + call imunmap (out) + if (streq (Memc[input], Memc[output])) { + call ccddelete (Memc[input]) + call imrename (Memc[tmp], Memc[input]) + } else + call strcpy (Memc[output], Memc[input], SZ_FNAME) + } else { + # Make a copy if necessary. + flatcor = ccdflag (out, "flatcor") + call imunmap (in) + call imunmap (out) + call imdelete (Memc[tmp]) + } + call free_proc (ccd) + + # Do special processing. + if (!flatcor) { + call eprintf ( + "%s: WARNING - Image should be flat fielded first\n") + call pargstr (Memc[input]) + } + call mkillumination (Memc[input], Memc[output], NO, YES) + if (!streq (Memc[input], Memc[output])) + call ccdcopy (Memc[input], Memc[output]) + } + + # Finish up. + call hdmclose () + call imtclose (listin) + call imtclose (listout) + call cal_close () + call ccd_close () + call sfree (sp) +end + + +# MKILLUMINATION -- Make illumination images. +# +# The images are boxcar smoothed to obtain the large scale illumination. +# Objects in the images are excluded from the average by sigma clipping. + +procedure mkillumination (input, output, inverse, log) + +char input[SZ_FNAME] # Input image +char output[SZ_FNAME] # Output image +int inverse # Return inverse of illumination +int log # Add log info? + +real xbminr # Minimum size of X smoothing box +real ybminr # Minimum size of Y smoothing box +real xbmaxr # Maximum size of X smoothing box +real ybmaxr # Maximum size of Y smoothing box +bool clip # Sigma clip +real lowsigma # Low sigma clip +real highsigma # High sigma clip + +int xbmin, ybmin, xbmax, ybmax +pointer sp, str, tmp, in, out, out1 + +bool clgetb(), ccdflag(), streq() +real clgetr() +pointer immap() +errchk immap, ccddelete + +real rdivzero # Result for divion by zero +int ndivzero # Number of zero divisions +common /cdivzero/ rdivzero, ndivzero + +begin + # Check if this operation has been done. Unfortunately this requires + # mapping the image. + + in = immap (input, READ_ONLY, 0) + if (ccdflag (in, "mkillum")) { + call imunmap (in) + return + } + + if (clgetb ("noproc")) { + call eprintf ( + " [TO BE DONE] Convert %s to illumination correction\n") + call pargstr (input) + call imunmap (in) + return + } + + # Get task parameters + xbminr = clgetr ("xboxmin") + ybminr = clgetr ("yboxmin") + xbmaxr = clgetr ("xboxmax") + ybmaxr = clgetr ("yboxmax") + clip = clgetb ("clip") + if (clip) { + lowsigma = max (MINSIGMA, clgetr ("lowsigma")) + highsigma = max (MINSIGMA, clgetr ("highsigma")) + } + if (inverse == YES) + rdivzero = clgetr ("divbyzero") + ndivzero = 0 + + call smark (sp) + call salloc (str, SZ_LINE, TY_CHAR) + call salloc (tmp, SZ_FNAME, TY_CHAR) + + # Create output. + if (streq (input, output)) { + call mktemp ("tmp", Memc[tmp], SZ_FNAME) + call set_output (in, out, Memc[tmp]) + out1 = in + } else { + call set_output (in, out, output) + out1 = out + } + + if (xbminr < 1.) + xbminr = xbminr * IM_LEN(in,1) + if (ybminr < 1.) + ybminr = ybminr * IM_LEN(in,2) + if (xbmaxr < 1.) + xbmaxr = xbmaxr * IM_LEN(in,1) + if (ybmaxr < 1.) + ybmaxr = ybmaxr * IM_LEN(in,2) + + xbmin = max (1, min (IM_LEN(in,1), nint (min (xbminr, xbmaxr)))) + xbmax = max (1, min (IM_LEN(in,1), nint (max (xbminr, xbmaxr)))) + ybmin = max (1, min (IM_LEN(in,2), nint (min (ybminr, ybmaxr)))) + ybmax = max (1, min (IM_LEN(in,2), nint (max (ybminr, ybmaxr)))) + + if (clip) + call illumination (in, out, xbmin, ybmin, xbmax, ybmax, + lowsigma, highsigma, inverse) + else + call qillumination (in, out, xbmin, ybmin, xbmax, ybmax, inverse) + + # Log the operation. + if (log == YES) { + if (ndivzero > 0) { + call sprintf (Memc[str], SZ_LINE, + "Warning: %d divisions by zero replaced by %g") + call pargi (ndivzero) + call pargr (rdivzero) + call ccdlog (out1, Memc[str]) + } + call sprintf (Memc[str], SZ_LINE, + "Illumination correction created from %s") + call pargstr (input) + call timelog (Memc[str], SZ_LINE) + call ccdlog (out1, Memc[str]) + } + call hdmpstr (out, "mkillum", Memc[str]) + call hdmpstr (out, "imagetyp", "illum") + + # Finish up + call imunmap (in) + call imunmap (out) + if (streq (input, output)) { + call ccddelete (input) + call imrename (Memc[tmp], input) + } else + call strcpy (output, input, SZ_FNAME) + call sfree (sp) +end + + +# ILLUMINATION -- Make illumination correction image with clipping. + +procedure illumination (in, out, xbmin, ybmin, xbmax, ybmax, low, high, inverse) + +pointer in # Pointer to the input image +pointer out # Pointer to the output image +int xbmin, ybmin # Minimum dimensions of the boxcar +int xbmax, ybmax # Maximum dimensions of the boxcar +real low, high # Clipping sigma thresholds +int inverse # Return inverse of illumination? + +real scale, ccdmean +int i, ncols, nlines, linein, lineout, ybox2, nrej +pointer sp, ptr, ptrs, data, sum, avg, output + +long clktime() +int boxclean() +real asumr(), divzero() +pointer imgl2r(), impl2r() +extern divzero() + +begin + # Set up an array of linepointers and accumulators + ncols = IM_LEN(out,1) + nlines = IM_LEN(out,2) + call smark (sp) + call salloc (ptrs, ybmax, TY_POINTER) + call salloc (sum, ncols, TY_REAL) + call salloc (avg, ncols, TY_REAL) + if (inverse == YES) + call salloc (output, ncols, TY_REAL) + else + output = avg + + # Set input buffers. + if (ybmax < nlines) + call imseti (in, IM_NBUFS, ybmax) + + # Get the first average over the minimum y box. + call aclrr (Memr[sum], ncols) + linein = 0 + while (linein < ybmin) { + linein = linein + 1 + data = imgl2r (in, linein) + call aaddr (Memr[data], Memr[sum], Memr[sum], ncols) + ptr = ptrs + mod (linein, ybmax) + Memi[ptr] = data + } + ybox2 = ybmin + scale = ybmin + call agboxcar (Memr[sum], Memr[avg], ncols, xbmin, xbmax, scale) + + # Iteratively clean the initial lines. + ptr = ptrs + if (ybox2 != ybmax) + ptr = ptr + 1 + do i = 1, NITERATE { + nrej = 0 + do lineout = 1, linein { + data = Memi[ptr+lineout-1] + nrej = nrej + boxclean (Memr[data], Memr[avg], Memr[sum], + ncols, low, high) + } + if (nrej > 0) + call agboxcar (Memr[sum], Memr[avg], ncols, xbmin, xbmax, + scale) + else + break + } + + # Output the minimum smoothing y box. + if (inverse == YES) + call arczr (1., Memr[avg], Memr[output], ncols, divzero) + ybox2 = (ybmin + 1) / 2 + lineout = 0 + while (lineout < ybox2) { + lineout = lineout + 1 + call amovr (Memr[output], Memr[impl2r(out, lineout)], ncols) + } + ccdmean = ybox2 * asumr (Memr[output], ncols) + + # Increase the y box size by factors of 2 until the maximum size. + while (linein < ybmax) { + linein = linein + 1 + data = imgl2r (in, linein) + call aaddr (Memr[sum], Memr[data], Memr[sum], ncols) + ptr = ptrs + mod (linein, ybmax) + Memi[ptr] = data + scale = scale + 1 + + nrej = boxclean (Memr[data], Memr[avg], Memr[sum], ncols, + low, high) + call agboxcar (Memr[sum], Memr[avg], ncols, xbmin, xbmax, scale) + + linein = linein + 1 + data = imgl2r (in, linein) + call aaddr (Memr[sum], Memr[data], Memr[sum], ncols) + ptr = ptrs + mod (linein, ybmax) + Memi[ptr] = data + + nrej = boxclean (Memr[data], Memr[avg], Memr[sum], ncols, low, high) + scale = scale + 1 + call agboxcar (Memr[sum], Memr[avg], ncols, xbmin, xbmax, scale) + + lineout = lineout + 1 + data = impl2r (out, lineout) + if (inverse == YES) + call arczr (1., Memr[avg], Memr[data], ncols, divzero) + else + call amovr (Memr[avg], Memr[data], ncols) + ccdmean = ccdmean + asumr (Memr[data], ncols) + } + + # For each line subtract the last line from the sum, add the + # next line to the sum, and output a line. + + while (linein < nlines) { + linein = linein + 1 + ptr = ptrs + mod (linein, ybmax) + data = Memi[ptr] + call asubr (Memr[sum], Memr[data], Memr[sum], ncols) + data = imgl2r (in, linein) + call aaddr (Memr[sum], Memr[data], Memr[sum], ncols) + Memi[ptr] = data + + nrej = boxclean (Memr[data], Memr[avg], Memr[sum], ncols, low, high) + + lineout = lineout + 1 + data = impl2r (out, lineout) + call agboxcar (Memr[sum], Memr[avg], ncols, xbmin, xbmax, scale) + + if (inverse == YES) + call arczr (1., Memr[avg], Memr[data], ncols, divzero) + else + call amovr (Memr[avg], Memr[data], ncols) + ccdmean = ccdmean + asumr (Memr[data], ncols) + } + + # Decrease the y box in factors of 2 until minimum y box. + while (lineout < nlines - ybox2) { + linein = linein + 1 + ptr = ptrs + mod (linein, ybmax) + data = Memi[ptr] + call asubr (Memr[sum], Memr[data], Memr[sum], ncols) + linein = linein + 1 + ptr = ptrs + mod (linein, ybmax) + data = Memi[ptr] + call asubr (Memr[sum], Memr[data], Memr[sum], ncols) + scale = scale - 2 + + lineout = lineout + 1 + data = impl2r (out, lineout) + call agboxcar (Memr[sum], Memr[data], ncols, xbmin, xbmax, scale) + if (inverse == YES) + call arczr (1., Memr[data], Memr[data], ncols, divzero) + ccdmean = ccdmean + asumr (Memr[data], ncols) + } + + # Output the last lines of the minimum y box size. + call agboxcar (Memr[sum], Memr[avg], ncols, xbmin, xbmax, scale) + if (inverse == YES) + call arczr (1., Memr[avg], Memr[output], ncols, divzero) + ybox2 = nlines - lineout + while (lineout < nlines) { + lineout = lineout + 1 + data = impl2r (out, lineout) + call amovr (Memr[output], Memr[data], ncols) + } + ccdmean = ccdmean + ybox2 * asumr (Memr[output], ncols) + + # Write scale factor out. + ccdmean = ccdmean / (ncols * nlines) + call hdmputr (out, "ccdmean", ccdmean) + call hdmputi (out, "ccdmeant", int (clktime (long (0)))) + + # Free buffers + call sfree (sp) +end + + +# QILLUMCOR -- Quick (no clipping) illumination correction image. + +procedure qillumination (in, out, xbmin, ybmin, xbmax, ybmax, inverse) + +pointer in # pointer to the input image +pointer out # pointer to the output image +int xbmin, ybmin # Minimum dimensions of the boxcar +int xbmax, ybmax # Maximum dimensions of the boxcar +int inverse # return inverse of illumination + +real scale, ccdmean +int ncols, nlines, linein, lineout, ybox1 +pointer sp, ptr, ptrs, data, sum, output + +long clktime() +real asumr(), divzero() +pointer imgl2r(), impl2r() +extern divzero() + +begin + # Set up an array of linepointers and accumulators + ncols = IM_LEN(out,1) + nlines = IM_LEN(out,2) + + call smark (sp) + call salloc (ptrs, ybmax, TY_POINTER) + call salloc (sum, ncols, TY_REAL) + call salloc (output, ncols, TY_REAL) + + # Set input buffers. + if (ybmax < nlines) + call imseti (in, IM_NBUFS, ybmax) + + # Accumulate the minimum y box. + call aclrr (Memr[sum], ncols) + linein = 0 + while (linein < ybmin) { + linein = linein + 1 + data = imgl2r (in, linein) + call aaddr (Memr[data], Memr[sum], Memr[sum], ncols) + ptr = ptrs + mod (linein, ybmax) + Memi[ptr] = data + } + + # Output the minimum y box. + ybox1 = (ybmin + 1) / 2 + scale = ybmin + call agboxcar (Memr[sum], Memr[output], ncols, xbmin, xbmax, scale) + if (inverse == YES) + call arczr (1., Memr[output], Memr[output], ncols, divzero) + lineout = 0 + while (lineout < ybox1) { + lineout = lineout + 1 + data = impl2r (out, lineout) + call amovr (Memr[output], Memr[data], ncols) + } + ccdmean = ybox1 * asumr (Memr[output], ncols) + + # Increase the y box size by steps of 2 until the maximum size. + while (linein < ybmax) { + linein = linein + 1 + data = imgl2r (in, linein) + call aaddr (Memr[sum], Memr[data], Memr[sum], ncols) + ptr = ptrs + mod (linein, ybmax) + Memi[ptr] = data + linein = linein + 1 + data = imgl2r (in, linein) + call aaddr (Memr[sum], Memr[data], Memr[sum], ncols) + ptr = ptrs + mod (linein, ybmax) + Memi[ptr] = data + + scale = scale + 2 + lineout = lineout + 1 + data = impl2r (out, lineout) + call agboxcar (Memr[sum], Memr[data], ncols, xbmin, xbmax, scale) + if (inverse == YES) + call arczr (1., Memr[data], Memr[data], ncols, divzero) + ccdmean = ccdmean + asumr (Memr[data], ncols) + } + + # For each line subtract the last line from the sum, add the + # next line to the sum, and output a line. + + while (linein < nlines) { + linein = linein + 1 + ptr = ptrs + mod (linein, ybmax) + data = Memi[ptr] + call asubr (Memr[sum], Memr[data], Memr[sum], ncols) + data = imgl2r (in, linein) + call aaddr (Memr[sum], Memr[data], Memr[sum], ncols) + Memi[ptr] = data + + lineout = lineout + 1 + data = impl2r (out, lineout) + call agboxcar (Memr[sum], Memr[data], ncols, xbmin, xbmax, scale) + if (inverse == YES) + call arczr (1., Memr[data], Memr[data], ncols, divzero) + ccdmean = ccdmean + asumr (Memr[data], ncols) + } + + # Decrease the y box in steps of 2 until minimum y box. + while (lineout < nlines - ybox1) { + linein = linein + 1 + ptr = ptrs + mod (linein, ybmax) + data = Memi[ptr] + call asubr (Memr[sum], Memr[data], Memr[sum], ncols) + linein = linein + 1 + ptr = ptrs + mod (linein, ybmax) + data = Memi[ptr] + call asubr (Memr[sum], Memr[data], Memr[sum], ncols) + + lineout = lineout + 1 + scale = scale - 2 + data = impl2r (out, lineout) + call agboxcar (Memr[sum], Memr[data], ncols, xbmin, xbmax, scale) + if (inverse == YES) + call arczr (1., Memr[data], Memr[data], ncols, divzero) + ccdmean = ccdmean + asumr (Memr[data], ncols) + } + + # Output the last lines of the minimum y box size. + call agboxcar (Memr[sum], Memr[output], ncols, xbmin, xbmax, scale) + if (inverse == YES) + call arczr (1., Memr[output], Memr[output], ncols, divzero) + ybox1 = nlines - lineout + while (lineout < nlines) { + lineout = lineout + 1 + data = impl2r (out, lineout) + call amovr (Memr[output], Memr[data], ncols) + } + ccdmean = ccdmean + ybox1 * asumr (Memr[output], ncols) + + # Write scale factor out. + ccdmean = ccdmean / (ncols * nlines) + call hdmputr (out, "ccdmean", ccdmean) + call hdmputi (out, "ccdmeant", int (clktime (long (0)))) + + # Free buffers + call sfree (sp) +end + + +# AGBOXCAR -- Vector growing boxcar smooth. +# This implements the growing box algorithm which differs from the +# normal boxcar smoothing which uses a fixed size box. + +procedure agboxcar (in, out, ncols, xbmin, xbmax, ybox) + +real in[ncols] # Sum of ybox lines +real out[ncols] # Boxcar smoothed output +int ncols # Number of columns +int xbmin, xbmax # Boxcar size in x +real ybox # Boxcar size in y + +int colin, colout, lastcol, npix, xbmin2 +real sum, output + +begin + xbmin2 = (xbmin + 1) / 2 + colin = 0 + sum = 0. + while (colin < xbmin) { + colin = colin + 1 + sum = sum + in[colin] + } + + npix = xbmin * ybox + output = sum / npix + colout = 0 + while (colout < xbmin2) { + colout = colout + 1 + out[colout] = output + } + + while (colin < xbmax) { + colin = colin + 1 + sum = sum + in[colin] + colin = colin + 1 + sum = sum + in[colin] + npix = npix + 2 * ybox + colout = colout + 1 + out[colout] = sum / npix + } + + lastcol = 0 + while (colin < ncols) { + colin = colin + 1 + lastcol = lastcol + 1 + sum = sum + in[colin] - in[lastcol] + colout = colout + 1 + out[colout] = sum / npix + } + + while (colout < ncols - xbmin2) { + lastcol = lastcol + 1 + sum = sum - in[lastcol] + lastcol = lastcol + 1 + sum = sum - in[lastcol] + npix = npix - 2 * ybox + colout = colout + 1 + out[colout] = sum / npix + } + + output = sum / npix + while (colout < ncols) { + colout = colout + 1 + out[colout] = output + } +end + + +# BOXCLEAN -- Reject data values from the sum for the next boxcar average +# which exceed the minimum and maximum residual values from the current +# boxcar average. This excludes data from the moving average before it +# enters the average. + +int procedure boxclean (data, boxavg, sum, ncols, low, high) + +real data[ncols] # Data line +real boxavg[ncols] # Box average line +real sum[ncols] # Moving sum +int ncols # Number of columns +real low # Low clipping factor +real high # High clipping factor + +int i, nrej +real rms, resid, minresid, maxresid + +begin + rms = 0. + do i = 1, ncols + rms = rms + (data[i] - boxavg[i]) ** 2 + rms = sqrt (rms / ncols) + minresid = -low * rms + maxresid = high * rms + + nrej = 0 + do i = 1, ncols { + resid = data[i] - boxavg[i] + if ((resid < minresid) || (resid > maxresid)) { + data[i] = boxavg[i] + sum[i] = sum[i] - resid + nrej = nrej + 1 + } + } + + return (nrej) +end + + +# DIVZERO -- Error action for division by zero. + +real procedure divzero (x) + +real x # Value to be inversed + +real rdivzero # Result for divion by zero +int ndivzero # Number of zero divisions +common /cdivzero/ rdivzero, ndivzero + +begin + ndivzero = ndivzero + 1 + return (rdivzero) +end diff --git a/noao/imred/ccdred/src/t_mkskyflat.x b/noao/imred/ccdred/src/t_mkskyflat.x new file mode 100644 index 00000000..02696905 --- /dev/null +++ b/noao/imred/ccdred/src/t_mkskyflat.x @@ -0,0 +1,215 @@ +include <imhdr.h> +include "ccdred.h" +include "ccdtypes.h" + + +# T_MKSKYFLAT -- Apply a sky observation to a flat field to remove the +# residual illumination pattern. + +procedure t_mkskyflat() + +int listin # List of input CCD images +int listout # List of output CCD images +int ccdtype # CCD image type +int interactive # Fit overscan interactively? + +bool flatcor, ccdflag(), clgetb(), streq() +int imtopenp(), imtgetim() +pointer sp, input, output, tmp, str, in, out, ccd +errchk set_input, set_output, ccddelete + +begin + call smark (sp) + call salloc (input, SZ_FNAME, TY_CHAR) + call salloc (output, SZ_FNAME, TY_CHAR) + call salloc (tmp, SZ_FNAME, TY_CHAR) + call salloc (str, SZ_LINE, TY_CHAR) + + # Get the lists and instrument translation file. Open the translation + # file. Initialize the interactive flag and the calibration images. + + listin = imtopenp ("input") + listout = imtopenp ("mkskyflat.output") + call clgstr ("instrument", Memc[input], SZ_FNAME) + if (Memc[input] == EOS) + call error (1, "No 'instrument' translation file specified.") + call hdmopen (Memc[input]) + call set_interactive ("", interactive) + + # Force flat fields even if flatcor=no + flatcor = clgetb ("flatcor") + call clputb ("flatcor", true) + call cal_open (NULL) + call ccd_open (0) + call clputb ("flatcor", flatcor) + + # Process each image. + while (imtgetim (listin, Memc[input], SZ_FNAME) != EOF) { + if (clgetb ("noproc")) { + call printf ("%s: mkskyflat\n") + call pargstr (Memc[input]) + } + + # Set input and output images. Use temporary image if needed. + call set_input (Memc[input], in, ccdtype) + if (in == NULL) + next + + if (imtgetim (listout, Memc[output], SZ_FNAME) == EOF) + call strcpy (Memc[input], Memc[output], SZ_FNAME) + if (Memc[output] == EOS) + call strcpy (Memc[input], Memc[output], SZ_FNAME) + if (streq (Memc[input], Memc[output])) + call mktemp ("tmp", Memc[tmp], SZ_FNAME) + else + call strcpy (Memc[output], Memc[tmp], SZ_FNAME) + call set_output (in, out, Memc[tmp]) + + # Process image as an illumination image. + call set_proc (in, out, ccd) + call set_sections (ccd) + call set_trim (ccd) + call set_fixpix (ccd) + call set_overscan (ccd) + call set_zero (ccd) + call set_dark (ccd) + call set_flat (ccd) + + # Do the processing. + if (CORS(ccd) == YES) { + call doproc (ccd) + call set_header (ccd) + + # Finish up + flatcor = ccdflag (out, "flatcor") + call imunmap (in) + call imunmap (out) + if (streq (Memc[input], Memc[output])) { + call ccddelete (Memc[input]) + call imrename (Memc[tmp], Memc[input]) + } else + call strcpy (Memc[output], Memc[input], SZ_FNAME) + } else { + # Delete the temporary output image. Make a copy if needed. + flatcor = ccdflag (out, "flatcor") + call imunmap (in) + call imunmap (out) + call imdelete (Memc[tmp]) + } + call free_proc (ccd) + + # Do special processing. + if (!flatcor) { + call eprintf ( + "%s: WARNING - Image should be flat fielded first\n") + call pargstr (Memc[input]) + } + call mkillumination (Memc[input], Memc[output], NO, YES) + call mkskyflat (Memc[input], Memc[output]) + if (!streq (Memc[input], Memc[output])) + call ccdcopy (Memc[input], Memc[output]) + } + + # Finish up. + call hdmclose () + call imtclose (listin) + call imtclose (listout) + call cal_close () + call ccd_close () + call sfree (sp) +end + + +# MKSKYFLAT -- Make a sky flat by dividing the input illumination image by +# the flat field. + +procedure mkskyflat (input, output) + +char input[SZ_FNAME] # Input image +char output[SZ_FNAME] # Output image + +int i, nc, nl +long time +real scale +pointer sp, str, flat, tmp, in, im, out, out1, data + +int hdmgeti() +bool clgetb(), ccdflag(), streq() +real hdmgetr() +pointer immap(), imgl2r(), impl2r() +errchk immap, ccddelete + +begin + # Check if this operation has been done. + in = immap (input, READ_ONLY, 0) + if (ccdflag (in, "skyflat")) { + call imunmap (in) + return + } + + # Print operation if not processing. + if (clgetb ("noproc")) { + call eprintf ( + " [TO BE DONE] Convert %s to sky flat\n") + call pargstr (input) + call imunmap (in) + return + } + + call smark (sp) + call salloc (str, SZ_LINE, TY_CHAR) + call salloc (flat, SZ_FNAME, TY_CHAR) + call salloc (tmp, SZ_FNAME, TY_CHAR) + + # Get the flat field. + call cal_image (in, FLAT, 1, Memc[flat], SZ_FNAME) + im = immap (Memc[flat], READ_ONLY, 0) + iferr (scale = hdmgetr (im, "ccdmean")) + scale = 1. + iferr (time = hdmgeti (im, "ccdmeant")) + time = IM_MTIME(im) + if (time < IM_MTIME(im)) + scale = 1. + + # Create the temporary output. + if (streq (input, output)) { + call mktemp ("tmp", Memc[tmp], SZ_FNAME) + call set_output (in, out, Memc[tmp]) + out1 = in + } else { + call set_output (in, out, output) + out1 = out + } + + # Multiply the illumination and flat field images with scaling. + nc = IM_LEN(out,1) + nl = IM_LEN(out,2) + do i = 1, nl { + data = impl2r (out, i) + call amulr (Memr[imgl2r(in,i)], Memr[imgl2r(im,i)], + Memr[data], nc) + if (scale != 1.) + call adivkr (Memr[data], scale, Memr[data], nc) + } + + # Log the operation. + call sprintf (Memc[str], SZ_LINE, + "Sky flat created from %s and %s") + call pargstr (input) + call pargstr (Memc[flat]) + call timelog (Memc[str], SZ_LINE) + call ccdlog (out1, Memc[str]) + call hdmpstr (out, "skyflat", Memc[str]) + call hdmpstr (out, "imagetyp", "flat") + + # Finish up + call imunmap (in) + call imunmap (im) + call imunmap (out) + if (streq (input, output)) { + call ccddelete (input) + call imrename (Memc[tmp], input) + } else + call strcpy (output, input, SZ_FNAME) + call sfree (sp) +end diff --git a/noao/imred/ccdred/src/t_skyreplace.x b/noao/imred/ccdred/src/t_skyreplace.x new file mode 100644 index 00000000..9bd2e9d0 --- /dev/null +++ b/noao/imred/ccdred/src/t_skyreplace.x @@ -0,0 +1,301 @@ +include <imhdr.h> + + +# T_SKYREPLACE -- Replace objects by sky. This development code as is not +# used in the package. It is here to be worked on further when an image +# display interface is added. + +procedure t_skyreplace () + +char image[SZ_FNAME] # Image to be modified + +char graph[SZ_LINE], display[SZ_LINE], cmd[SZ_LINE] +pointer im, immap() +int clgeti(), wcs, key, clgcur(), nrep, skyreplace() +real wx, wy, xc, yc, r, s + +begin + call clgstr ("image", image, SZ_FNAME) + call sprintf (graph, SZ_LINE, "contour %s") + call pargstr (image) + call sprintf (display, SZ_LINE, "display %s %d") + call pargstr (image) + call pargi (clgeti ("frame")) + + im = immap (image, READ_WRITE, 0) + while (clgcur ("cursor",wx, wy, wcs, key, cmd, SZ_LINE) != EOF) { + switch (key) { + case 'a': + r = sqrt ((wx - xc) ** 2 + (wy - yc) ** 2) + s = 2 * r + case 'b': + nrep = skyreplace (im, xc, yc, r, s) + case 'c': + xc = wx + yc = wy + case 'd': + call imunmap (im) + call clcmdw (display) + im = immap (image, READ_WRITE, 0) + case 'g': + call imunmap (im) + call clcmdw (graph) + im = immap (image, READ_WRITE, 0) + case 'q': + break + default: + call printf ("\007") + } + } + + call imunmap (im) +end + + +define NSKY 100 # Minimum number of sky points + +int procedure skyreplace (im, xc, yc, r, s) + +pointer im # IMIO pointer +real xc, yc # Object center +real r # Object aperture radius +real s # Sky aperture radius + +real avg, sigma, urand(), mode, find_mode() +long seed +int xlen, ylen, nx, nx1, nx2, ny, ny1, ny2, ntotal, nobj, nallsky, nsky[4] +int i, j, x1, x2, x3, x4, y1, y2, y3, y4, y +pointer sp, allsky, sky[4], ptr1, ptr2 +pointer datain, dataout, imgs2r(), imps2r() + +begin + xlen = IM_LEN(im,1) + ylen = IM_LEN(im,2) + x1 = max (1, int (xc - s)) + x4 = min (xlen, int (xc + s + 0.5)) + y1 = max (1, int (yc - s)) + y4 = min (ylen, int (yc + s + 0.5)) + nx = x4 - x1 + 1 + ny = y4 - y1 + 1 + ntotal = nx * ny + + x2 = max (1, int (xc - r)) + x3 = min (xlen, int (xc + r + 0.5)) + y2 = max (1, int (yc - r)) + y3 = min (xlen, int (yc + r + 0.5)) + nx1 = (x3 - x2 + 1) + ny1 = (y3 - y2 + 1) + nobj = nx1 * ny1 + nallsky = ntotal - nobj + + if ((nallsky < NSKY) || (nobj < 1)) + return (0) + + call smark (sp) + call salloc (allsky, nallsky, TY_REAL) + datain = imgs2r (im, x1, x4, y1, y4) + dataout = imps2r (im, x2, x3, y2, y3) + ptr2 = allsky + + # First quadrant + x2 = max (1, int (xc - r)) + x3 = min (xlen, int (xc + 0.5)) + y2 = max (1, int (yc - r)) + y3 = min (xlen, int (yc + 0.5)) + nx1 = x3 - x1 + 1 + nx2 = x3 - x2 + ny1 = y2 - y1 + ny2 = y3 - y2 + 1 + nsky[1] = nx1 * ny1 + nx2 * ny2 + sky[1] = ptr2 + + if (nsky[1] > 0) { + ptr1 = datain + for (y=y1; y<y2; y=y+1) { + call amovr (Memr[ptr1], Memr[ptr2], nx1) + ptr1 = ptr1 + nx + ptr2 = ptr2 + nx1 + } + for (; y<=y3; y=y+1) { + call amovr (Memr[ptr1], Memr[ptr2], nx2) + ptr1 = ptr1 + nx + ptr2 = ptr2 + nx2 + } + } + + # Second quadrant + x2 = max (1, int (xc + 1.5)) + x3 = min (xlen, int (xc + r + 0.5)) + y2 = max (1, int (yc - r)) + y3 = min (xlen, int (yc + 0.5)) + nx1 = x4 - x2 + 1 + nx2 = x4 - x3 + ny1 = y2 - y1 + ny2 = y3 - y2 + 1 + nsky[2] = nx1 * ny1 + nx2 * ny2 + sky[2] = ptr2 + + if (nsky[2] > 0) { + ptr1 = datain + x2 - x1 + for (y=y1; y<y2; y=y+1) { + call amovr (Memr[ptr1], Memr[ptr2], nx1) + ptr1 = ptr1 + nx + ptr2 = ptr2 + nx1 + } + ptr1 = ptr1 + x3 - x2 + 1 + for (; y<=y3; y=y+1) { + call amovr (Memr[ptr1], Memr[ptr2], nx2) + ptr1 = ptr1 + nx + ptr2 = ptr2 + nx2 + } + } + + # Third quadrant + x2 = max (1, int (xc - r)) + x3 = min (xlen, int (xc + 0.5)) + y2 = max (1, int (yc + 1.5)) + y3 = min (xlen, int (yc + r + 0.5)) + nx1 = x3 - x2 + nx2 = x3 - x1 + 1 + ny1 = y3 - y2 + 1 + ny2 = y4 - y3 + nsky[3] = nx1 * ny1 + nx2 * ny2 + sky[3] = ptr2 + + if (nsky[3] > 0) { + ptr1 = datain + (y2 - y1) * nx + for (y=y2; y<=y3; y=y+1) { + call amovr (Memr[ptr1], Memr[ptr2], nx1) + ptr1 = ptr1 + nx + ptr2 = ptr2 + nx1 + } + for (; y<=y4; y=y+1) { + call amovr (Memr[ptr1], Memr[ptr2], nx2) + ptr1 = ptr1 + nx + ptr2 = ptr2 + nx2 + } + } + + # Fourth quadrant + x2 = max (1, int (xc + 1.5)) + x3 = min (xlen, int (xc + r + 0.5)) + y2 = max (1, int (yc + 1.5)) + y3 = min (xlen, int (yc + r + 0.5)) + nx1 = x4 - x3 + nx2 = x4 - x2 + 1 + ny1 = y3 - y2 + 1 + ny2 = y4 - y3 + nsky[4] = ny1 * nx1 + ny2 * nx2 + sky[4] = ptr2 + + if (nsky[4] > 0) { + ptr1 = datain + (y2 - y1) * nx + x3 - x1 + 1 + for (y=y2; y<=y3; y=y+1) { + call amovr (Memr[ptr1], Memr[ptr2], nx1) + ptr1 = ptr1 + nx + ptr2 = ptr2 + nx1 + } + ptr1 = ptr1 - (x3 - x2 + 1) + for (; y<=y4; y=y+1) { + call amovr (Memr[ptr1], Memr[ptr2], nx2) + ptr1 = ptr1 + nx + ptr2 = ptr2 + nx2 + } + } + + # This part is for doing a gradient correction. It is not implemented. +# if ((nsky[1]>NSKY)&&(nsky[2]>NSKY)&&(nsky[3]>NSKY)&&(nsky[4]>NSKY)) { +# call asrtr (Memr[sky[1]], Memr[sky[1]], nsky[1]) +# call asrtr (Memr[sky[2]], Memr[sky[2]], nsky[2]) +# call asrtr (Memr[sky[3]], Memr[sky[3]], nsky[3]) +# call asrtr (Memr[sky[4]], Memr[sky[4]], nsky[4]) + + # Add a gradient correction here. + +# seed = dataout +# do i = dataout, dataout+nobj-1 { +# j = 4 * urand (seed) + 1 +# k = 0.95 * nsky[j] * urand (seed) +# Memr[i] = Memr[sky[j]+k] +# } +# } else { + call asrtr (Memr[allsky], Memr[allsky], nallsky) + + # Find the mean and sigma excluding the outer 20% + x1 = 0.1 * nallsky + x2 = 0.9 * nallsky + call aavgr (Memr[allsky+x1-1], x2-x1+1, avg, sigma) + mode = find_mode (Memr[allsky], nallsky, nallsky / 20) + call printf ("Mean = %g, Median = %g, Mode = %g\n") + call pargr (avg) + call pargr (Memr[allsky+nallsky/2-1]) + call pargr (mode) + for (x1=0; (x1<nallsky)&&(Memr[allsky+x1]<avg-3*sigma); x1=x1+1) + ; + for (x2=nallsky-1; (x2>0)&&(Memr[allsky+x2]>avg+3*sigma); x2=x2-1) + ; + nx = x2 - x1 - 1 + + seed = dataout + do i = dataout, dataout+nobj-1 { + j = nx * urand (seed) + x1 + Memr[i] = Memr[allsky+j] + } +# } + + call sfree (sp) + return (nobj) +end + +real procedure find_mode (data, npts, n) + +real data[npts] # Data +int npts # Number of data points +int n # Bin size + +int x, xlast, xmin +real sumx, sumy, sumxx, sumxy, a, amin +pointer sp, slope + +begin + call smark (sp) + call salloc (slope, npts - n, TY_REAL) + + sumx = 0. + sumy = 0. + sumxx = 0. + sumxy = 0. + + x = 0 + xlast = 0 + while (x < n) { + x = x + 1 + sumx = sumx + x + sumy = sumy + data[x] + sumxx = sumxx + x ** 2 + sumxy = sumxy + x * data[x] + } + amin = (n * sumxy - sumx * sumy) / (n * sumxx - sumx ** 2) + xmin = (x + xlast) / 2 + Memr[slope] = amin + + while (x < npts - n) { + x = x + 1 + xlast = xlast + 1 + sumx = sumx + x - xlast + sumy = sumy + data[x] - data[xlast] + sumxx = sumxx + x * x - xlast * xlast + sumxy = sumxy + x * data[x] - xlast * data[xlast] + + a = (n * sumxy - sumx * sumy) / (n * sumxx - sumx ** 2) + if (a < amin) { + amin = a + xmin = (x + xlast) / 2 + } + Memr[slope+xlast] = a + } + + call gplotv (Memr[slope+11], npts-2*n-22, 1., real (npts-2*n-22), "") + call sfree (sp) + return (data[xmin]) +end diff --git a/noao/imred/ccdred/src/timelog.x b/noao/imred/ccdred/src/timelog.x new file mode 100644 index 00000000..7a8d969f --- /dev/null +++ b/noao/imred/ccdred/src/timelog.x @@ -0,0 +1,29 @@ +include <time.h> + + +# TIMELOG -- Prepend a time stamp to the given string. +# +# For the purpose of a history logging prepend a short time stamp to the +# given string. Note that the input string is modified. + +procedure timelog (str, max_char) + +char str[max_char] # String to be time stamped +int max_char # Maximum characters in string + +pointer sp, time, temp +long clktime() + +begin + call smark (sp) + call salloc (time, SZ_DATE, TY_CHAR) + call salloc (temp, max_char, TY_CHAR) + + call cnvdate (clktime(0), Memc[time], SZ_DATE) + call sprintf (Memc[temp], max_char, "%s %s") + call pargstr (Memc[time]) + call pargstr (str) + call strcpy (Memc[temp], str, max_char) + + call sfree (sp) +end diff --git a/noao/imred/ccdred/x_ccdred.x b/noao/imred/ccdred/x_ccdred.x new file mode 100644 index 00000000..f651b668 --- /dev/null +++ b/noao/imred/ccdred/x_ccdred.x @@ -0,0 +1,15 @@ +task badpiximage = t_badpiximage, + ccdgroups = t_ccdgroups, + ccdhedit = t_ccdhedit, + ccdinstrument = t_ccdinst, + ccdlist = t_ccdlist, + ccdmask = t_ccdmask, + ccdproc = t_ccdproc, + qccdproc = t_ccdproc, + combine = t_combine, + mkfringecor = t_mkfringecor, + mkillumcor = t_mkillumcor, + mkillumflat = t_mkillumflat, + mkimage = t_mkimage, + mkskycor = t_mkskycor, + mkskyflat = t_mkskyflat diff --git a/noao/imred/ccdred/zerocombine.cl b/noao/imred/ccdred/zerocombine.cl new file mode 100644 index 00000000..6fb9613b --- /dev/null +++ b/noao/imred/ccdred/zerocombine.cl @@ -0,0 +1,48 @@ +# ZEROCOMBINE -- Process and combine zero level CCD images. + +procedure zerocombine (input) + +string input {prompt="List of zero level images to combine"} +file output="Zero" {prompt="Output zero level name"} +string combine="average" {prompt="Type of combine operation", + enum="average|median"} +string reject="minmax" {prompt="Type of rejection", + enum="none|minmax|ccdclip|crreject|sigclip|avsigclip|pclip"} +string ccdtype="zero" {prompt="CCD image type to combine"} +bool process=no {prompt="Process images before combining?"} +bool delete=no {prompt="Delete input images after combining?"} +bool clobber=no {prompt="Clobber existing output image?"} +string scale="none" {prompt="Image scaling", + enum="none|mode|median|mean|exposure"} +string statsec="" {prompt="Image section for computing statistics"} +int nlow=0 {prompt="minmax: Number of low pixels to reject"} +int nhigh=1 {prompt="minmax: Number of high pixels to reject"} +int nkeep=1 {prompt="Minimum to keep (pos) or maximum to reject (neg)"} +bool mclip=yes {prompt="Use median in sigma clipping algorithms?"} +real lsigma=3. {prompt="Lower sigma clipping factor"} +real hsigma=3. {prompt="Upper sigma clipping factor"} +string rdnoise="0." {prompt="ccdclip: CCD readout noise (electrons)"} +string gain="1." {prompt="ccdclip: CCD gain (electrons/DN)"} +string snoise="0." {prompt="ccdclip: Sensitivity noise (fraction)"} +real pclip=-0.5 {prompt="pclip: Percentile clipping parameter"} +real blank=0. {prompt="Value if there are no pixels"} + +begin + string ims + + ims = input + + # Process images first if desired. + if (process == YES) + ccdproc (ims, output="", ccdtype=ccdtype, noproc=no) + + # Combine the flat field images. + combine (ims, output=output, plfile="", sigma="", combine=combine, + reject=reject, ccdtype=ccdtype, subsets=no, delete=delete, + clobber=clobber, project=no, outtype="real", offsets="none", + masktype="none", blank=blank, scale=scale, zero="none", weight=no, + statsec=statsec, lthreshold=INDEF, hthreshold=INDEF, nlow=nlow, + nhigh=nhigh, nkeep=nkeep, mclip=mclip, lsigma=lsigma, hsigma=hsigma, + rdnoise=rdnoise, gain=gain, snoise=snoise, sigscale=0.1, + pclip=pclip, grow=0) +end |