diff options
| author | Joseph Hunkeler <jhunkeler@gmail.com> | 2015-07-08 20:46:52 -0400 |
|---|---|---|
| committer | Joseph Hunkeler <jhunkeler@gmail.com> | 2015-07-08 20:46:52 -0400 |
| commit | fa080de7afc95aa1c19a6e6fc0e0708ced2eadc4 (patch) | |
| tree | bdda434976bc09c864f2e4fa6f16ba1952b1e555 /pkg/images/immatch | |
| download | iraf-linux-fa080de7afc95aa1c19a6e6fc0e0708ced2eadc4.tar.gz | |
Initial commit
Diffstat (limited to 'pkg/images/immatch')
176 files changed, 70576 insertions, 0 deletions
diff --git a/pkg/images/immatch/Revisions b/pkg/images/immatch/Revisions new file mode 100644 index 00000000..a45cc7be --- /dev/null +++ b/pkg/images/immatch/Revisions @@ -0,0 +1,2025 @@ +.help revisions Jan97 images.immatch +.nf +=============================== +Package Reorganization +=============================== + +pkg/images/imarith/t_imsum.x +pkg/images/imarith/t_imcombine.x +pkg/images/doc/imsum.hlp +pkg/images/doc/imcombine.hlp + Provided options for USHORT data. (12/10/96, Valdes) + +pkg/images/imarith/icsetout.x +pkg/images/doc/imcombine.hlp + A new option for computing offsets from the image WCS has been added. + (11/30/96, Valdes) + +pkg/images/imarith/t_imcombine.x +pkg/images/imarith/icombine.gx + Changed the error checking to catch additional errors relating to too + many files. (11/12/96, Valdes) + +pkg/images/imarith/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. (8/1/96, Valdes) + +pkg/images/filters/median.x + The routine mde_yefilter was being called with the wrong number of + arguments. + (7/18/96, Davis) + +pkg/images/imarith/t_imcombine.x +pkg/images/imarith/icombine.gx +pkg/images/imarith/icimstack.x + +pkg/images/imarith/iclog.x +pkg/images/imarith/mkpkg +pkg/images/doc/imcombine.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. + (5/14/96, Valdes) + +pkg/images/geometry/xregister/rgxfit.x + Changed several Memr[] references to Memi[] in the rg_fit routine. + This bug was causing a floating point error in the xregister task + on the Dec Alpha if the coords file was defined, and could potentially + cause problems on other machines. + (Davis, April 3, 1996) + +pkg/images/geometry/t_geotran.x +pkg/images/geometry/geograph.x +pkg/images/doc/geomap.hlp + Corrected the definition of skew in the routines which compute a geometric + interpretation of the 6-coefficient fit, which compute the coefficients + from the geometric parameters, and in the relevant help pages. + (2/19/96, Davis) + +pkg/images/median.par +pkg/images/rmedian.par +pkg/images/mode.par +pkg/images/rmode.par +pkg/images/fmedian.par +pkg/images/frmedian.par +pkg/images/fmode.par +pkg/images/frmode.par +pkg/images/doc/median.hlp +pkg/images/doc/rmedian.hlp +pkg/images/doc/mode.hlp +pkg/images/doc/rmode.hlp +pkg/images/doc/fmedian.hlp +pkg/images/doc/frmedian.hlp +pkg/images/doc/fmode.hlp +pkg/images/doc/frmode.hlp +pkg/images/filters/t_median.x +pkg/images/filters/t_rmedian.x +pkg/images/filters/t_mode.x +pkg/images/filters/t_rmode.x +pkg/images/filters/t_fmedian.x +pkg/images/filters/t_frmedian.x +pkg/images/filters/t_fmode.x +pkg/images/filters/t_frmode.x + Added a verbose parameter to the median, rmedian, mode, rmode, fmedian, + frmedian, fmode, and frmode tasks. (11/27/95, Davis) + +pkg/images/geometry/doc/geotran.hlp + Fixed an error in the help page for geotran. The default values for + the xscale and yscale parameters were incorrectly listed as INDEF, + INDEF instead of 1.0, 1.0. (11/14/95, Davis) + +pkg/images/imarith/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) + +pkg/images/doc/imcombine.hlp + Clarified a point about how the sigma is calculated with the SIGCLIP + option. (10/11/95, Valdes) + +pkg/images/imarith/icombine.gx + To deal with the case of readnoise=0. and image data which has points with + negative mean or median and very small minimum readnoise is set + internally to avoid computing a zero sigma and dividing by it. This + applies to the noise model rejection options. (8/11/95, Valdes) + +pkg/images/frmedian.hlp +pkg/images/frmode.hlp +pkg/images/rmedian.hlp +pkg/images/rmode.hlp +pkg/images/frmedian.par +pkg/images/frmode.par +pkg/images/rmedian.par +pkg/images/rmode.par +pkg/images/filters/frmedian.h +pkg/images/filters/frmode.h +pkg/images/filters/rmedian.h +pkg/images/filters/rmode.h +pkg/images/filters/t_frmedian.x +pkg/images/filters/t_frmode.x +pkg/images/filters/t_rmedian.x +pkg/images/filters/t_rmode.x +pkg/images/filters/frmedian.x +pkg/images/filters/frmode.x +pkg/images/filters/rmedian.x +pkg/images/filters/rmode.x +pkg/images/filters/med_utils.x + Added new ring median and modal filtering tasks frmedian, rmedian, + frmode, and rmode to the images package. + (6/20/95, Davis) + +pkg/images/fmedian.hlp +pkg/images/fmode.hlp +pkg/images/median.hlp +pkg/images/mode.hlp +pkg/images/fmedian.par +pkg/images/fmode.par +pkg/images/median.par +pkg/images/mode.par +pkg/images/filters/fmedian.h +pkg/images/filters/fmode.h +pkg/images/filters/median.h +pkg/images/filters/mode.h +pkg/images/filters/t_fmedian.x +pkg/images/filters/t_fmode.x +pkg/images/filters/t_median.x +pkg/images/filters/t_mode.x +pkg/images/filters/fmedian.x +pkg/images/filters/fmode.x +pkg/images/filters/median.x +pkg/images/filters/mode.x +pkg/images/filters/fmd_buf.x +pkg/images/filters/fmd_hist.x +pkg/images/filters/fmd_maxmin.x +pkg/images/filters/med_buf.x +pkg/images/filters/med_sort.x + Added minimum and maximum good data parameters to the fmedian, fmode, + median, and mode filtering tasks. Removed the 64X64 kernel size limit + in the median and mode tasks. Replaced the common blocks with structures + and .h files. + (6/20/95, Davis) + +pkg/images/geometry/t_geotran.x +pkg/images/geometry/geotran.x +pkg/images/geometry/geotimtran.x + Fixed a bug in the buffering of the x and y coordinate surface interpolants + which can cause a memory corruption error if, nthe nxsample or nysample + parameters are > 1, and the nxblock or nyblock parameters are less + than the x and y dimensions of the input image. Took the opportunity + to clean up the code. + (6/13/95, Davis) + +======= +V2.10.4 +======= + +pkg/images/geometry/t_geomap.x + Corrected a harmless typo in the code which determines the minimum + and maximum x values and improved the precision of the test when the + input is double precision. + (4/18/95, Davis) + +pkg/images/doc/fit1d.hlp + Added a description of the interactive parameter to the fit1d help page. + (4/17/95, Davis) + +pkg/images/imarith/t_imcombine.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) + +pkg/images/geometry/xregister/t_xregister.x + Added a test on the status code returned from the fitting routine so + the xregister tasks does not go ahead and write an output image when + the user quits the task in in interactive mode. + (3/31/95, Davis) + +pkg/images/imarith/icscale.x +pkg/images/doc/imcombine.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) + +pkg/images/geometry/xregister/rgxtools.x + Changed some amovr and amovi calls to amovkr and amovki calls. + (3/15/95, Davis) + +pkg/images/geometry/t_imshift.x +pkg/images/geometry/t_magnify.x +pkg/images/geometry/geotran.x +pkg/images/geometry/xregister/rgximshift.x + The buffering margins set for the bicubic spline interpolants were + increased to improve the flux conservation properties of the interpolant + in cases where the data is undersampled. (12/6/94, Davis) + +pkg/images/xregister/rgxbckgrd.x + In several places the construct array[1++nx-wborder] was being used + instead of array[1+nx-wborder]. Apparently caused by a typo which + propagated through the code, the Sun compilers did not catch this, but + the IBM/RISC6000 compilers did. (11/16/94, Davis) + + +pkg/images/xregister.par +pkg/images/doc/xregister.hlp +pkg/images/geometry/xregister/t_xregister.x +pkg/images/geometry/xregister/rgxcorr.x +pkg/images/geometry/xregister/rgxicorr.x +pkg/images/geometry/xregister/rgxcolon.x +pkg/images/geometry/xregister/rgxdbio.x + The xregister task was modified to to write the output shifts file + in either text database format (the current default) or in simple text + format. The change was made so that the output of xregister could + both be edited more easily by the user and be used directly with the + imshift task. (11/11/94, Davis) + +pkg/images/imfit/fit1d.x + A Memc in the ratio output option was incorrectly used instead of Memr + when the bug fix of 11/16/93 was made. (10/14/94, Valdes) + +pkg/images/geometry/xregister/rgxcorr.x + The procedure rg_xlaplace was being incorrectly declared as an integer + procedure. + (8/1/94, Davis) + +pkg/images/geometry/xregister/rgxregions.x + The routine strncmp was being called (with a missing number of characters + argument) instead of strcmp. This was causing a bus error under solaris + but not sun os whenever the user set regions to "grid ...". (7/27/94 LED) + +pkg/images/tv/imexaine/ierimexam.x + The Gaussian fitting can return a negative sigma**2 which would cause + an FPE when the square root is taken. This will only occur when + there is no reasonable signal. The results of the gaussian fitting + are now set to INDEF if this unphysical result occurs. (7/7/94, Valdes) + +pkg/images/geometry/geofit.x + A routine expecting two char arrays was being passed two real arrays + instead resulting in a segmentation violation if calctype=real + and reject > 0. + (6/21/94, Davis) + +pkg/images/imarith/t_imarith.x + IMARITH now deletes the CCDMEAN keyword if present. (6/21/94, Valdes) + +pkg/images/imarith/icaclip.gx +pkg/images/imarith/iccclip.gx +pkg/images/imarith/icpclip.gx +pkg/images/imarith/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) + +pkg/images/geometry/xregister/rgxicorr.x + The path names to the xregister task interactive help files was incorrect. + (6/13/94, Davis) + +pkg/images/imarith/iccclip.gx +pkg/images/imarith/icsclip.gx + Found and fixed another typo bug. (6/7/94, Valdes/Zhang) + +pkg/images/imarith/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) + +pkg/images/imarith/icsclip.gx + There was a missing line: l = Memi[mp1]. (5/25/94, Valdes/Zhang) + +pkg/images/imarith/icaclip.gx +pkg/images/imarith/iccclip.gx +pkg/images/imarith/icpclip.gx +pkg/images/imarith/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) + +pkg/images/geometry/t_geotran.x + In cases where there was no input geomap database, geotran was + unnecessarily overiding the size of the input image requested by the + user if the size of the image was bigger than the default output size + (the size of the output image which would include all the input image + pixels is no user shifts were applied). + (5/10/94, Davis) + +pkg/images/imarith/icscale.x +pkg/images/imarith/t_imcombine.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) + +pkg/images/tv/imexaine/ierimexam.x + For some objects the moment analysis could fail producing a floating + overflow error in imexamine, because the code was trying to use + INDEF as the initial value of the object fwhm. Changed the gaussian + fitting code to use a fraction of the fitting radius as the initial value + for the fitted full-width half-maximum in cases where the moment analysis + cannot compute an initial value. + (4/15/94 LED) + +pkg/images/imarith/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) + +pkg/images/doc/imcombine.hlp + Tried again to clarify the scaling as multiplicative and the offseting + as additive for file input and for log output. (3/22/94, Valdes) + +pkg/images/imarith/iacclip.gx +pkg/images/imarith/iccclip.gx +pkg/images/imarith/iscclip.gx + The image sigma was incorrectly computed when an offset scaling is used. + (3/8/94, Valdes) + +pkg/images/doc/imcombine.hlp + The MINMAX example confused low and high. (3/7/94, Valdes) + +pkg/images/geometry/t_geomap.x +pkg/images/geometry/geofit.x +pkg/images/geometry/geograph.x + Fixed a bug in the geomap code which caused the linear portion of the transformation + to be computed incorrectly if the x and y fits had a different functional form. + (12/29/93, Davis) + +pkg/images/imarith/t_imcombine.x +pkg/images/imcombine.par +pkg/images/do/imcombine.hlp + The output pixel datatypes now include unsigned short integer. + (12/4/93, Valdes) + +pkg/images/doc/imcombine.hlp + Fixed an error in the example of offseting. (11/23/93, Valdes) + +pkg/images/imfit/fit1d.x + When doing operations in place the input and output buffers are the + same and the difference and ratio operations assumed they were not + causing the final results to be wrong. (11/16/93, Valdes) + +pkg/images/imarith/t_imarith.x +pkg/images/doc/imarith.hlp + If no calculation type is specified then it will be at least real + for a division. Since the output pixel type defaults to the + calculation type if not specified this will also result in a + real output if dividing two integer images. (11/12/93, Valdes) + +pkg/images/imarith/icgrow.gx +pkg/images/imarith/icpclip.gx +pkg/images/imarith/icsclip.gx +pkg/images/imarith/icaclip.gx +pkg/images/imarith/iccclip.gx +pkg/images/imarith/t_imcombine.x +pkg/images/doc/imcombine.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) + +======= +V2.10.2 +======= + +pkg/images/imarith/icsetout.x + Added MWCS calls to update the axis mapping when using the project + option in IMCOMBINE. (10/8/93, Valdes) + +pkg$images/imarith/icscale.x +pkg$images/doc/imcombine.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) + +pkg$images/imarith/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) + +pkg$images/imfit/imsurfit.h +pkg$images/imfit/t_imsurfit.x +pkg$images/imfit/imsurfit.x +pkg$images/lib/ranges.x + Fixed two bugs in the imsurfit task bad pixel rejection code. For low + k-sigma rejections factors the bad pixel list could overflow resulting + in a segmentation violation or a hung task. Overlapping ranges were + not being decoded into a bad pixel list properly resulting in + oscillating bad pixel rejection behavior where certain groups of + bad pixels were alternately being included and excluded from the fit. + Both bugs are fixed in iraf 2.10.3 + (9/21/93, Davis) + +pkg$images/doc/imcombine.hlp + Clarified how bad pixel masks work with the "project" option. + (9/13/93, Valdes) + +pkg$images/imfit/fit1d.x + When the input and output images are the same there was an typo error + such that the output was opened separately but then never unmapped + resulting in the end of the image not being updated. (8/6/93, Valdes) + +pkg$images/imarith/t_imcombine.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) + +pkg$images/filters/t_mode.x +pkg$images/filters/t_median.x + Fixed a bug in the error trapping code in the median and mode tasks. + The call to eprintf contained an extra invalid error code agument. + (7/28/93, Davis) + +pkg$images/geometry/geomap.par +pkg$images/geometry/t_geomap.x +pkg$images/geometry/geogmap.x +pkg$images/geometry/geofit.x + Fixed a bug in the error handling code in geomap which was producing + a segmentation violation on exit if the user's coordinate list + had fewer than 3 data points. Also improved the error messages + presented to the user in both interactive and non-interactive mode. + (7/7/93, Davis) + +pkg$images/imarith/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) + +pkg$images/imarith/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) + +pkg$images/geometry/t_imshift.x + Added support for type ushort to the imshift task in cases where the + pixel shifts are integral. + (5/8/93, Davis) + +pkg$images/doc/rotate.hlp + Fixed a bug in the rotate task help page which implied that automatic + image size computation would occur if ncols or nlines were set no 0 + instead of ncols and nlines. + (4/17/93, Davis) + +pkg$images/imarith/imcombine.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) + +pkg$images/doc/gauss.hlp + Fixed 2 sign errors in the equations in the documentation describing + the elliptical gaussian fucntion. + (4/13/92, Davis) + +pkg/images/imutil/t_imslice.x + Removed an error check in the imslice task, which was preventing it from + being used to reduce the dimensionality of images where the length of + the slice dimension is 1.0. + (2/16/83, Davis) + +pkg/images/filters/fmedian.x + The fmedian task was printing debugging information under iraf 2.10.2. + (1/25/93, Davis) + +pkg/images/imarith/icaclip.gx +pkg/images/imarith/iccclip.gx +pkg/images/imarith/icpclip.gx +pkg/images/imarith/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) + + +======= +V2.10.1 +======= + +pkg/images/imarith/t_imcombine.x +pkg/images/imarith/icaclip.gx +pkg/images/imarith/iccclip.gx +pkg/images/imarith/icgrow.gx +pkg/images/imarith/iclog.x +pkg/images/imarith/icombine.com +pkg/images/imarith/icombine.gx +pkg/images/imarith/icombine.h +pkg/images/imarith/icpclip.gx +pkg/images/imarith/icscale.x +pkg/images/imarith/icsclip.gx +pkg/images/imarith/icsetout.x +pkg/images/imcombine.par +pkg/images/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) + +pkg/images/imutil/imcopy.x + Added a call to flush after the status line printout so that the output + will appear immediately. (8/19/92, Davis) + +pkg/images/filters/mkpkg +pkg/images/filters/t_fmedian.x +pkg/images/filters/fmedian.x +pkg/images/filters/fmd_buf.x +pkg/images/filters/fmd_maxmin.x + The fmedian task could crash with a segmentation violation if mapping + was turned off (hmin = zmin and hmax = zmax) and the input image + contained data outside the range defined by zmin and zmax. (8/18/92, Davis) + +pkg/images/imarith/icaclip.gx +pkg/images/imarith/iccclip.gx +pkg/images/imarith/icpclip.gx +pkg/images/imarith/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) + +pkg/images/imarith/icmm.gx + This procedure failed to set the dflag resulting in the weighted average + being computed in correctly. (8/11/92, Valdes) + +pkg/images/imfit/fit1d.x + At some point changes were made but not documented dealing with image + sections on the input/output. The changes seem to have left off the + final step of opening the output image using the appropriate image + sections. Because of this it is an error to use an image section + on an input image when the output image is different; i.e. + + cl> fit1d dev$pix[200:400,*] junk + + This has now been fixed. (8/10/92, Valdes) + +pkg/images/imarith/icscales.x + The zero levels were incorrectly scaled twice. (8/10/92, Valdes) + +pkg/images/imarith/icstat.gx + Contained the statement + nv = max (1., (Memi[v2+i] - Memi[v1+i]) / Memi[dv+i] + 1) + which is max(real,int). Changed the 1. to a 1. (8/10/92, Valdes) + +pkg$images/imarith/icaclip.gx +pkg$images/imarith/iccclip.gx +pkg$images/imarith/icsclip.gx + These files contained multiple cases (ten or so) of constructs such as + "max (1., ...)" or "max (0., ...)" where the ... could be either real + or double. In the double cases the DEC compiler complained about a + type mismatch since 1. is real. (8/10/92, Valdes) + +pkg$images/imfit/t_imsurfit.x + Fixed a bug in the section reading code. Imsurfit is supposed to switch + the order of the section delimiters in x and y if x2 < x1 or y2 < 1. + Unfortunately the y test was actually "if (y2 < x1)" instead of + "if (y2 < y1)". Whether or not the code actually works correctly + depends on the value of x1 relative to y2. This bug was not present + in 2.9.1 but is present in subsequent releases. (7/30/92 LED) + +======= +V2.10.1 +======= + +pkg$images/filters/t_gauss.x + The case theta=90 and ratio > 0.0 but < 1.0 was producing an incorrect + convolution if bilinear=yes, because the major axis sigmas being + input along the x and y axes were sigma and ratio * sigma respectively + instead of ratio * sigma and sigma in this case. + +pkg$images/imutil/imcopy.x + Modified imcopy to write its verbose output to STDOUT instead of + STDERR. (6/24/92, Davis) + +pkg$images/imarith/imcombine.gx + The step where impl1$t is called to check if there is enough memory + did not set the return buffer because the values are irrelevant for + this check. However, depending on history, this buffer could have + arbitrary values and later when IMIO attempts to flush this buffer, + at least in the case of image type coersion, cause arithmetic errors. + The fix was to clear the returned buffers. (4/27/92, Valdes) + +pkg$images/imutil/t_imstack.x + Modified the imslice task to read the old and write a new axis map. + (4/23/92, Davis) + +pkg$images/geometry/t_imslice.x + Modified the imslice task to read the old and write a new axis map. + (4/23/92, Davis) + +pkg$images/geometry/t_blkavg.x +pkg$images/geometry/t_blkrep.x + Modified the calls to mw_shift and mw_scale to explicitly set the + number of logical axes instead of using the default of 0. + (4/23/92, Davis) + +pkg$images/geometry/t_imtrans.x + Modified imtranspose so that it correctly picks up the axis map + and writes it to the output image wcs. (4/23/92, Davis) + +pkg$images/register.par +pkg$images/geotran.par +pkg$images/doc/register.hlp +pkg$images/doc/geotran.hlp + Changed the default values of the parameters xscale and yscale in + the register and geotran tasks from INDEF to 1.0 (4/23/92, Davis) + +pkg$images/geometry/t_imtrans.x +pkg$images/doc/imtranspose.hlp + Modified the imtranspose task so it does a true transpose of the + axes instead of simply modifying the lterm. (4/8/92, Davis) + +pkg$images/iminfo/listpixels.x + Added the formats parameter for formatting the output pixel coordinates + to the listpixels task. These formats take precedence over the formats + stored in the WCS in the image header and the previous default format. + (4/7/92, Davis) + +pkg$images/imutil/t_imstack.x + Added wcs support to the imstack task. (4/2/92, Davis) + +pkg$images/iminfo/listpixels.x + Modified listpixels so that it will work correctly if the dimension + of the wcs is less than the dimension of the image. (3/16/92, Davis) + +pkg$images/geometry/t_geotran.x + Modified the rotate, imlintran, register and geotran tasks wcs updating + code to deal correclty with dimensionally reduced data. (3/16/92, Davis) + +pkg$images/imarith/icalip.gx +pkg$images/imarith/icclip.gx +pkg$images/imarith/ipslip.gx +pkg$images/imarith/icslip.gx +pkg$images/imarith/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) + +pkg$images/geometry/t_blkavg.x +pkg$images/geometry/t_blkrep.x + 1. Improved the precision of the blkavg task wcs updating code. + 2. Changed the blkrep task wcs updating code so that it is consistent + with blkavg. This means that a blkrep command followed by a blkavg + command or vice versa will return the original coordinate system + to within machine precision. (3/16/92, Davis) + +pkg$images/iminfo/listpixels.x + Modified listpixels to print out an error if it could not open the + wcs in the image. (3/15/92, Davis) + +pkg$images/geometry/t_magnify.x + Fixed a bug in the magnify task wcs updating code which was not + working correctly for dimensionally reduced images. (3/15/92, Davis) + +pkg$images/geometry/t_imtrans.x + Fixed a bug in the imtranspose task wcs updating code which was not + working correctly for dimensionally reduced images. (3/14/92, Davis) + +pkg$images/imarith/icalip.gx +pkg$images/imarith/icclip.gx +pkg$images/imarith/icslip.gx + There was a bug allowing the number of valid pixels counter to become + negative. Also there was a step which should not be done if the + number of valid pixels is less than 1; i.e. all pixels rejected. + A test was put in to skip this step. (3/13/92, Valdes) + +pkg$images/iminfo/t_imslice.x +pkg$images/doc/imslice.hlp + Added wcs support to the imslice task. + (3/12/92, Davis) + +pkg$images/iminfo/t_imstat.x + Fixed a bug in the code for computing the standard deviation, kurtosis, + and skew, wherein precision was being lost because two of the intermediate + variables in the computation were real instead of double precision. + (3/10/92, Davis) + +pkg$images/iminfo/listpixels.x + 1. Modified listpixels task to use the MWCS axis "format" attributes + if they are present in the image header. + 2. Added support for dimensionally reduced images, i.e. + images which are sections of larger images and whose coordinate + transformations depend on the reduced axes, to the listpixels task. + (3/6/92, Davis) + +pkg$images/imarith/t_imcombine.x +pkg$images/imarith/icsetout.x + Changed error messages to say IMCOMBINE instead of ICOMBINE. + (3/2/92, Valdes) + +pkg$images/imarith/iclog.x + Added listing of read noise and gain. (2/10/92, Valdes) + +pkg$images/imarith/icscale.x +pkg$images/imarith/icpclip.gx + 1. Datatype declaration for asumi was incorrect. + 2. Reduced the minimum number of images allowed for PCLIP to 3. + (1/7/92, Valdes) + +pkg$images/imarith/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) + +pkg$images/imarith/icgdata.gx +pkg$images/imarith/icscale.x + Fixed datatype declaration errors found by SPPLINT. (11/22/91, Valdes) + +pkg$images/iminfo/t_imstat.x + Fixed a bug in the kurtosis computation found by ST. + (Davis 10/11/91) + +pkg$images/iminfo/t_imstat.x +pkg$images/doc/imstat.hlp + Corrected a bug in the mode computation in imstatistics. The parabolic + interpolation correction for computing the histogram peak was being + applied in the wrong direction. Note that for dev$pix the wrong answer + is actually closer to the expected answer than the correct answer + due to binning effects. + (Davis 9/24/91) + +pkg$images/filters/t_gauss.x + The code which computes the gaussian kernel was producing a divide by + zero error if ratio=0.0 and bilinear=yes (2.10 version only). + (Davis 9/18/91) + +pkg$images/doc/magnify.hlp + Corrected a bug in the magnify help page. + (Davis 9/18/91) + +pkg$images/imarith/icsclip.gx +pkg$images/imarith/icaclip.gx +pkg$images/imarith/iccclip.gx + There was a typo, Memr[d[k]+k] --> Memr[d[j]+k]. (9/17/91, Valdes) + +pkg$images/imarith/icstat.gx +pkg$images/imarith/icmask.x + The offsets were used improperly in computing image statistics. + (Valdes, 9/17/91) + +pkg$images/geometry/t_imshift.x + The shifts file pointer was not being correctly initialized to NULL + in the case where no shifts file was declared. When the task + was invoked repeatedly from a script, this could result in an array being + referenced, for which space had not been previously allocated. + (Davis 7/29/91) + +pkg$images/imarith/imc* - +pkg$images/imarith/ic* + +pkg$images/imarith/t_imcombine.x +pkg$images/imarith/mkpkg +pkg$images/imarith/generic/mkpkg +pkg$images/imcombine.par +pkg$images/doc/imcombine.hlp + Replaced old version of IMCOMBINE with new version supporting masks, + offsets, and new algorithms. (Valdes 7/19/91) + +pkg$images/iminfo/imhistogram.x + Imhistogram has been modified to print the value of the middle of + histogram bin instead of the left edge if the output type is list + instead of plot. (Davis 6/11/91) + +pkg$images/t_imsurfit.x + Modified the sections file reading code to check the order of the + x1 x2 y1 y2 parameters and switch (x1,x2) or (y1,y2) if x2 < x1 or + y2 < y1 respectively. (Davis 5/28/91) + +pkg$images/listpixels.par +pkg$images/iminfo/listpixels.x +pkg$images/doc/listpixels.hlp + Modified the listpixels task to be able to print the pixel coordinates + in logical, physical or world coordinates. The default coordinate + system is still logical as before. (Davis 5/17/91) + +pkg$images/images.par +pkg$images/doc/minmax.hlp +pkg$images/imutil/t_minmax.x +pkg$images/imutil/minmax.x + Minmax was modified to do the minimum and maximum values computations + in double precision or complex instead of real if the input image + pixel type is double precision or complex. Note that the minimum and + maximum header values are still stored as real however. + (Davis 5/16/91) + +imarith/t_imarith.x + There was a missing statement to set the error flag if the image + dimensions did not match. (5/14/91, Valdes) + +doc/imarith.hlp + Fixed some formatting problems in the imarith help page. (5/2/91 Davis) + +imarith$imcombine.x + Changed the order in which images are unmapped to have the output images + closed last. This is to allow file descriptors for the temporary image + used when updating STF headers. (4/22/91, Valdes) + +pkg$images/geometry/t_blkavg.x +pkg$images/geometry/blkavg.gx +pkg$images/geometry/blkavg.x + The blkavg task was partially modified to support complex image data. + The full modifications cannot be made because of an error in abavx.x + and the missing routine absux.x. + (4/18/91 Davis) + +pkg$images/geometry/geofit.x + The x and y fits cross-terms switch was not being set correctly to "yes" + in the case where xxorder=2 and xyorder=2 or in the case where yxorder=2 + and yyorder=2. + (4/9/91 Davis) + +pkg$images/geometry/geogmap.x + Modified the line which prints the geometric parameters to use the + variable name xshift and yshift instead of delx and dely. + (4/9/91 Davis) + +pkg$images/imfit/imsurfit.x + Fixed a bug in the pixel rejection code which occurred when upper was > + 0.0 and lower = 0.0 or lower > 0 and upper = 0.0. The problem was that + the code was simply setting the rejection limits to the computed sigma + times the upper and lower parameters without checking for the 0.0 + condition first. In the first case this results in all points with + negative residuals being rejected and in the latter all points with + positive residuals are rejected. + (2/25/91 Davis) + +pkg$images/doc/hedit.hlp +pkg$images/doc/hselect.hlp +pkg$images/doc/imheader.hlp +pkg$images/doc/imgets.hlp + Added a reference to imgets in the SEE ALSO sections of the hedit and + hselect tasks. + Added a reference to hselect and hedit in the SEE ALSO sections of the + imheader and imgets tasks. + (2/22/91 Davis) + +pkg$images/gradient.hlp +pkg$images/laplace.hlp +pkg$images/gauss.hlp +pkg$images/convolve.hlp +pkg$images/gradient.par +pkg$images/laplace.par +pkg$images/gauss.par +pkg$images/convolve.par +pkg$images/t_gradient.x +pkg$images/t_laplace.x +pkg$images/t_gauss.x +pkg$images/t_convolve.x +pkg$images/convolve.x +pkg$images/xyconvolve.x +pkg$images/radcnv.x + The convolution operators were modified to run more efficiently in + certain cases. The LAPLACE task was modified to make use of the + radial symmetry of the convolution kernel in the y direction as well + as the x direction resulting in a modest speedup in execution time. + A new parameter bilinear was added to the GAUSS and CONVOLVE tasks. + By default and if appropriate mathematically, GAUSS now makes use of + the bilinearity or separability of the Gaussian function, + to separate the 2D convolution in x and y into two equivalent + 1D convolutions in x and y, resulting in a considerable speedup + in execution time. Similarly the user can know program CONVOLVE to + compute a bilinear convolution instead of a full 2D 1 if appropriate. + (1/29/91 Davis) + +pkg$images/filters/t_convolve.x + CONVOLVE was not decoding the legal 1D kernel "1.0 2.0 1.0" correctly + although the alternate form "1.0 2.0 1.0;" worked. Leading + blanks in string kernels as in for example " 1.0 2.0 1.0" also generated + and error. Fixed these bugs and added some additional error checking code. + (11/28/90 Davis) + +pkg$images/doc/gauss.hlp + Added a detailed mathematical description of the gaussian kernel used + by the GAUSS task to the help page. + +pkg$images/images.hd +pkg$images/rotate.cl +pkg$images/imlintran.cl +pkg$images/register.cl +pkg$images/register.par + Added src="script file name" entries to the IMAGES help database + for the tasks ROTATE, IMLINTRAN, and REGISTER. Changed the CL + script for REGISTER to a procedure script to remove the ugly + local variable declarations. Added a few comments to the scripts. + (12/11/90, Davis) + +pkg$images/iminfo/imhistogram.x + Added a new parameter binwidth to imhistogram. If binwidth is defined + it determines the histogram resolution in intensity units, otherwise + nbins determines the resolution as before. (10/26/90, Davis) + +pkg$images/doc/sections.hlp + Clarified what is meant by an image template and that the task itself + does not check whether the specified names are actually images. + The examples were improved. (10/3/90, Valdes) + +pkg$images/doc/fit1d.hlp + Changed lines to columns in example 2. (10/3/90, Valdes) + +pkg$images/imarith/imcscales.x + When an error occured while parsing the mode section the untrapped error + caused further problems downstream. Because it would require adding + lots of errchks to cause the program to gracefully abort I instead made + it a warning. (10/2/90, Valdes) + +pkg$images/imutil/hedit.x + Hedit was computing but not using min_lenarea. If the user specified + a min_lenuserarea greater than the default of 28800 then the default + was being used instead of the larger number. + +pkg$imarith/imasub.gx + The case of subtracting an image from the constant zero had a bug + which is now fixed. (8/14/90, Valdes) + +pkg$images/t_imtrans.x + Modified the imtranspose task so it will work on type ushort images. + (6/6/90 Davis) + +pkg$images + Added world coordinate system support to the following tasks: imshift, + shiftlines, magnify, imtranspose, blkrep, blkavg, rotate, imlintran, + register and geotran. The only limitation is that register and geotran + will only support simple linear transformations. + (2/24/90 Davis) + +pkg$images/geometry/geotimtran.x + Fixed a problem in the boundary extension "reflect" option code for small + images which was causing odd values to be inserted at the edges of the + image. + (2/14/90 Davis) + +pkg$images/iminfo/imhistogram.x + A new parameter "hist_type" was added to the imhistogram task giving + the user the option of plotting the integral, first derivative and + second derivative of the histogram as well as the normal histogram. + Code was contributed by Rob Seaman. + (2/2/90 Davis) + +pkg$images/geometry/geogmap.x + The path name of the help file was being erroneously renamed with + the result that when users ran the double precision version of the + code they could not find the help file. + (26/1/90 Davis) + +pkg$images/filters/t_boxcar.x,t_convolve.x + Added some checks for 1-D images. + (1/20/90 Davis) + +pkg$images/iminfo/t_imstat.x,imstat.h + Made several minor bug fixes and alterations in the imstatistics task + in response to user complaints and suggestions. + + 1. Changed the verbose parameter to the format parameter. If format is + "yes" (the default) then the selected fields are printed in fixed format + with column labels. Other wise the fields are printed in free format + separated by 2 blanks. This fixes the problem of fields running together. + + 2. Fixed a bug in the code which estimates the median from the image + histogram by linearly interpolating around the midpt of the integrated + histogram. The bug occurred when more than half the pixels were in the + first bin. + + 3. Added a check to ensure that the number of fields did not overflow + the fields array. + + 4. Removed the extraneous blank line printed after the title. + + 5. The pound sign is now printed at the beginning of the column header + string regardless of which field is printed first. In the previous + versions it was only being printed if the image name field was + printed first. + + 6. Changed the name of the median field to midpt in response to user + confusions about how the median is computed. + + (1/20/90, Davis) + +pkg$images/imutil/t_imslice.hlp + The imslice was not correctly computing the number of lines in the + output image in the case where the slice dimension was 1. + (12/4/89, Davis) + +pkg$images/doc/imcombine.hlp + Clarified and documented definitions of the scale, offset, and weights. + (11/30/89, Valdes) + +pkg$images/geometry/geotran.x + High order surfaces of a certain functional form could occasionally + produce out of bounds pixel errors. The bug was caused by not properly + computing the distortion of the image boundary for higher order + surfaces. + (11/21/89, Davis) + +pkg$images/geometry/imshift.x + The circulating buffer space was not being freed after each execution + of IMSHIFT. This did not cause an error in execution but for a long + list of frames could result in alot of memory being tied up. + (10/25/89, Davis) + +pkg$images/imarith/t_imarith.x + IMARITH is not prepared to deal with images sections in the output. + It used to look for '[' to decide if the output specification included + and image section. This has been changed to call the IMIO procedure + imgsection and check if a non-null section string is returned. + Thus it is up to IMIO to decide what part of the image name is + an image section. (9/5/89, Valdes) + +pkg$images/imarith/imcmode.gx + Fixed bug causing infinite loop when computing mode of constant value + section. (8/14/89, Valdes) + +==== +V2.8 +==== + +pkg$images/iminfo/t_imstat.x + Davis, Jun 15, 1989 + Added a couple of switches to that skew and kurtosis are not computed + if they are not to be printed. + +pkg$images/iminfo/t_imstat.x + Davis, Jun 14, 1989 + A simple mod was made to the skew and kurtosis computation to avoid + divide by zero errors in case of underflow. + +pkg$images/imutil/chpixtype.par + Davis, Jun 13, 1989 + The parameter file has been modified to accept an output pixel + type of ushort. + +pkg$images/imarith/imcombine.gx + Valdes, Jun 2, 1989 + A new scheme to detect file errors is now used. + +pkg$images/imfit/t_imsurfit.x + Davis, Jun 1, 1989 + 1. If the user set regions = "sections" but the sections file + did not exist the task would go into an infinite loop. The problem + was a missing error check on the open statement. + +pkg$images/iminfo/imhistogram.x,imhistogram.par + Davis, May 31, 1989 + A new version of imhistogram has been installed. These mods have + been made over a period of a month by Doug Tody and Rob Seaman. + The mods include + 1. An option to turn off log scaling of the y axis of the histogram plot. + 2. A new autoscale parameter which avoids aliasing problems for integer + data. + 3. A new parameter top_close which resolves the ambiguity in the top + bin of the histogram. + +pkg$images/imarith/imcombine.gx + Valdes, May 9, 1989 + 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. + +pkg$images/imarith/t_imarith.x + Valdes, May 6, 1989 + Operations in which the output image has an image section are now + skipped with a warning message. + +pkg$images/imarith/sigma.gx +pkg$images/imarith/imcmode.gx + Valdes, May 6, 1989 + 1. The weighted sigma was being computed incorrectly. + 2. The argument declarations were wrong for integer input images. + Namely the mean vector is always real. + 3. Minor change to imcmode.gx to return correct datatype. + +pkg$images/imstack,imslice + Davis, April 1, 1989 + The proto images tasks imstack and imslice have been moved from the + proto package to the images package. Imstack is unchanged except that + it now supports the image data types USHORT and COMPLEX. Imslice has + been modified to allow slicing along any dimension of the image instead + of just the highest dimension. + +pkg$images/imstatistics. + Davis, Mar 31, 1989 + 1. A totally new version of the imstatistics task has been written + and replaces the old version. The new task allows the user to select + which statistical parameters to compute and print. These include + the mean, median, mode, standard deviation, skew, kurtosis and the + minimum and maximum pixel values. + +pkg$images/imhistogram.par +pkg$images/iminfo/imhistogram.x +pkg$images/doc/imhistogram.hlp + Davis, Mar 31, 1989 + 1. The imhistogram task has been modified to plot "box" style histograms + as well as "line" type histograms. Type "line" remains the default. + +pkg$images/geometry/geotran.par,register.par,geomap.par +pkg$images/doc/geomap.hlp,register.hlp,geotran.hlp + Davis, Mar 6, 1989 + 1. Improved the parameter prompting in GEOMAP, REGISTER and GEOTRAN + and improved the help pages. + 2. Changed GEOMAP database quantities "xscale" and "yscale" to "xmag" + and "ymag" for consistency . Geotran was changed appropriately. + +pkg$images/imarith/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) + +pkg$images/imutil/imcopy.x + Davis, Feb 28, 1989 + 1. Added support for type USHORT to the imcopy task. This is a merged + ST modification. + +pkg$images/imarith/imcthreshold.gx +pkg$images/imcombine.par +pkg$images/doc/imcombine.hlp +pkg$images/imarith/imcscales.x + Valdes, Feb 16, 1989 + 1. Added provision for blank value when all pixels are rejected by the + threshold. + 2. Fixed a bug that was improperly scaling 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. + +pkg$images/imfit/imsurfit.x + Davis, Feb 23, 1989 + Fixed a bug in the median fitting code which could cause the porgram + to go into an infinite loop if the region to be fitted was less than + the size of the whole image. + +pkg$images/geometry/t_magnify.x + Davis, Feb 16, 1989 + Modified magnify to work on 1D images as well as 2D images. The + documentation has been updated. + +pkg$images/geometry/t_geotran.x + Davis, Feb 15, 1989 + Modified the GEOTRAN and REGISTER tasks so that they can handle a list + of transform records one for each input image. + +pkg$images/imarith/imcmode.gx + Valdes, Feb 8, 1989 + Added test for nx=1. + +pkg$images/imarith/t_imcombine.x + Valdes, Feb 3, 1989 + The test for the datatype of the output sigma image was wrong. + +pkg$images/iminfo/listpixels.x,listpixels.par + Davis, Feb 6, 1989 + The listpixels task has been modified to print out the pixels for a + list of images instead of a single image only. A title line for each + image listed can optionally be printed on the standard output if + the new parameter verbose is set to yes. + +pkg$images/geometry/t_imshift.x + Davis, Feb 2, 1989 + Added a new parameter shifts_file to the imshift task. Shifts_file + is the name of a text file containing the the x and yshifts for + each input image to be shifted. The number of input shifts must + equal the number of input images. + +pkg$images/geometry/t_geomap.x + Davis, Jan 17, 1989 + Added an error message for the case where the coordinates is empty + of there are no points in the specified data range. Previously the + task would proceed to the next coordinate file without any message. + +pkg$images/geometry/t_magnify.x + Davis, Jan 14, 1989 + Added the parameter flux conserve to the magnify task to bring it into + line with all the other geometric transformation tasks. + +pgk$images/geometry/geotran.x,geotimtran.x + Davis, Jan 2, 1989 + A bug was fixed in the flux conserve code. If the x and y reference + coordinates are not in pixel units and are not 1 then + the computed flux per pixel was too small by xscale * yscale. + +pkg$images/filters/acnvrr.x,convolve.x,boxcar.x,aboxcar.x + Davis, Dec 27, 1988 + I changed the name of the acnvrr procedure to cnv_radcnvr to avoid + a name conflict with a vops library procedure. This only showed + up when shared libraries were implemented. I also changed the name + of the aboxcarr procedure to cnv_aboxr to avoid conflict with the + vops naming conventions. + +pkg$images/imarith/imcaverage.gx + Davis, Dec 22, 1988 + Added an errchk statement for imc_scales and imgnl$t to stop the + program bombing with segmentation violations when mode <= 0. + +pkg$images/imarith/imcscales.x + Valdes, Dec 8, 1988 + 1. IMCOMBINE 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. + +pkg$images/iminfo/imhistogram.x + Davis, Nov 30, 1988 + Changed the list+ mode so that bin value and count are printed out instead + of bin count and value. This makes the plot and list modes compatable. + +pkg$images/iminfo/t_imstat.x + Davis, Nov 17, 1988 + Added the n=n+1 back into the inner loop of imstat. + +pkg$images/geotran.par,register.par + Davis, Nov 11 , 1988 + Fixed to glaring errors in the parameter files for register and geotran. + Xscale and yscale were described as pixels per reference unit when + they should be reference units per pixel. The appropriate bug fix has been + made. + +pkg$images/geometry/t_geotran.x + Davis, November 7, 1988 + The routine gsrestore was not being error checked. If either of the + input x or y coordinate surface was linear and the other was not, + the message came back GSRESTORE: Illegal x coordinate. This bug has + been fixed. + +pkg$images/imarith/imcombine.gx + Valdes, October 19, 1988 + A vops clear routine was not called generically causing a crash with + double images. + +pkg$images/filters/t_fmedian.x,t_median.x,t_fmode.x,t_mode.x,t_gradient.x + t_gauss.x,t_boxcar.x,t_convolve.x,t_laplace.x + Davis, October 4, 1988 + I fixed a bug in the error handling code for the filters tasks. If + and error occurred during task execution and the input image name was + the same as the output image name then the input image was trashed. + +pkg$images/imarith/imcscales.gx + Valdes, September 28, 1988 + It is now an error for the mode to be nonpositive when scaling or weighting. + +pkg$images/imarith/imcmedian.gx + Valdes, August 16, 1988 + 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. + +pkg$images/geometry/t_imshift.x + Davis, August 11, 1988 + 1. Imshift has been modified to uses the optimized code if nearest + neighbour interpolation is requested. A nint is done on the shifts + before calling the quick shift routine. + 2. If the requested pixel shift is too large imshift will now + clean up any pixelless header files before continuing execution. + +pkg$images/geometry/blkavg.gx + Davis, July 13, 1988 + Blkavg has been fixed so that it will work on 1D images. + +pkg$images/geometry/t_imtrans.x,imtrans.x + Davis, July 12, 1988 + Imtranspose has been modified to work on complex images. + +pkg$images/imutil/t_chpix.x + Davis, June 29, 1988 + A new task chpixtype has been added to the images package. Chpixtype + changes the pixel types of a list of images to a specified output pixel + type. Seven data types are supported "short", "ushort", "int", "long" + "real" and "double". + +pkg$images/geometry/rotate.cl,imlintran.cl,t_geotran.x + Davis, June 10, 1988 + The rotate and imlintran scripts have been rewritten to use procedure + scripts. This removes all the annoying temporary cl variables which + appear when the user does an lpar. In previous versions of these + two tasks the output was restricted to being the same size as the input + image. This is still the default case, but the user can now set the + ncols and nrows parameters to the desired output size. I ncols or nlines + < 0 then then the task compute the output image size required to contain + the whole input image. + +pkg$images/filters/t_convolve.x,t_laplace.x,t_gradient.x,t_gauss.x,convolve.x + Davis, June 1, 1988 + The convolution operators laplace, gauss and convolve have been modified + to make use of radial symmetry in the convolution kernel. In gauss and + laplace the change is transparent to the user. For the convolve operator + the user must indicate that the kernel is radially symmetric by setting + the parameter radsym. For kernels of 7 by 7 or greater the speedup + in timings is on the order of 30% on the Vax 750 with the fpa. + +pkg$images/imarith/imcmode.gx + Valdes, Apr 11, 1988 + 1. The use of a mode sections was handled incorrectly. + +pkg$images/imfit/fit1d.x + Valdes, Jan 4, 1988 + 1. Added an error check for a failure in IMMAP. The missing error check + caused FIT1D to hang when a bad input image was specified. + +pkg$images/magnify.par +pkg$images/imcombine.par +pkg$images/imarith/imcmode.gx +pkg$images/doc/imarith.hlp + Valdes, Dec 7, 1987 + 1. Added option list to parameter prompts. + 2. Fixed minor typo in help page + 3. The mode calculation in IMCOMBINE would go into an infinite loop + if all the pixel values were the same. If all the pixels are the + same them it skips searching for the mode and returns the constant + number. + +pkg$images/geometry/geotimtran.x + Davis, Nov 25, 1987 + 1. A bug in the boundary extension = wrap option was found in the + IMLINTRAN task. The problem occured in computing values for out of + bounds pixels in the range 0.0 < x < 1.0, ncols < x < ncols + 1.0, + 0.0 < y < 1.0 and nlines < y < nlines + 1. The computed coordinates + were falling outside the boundaries of the interpolation array. + +pkg$images/geometry/t_geomap.x,geograph.x + Davis, Nov 19, 1987 + 1. The geomap task now writes the name of the output file into the database. + 2. Rotation angles of 360. degrees have been altered to 0 degrees. + +pkg$images/imfit/t_imsurfit.x,imsurfit.x +pkg$images/lib/ranges.x + Davis, Nov 2, 1987 + A bug in the regions fitting option of the IMSURFIT task has been found + and fixed. This bug would occur when the user set the regions parameter + to sections and then listed section which overlapped each other. The + modified ranges package was not handling the overlap correctly and + computing a number of points which was incorrect. + +pkg$images/imarith/* + + Valdes, Sep 30, 1987 + The directory was reorganized to put generic code in the subdirectory + generic. + + A new task called IMCOMBINE has been added. It provides for combining + images by a number of algorithms, statistically weighting the images + when averaging, scaling or offsetting the images by the exposure time + or image mode before combining, and rejecting deviant pixels. It is + almost fully generic including complex images and works on images of + any dimension. + +pkg$images/geometry/geotran.x + Davis, Sept 3, 1987 + A bug in the flux conserving algorithm was found in the geotran code. + The symptom was that the flux of the output image occasionally was + negative. This would happen when two conditions were met, the transformation + was of higher order than a simple rotation, magnification, translation + and an axis flip was involved. The mathematical interpretation of this + bug is that the coordinate surface had turned upside down. The solution + for people running systems with this bug is to multiply there images + by -1. + +pkg$images/imfit/imsurfit.h,t_imsurfit.x + Davis, Aug 6, 1987 + A new option was added to the parameter regions in the imsurfit task. + Imsurfit will now fit a surface to a single circular region defined + by an x and y center and a radius. + +pkg$images/geometry/geotimtran.x + Davis, Jun 15, 1987 + Geotran and register were failing when the output image number of rows + and columns was different from the input number of rows and columns. + Geotran was mistakenly using the input images sizes to determine the + number of output lines that should be produced. The same problem occurred + when the values of the boundary pixels were being computed. The program + was using the output image dimensions to compute the boundary pixels + instead of the input image dimensions. + +pkg$images/geometry/geofit.x,geogmap.x + Davis, Jun 11, 1987 + A bug in the error checking code in the geomap task was fixed. The + condition of too few points for a reasonable was not being trapped + correctly. The appropriate errchk statements were added. + +pkg$images/geomap.par + Davis, Jun 10, 1987 + The default fitting function was changed to polynomial. This will satisfy + most users who wish to do shifts, rotations, and magnifications and + avoid the neccessity of correctly setting the xmin, xmax, ymin, and ymax + parameters. For the chebyshev and legendre polynomial functions these + parameters must be explicitly set. For reference coordinates in pixel + units the normal settings are 1, ncols, 1 and nlines respectively. + +pkg$images/iminfo/hselect.x,imheader.x,images$/imutil/hselect.x + Davis, Jun 8, 1987 + Imheader has been modified to open an image with the default min_lenuserarea + Hselect and hedit will now open the image setting the user area to the + maximum of 28800 chars or the min_lenuser environment variable. + +pkg$images/iminfo/t_imstat.x + Davis, May 22, 1987 + An error in the image minimum computation was corrected. This error + would show up most noiticeably if imstat was run on a 1 pixel image. + The min value would be left set to MAX_REAL. + +pkg$images/filters/mkpkg + Davis, May 22, 1987 + I added mach.h to the dependency file list of t_fmedian.x and + recompiled. The segmentation violations I had been getting in the + program disappeared. + +pkg$images/t_shiftlines.x,shiftlines.x + Davis, April 15, 1987 + 1. I changed the names of the procedures shiftlines and shiftlinesi + to sh_lines and sh_linesi. When the original names were contracted + to 6 letter fortran names they became shifti and shifts which just + so happens to collide with shifti and shifts in the subdirectory + osb. On VMS this was causing problems with the shareable libraries. + If images was linked with -z there was no problem. + +pkg$images/imarith/t_imsum.x + Valdes, March 24, 1987 + 1. IMSUM was failing to unmap images opened to check image dimensions + in a quick first pass through the image list. This is probably + the source of the out of files problem with STF images. It may + be the source of the out of memory problem reported from AOS/IRAF. + +pkg$images/imfit/fit1d.x +pkg$images/imfit/mkpkg + Valdes, March 17, 1987 + 1. Added error checking for the illegal operation in which both input + and output image had an image section. This was causing the task + to crash. The task now behaves properly in this circumstance and + even allows the fitted output to be placed in an image section of + an existing output image (even different than the input image + section) provided the input and output images have the same sizes. + +pkg$images/t_convolve.x + Davis, March 3, 1987 + 1. Fixed the kernel decoding routine in the convolve task so that + it now recognizes the row delimter character in string entry mode. + +pkg$images/geometry,filters + Davis, February 27, 1987 + 1. Changed all the imseti (im, TY_BNDRYPIXVAL, value) calls to imsetr. + +pkg$images/t_minmax.x,minmax.x + Davis, February 24, 1987 + 1. Minmax has been changed to compute the minimum and maximum pixel + as well as the minimum and maximum pixel values. The pixels are output + in section notation and stored in the minmax parameter file. + +pkg$images/t_magnify.x + Davis, February 19, 1987 + 1. Magnify was aborting with the error MSIFIT: Too few datapoints + when trying to reduce an image using the higher order interpolants + poly3, poly5 and spline3. I increased the NEDGE defined constant + from 2 to three and modified the code to use the out of bounds + imio. + +pkg$images/geograph.x,geogmap.x + Davis, February 17, 1987 + 1. Geomap now uses the gpagefile routine to page the .keys file. + The :show command deactivates the workstation before printing a + block of text and reactivates it when it is finished. + +pkg$images/geometry/geomap,geotran + Davis, January 26, 1987 + 1. There have been substantial changes to the geomap, and geotrans + tasks and those tasks rotate, imlintran and register which depend + on them. + 2. Geomap has been changed to be able to compute a transformation + in both single and double precision. + 3. The geotran code has been speeded up considerably. A simple rotate + now takes 70 seconds instead of 155 seconds using bilinear interpolation. + 4. Two new cl parameters nxblock and nyblock have been added to the + rotate, imlintran, register and geotran tasks. If the output image + is smaller than these parameters then the entire output image + is computed at once. Otherwise the output image is computed in blocks + nxblock by nyblock in size. + 5. The 3 geotran parameters rotation, scangle and flip have been replaced + with two parameters xrotation and yrotation which serve the same purpose. + +pkg$images/geometry/t_shiftlines.x,shiftlines.x + Davis, January 19, 1987 + 1. The shiftlines task has been completely rewritten. The following + are the major changes. + 2. Shiftlines now makes use of the imio boundary extension operations. + Therefore the four options: nearest pixel, reflect, wrap and constant + boundary extension are available. + 3. The interpolation code has been vectorised. The previous version + was using the function call asieval for every output pixel evaluated. + The asieval call were replaced with asivector calls. + 4. An extra CL parameter constant to support constant boundary + exension was added. + 5. The shiftlines help page was modified and the date changed to + January 1987. + +pkg$images/imfit/imsurfit.x + Davis, January 12, 1987 + 1. I changed the amedr call to asokr calls. For my application it did + not matter whether the input array is left partially sorted and the asokr + routine is more efficient. + +pkg$images/lib/pixlist.x + Davis, December 12, 1986 + 1. A bug in the pl_get_ranges routine caused the routine to fail when the + number of ranges got too large. The program could not detect the end of + the ranges and would go into an infinite loop. + +pkg$images/iminfo/t_imstat.x + Davis, December 3, 1986 + 1. Imstat was failing on constant images because finite machine precision + could result in a negative sigma squared. Added a check for this condition. + +pkg$images/filters/fmode.x + Davis, October 27, 1986 + 1. Added a check for 0 data range before calling amapr. + +pkg$images/imarith/imsum.gx + Valdes, October 20, 1986 + 1. Found and fixed bug in this routine which caused pixel rejection + to fail some fraction of the time. + +pkg$images/geometry/blkrp.gx + Valdes, October 13, 1986 + 1. There was a bug when the replication factor for axis 1 was 1. + +pkg$images/iminfo/imhistogram.x + Hammond, October 8, 1986 + 1. Running imhistogram on a constant valued image would result in + a "floating divide by zero fault" in ahgm. This condition is + now trapped and a warning printed if there is no range in the data. + +pkg$images/tv/doc/cvl.hlp + Valdes, October 7, 1986 + 1. Typo in V2.3 documentation fixed: "zcale" -> "zscale". + +pkg$images/fit1d.par + Valdes, October 7, 1986 + 1. When querying for the output type the query was: + +Type of output (fit, difference, ratio) (fit|difference|ratio) (): + + The enumerated values were removed since they are given in the + prompt string. + +pkg$images/imarith/t_imsum.x +pkg$images/imarith/imsum.gx +pkg$images/do/imsum.hlp + Valdes, October 7, 1986 + 1. Medians or pixel rejection with more than 15 images is now + correct. There was an error in buffering. + 2. Averages of integer datatype images are now correct. The error + was caused by summing the pixel values divided by the number + of images instead of summing the pixel values and then dividing + by the number of images. + 3. Option keywords may now be abbreviated. + 4. The output pixel datatype now defaults to the calculation datatype + as is done in IMARITH. The help page was modified to indicate this. + 5. Dynamic memory is now used throughout to reduce the size of the + executable. + 6. The bugs 1-2 are present in V2.3 and not in V2.2. + +pkg$images/imarith/t_imarith.x +pkg$images/imarith.par +pkg$images/doc/imarith.hlp + Valdes, October 6, 1986 + 1. The parameter "debug" was changed to "noact". "debug" is reserved + for debugging information. + 2. The output pixel type now defaults to the calculation datatype. + 3. The datatype of constant operands is determined with LEXNUM. This + fixes a bug in which a constant such as "1." was classified as an + integer. + 4. Trailing whitespace in the string for a constant operand is allowed. + This fixes a bug with using "@" files created with the task FIELDS + from a table of numbers. Trailing whitespace in image names is + not checked for since this should be taken care of by lower level + system services. + 5. The reported bug with the "max" operation not creating a pixel file + was the result of the previous round of changes. This has been + corrected. This problem does not exist in the released version. + 6. All strings are now dynamically allocated. Also IMTOPENP is used + to open a CL list directly. + 7. The help page was revised for points (1) and (2). + +pkg$images/fmode.par +pkg$images/fmd_buf.x +pkg$images/med_sort.x + Davis, September 29, 1986 + 1. Changed the default value of the unmap parameter in fmode to yes. The + documentation was changed and the date modified. + 2. Added a test to make sure that the input image was not a constant + image in fmode and fmedian. + 3. Fixed the recently added swap macro in the sort routines which + was giving erroneous results for small boxes in tasks median and mode. + +pkg$images/imfit/fit1d.x + Valdes, September 24, 1986 + 1. Changed subroutine name with a VOPS prefix to one with a FIT1D + prefix. + +pkg$images/imarith/t_imdivide.x +pkg$images/doc/imdivide.hlp +pkg$images/imdivide.par + Valdes, September 24, 1986 + 1. Modified this ancient and obsolete task to remove redundant + subroutines now available in the VOPS library. + 2. The option to select action on zero divide was removed since + there was only one option. Parameter file changed. + 3. Help page revised. + +pkg$images/geometry/t_blkrep.x + +pkg$images/geometry/blkrp.gx + +pkg$images/geometry/blkrep.x + +pkg$images/doc/blkrep.hlp + +pkg$images/doc/mkpkg +pkg$images/images.cl +pkg$images/images.men +pkg$images/images.hd +pkg$images/x_images.x + Valdes, September 24, 1986 + 1. A new task called BLKREP for block replicating images has been added. + This task is a complement to BLKAVG and performs a function not + available in any other way. + 2. Help for BLKREP has been added. + +pkg$images/imarith/t_imarith.x +pkg$images/imarith/imadiv.gx +pkg$images/doc/imarith.hlp +pkg$images/imarith.par + Valdes, September 24, 1986 + 1. IMARITH has been modified to provide replacement of divisions + by zero with a constant parameter value. + 2. The documentation has been revised to include this change and to + clarify and emphasize areas of possible confusion. + +pkg$images/doc/magnify.hlp +pkg$images/doc/blkavg.hlp + Valdes, September 18, 1986 + 1. The MAGNIFY help document was expanded to clarify that images with axis + lengths of 1 cannot be magnified. Also a discussion of the output + size of a magnified image. This has been misunderstood often. + 2. Minor typo fix for BLKAVG. + +images$geometry/blkav.gx: Davis, September 7, 1986 + 1. The routine blkav$t was declared a function but called everywhere as + a procedure. Removed the function declaration. + +images$filters/med_sort.x: Davis, August 14, 1986 + 1. A bug in the sorting routine for MEDIAN and MODE in which the doop + loop increment was being set to zero has been fixed. This bug was + causing MEDIAN and MODE to fail on class 6 for certain sized windows. + +images$imfit/fit1d.x: Davis, July 24, 1986 + 1. A bug in the type=ratio option of fit1d was fixed. The iferr call + on the vector operator adivr was not trapping a divide by zero + condition. Changed adivr to adivzr. + +images$iminfo/listpixels.x: Davis, July 21, 1986 + 1. I changed a pargl to pargi for writing out the column number of the + pixels. + +images$iminfo/t_imstat.x: Davis, July 21, 1986 + 1. I changed a pargr to a pargd for the double precision quantitiies + sum(MIN) and sum(MAX). + +images$imfit/t_lineclean.x: Davis, July 14, 1986 + 1. Bug in the calling sequence for ic_clean fixed. The ic pointer + was not being passed to ic_clean causing access violation and/or + segmentation violation errors. + +images$imfit/fit1d.x, lineclean.x: Valdes, July 3, 1986 + 1. FIT1D and LINECLEAN modified to use new ICFIT package. + +From Valdes June 19, 1986 + +1. The help page for IMSUM was modified to explicitly state what the +median of an even number of images does. + +----------------------------------------------------------------------------- + +From Davis June 13, 1986 + +1. A bug in CONVOLVE in which insufficient space was being allocated for +long (> 161 elements) 1D kernels has been fixed. CONVOLVE was not +allocating sufficent extra space. + +----------------------------------------------------------------------------- + +From Davis June 12, 1986 + +1. I have changed the default value of parameter unmap in task FMEDIAN to +yes to preserve the original data range. + +2. I have changed the value of parameter row_delimiter from \n to ;. + +----------------------------------------------------------------------------- + +From Davis May 12, 1986 + +1. Changed the angle convention in GAUSS so that theta is the angle of the +major axis with respect to the x axis measured counter-clockwise as specified +in the help page instead of the negative of that angle. + +----------------------------------------------------------------------------- + +From Davis Apr 28, 1986 + +1. Moved geomap.key to lib$scr and made redefined HELPFILE in geogmap.x +appropriately. + +------------------------------------------------------------------------------ + +images$imarith/imsum.gx: Valdes Apr 25, 1986 + 1. Fixed bug in generic code which called the real VOPS operator + regardless of the datatype. This caused IMSUM to fail on short + images. + +From Davis Apr 17, 1986 + +1. Changed constructs of the form boolean == false in the file imdelete.x +to ! boolean. + +------------------------------------------------------------------------------ + +images$imarith: Valdes, April 8, 1986 + 1. IMARITH has been modified to also operate on a list of specified + header parameters. This is primarily used when adding images to + also added the exposure times. A new parameter was added and the + help page modified. + 2. IMSUM has been modified to also operate on a list of specified + header parameters. This is primarily used when summing images to + also sum the exposure times. A new parameter was added and the + help page modified. + +------------------------------------------------------------------------------ + +From Valdes Mar 24, 1986: + +1. When modifying IMARITH to handle mixed dimensions the output image header +was made a copy of the image with the higher dimension. However, the default +when the images were of the same dimension changed to be a copy of the second +operand. This has been changed back to being a copy of the first operand +image. + +------------------------------------------------------------------------------ + +From Davis Mar 21, 1986: + +1. A NULL pointer bug in the subroutine plfree inside IMSURFIT was causing +segmentation violation errors. A null pointer test was added to plfree. + +------------------------------------------------------------------------------ + +From Davis Mar 20, 1986: + +1. A bug involving in place operations in several image tasks has been fixed. + +------------------------------------------------------------------------------ + +From Davis Mar 19, 1986: + +1. IMSURFIT no longer permits the input image to be replaced by the output +image. + +2. The tasks IMSHIFT, IMTRANSPOSE, SHIFTLINES, and GEOTRAN have been modified +to use the images tools xt_mkimtemp and xt_delimtemp for in place +calculations. + +------------------------------------------------------------------------------- + +From Valdes Mar 13, 1986: + +1. Bug dealing with type coercion in short datatype images in IMARITH and IMSUM +which occurs on the SUN has been fixed. +------ +From Valdes Mar 10, 1986: + +1. IMSUM has been modified to work on any number of images. + +2. Modified the help page +------ +From Valdes Feb 25, 1986: + +There have been two changes to IMARITH: + +1. A bug preventing use of image sections has been removed. + +2. An improvement allowing use of images of different dimension. +The algorithm is as follow: + + a. Check if both operands are images. If not the output + image is a copy of the operand image. + + b. Check that the axes lengths are the same for the dimensions + in common. For example a 3D and 2D image must have the same + number of columns and lines. + + c. Set the output image to be a copy of the image with the + higher dimension. + + d. Repeat the operation over the lower dimensions for each of + the higher dimensions. + +For example, consider subtracting a 2D image from a 3D image. The output +image will be 3D and the 2D image is subtracted from each band of the +3D image. This will work for any combination of dimensions. Another +example is dividing a 3D image by a 1D image. Then each line of each +plane and each band will be divided by the 1D image. Likely applications +will be subtracting biases and darks and dividing by response calibrations +in stacked observations. + +3. Modified the help page +=========== +Release 2.2 +=========== +From Davis Mar 6, 1986: + +1. A serious bug had crept into GAUSS after I made some changes. For 2D +images the sense of the sigma was reversed, i.e sigma = 2.0 was actually +sigma = 0.5. This bug has now been fixed. + +--------------------------------------------------------------------------- + +From Davis Jan 13, 1986: + +1. Listpixels will now print out complex pixel values correctly. + +--------------------------------------------------------------------------- + +From Davis Dec 12, 1985: + +1. The directional gradient operator has been added to the images package. + +--------------------------------------------------------------------------- + +From Valdes Dec 11, 1985: + +1. IMARITH has been modified to first check if an operand is an existing +file. This allows purely numeric image names to be used. + +--------------------------------------------------------------------------- + +From Davis Dec 11, 1985: + +1. A Laplacian (second derivatives) operator has been added to the images +package. + +--------------------------------------------------------------------------- + +From Davis Dec 10, 1985: + +1. The new convolution tasks boxcar, gauss and convolve have been added +to the images package. Convolve convolves an image with an arbitrary +user supplied rectangular kernel. Gauss convolves an image with a 2D +Gaussian of arbitrary size. Boxcar will smooth an image using a smoothing +window of arbitrary size. + +2. The images package source code has been reorganized into the following +subdirectories: 1) filters 2) geometry 3) imfit 4) imarith 4) iminfo and +5) imutil 6) lib. Lib contains routines which may be of use to several IRAF +tasks such as ranges. The imutil subdirectory contains tasks which modify +images in some way such as hedit. The iminfo subdirectory contains code +for displaying header and pixel values and other image characteristics +such as the histogram. Image arithmetic and fitting routines are found +in imarith and imfit respectively. Filters contains the convolution and +median filtering routines and geometry contains the geometric distortion +corrections routines. + +3. The documentation of the main images package has been brought into +conformity with the new IRAF standards. + +4. Documentation for imdelete, imheader, imhistogram, listpixels and +sections has been added to the help database. + +5. The parameter structure for imhistogram has been simplified. The +redundant parameters sections and setranges have been removed. + +--------------------------------------------------------------------------- + + +From Valdes Nov 4, 1985: + +1. IMCOPY modified so that the output image may be a directory. Previously +logical directories were not correctly identified. +------ + +From Davis Oct 21, 1985: + +1. A bug in the pixel rejection cycle of IMSURFIT was corrected. The routine +make_ranges in ranges.x was not successfully converting a sorted list of +rejected pixels into a list of ranges in all cases. + +2. Automatic zero divide error checking has been added to IMSURFIT. +------ +From Valdes Oct 17, 1985: + +1. Fit1d now allows averaging of image lines or columns when interactively +setting the fitting parameters. The syntax is "Fit line = 10 30"; i.e. +blank separated line or column numbers. A single number selects just one +line or column. Be aware however, that the actual fitting of the image +is still done on each column or line individually. + +2. The zero line in the interactive curve fitting graphs has been removed. +This zero line interfered with fitting data near zero. +------ +From Rooke Oct 10, 1985: + +1. Blkaverage was changed to "blkavg" and modified to support any allowed +number of dimensions. It was also made faster in most cases, depending on +the blocking factors in each dimension. +------ +From Valdes Oct 4, 1985: + +1. Fit1d and lineclean modified to allow separate low and high rejection +limits and rejection iterations. +------ +From Davis Oct 3, 1985: + +1. Minmax was not calculating the minimum correctly for integer images. +because the initial values were not being set correctly. +------ +From Valdes Oct 1, 1985: + +1. Imheader was modified to print the image history. Though the history +mechanism is little used at the moment it should become an important part +of any image. + +2. Task revisions renamed to revs. +------ +From Davis Sept 30, 1985: + +1. Two new tasks median and fmedian have been added to the images package. +Fmedian is a fast median filtering algorithm for integer data which uses +the histogram of the image to calculate the median at each window. Median +is a slower but more general algorithm which performs the same task. +------ +From Valdes August 26, 1985: + +1. Blkaverage has been modified to include an new parameter called option. +The current options are to average the blocks or sum the blocks. +------ +From Valdes August 7, 1985 + +1. Fit1d and lineclean wer recompiled with the modified icfit package. +The new package contains better labeling and graph documentation. + +2. The two tasks now have parameters for setting the graphics device +and reading cursor input from a file. +______ +From: /u2/davis/ Tue 08:27:09 06-Aug-85 +Package: images +Title: imshift bug + +Imshift was shifting incorrectly when an integral pixel shift in x and +a fractional pixel shift in y was requested. The actual x shift was +xshift + 1. The bug has been fixed and imshift will now work correctly for +any combination of fractional and integral pixel shifts +------ +From: /u2/davis/ Fri 18:14:12 02-Aug-85 +Package: images +Title: new images task + +A new task GEOMAP has been added to the images package. GEOMAP calculates +the spatial transformation required to map one image onto another. +------ +From: /u2/davis/ Thu 16:47:49 01-Aug-85 +Package: images +Title: new images tasks + +The tasks ROTATE, IMLINTRAN and GEODISTRAN have been added to the images +package. ROTATE rotates and shifts an image. IMLINTRAN will rotate, rescale +and shift an an image. GEODISTRAN corrects an image for geometric distortion. +------ +From Valdes July 26, 1985: + +1. The task revisions has been added to page revisions to the images +package. The intent is that each package will have a revisions task. +Note that this means there may be multiple tasks named revisions loaded +at one time. Typing revisions alone will give the revisions for the +current package. To get the system revisions type system.revisions. + +2. A new task called fit1d replaces linefit. It is essentially the same +as linefit except for an extra parameter "axis" which selects the axis along +which the functions are to be fit. Axis 1 is lines and axis 2 is columns. +The advantages of this change are: + + a. Column fitting can now be done without transposing the image. + This allows linefit to be used with image sections along + both axes. + b. For 1D images there is no prompt for the line number. +.endhelp diff --git a/pkg/images/immatch/doc/geomap.hlp b/pkg/images/immatch/doc/geomap.hlp new file mode 100644 index 00000000..525e70b8 --- /dev/null +++ b/pkg/images/immatch/doc/geomap.hlp @@ -0,0 +1,435 @@ +.help geomap Jan01 images.immatch +.ih +NAME +geomap -- compute one or more spatial transformation functions +.ih +USAGE +geomap input database xmin xmax ymin ymax +.ih +PARAMETERS +.ls input +The list of text files containing the pixel coordinates of control points in +the reference and input images. The control points are listed +one per line with xref, yref, xin, and yin in columns 1 through 4 respectively. +.le +.ls database +The name of the text file database where the computed transformations will +be stored. +.le +.ls xmin, xmax, ymin, ymax +The range of reference coordinates over which the computed coordinate +transformation is valid. If the user is working in pixel units these limits +should normally be set to the values of the column and row limits of the +reference image, e.g xmin = 1.0, xmax = 512, ymin= 1.0, ymax = 512 for +a 512 x 512 image. The minimum and maximum xref and yref values in \fIinput\fR +are used if xmin, xmax, ymin, or ymax are undefined. +.le +.ls transforms = "" +An optional list of transform record names. If transforms is undefined +the database record(s) are assigned the names of the +individual text files specified by \fIinput\fR. +.le +.ls results = "" +Optional output files containing a summary of the results including a +description of the transform geometry and a listing of the input coordinates, +the fitted coordinates, and the fit residuals. The number of results files +must be one or equal to the number of input files. If results is "STDOUT" the + results summary is printed on the standard output. +.le +.ls fitgeometry = "general" +The fitting geometry to be used. The options are the following. +.ls shift +X and y shifts only are fit. +.le +.ls xyscale +X and y shifts and x and y magnification factors are fit. Axis flips are +allowed for. +.le +.ls rotate +X and y shifts and a rotation angle are fit. Axis flips are allowed for. +.le +.ls rscale +X and y shifts, a magnification factor assumed to be the same in x and y, and a +rotation angle are fit. Axis flips are allowed for. +.le +.ls rxyscale +X and y shifts, x and y magnifications factors, and a rotation angle are fit. +Axis flips are allowed for. +.le +.ls general +A polynomial of arbitrary order in x and y is fit. A linear term and a +distortion term are computed separately. The linear term includes an x and y +shift, an x and y scale factor, a rotation and a skew. Axis flips are also +allowed for in the linear portion of the fit. The distortion term consists +of a polynomial fit to the residuals of the linear term. By default the +distortion term is set to zero. +.le + +For all the fitting geometries except "general" no distortion term is fit, +i.e. the x and y polynomial orders are assumed to be 2 and the cross term +switches are assumed to be "none", regardless of the values of the +\fIxxorder\fR, \fIxyorder\fR, \fIxxterms\fR, \fIyxorder\fR, \fIyyorder\fR and +\fIyxterms\fR parameters set by the user. +.le +.ls function = "polynomial" +The type of analytic surface to be fit. The options are the following. +.ls legendre +Legendre polynomials in x and y. +.le +.ls chebyshev +Chebyshev polynomials in x and y. +.le +.ls polynomial +Power series in x and y. +.le +.le +.ls xxorder = 2, xyorder = 2, yxorder = 2, yyorder = 2 +The order of the polynomials in x and y for the x and y fits respectively. +The default order and cross term settings define the linear term in x +and y, where the 6 coefficients can be interpreted in terms of an x and y shift, +an x and y scale change, and rotations of the x and y axes. The "shift", +"xyscale", "rotation", "rscale", and "rxyscale", fitting geometries +assume that the polynomial order parameters are 2 regardless of the values +set by the user. If any of the order parameters are higher than 2 and +\fIfitgeometry\fR is "general", then a distortion surface is fit to the +residuals from the linear portion of the fit. +.le +.ls xxterms = "half", yxterms = "half" +The options are: +.ls none +The individual polynomial terms contain powers of x or powers of y but not +powers of both. +.le +.ls half +The individual polynomial terms contain powers of x and powers of y, whose +maximum combined power is max (xxorder - 1, xyorder - 1) for the x fit and +max (yxorder - 1, yyorder - 1) for the y fit. +.le +.ls full +The individual polynomial terms contain powers of x and powers of y, whose +maximum combined power is max (xxorder - 1, xyorder - 1) for the x fit and +max (yxorder - 1, yyorder - 1) for the y fit. +.le + +The "shift", "xyscale", "rotation", "rscale", and "rxyscale" fitting +geometries, assume that the cross term switches are set to "none" +regardless of the values set by the user. If either of the cross terms +parameters are set to "half" or "full" and \fIfitgeometry\fR is "general" +then a distortion surface is fit to the residuals from the linear +portion of the fit. +.le +.ls maxiter = 0 +The maximum number of rejection iterations. The default is no rejection. +.le +.ls reject = 3.0 +The rejection limit in units of sigma. +.le +.ls calctype = "real" +The precision of the coordinate transformation calculations. The options are +real and double. +.le +.ls verbose = yes +Print messages about actions taken by the task ? +.le +.ls interactive = yes +In interactive mode the user may interact with the fitting process, e.g. +change the order of the fit, reject points, display the data, etc. +.le +.ls graphics = "stdgraph" +The graphics device. +.le +.ls cursor = "" +The graphics cursor. +.le +.ih +DESCRIPTION + +GEOMAP computes the transformation required to map the reference coordinate +system to the input coordinate system. The coordinates of points in common +to the two systems are listed in the input text file(s) \fIinput\fR +one per line in the following format: "xref yref xin yin". + +The computed transforms are stored in the text database file \fIdatabase\fR +in records with names specified by the parameter \fItransforms\fR. If the +transforms parameter is undefined the records are assigned the name of +the input coordinate files. + +The computed transformation has the form shown below, where the reference +coordinates must be defined in the coordinate system of the reference image +system if the user intends to resample an image with gregister or geotran, or +transform coordinates from the reference coordinate system to the input +image coordinate system. + +.nf + xin = f (xref, yref) + yin = g (xref, yref) +.fi + +If on the other hand the user wishes to transform coordinates from the +input image coordinate system to the reference coordinate system then he or she +must reverse the roles of the reference and input coordinates as defined above, +and compute the inverse transformation. + + +The functions f and g are either a power series polynomial or a Legendre or +Chebyshev polynomial surface of order \fIxxorder\fR and \fIxyorder\fR in x +and \fIyxorder\fR and \fIyyorder\fR in y. + +Several polynomial cross terms options are available. Options "none", +"half", and "full" are illustrated below for a quadratic polynomial in +x and y. + +.nf +xxterms = "none", xyterms = "none" +xxorder = 3, xyorder = 3, yxorder = 3, yyorder = 3 + + xin = a11 + a21 * xref + a12 * yref + + a31 * xref ** 2 + a13 * yref ** 2 + yin = a11' + a21' * xref + a12' * yref + + a31' * xref ** 2 + a13' * yref ** 2 + +xxterms = "half", xyterms = "half" +xxorder = 3, xyorder = 3, yxorder = 3, yyorder = 3 + + xin = a11 + a21 * xref + a12 * yref + + a31 * xref ** 2 + a22 * xref * yref + a13 * yref ** 2 + yin = a11' + a21' * xref + a12' * yref + + a31' * xref ** 2 + a22' * xref * yref + a13' * yref ** 2 + +xxterms = "full", xyterms = "full" +xxorder = 3, xyorder = 3, yxorder = 3, yyorder = 3 + + xin = a11 + a21 * xref + a31 * xref ** 2 + + a12 * yref + a22 * xref * yref + a32 * xref ** 2 * yref + + a13 * yref ** 2 + a23 * xref * yref ** 2 + + a33 * xref ** 2 * yref ** 2 + yin = a11' + a21' * xref + a31' * xref ** 2 + + a12' * yref + a22' * xref * yref + a32' * xref ** 2 * yref + + a13' * yref ** 2 + a23' * xref * yref ** 2 + + a33' * xref ** 2 * yref ** 2 +.fi + +If the \fBfitgeometry\fR parameter is anything other than "general", the order +parameters assume the value 2 and the cross terms switches assume the value +"none", regardless of the values set by the user. The computation can be done in +either real or double precision by setting \fIcalctype\fR. Automatic pixel +rejection may be enabled by setting \fmaxiter\fR > 0 and \fIreject\fR to some +number greater than 0. + +\fIXmin\fR, \fIxmax\fR, \fIymin\fR and \fIymax\fR define the region of +validity of the fit in the reference coordinate system and must be set by +the user. These parameters can be used to reject out of range data before the +actual fitting is done. + +GEOMAP may be run interactively by setting \fIinteractive\fR = yes and +inputting commands by the use of simple keystrokes. +In interactive mode the user has the option of changing the +fit parameters and displaying the data graphically until a satisfactory +fit has been achieved. The available keystroke commands are listed +below. + +.nf +? Print options +f Fit the data and graph with the current graph type (g, x, r, y, s) +g Graph the data and the current fit +x,r Graph the x fit residuals versus x and y respectively +y,s Graph the y fit residuals versus x and y respectively +d,u Delete or undelete the data point nearest the cursor +o Overplot the next graph +c Toggle the constant x, y plotting option +t Plot a line of constant x, y through the nearest data point +l Print xshift, yshift, xmag, ymag, xrotate, yrotate +q Exit the interactive curve fitting +.fi + +The parameters listed below can be changed interactively with simple colon +commands. Typing the parameter name alone will list the current value. + +.nf +:show List parameters +:fitgeometry Fitting geometry (shift,xyscale,rotate, + rscale,rxyscale,general) +:function [value] Fitting function (chebyshev,legendre, + polynomial) +:xxorder :xyorder [value] X fitting function xorder, yorder +:yxorder :yyorder [value] Y fitting function xorder, yorder +:xxterms :yxterms [n/h/f] X, Y fit cross terms type +:maxiter [value] Maximum number of rejection iterations +:reject [value] Rejection threshold +.fi + +The final fit is stored in a simple text file in a format suitable for use +by the GREGISTER or GEOTRAN tasks. + +If \fIverbose\fR is "yes", various pieces of useful information are printed +to the terminal as the task proceeds. If \fIresults\fR is set to a file name +then the input coordinates, the fitted coordinates, and the residuals of +the fit are written to that file. + +The transformation computed by the "general" fitting geometry is arbitrary +and does not correspond to a physically meaningful model. However the computed +coefficients for the linear term can be given a simple geometrical geometric +interpretation for all the fitting geometries as shown below. + +.nf + fitting geometry = general (linear term) + xin = a + b * xref + c * yref + yin = d + e * xref + f * yref + + fitting geometry = shift + xin = a + xref + yin = d + yref + + fitting geometry = xyscale + xin = a + b * xref + yin = d + f * yref + + fitting geometry = rotate + xin = a + b * xref + c * yref + yin = d + e * xref + f * yref + b * f - c * e = +/-1 + b = f, c = -e or b = -f, c = e + + fitting geometry = rscale + xin = a + b * xref + c * yref + yin = d + e * xref + f * yref + b * f - c * e = +/- const + b = f, c = -e or b = -f, c = e + + fitting geometry = rxyscale + xin = a + b * xref + c * yref + yin = d + e * xref + f * yref + b * f - c * e = +/- const +.fi + +The coefficients can be interpreted as follows. Xref0, yref0, xin0, yin0 +are the origins in the reference and input frames respectively. Orientation +and skew are the rotation of the x and y axes and their deviation from +perpendicularity respectively. Xmag and ymag are the scaling factors in x and +y and are assumed to be positive. + +.nf + general (linear term) + xrotation = rotation - skew / 2 + yrotation = rotation + skew / 2 + b = xmag * cos (xrotation) + c = ymag * sin (yrotation) + e = -xmag * sin (xrotation) + f = ymag * cos (yrotation) + a = xin0 - b * xref0 - c * yref0 = xshift + d = yin0 - e * xref0 - f * yref0 = yshift + + shift + xrotation = 0.0, yrotation = 0.0 + xmag = ymag = 1.0 + b = 1.0 + c = 0.0 + e = 0.0 + f = 1.0 + a = xin0 - xref0 = xshift + d = yin0 - yref0 = yshift + + xyscale + xrotation 0.0 / 180.0 yrotation = 0.0 + b = + /- xmag + c = 0.0 + e = 0.0 + f = ymag + a = xin0 - b * xref0 = xshift + d = yin0 - f * yref0 = yshift + + rscale + xrotation = rotation + 0 / 180, yrotation = rotation + mag = xmag = ymag + const = mag * mag + b = mag * cos (xrotation) + c = mag * sin (yrotation) + e = -mag * sin (xrotation) + f = mag * cos (yrotation) + a = xin0 - b * xref0 - c * yref0 = xshift + d = yin0 - e * xref0 - f * yref0 = yshift + + rxyscale + xrotation = rotation + 0 / 180, yrotation = rotation + const = xmag * ymag + b = xmag * cos (xrotation) + c = ymag * sin (yrotation) + e = -xmag * sin (xrotation) + f = ymag * cos (yrotation) + a = xin0 - b * xref0 - c * yref0 = xshift + d = yin0 - e * xref0 - f * yref0 = yshift +.fi + + +.ih +EXAMPLES +1. Compute the linear transformation between coordinate systems. + A record called "m51.coo" will be written in the database + file "database". + + +.nf + cl> geomap m51.coo database 1. 512. 1. 512. +.fi + +2. Compute the 3rd order transformation in x and y between two + coordinate systems. A record called "m51.coo" will be written in + the database file "database". This record supersedes the one + of the same name written in example 1. + +.nf + cl> geomap m51.coo database 1. 512. 1. 512. xxo=4 xyo=4 \ + >>> yxo=4 yyo=4 xxt=full yxt=full inter- +.fi + +3. Register a 500 by 500 image of m51 to an 800 by 800 image of the same +field taken with a different instrument, and display the original +800 by 800 image and the transformed image. Use the default fitting parameters. + +.nf + cl> geomap m51.coo database 1.0 800.0 1.0 800.0 + cl> gregister m51.500 m51.500.out database m51.coo + cl> display m51.800 1 fi+ + cl> display m51.500.out 2 fi+ +.fi + +4. Use the above transform to transform a list of object pixel coordinates +in the m51.800 image to their pixel coordinates in the m51.500 system. + +.nf + cl> geoxytran m51.800.xy m51.500.xy database m51.coo +.fi + +5. Transform object pixel coordinates in the m51.500 image to their +pixel coordinates in the m51.800 image. Note that to do this the roles +of the reference and input coordinates defined in example 3 must be +reversed and the inverse transform must be computed. + +.nf + cl> fields m51.coo 3,4,1,2 > m51.coo.inv + cl> geomap m51.coo.inv database 1.0 512.0 1.0 512.0 + cl> geoxytran m51.512.xy m51.800.xy database m51.coo.inv +.fi + +6. Compute 3 different transforms, store them in the same database file, +and use them to transform 3 different images. Use the original image names as +the database record names. + +.nf + cl> geomap coo1,coo2,coo3 database 1. 512. 1. 512. \ + >>> transforms=im1,im2,im3 + cl> gregister im1,im2,im3 im1.out,im2.out,im3.out database \ + >>> im1,im2,im3 +.fi + +.ih +BUGS + +The user should be aware that for high order fits the "polynomial" basis +functions become very unstable. Switching to the "legendre" or "chebyshev" +polynomials and/or going to double precision will usually cure the problem. + +.ih +SEE ALSO +imshift, magnify, rotate, imlintran, gregister, geotran, geoxytran +.endhelp diff --git a/pkg/images/immatch/doc/geotran.hlp b/pkg/images/immatch/doc/geotran.hlp new file mode 100644 index 00000000..e3ad15f7 --- /dev/null +++ b/pkg/images/immatch/doc/geotran.hlp @@ -0,0 +1,320 @@ +.help geotran Dec98 images.immatch +.ih +NAME +geotran -- geometrically transform a list of images +.ih +USAGE +geotran input output database transforms +.ih +PARAMETERS +.ls input +List of images to be transformed. +.le +.ls output +List of output images. If the output image name is the same as the input +image name the input image is overwritten. The output image may be a section +of an existing image. The number of output images must equal the number +of input images. +.le +.ls database +The name of the text file containing the coordinate transformation (generally +the database file produced by GEOMAP). +If database is the null string then GEOTRAN will perform a linear +transformation based the values of xin, yin, xout, yout, xshift, yshift, +xmag, ymag, xrotation and yrotation. If all these parameters have their +defaults values the transformation is a null transformation. If the geometric +transformation is linear xin, yin, xout, yout, xshift, yshift, xmag, ymag, +xrotation and yrotation can be used to override the values in the database +file. +.le +.ls transforms +The list of record name(s) in the file \fIdatabase\fR containing the +desired transformations. +This record name is usually the name of the text file input to geomap +listing the reference and input coordinates of the control points. +The number of records must be 1 or equal to the number of input images. +The record names may be listed in a text file 1 record per line. +The transforms parameter is only +requested if database is not equal to the null string. +.le +.ls geometry = "geometric" +The type of geometric transformation. The geometry parameter is +only requested if database is not equal to the null string. The options are: +.ls linear +Perform only the linear part of the geometric transformation. +.le +.ls geometric +Compute both the linear and distortion portions of the geometric correction. +.le +.le +.ls xmin = INDEF, xmax = INDEF, ymin = INDEF, ymax = INDEF +The minimum and maximum x and y reference values of the output image. +If a database file has been defined xmin, xmax, ymin and ymax +efault to the minimum and maximum values set by +GEOMAP and may be less than but may not exceed those values. +.le +.ls xscale = 1.0, yscale = 1.0 +The output picture x and y scales in units of +x and y reference units per output pixel, +e.g arcsec / pixel or Angstroms / pixel if the reference coordinates +are arcsec or Angstroms. If the reference coordinates are in pixels +then xscale and yscale should be 1.0 to preserve the scale of the reference +image. +If xscale and yscale are undefined (INDEF), xscale and yscale default to the +range of the reference coordinates over the range in pixels. +Xscale and yscale override the values of ncols and nlines. +.le +.ls ncols = INDEF, nlines = INDEF +The number of columns and lines in the output image. Ncols and nlines default +to the size of the input image. If xscale or yscale are defined ncols or nlines +are overridden. +.le +.ls xsample = 1.0, ysample = 1.0 +The coordinate surface subsampling factor. The coordinate surfaces are +evaluated at every xsample-th pixel in x and every ysample-th pixel in y. +Transformed coordinates at intermediate pixel values are determined by +bilinear interpolation in the coordinate surfaces. If the coordinate +surface is of high order setting these numbers to some reasonably high +value is strongly recommended. +.le +.ls interpolant = "linear" +The interpolant used for rebinning the image. +The choices are the following. +.ls nearest +Nearest neighbor. +.le +.ls linear +Bilinear interpolation in x and y. +.le +.ls poly3 +Third order polynomial in x and y. +.le +.ls poly5 +Fifth order polynomial in x and y. +.le +.ls spline3 +Bicubic spline. +.le +.ls sinc +2D sinc interpolation. Users can specify the sinc interpolant width by +appending a width value to the interpolant string, e.g. sinc51 specifies +a 51 by 51 pixel wide sinc interpolant. The sinc width will be rounded up to +the nearest odd number. The default sinc width is 31 by 31. +.le +.ls lsinc +Look-up table sinc interpolation. Users can specify the look-up table sinc +interpolant width by appending a width value to the interpolant string, e.g. +lsinc51 specifies a 51 by 51 pixel wide look-up table sinc interpolant. The user +supplied sinc width will be rounded up to the nearest odd number. The default +sinc width is 31 by 31 pixels. Users can specify the resolution of the lookup +table sinc by appending the look-up table size in square brackets to the +interpolant string, e.g. lsinc51[20] specifies a 20 by 20 element sinc +look-up table interpolant with a pixel resolution of 0.05 pixels in x and y. +The default look-up table size and resolution are 20 by 20 and 0.05 pixels +in x and y respectively. +.le +.ls drizzle +2D drizzle resampling. Users can specify the drizzle pixel fraction in x and y +by appending a value between 0.0 and 1.0 in square brackets to the +interpolant string, e.g. drizzle[0.5]. The default value is 1.0. +The value 0.0 is increased internally to 0.001. Drizzle resampling +with a pixel fraction of 1.0 in x and y is equivalent to fractional pixel +rotated block summing (fluxconserve = yes) or averaging (flux_conserve = no) if +xmag and ymag are > 1.0. +.le +.le +.ls boundary = "nearest" +The choices are: +.ls nearest +Use the value of the nearest boundary pixel. +.le +.ls constant +Use a user supplied constant value. +.le +.ls reflect +Generate a value by reflecting about the boundary of the image. +.le +.ls wrap +Generate a value by wrapping around to the opposite side of the image. +.le +.le +.ls constant = 0.0 +The value of the constant for boundary extension. +.le +.ls fluxconserve = yes +Preserve the total image flux. The output pixel values are multiplied by +the Jacobian of the coordinate transformation. +.le +.ls xin = INDEF, yin = INDEF +The x and y coordinates in pixel units in the input image which will map to +xout, yout in the output image. If the database file is undefined these +numbers default to the center of the input image. +.le +.ls xout = INDEF, yout = INDEF +The x and y reference coordinates in the output image which correspond +to xin, yin in the input image. If the database file is undefined, xout and +yout default to the center of the output image reference coordinates. +.le +.ls xshift = INDEF, yshift = INDEF +The shift of the input origin in pixels. If the database file is undefined +then xshift and yshift determine the shift of xin, yin. +.le +.ls xmag = INDEF, ymag = INDEF +The scale factors of the coordinate transformation in units of input pixels +per reference coordinate unit. If database is undefined xmag and ymag +default to 1.0; otherwise xmag and ymag default to the values found +by GEOMAP. If the database file is not null then xmag and ymag override +the values found by GEOMAP. +.le +.ls xrotation = INDEF, yrotation = INDEF +The rotation angles in degrees of the coordinate transformation. +Positive angles are measured counter-clockwise with respect to the x axis. +If database +is undefined then xrotation and yrotation default to 0.0; otherwise +xrotation and yrotation default to the values found by GEOMAP. +If database is not NULL then xrotation and yrotation override the values +found by GEOMAP. +.le +.ls nxblock = 512, nyblock = 512 +If the size of the output image is less than nxblock by nyblock then +the entire image is transformed at once. Otherwise the output image +is computed in blocks of nxblock by nxblock pixels. +.le +.ls verbose = yes +Print messages about the progress of the task ? +.le +.ih +DESCRIPTION + +GEOTRAN corrects an image for geometric distortion using the coordinate +transformation determined by GEOMAP. The transformation is stored as the +coefficients of a polynomial surface in record \fItransforms\fR, +in the text file \fIdatabase\fR. +The coordinate surface is sampled at every \fIxsample\fR and \fIysample\fR +pixel in x and y. +The transformed coordinates at intermediate pixel values are +determined by bilinear interpolation in the coordinate surface. If +\fIxsample\fR and \fIysample\fR = 1, the coordinate +surface is evaluated at every pixel. Use of \fIxsample\fR and \fIysample\fR +are strongly recommended for large images and high order coordinate +surfaces in order to reduce the execution time. + +\fIXmin\fR, \fIxmax\fR, \fIymin\fR and \fIymax\fR define the range of +reference coordinates represented in the output picture. These numbers +default to the minimum and maximum x and y reference values used by GEOMAP, +and may not exceed those values. +The scale and size of the output picture is determined as follows. + +.nf + ncols = ncols (inimage) + if (xscale == INDEF) + xscale = (xmax - xmin ) / (ncols - 1) + else + ncols = (xmax - xmin) / xscale + 1 + + nlines = nlines (inimage) + if (yscale == INDEF) + yscale = (ymax - ymin ) / (nlines - 1) + else + nlines = (ymax - ymin) / yscale + 1 +.fi + +The output image gray levels are determined by interpolating in the input +image at the positions of the transformed output pixels. If the +\fIfluxconserve\fR switch is set the output pixel values are multiplied by +the Jacobian of the transformation. +GEOTRAN uses the routines in the 2-D interpolation package. + +The linear portion of the transformation may be altered after the fact +by setting some or all of the parameters \fIxin\fR, \fIyin\fR, \fIxout\fR, +\fIyout\fR, \fIxshift\fR, \fIyshift\fR, \fIxmag\fR, \fIymag\fR, \fIxrotation\fR, +\fIyrotation\fR. +Xin, yin, xshift, yshift, xout and yout can be used to redefine the shift. +Xmag, and ymag can be used to reset the x and y scale of the transformation. +Xrotation and yrotation can be used to reset the orientation of the +transformation. + +The output image is computed in \fInxblock\fR by \fInyblock\fR pixel sections. +If possible users should set these numbers to values larger than the dimensions +of the output image to minimize the number of disk reads and writes required +to compute the output image. If this is not feasible and the image rotation is +small, users should set nxblock to be greater than the number of columns in +the output image, and nyblock to be as large as machine memory will permit. + +If the CL environment variable \fInomwcs\fR is "no" then the world +coordinate system of the input image will be modified in the output image +to reflect the effects of the \fIlinear\fR portion of the geometric +transformation operation. +Support does not yet exist in the IRAF world coordinate system interface +for the higher order distortion corrections that GEOTRAN is capable of +performing. + +.ih +TIMINGS +It requires approximately 70 and 290 cpu seconds to correct a 512 by 512 +square image for geometric distortion using a low order coordinate surface +and bilinear and biquintic interpolation respectively (Vax 11/750 fpa). + +.ih +EXAMPLES + +1. Register two images by transforming the coordinate system of the input +image to the coordinate system of the reference image. The size of the +reference image is 512 by 512. The output image scale will be 1.0 and +its size will be determined by the xmin, xmax, ymin, ymax parameters set +in the task GEOMAP. The file "database" containing the record "m51.coo" +was produced by GEOMAP. + +.nf + cl> geomap m51.coo database 1.0 512.0 1.0 512.0 + cl> geotran m51 m51.tran database m51.coo +.fi + +2. Repeat the above command but set the output image scale to 2.0 reference +images pixels per output image pixel. + +.nf + cl> geomap m51.coo database 1.0 512.0 1.0 512.0 + cl> geotran m51 m51.tran database m51.coo xscale=2.0 yscale=2.0 +.fi + +3. Repeat the previous command using an output scale of +2 reference units per pixel and bicubic spline interpolation with no +flux correction. + +.nf + cl> geomap m51.coo database 1.0 512.0 1.0 512.0 + cl> geotran m51 m51.tran database m51.coo xscale=2. yscale=2. \ + >>> inter=spline3 flux- +.fi + +4. Register a list of 512 by 512 pixel square images using the set of +transforms computed by GEOMAP. The input images, output images, and coordinate +lists / transforms are listed in the files inlist, outlist and reclist +respectively. + +.nf + cl> geomap @reclist database 1. 512. 1. 512. + cl> geotran @inlist @outlist database @reclist +.fi + +5. Mosaic 3 512 square images into a larger 512 by 1536 square images after +applying a shift to each input image. + +.nf + cl> geotran image1 outimage[1:512,1:512] "" ncols=512 nlines=1536 \ + xshift=5.0 yshift=5.0 + cl> geotran image2 outimage[1:512,513:1024] "" xshift=10.0 yshift=10.0 + cl> geotran image3 outimage[1:512,1025:1536] "" xshift=15.0 yshift=15.0 +.fi + +.ih +BUGS +Support does not yet exist in the IRAF world coordinate system interface +for the higher order distortion corrections that GEOTRAN is capable of +performing. + +.ih +SEE ALSO +imshift, magnify, rotate, imlintran, geomap, geoxytran, gregister +.endhelp diff --git a/pkg/images/immatch/doc/geoxytran.hlp b/pkg/images/immatch/doc/geoxytran.hlp new file mode 100644 index 00000000..69e8565c --- /dev/null +++ b/pkg/images/immatch/doc/geoxytran.hlp @@ -0,0 +1,408 @@ +.help geoxytran Apr95 images.immatch +.ih +NAME +geoxytran -- geometrically transform a list of coordinates +.ih +USAGE +geoxytran input output database transforms +.ih +PARAMETERS +.ls input +The list of input coordinate files to be transformed. +.le +.ls output +The list of output transformed coordinate files. The number of output files must +be one or equal to the number of input files. +.le +.ls database +The name of the text database file written by the geomap task which +contains the desired spatial transformation. +If database is undefined geoxytran computes +a linear transformation using the current +values of the xref, yref, xout, yout, xshift, yshift, xmag, ymag, xrotation, +and yrotation parameters. +.le +.ls transforms +The database record containing the desired spatial transformation. +The number of records must be one or equal to the number of input coordinate +files. Transforms is usually the name of the coordinate file that the +geomap task used to compute the spatial transformation. +If defined the values of xref, yref, xout, yout, xshift, yshift, xmag, ymag, +xrotation, and yrotation will supersede the computed values in the +database file. +.le +.ls geometry = "geometric" (linear|geometric) +The type of geometric transformation. The geometry parameter is +only requested if database is defined. The options are: +.ls linear +Perform only the linear part of the spatial transformation. +.le +.ls geometric +Compute both the linear and distortion portions of the spatial transformation. +.le +.le +.ls direction = "forward" (forward|backward) +The transformation direction may be "forward" or "backward". The forward +direction directly evaluates the database solution. The backward +direction iteratively determines the coordinate which evaluates to the +specified coordinate. +.le +.ls xref = INDEF, yref = INDEF +The x and y coordinates of the reference origin. +If the database file is undefined xref and +yref default to [0.0,0.0]. Otherwise xref and yref +default to the mean of minimum and maximum x and y values +[(xmin + xmax) / 2.0, (ymin + ymax) / 2.0] computed by geomap. +.le +.ls xmag = INDEF, ymag = INDEF +The x and y scale factors in input units +per reference unit. If database is undefined xmag and ymag +default to [1.0, 1.0]. Otherwise xmag and ymag default to the values computed +by geomap. +.le +.ls xrotation = INDEF, yrotation = INDEF +The x and y rotation angles in degrees measured counter-clockwise with +respect to the x and y axes. If database +is undefined then xrotation and yrotation are interpreted as the +rotation of the coordinates with respect to the x and y axes and +default to [0.0, 0.0]. For example xrotation and yrotation values of +[30.0, 30.0] will rotate a point 30 counter-clockwise with respect +to the x and y axes. Otherwise xrotation and yrotation default to the +values computed by geomap. Geomap computes the x and y rotation angles +of the x and y axes, not the rotation angle of the coordinates. An output +coordinate system rotated 30 degrees counter-clockwise with respect +to the reference coordinate system will produce xrotation and yrotation +values of [330.0,330.0] or equivalently [-30.0,-30.0] in the database file +not [30.0,30.0]. +.le +.ls xout = INDEF, yout = INDEF +The x and y coordinates of the output origin. +If the database file is undefined xout and +yout default to [0.0,0.0]. +If database is defined xout and yout +default to the position that the reference origin [xref,yref] +occupies in the transformed system. +.le +.ls xshift = INDEF, yshift = INDEF +The x and y shift of the reference origin in output units. +If the database file is undefined xshift and yshift default to [0.0,0.0]. +If the database file is defined xshift and yshift default to the +values computed by geomap. If defined xshift and yshift take precedence over +the x and y shifts determined from xref, yref, xout and yout. +.le +.ls xcolumn = 1, ycolumn = 2 +The columns in the input coordinate file containing the x and y coordinates. +.le +.ls calctype = "real" +The precision of the coordinate transformation calculations. The options +are "real" and "double". Note that this only applies to a "forward" +transformation. The "backward" transformation is done iteratively and +is always calculated in double precision to get the best convergence. +.le +.ls xformat = "", yformat = "" +The default output format for the computed x and y coordinates. If +xformat and yformat are undefined geoxytran outputs the coordinates +using the maximum of the precision of the input coordinates +and the value of the \fImin_sigdigits\fR parameter. +.le +.ls min_sigdigits = 7 +The minimum precision of the output x and y coordinates. +.le + +.ih +DESCRIPTION + +GEOXYTRAN applies a coordinate transformation to a list of reference +coordinates in the text file \fIinput\fR and writes the transformed +coordinates to the text file \fIoutput\fR. The input coordinates +are read from, and the output coordinates written to, columns +\fIxcolumn\fR and \fIycolumn\fR in the input and output +files. The format of the output coordinates can be specified using the +\fIxformat\fR and \fIyformat\fR parameters. If the output formats +are unspecified the coordinates are written out with a precision +which is the maximum of the precision of the input coordinates +and the value of the \fImin_sigdigits\fR parameter. All remaining fields in +the input file are copied to the output file without modification. +Blank lines and comment lines are also passed to the output file +unaltered. + +The coordinate transformation either be read from record \fItransforms\fR +in the database file \fIdatabase\fR computed by GEOMAP, or specified +by the user via the \fIxref\fR, \fIyref\fR, \fIxmag\fR, \fIymag\fR, +\fIxrotation\fR, \fIyrotation\fR, \fIxout\fR, \fIyout\fR, \fIxshift\fR, +and \fIyshift\fR parameters. + +The transformation computed by GEOMAP has the following form. + +.nf + xout = f (xref, yref) + yout = g (xref, yref) +.fi + +The functions f and g are either a power series polynomial or a Legendre +or Chebyshev polynomial surface whose order and region of validity were +set by the user when GEOMAP was run. The computed transformation is +arbitrary and does not correspond to any physically meaningful model. +However the first order terms can be given the simple geometrical +interpretation shown below. + +.nf + xout = a + b * xref + c * yref + yout = d + e * xref + f * yref + b = xmag * cos (xrotation) + c = ymag * sin (yrotation) + e = -xmag * sin (xrotation) + f = ymag * cos (yrotation) + a = x0 - b * xref0 - c * yref0 = xshift + d = y0 - e * xref0 - f * yref0 = xshift +.fi + +Xref0, yref0, x0, and +y0 are the origins of the reference and output coordinate systems +respectively. xmag and ymag are the x and y scale factors in output units +per reference unit and xrotation and yrotation are the rotation angles measured +counter-clockwise of the x and y axes. + +The linear portion of the GEOMAP transformation may be altered after the fact +by setting some or all of the parameters \fIxref\fR, \fIyref\fR, \fIxout\fR, +\fIyout\fR, \fIxshift\fR, \fIyshift\fR, \fIxmag\fR, \fIymag\fR, \fIxrotation\fR, +and \fIyrotation\fR. If defined these parameters will replace the corresponding +values in the GEOMAP database file. +Xref, yref, xshift, yshift, xout and yout can be used to redefine the shift +where xshift and yshift take precedence over xref, yref, xout and yout. +Xmag, and ymag can be used to reset the scale of the transformation. +Xrotation and yrotation can be used to redefine the orientation of the +transformation. Note that xrotation and yrotation are interpreted as +the rotation of the coordinate axes not the coordinates. +The default values of these parameters are. + +.nf + xref = (xmin + xmax) / 2.0 + yref = (ymin + ymax) / 2.0 + xout = f (xref,yref) + yout = g (xref,yref) + xshift = xshift (database) = xout - f(xref,yref) + yshift = yshift (database) = yout - g(xref,yref) + xmag = xmag (database) + ymag = ymag (database) + xrotation = xrotation (database) + yrotation = yrotation (database) +.fi + +If the GEOMAP database is undefined then GEOXYTRAN performs a linear +transformation on the input coordinates using the parameters +\fIxref\fR, \fIyref\fR, \fIxmag\fR, \fIymag\fR, \fIxrotation\fR, +\fIyrotation\fR, \fIxout\fR, \fIyout\fR, \fIxshift\fR, and +\fIyshift\fR as shown below. Note that in this case xrotation and +yrotation are interpreted as the rotation of the coordinates +themselves not the coordinate axes. + +.nf + xout = a + b * xref + c * yref + yout = d + e * xref + f * yref + b = xmag * cos (xrotation) + c = -ymag * sin (yrotation) + e = xmag * sin (xrotation) + f = ymag * cos (yrotation) + a = xo - b * xref0 - c * yref0 = xshift + d = yo - e * xref0 - f * yref0 = xshift +.fi + + +.ih +Forward vs. Backward Transformations + +The transformation direction is specified by the \fIdirection\fR parameter +which may take the values "forward" or "backward". The forward transformation +is a direct evaluation of the database solution. The backward +transformation is an iterative evaluation to obtain the coordinate which +evaluates to the desired coordinate. + +When the same solution is used with \fBgeotran\fR to transform an image +to another image matching the "reference" image is needed to obtain +coordinates in the transformed image. This is because the transformation +is produced with \fBgeomap\fR to map "reference" coordinates to the +image which is subsequently transformed. Therefore, if you have coordinates +in the image which has been transformed then you should use the "backward" +transformation to get coordinates for the transformed image. But if you +have standard coordinates from the reference image being matched then you +would use the "forward" transformation. If you are not sure then you can +use \fBtvmark\fR to overlay the results to find which direction produces +the desired coordinates. + +Because the backward transformation is performed iteratively it can be +slow. If higher speeds are desired, such as when evaluating a very +large number of coordinates, one might create a transformation solution +that can be evaluated in the forward direction. This is done by +using \fBgeomap\fR with the reference and target coordinates reversed. + +.ih +FORMATS + +A format specification has the form "%w.dCn", where w is the field +width, d is the number of decimal places or the number of digits of +precision, C is the format code, and n is radix character for +format code "r" only. The w and d fields are optional. The format +codes C are as follows: + +.nf +b boolean (YES or NO) +c single character (c or '\c' or '\0nnn') +d decimal integer +e exponential format (D specifies the precision) +f fixed format (D specifies the number of decimal places) +g general format (D specifies the precision) +h hms format (hh:mm:ss.ss, D = no. decimal places) +m minutes, seconds (or hours, minutes) (mm:ss.ss) +o octal integer +rN convert integer in any radix N +s string (D field specifies max chars to print) +t advance To column given as field W +u unsigned decimal integer +w output the number of spaces given by field W +x hexadecimal integer +z complex format (r,r) (D = precision) + + +Conventions for w (field width) specification: + + W = n right justify in field of N characters, blank fill + -n left justify in field of N characters, blank fill + 0n zero fill at left (only if right justified) +absent, 0 use as much space as needed (D field sets precision) + +Escape sequences (e.g. "\n" for newline): + +\b backspace (not implemented) +\f formfeed +\n newline (crlf) +\r carriage return +\t tab +\" string delimiter character +\' character constant delimiter character +\\ backslash character +\nnn octal value of character + +Examples + +%s format a string using as much space as required +%-10s left justify a string in a field of 10 characters +%-10.10s left justify and truncate a string in a field of 10 characters +%10s right justify a string in a field of 10 characters +%10.10s right justify and truncate a string in a field of 10 characters + +%7.3f print a real number right justified in floating point format +%-7.3f same as above but left justified +%15.7e print a real number right justified in exponential format +%-15.7e same as above but left justified +%12.5g print a real number right justified in general format +%-12.5g same as above but left justified + +%h format as nn:nn:nn.n +%15h right justify nn:nn:nn.n in field of 15 characters +%-15h left justify nn:nn:nn.n in a field of 15 characters +%12.2h right justify nn:nn:nn.nn +%-12.2h left justify nn:nn:nn.nn + +%H / by 15 and format as nn:nn:nn.n +%15H / by 15 and right justify nn:nn:nn.n in field of 15 characters +%-15H / by 15 and left justify nn:nn:nn.n in field of 15 characters +%12.2H / by 15 and right justify nn:nn:nn.nn +%-12.2H / by 15 and left justify nn:nn:nn.nn + +\n insert a newline +.fi + +.ih +EXAMPLES + +.nf +1. Compute the transformation from the reference system to the output +system and then evaluate the transformation for both the input list and +the list of unknowns. + + cl> type rtran + + 1.0000 1.0000 184.1445 -153.0376 + 512.0000 1.0000 684.0376 184.1445 + 512.0000 512.0000 346.8555 684.0376 + 1.0000 512.0000 -153.0380 346.8555 + + cl> geomap rtran rtran.db 1.0 512.0 1.0 512.0 intera- + + cl> type rtran.db + + # Tue 14:53:36 18-Apr-95 + begin rtran + output rtran.db + xrefmean 256.5 + yrefmean 256.5 + xmean 265.4999 + ymean 265.5 + xshift 183.826 + yshift -154.6757 + xmag 1.180001 + ymag 1.179999 + xrotation 326. + yrotation 326. + surface1 11 + 3. 3. + 2. 2. + 2. 2. + 0. 0. + 1. 1. + 512. 512. + 1. 1. + 512. 512. + 183.826 -154.6757 + 0.9782647 0.6598474 + -0.6598479 0.9782643 + surface2 0 + + cl> geoxytran rtran STDOUT rtran.db rtran + + 184.1444 -153.038 184.1445 -153.0376 + 684.0377 184.1444 684.0376 184.1445 + 346.8554 684.0375 346.8555 684.0376 + -153.038 346.8555 -153.038 346.8555 + + cl> geoxytran unknowns unknowns.tran rtran.db rtran + + +2. Evaluate the backward transformation to take coordinates from the +output system to the reference system. In this example we use the +output of the first example to illustrate getting back the coordinates +used in the original geomap input. + + cl> geoxytran rtran STDOUT rtran.db rtran dir=forward |\ + >>> geoxytran STDIN STDOUT rtran.db rtran dir=backward + 0.999798 0.9997257 184.1445 -153.0376 + 512. 0.9999674 684.0376 184.1445 + 512. 512. 346.8555 684.0376 + 0.999918 512.0001 -153.0380 346.8555 + + +3. Evaluate the transform computed in example 1 for the same list of +unknowns but modify the transformation slightly by setting xmag +and ymag to 1.18 and 1.18 exactly. + + cl> geoxytran unknowns unknowns.tran rtran.db rtran xmag=1.18 \ + ymag=1.18 + + +4. Evaluate the same transformation for the same unknowns as before +using the linear transformation parameters not the transform computed +by geomap. Note that the angle is the negative of the one defined +in the database file. + + cl> geoxytran unknowns unknowns.tran "" xmag=1.18 ymag=1.18 \ + xrot=34 yrot=34 xshift=183.826 yshift=-154.6757 +.fi + +.ih +BUGS + +.ih +SEE ALSO +geomap, lists.lintran, geotran, gregister +.endhelp diff --git a/pkg/images/immatch/doc/gregister.hlp b/pkg/images/immatch/doc/gregister.hlp new file mode 100644 index 00000000..73dff3d4 --- /dev/null +++ b/pkg/images/immatch/doc/gregister.hlp @@ -0,0 +1,265 @@ +.help gregister Dec98 images.immatch +.ih +NAME +gregister -- transform a list of images from one coordinate system to another +.ih +USAGE +gregister input output database transforms +.ih +PARAMETERS +.ls input +List of images to be transformed. +.le +.ls output +List of output images. +.le +.ls database +The name of the text file database produced by GEOMAP containing the coordinate +transformation(s). +.le +.ls transforms +The list of the database record(s) containing the transformations. +The number of transforms must be 1 or the same as the number of input +images. Transforms is usually the name of the +text file input to GEOMAP which lists the reference and input +coordinates of the control points. +.le +.ls geometry = "geometric" +The type of geometry to be applied: The choices are: +.ls linear +The linear part, shifts, scales and rotations are computed. +.le +.ls geometric +The full transformation is computed. +.le +.le +.ls xmin = INDEF, xmax = INDEF, ymin = INDEF, ymax = INDEF +The minimum and maximum x and y reference values of the output image. +Xmin, xmax, ymin and ymax default to minimum and maximum values set in GEOMAP, +and may not extend beyond the bounds of those parameters. +.le +.ls xscale = 1.0, yscale = 1.0 +The output x and y scales in units of reference x and y +units per pixel, e.g "/ pixel or Angstroms / pixel if the reference +coordinates +are arc-seconds or Angstroms. If the reference coordinates are in pixels +then xscale and yscale should be 1.0 to preserve the scale of the reference +image. The default is set for pixel coordinates. +If xscale and yscale are undefined (INDEF), xscale and yscale default to the +range of the reference coordinates over the range in pixels. +Xscale and yscale override the values of ncols and nlines. +.le +.ls ncols = INDEF, nlines = INDEF +The number of columns and lines in the output image. Ncols and nlines default +to the size of the input image. If xscale or yscale are defined ncols or nlines +are overridden. +.le +.ls xsample = 1.0, ysample = 1.0 +The coordinate surface subsampling factor. The coordinate surfaces are +evaluated at every xsample-th pixel in x and every ysample-th pixel in y. +Transformed coordinates at intermediate pixel values are determined by +bilinear interpolation in the coordinate surfaces. +.le +.ls interpolant = "linear" +The choices are the following. +.ls nearest +Nearest neighbor. +.le +.ls linear +Bilinear interpolation in x and y. +.le +.ls poly3 +Third order polynomial in x and y. +.le +.ls poly5 +Fifth order polynomial in x and y. +.le +.ls spline3 +Bicubic spline. +.le +.ls sinc +2D sinc interpolation. Users can specify the sinc interpolant width by +appending a width value to the interpolant string, e.g. sinc51 specifies +a 51 by 51 pixel wide sinc interpolant. The sinc width will be rounded up to +the nearest odd number. The default sinc width is 31 by 31. +.le +.ls lsinc +Look-up table sinc interpolation. Users can specify the look-up table sinc +interpolant width by appending a width value to the interpolant string, e.g. +lsinc51 specifies a 51 by 51 pixel wide look-up table sinc interpolant. The user +supplied sinc width will be rounded up to the nearest odd number. The default +sinc width is 31 by 31 pixels. Users can specify the resolution of the lookup +table sinc by appending the look-up table size in square brackets to the +interpolant string, e.g. lsinc51[20] specifies a 20 by 20 element sinc +look-up table interpolant with a pixel resolution of 0.05 pixels in x and y. +The default look-up table size and resolution are 20 by 20 and 0.05 pixels +in x and y respectively. +.le +.ls drizzle +2D drizzle resampling. Users can specify the drizzle pixel fraction in x and y +by appending a value between 0.0 and 1.0 in square brackets to the +interpolant string, e.g. drizzle[0.5]. The default value is 1.0. +The value 0.0 is increased internally to 0.001. Drizzle resampling +with a pixel fraction of 1.0 in x and y is equivalent to fractional pixel +rotated block summing (fluxconserve = yes) or averaging (flux_conserve = no) if +xmag and ymag are > 1.0. +.le +.le +.ls boundary = "nearest" +The boundary extension choices are: +.ls nearest +Use the value of the nearest boundary pixel. +.le +.ls constant +Use a constant value. +.le +.ls reflect +Generate value by reflecting about the boundary. +.le +.ls wrap +Generate a value by wrapping around to the opposite side of the image. +.le +.le +.ls constant = 0. +The value of the constant for boundary extension. +.le +.ls fluxconserve = yes +Preserve the total image flux. The output pixel values are multiplied by +the Jacobian of the coordinate transformation. +.le +.ls nxblock = 512, nyblock = 512 +If the dimensions of the output image are less than nxblock and nyblock +then the entire image is transformed at once. Otherwise blocks of size +nxblock by nyblock are transformed one at a time. +.le +.ls verbose = yes +Print messages about the progress of the task ? +.le +.ih +DESCRIPTION + +GREGISTER corrects an image for geometric distortion using the coordinate +transformation computed by GEOMAP. The transformation is stored as the +coefficients of a polynomial surface in record \fItransforms\fR, +in the text file \fIdatabase\fR. +The coordinate surface is sampled at every \fIxsample\fR and \fIysample\fR +pixel in x and y. +The transformed coordinates at intermediate pixel values are +determined by bilinear interpolation in the coordinate surface. If +\fIxsample\fR and \fIysample\fR = 1, the coordinate +surface is evaluated at every pixel. Use of \fIxsample\fR and \fIysample\fR +are strongly recommended for large images and high order coordinate +surfaces in order to reduce the execution time. + +\fIXmin\fR, \fIxmax\fR, \fIymin\fR and \fIymax\fR define the range of +reference coordinates represented in the output picture. These numbers +default to the minimum and maximum x and y reference values used by GEOMAP, +and may not exceed these values. +The scale and size of the output picture is determined as follows. + +.nf + ncols = ncols(input) + if (xscale == INDEF) + xscale = (xmax - xmin ) / (ncols - 1) + else + ncols = (xmax - xmin) / xscale + 1 + + nlines = nlines(input) + if (yscale == INDEF) + yscale = (ymax - ymin ) / (nlines - 1) + else + nlines = (ymax - ymin) / yscale + 1 +.fi + +The output image gray levels are determined by interpolating in the input +image at the positions of the transformed output pixels. If the +\fIfluxconserve\fR switch is set the output pixel values are multiplied by +the Jacobian of the transformation. GREGISTER uses the routines in the +2-D interpolation package. + +The output image is computed in \fInxblock\fR by \fInyblock\fR pixel sections. +If possible users should set these numbers to values larger than the dimensions +of the output image, in order to minimize the number of disk reads and writes +required to compute the output image. If this is not feasible and the image +rotation is small users should set nxblock to be greater than the number of +columns in the output image, and nyblock to be as large as machine memory +will permit. + +If the environment variable \fInomwcs\fR is "no" then the world coordinate +system of the input image is modified in the output image to reflect the +effects of the \fIlinear\fR portion of the registration operation. +Support does not yet exist in the IRAF world coordinate system interface +for the higher order distortion corrections that GREGISTER is capable +of performing. + +.ih +TIMINGS +It requires approximately 70 and 290 cpu seconds to correct a 512 by 512 +square image for geometric distortion using a low order coordinate surface +and bilinear and biquintic interpolation respectively (Vax 11/750 far). + +.ih +EXAMPLES +.ls 4 1. +Transform an image to the reference coordinate system of a 512 by 512 pixel +square image. The output image will have the same scale and size as the +reference image if the reference coordinates are in pixels. + +.nf +cl> geomap coords database 1.0 512.0 1.0 512.0 +cl> gregister input output database coords +.fi +.le +.ls 4 2. +Repeat the previous example but rescale the output image. The scale of the +output image will be 2.5 reference units per pixel and its size will be +determined by the xmin, xmax, ymin, ymax parameters (1.0, 512.0, 1.0, 512.0). + +.nf +cl> geomap coords database 1.0 512.0 1.0 512.0 +cl> gregister input output database coords xscale=2.5 yscale=2.5 +.fi +.le +.ls 4 3. +Correct an image for 3rd order geometric distortion using an output scale of 2 +reference units per pixel unit and bicubic spline interpolation with no flux +correction. + +.nf +cl> geomap coords database 1.0 512.0 1.0 512.0 xxorder=4 xyorder=4 \ +xxterms=yes yxorder=4 yyorder=4 yxterms=yes +cl> gregister input output database coords xscale=2. yscale=2. \ +>>> inter=spline3 flux- +.fi +.le +.ls 4 4. +Transform three images using 3 different transformation records stored +in the database file. + +.nf +cl> geomap coord1,coord2,coord3 database 1. 512. 1. 512. +cl> gregister im1,im2,im3 imout1,imout2,imout3 database \ +>>> coord1,coord2,coords3 +.fi +.le +.ls 4 5. +Repeat the above example using the textfiles inlist, outlist, reclist which +contain the list of input images, list of output images and list of coordinate +files respectively. + +.nf +cl> geomap @reclist database 1. 512. 1. 512. +cl> gregister @inlist @outlist database @reclist +.fi +.le + +.ih +BUGS +Support does yet exist in the IRAF world coordinate system interface +for the higher order distortion corrections that GREGISTER is capable +of performing. + +.ih +SEE ALSO +imshift, magnify, rotate, imlintran, geomap, geotran, geoxytran +.endhelp diff --git a/pkg/images/immatch/doc/imalign.hlp b/pkg/images/immatch/doc/imalign.hlp new file mode 100644 index 00000000..c63be5bc --- /dev/null +++ b/pkg/images/immatch/doc/imalign.hlp @@ -0,0 +1,316 @@ +.help imalign Feb90 images.immatch +.ih +NAME +imalign -- register a list of images by computing relative object shifts +.ih +USAGE +imalign input reference coords output +.ih +PARAMETERS +.ls input +The input images to be shifted and trimmed. The input image list should +contain the reference image so that its borders are +used in the computation of the overlap region. +.le +.ls reference +The reference image to which the input images will be aligned. +.le +.ls coords +A text file containing the reference image coordinates of the registration +objects to be centered in each image, one object per line with the x and y +coordinates in columns one and two respectively. +.le +.ls output +The output images. +.le +.ls shifts = "" +A text file containing the initial estimate for each image of the +shift in each axis relative to the reference image. These +estimates are used to modify the coordinates of the registration +objects prior to centering. The format of the file is one image per +line with the x and y shifts in columns one and two respectively. +The sense of the shifts is such that: \fIXshift=Xref-Xin\fR and +\fBYshift=Yref-Yin\fR. If \fIshifts\fR is null, a coarse centering +pass will be made to attempt to determine the initial shifts. +.le +.ls boxsize = 7 +The size in pixels of the box to use for the final centering, during +which all the sources in \fIcoords\fR are recentered in each image +using the initial estimate of the relative shift for each image. +Care should be taken to choose an appropriate value for this parameter, +since it is highly data dependent. +.le +.ls bigbox = 11 +The size in pixels of the box to use for coarse centering. The coarse +pass through the centering algorithm is made with the box centered at +the nominal position of the first source in the coordinate list. +Coarse centering is performed only if the shifts file is undefined. +Care should be taken to choose an appropriate value for this parameter, +since it is highly data dependent. Large values should be suspect until +the final results are checked to see that the centering did not converge +on the wrong coordinates, although the usual result for an inappropriate +\fIbigbox\fR size is that the algorithm fails to converge and the task +aborts. +.le +.ls negative = no +Are the features negative ? +.le +.ls background = INDEF +The absolute reference level for the marginal centroid calculation. +If background is INDEF, this is set to the mean value (between the +thresholds) of the individual sources. +.le +.ls lower = INDEF +The lower threshold for the data. Individual pixels less than this +value will be given zero weight in the centroids. +.le +.ls upper = INDEF +The upper threshold for the data. Individual pixels greater than this +value will be given zero weight in the centroids. +.le +.ls niterate = 3 +The maximum number of centering iterations to perform. The centering +will halt when this limit is reached or when the desired Itolerance +is achieved. +.le +.ls tolerance = 0 +The tolerance for convergence of the centering algorithm. This is the +integral shift of the centering box from one iteration to the next. +.le +.ls maxshift = INDEFR +The maximum permitted difference between the predicted shift and the +the computed shift for each object. Objects with shifts greater than +maxshift are ignored. If maxshift is undefined no shift checking is done. +.le +.ls shiftimages = yes +If shiftimages is yes, the IMSHIFT task will be used to align the +images. If shiftimages is no, the images will not be aligned, but +the coordinates will still be centered. +.le +.ls interp_type = "spline3" +The interpolation function used by the IMSHIFT task. +.le +.ls boundary_type = "constant" +The boundary extension type used by the IMSHIFT task. +.le +.ls constant = 0. +The constant used by the IMSHIFT task if \fIboundary_type\fR is "constant". +.le +.ls trimimages = yes +If trimimages is yes, the output images will be trimmed to +include only the region over which they all overlap. The +trim section that is actually used may differ slightly from that +reported by IMCENTROID, due to a correction applied to compensate for +the boundary extension "contamination" near the edges of the images. +.le +.ls verbose = yes +Print the centers, shifts, and trim section? +.le +.ih +DESCRIPTION +IMALIGN measures the X and Y axis shifts between a list of input images +\fIinput\fR and a reference image \fIreference\fR, registers the +input images to the reference image using the computed shifts, +and trims the input images to a common overlap region. +The task is meant to address the class of two dimensional image +registration problems in which the images have the same pixel scale, +are shifted relative to each other by simple x and y translations, and contain +enough high signal / noise, pointlike sources in common to compute good +average positions. The basic operation of the task is to find centers +for the list of registration objects or features in the coordinate +frame of each image and then to subtract the corresponding centers +found in the reference image. The shifts of the registration objects +are averaged for each image. + +IMALIGN is a simple script front end for IMCENTROID, which computes the +shifts, IMSHIFT, which shifts the images, and +IMCOPY, which performs the trimming. + +A list of the X and Y coordinates of the registration objects should be +provided via the \fIcoords\fR parameter. The registration objects do not +all have to be common to each frame; only that subset of the +objects that is contained within the bounds of a given image will be +centered. Only the objects that are common to both the given image and +the reference will be used to calculate the shifts. The coordinates +must be measured in the frame of the reference image. If coarse +centering is to be done, which is to say, if no \fIshifts\fR file is +provided, then the first registration source should be separated from +other sources by at least the maximum expected relative shift. + +An initial estimate of the shifts between each of the input images and +the reference image is required for the centering algorithm (a marginal +centroid) to work. This estimate can be explicitly supplied in the file +\fIshifts\fR (\fIXshift=Xref-Xin\fR and \fIYshift=Yref-Yin\fR) or can +be generated from the images by measuring the relative shift of the +first source listed in the coords file for each image. This coarse +centering pass requires that the first source be detached from other +sources and from the border of each image, by a distance that is at +least the maximum shift between the reference and input image. This +source should be pointlike and have a high signal to noise ratio. The +value of the \fIbigbox\fR parameter should be chosen to include the +location of the source in each of the images to be aligned while +excluding other sources. Large values of \fIbigbox\fR should be held +suspect until the final convergence of the centering algorithm is +verified, although given a small value for the \fItolerance\fR, the +quality of the final centers is independent of the estimate for the +initial shifts. Better convergence may also be obtained by increasing +the \fIniterate\fR parameter, although the default value of three +should work for most cases. \fINiterate\fR should be kept small to +avoid runaway. + +The \fIboxsize\fR parameter controls the size of the centering box for +the fine centering passes and should be chosen so as to exclude sky +background and other sources while including the wings of the point +spread function. The sense of the shifts that are calculated is +consistent with the file supplied to the \fIshifts\fR parameter and +with that used with the IMSHIFT task. + +If \fIshiftimages\fR is yes the images will actually be shifted using +the IMSHIFT task. Note that if \fIinterp_type\fR is "nearest" the +effect on the images is the same as if the shifts were rounded to +integral values. In this case, the pixels will be shifted without +interpolation. This can be used for data in which it is more important +to preserve the pixel values than it is to achieve perfect +registration. + +If \fItrimimages\fR is yes, the output images will be trimmed to +include only the region over which they all overlap. The trim section +that is actually used may differ slightly from that reported by +IMCENTROID. A one or two pixel correction may be applied to each edge +to compensate for the boundary extension "contamination" due to +multi-pixel (e.g., \fIinterp_type\fR = poly5) interpolation near the +edges of the images. + +IMALIGN may be used with a set of \fIimages\fR which vary in size. +This can result in vignetting of the calculated overlap region because +of the nature of the IMSHIFT task to preserve the size of an input +image. To visualize this, imagine a large reference image and a single +small image to be aligned to it, both containing the same registration +object which is at the center of each image. IMALIGN will cause the +small image to be shifted such that the object is positioned at the same +pixel location as in the reference. In performing the shift, a large +fraction of the area of the small image may be shifted outside of its +own borders, whereas the physical overlap of the large and small images +includes ALL of the pixels of the small image. In the case of such +vignetting, IMALIGN will print a warning message and refuse to proceed +with the trimming although the vignetting will occur whether or not the +images are trimmed. Note that the vignetting will not occur if the +small image is used as the \fIreference\fR. + +The vignetting message may also be printed if the \fIimages\fR are all +the same size but the \fIreference\fR is not included in the list. +This will occur if the sense of the measured shifts in a coordinate are +all positive or all negative since in this case the border of the +\fIreference\fR would have provided one of the limits to the trim +section. The reality of this vignetting depends on your point of view. + +Trimming will also not be performed if the entire overlap region vanishes. + +Note that many of these difficulties are due to the intrinsically fuzzy +nature of the process of image registration. This all leads to a few +"rules of thumb": + +.nf + o Include the reference image in the input image list + + o Use the smallest image as the reference image + + o Choose the reference image such that the input images are + scattered to either side in the shifts in each axis + + o Align images that are the same size, OR + + o Pad dissimilar sized images with blanks to + the largest size and disable trimming +.fi +.ih +CENTERING ALGORITHM +The algorithm is a "marginal" centroid in which the fit for each axis +is performed separately upon a vector created by collapsing the +centering box perpendicular to that axis. The centroid is calculated +with respect to the level specified by \fIbackground\fR. If +\fIbackground\fR is INDEF, the reference level for each source in each +image is the local mean for those pixels that lie between the +\fIlower\fR and \fIupper\fR thresholds. The thresholds are set to the +local data minimum or maximum if \fIlower\fR or \fIupper\fR, +respectively, are INDEF. If \fInegative\fR is yes, than the marginal +vector will be inverted before being passed to the centroid algorithm. + +The maximum number of centering iterations and the tolerance for +convergence are controlled by \fIniterate\fR and \fItolerance\fR. Note +that the tolerance is an integer value that represents the maximum +movement of the centering box between two successive iterations. The +default value of 0 requires that the centroid lie within the center +pixel of the centering box which is \fIboxsize\fR in extent (note that +\fIboxsize\fR must be an odd number). This should normally be the case +for bright, circularly symmetric point sources in images with a flat +sky background. If the registration sources are not circular symmetric +try increasing the tolerance gingerly. A sky level that varies across +the image should be removed before processing. The centering and +calculation of the shifts may be performed with \fIshiftimages\fR = no +(or directly with IMCENTROID) and the calculated shifts applied to the +images directly with IMSHIFT. + +.ih +EXAMPLES +1. Align three images to the first using the list of registration star +coordinates in the file "x1.coords". + +.nf + cl> imalign x1,x2,x3 x1 x1.coords x1.out,x2.out,x3.out +.fi + +2. Align a list of images contained in the file "imlist", overwriting the +original images with the shifted and trimmed images: + +.nf + cl> imalign @imlist x1 x1.coords @imlist +.fi + +3. Align the images leaving the output images the same size as the input +images: + +.nf + cl> imalign @imlist x1 x1.coords @outlist trimimages- +.fi + +4. Perform the centering but not the shifts: + +.nf + cl> imalign @imlist x1 x1.coords shiftimages- +.fi + +5. Perform the centering, but don't calculate the shifts at all, +and don't shift the image. + +.nf + pr> imalign @imlist "" x1.coords shiftimages- +.fi + +.ih +BUGS +The images being shifted must be in the current directory. + +The coarse centering portion of the algorithm can be fooled if the +first source on the list is not well separated from other sources, or +if the first source has a low signal to noise ratio, or if there is a +complicated shape to the background. + +The task can produce output images that do not contain the entire +overlap region. This can only occur if the images are of varying sizes. +This behavior is caused by the action of the IMSHIFT task to preserve the +size of an input image, thus implicitly "trimming" the image. A work +around is to use IMCOPY to place the images into subsections of blank +images that are the size (in each dimension) of the largest image(s) +and use IMALIGN with \fItrimimages\fR set to no. The borders of the output +images can be trimmed manually. This is discussed above in more detail. + +If \fIimages\fR does not contain the \fIreference\fR and \fItrimimages\fR +is set to yes then the set of shifted and trimmed images may no longer +be aligned to the reference. This occurs because any place holder +pixels at the bottom and left edges of the images will be trimmed off. +This is also discussed above. +.ih +SEE ALSO +imcentroid, center, imshift, geomap, geotran +.endhelp diff --git a/pkg/images/immatch/doc/imcentroid.hlp b/pkg/images/immatch/doc/imcentroid.hlp new file mode 100644 index 00000000..c284d9be --- /dev/null +++ b/pkg/images/immatch/doc/imcentroid.hlp @@ -0,0 +1,257 @@ +.help imcentroid Jan97 images.immatch +.ih +NAME +imcentroid -- center sources in images, optionally find shifts + +.ih +USAGE +imcentroid input reference coords + +.ih +PARAMETERS + +.ls input +The list of images within which sources are to be centered. If a +\fIreference\fR image is specified, imcentroid will calculate the mean +X and Y shifts between the centered sources within each image and those +same sources within the reference image. The input image list +should normally include the reference image so that its borders are +used in the calculation of the overlap region. +.le +.ls reference = "" +The reference image to which the input images will be aligned. If +a reference image is specified the mean X and Y shifts between each of +the input images and the reference image will be calculated, otherwise +only the centers for the individual sources will be reported. +.le +.ls coords +A text file containing the coordinates of the registration objects to +be centered in each image, one object per line with the x and y +coordinates in columns one and two respectively. These coordinates +should be measured in the frame of the reference image. +.le +.ls shifts = "" +A text file containing the initial estimate for each image of the +shift in each axis relative to the reference image. These +estimates are used to modify the coordinates of the registration +objects prior to centering. The format of the file is one image per +line with the fractional x and y shifts in columns one and two +respectively. The sense of the shifts is such that: +Xshift =Xref - Xin and shift= Yref - Yin. If shifts is undefined, +a coarse centering pass will be made to attempt to determine +the initial shifts. +.le +.ls boxsize = 7 +The size in pixels of the box to use for the final centering, during +which all the sources in the coords file are recentered in each image +using the initial estimate of the relative shift for each image. +Care should be taken to choose an appropriate value for this parameter, +since it is highly data dependent. +.le +.ls bigbox = 11 +The size in pixels of the box to use for coarse centering. The coarse +pass through the centering algorithm is made with the box centered at +the nominal position of the first source in the coordinate list. +Coarse centering is performed only if the shifts file is undefined. +Care should be taken to choose an appropriate value for this parameter, +since it is highly data dependent. Large value should be suspect until +the final results are checked to see that the centering did not converge +on the wrong coordinates, although the usual result for an inappropriate +bigbox size is that the algorithm fails to converge and the task +aborts. +.le +.ls negative = no +Are the features negative ? +.le +.ls background = INDEF +The absolute reference level for the marginal centroid calculation. +If background is INDEF, this is set to the mean value (between the +thresholds) of the individual sources. +.le +.ls lower = INDEF +The lower threshold for the data. Individual pixels less than this +value will be given zero weight in the centroids. +.le +.ls upper = INDEF +The upper threshold for the data. Individual pixels greater than this +value will be given zero weight in the centroids. +.le +.ls niterate = 3 +The maximum number of centering iterations to perform. The centering +will halt when this limit is reached or when the desired tolerance +is achieved. +.le +.ls tolerance = 0 +The tolerance for convergence of the centering algorithm. This is the +integral shift of the centering box from one iteration to the next. +.le +.ls maxshift = INDEFR +The maximum permitted difference between the predicted shift and the +the computed shift for each object. Objects with shifts greater than +maxshift are ignored. If maxshift is undefined no shift checking is done. +.le +.ls verbose = yes +Print the centers for the individual objects ? If verbose is no +only the shifts relative to the reference coordinates will be reported. +If no reference image is supplied, verbose is automatically set to yes. +.le + +.ih +DESCRIPTION + +IMCENTROID measures the X and Y coordinates of a list of sources in a +list of images and finds the mean X and Y shifts between the input +images \fIinput\fR and a \fIreference\fR image, where the shifts are +defined as the shifts that should be added to the input image coordinates to +convert them into the reference coordinates. The task is meant to +address the class of two dimensional image registration problems in +which the images have the same pixel scale, are shifted relative to +each other by simple translations in each axis, and contain enough high +signal-to-noise, pointlike sources in common to form good average +positions. The basic operation of the task is to find centers for the +list of registration objects in the coordinate frame of each image and +then to subtract the corresponding centers found in the reference +image. The shifts of the objects are averaged for each image. + +A list of the X and Y coordinates of the registration objects should be +provided in the coordinates file \fIcoords\fR. The registration objects do not +all have to be common to each frame, rather only that subset of the +objects that is contained within the bounds of a given image will be +centered. Only the objects that are common to both the given image and +the reference will be used to calculate the shifts. The coordinates +should be measured in the frame of the reference image\fIreference\fR. +If coarse centering is to be done, which is to say, if no \fIshifts\fR file is +provided, then the first registration source should be separated from +other sources by at least the maximum expected relative shift. + +An initial estimate of the shifts between each of the input images +\fIinput\fR and the reference image \fIreference\fR is required for the +centering algorithm (a marginal centroid) to work. This estimate can be +explicitly supplied in the text file \fIshifts\fR where Xshift = Xref -Xin +and Yshift = Yref -Y in, or can be generated from the images by measuring +the relative shift of the first source listed in the coordinates file +\fIcoords\fR for each input image. This coarse +centering pass requires that the first source be detached from other +sources and from the border of each image by a distance that is at +least the maximum shift between the reference and input image. This +source should be pointlike and have a high signal to noise ratio. The +value of the \fIbigbox\fR parameter should be chosen to include the +location of the source in each of the images to be aligned while +excluding other sources. Large values of \fIbigbox\fR should be held +suspect until the final convergence of the centering algorithm is +verified, although given a small value for the \fItolerance\fR, the +quality of the final centers is independent of the estimate for the +initial shifts. Better convergence may also be obtained by increasing +the \fIniterate\fR parameter, although the default value of three +should work for most cases. \fINiterate\fR should be kept small to +avoid runaway. + +The \fIboxsize\fR parameter controls the size of the centering box for +the fine centering pass and should be chosen so as to exclude sky +background and other sources while including the wings of the point +spread function. The sense of the shifts that are calculated is +consistent with the file supplied to the \fIshifts\fR parameter and +with that used with the IMSHIFT task. + +IMCENTROID may be used with a set of input images which vary in size. +This can result in vignetting of the calculated overlap region because +of the nature of tasks such as IMSHIFT to preserve the size of an input +image. To visualize this, imagine a large reference image and a single +small image to be aligned to it, both containing the same registration +object which is at the center of each image. IMCENTROID will cause the +coordinate system of the small image to be shifted such that the object +will be positioned at the same pixel location as in the reference. If +the shift is performed, a large fraction of the area of the small image +may be shifted outside of its own borders, whereas the physical overlap +of the large and small images includes ALL of the pixels of the small +image. In the case of such vignetting, IMCENTROID will print a warning +message and both the vignetted and unvignetted trim sections. Note +that the vignetting will not occur if the small image is used as the +reference image. + +The vignetting message may also be printed if the input images are all +the same size but the reference image is not included in the list. +This will occur if the sense of the measured shifts in a coordinate are +all positive or all negative since in this case the border of the +reference image would have provided one of the limits to the trim +section. The reality of this vignetting depends on your point of view. + +Note that many of these difficulties are due to the intrinsically fuzzy +nature of the process of image registration. This all leads to a few +guidelines: + +.nf + o Include the reference image in the input image list + + o Use the smallest image as the reference image + + o Choose the reference image such that the input images + are scattered to either side in the shifts in each axis + + o Align images that are the same size, OR + + o Pad dissimilar sized images with blanks to the largest size +.fi + +.ih +CENTERING ALGORITHM + +The algorithm is a "marginal" centroid in which the fit for each axis +is performed separately upon a vector created by collapsing the +centering box perpendicular to that axis. The centroid is calculated +with respect to the level specified by \fIbackground\fR. If +\fIbackground\fR is INDEF, the reference level for each source in each +image is the local mean for those pixels that lie between the +\fIlower\fR and \fIupper\fR thresholds. The thresholds are set to the +local data minimum or maximum if \fIlower\fR or \fIupper\fR, +respectively, are INDEF. If \fInegative\fR is yes, than the marginal +vector will be inverted before being passed to the centroid algorithm. + +The maximum number of centering iterations and the tolerance for +convergence are controlled by \fIniterate\fR and \fItolerance\fR. Note +that the tolerance is an integer value that represents the maximum +movement of the centering box between two successive iterations. The +default value of 0 requires that the centroid lie within the center +pixel of the centering box which is \fIboxsize\fR in extent (note that +\fIboxsize\fR must be an odd number). This should normally be the case +for bright, circularly symmetric point sources in images with a flat +sky background. If the registration sources are not circular symmetric +try increasing the tolerance gingerly. If the sky background is not +flat, but varies across the image, it can be removed before processing. + +.ih +EXAMPLES + +1. Calculate the shifts between three images using the first image +as a reference image and the list of registration star coordinates in +the file "x1.coords". + +.nf + cl> imcentroid x1,x2,x3 x1 x1.coords +.fi + +2. Calculate the shifts between a list of images contained in the file +"imlist": + +.nf + pr> imcentroid @imlist x1 x1.coords +.fi + +3. Perform the centering, but don't calculate the shifts, i.e., don't +supply a reference image. Note that the \fIinput\fR list of shifts, +or a coarse centering pass are still needed: + +.nf + pr> imcentroid @imlist "" x1.coords +.fi + +.ih +BUGS +The coarse centering portion of the algorithm can be fooled if the +first source on the list is not well separated from other sources, or +if the first source has a low signal to noise ratio, or if there is a +complicated shape to the background. +.ih +SEE ALSO +imalign, imshift, xregister, geomap, geotran +.endhelp diff --git a/pkg/images/immatch/doc/imcombine.hlp b/pkg/images/immatch/doc/imcombine.hlp new file mode 100644 index 00000000..720fe785 --- /dev/null +++ b/pkg/images/immatch/doc/imcombine.hlp @@ -0,0 +1,1471 @@ +.help imcombine Aug01 images.immatch +.ih +NAME +imcombine -- Combine images using various algorithms +.ih +USAGE +imcombine input output +.ih +PARAMETERS +.ls input +List of input images to combine. If the \fIproject\fR parameter is "no" +then all input images must have the same dimensionality though they may +be of different sizes. Otherwise each input image is handled separately +and they may have different dimensionalities. +.le + + +When the \fIproject\fR parameter is "no" all the input images are combined +into a single output file. In this case the following parameters specify +only a single file name. Otherwise each input image is combined by +projecting (combining across) the highest dimension to produce a lower +dimensional image. For this type of combining there is one output for each +input and so the following parameters specify matching lists. + +.ls output +Output combined image(s). If there are fewer than 100 input images the +names of the input images are recorded in header keywords IMCMBnnn. +.le +.ls headers = "" (optional) +Optional output multiextension FITS file(s). The extensions are dataless +headers from each input image. +.le +.ls bpmasks = "" (optional) +Optional output bad pixel mask(s) with good values of 0 and bad values of +1. Output pixels are marked as bad when no input pixels contributed to the +output pixel. The file name is also added to the output image header under +the keyword BPM. +.le +.ls rejmask = "" (optional) +Optional output mask file(s) identifying rejected or excluded pixels. The +pixel mask is the size of the output image but there is one extra dimension +with length equal to the number of input images. Each element of the +highest dimension is a mask corresponding to an input image with values of +1 for rejected or excluded pixels and values of 0 for pixels which were +used. The order of the masks is the order of the input images and image +header keywords, indexed by the pixel coordinate of the highest dimension +identify the input images. Note that the pixel positions are in the output +pixel coordinate system. +.le +.ls nrejmasks = "" (optional) +Optional output pixel mask(s) giving the number of input pixels rejected or +excluded from the input images. +.le +.ls expmasks = "" (optional) +Optional output exposure mask(s) giving the sum of the exposure values of +the input images with non-zero weights that contributed to that pixel. +Since masks are integer, the exposure values may be scaled to preserve +dynamic range and fractional significance. The scaling values are given in +the header under the keywords MASKSCAL and MASKZERO. Exposure values are +computed from the mask values by scale * value + zero where scale is the +value of the MASKSCAL keyword and zero is the value of the MASKZERO +keyword. +.le +.ls sigma = "" (optional) +Optional output sigma image(s). The sigma is the standard deviation, +corrected for a finite population, of the input pixel values (excluding +rejected pixels) about the output combined pixel values. +.le + +.ls imcmb = "$I" (optional) +A keyword in the input images that is copied +to one of the IMCMBnnn keywords in the output image. A null string +does not set the IMCMBnnn keywords nor deletes any existing keywords. +Any other value will delete existing keywords before creating new ones. +The special value "$I" specifies the basename of the input image name. +If a keyword is specified that does not exist in the input image(s) then +no ICMB keyword will be produced; it is not a error for the keyword to +not exist. +.le +.ls logfile = "STDOUT" (optional) +Optional output log file. If no file is specified then no log information is +produced. The special filename "STDOUT" prints log information to the +terminal. +.le + +.ls combine = "average" (average|median|lmedian|sum|quadrature|nmodel) +Type of combining operation performed on the final set of pixels (after +offsetting, masking, thresholding, and rejection). The choices are: + +.nf + average - weighted average + median - median + lmedian - median except use the lower value if only two + sum - (weighted) sum + quadrature - weighted quadrature average + nmodel - weighted quadrature average of noise model values +.fi + +The details of each choice is given in the DESCRIPTION. +Note that if weights are used then the weighted "sum" is the same as +the weighted "average" since the weights are normalized to unit total weight. +The "lmedian" option is intended for minimizing the effects of cosmic rays +when there are more than two images but some pixels may only have two +contributing images. The "quadrature" and "nmodel" options are used +for error propagation either with input sigma images (quadrature) or where the +pixel sigmas may be computed by the noise model used by this task (nmodel). +.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 described 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. +.le +.ls outtype = "real" (none|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. When there is a mixture of +short and unsigned short images the highest precedence become integer. +The datatypes may be abbreviated to a single character. +.le +.ls outlimits = "" +Output region limits specified as pairs of whitespace separated values. +The first two numbers are the limits along the first output image dimension, +the next two numbers are the limits along the second dimension, and so on. +If the higher dimension limits are not specified they default to the full +range. Therefore, if no limits are specified then the full output is +created. Note that the output size is computed from all the input images +including offsets if specified and the coordinates are relative to that +size. +.le +.ls offsets = "none" (none|wcs|world|physical|grid|<filename>) +Integer offsets to add to each image axes. The options are: +.ls "none" +No offsets are applied. +.le +.ls "wcs" or "world" +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 "physical" +The physical coordinate system defined by the IRAF LTM/LTV keywords +define the offsets. +.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" +Type of pixel masking to use. The choices are + +.nf + none - No pixel masking + goodvalue - good pixels defined by maskvalue parameter + badvalue - bad pixels defined by maskvalue parameter + novalue - pixels with no value defined by maskvalue parameter + goodbits - good pixels defined by maskvalue parameter + badbits - bad pixels defined by maskvalue parameter +.fi + +Except for "none", these choices use the mask specified by the header +keyword BPM. To use a different keyword to specify the mask the syntax +is + +.nf + !<keyword> [goodvalue|badvalue|novalue|goodbits|badbits] +.fi + +where if the optional second word is missing the default is "goodvalue". + +If "none" (or "") no pixel masking is done +even if an image has an associated pixel mask. The masking defines +pixels to be used (good) and not used (bad). The types use the +"maskvalue" parameter to define a single value (either as a number or +set of bits) for good or bad and all other values are treated as the +opposite; i.e. bad or good respectively. + +The "novalue" choice uses 0 as the good value and all other values are +bad. However, the "maskvalue" parameter defines a mask value for pixels +with no value such as occurs from rebinning at the edges or stacking where +there is no overlap at all. The distinction pixels is that when a final pixel +has no overlapping data because all input pixels have a "no value" flag +the blank value is output while if there is no good data then pixels which +are have other than the "no value" flag are combined as if they were good +to produce a representative output value. An output mask will have a +value of 0 for pixels where at least one good input value was present, +a value of 1 when there was no overlapping data, and a value of 2 when +bad data was used. +.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 for combining after any +rejection. +.le + +.ls scale = "none" (none|mode|median|mean|exposure|@<file>|!<keyword>) +Multiplicative image scaling to be applied. The choices are none, multiply +by the reciprocal of the mode, median, or mean of the specified statistics +section, multiply by the reciprocal of the exposure time in the image header, +multiply by the values in a specified file, or multiply 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, add +the negative of the mode, median, or mean of the specified statistics +section, add the values given in a file, or add the 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 +.ls expname = "" +Image header keyword to be used with the exposure scaling and weighting +options. Also if an exposure keyword is specified that keyword will be +added to the output image using a weighted average of the input exposure +values. +.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 non-overlap, 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. The latter is in addition to pixels +missing due to non-overlapping offsets, bad pixel masks, or thresholds. +.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) +Readout noise in electrons, gain in electrons/DN, and sensitivity noise as +a fraction. These parameters are used with the "ccdclip" and "crreject" +algorithms as well as with the "nmodel" combining option. 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. +Radius in pixels for additional pixel to be rejected in an image with a +rejected pixel from one of the rejection algorithms. This applies only to +pixels rejected by one of the rejection algorithms and not the masked or +threshold rejected pixels. +.le + +.ce +Environment Variables + +.ls imcombine_maxmemory (default = 250000000) +This task tries to use the maximum possible memory for efficiency when +dealing with lots of data and is designed to reduce memory usage if +memory allocation fails. However, there may be cases where this adjustment +fails so this variable allows forcing the task to stay within a smaller +allocation. This variable is in bytes and the default is the amount +generally returned by the system. It is large because of virtual memory +functionality. If problems are encountered one should try setting this +variable to a smaller size until, hopefully, the out of memory errors +disappear. +.le +.ls imcombine_option (default = 1) +This environment variable is used to select certain experimental or +diagnostic options. If this variable has the value 1, the default when the +variable is undefined, then when the number of images exceeds the number of +files that can be kept open under IRAF (currently this means more than 4000 +images) the images are closed and opened as needed. This is in contrast to +the previous method, when the variable has the value 0, which first builds +a single stacked image of a higher dimension from the input images. This +method requires the images all have the same size and also that there be +sufficient disk space for the stacked image and that the image be less +than 2Gb in size. +.le +.ih +DESCRIPTION +A set of images or the highest dimension elements (for example +the planes in an image cube) are combined by weighted averaging, medianing, +or summing. Pixels may be rejected from the combining by using pixel +masks, threshold levels, and rejection algorithms. The images may be +scaled, before rejections, multiplicatively, additively, or both based on +image statistics, image header keywords, or text files. The images may be +combined with integer pixel coordinate offsets, possibly determined using +the world coordinate system of the images, to produce an image bigger than +any of the input images. + +The input images to be combined are specified by a list. 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. If \fBproject\fR is "no" then the entire input list is combined to +form a single output image. In this case the images must all have the +same dimensionality but they may have different sizes. There is a software +limit of approximately 4000 images which may be open +simultaneously. To combine more than this number the program may either +create a temporary stacked image, requiring the images to be of the same +size, or repeatedly open and close the images. See the "Environment +Variables" in the PARAMETERS section. + +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 value of a keyword in the input images, where the +keyword is specified by the parameter \fIimcmb\fR, is written to an +indexed keyword IMCMBnnn. The purpose of the ICMBnnn keywords is to +identify the contributors to the output image. One common choice is +the input image name though other identifiers may be used. + +If a bad pixel mask is created, the name of the mask will be included in the +output image header 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. If there is a mixture of short and unsigned +short images then the highest precision is integer. + +In addition to one or more output combined images there are some optional +output files which may be specified as described in the OPTIONAL OUTPUT +section. + +An outline of the steps taken by the program is given below and the +following sections elaborate on the steps. + +.nf +o Check the input images and stack them if needed +o Set the input image offsets and the final output image size. +o Set the input image scales and weights possibly by computing + image statistics +o Write the log file and optional header 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 and other optional images. +.fi + +OPTIONAL OUTPUTS + +There are various additional outputs that may be produced by providing +the filenames. + +.ls Headers +The output image can only have one set of header keywords which are +inherited from the first input image in the input list. Copies of all the +input headers may be stored in a multiextension FITS file specified by the +\fIheaders\fR parameter. The extension names are the input image names. +The extensions are dataless headers. Since this means the image sizes are +lost, AXLEN keywords are added. Also the keywords INIMAGE and OUTIMAGE are +added giving the name of the input image and the name of the output +combined image. +.le +.ls Bad Pixel Masks +The \fIbpmasks\fR parameter produces optional output bad pixel mask(s) with +good values of 0 and bad values of 1. Output pixels are marked as bad when +no input pixels contributed to the output pixel. The file name is also +added to the output image header under the keyword BPM. +.le +.ls Rejection Masks +The \fIrejmasks\fR parameter produces optional output mask file(s) +identifying rejected or excluded pixels. The pixel mask is the size of the +output image. There is one extra dimension with length equal to the number +of input images. Each element of the highest dimension is a mask +corresponding to an input image with values of 1 for rejected or excluded +pixels and values of 0 for pixels which were used. The order of the masks +is the order of the input images and image header keywords indexed by the +element identify the input images. Note that the pixel positions are in +the output pixel coordinate system. + +This mask is the only way to record whether a particular input image pixel +contributed to the output image. As an example, consider the case of +three input two dimensional images of sizes 1020x1020, 1010x1010, and +1000x1000 with relative offsets of (0,0), (10,10), and (20,20). The output +image would then be 1020x1020. + +Suppose that the only input pixels not used are pixels (1,1) in each input +image. Because of the offsets the first 10 rows and columns of the output +will be based on just a single pixel except for (1,1) which has no input +pixels. The next 10 rows and columns of the output will be a combination +of 2 input pixels except (11,11) which is just based on pixel (11,11) +in the first input image. Finally all other pixels except (21,21) will be +a combination of 3 values. + +The rejection mask will be three dimensional of size 1020x1020x3. Plane 1 +will correspond to the first input image, plane 2 to the second, and so +on. All of the pixels will be zero except for the following pixels +which will have a value of 1. In the first plane only pixel (1,1,1) will be +one. In the second plane the first 10 rows and columns and pixel (11,11,2) +will be one. And in the third plane, the first 20 rows and columns and pixel +(21,21,3) will be one. So if we want to know about output pixel (11,11) +the rejection mask will tell us that pixels from the second and third +images were excluded. + +This is a complex example because of the offsets and dissimilar sizes. +In the more common and simpler case of equal sizes and registered images, +the mask +planes would have one to indicate that the pixel in the input image at +that coordinate was not used. For instance if pixel (12,15,2) is one +in the rejection mask then pixel (12,15) in the second input image was +excluded. + +Note that one can use image sections to extract a mask matching the input +image. For the example case with the offsets masks in the input +coordinates can be extracted with the commands + +.nf + cl> imcopy rejmask[*,*,1] mask1 + cl> imcopy rejmask[11:1020,11:1020,2] mask2 + cl> imcopy rejmask[21:1020,21:1020,3] mask3 +.fi + +For the case of equal sized and registered images one could also use +\fBimslice\fR. +.le +.ls Mask of the Number of Rejected Pixels +The \fInrejmasks\fR parameter produces optional pixel mask(s) giving the +number of input pixels rejected or excluded from the input images. This is +equivalent to projecting the rejection mask described previously by summing +along the highest dimension. Note that in this mask a value of 0 indicates +all the input pixels were used to create the output pixel and a value equal +to the number of input images indicate no input pixels were used. +.le +.ls Exposure Masks +The \fIexpmasks\fR parameter produces optional output exposure mask(s) +giving the sum of the exposure values of the input images with non-zero +weights that contributed to that pixel. Since masks are integer, the +exposure values may be scaled to preserve dynamic range and fractional +significance. The scaling values are given in the header under the +keywords MASKSCAL and MASKZERO. Exposure values are computed from the mask +values by scale * value + zero where scale is the value of the MASKSCAL +keyword and zero is the value of the MASKZERO keyword. +.le +.ls Sigma of Combined Pixels +The \fIsigma\fR parameter produces optional output sigma image(s). The +sigma is the standard deviation, corrected for a finite population, of the +input pixel values (excluding rejected pixels) about the output combined +pixel values. +.le +.ls Output Log File +The \fIlogfile\fR parameter produces an optional output log file. If no +file is specified then no log information is produced. The special +filename "STDOUT" prints log information to the terminal. +.le + +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 columns, the first two images in the next 10 columns and +all three images starting in the 21st column. At the 21st output column +the 21st column of the first image will be combined with the 11th 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 120 +columns corresponding to the 20 column offset in the third image. +Note that this same output image size is computed and used as the +basis for the \fIoutlimits\fR parameter to specify a subregion to +actually be output. + +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 +non-overlapping 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. + +OUTPUT OF SUBREGIONS + +The output image size is computed from all of the input images including +the offsets as described previously. The \fIoutlimits\fR may be used to +specify a subregion of this full size to be created. The syntax of this +parameter is pairs of whitespace separated numbers selecting the first and last +pixel in each output dimension. The pairs for each dimension are also +whitespace separated and are given in order of the dimensions. Any missing +values at the end of the string default to the full limits of the output +image. If the requested limits fall outside the full output image they are +reset to the size of the full computed output size. + +As an example, consider combining 10 images of size 1000x1000 with offsets +of 0, 1, ..., 9 along the first dimension. Because of the offsets the full +output size is 1010x1000. To output only the region [1:100,101:200] +of this full size the parameter value would be the string "1 100 101 200". +Note that if the value was just "1 100" then the output region would +be [1:100,1:1000]. + +The intended purpose for this option is to allow creating subregions using +a smaller number of images in the case of offset data taken at a raster of +positions. This is important since when the number of images becomes too +large (>4000) the program either has to prestack the images into a higher +dimensional single image (requiring equal sized images) or utilize an +inefficient algorithm where images are opened and closed for each input +line. A detail of how this task works is that it is the number of images +required to be accessed for each output line that is significant. + +The following example was developed when the maximum number of images +open at one time was ~240. In V2.12 the number was increased to +more than 4000 so it is not as relevant though it may apply to very +large surveys with many small images. + +As an example, consider a survey of a region of the sky composed of 8000 +images which are each 500x1000. The offsets between each image are 50 +pixels along the first dimension and 900 pixels along the second dimension, +give or take a few pixels due to telescope pointing errors. Thus this +survey consists of strips of exposures. Within a strip the images over by +about 450 pixels. Between strips the overlap is 100 pixels. So the +strips consist 400 exposures and there are 20 strips. + +The full size of this survey is then about 20450x18900. At any point in a +single strip the number of images contributing is no more than 10. +Including the overlap of the strips the maximum number is then 20. In +order to combine the data for such a survey one would like to create +subregion outputs which are 120 images from each strip. The lines where +the two strips overlap then require 240 images. To produce roughly equal +size regions we choose sizes along the first dimension of 5200 pixels. The +number of lines in the output subregions might be the full size of the +survey. However, it might be desirable to also break the second dimension +into blocks for ease of display and manipulation. + +The method for combining this example survey is then to combine the data in +four groups along the first dimension to produce subimages each 5200 pixels +wide which have no overlap. The reason for wanting to create +non-overlapping subregions is to simplify creation of the related masks, +most importantly, the exposure masks. The \fIoutlimits\fR parameter would +have the values "1 5200", "5201 10400", "10401 15600", and "15601 20800". +The second pair of limits is not specified to obtain the full size along +the second dimension. Note that the last block will actually be smaller +than 5200 pixels since the survey is less than 20800 pixels. + +In each combining step all the images must be specified for the input in +order to compute the full output size but then only those images needed to +produce an output line will be accessed at the same time. By design this +is roughly 240 images for lines where the strips overlap. The +non-overlapping blocks can be mosaiced together with this task as a final +step if desired. + + +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 are computed by sampling a uniform grid of points with +the smallest grid step that yields less than 100000 pixels; sampling is used +to reduce the time needed 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 value of the +image header keyword specified by the \fIexpname\fR keyword. As implied +by the parameter name, this is typically the image exposure time since +intensity levels are linear with the exposure time in CCD detectors. +Note that the exposure keyword is also updated in the final image +as the weighted average of the input values. Thus, if one wants to +use a nonexposure time keyword and keep the exposure time updating +feature the image header keyword syntax is available; i.e. !<keyword>. + +Scaling values may be defined as a list of values in a text file. The file +name is specified by the standard @file syntax. The list consists of one +value per line. The order of the list is assumed to be the same as the +order of the input images. It is a fatal error if the list is incomplete +and a warning if the list appears longer than the number of input images. +Because the scale and zero levels are adjusted only the relative +values are important. + +If both an intensity scaling and zero point shift are selected the +zero point is added first and the scaling is done. This is +important if the scale and offset values are specified by +header keywords or from a file of values. However, +in the log output the zero values are given as the scale times +the offset hence those numbers would be interpreted as scaling +first and zero offset second. + +The image statistics and scale factors are recorded in the log file +unless they are all equal, which is equivalent to no scaling. The +scale factors are normalized so that the first input image has no +scaling. This is done because the header of the first input image +is used as the template header for the combined output image. +By scaling to this first image this means that flux related keywords, +such as exposure time and airmass, are representative of the output +(except when the "sum" option is used). + +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 used for the final weighted average, sigma image, and +exposure mask 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. + +When forming the final weighted averages if the sum of the weights of +the non-rejected or excluded pixels is zero then instead of producing +a zero average the unweighted average of the pixels is produced. Similarly, +in the sigma calculation when the weights of the pixels are all zero +then the sigma is computed as if all pixels have unit weights. + +When there are zero weights only the pixels with non-zero weights are +used in computing the output exposure time mask. Note that the actual +weight values are not used but simply the sum of all exposure times +of pixels from images with non-zero weights is produced. + +The purpose of using zero weights is to identify images that are of +poor quality (such as non-photometric or bad seeing) which are then +excluded in the final weighted average or exposure time. However, +they contribute to the final image when there is no good +quality data but with an output exposure time of zero. + +INPUT PIXEL MASKS + +A pixel mask is a type of IRAF file having the extension ".pl" or +a FITS extension of "type=mask" which +identifies an integer value with each pixel of the images to which it is +applied. In future masks may also be stored as special FITS extensions. +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 type of file is compact. +It is 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. + +To use pixel masks with \fBimcombine\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) or some other +keyword to be specified. 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" or "". 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", "novalue", "goodbits", "badbits", and "!<keyword>". The last choice +allows specifying the keyword whose value is the mask to be used otherwise +the keyword "BPM" is used. + +The \fImasktype\fR choices are used in conjunction with the +\fImaskvalue\fR parameter. When the mask type is "goodvalue" or an +explicit keyword is specified without a mask type, the pixels with mask +values matching the specified value are included in combining and all +others are rejected. 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. + +The "novalue" option differs from the others in that there are three +classes of mask values and any output pixel mask will have the three +values 0 for good, 1 for no data, and 2 for bad. The purpose of this +option is to produce output values from the input values when there are +no good pixels. This happens when the input images have pixel values +which have been identified as bad (such as saturated) but whose values +can be used, possibly after being replaced or interpolated from nearby +pixels, to produce a value that is either cosmetically reasonable or even +marginally scientifically useful. Again, this only happens if there +are no good pixels to combine and then the output mask will identify +these pixels with a mask value of 2. If there is even one good pixel +then only the good data will contribute to the output. An exposure mask +may be useful in this case when most but not all image pixels have been +eliminated due to things like saturation. + +If a mask operation is specified and an image has no mask image associated +with it (the BPM or specified keyword is absent), 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. + +When the number of input images exceeds the maximum number of open files +allowed by IRAF and the input images need to be "stacked" then the masks +are also stacked. The stacking requires all the images to have the same size. + + +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. + +.in 2 +MINMAX +.in 2 +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 -2 +CCDCLIP +.in 2 +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 values (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 -2 +CRREJECT +.in 2 +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 -2 +SIGCLIP +.in 2 +The sigma clipping algorithm computes at each output pixel the median or +average excluding the high and low values. The sigma is then computed +about this estimate (without excluding the low and high values). 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 -2 +AVSIGCLIP +.in 2 +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 -2 +PCLIP +.in 2 +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 multiplied 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. + +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. + +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 +may also be rejected. The number of neighbors to be rejected +is specified by the \fIgrow\fR parameter which is a radius in pixels. +If too many pixels are rejected in one of the grown pixels positions +(as defined by the \fInkeep\fR parameter) then the value of that pixel +without growing will be used. + +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 as specified by the \fIcombine\fR +parameter. In all cases if there are no remaining pixels the \fIblank\fR +is produced. The combining choices are as follows. + +.in 2 +AVERAGE +.in 2 +The weighted average of the remaining pixels is computed. If no +weighting was specified then a simple, unweighted average is used. +If the sum of the weights of for the accepted pixels is zero then the +unweighted average is output. + +.in -2 +MEDIAN +.in 2 +The median of the remaining pixels is computed. The median is the +usual mathematical definition where a particular pixel value is produced +for an odd number of pixels and the average of the two central values +is computed for an even number of pixels. + +.in -2 +SUM +.in 2 +The sum of the unrejected pixels is computed. + +.in -2 +LMEDIAN +.in 2 +The median of the remaining pixels is computed except that for two +pixels the lower value is used. This is a specialized feature useful +for minimizing the effects of cosmic rays in dithered and/or masked data. + +.in -2 +QUADRATURE +.in 2 +The pixels are combined as + +.nf + sqrt (sum {(wt * sigma)^2}) / sum {wt} +.fi + +This is used when the input pixel values represent "sigmas". This option +is usually a second pass after the input data has been combined. It is +important that the input is arranged such that the same scaling and +pixel rejections are used. This means that these cannot be given by +explicit lists and masks and not generated from the data. + +.in -2 +QUADRATURE +.in 2 +The pixels are combined as + +.nf + value = max (0, scaled_pixel_value) + variance = rdnoise^2 + value / gain + (snoise * value)^2 + output = sqrt (sum {variance * wt^2}) / sum {wt} +.fi + +This is used when the variances in the input images can be computed +by the above noise model. Note that the gain and rdnoise are adjusted +for any scaling applied to the pixel values. + +This method has the advantage that the input images are the same as +those used to form a combined image and so all the steps of deriving +scaling and rejecting pixels by some rejection method will be the same. +.in -4 + +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> imcombine obj* avg combine=average reject=none + cl> imcombine obj* med combine=median reject=none +.fi + +2. To reject cosmic rays: + +.nf + cl> imcombine 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> imcombine @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> imcombine 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> imcombine obj* avsig combine=average reject=avsig \ + >>> scale=exp zero=mode weight=exp expname=exptime +.fi +.ih +REVISIONS +.ls IMCOMBINE V2.12 +A number of enhancements for dealing with large numbers of images were +made. Also the masktype option "!<keyword>", where <keyword> is a +user specified keyword, was added. + +The new parameters "headers", "bpmasks", "rejmasks", "nrejmasks", and +"expmasks" provide additional types of output. The old parameters +"rejmask" and "plfile" were removed. The new "nrejmasks" corresponds +to the old "plfile" and the new "rejmasks" corresponds to the old +"rejmask". + +There is a new "combine" type "sum" for summing instead of averaging the +final set of offset, scaled, and weighted pixels. + +there is a new parameter "outlimits" to allow output of a subregion of +the full output. This is useful for raster surveys with large numbers +of images. + +Additional keywords may appear in the output headers. + +The scaling is now done relative to the first image rather than an +average over the images. This is done so that flux related keywords +such as exposure time and airmass remain representative. +.le +.ls IMCOMBINE V2.11.2 +The grow algorithm was improved to give a 2D growing radius. + +An optional output mask file contains the identifications of which pixel +in which input image was rejected or excluded. + +The internal calculation type was changed to be the highest precedence +of the input and output types. Previously it was only the input types. +.le +.ls IMCOMBINE 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. + +A combination of ushort and short images now defaults to integer. +.le +.ls IMCOMBINE V2.14 +The "masktype" parameter has been generalized to allow both using a +different keyword for the input mask and choosing the mask method. +The "novalue" masktype is new and is useful for maintaining a distinction +between no data and possibly marginally useful or cosmetically useful +data. +.le +.ls IMCOMBINE V2.10.3 +The input scalings from an @file or header keyword are now truly +mulitplicative or additive and they are not normalized. The output +pixel types now include unsigned short integer. +.le +.ls IMCOMBINE 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 IMCOMBINE 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 +ccdred.combine mscred.combine onedspec.scombine, wpfc.noisemodel, +obsolete.ocombine +.endhelp diff --git a/pkg/images/immatch/doc/linmatch.hlp b/pkg/images/immatch/doc/linmatch.hlp new file mode 100644 index 00000000..21c04b22 --- /dev/null +++ b/pkg/images/immatch/doc/linmatch.hlp @@ -0,0 +1,699 @@ +.help linmatch Apr95 images.immatch +.ih +NAME +linmatch -- linearly match the intensity scales of 1 and 2D images +.ih +USAGE +linmatch input reference regions lintransform +.ih +PARAMETERS +.ls input +The list of input images to be matched. +.le +.ls reference +The list of reference images to which the input images are to be matched +if \fIscaling\fR is one of the "mean", "median", "mode", or "fit" +algorithms, or the list of reference photometry files if \fIscaling\fR +specifies the "photometry" algorithm. The number of reference images or +reference photometry files must be one or equal to the number of input +images. +.le +.ls regions +The list of image regions used to compute the intensity +matching function if \fIscaling\fR is one of the "mean", "median", "mode", +or "fit" algorithms, or a list of the input photometry files if +\fIscaling\fR specifies the "photometry" algorithm. In the former +case \fIregions\fR may be: 1) a string of the form "grid nx ny" defining +a grid of nx by ny equally spaced and sized image regions spanning the +entire image, 2) a list of object coordinates separated by commas e.g. +"303 401, 131 202", 3) a list of image sections separated by whitespace +e.g "[101:200,101:200] [301:400,301:400]", +4) the name of a text file containing a list of object coordinates separated +by newlines, and 5) the name of a text file containing a list of image +sections separated by whitespace and/or newlines. +.le +.ls lintransform +The name of the text file where the computed scaling factors are written. +If \fIdatabasefmt\fR is "yes", a single record containing the computed +bscale and bzero factors for each image region or object, and the +average bscale and bzero, is written to the text database +file for each input image. If \fIdatabasefmt\fR = "no", a single line +containing the input image name, bscale factor, bzero factor, error +in bscale, and error in bzero is written to a simple text file for +each image. +.le +.ls output = "" +The list of output matched images. If \fIoutput\fR is the NULL string +then bscale and bzero are computed for each input image and written to +\fIlintransform\fR, but no output images are written. If \fIoutput\fR +is not NULL then the number of output images must equal the number of +input images. +.le +.ls databasefmt = yes +If \fIdatabasefmt\fR is "yes" the computed bscale and bzero factors +are written to a text database file, otherwise they are written to a +simple text file. +.le +.ls records = "" +The list of records to be written to or read from \fIlintransform\fR one +input image. If \fIrecords\fR is NULL then the output or input record names +are assumed to be the names of the input images. If \fIrecords\fR is not NULL +then the record names in \fIrecords\fR are used to write / read the +database records. This parameter is useful for users +who, wish to compute the bscale and bzero factors using images that have +been processed +in some manner (e.g. smoothed), but apply the computed bscale and bzero +factors to the original unprocessed images. If more than one record +with the same name exists in \fIlintransform\fR then the most recently written +record takes precedence. The records parameter is ignored if +\fIdatabasefmt\fR is "no". +.le +.ls append = yes +Append new records to an existing \fIlintransform\fR file or start a new +file for each execution of LINMATCH? The append parameter is +ignored if \fIdatabasefmt\fR is "no". +.le +.ls shifts = "" +An optional list of shifts files containing the x and y shifts to be applied +to the reference regions to determine their positions in +the input images. The number of shifts files must equal the number of +reference images. The shifts are listed in the shifts file, 1 shift per line, +with the x and y shifts in +columns 1 and 2 respectively. If there are fewer x and y shifts defined +in the shifts file than there are input images, the extra input +images will be assigned x and y shifts of \fIxshift\fR and \fIyshift\fR +respectively. The shifts parameter is ignored if the \fIscaling\fR +parameter is set to "photometry". +.le +.ls xshift = 0.0 yshift = 0.0 +The default x and y shifts to be applied to the reference image regions +or objects to compute their positions in the input image. +Values in \fIshifts\fR take precedence over the values of \fIxshift\fR and +\fIyshift\fR. xshift and yshift are ignored if the \fIscaling\fR parameter +is set to "photometry". +.le +.ls dnx = 31 dny = 31 +The default size of a single image region used to compute the bscale +and bzero factors if \fIscaling\fR is one of the "mean", "median", "mode", +or "fit" algorithms and \fIregions\fR is a coordinate list rather than +a sections list. dnx and dny are ignored if the \fIscaling\fR parameter +is set to "photometry". +.le +.ls maxnregions = 100 +The maximum number of image regions or objects with measured photometry +that can be used to compute the bscale and bzero factors. +.le +.ls scaling = "mean mean" +The algorithms used to compute the bscale and bzero factors respectively. +The options are: +.ls mean median mode +Bscale or bzero are computed using the "mean", "median", or "mode" statistic +for each input and reference region individually. If one of the bscale or +bzero fitting +algorithms is set to "mean", "median", or "mode", the remaining factor +must be set to "mean", "median" or "mode" or a numerical constant, +e.g. "mean mean", "mean -100.0" or "2.63 mode". +If both algorithms are set to "mean", "median", or "mode" bscale will be +computed using the specified statistic and bzero will be set to 0.0 +If more than one input region is defined then a weighted least squares +fit of the reference statistics to the input image statistics +is performed and used to compute the final bscale and bzero factors. +.le +.ls fit +Bscale and bzero are computed for each input image region individually +by performing a least squares fit of the reference image pixels to +the input image pixels. If more than one input image region is defined +the final bscale and bzero factors are computed by averaging, +weighted by their signal-to-noise ratios, the individual bscale and bzero +values. If one of the bscale or bzero fitting +algorithms is set to "fit", the remaining factor must either also +be computed with the "fit" algorithm or set to a numerical constant, +e.g. "fit fit", "fit -100.0", or "2.63 fit". +.le +.ls photometry +Bscale and/or bzero are computed for each input object individually +using photometry computed for a set of objects common to the reference +and input images. If more than one input object is defined +the final bscale and bzero factors are computed by averaging, +weighted by their signal-to-noise ratios, the individual bscale and bzero +values. If one of the bscale or bzero fitting +algorithms is set to "photometry", the remaining factor must either also +be computed with the "photometry" algorithm or set to a numerical +constant, e.g. "photometry photometry", "photometry -100.0", or +"2.63 photometry". +.le +.ls number +Bscale and/or bzero are set to user defined numerical constants, +e.g. "2.62 -55.0" or "2.62 median". If both bscale and bzero are numerical +constants, LINMATCH must be run in non-interactive mode. If only one of bscale +or bzero is a numerical constant, any of the "mean", "median", "mode", "fit", +or "photometry" algorithms may be used to compute the remaining factor. +.le +.ls file +Bscale and bzero are not computed but instead read from record \fIrecord\fR in +the text database file \fIlintransform\fR if \fIdatabasefmt\fR is "yes", +or the next line of a simple text file if \fIdatabasefmt\fR is "no". +.le + +Further description of the matching algorithms can be found in the ALGORITHMS +section. +.le +.ls datamin = INDEF datamax = INDEF +The minimum and maximum good data values. Datamin and datamax are used by +the "mean", "median", and "mode" scaling algorithms to reject entire +image regions from the final fit, and by the "fit" algorithm to reject +individual bad pixels from the least squares fits for the individual +regions. +.le +.ls maxiter = 10 +The maximum number of iterations performed by the least squares fitting +algorithm. +.le +.ls nreject = 0 +The maximum number of rejection cycles used to detect and reject bad pixels +from the fit if the scaling algorithm is "fit" or bad regions / objects +from the fit if the scaling algorithm is "mean", "median", "mode", "fit", +or "photometry". +.le +.ls loreject = INDEF hireject = INDEF +The high- and low-side bad data rejection limits used to detect and reject +deviant pixels from the fit if the scaling algorithm is "fit" or bad +regions / objects from the fit if the scaling algorithm is "mean", "median", +"mode", "fit", or "photometry". +.le +.ls gain = "1.0 1.0" readnoise = "0.0 0.0" +The reference and input image gain and readout noise in e-/ADU and +e- respectively. Gain and readout may be numerical constants or the +image header keyword containing the actual gain and/or readout noise +value. Gain and readnoise are used by the "mean", "median", "mode", +and "fit" algorithms to estimate the expected errors in the computed +"mean", "median", or "mode" statistics, and by the "fit" algorithm +to compute the per pixel errors values. +.le +.ls interactive = no +Compute the bscale and bzero scaling factors for each image interactively +using graphics cursor and optionally image cursor input. +.le +.ls verbose = yes +Print messages about the progress of the task during task execution in +non-interactive mode. +.le +.ls graphics = "stdgraph" +The default graphics device. +.le +.ls display = "stdimage" +The default image display device. +.le +.ls gcommands = "" +The default graphics cursor. +.le +.ls icommands = "" +The default image cursor. +.le + +.ih +DESCRIPTION + +LINMATCH computes the bscale and bzero factors required to match +the intensity scales of a list of input +images \fIinput\fR to the intensity scales of a list of reference +images \fIreference\fR using the following definition of +bscale and bzero and a variety of techniques. + +.nf + reference = bscale * input + bzero +.fi + +The computed bscale and bzero factors are stored +in the text file \fIlintransform\fR, in the record \fIrecords\fR if +\fIdatabasefmt\fR is "yes", or a single line of a simple text file +if \fIdatabasefmt\fR is "no". One record is written to the output file +file for each input image. If a non NULL list of output images +\fIoutput\fR is supplied, a scaled output image is written for +each input image. LINMATCH is intended to solve 1D and 2D image intensity +matching problems where the input and reference images: 1) have the same +pixel scale and orientation, 2) differ in intensity by at most a scale +factor and a zero point, and 3) contain one or more regions or objects in +common that can be used to compute the scaling factors. Some of the scaling +algorithms also require that the images registered and have identical +point spread functions. LINMATCH cannot be used to compute or apply non-linear +intensity matching functions. + +If \fIscaling\fR = "mean", "median", "mode", or "fit" bscale and bzero +are computed directly from the input and reference image data using the +image sections specified in the \fIregions\fR and one of the above fitting +techniques as described in the ALGORITHMS section. All four algorithms +require accurate knowledge of the measurement errors which in turn +require accurate knowledge of the input and reference image gain and +readout noise values. Gain and readout noise values can be entered by +setting the \fIgain\fR and \fIreadnouse\fR parameters to the appropriate +numerical values or image header keyword. + +\fIRegions\fR is interpreted as either: 1) a string of +the form "grid nx ny" specifying a list of nx by ny image sections +spanning the entire image, 2) a string defining the coordinates of a list +of objects separated by commas e.g. +"103.3 189.2, 204.4 389.7", 3) a string containing a list of image +sections separated by whitespace, e.g "[100:203,200:300] [400:500,400:500]" +4) the name of a text file containing the coordinates of one or +more objects, one object per line, with the x and y coordinates +in columns 1 and 2 respectively, 5) the name of a text +file containing a list of image sections separated by whitespace and/or +newlines. The image sections specifications, or alternatively +the object coordinates and the parameters \fIdnx\fR and \fIdny\fR, +determine the size of the input and reference image data regions to be +extracted and used to compute the bscale and bzero factors. +These image regions should be selected with care. Ideal regions +span a range of intensity values and contain both object and background +data. + +If \fIscaling\fR = "photometry", the bscale and bzero factors +are computed directly from data in the input and reference image photometry +files using the technique described in the ALGORITHMS section. +In this case \fIregions\fR is a list of the input image photometry +files and \fIreference\fR are the corresponding reference image +photometry files written by a separate photometry task. +These photometry files are simple text files with the object +sky values, errors in the sky values, magnitudes, and errors in the +magnitudes in columns 1, 2, 3, and 4 respectively. + +An image region is rejected from the fit if it contains data outside the +limits specified by the \fIdatamin\fR and \fIdatamax\fR parameters +and \fIscaling\fR = +"mean", "median", or "mode". A pixel is rejected from the fit for an +individual region if the pixel value is outside the limits specified +by datamin and datamax, and the scaling algorithm is "fit". The datamin +and datamax parameters are not used by the "photometry" scaling algorithm . + +Deviant pixels can be rejected from the fits to individual image regions +if \fIscaling\fR = "fit", and \fInreject\fR, \fIloreject\fR, and +\fIhireject\fR are set appropriately. Nreject, loreject and reject +are also be used by all the scaling algorithms to reject image regions +which contribute deviant bscale and bzero values. + +The computed bscale and bzero value for each region and the final bscale +and bzero value for each input image are written to the linear +transformation file \fIlintransform\fR. +If \fIdatabasefmt\fR is "yes" each result is written to a record whose name +is either identical to the name of the input +image or supplied by the user via the \fIrecords\fR parameter . +If \fIdatabasefmt\fR is "no", then a single line containing the input image +name and the computed bscale and bzero values and their errors +is written to the output shifts file. + +If a list of output image names have been supplied then the bscale and +bzero values will be applied to the input images to compute the output images. + +If the \fIscaling\fR parameter is set to "file" then the shifts +computed in a previous run of LINMATCH will be read from the \fIlintransform\fR +file and applied to the input images to compute the output images. +If no record list is supplied by the user LINMATCH will +search for a record whose name is the same as the input image name. If more than +one record of the same name is found then the most recently written +record will be used. + +In non-interactive mode the task parameters are set at task startup time +and the input images are processed sequentially. If the \fIverbose\fR +flag is set, messages about the progress of the task are printed on the +screen as the task is running. + +In interactive mode the user can mark the regions to be used +to compute the matching function on the image display, show/set the data +and algorithm parameters, compute, recompute, and plot +matching function, and interactively delete and undelete +bad data from the fits using the plots and graphics cursor. A summary +of the available interactive commands is given in the CURSOR COMMANDS +section. + +.ih +CURSOR COMMANDS + +.nf +The following graphics cursor commands are currently available in LINMATCH. + + Interactive Keystroke Commands + +? Print help +: Colon commands + +g Draw a plot of the current fit +i Draw the residuals plot for the current fit +p Draw a plot of current photometry +s Draw histograms for the image region nearest the cursor +l Draw the least squares fit for the image region nearest the cursor +h Draw histogram plot of each image region in turn +l Draw least squares fits plot of each image region in turn +r Redraw the current plot +d Delete the image region nearest the cursor +u Undelete the image region nearest the cursor +f Recompute the intensity matching function +w Update the task parameters +q Exit + + + Colon Commands + +:markcoords Mark objects on the display +:marksections Mark image sections on the display +:show Show current values of all the parameters + + Show/set Parameters + +:input [string] Show/set the current input image +:reference [string] Show/set the current reference image / phot file +:regions [string] Show/set the current image regions +:photfile [string] Show/set the current input photometry file +:lintransform [string] Show/set the linear transform database file name +:dnx [value] Show/set the default x size of an image region +:dny [value] Show/set the default y size of an image region +:shifts [string] Show/set the current shifts file +:xshift [value] Show/set the input image x shift +:yshift [value] Show/set the input image y shift +:output [string] Show/set the current output image name +:maxnregions Show the maximum number of objects / regions +:gain [string] Show/set the gain value / image header keyword +:readnoise [string] Show/set the readout noise value / image header + keyword + +:scaling Show the current scaling algorithm +:datamin [value] Show/set the minimum good data value +:datamax [value] Show/set the maximum good data value +:nreject [value] Show/set the maximum number of rejection cycles +:loreject [value] Show/set low side k-sigma rejection parameter +:hireject [value] Show/set high side k-sigma rejection parameter +.fi + +.ih +ALGORITHMS + +MEAN, MEDIAN, AND MODE + +For each input and reference image region the mean, median, mode, statistic +and an error estimate for that statistic are computed as shown below, +mstat is for mean, median, or mode statistic, emstat stands for the error +estimate, stdev for the measured standard deviation, and npix for the +number of points. + +.nf + mstat = mean, median, or mode + emstat = min (sqrt (mean / gain + readnoise ** 2 / gain ** 2), + stdev / sqrt(npix)) +.fi + +If only a single image region is specified then mstat is used to compute +one of bscale or bzero but not both as shown below. Bscale is computed by +default. + +.nf + bscale = mstat[ref] / mstat[input] + err[bscale] = abs (bscale) * sqrt (emstat[ref] ** 2 / mstat[ref] ** 2 + + emstat[input] ** 2 / mstat[input] ** 2) + bzero = constant + err[bzero] = 0.0 + + bzero = mstat[ref] - mstat[input] + err[bzero] = sqrt (emstat[ref] ** 2 + emstat[input] ** 2) + bscale = constant + err[bscale] = 0.0 +.fi + +If more than one image region is defined then the computed mean, median, +or mode values for the input and reference image regions are used as +shown below to compute the bscale and bzero factors and their errors +using a weighted least squares fit. + +.nf + mstat[ref] = bscale * mstat[input] + bzero +.fi + +If an image region contains data outside the limits defined +by \fIdatamin\fR and \fIdatamax\fR that image region is eliminated +entirely from the fit. + +The parameters \fInreject\fR, \fIloreject\fR, +and \fIhireject\fR are used to detect and automatically eliminate +deviant data points from the final least squares fit. If for some reason +bscale or bzero cannot be fit, default values of 1.0 and 0.0 are +assigned. + +The mean, median, and mode algorithms depend on the global properties of +the image regions. These algorithms do require the reference and +input images to have the same pixel scale and orientation, +but do not automatically require the reference and input images +to have the same point spread function. Small shifts between the reference +and input images can be removed using the \fIshifts\fR, \fIxshift\fR, and +\fIyshift\fR parameters. + +If the image regions contain stars, then either regions should be large +enough to include all the flux of the stars in which case the images +do not have to have the same psf, or the psfs should be the same so +that same portion of the psf is sampled. The best image regions for +matching will contain object and background information. + +FIT + +For each input and reference image the bscale and bzero factors are +computed by doing a pixel to pixel weighted least squares fit of the reference +image counts to the input image counts as shown below. + +.nf + counts[ref] = bscale * counts[input] + bzero + weight = 1.0 / (err[ref] ** 2 + bscale ** 2 * err[input] ** 2) + err[ref] = sqrt (counts[ref] / gain[ref] + readnoise[ref] ** 2 / + gain[ref] ** 2) + err[input] = sqrt (counts[input] / gain[input] + + readnoise[input] ** 2 / gain[input] ** 2) +.fi + +The fitting technique takes into account errors in both the reference and +input image counts and provides an error estimate for the computed bscale +and bzero factors. Bad data are rejected +automatically from the fit by setting the \fIdatamin\fR and \fIdatamax\fR +parameters. Deviant pixels are rejected from the fit by setting the +\fInreject\fR, \fIloreject\fR, and \fIhireject\fR parameters appropriately. + +The final bscale and bzero for the input image are computed by calculating +the average weighted by their errors of the individual bscale and bzero +values. The parameters \fInreject\fR, \fIloreject\fR, and \fIhirject\fR +can be used to automatically detect and reject deviant points. + +The fit algorithm depends on the results of pixel to pixel fits in +each reference and input image region. The technique requires that the +images be spatially registered and psfmatched before it is employed. +Each input and reference image should contain a range of pixel intensities +so that both bscale and bzero can be accurately determined. + +PHOTOMETRY + +For each object common to the reference and input photometry files +the input sky values sky, errors in the sky values serr, +magnitudes mag, and magnitude errors merr are used to compute the +bscale and bzero factors and estimate their errors as shown +below. + +.nf + bscale = 10.0 ** ((mag[ref] - mag[input]) / 2.5) + bzero = sky[ref] - bscale * sky[input] + err[bscale] = 0.4 * log(10.0) * bscale * sqrt (merr[ref] ** 2 + + magerr[input] ** 2)) + err[bzero] = sqrt (serr[ref] ** 2 + err[bscale] ** 2 * + sky[input] ** 2 + bscale ** 2 * sky[input] ** 2) +.fi + +The final bscale and bzero for the input image are computed by calculation +the average of the individual bscale and bzero values weighted by their +errors. The parameters \fInreject\fR, \fIloreject\fR, and \fIhirject\fR can +be used to automatically detect and reject deviant points. + +THE LEAST SQUARES FITTING TECHNIQUE + +The least squares fitting code performs a double linear regression on +the x and y points, taking into account the errors in both x and y. + +The best fitting line is the defined below. + +.nf + y = a * x + b +.fi + +The error ellipses are + +.nf + S = (x - xfit) ** 2 / err[x] ** 2 + (y - yfit) ** 2 / + err[y] ** 2 +.fi + +where S is the quantity to be minimized. Initial values of a and b are +estimated by fitting the data to a straight line assuming uniform +weighting. The best fit values of a and b are then +determined by iterating on the relationship + +.nf + dy = x' * da + db +.fi + +where da and db are corrections to the previously determined values of a and +b and dy and x' are defined as. + +.nf + dy = y - (ax + b) + x' = x + a * err[x] ** 2 * dy / (a ** 2 * err[x] ** 2 + + err[y] ** 2) +.fi + +The new values of the a and b then become. + +.nf + a = a + da + b = b + db +.fi + +.ih +REFERENCES + +A review of doubly weighted linear regression problems in +astronomy can be found in the paper "Linear Regression in Astronomy. II" +by (Feigelson and Babu (1992 Ap.J. 397, 55). A detailed derivation of the +particular solution used by LINMATCH can be found in the article +"The Techniques of Least Squares and Stellar Photometry with CCDs" +by Stetson (1989 Proceeding of the V Advanced School of Astrophysics, +p 51). + +.ih +EXAMPLES + +1. Match the intensity scales of a list of images to a reference +image using a list of stars on the displayed reference image with +the image cursor and the "mean" scaling algorithm. Assume that none +of the stars are saturated and that a radius of 31 pixels is sufficient +to include all the flux from the stars plus some background flux. +Make sure that the correct gain and readout noise values are in the +image headers. + +.nf + cl> display refimage 1 + + cl> rimcursor > objlist + ... mark several candidate stars by moving the cursor to the + star of interest and hitting the space bar key + ... type EOF to terminate the list + + cl> linmatch @imlist refimage objlist lintran.db \ + out=@outlist dnx=31 dny=31 scaling="mean mean" gain=gain \ + readnoise=readnoise +.fi + +2. Repeat the previous command but force the bzero factor to be -100.0 +instead of using the fitted value. + +.nf + cl> linmatch @imlist refimage objlist lintran.db \ + out=@outlist dnx=31 dny=31 scaling="mean -100.0" \ + gain=gain readnoise=rdnoise +.fi + +3. Repeat the first example but compute bscale and bzero +the bscale and bzero values using boxcar smoothed versions of +the input images. Make sure the gain and readout noise are +adjusted appropriately. + +.nf + cl> linmatch @bimlist brefimage objlist lintran.db \ + dnx=31 dny=31 scaling="mean mean" gain=gain \ + readnoise=rdnoise + + cl> linmatch @imlist refimage objlist lintran.db \ + out=@outimlist records=@bimlist scaling="file file" +.fi + +4. Match the intensity of an input image which has been spatially +registered and psfmatched to the reference image using the "fit" algorithm +and a single reference image region. Remove the effects of saturated +pixels by setting datamax to 28000 counts, and the effects of any deviant pixels +by setting nreject, loreject, and hireject to appropriate values. + +.nf + cl> linmatch image refimage [50:150,50:150] lintran.db \ + out=outimage scaling="fit fit" datamax=28000 nreject=3 \ + loreject=3 hireject=3 gain=gain readnoise=rdnoise +.fi + +5. Repeat the previous example but use several image sections to compute +the bscale and bzero values. + +.nf + cl> linmatch image refimage sections lintran.db \ + out=outimage scaling="fit fit" datamax=28000 nreject=3 \ + loreject=3 hireject=3 gain=gain readnoise=rdnoise +.fi + +6. Match the intensity scales of two images using photometry +computed with the apphot package qphot task. The two images are +spatially registered, psfmatched, and the photometry aperture is sufficient to +include all the light from the stars. The filecalc task used to compute +the error in the mean sky is in the addon ctio package. + +.nf + cl> display refimage 1 fi+ + cl> rimcursor > objlist + ... mark several candidate stars by moving the cursor to the + star of interest and hitting the space bar key + ... type EOF to terminate the list + cl> qphot refimage coords=objlist inter- + cl> qphot image coords=objlist inter- + cl> pdump refimage.mag.1 msky,stdev,nsky,mag,merr yes | filecalc \ + STDIN "$1;$2/sqrt($3);$4;$5" > refimage.phot + cl> pdump image.mag.1 msky,stdev,nsky,mag,merr yes | filecalc \ + STDIN "$1;$2/sqrt($3);$4;$5" > image.phot + cl> linmatch image refimage.phot image.phot lintran.db \ + out=outimage scaling="phot phot" nreject=3 loreject=3\ + hireject=3 +.fi + +7. Register two images interactively using the fit algorithms and +five non-overlapping image regions in the sections file. + +.nf + cl> linmatch image refimage sections lintran.db \ + out=outimage scaling="fit fit" datamax=28000 nreject=3 \ + loreject=3 hireject=3 gain=gain readnoise=rdnoise \ + interactive + + + ... a plot of bscale and bzero versus region number + appears + + ... type ? to get a list of the keystroke and : commands + + ... type i to see a plot of the bscale and bzero residuals + versus region + + ... type g to return to the default bscale and bzero versus + region plot + + ... type l to examine plot of the fits and residuals for the + individual regions + ... step forward and back in the regions list with the + space bar and -keys + ... flip back and forth between the fit and residuals + keys with l and i keys + ... return to the main plot by typing q + + ... return to the residuals plot by typing i and delete a + region with a large residual by moving to the + bad point and typing d + + ... type f to recompute the fit + + ... type q to quit the interactive loop, n to go to the + next image or q to quit the task + +.fi + +.ih +TIME REQUIREMENTS +.ih +BUGS +.ih +SEE ALSO +imexpr, imcombine, ctio.filecalc, apphot.qphot, apphot.phot +.endhelp diff --git a/pkg/images/immatch/doc/psfmatch.hlp b/pkg/images/immatch/doc/psfmatch.hlp new file mode 100644 index 00000000..4972700e --- /dev/null +++ b/pkg/images/immatch/doc/psfmatch.hlp @@ -0,0 +1,595 @@ +.help psfmatch Oct94 images.immatch +.ih +NAME +psfmatch -- match the point spread functions of 1 and 2D images +.ih +USAGE +psfmatch input reference psfdata kernel +.ih +PARAMETERS +.ls input +The list of input images to be matched. +.le +.ls reference +The list of reference images to which the input images are to be matched if +\fIconvolution\fR = "image", or the list of reference image psfs if +\fIconvolution\fR = "psf". The reference image psf must be broader than the +input image psf in at least one dimension. +The number of reference images/psfs must be one or equal to the number of +input images. +.le +.ls psfdata +The list of objects used to compute the psf matching function if +\fIconvolution\fR is "image", or the list of input image psfs if +\fIconvolution\fR is "psf". In the former case \fIpsfdata\fR may be: +1) a string containing the x and y coordinates of a single object, +e.g. "51.0 105.0" or 2) the name of a text file containing a list of +objects, and the number of objects +files must equal the number of reference images. In the latter case +the number of input psf images must equal the number of input images. +.le +.ls kernel +The list of input/output psf matching function images to be convolved with the +input images to produce the output images. The number of kernel images +must equal the number of input images. +.le +.ls output = "" +The list of output matched images. If \fIoutput\fR is the NULL string +then the psf matching function is computed for each input image and written to +\fIkernel\fR but no output images are written. If \fIoutput\fR is not NULL +then the number of output images must equal the number of input images. +.le +.ls convolution = "image" +The algorithm used to compute the psf matching function. The options are: +.ls image +The psf matching function is computed directly from the reference and input +image data using the objects specified in \fIpsfdata\fR, the data +regions specified by \fIdnx\fR, \fIdny\fR, \fIpnx\fR, and \fIpny\fR, +and the convolution theorem. +.le +.ls psf +The psf matching function is computed directly from pre-computed +reference and input image psfs using the convolution theorem. +.le +.ls kernel +No psf matching function is computed. Instead the psf matching function +is read from the input image \fIkernel\fR. +.le +.le +.ls dnx = 31, ls dny = 31 +The x and y width of the data region to be extracted around each object. The +data region should be big enough to include both object and sky data. +\fIDnx\fR and \fIdny\fR are not used if \fIconvolution\fR is "psf" or +"kernel". +.le +.ls pnx = 15, pny = 15 +The x and y width of the psf matching function to be computed which must be +less than \fIdnx\fR and \fIdny\fR respectively. The psf +matching function should be kept as small as possible to minimize +the time required to compute the output image. +\fIPnx\fR and \fIPny\fR are not used if \fIconvolution\fR is "psf" or +"kernel". +.le +.ls center = yes +Center the objects in \fIpsfdata\fR before extracting the data from the +input and reference images. Centering should be turned off if the objects +are non-stellar and do not have well-defined centers. +Centering is turned off if \fIconvolution\fR is "psf" or +"kernel". +.le +.ls background = median +The default background function to be subtracted from the input +and reference image data in each object region before the +psf matching function is computed. The background is computed using +data inside the data extraction region defined by \fIdnx\fR and \fIdny\fR +but outside the kernel region defined by \fIpnx\fR and \fIpny\fR. +Background fitting is turned off if \fIconvolution\fR is "psf" or +"kernel". +The options are: +.ls none +no background subtraction is done. +.le +.ls "insky refsky" +the numerical values of insky and refsky are subtracted from the +input and reference image respectively. +.le +.ls mean +the mean of the input and reference image region is computed and subtracted +from the image data. +.le +.ls median +the median of the input and reference image region is computed and subtracted +from the data. +.le +.ls plane +a plane is fit to the input and reference image region and subtracted +from the data. +.le +.le +.ls loreject = INDEF, ls hireject = INDEF +The k-sigma rejection limits for removing the effects of bad data from the +background fit. +.le +.ls apodize = 0.0 +The fraction of the input and reference image data endpoints in x and y +to apodize with a +cosine bell function before the psf matching function is computed. +Apodizing is turned off if \fIconvolution\fR is "psf" or +"kernel". +.le +.ls fluxratio = INDEF +The ratio of the integrated flux of the reference objects to the integrated +flux of the input objects. +By default \fIfluxratio\fR is computed directly from the input data. +.le +.ls filter = "replace" +The filter used to remove high frequency noise from the psf +matching function. Filtering is not performed if \fIconvolution\fR +is "kernel". The options are: +.ls cosbell +apply a cosine bell taper to the psf matching function in frequency space. +.le +.ls replace +replace the high-frequency low signal-to-noise components of the psf matching +function with a gaussian model computed from the low frequency +high signal-to-noise components of the matching function. +.le +.ls model +replace the entire psf matching function with a gaussian model fit to the +low frequency high signal-to-noise components of the matching function. +.le +.le +.ls sx1 = INDEF, sx2 = INDEF, sy1 = INDEF, sy2 = INDEF +The limits of the cosine bell taper in frequency space. Frequency components +inside sx1 and sy1 are unaltered. Frequency components outside sx2 and sy2 +are set to 0.0. By default sx1 and sy1 are set to 0.0, +and sx2 and sy2 are set to the largest frequency present in the data. +.le +.ls radsym = no +Compute a radially symmetric cosine bell function ? +.le +.ls threshold = 0.2 +The low frequency cutoff in fraction of the total input image spectrum +power for the filtering options "replace" and "model". +.le +.ls normfactor = 1.0 +The total power in the computed psf matching function \fIkernel\fR. By default +the psf matching function is normalized. If \fInormfactor\fR +is set to INDEF, then the total power is set to \fIfluxratio\fR. +\fINormfactor\fR is not used if \fIconvolution\fR is set "kernel". +.le +.ls boundary_type = "nearest" +The boundary extension algorithm used to compute the output matched +image. The options are: +.ls nearest +use the value of the nearest boundary pixel. +.le +.ls constant +use a constant value. +.le +.ls reflect +generate a value by reflecting about the boundary. +.le +.ls wrap +generate a value by wrapping around to the opposite side of the image. +.le +.le +.ls constant = 0.0 +The default constant for constant boundary extension. +.le +.ls interactive = no +Compute the psf matching function for each image +interactively using graphics cursor and, optionally, image cursor input. +.le +.ls verbose +Print messages about the progress of the task in non-interactive mode. +.le +.ls graphics = "stdgraph" +The default graphics device. +.le +.ls display = "stdimage" +The default image display device. +.le +.ls gcommands = "" +The default graphics cursor. +.le +.ls icommands = "" +The default image display cursor. +.le + +.ih +DESCRIPTION + +PSFMATCH computes the convolution kernel required to match the +point-spread functions +of the input images \fIinput\fR to the point-spread functions of +the reference images \fIreference\fR using either the image data +or pre-computed psfs and the convolution theorem. +The computed psf matching functions are stored in the \fIkernel\fR images. +If a non-NULL list of output images \fIoutput\fR is +specified the input images are +convolved with the kernel images to produce a list of psf matched output +images. PSFMATCH requires +that the input and reference images be spatially registered +and that the reference images have poorer resolution (broader PSF) +than the input images in at least one dimension. + +If \fIconvolution\fR = "image", the matching function is computed directly +from the input and reference image data using the objects listed in +\fIpsfdata\fR and the convolution theorem as described in the ALGORITHMS +section. \fIpsfdata\fR is interpreted as either: 1) a +string defining the coordinates of a single object e.g. "103.3 189.2" or 2) +the name of a text file containing the coordinates of one or +more objects, one object per line, with the x and y coordinates +in columns 1 and 2 respectively. The object coordinates, the +size of the data region to be extracted \fIdnx\fR +by \fIdny\fR, and the size of the kernel to be computed \fIpnx\fR and +\fIpny\fR, determine +the input and reference image regions used to compute the psf matching +function. +These image regions should be selected with care. Ideal regions +contain a single high signal-to-noise unsaturated star which has no close +neighbors and is well centered on a pixel. + +If \fIcenter\fR is "yes" and \fIconvolution\fR is "image", the objects +in \fIpsfdata\fR are centered before +the data region is extracted. Centering should be on if the objects +are stellar, particularly if their coordinates were read from the image +display cursor. Centering should be off if the objects are non-stellar and +do not have well-defined centers. + +If the \fIbackground\fR fitting algorithm is other than "none" and +\fIconvolution\fR is "image", the background for each object is fit using +data inside the region defined by +\fIdnx\fR and \fIdny\fR but outside the region defined by +\fIpnx\fR by \fIpny\fR. Bad data can be removed from the +background fit by setting the parameters \fIloreject\fR and \fIhireject\fR. +A cosine bell function is applied to the edges of the data region +after background fitting but before computing the psf matching function +if the \fIapodize\fR parameter is > 0.0. + +If \fIpsfdata\fR contains more than one object, the extracted image data +is weighted by the total intensity in the extracted region after +background subtraction, and averaged to produce a single smoothed +data region for each reference and input image. + +If \fIconvolution\fR = "psf", +the psf matching function is computed directly from the input image +and reference +image point-spread functions +using the convolution theorem as described in the ALGORITHMS section. +In this case \fIpsfdata\fR is the list of input image psfs and +\fIreference\fR are the corresponding reference image psfs written by +by some external psf modeling task. +If \fIconvolution\fR is "psf", +centering and background fitting +are assumed to have been performed by the psf modeling task and are not +performed by PSFMATCH. + +PSFMATCH requires that the total power in the psf matching function +before normalization be the ratio +of the integrated flux of the reference image/psf over the integrated +flux of the input image/psf. If \fIfluxratio\fR is INDEF, PSFMATCH +estimates this number internally as described in the ALGORITHMS section, +otherwise the \fIfluxratio\fR is set to the value supplied by the user. + +If \fIconvolution\fR is "kernel", PSFMATCH reads the psf matching function +from the images in \fIkernel\fR which were either +created during a previous run of PSFMATCH or by a separate task. + +PSFMATCH provides several options for filtering out the ill-behaved +noise-dominated high frequency components of the psf matching function +that are produced when the ratio of reference / input image of psf +fourier transforms is taken. + +If \fIfilter\fR is set to "cosbell", a cosine bell function +with a taper defined by \fIsx1\fR, \fIsx2\fR, \fIsy1\fR, and \fIsy2\fR and +symmetry defined by \fRradsym\fR is applied to +the psf matching function in frequency space. This filter +sets all the frequency components greater than \fIsx2\fR and \fIsy2\fR +to 0.0 and leaves all frequency components inside \fIsx1\fR and \fIsy1\fR +unaltered. Users should exercise this option with caution as the effect +of the filtering process can be to significantly +broaden the computed psf matching function as described in the ALGORITHMS +section. + +An alternative approach to dealing with the noisy +high frequency components of the psf +matching function it is to replace them with a reasonable guess. If the +matching function is approximately gaussian then its fourier transform is also +approximately gaussian and the low frequency components can be modeled +reliably with an elliptical gaussian function. The model derived from the low +frequency components of the matching can then be used to replace the high +frequency components. +If \fIfilter\fR is set to "replace", those high frequency components +of the matching function which have less than a fraction +\fIthreshold\fR of their total power in the equivalent high frequency +components of the divisor or input image transform, +are replaced by a model computed by fitting a gaussian to the low frequency +components of the matching function, as described in the ALGORITHMS section. +If \fIfilter\fR = "model" then the entire psf matching function +is replaced with the best fitting gaussian model. + +Another problem can arise during the computation of the psf matching +function . Occasionally it is not possible by means of a single execution +of PSFMATCH to match the reference and input image psfs. An example +of this situation +is the case where the seeing of the reference and input images +was comparable but the declination guiding error in the reference +image was larger than the error in the input image. +In this case input image needs to be convolved to the resolution of +the reference image. However it is also the case +that the guiding error in ra in the input image is greater than the guiding +error in ra in the reference image. In this case the reference image needs +to be convolved to the resolution of the input image along the other axis. +If no corrective action is taken by the task, the +first time PSFMATCH is run the values of the psf matching function along +the ra axis will be greater than the computed fluxratio, resulting in +unrealistic action +along this axis. PSFMATCH avoids this situation by internally limiting +the psf matching function to a maximum value of fluxratio computed as described +above. + +By default the psf matching function is normalized to unit power before +output. This may not be what is desired since if carefully computed the +internally computed quantity a contains information about differences +in exposure time, transparency, etc. If \fInormfactor\fR is set to +a number of INDEF, the total power of the psf matching function will be +set to that value of \fIfluxratio\fR respectively. + +If a list of output images names has been supplied then the computed +psf matching function is applied to the input images to produce +the output images using the boundary extension algorithm +defined by \fIboundary\fR and \fIconstant\fR. + +In non-interactive mode the parameters are set at task startup time and +the input images are processed sequentially. If the \fIverbose\fR flag +is set messages about the progress of the task are printed on he +screen as the task is running. + +In interactive mode the user can mark the regions to be used to compute +the psf matching function on the image display, show/set the data +and algorithm parameters, compute, recompute, and plot the psf matching +function and its accompanying fourier spectrum, and experiment with the +various filtering and modeling options. + +.ih +CURSOR COMMANDS + +The following graphics cursor commands are currently available in +PSFMATCH. + +.nf + Interactive Keystroke Commands + + +? Print help +: Colon commands +k Draw a contour plot of the psf matching kernel +p Draw a contour plot of the psf matching kernel fourier spectrum +x Draw a column plot of the psf matching kernel / fourier spectrum +y Draw a line plot of the psf matching kernel / fourier spectrum +r Redraw the current plot +f Recompute the psf matching kernel +w Update the task parameters +q Exit + + + Colon Commands + + +:mark [file] Mark objects on the display +:show Show current values of the parameters + + + Show/Set Parameters + + +:input [string] Show/set the current input image name +:reference [string] Show/set the current reference image/psf name +:psf [file/string] Show/set the objects/input psf list +:psfimage [string] Show/set the current input psf name +:kernel [string] Show/set the current psf matching kernel name +:output [string] Show/set the current output image name + +:dnx [value] Show/set x width of data region(s) to extract +:dny [value] Show/set y width of data region(s) to extract +:pnx [value] Show/set x width of psf matching kernel +:pny [value] Show/set y width of psf matching kernel +:center [yes/no] Show/set the centering switch +:background [string] Show/set the background fitting function +:loreject [value] Show/set low side k-sigma rejection parameter +:hireject [value] Show/set high side k-sigma rejection parameter +:apodize [value] Show/set percent of endpoints to apodize + +:filter [string] Show/set the filtering algorithm +:fluxratio [value] Show/set the reference/input psf flux ratio +:sx1 [value] Show/set inner x frequency for cosbell filter +:sx2 [value] Show/set outer x frequency for cosbell filter +:sy1 [value] Show/set inner y frequency for cosbell filter +:sy2 [value] Show/set outer y frequency for cosbell filter +:radsym [yes/no] Show/set radial symmetry for cosbell filter +:threshold [value] Show/set %threshold for replace/modeling filter +:normfactor [value] Show/set the kernel normalization factor +.fi + +.ih +ALGORITHMS + +The problem of computing the psf matching function can expressed +via the convolution theorem as shown below. +In the following expressions r is the reference +image data or reference image psf, i is the input image data or input image +psf, k is the unit power psf matching +function, +a is a scale factor specifying the ratio of the total +power in the reference data or psf to the total power in the input data or +psf, * is the convolution operator, and FT is the fourier transform operator. + +.nf + r = ak * d + R = FT (r) + I = FT (i) + aK = R / I + ak = FT (aK) +.fi + +The quantity ak is the desired psf matching function and aK is its fourier +transform. + +If the background was accurately removed from the image or psf data before the +psf matching function was computed, the quantity a is simply the central +frequency component of the computed psf matching function aK as shown below. + +.nf + aK[0,0] = a = sum(r) / sum(i) +.fi + +If the background was not removed from the image or psf data before the +psf matching function was computed the previous expression is not valid. +The computed aK[0,0] will include an offset and a must be estimated +in some other manner. The approach taken by PSFMATCH in this circumstance +is to fit a gaussian model to the absolute value of 1st and 2nd frequencies +of R and I along the x and y axes independently, average the fitted x and y +amplitudes, and set aK[0,0] to the ratio of the resulting fitted amplitudes +as shown below. + +.nf + a = amplitude (R) / amplitude (I) + = (sum(r) - sum(skyr)) / (sum(i) - sum(skyi)) + aK[0,0] = a +.fi + +This approach will work well as long as the image data or psf is reasonably +gaussian but may not work well in arbitrary image regions. If the user is +dissatisfied with either of the techniques described above they can +set aK[0,0] to a pre-determined value of their own. + +If a filter is applied to the computed psf matching function in frequency +space then instead of computing + +.nf + ak = FT (aK) +.fi + +PSFMATCH actually computes + +.nf + ak' = FT (aKF) = ak * f +.fi + +where F is the applied filter in frequency space and f is its +fourier transform. Care should be taken in applying any filter. +For example if F is the step function, then ak' will be the desired kernel +ak convolved with f, a sinc function of frequency 2 * PI / hwidth where +hwidth is the half-width of the step function, and the resulting k' +will be too broad. + +If the user chooses to replace the high frequency components of the psf +matching function with a best guess, PSFMATCH performs the following +steps: + +.nf +1) fits an elliptical gaussian to those frequency components of the fourier +spectrum of aK for which for which the amplitude of I is greater +than threshold * I[0,0] to determine the geometry of the ellipse + +2) uses the fourier shift theorem to preserve the phase information in the +model and solve for any x and y shifts + +3) replace those frequency components of aK for which the fourier spectrum +of I is less than threshold * I[0,0] with the model values + + or alternatively + +replace all of aK with the model values +.fi + +.ih +EXAMPLES + +1. Psf match a list of input images taken at different epochs with variable +seeing conditions to a reference image with the poorest seeing by marking +several high signal-to-noise isolated stars on the displayed reference image +and computing the psf matching function directly from the input and reference +image data. User makes two runs with psfmatch one to compute and check the +kernel images and one to match the images. + +.nf + cl> display refimage 1 fi+ + + cl> rimcursor > objects + + cl> psfmatch @inimlist refimage objects @kernels dnx=31 \ + dny=31 pnx=15 pny=15 + + cl> imstat @kernels + + cl> psfmatch @inlist refimage objects @kernels \ + output=@outlist convolution="kernel" +.fi + +2. Psf match two spectra using a high signal-to-noise portion of the +data in the middle of the spectrum. Since the spectra are registered +spatially and there is little data available for background fitting the +user chooses to turn centering off and set the backgrounds manually. + +.nf + cl> psfmatch inspec refspec "303.0 1.0" kernel \ + output=outspec dnx=31 dny=31 pnx=15 pny=15 center- \ + back="403.6 452.0" +.fi + +3. Psf match two images using psf functions inpsf and refpsf computed with +the daophot package phot/psf/seepsf tasks. Since the kernel is fairly +large use the stsdas fourier package task fconvolve to do the actual +convolution. The boundary extension algorithm in fconvolve is equivalent +to setting the psfmatch boundary extension parameters boundary and +constant to "constant" and "0.0" respectively. + +.nf + cl> psfmatch inimage refpsf inpsf kernel convolution=psf + + cl> fconvolve inimage kernel outimage +.fi + +4. Psf match two images interactively using the image data itself to +compute the psf matching function. + +.nf + cl> psfmatch inimage refimage objects kernel interactive+ + + ... a contour plot of the psf matching function appears + with the graphics cursor ready to accept commands + + ... type x and y to get line and column plots of the psf + matching function at various points and k to return + to the default contour plot + + ... type ? to get a list of the available commands + + ... type :mark to define a new set of objects + + ... type f to recompute the psf matching function using + the new objects + + ... increase the data window to 63 pixels in x and y + with the :dnx 63 and :dny 63 commands, at the + same time increase the psf function size to 31 with + the colon commands :pnx 31 and :pny 31 + + ... type f to recompute the psf matching function using + the new data and kernel windows + + ... type q to quit the task, and q again to verify the previous + q command +.fi + +.ih +TIME REQUIREMENTS +.ih +BUGS +.ih +SEE ALSO +convolve, gauss, stsdas.fconvolve, digiphot.daophot.psf +.endhelp diff --git a/pkg/images/immatch/doc/skymap.hlp b/pkg/images/immatch/doc/skymap.hlp new file mode 100644 index 00000000..b1a4a3fc --- /dev/null +++ b/pkg/images/immatch/doc/skymap.hlp @@ -0,0 +1,642 @@ +.help skymap Dec96 images.immatch +.ih +NAME +skymap -- compute the spatial transformation function required to register +a list of images using celestial coordinate WCS information +.ih +USAGE +skymap input reference database +.ih +PARAMETERS +.ls input +The list of input images containing the input celestial coordinate wcs. +.le +.ls reference +The list of reference images containing the reference celestial coordinate +wcs. The number of reference images must be one or equal to the number +of input images. +.le +.ls database +The name of the output text database file containing the computed +transformations. +.le +.ls transforms = "" +An option transform name list. If transforms is undefined then the +transforms are assigned record names equal to the input image names. +.le +.ls results = "" +Optional output files containing a summary of the results including a +description of the transform geometry and a listing of the input coordinates, +the fitted coordinates, and the fit residuals. The number of results files +must be one or equal to the number of input files. If results is "STDOUT" the +results summary is printed on the standard output. +.le +.ls xmin = INDEF, xmax = INDEF, ymin = INDEF, ymax = INDEF +The minimum and maximum logical x and logical y coordinates used to generate +the grid of reference image control points and define the region of +validity of the spatial transformation. Xmin, xmax, ymin, and +ymax are assigned defaults of 1, the number of columns in the reference +image, 1, and the number of lines in the reference image, respectively. +.le +.ls nx = 10, ny = 10 +The number of points in x and y used to generate the coordinate grid. +.le +.ls wcs = "world" +The world coordinate system of the coordinates. The options are: +.ls physical +Physical coordinates are pixel coordinates which are invariant with +respect to linear transformations of the physical image data. For example, +if the reference +image is a rotated section of a larger input image, the physical +coordinates of an object in the reference image are equal to the physical +coordinates of the same object in the input image, although the logical +pixel coordinates are different. +.le +.ls world +World coordinates are image coordinates which are invariant with +respect to linear transformations of the physical image data and which +are in degrees for all celestial coordinate +systems. Obviously if the +wcs is correct the ra and dec of an object +should remain the same no matter how the image +is linearly transformed. The default world coordinate +system is either 1) the value of the environment variable "defwcs" if +set in the user's IRAF environment (normally it is undefined) and present +in the image header, 2) the value of the "system" +attribute in the image header keyword WAT0_001 if present in the +image header or, 3) the "physical" coordinate system. +.le +.le +.ls xformat = "%10.3f", yformat = "%10.3f" +The format of the output logical x and y reference and input pixel +coordinates in columns 1 and 2 and 3 and 4 respectively. By default the +coordinates are output right justified in a field of ten spaces with +3 digits following the decimal point. +.le +.ls rwxformat = "", rwyformat = "" +The format of the output reference image celestial coordinates +in columns 5 and 6 respectively. The internal default formats will give +reasonable output formats and precision for all celestial coordinate +systems. +.le +.ls wxformat = "", wyformat = "" +The format of the output input image celestial coordinates +in columns 7 and 8 respectively. The internal default formats will give +reasonable output formats and precision for all celestial coordinate +systems. +.le +.ls fitgeometry = "general" +The fitting geometry to be used. The options are the following. +.ls shift +X and y shifts only are fit. +.le +.ls xyscale +X and y shifts and x and y magnification factors are fit. Axis flips are +allowed for. +.le +.ls rotate +X and y shifts and a rotation angle are fit. Axis flips are allowed for. +.le +.ls rscale +X and y shifts, a magnification factor assumed to be the same in x and y, and a +rotation angle are fit. Axis flips are allowed for. +.le +.ls rxyscale +X and y shifts, x and y magnifications factors, and a rotation angle are fit. +Axis flips are allowed for. +.le +.ls general +A polynomial of arbitrary order in x and y is fit. A linear term and a +distortion term are computed separately. The linear term includes an x and y +shift, an x and y scale factor, a rotation and a skew. Axis flips are also +allowed for in the linear portion of the fit. The distortion term consists +of a polynomial fit to the residuals of the linear term. By default the +distortion terms is set to zero. +.le + +For all the fitting geometries except "general" no distortion term is fit, +i.e. the x and y polynomial orders are assumed to be 2 and the cross term +switches are set to "none" regardless of the values of the \fIxxorder\fR, +\fIxyorder\fR, \fIxxterms\fR, \fIyxorder\fR, \fIyyorder\fR and \fIyxterms\fR +parameters set by the user. +.le +.ls function = "polynomial" +The type of analytic coordinate surfaces to be fit. The options are the +following. +.ls legendre +Legendre polynomials in x and y. +.le +.ls chebyshev +Chebyshev polynomials in x and y. +.le +.ls polynomial +Power series polynomials in x and y. +.le +.le +.ls xxorder = 2, xyorder = 2, yxorder = 2, yyorder = 2 +The order of the polynomials in x and y for the x and y fits respectively. +The default order and cross term settings define the linear term in x +and y, where the 6 coefficients can be interpreted in terms of an x and y shift, +an x and y scale change, and rotations of the x and y axes. The "shift", +"xyscale", "rotation", "rscale", and "rxyscale", fitting geometries +assume that the polynomial order parameters are 2 regardless of the values +set by the user. If any of the order parameters are higher than 2 and +\fIfitgeometry\fR is "general", then a distortion surface is fit to the +residuals from the linear portion of the fit. +.le + +.ls xxterms = "half", yxterms = "half" +The options are: +.ls none +The individual polynomial terms contain powers of x or powers of y but not +powers of both. +.le +.ls half +The individual polynomial terms contain powers of x and powers of y, whose +maximum combined power is MAX (xxorder - 1, xyorder - 1) for the x fit and +MAX (yxorder - 1, yyorder - 1) for the y fit. +.le +.ls full +The individual polynomial terms contain powers of x and powers of y, whose +maximum combined power is MAX (xxorder - 1 + xyorder - 1) for the x fit and +MAX (yxorder - 1 + yyorder - 1) for the y fit. +.le + +The "shift", "xyscale", "rotation", "rscale", and "rxyscale" fitting +geometries, assume that the cross term switches are set to "none"regardless +of the values set by the user. If either of the cross terms parameters is +set to "half" or "full" and \fIfitgeometry\fR is "general" then a distortion +surface is fit to the residuals from the linear portion of the fit. +.le + +.ls reject = INDEF +The rejection limit in units of sigma. The default is no rejection. +.le +.ls calctype = "real" +The precision of coordinate transformation calculations. The options are "real" +and "double". +.le +.ls verbose = yes +Print messages about the progress of the task? +.le +.ls interactive = yes +Run the task interactively ? +In interactive mode the user may interact with the fitting process, e.g. +change the order of the fit, delete points, replot the data etc. +.le +.ls graphics = "stdgraph" +The graphics device. +.le +.ls gcommands = "" +The graphics cursor. +.le + +.ih +DESCRIPTION + +SKYMAP computes the spatial transformation function required to map the +celestial coordinate system of the reference image \fIreference\fR to +the celestial coordinate +system of the input image \fIinput\fR, and stores the computed function in +the output text database file \fIdatabase\fR. +The input and reference images may be 1D or 2D but +must have the same dimensionality. The input image and output +text database file can be input to the REGISTER or GEOTRAN tasks to +perform the actual image registration. SKYMAP assumes that the world +coordinate systems in the input and reference +image headers are accurate and that the two systems are compatible, e.g. both +images have a celestial coordinate system WCS. + +SKYMAP computes the required spatial transformation by matching the logical +x and y pixel coordinates of a grid of points +in the input image with the logical x and y pixels coordinates +of the same grid of points in the reference image, +using celestial coordinate information stored in the two image headers. +The coordinate grid consists of \fInx * ny\fR points evenly distributed +over the logical pixel space of interest in the reference image defined by the +\fIxmin\fR, \fIxmax\fR, \fIymin\fR, \fIymax\fR parameters. +The logical x and y reference image pixel coordinates are transformed to +reference image celestial coordinates using +world coordinate information stored in the reference image header. +The reference image celestial coordinates are transformed to +input image celestial coordinates using world coordinate +system information in both the reference and the input image headers. +Finally the input image celestial coordinates are transformed to logical x and y +input image pixel coordinates using world coordinate system information +stored in the input image header. The transformation sequence looks +like the following for an equatorial celestial coordinate system: + +.nf + (x,y) reference -> (ra,dec) reference (reference image wcs) +(ra,dec) reference -> (ra,dec) input (reference and input image wcs) + (ra,dec) input -> (x,y) input (input image wcs) +.fi + +The computed reference and input logical coordinates and the +world coordinates are written to temporary coordinates file which is +deleted on task termination. +The pixel and celestial coordinates are written using +the \fIxformat\fR and \fIyformat\fR and the \fIrwxformat\fR, \fIrwyformat\fR, +\fIwxformat\fR and \fIwxformat\fR +parameters respectively. If these formats are undefined and, in the +case of the celestial coordinates a format attribute cannot be +read from either the reference or the input images, reasonable default +formats are chosen. +If the reference and input images are 1D then all the output logical and +world y coordinates are set to 1. + +SKYMAP computes a spatial transformation of the following form. + +.nf + xin = f (xref, yref) + yin = g (xref, yref) +.fi + +The functions f and g are either a power series polynomial or a Legendre or +Chebyshev polynomial surface of order \fIxxorder\fR and \fIxyorder\fR in x +and \fIyxorder\fR and \fIyyorder\fR in y. + +Several polynomial cross terms options are available. Options "none", +"half", and "full" are illustrated below for a quadratic polynomial in +x and y. + +.nf +xxterms = "none", xyterms = "none" +xxorder = 3, xyorder = 3, yxorder = 3, yyorder = 3 + + xin = a11 + a21 * xref + a12 * yref + + a31 * xref ** 2 + a13 * yref ** 2 + yin = a11' + a21' * xref + a12' * yref + + a31' * xref ** 2 + a13' * yref ** 2 + +xxterms = "half", xyterms = "half" +xxorder = 3, xyorder = 3, yxorder = 3, yyorder = 3 + + xin = a11 + a21 * xref + a12 * yref + + a31 * xref ** 2 + a22 * xref * yref + a13 * yref ** 2 + yin = a11' + a21' * xref + a12' * yref + + a31' * xref ** 2 + a22' * xref * yref + a13' * yref ** 2 + +xxterms = "full", xyterms = "full" +xxorder = 3, xyorder = 3, yxorder = 3, yyorder = 3 + + xin = a11 + a21 * xref + a31 * xref ** 2 + + a12 * yref + a22 * xref * yref + a32 * xref ** 2 * yref + + a13 * yref ** 2 + a23 * xref * yref ** 2 + + a33 * xref ** 2 * yref ** 2 + yin = a11' + a21' * xref + a31' * xref ** 2 + + a12' * yref + a22' * xref * yref + a32' * xref ** 2 * yref + + a13' * yref ** 2 + a23' * xref * yref ** 2 + + a33' * xref ** 2 * yref ** 2 +.fi + +If the \fBfitgeometry\fR parameter is anything other than "general", the +order parameters assume the value 2 and the cross terms switches assume +the value "none", regardless of the values set by the user. The computation +can be done in either real or double precision by setting the \fIcalctype\fR +parameter. Automatic pixel rejection may be enabled by setting the \fIreject\fR +parameter to a positive number other than INDEF. + +The transformation computed by the "general" fitting geometry is arbitrary +and does not necessarily correspond to a physically meaningful model. +However the computed +coefficients for the linear term can be given a simple geometrical geometric +interpretation for all the fitting geometries as shown below. + +.nf + fitting geometry = general (linear term) + xin = a + b * xref + c * yref + yin = d + e * xref + f * yref + + fitting geometry = shift + xin = a + xref + yin = d + yref + + fitting geometry = xyscale + xin = a + b * xref + yin = d + f * yref + + fitting geometry = rotate + xin = a + b * xref + c * yref + yin = d + e * xref + f * yref + b * f - c * e = +/-1 + b = f, c = -e or b = -f, c = e + + fitting geometry = rscale + xin = a + b * xref + c * yref + yin = d + e * xref + f * yref + b * f - c * e = +/- const + b = f, c = -e or b = -f, c = e + + fitting geometry = rxyscale + xin = a + b * xref + c * yref + yin = d + e * xref + f * yref + b * f - c * e = +/- const +.fi + + +The coefficients can be interpreted as follows. Xref0, yref0, xin0, yin0 +are the origins in the reference and input frames respectively. Orientation +and skew are the orientation of the x and y axes and their deviation from +perpendicularity respectively. Xmag and ymag are the scaling factors in x and +y and are assumed to be positive. + +.nf + general (linear term) + xrotation = rotation - skew / 2 + yrotation = rotation + skew / 2 + b = xmag * cos (xrotation) + c = ymag * sin (yrotation) + e = -xmag * sin (xrotation) + f = ymag * cos (yrotation) + a = xin0 - b * xref0 - c * yref0 = xshift + d = yin0 - e * xref0 - f * yref0 = yshift + + shift + xrotation = 0.0, yrotation = 0.0 + xmag = ymag = 1.0 + b = 1.0 + c = 0.0 + e = 0.0 + f = 1.0 + a = xin0 - xref0 = xshift + d = yin0 - yref0 = yshift + + xyscale + xrotation 0.0 / 180.0 yrotation = 0.0 + b = + /- xmag + c = 0.0 + e = 0.0 + f = ymag + a = xin0 - b * xref0 = xshift + d = yin0 - f * yref0 = yshift + + rscale + xrotation = rotation + 0 / 180, yrotation = rotation + mag = xmag = ymag + const = mag * mag + b = mag * cos (xrotation) + c = mag * sin (yrotation) + e = -mag * sin (xrotation) + f = mag * cos (yrotation) + a = xin0 - b * xref0 - c * yref0 = xshift + d = yin0 - e * xref0 - f * yref0 = yshift + + rxyscale + xrotation = rotation + 0 / 180, yrotation = rotation + const = xmag * ymag + b = xmag * cos (xrotation) + c = ymag * sin (yrotation) + e = -xmag * sin (xrotation) + f = ymag * cos (yrotation) + a = xin0 - b * xref0 - c * yref0 = xshift + d = yin0 - e * xref0 - f * yref0 = yshift +.fi + + +\fIXmin\fR, \fIxmax\fR, \fIymin\fR and \fIymax\fR define the region of +validity of the fit as well as the limits of the grid +in the reference coordinate system. These parameters are also used to +reject out of range data before the actual fitting is done. + +Each computed transformation is written to the output file \fIdatabase\fR +in a record whose name is supplied by the user via the \fItransforms\fR +parameter or set to the name of the corresponding input image. +The database file is opened in append mode and new records are written +to the end of the existing file. If more that one record of the same +name is written to the database file, the last record written is the +valid record, i.e. the one that will be used by the REGISTER or +GEOTRAN tasks. + +SKYMAP will terminate with an error if the reference and input images +are not both either 1D or 2D. +If the celestial coordinate system information cannot be read from either +the reference or input image header, the requested transformations +from the celestial <-> logical coordinate systems cannot be compiled for either +or both images, or the celestial coordinate systems of the reference and input +images are fundamentally incompatible in some way, the output logical +reference and input image coordinates are both set to a grid of points +spanning the logical pixel space of the input, not the reference image. +This grid of points defines an identity transformation which will leave +the input image unchanged if applied by the REGISTER or GEOTRAN tasks. + +If \fIverbose\fR is "yes" then messages about the progress of the task +as well as warning messages indicating potential problems are written to +the standard output. If \fIresults\fR is set to a file name then the input +coordinates, the fitted coordinates, and the residuals of the fit are +written to that file. + +SKYMAP may be run interactively by setting the \fIinteractive\fR +parameter to "yes". +In interactive mode the user has the option of viewing the fit, changing the +fit parameters, deleting and undeleting points, and replotting +the data until a satisfactory +fit has been achieved. + +.ih +CURSOR COMMANDS + +In interactive mode the following cursor commands are currently available. + +.nf + Interactive Keystroke Commands + +? Print options +f Fit the data and graph with the current graph type (g, x, r, y, s) +g Graph the data and the current fit +x,r Graph the x fit residuals versus x and y respectively +y,s Graph the y fit residuals versus x and y respectively +d,u Delete or undelete the data point nearest the cursor +o Overplot the next graph +c Toggle the constant x, y plotting option +t Plot a line of constant x, y through the nearest data point +l Print xshift, yshift, xmag, ymag, xrotate, yrotate +q Exit the interactive curve fitting +.fi + +The parameters listed below can be changed interactively with simple colon +commands. Typing the parameter name alone will list the current value. + +.nf + Colon Parameter Editing Commands + +:show List parameters +:fitgeometry Fitting geometry (shift,xyscale,rotate, + rscale,rxyscale,general) +:function [value] Fitting function (chebyshev,legendre, + polynomial) +:xxorder :xyorder [value] X fitting function xorder, yorder +:yxorder :yyorder [value] Y fitting function xorder, yorder +:xxterms :yxterms [n/h/f] X, Y fit cross terms type +:reject [value] Rejection threshold +.fi + + +.ih +FORMATS + +A format specification has the form "%w.dCn", where w is the field +width, d is the number of decimal places or the number of digits of +precision, C is the format code, and n is radix character for +format code "r" only. The w and d fields are optional. The format +codes C are as follows: + +.nf +b boolean (YES or NO) +c single character (c or '\c' or '\0nnn') +d decimal integer +e exponential format (D specifies the precision) +f fixed format (D specifies the number of decimal places) +g general format (D specifies the precision) +h hms format (hh:mm:ss.ss, D = no. decimal places) +m minutes, seconds (or hours, minutes) (mm:ss.ss) +o octal integer +rN convert integer in any radix N +s string (D field specifies max chars to print) +t advance To column given as field W +u unsigned decimal integer +w output the number of spaces given by field W +x hexadecimal integer +z complex format (r,r) (D = precision) + + + +Conventions for w (field width) specification: + + W = n right justify in field of N characters, blank fill + -n left justify in field of N characters, blank fill + 0n zero fill at left (only if right justified) +absent, 0 use as much space as needed (D field sets precision) + +Escape sequences (e.g. "\n" for newline): + +\b backspace (not implemented) +\f formfeed +\n newline (crlf) +\r carriage return +\t tab +\" string delimiter character +\' character constant delimiter character +\\ backslash character +\nnn octal value of character + +Examples + +%s format a string using as much space as required +%-10s left justify a string in a field of 10 characters +%-10.10s left justify and truncate a string in a field of 10 characters +%10s right justify a string in a field of 10 characters +%10.10s right justify and truncate a string in a field of 10 characters + +%7.3f print a real number right justified in floating point format +%-7.3f same as above but left justified +%15.7e print a real number right justified in exponential format +%-15.7e same as above but left justified +%12.5g print a real number right justified in general format +%-12.5g same as above but left justified + +%h format as nn:nn:nn.n +%15h right justify nn:nn:nn.n in field of 15 characters +%-15h left justify nn:nn:nn.n in a field of 15 characters +%12.2h right justify nn:nn:nn.nn +%-12.2h left justify nn:nn:nn.nn + +%H / by 15 and format as nn:nn:nn.n +%15H / by 15 and right justify nn:nn:nn.n in field of 15 characters +%-15H / by 15 and left justify nn:nn:nn.n in field of 15 characters +%12.2H / by 15 and right justify nn:nn:nn.nn +%-12.2H / by 15 and left justify nn:nn:nn.nn + +\n insert a newline +.fi + +.ih +REFERENCES + +Additional information on IRAF world coordinate systems including +more detailed descriptions of the "logical", "physical", and "world" +coordinate systems can be found in the help pages for the WCSEDIT +and WCRESET tasks. Detailed documentation for the IRAF world +coordinate system interface MWCS can be found in the file +"iraf$sys/mwcs/MWCS.hlp". This file can be formatted and printed +with the command "help iraf$sys/mwcs/MWCS.hlp fi+ | lprint". + +Details of the FITS header world coordinate system interface can +be found in the draft paper "World Coordinate Systems Representations Within the +FITS Format" by Hanisch and Wells, available from the iraf anonymous ftp +archive and the draft paper which supersedes it "Representations of Celestial +Coordinates in FITS" by Greisen and Calabretta available from the NRAO +anonymous ftp archives. + +The spherical astronomy routines employed here are derived from the Starlink +SLALIB library provided courtesy of Patrick Wallace. These routines +are very well documented internally with extensive references provided +where appropriate. Interested users are encouraged to examine the routines +for this information. Type "help slalib" to get a listing of the SLALIB +routines, "help slalib opt=sys" to get a concise summary of the library, +and "help <routine>" to get a description of each routine's calling sequence, +required input and output, etc. An overview of the library can be found in the +paper "SLALIB - A Library of Subprograms", Starlink User Note 67.7 +by P.T. Wallace, available from the Starlink archives. + +.ih +EXAMPLES + +1. Compute the spatial transformation required to match a radio image to an +X-ray image of the same field using a 100 point coordinate grid +and a simple linear transformation. Both images have accurate sky +equatorial world coordinate systems define at different equinoxes. +Print the output world coordinates +in the coords file in hh:mm:ss.ss and dd:mm:ss.s format. Run geotran +on the results to do the actual registration. + +.nf + cl> skymap radio xray geodb rwxformat=%12.2H rwyformat=%12.1h \ + wxformat=%12.2H wyformat=%12.1h interactive- + + cl> geotran radio radio.tran geodb radio +.fi + +2. Repeat the previous command but begin with a higher order fit +and run the task in interactive mode in order to examine the fit +residuals. + +.nf + cl> skymap radio xray geodb rwxformat=%12.2H rwyformat=%12.1h \ + wxformat=%12.2H wyformat=%12.1h xxo=4 xyo=4 xxt=half \ + yxo=4 yyo=4 yxt=half + + ... a plot of the fit appears + + ... type x and r to examine the residuals of the x + surface fit versus x and y + + ... type y and s to examine the residuals of the y + surface fit versus x and y + + ... delete 2 deviant points with the d key and + recompute the fit with the f key + + ... type q to quit and save the fit + + cl> geotran radio radio.tran geodb radio +.fi + +3. Repeat example 1 but set the transform name specifically. + +.nf + cl> skymap radio xray geodb trans=m82 rwxformat=%12.2H \ + rwyformat=%12.1h wxformat=%12.2H wyformat=%12.1h \ + interactive- + + cl> geotran radio radio.tran geodb m82 +.fi + +.ih +TIME REQUIREMENTS +.ih +BUGS +.ih +SEE ALSO +wcsctran,register,geotran +.endhelp diff --git a/pkg/images/immatch/doc/skyxymatch.hlp b/pkg/images/immatch/doc/skyxymatch.hlp new file mode 100644 index 00000000..63485284 --- /dev/null +++ b/pkg/images/immatch/doc/skyxymatch.hlp @@ -0,0 +1,406 @@ +.help skyxymatch Dec96 images.immatch +.ih +NAME +skyxymatch -- match input and reference image x-y coordinates using the +celestial coordinate WCS +.ih +USAGE +skyxymatch input reference output +.ih +PARAMETERS +.ls input +The list of input images containing the input celestial coordinate wcs. +.le +.ls reference +The list of reference images containing the reference celestial coordinate +wcs. The number of reference images must be one or equal to the number +of input images. +.le +.ls output +The output matched coordinate lists containing: +1) the logical x-y pixel coordinates of a point +in the reference image in columns 1 and 2, 2) the logical x-y pixel +coordinates of the same point in the input image in columns 3 and 4, +3) the world coordinates of the point in the reference image in columns +5 and 6, and 4) the world coordinate of the point in the input image in +columns 7 and 8. The output coordinate list can be +input directly to the geomap task. The number of output files must be +equal to the number of input images or be the standard output STDOUT. +.le +.ls coords = "grid" +The source of the coordinate list. The options are: +.ls grid +Generate a list of \fInx * ny\fR coordinates evenly spaced over +the reference image, and beginning and ending at logical coordinates +\fIxmin\fR and \fIxmax\fR in x and \fIymin\fR and \fIymax\fR in y. +.le +.ls <filename> +The name of the text file containing the world coordinates of a set of +points in the reference image. +.le +.le +.ls xmin = INDEF, xmax = INDEF, ymin = INDEF, ymax = INDEF +The minimum and maximum logical x and logical y coordinates used to generate +the grid of control points if \fIcoords\fR = "grid". Xmin, xmax, ymin, and +ymax default to 1, the number of columns in the reference image, 1, and the +number of lines in the reference image, respectively. +.le +.ls nx = 10, ny = 10 +The number of points in x and y used to generate the coordinate grid +if \fIcoords\fR = "grid". +.le +.ls wcs = "world" +The world coordinate system of the coordinates. The options are: +.ls physical +Physical coordinates are pixel coordinates which are invariant with +respect to linear transformations of the physical image data. For example, +if the reference +image is a rotated section of a larger input image, the physical +coordinates of an object in the reference image are equal to the physical +coordinates of the same object in the input image, although the logical +pixel coordinates are different. +.le +.ls world +World coordinates are image coordinates which are invariant with +respect to linear transformations of the physical image data and which +are in decimal degrees for the celestial coordinate systems. Obviously if the +wcs is correct the ra and dec of an object +should remain the same no matter how the image +is linearly transformed. The default world coordinate +system is either 1) the value of the environment variable "defwcs" if +set in the user's IRAF environment (normally it is undefined) and present +in the image header, 2) the value of the "system" +attribute in the image header keyword WAT0_001 if present in the +image header or, 3) the "physical" coordinate system. +Care must be taken that the wcs of the input and +reference images are compatible, e.g. it makes no sense to +match the coordinates of a 2D sky projection and a 2D spectral wcs. +.le +.le +.ls xcolumn = 1, ycolumn = 2 +The columns in the input coordinate list containing the x and y coordinate +values if \fIcoords\fR = <filename>. +.le +.ls xunits = "", ls yunits = "" +The units of the x and y coordinates in the input coordinate list +if \fIcoords\fR = <filename>, by default decimal degrees for celestial +coordinate systems, otherwise any units. +The options are: +.ls hours +Input coordinates specified in hours are converted to decimal degrees by +multiplying by 15.0. +.le +.ls native +The internal units of the wcs. No conversions on the input coordinates +are performed. +.le + +If the units are not specified the default is "native". +.le +.ls xformat = "%10.3f", yformat = "%10.3f" +The format of the output logical x and y reference and input pixel +coordinates in columns 1 and 2 and 3 and 4 respectively. By default the +coordinates are output right justified in a field of ten spaces with +3 digits following the decimal point. +.le +.ls rwxformat = "", rwyformat = "" +The format of the output world x and y reference image coordinates +in columns 5 and 6 respectively. The internal default formats will give +reasonable output formats and precision for sky projection coordinates. +.le +.ls wxformat = "", wyformat = "" +The format of the output world x and y input image coordinates +in columns 7 and 8 respectively. The internal default formats will give +reasonable output formats and precision for sky projection coordinates. +.le +.ls min_sigdigits = 7 +The minimum precision of the output coordinates if, the formatting parameters +are undefined, or the output world coordinate system is "world" and the wcs +cannot be decoded. +.le +.ls verbose = yes +Print messages about the progress of the task? +.le + +.ih +DESCRIPTION + +SKYXYMATCH matches the logical x and y pixel coordinates of a set of points +in the input image \fIinput\fR with the logical x and y pixels coordinates +of the same points in the reference image \fIreference\fR +using world celestial coordinate information +in the image headers. SKYXYMATCH writes its results to the +coordinate file \fIoutput\fR which is suitable for input to the GEOMAP task. +The input and reference images may be 1D or 2D but must both have +the same dimensionality. + +If \fIcoords\fR = "grid", SKYXYMATCH computes a grid of \fInx * ny\fR +logical x and y pixel coordinates evenly distributed over the +logical pixel space of the reference image defined by the +\fIxmin\fR, \fIxmax\fR, \fIymin\fR, \fIymax\fR parameters. +The logical x and y reference image pixel coordinates are transformed to +reference image celestial coordinates using +world coordinate information stored in the reference image header. +The reference image celestial coordinates are transformed to +input image celestial coordinates using world coordinate +system information in both the reference and the input image headers. +Finally the input image celestial coordinates are transformed to logical x and y +input image pixel coordinates using world coordinate system information +stored in the input image header. The transformation sequence looks +like the following for an equatorial celestial coordinate system: + +.nf + (x,y) reference -> (ra,dec) reference (reference image wcs) +(ra,dec) reference -> (ra,dec) input (reference and input image wcs) + (ra,dec) input -> (x,y) input (input image wcs) +.fi + +The reference and input image celestial coordinate systems +may be equatorial, ecliptic, galactic, or supergalactic. The equatorial systems +may be one of: 1) the mean place pre-IAU 1976 (FK4) system, 2) +the same as FK4 but without the E-terms (FK4-NO-E) system, 3) the mean +place post-IAU +1976 (FK5) system, 4) or the geocentric apparent place in the post-IAU 1976 +(GAPPT) system. + +SKYXYMATCH assumes that the celestial coordinate system is specified by the FITS +keywords CTYPE, CRPIX, CRVAL, CD (or alternatively CDELT / CROTA), RADECSYS, +EQUINOX (or EPOCH), MJD-WCS (or MJD-OBS, or DATE-OBS). USERS SHOULD TAKE NOTE +THAT MJD-WCS IS CURRENTLY NEITHER A STANDARD OR A PROPOSED STANDARD FITS +KEYWORD. HOWEVER IT OR SOMETHING SIMILAR, IS REQUIRED TO SPECIFY THE EPOCH OF +THE COORDINATE SYSTEM WHICH MAY BE DIFFERENT FROM THE EPOCH OF THE OBSERVATION. + +The first four characters of the values of the ra / longitude and dec / latitude +axis CTYPE keywords specify the celestial coordinate system. The currently +permitted values of CTYPE[1:4] are RA-- / DEC- for equatorial coordinate +systems, ELON / ELAT for the ecliptic coordinate system, GLON / GLAT for the +galactic coordinate system, and SLON / SLAT for the supergalactic coordinate +system. + +The second four characters of the values of the ra / longitude and dec / +latitude axis CTYPE keywords specify the sky projection geometry. IRAF +currently supports the TAN, SIN, ARC, and GLS geometries, and consequently the +currently permitted values of CTYPE[5:8] are -TAN, -ARC, -SIN, and -GLS. +SKYXYMATCH fully supports the TAN, SIN, and ARC projections, but does not fully +support the GLS projection. + +If the image celestial coordinate systems are equatorial, the value of the +RADECSYS keyword specifies which fundamental equatorial system is to be +considered. The permitted values of RADECSYS are FK4, FK4-NO-E, FK5, and GAPPT. +If the RADECSYS keyword is not present in the image header, the values of the +EQUINOX / EPOCH keywords (in that order of precedence) are used to determine +the fundamental equatorial coordinate system. EQUINOX or EPOCH contain the +epoch of the mean place and equinox for the FK4, FK4-NO-E, and FK5 systems +(e.g 1950.0 or 2000.0). The default equatorial system is FK4 if EQUINOX or +EPOCH < 1984.0, FK5 if EQUINOX or EPOCH >= 1984.0, and FK5 if RADECSYS, EQUINOX, +and EPOCH are undefined. If RADECSYS is defined but EQUINOX and EPOCH are not, +the equinox defaults to 1950.0 for the FK4 and FK4-NO-E systems, and 2000.0 for +the FK5 system. The equinox value is interpreted as a Besselian epoch for the +FK4 and FK4-NO-E systems, and as a Julian epoch for the FK5 system. Users are +strongly urged to use the EQUINOX keyword in preference to the EPOCH keyword, +if they must enter their own equinox values into the image header. The FK4 and +FK4-NO-E systems are not inertial and therefore also require the epoch of the +observation (the time when the mean place was correct), in addition to the +equinox. The epoch is specified, in order of precedence, by the values of the +keywords MJD-WCS or MJD-OBS (which contain the modified Julian date, JD - +2400000.5, of the coordinate system), or the DATE-OBS keyword (which contains +the date of the observation in the form DD/MM/YY, CCYY-MM-DD, +CCYY-MM-DDTHH:MM:SS.S). As the latter quantity is +only accurate to a day, the MJD-WCS or MJD-OBS specification is preferred. +If all 3 keywords are absent the epoch defaults to the value of equinox. +Equatorial coordinates in the GAPPT system require only the specification +of the epoch of observation which is supplied via the MJD-WCS, MJD-OBS, +or DATE-OBS keywords (in that order of precedence) as for the FK4 and +FK4-NO-E system. + +If the image celestial coordinate systems are ecliptic the mean ecliptic +and equinox of date are required. These are read from the MJD-WCS, MJD-OBS, +or DATE-OBS keywords (in that order or precedence) as for the equatorial FK4, +FK4-NO-E, and GAPPT systems. + +USERS NEED TO BE AWARE THAT THE IRAF IMAGE WORLD COORDINATE SYSTEM +CURRENTLY (IRAF VERSIONS 2.10.4 PATCH 2 AND EARLIER) SUPPORTS ONLY THE +EQUATORIAL SYSTEM (CTYPE<lngax> = "RA--XXXX" CTYPE<latax> = "DEC-XXXX") +WHERE XXXX IS THE PROJECTION TYPE, EVEN THOUGH THE SKYXYMATCH TASK +SUPPORTS GALACTIC, SUPERGALACTIC, AND ECLIPTIC coordinate systems. + +If \fIcoords\fR is a file name, SKYXYMATCH reads a list of x and y +reference image world coordinates from columns \fIxcolumn\fR and \fIycolumn\fR +in the input coordinates file and transforms these coordinates to +"native" coordinate units using the \fIxunits\fR and \fIyunits\fR parameters. +The reference image world coordinates are +transformed to logical reference and input image coordinates +using the value of the \fIwcs\fR parameter and world coordinate +information in the reference and input image headers. + +SKYXYMATCH will terminate with an error if the reference and input images +are not both either 1D or 2D. +If the world coordinate system information cannot be read from either +the reference or input image header, the requested transformations +from the world <-> logical coordinate systems cannot be compiled for either +or both images, or the world coordinate systems of the reference and input +images are fundamentally incompatible in some way, the output logical +reference and input image coordinates are both set to a grid of points +spanning the logical pixel space of the input, not the reference image, +and defining an identify transformation, is written to the output file. + +The computed reference and input logical and world coordinates +are written to the output file using +the \fIxformat\fR and \fIyformat\fR, \fIrwxformat\fr, \fIrwyformat\fR, +and the \fIwxformat\fR and \fIwxformat\fR +parameters respectively. If these formats are undefined and, in the +case of the world coordinates, a format attribute cannot be +read from either the reference or the input images reasonable defaults are +chosen. + +If the reference and input images are 1D then the +output logical and world y coordinates are +set to 1. + +If \fIverbose\fR is "yes" then a title section is written to the output +file for each set of computed coordinates, along with messages about +what if anything went wrong with the computation. + +.ih +FORMATS + +A format specification has the form "%w.dCn", where w is the field +width, d is the number of decimal places or the number of digits of +precision, C is the format code, and n is radix character for +format code "r" only. The w and d fields are optional. The format +codes C are as follows: + +.nf +b boolean (YES or NO) +c single character (c or '\c' or '\0nnn') +d decimal integer +e exponential format (D specifies the precision) +f fixed format (D specifies the number of decimal places) +g general format (D specifies the precision) +h hms format (hh:mm:ss.ss, D = no. decimal places) +m minutes, seconds (or hours, minutes) (mm:ss.ss) +o octal integer +rN convert integer in any radix N +s string (D field specifies max chars to print) +t advance To column given as field W +u unsigned decimal integer +w output the number of spaces given by field W +x hexadecimal integer +z complex format (r,r) (D = precision) + + + +Conventions for w (field width) specification: + + W = n right justify in field of N characters, blank fill + -n left justify in field of N characters, blank fill + 0n zero fill at left (only if right justified) +absent, 0 use as much space as needed (D field sets precision) + +Escape sequences (e.g. "\n" for newline): + +\b backspace (not implemented) +\f formfeed +\n newline (crlf) +\r carriage return +\t tab +\" string delimiter character +\' character constant delimiter character +\\ backslash character +\nnn octal value of character + +Examples + +%s format a string using as much space as required +%-10s left justify a string in a field of 10 characters +%-10.10s left justify and truncate a string in a field of 10 characters +%10s right justify a string in a field of 10 characters +%10.10s right justify and truncate a string in a field of 10 characters + +%7.3f print a real number right justified in floating point format +%-7.3f same as above but left justified +%15.7e print a real number right justified in exponential format +%-15.7e same as above but left justified +%12.5g print a real number right justified in general format +%-12.5g same as above but left justified + +%h format as nn:nn:nn.n +%15h right justify nn:nn:nn.n in field of 15 characters +%-15h left justify nn:nn:nn.n in a field of 15 characters +%12.2h right justify nn:nn:nn.nn +%-12.2h left justify nn:nn:nn.nn + +%H / by 15 and format as nn:nn:nn.n +%15H / by 15 and right justify nn:nn:nn.n in field of 15 characters +%-15H / by 15 and left justify nn:nn:nn.n in field of 15 characters +%12.2H / by 15 and right justify nn:nn:nn.nn +%-12.2H / by 15 and left justify nn:nn:nn.nn + +\n insert a newline +.fi + +.ih +REFERENCES + +Additional information on IRAF world coordinate systems including +more detailed descriptions of the "logical", "physical", and "world" +coordinate systems can be found in the help pages for the WCSEDIT +and WCRESET tasks. Detailed documentation for the IRAF world +coordinate system interface MWCS can be found in the file +"iraf$sys/mwcs/MWCS.hlp". This file can be formatted and printed +with the command "help iraf$sys/mwcs/MWCS.hlp fi+ | lprint". + +Details of the FITS header world coordinate system interface can +be found in the draft paper "World Coordinate Systems Representations Within the +FITS Format" by Hanisch and Wells, available from the iraf anonymous ftp +archive and the draft paper which supersedes it "Representations of Celestial +Coordinates in FITS" by Greisen and Calabretta available from the NRAO +anonymous ftp archives. + +The spherical astronomy routines employed here are derived from the Starlink +SLALIB library provided courtesy of Patrick Wallace. These routines +are very well documented internally with extensive references provided +where appropriate. Interested users are encouraged to examine the routines +for this information. Type "help slalib" to get a listing of the SLALIB +routines, "help slalib opt=sys" to get a concise summary of the library, +and "help <routine>" to get a description of each routine's calling sequence, +required input and output, etc. An overview of the library can be found in the +paper "SLALIB - A Library of Subprograms", Starlink User Note 67.7 +by P.T. Wallace, available from the Starlink archives. + +.ih +EXAMPLES + +1. Compute a matched list of 100 logical x and y coordinates for an X-ray +and radio image of the same field, both of which have accurate sky +projection world coordinate systems with different equinoxes. Print the +output world coordinates in hh:mm:ss.ss and dd:mm:ss.s format + +.nf + cl> skyxymatch image refimage coords rwxformat=%12.2H \ + rwyformat=%12.1h wxformat=%12.2H wyformat=%12.1h +.fi + +2. Given a list of ras and decs of objects in the reference image, +compute a list of matched logical x and y coordinates for the two images, +both of which have a accurate sky projection wcss, although the reference +wcs is in equatorial coordinates and the input wcs is in galactic +coordinates. The ras and decs are in +columns 3 and 4 of the input coordinate file and are in hh:mm:ss.ss and +dd:mm:ss.s format respectively. Print the output world coordinates +in the same units as the input. + +.nf + cl> skyxymatch image refimage coords coords=radecs \ + xcolumn=3 ycolumn=4 xunits=hours rwxformat=%12.2H \ + rwyformat=%12.1h wxformat=%12.2H wyformat=%12.1h +.fi + +.ih +TIME REQUIREMENTS +.ih +BUGS +.ih +SEE ALSO +skyctran,wcsctran,geomap,geotran,skymap,sregister +.endhelp diff --git a/pkg/images/immatch/doc/sregister.hlp b/pkg/images/immatch/doc/sregister.hlp new file mode 100644 index 00000000..5bc829c5 --- /dev/null +++ b/pkg/images/immatch/doc/sregister.hlp @@ -0,0 +1,779 @@ +.help sregister Dec98 images.immatch +.ih +NAME +sregister -- register a list of images to a reference image using celestial +coordinate WCS information +.ih +USAGE +sregister input reference output +.ih +PARAMETERS +.ls input +The list of input images containing the input celestial coordinate wcs. +.le +.ls reference +The list of reference images containing the reference celestial coordinate wcs. +The number of reference images must be one or equal to the number of +input images. +.le +.ls output +The list of output registered images. The number of output images must +be equal to the number of input images. +.le +.ls xmin = INDEF, xmax = INDEF, ymin = INDEF, ymax = INDEF +The minimum and maximum logical x and logical y coordinates used to, generate +the grid of reference image control points, define the region of validity of +the spatial transformation, and define the extent of the output image. +Xmin, xmax, ymin, and +ymax are assigned defaults of 1, the number of columns in the reference +image, 1, and the number of lines in the reference image, respectively. +.le +.ls nx = 10, ny = 10 +The number of points in x and y used to generate the coordinate grid. +.le +.ls wcs = "world" +The world coordinate system of the coordinates. The options are: +.ls physical +Physical coordinates are pixel coordinates which are invariant with +respect to linear transformations of the physical image data. For example, +if the reference +image is a rotated section of a larger input image, the physical +coordinates of an object in the reference image are equal to the physical +coordinates of the same object in the input image, although the logical +pixel coordinates are different. +.le +.ls world +World coordinates are image coordinates which are invariant with +respect to linear transformations of the physical image data and which +are in decimal degrees for celestial coordinate systems. Obviously if the +wcs is correct the ra and dec of an object +should remain the same no matter how the image +is linearly transformed. The default world coordinate +system is either 1) the value of the environment variable "defwcs" if +set in the user's IRAF environment (normally it is undefined) and present +in the image header, 2) the value of the "system" +attribute in the image header keyword WAT0_001 if present in the +image header or, 3) the "physical" coordinate system. +Care must be taken that the wcs of the input and +reference images are compatible, e.g. it makes no sense to +match the coordinates of a 2D sky projection and a 2D spectral wcs. +.le +.le +.ls xformat = "%10.3f", yformat = "%10.3f" +The format of the output logical x and y reference and input pixel +coordinates in columns 1 and 2 and 3 and 4 respectively. By default the +coordinates are output right justified in a field of ten spaces with +3 digits following the decimal point. +.le +.ls rwxformat = "", rwyformat = "" +The format of the output world x and y reference image coordinates +in columns 5 and 6 respectively. The internal default formats will give +reasonable output formats and precision for celestial coordinate +systems. +.le +.ls wxformat = "", wyformat = "" +The format of the output world x and y input image coordinates +in columns 7 and 8 respectively. The internal default formats will give +reasonable output formats and precision for celestial coordinate +systems. +.le +.ls fitgeometry = "general" +The fitting geometry to be used. The options are the following. +.ls shift +X and y shifts only are fit. +.le +.ls xyscale +X and y shifts and x and y magnification factors are fit. Axis flips are +allowed for. +.le +.ls rotate +X and y shifts and a rotation angle are fit. Axis flips are allowed for. +.le +.ls rscale +X and y shifts, a magnification factor assumed to be the same in x and y, and a +rotation angle are fit. Axis flips are allowed for. +.le +.ls rxyscale +X and y shifts, x and y magnifications factors, and a rotation angle are fit. +Axis flips are allowed for. +.le +.ls general +A polynomial of arbitrary order in x and y is fit. A linear term and a +distortion term are computed separately. The linear term includes an x and y +shift, an x and y scale factor, a rotation and a skew. Axis flips are also +allowed for in the linear portion of the fit. The distortion term consists +of a polynomial fit to the residuals of the linear term. By default the +distortion terms is set to zero. +.le + +For all the fitting geometries except "general" no distortion term is fit, +i.e. the x and y polynomial orders are assumed to be 2 and the cross term +switches are set to "none", regardless of the values of the \fIxxorder\fR, +\fIxyorder\fR, \fIxxterms\fR, \fIyxorder\fR, \fIyyorder\fR and \fIyxterms\fR +parameters set by the user. +.le +.ls function = "polynomial" +The type of analytic coordinate surfaces to be fit. The options are the +following: +.ls legendre +Legendre polynomials in x and y. +.le +.ls chebyshev +Chebyshev polynomials in x and y. +.le +.ls polynomial +Power series polynomials in x and y. +.le +.le +.ls xxorder = 2, xyorder = 2, yxorder = 2, yyorder = 2 +The order of the polynomials in x and y for the x and y fits respectively. +The default order and cross term settings define the linear term in x +and y, where the 6 coefficients can be interpreted in terms of an x and y shift, +an x and y scale change, and rotations of the x and y axes. The "shift", +"xyscale", "rotation", "rscale", and "rxyscale", fitting geometries +assume that the polynomial order parameters are 2 regardless of the values +set by the user. If any of the order parameters are higher than 2 and +\fIfitgeometry\fR is "general", then a distortion surface is fit to the +residuals from the linear portion of the fit. +.le +.ls xxterms = "half", yxterms = "half" +The options are: +.ls none +The individual polynomial terms contain powers of x or powers of y but not +powers of both. +.le +.ls half +The individual polynomial terms contain powers of x and powers of y, whose +maximum combined power is MAX (xxorder - 1, xyorder - 1) for the x fit and +MAX (yxorder - 1, yyorder - 1) for the y fit. +.le +.ls full +The individual polynomial terms contain powers of x and powers of y, whose +maximum combined power is MAX (xxorder - 1 + xyorder - 1) for the x fit and +MAX (yxorder - 1 + yyorder - 1) for the y fit. +.le + +The "shift", "xyscale", "rotation", "rscale", and "rxyscale" fitting +geometries, assume that the cross term switches are set to "none"regardless +of the values set by the user. If either of the cross terms parameters is +set to "half" or "full" and \fIfitgeometry\fR is "general" then a distortion +surface is fit to the residuals from the linear portion of the fit. +.le + +.ls reject = INDEF +The rejection limit in units of sigma. The default is no rejection. +.le +.ls calctype = "real" +The precision of coordinate transformation calculations. The options are "real" +and "double". +.le +.ls geometry = "geometric" +The type of geometric transformation. The options are: +.ls linear +Perform only the linear part of the geometric transformation. +.le +.ls geometric +Compute both the linear and distortion portions of the geometric correction. +.le +.le +.ls xsample = 1.0, ysample = 1.0 +The coordinate surface subsampling factor. The coordinate surfaces are +evaluated at every xsample-th pixel in x and every ysample-th pixel in y. +Transformed coordinates at intermediate pixel values are determined by +bilinear interpolation in the coordinate surfaces. If the coordinate +surface is of high order setting these numbers to some reasonably high +value is recommended. +.le +.ls interpolant = "linear" +The interpolant used for rebinning the image. The choices are the following. +.ls nearest +Nearest neighbor. +.le +.ls linear +Bilinear interpolation in x and y. +.le +.ls poly3 +Third order polynomial in x and y. +.le +.ls poly5 +Fifth order polynomial in x and y. +.le +.ls spline3 +Bicubic spline. +.le +.ls sinc +2D sinc interpolation. Users can specify the sinc interpolant width by +appending a width value to the interpolant string, e.g. sinc51 specifies +a 51 by 51 pixel wide sinc interpolant. The sinc width will be rounded up to +the nearest odd number. The default sinc width is 31 by 31. +.le +.ls lsinc +Look-up table sinc interpolation. Users can specify the look-up table sinc +interpolant width by appending a width value to the interpolant string, e.g. +lsinc51 specifies a 51 by 51 pixel wide look-up table sinc interpolant. The user +supplied sinc width will be rounded up to the nearest odd number. The default +sinc width is 31 by 31 pixels. Users can specify the resolution of the lookup +table sinc by appending the look-up table size in square brackets to the +interpolant string, e.g. lsinc51[20] specifies a 20 by 20 element sinc +look-up table interpolant with a pixel resolution of 0.05 pixels in x and y. +The default look-up table size and resolution are 20 by 20 and 0.05 pixels +in x and y respectively. +.le +.ls drizzle +2D drizzle resampling. Users can specify the drizzle pixel fraction in x and y +by appending a value between 0.0 and 1.0 in square brackets to the +interpolant string, e.g. drizzle[0.5]. The default value is 1.0. +The value 0.0 is increased internally to 0.001. Drizzle resampling +with a pixel fraction of 1.0 in x and y is equivalent to fractional pixel +rotated block summing (fluxconserve = yes) or averaging (flux_conserve = no) if +xmag and ymag are > 1.0. +.le +.le +.ls boundary = "nearest" +The choices are: +.ls nearest +Use the value of the nearest boundary pixel. +.le +.ls constant +Use a user supplied constant value. +.le +.ls reflect +Generate a value by reflecting about the boundary of the image. +.le +.ls wrap +Generate a value by wrapping around to the opposite side of the image. +.le +.le +.ls constant = 0.0 +The value of the constant for boundary extension. +.le +.ls fluxconserve = yes +Preserve the total image flux? If flux conservation is turned on, the output +pixel values are multiplied by the Jacobian of the coordinate transformation. +.le +.ls nxblock = 512, nyblock = 512 +If the size of the output image is less than nxblock by nyblock then +the entire image is transformed at once. Otherwise the output image +is computed in blocks nxblock by nyblock pixels. +.le +.ls wcsinherit = yes +Inherit the wcs of the reference image? +.le +.ls verbose = yes +Print messages about the progress of the task? +.le +.ls interactive = no +Run the task interactively ? +In interactive mode the user may interact with the fitting process, e.g. +change the order of the fit, delete points, replot the data etc. +.le +.ls graphics = "stdgraph" +The graphics device. +.le +.ls gcommands = "" +The graphics cursor. +.le + +.ih +DESCRIPTION + +SREGISTER computes the spatial transformation function required to register +the input image \fIinput\fR to the reference image \fIreference\fR, +and writes the registered input image to the output image \fIoutput\fR. +The input and reference images may be 1D or 2D but must have +the same dimensionality. SREGISTER assumes that the world +coordinate systems in the input and reference +image headers are accurate and that both systems are compatible, e.g. both +images have a celestial coordinate system WCS. + +SREGISTER computes the required spatial transformation by matching the logical +x and y pixel coordinates of a grid of points +in the input image with the logical x and y pixels coordinates +of the same grid of points in the reference image, +using world coordinate information stored in the two image headers. +The coordinate grid consists of \fInx * ny\fR points evenly distributed +over the logical pixel space of interest in the reference image defined by the +\fIxmin\fR, \fIxmax\fR, \fIymin\fR, \fIymax\fR parameters. +The reference image celestial coordinates are transformed to +input image celestial coordinates using world coordinate +system information in both the reference and the input image headers. +Finally the input image celestial coordinates are transformed to logical x and y +input image pixel coordinates using world coordinate system information +stored in the input image header. The transformation sequence looks +like the following for an equatorial celestial coordinate system: + +.nf + (x,y) reference -> (ra,dec) reference (reference image wcs) +(ra,dec) reference -> (ra,dec) input (reference and input image wcs) + (ra,dec) input -> (x,y) input (input image wcs) +.fi + +The computed reference and input logical coordinates and the +celestial coordinates are written to a temporary output coordinates file +which is deleted on task termination. The pixel and celestial coordinates +are output using the \fIxformat\fR and \fIyformat\fR and the \fIrwxformat\fR, +\fIrwyformat\fR, \fIwxformat\fR and \fIwxformat\fR +parameters respectively. If these formats are undefined and, in the +case of the celestial coordinates a format attribute cannot be +read from either the reference or the input images, the coordinates are +output in %g format with \fImin_sigdigits\fR digits of precision. +If the reference and input images are 1D then all the output logical and +world y coordinates are set to 1. + +SREGISTER computes a spatial transformation of the following form. + +.nf + xin = f (xref, yref) + yin = g (xref, yref) +.fi + +The functions f and g are either a power series polynomial or a Legendre or +Chebyshev polynomial surface of order +\fIxxorder\fR and \fIxyorder\fR in x and \fIyxorder\fR and \fIyyorder\fR in y. + +Several polynomial cross terms options are available. Options "none", +"half", and "full" are illustrated below for a quadratic polynomial in +x and y. + +.nf +xxterms = "none", xyterms = "none" +xxorder = 3, xyorder = 3, yxorder = 3, yyorder = 3 + + xin = a11 + a21 * xref + a12 * yref + + a31 * xref ** 2 + a13 * yref ** 2 + yin = a11' + a21' * xref + a12' * yref + + a31' * xref ** 2 + a13' * yref ** 2 + +xxterms = "half", xyterms = "half" +xxorder = 3, xyorder = 3, yxorder = 3, yyorder = 3 + + xin = a11 + a21 * xref + a12 * yref + + a31 * xref ** 2 + a22 * xref * yref + a13 * yref ** 2 + yin = a11' + a21' * xref + a12' * yref + + a31' * xref ** 2 + a22' * xref * yref + a13' * yref ** 2 + +xxterms = "full", xyterms = "full" +xxorder = 3, xyorder = 3, yxorder = 3, yyorder = 3 + + xin = a11 + a21 * xref + a31 * xref ** 2 + + a12 * yref + a22 * xref * yref + a32 * xref ** 2 * yref + + a13 * yref ** 2 + a23 * xref * yref ** 2 + + a33 * xref ** 2 * yref ** 2 + yin = a11' + a21' * xref + a31' * xref ** 2 + + a12' * yref + a22' * xref * yref + a32' * xref ** 2 * yref + + a13' * yref ** 2 + a23' * xref * yref ** 2 + + a33' * xref ** 2 * yref ** 2 +.fi + + +The computation can be done in either real or +double precision by setting the \fIcalctype\fR parameter. +Automatic pixel rejection may be enabled by setting the \fIreject\fR +parameter to some number > 0.0. + +The transformation computed by the "general" fitting geometry is arbitrary +and does not correspond to a physically meaningful model. However the computed +coefficients for the linear term can be given a simple geometrical geometric +interpretation for all the fitting geometries as shown below. + +.nf + fitting geometry = general (linear term) + xin = a + b * xref + c * yref + yin = d + e * xref + f * yref + + fitting geometry = shift + xin = a + xref + yin = d + yref + + fitting geometry = xyscale + xin = a + b * xref + yin = d + f * yref + + fitting geometry = rotate + xin = a + b * xref + c * yref + yin = d + e * xref + f * yref + b * f - c * e = +/-1 + b = f, c = -e or b = -f, c = e + + fitting geometry = rscale + xin = a + b * xref + c * yref + yin = d + e * xref + f * yref + b * f - c * e = +/- const + b = f, c = -e or b = -f, c = e + + fitting geometry = rxyscale + xin = a + b * xref + c * yref + yin = d + e * xref + f * yref + b * f - c * e = +/- const +.fi + +The coefficients can be interpreted as follows. Xref0, yref0, xin0, yin0 +are the origins in the reference and input frames respectively. Orientation +and skew are the orientation of the x and y axes and their deviation from +perpendicularity respectively. Xmag and ymag are the scaling factors in x and +y and are assumed to be positive. + +.nf + general (linear term) + xrotation = rotation - skew / 2 + yrotation = rotation + skew / 2 + b = xmag * cos (xrotation) + c = ymag * sin (yrotation) + e = -xmag * sin (xrotation) + f = ymag * cos (yrotation) + a = xin0 - b * xref0 - c * yref0 = xshift + d = yin0 - e * xref0 - f * yref0 = yshift + + shift + xrotation = 0.0, yrotation = 0.0 + xmag = ymag = 1.0 + b = 1.0 + c = 0.0 + e = 0.0 + f = 1.0 + a = xin0 - xref0 = xshift + d = yin0 - yref0 = yshift + + xyscale + xrotation 0.0 / 180.0 yrotation = 0.0 + b = + /- xmag + c = 0.0 + e = 0.0 + f = ymag + a = xin0 - b * xref0 = xshift + d = yin0 - f * yref0 = yshift + + rscale + xrotation = rotation + 0 / 180, yrotation = rotation + mag = xmag = ymag + const = mag * mag + b = mag * cos (xrotation) + c = mag * sin (yrotation) + e = -mag * sin (xrotation) + f = mag * cos (yrotation) + a = xin0 - b * xref0 - c * yref0 = xshift + d = yin0 - e * xref0 - f * yref0 = yshift + + rxyscale + xrotation = rotation + 0 / 180, yrotation = rotation + const = xmag * ymag + b = xmag * cos (xrotation) + c = ymag * sin (yrotation) + e = -xmag * sin (xrotation) + f = ymag * cos (yrotation) + a = xin0 - b * xref0 - c * yref0 = xshift + d = yin0 - e * xref0 - f * yref0 = yshift +.fi + + +\fIXmin\fR, \fIxmax\fR, \fIymin\fR and \fIymax\fR define the region of +validity of the transformation as well as the limits of the grid +in the reference coordinate system. + +Each computed transformation is written to the a temporary output text database +file which is deleted on task termination. Otherwise the +database file is opened in append mode and new records are written +to the end of the existing file. If more that one record of the same +name is written to the database file, the last record written is the +valid record. + +SREGISTER will terminate with an error if the reference and input images +are not both either 1D or 2D. +If the world coordinate system information cannot be read from either +the reference or input image header, the requested transformations +from the world <-> logical coordinate systems cannot be compiled for either +or both images, or the world coordinate systems of the reference and input +images are fundamentally incompatible in some way, the output logical +reference and input image coordinates are both set to a grid of points +spanning the logical pixel space of the input, not the reference image. +This grid of points defines an identity transformation which results in +an output image equal to the input image. + +SREGISTER computes the output image by evaluating the fitted coordinate +surfaces and interpolating in the input image at position of the transformed +coordinates. The scale of the output image is the same as the scale of the +reference image. The extent and size of the output image are determined +by the \fIxmin\fR, \fIxmax\fR, \fIymin\fR, and \fIymax\fR parameters +as shown below + +.nf + xmin <= x <= xmax + ymin <= x <= ymax + ncols = xmax - xmin + 1 + nlines = xmax - xmin + 1 +.fi + +SREGISTER samples the coordinate surfaces at every \fIxsample\fR and +\fIysample\fR pixels in x and y. +The transformed coordinates at intermediate pixel values are +determined by bilinear interpolation in the coordinate surface. If +\fIxsample\fR and \fIysample\fR = 1, the coordinate +surface is evaluated at every pixel. Use of \fIxsample\fR and \fIysample\fR +are strongly recommended for large images and high order coordinate +surfaces in order to reduce the time required to compute the output image. + +The output image gray levels are determined by interpolating in the input +image at the positions of the transformed output pixels using the +interpolant specified by the \fIinterpolant\fR parameter. If the +\fIfluxconserve\fR switch is set the output pixel values are multiplied by +the Jacobian of the transformation, which preserves the flux of the entire +image. Out-of-bounds pixels are evaluated using the \fIboundary\fR and +\fIconstant\fR parameters. + +The output image is computed in \fInxblock\fR by \fInyblock\fR pixel sections. +If possible users should set these number to values larger than the dimensions +of the output image in order to minimize the number of disk reads and writes +required to compute the output image. If this is not feasible and the image +rotation is small, users should set nxblock to be greater than the number of +columns in the output image, and nyblock to be as large as machine memory +will permit. + +If \fIwcsinherit\fR = "yes", then the output image will inherit the world +coordinate system of the reference image. +Otherwise if the environment variable \fInomwcs\fR is "no" the world +coordinate +system of the input image is modified in the output image to reflect the +effects of the \fIlinear\fR portion of the registration operation. +Support does not yet exist in the IRAF world coordinate system interface +for the higher order distortion corrections that SREGISTER is capable +of performing. + +If \fIverbose\fR is "yes" then messages about the progress of the task +as well as warning messages indicating potential problems +are written to the standard output. + +SREGISTER may be run interactively by setting the \fIinteractive\fR +parameter to "yes". +In interactive mode the user has the option of viewing the fitted +spatial transformation, changing the +fit parameters, deleting and undeleting points, and replotting +the data until a satisfactory +fit has been achieved. + +.ih +CURSOR COMMANDS + +In interactive mode the following cursor commands are currently available. + +.nf + Interactive Keystroke Commands + +? Print options +f Fit the data and graph with the current graph type (g, x, r, y, s) +g Graph the data and the current fit +x,r Graph the x fit residuals versus x and y respectively +y,s Graph the y fit residuals versus x and y respectively +d,u Delete or undelete the data point nearest the cursor +o Overplot the next graph +c Toggle the constant x, y plotting option +t Plot a line of constant x, y through the nearest data point +l Print xshift, yshift, xmag, ymag, xrotate, yrotate +q Exit the interactive curve fitting +.fi + +The parameters listed below can be changed interactively with simple colon +commands. Typing the parameter name alone will list the current value. + +.nf + Colon Parameter Editing Commands + +:show List parameters +:fitgeometry Fitting geometry (shift,xyscale,rotate, + rscale,rxyscale,general) +:function [value] Fitting function (chebyshev,legendre, + polynomial) +:xxorder :xyorder [value] X fitting function xorder, yorder +:yxorder :yyorder [value] Y fitting function xorder, yorder +:xxterms :yxterms [n/h/f] X, Y fit cross term types +:reject [value] Rejection threshold +.fi + + +.ih +FORMATS + +A format specification has the form "%w.dCn", where w is the field +width, d is the number of decimal places or the number of digits of +precision, C is the format code, and n is radix character for +format code "r" only. The w and d fields are optional. The format +codes C are as follows: + +.nf +b boolean (YES or NO) +c single character (c or '\c' or '\0nnn') +d decimal integer +e exponential format (D specifies the precision) +f fixed format (D specifies the number of decimal places) +g general format (D specifies the precision) +h hms format (hh:mm:ss.ss, D = no. decimal places) +m minutes, seconds (or hours, minutes) (mm:ss.ss) +o octal integer +rN convert integer in any radix N +s string (D field specifies max chars to print) +t advance To column given as field W +u unsigned decimal integer +w output the number of spaces given by field W +x hexadecimal integer +z complex format (r,r) (D = precision) + + + +Conventions for w (field width) specification: + + W = n right justify in field of N characters, blank fill + -n left justify in field of N characters, blank fill + 0n zero fill at left (only if right justified) +absent, 0 use as much space as needed (D field sets precision) + +Escape sequences (e.g. "\n" for newline): + +\b backspace (not implemented) +\f formfeed +\n newline (crlf) +\r carriage return +\t tab +\" string delimiter character +\' character constant delimiter character +\\ backslash character +\nnn octal value of character + +Examples + +%s format a string using as much space as required +%-10s left justify a string in a field of 10 characters +%-10.10s left justify and truncate a string in a field of 10 characters +%10s right justify a string in a field of 10 characters +%10.10s right justify and truncate a string in a field of 10 characters + +%7.3f print a real number right justified in floating point format +%-7.3f same as above but left justified +%15.7e print a real number right justified in exponential format +%-15.7e same as above but left justified +%12.5g print a real number right justified in general format +%-12.5g same as above but left justified + +%h format as nn:nn:nn.n +%15h right justify nn:nn:nn.n in field of 15 characters +%-15h left justify nn:nn:nn.n in a field of 15 characters +%12.2h right justify nn:nn:nn.nn +%-12.2h left justify nn:nn:nn.nn + +%H / by 15 and format as nn:nn:nn.n +%15H / by 15 and right justify nn:nn:nn.n in field of 15 characters +%-15H / by 15 and left justify nn:nn:nn.n in field of 15 characters +%12.2H / by 15 and right justify nn:nn:nn.nn +%-12.2H / by 15 and left justify nn:nn:nn.nn + +\n insert a newline +.fi + +.ih +REFERENCES + +Additional information on IRAF world coordinate systems including +more detailed descriptions of the "logical", "physical", and "world" +coordinate systems can be found in the help pages for the WCSEDIT +and WCRESET tasks. Detailed documentation for the IRAF world +coordinate system interface MWCS can be found in the file +"iraf$sys/mwcs/MWCS.hlp". This file can be formatted and printed +with the command "help iraf$sys/mwcs/MWCS.hlp fi+ | lprint". + +Details of the FITS header world coordinate system interface can +be found in the draft paper "World Coordinate Systems Representations Within the +FITS Format" by Hanisch and Wells, available from the iraf anonymous ftp +archive and the draft paper which supersedes it "Representations of Celestial +Coordinates in FITS" by Greisen and Calabretta available from the NRAO +anonymous ftp archives. + +The spherical astronomy routines employed here are derived from the Starlink +SLALIB library provided courtesy of Patrick Wallace. These routines +are very well documented internally with extensive references provided +where appropriate. Interested users are encouraged to examine the routines +for this information. Type "help slalib" to get a listing of the SLALIB +routines, "help slalib opt=sys" to get a concise summary of the library, +and "help <routine>" to get a description of each routine's calling sequence, +required input and output, etc. An overview of the library can be found in the +paper "SLALIB - A Library of Subprograms", Starlink User Note 67.7 +by P.T. Wallace, available from the Starlink archives. + +.ih +EXAMPLES + +1. Register a radio image to an X-ray image of the same field using +a 100 point coordinate grid and a simple linear transformation. Both +images have accurate sky projection world coordinate systems. Print the +output world coordinates in the coords file in hh:mm:ss.ss and dd:mm:ss.s +format. Display the input and output image and blink them. + +.nf + cl> sregister radio xray radio.tran rwxformat=%12.2H \ + rwyformat=%12.1h wxformat=%12.2H wyformat=%12.1h + + cl> display radio 1 fi+ + + cl> display radio.tran 2 fi+ +.fi + +2. Repeat the previous command but begin with a higher order fit +and run the task in interactive mode in order to examine the fit +residuals. + +.nf + cl> sregister radio xray radio.tran rwxformat=%12.2H \ + rwyformat=%12.1h wxformat=%12.2H wyformat=%12.1h xxo=4 \ + xyo=4 xxt=half yxo=4 yyo=4 yxt=half inter+ + + ... a plot of the fit appears + + ... type x and r to examine the residuals of the x + surface fit versus x and y + + ... type y and s to examine the residuals of the y + surface fit versus x and y + + ... delete 2 deviant points with the d key and + recompute the fit with the f key + + ... type q to quit, save the fit, and compute the registered + image +.fi + + +3. Mosaic a set of 9 images covering a ~ 1 degree field into a single image +centered at 12:32:53.1 +43:13:03. Set the output image scale to 0.5 +arc-seconds / pixel which is close the detector scale of 0.51 arc-seconds +per pixel. Set the orientation to be north up and east to the left. +The 9 images all have accurate world coordinate information in their headers. + +.nf + # Create a dummy reference image big enough to cover 1 square degree + + cl> mkpattern refimage ncols=7200 nlines=7200 ... + + # Give the dummy reference image the desired coordinate system + + cl> ccsetwcs refimage "" xref=3600.5 yref=3600.5 xmag=-0.5 \ + ymag=0.5 lngref=12:32:53.1 latref=43:13:03 ... + + # Register the images using constant boundary extension and set + # uservalue to some reasonable value outside the good data range. + # It may be possible to improve performance by increasing nxblock + # and nyblock. + + cl> sregister @inlist refimage @outlist boundary=constant \ + constant=<uservalue> nxblock=7200 nyblock=1024 ... + + # Combine the images using imcombine + + cl> imcombine @outlist mosaic lthreshold=<uservalue> ... + +.fi + +.ih +TIME REQUIREMENTS +.ih +BUGS +.ih +SEE ALSO +imalign,xregister,register,geotran,wregister +.endhelp diff --git a/pkg/images/immatch/doc/wcscopy.hlp b/pkg/images/immatch/doc/wcscopy.hlp new file mode 100644 index 00000000..493f1311 --- /dev/null +++ b/pkg/images/immatch/doc/wcscopy.hlp @@ -0,0 +1,80 @@ +.help wcscopy Jun95 images.immatch +.ih +NAME +wcscopy -- copy the wcs of a reference image to a list of images +.ih +USAGE +wcscopy images refimages +.ih +PARAMETERS +.ls images +The list of input images which will inherit the wcs of the reference image. +If the image does not exists a dataless image header is created. +.le +.ls reference +The list of reference images containing the reference wcs. The number of +reference images must be one or equal to the number of input images. +.le +.ls verbose = yes +Print messages about the progress of the task? +.le + +.ih +DESCRIPTION + +WCSCOPY copies the world coordinate system information in the header of the +reference image \fIreference\fR to the headers of the input images +\fIimages\fR, replacing any existing world coordinate system information +in the input image headers in the process. WCSCOPY assumes that the +world coordinate system information in the header of the reference +image is accurate and that all the input images have write permission. +If the input image does not exist a data-less image header is created. +The WCS is treated as an independent object and +there is no check made on the dimensionality and sizes of the images. + + +.ih +REFERENCES + +Information on IRAF world coordinate systems including +more detailed descriptions of the "logical", "physical", and "world" +coordinate systems can be +found in the help pages for the WCSEDIT and WCRESET tasks. +Detailed documentation for the IRAF world coordinate system +interface MWCS can be found in the file "iraf$sys/mwcs/MWCS.hlp". +This file can be formatted and printed with the command "help +iraf$sys/mwcs/MWCS.hlp fi+ | lprint". Information on the spectral +coordinates systems and their suitability for use with WCSXYMATCH +can be obtained by typing "help specwcs | lprint". +Details of the FITS header +world coordinate system interface can be found in the document +"World Coordinate Systems Representations Within the FITS Format" +by Hanisch and Wells, available from our anonymous ftp archive. + +.ih +EXAMPLES + +1. Make sure that the world coordinates systems of a list of input images +that have been registered to a reference image with the xregister task +are identical to the world coordinate system of the reference image. + +.nf + cl> xregister @inlist refimage [200:400,200:400] shifts \ + output=@outlist xwindow=21 ywindow=21 + cl> wcscopy @outlist refimage +.fi + +2. Create a data-less WCS image by specifying a new image. + +.nf + cl> wcscopy new dev$wpix +.fi + +.ih +TIME REQUIREMENTS +.ih +BUGS +.ih +SEE ALSO +tprecess,imalign,xregister,geomap,register,geotran,wcsmap,wregister,wcsedit +.endhelp diff --git a/pkg/images/immatch/doc/wcsmap.hlp b/pkg/images/immatch/doc/wcsmap.hlp new file mode 100644 index 00000000..e2a4dd01 --- /dev/null +++ b/pkg/images/immatch/doc/wcsmap.hlp @@ -0,0 +1,619 @@ +.help wcsmap Feb96 images.immatch +.ih +NAME +wcsmap -- compute the spatial transformation function required to register +a list of images using WCS information +.ih +USAGE +wcsmap input reference database +.ih +PARAMETERS +.ls input +The list of input images containing the input wcs. +.le +.ls reference +The list of reference images containing the reference wcs. The number of +reference images must be one or equal to the number of input images. +.le +.ls database +The name of the output text database file containing the computed +transformations. +.le +.ls transforms = "" +An optional list of transform names. If transforms is undefined the +transforms are assigned record names identical to the names of the input images. +.le +.ls results = "" +Optional output files containing a summary of the results including a +description of the transform geometry and a listing of the input coordinates, +the fitted coordinates, and the fit residuals. The number of results files +must be one or equal to the number of input files. If results is "STDOUT" the +results summary is printed on the standard output. +.le +.ls xmin = INDEF, xmax = INDEF, ymin = INDEF, ymax = INDEF +The minimum and maximum logical x and logical y coordinates used to generate +the grid of reference image control points and define the region of +validity of the spatial transformation. Xmin, xmax, ymin, and +ymax are assigned defaults of 1, the number of columns in the reference +image, 1, and the number of lines in the reference image, respectively. +.le +.ls nx = 10, ny = 10 +The number of points in x and y used to generate the coordinate grid. +.le +.ls wcs = "world" +The world coordinate system of the coordinates. The options are: +.ls physical +Physical coordinates are pixel coordinates which are invariant with +respect to linear transformations of the physical image data. For example, +if the reference +image is a rotated section of a larger input image, the physical +coordinates of an object in the reference image are equal to the physical +coordinates of the same object in the input image, although the logical +pixel coordinates are different. +.le +.ls world +World coordinates are image coordinates which are invariant with +respect to linear transformations of the physical image data and which +are in world units, normally decimal degrees for sky projection coordinate +systems and angstroms for spectral coordinate systems. Obviously if the +wcs is correct the ra and dec or wavelength and position of an object +should remain the same not matter how the image +is linearly transformed. The default world coordinate +system is either 1) the value of the environment variable "defwcs" if +set in the user's IRAF environment (normally it is undefined) and present +in the image header, 2) the value of the "system" +attribute in the image header keyword WAT0_001 if present in the +image header or, 3) the "physical" coordinate system. +Care must be taken that the wcs of the input and +reference images are compatible, e.g. it makes no sense to +match the coordinates of a 2D sky projection and a 2D spectral wcs. +.le +.le +.ls transpose = no +Force a transpose of the reference image world coordinates before evaluating +the world to logical coordinate transformation for the input image ? This +option is useful if there is not enough information in the reference and +input image headers to tell whether or not the images are transposed with +respect to each other. +.le +.ls xformat = "%10.3f", yformat = "%10.3f" +The format of the output logical x and y reference and input pixel +coordinates in columns 1 and 2 and 3 and 4 respectively. By default the +coordinates are output right justified in a field of ten spaces with +3 digits following the decimal point. +.le +.ls wxformat = "", wyformat = "" +The format of the output world x and y reference and input image coordinates +in columns 5 and 6 respectively. The internal default formats will give +reasonable output formats and precision for both sky projection coordinates +and other types, e.g. spectral, coordinates. +.le +.ls fitgeometry = "general" +The fitting geometry to be used. The options are the following. +.ls shift +X and y shifts only are fit. +.le +.ls xyscale +X and y shifts and x and y magnification factors are fit. Axis flips are +allowed for. +.le +.ls rotate +X and y shifts and a rotation angle are fit. Axis flips are allowed for. +.le +.ls rscale +X and y shifts, a magnification factor assumed to be the same in x and y, and a +rotation angle are fit. Axis flips are allowed for. +.le +.ls rxyscale +X and y shifts, x and y magnifications factors, and a rotation angle are fit. +Axis flips are allowed for. +.le +.ls general +A polynomial of arbitrary order in x and y is fit. A linear term and a +distortion term are computed separately. The linear term includes an x and y +shift, an x and y scale factor, a rotation and a skew. Axis flips are also +allowed for in the linear portion of the fit. The distortion term consists +of a polynomial fit to the residuals of the linear term. By default the +distortion terms is set to zero. +.le + +For all the fitting geometries except "general" no distortion term is fit, +i.e. the x and y polynomial orders are assumed to be 2 and the cross term +switches are set to "none", regardless of the values of the \fIxxorder\fR, +\fIxyorder\fR, \fIxxterms\fR, \fIyxorder\fR, \fIyyorder\fR and \fIyxterms\fR +parameters set by the user. +.le +.ls function = "polynomial" +The type of analytic coordinate surfaces to be fit. The options are the +following. +.ls legendre +Legendre polynomials in x and y. +.le +.ls chebyshev +Chebyshev polynomials in x and y. +.le +.ls polynomial +Power series polynomials in x and y. +.le +.le +.ls xxorder = 2, xyorder = 2, yxorder = 2, yyorder = 2 +The order of the polynomials in x and y for the x and y fits respectively. +The default order and cross term settings define the linear term in x +and y, where the 6 coefficients can be interpreted in terms of an x and y shift, +an x and y scale change, and rotations of the x and y axes. The "shift", +"xyscale", "rotation", "rscale", and "rxyscale", fitting geometries +assume that the polynomial order parameters are 2 regardless of the values +set by the user. If any of the order parameters are higher than 2 and +\fIfitgeometry\fR is "general", then a distortion surface is fit to the +residuals from the linear portion of the fit. +.le +.ls xxterms = "half", yxterms = "half" +The options are: +.ls none +The individual polynomial terms contain powers of x or powers of y but not +powers of both. +.le +.ls half +The individual polynomial terms contain powers of x and powers of y, whose +maximum combined power is MAX (xxorder - 1, xyorder - 1) for the x fit and +MAX (yxorder - 1, yyorder - 1) for the y fit. +.le +.ls full +The individual polynomial terms contain powers of x and powers of y, whose +maximum combined power is MAX (xxorder - 1 + xyorder - 1) for the x fit and +MAX (yxorder - 1 + yyorder - 1) for the y fit. +.le + +The "shift", "xyscale", "rotation", "rscale", and "rxyscale" fitting +geometries, assume that the cross term switches are set to "none"regardless +of the values set by the user. If either of the cross terms parameters is +set to "half" or "full" and \fIfitgeometry\fR is "general" then a distortion +surface is fit to the residuals from the linear portion of the fit. +.le +.ls reject = INDEF +The rejection limit in units of sigma. The default is no rejection. +.le +.ls calctype = "real" +The precision of coordinate transformation calculations. The options are "real" +and "double". +.le +.ls verbose = yes +Print messages about the progress of the task? +.le +.ls interactive = yes +Run the task interactively ? +In interactive mode the user may interact with the fitting process, e.g. +change the order of the fit, delete points, replot the data etc. +.le +.ls graphics = "stdgraph" +The graphics device. +.le +.ls gcommands = "" +The graphics cursor. +.le + +.ih +DESCRIPTION + +WCSMAP computes the spatial transformation function required to map the +coordinate system of the reference image \fIreference\fR to the coordinate +system of the input image \fIinput\fR, and stores the computed function in +the output text database file \fIdatabase\fR. +The input and reference images must be one- or two-dimensional and +must have the same dimensionality. The input image and output +text database file can be input to the REGISTER or GEOTRAN tasks to +perform the actual image registration. WCSMAP assumes that the world +coordinate systems in the input and reference +image headers are accurate and that the two systems are compatible, e.g. both +images have the same epoch sky projection world coordinate systems or both are +spectra whose coordinates are in the same units. + +WCSMAP computes the required spatial transformation by matching the logical +x and y pixel coordinates of a grid of points +in the input image with the logical x and y pixels coordinates +of the same grid of points in the reference image, +using world coordinate information stored in the two image headers. +The coordinate grid consists of \fInx * ny\fR points evenly distributed +over the logical pixel space of interest in the reference image defined by the +\fIxmin\fR, \fIxmax\fR, \fIymin\fR, \fIymax\fR parameters. +The logical x and y pixel reference image coordinates are transformed to the +reference image world coordinate system defined by \fIwcs\fR, using the wcs +information in the reference image header. +The reference image world coordinates are then transformed to logical x and +y pixel coordinates in the input image, using world coordinate system +information stored in the input image header. + +The computed reference and input logical coordinates and the +world coordinates are written to a temporary output coordinates file which +is deleted on task termination. +The x and y coordinates are written using +the \fIxformat\fR and \fIyformat\fR and the \fIwxformat\fR and \fIwxformat\fR +parameters respectively. If these formats are undefined and, in the +case of the world coordinates a format attribute cannot be +read from either the reference or the input images, the coordinates are +output in %g format with \fImin_sigdigits\fR digits of precision. +If the reference and input images are 1D then all the output logical and +world y coordinates are set to 1. + +WCSMAP computes a spatial transformation of the following form. + +.nf + xin = f (xref, yref) + yin = g (xref, yref) +.fi + +The functions f and g are either a power series polynomial or a Legendre or +Chebyshev polynomial surface of order \fIxxorder\fR and \fIxyorder\fR in +x and \fIyxorder\fR and \fIyyorder\fR in y. Cross terms are optional. + +Several polynomial cross terms options are available. Options "none", +"half", and "full" are illustrated below for a quadratic polynomial in +x and y. + +.nf +xxterms = "none", xyterms = "none" +xxorder = 3, xyorder = 3, yxorder = 3, yyorder = 3 + + xin = a11 + a21 * xref + a12 * yref + + a31 * xref ** 2 + a13 * yref ** 2 + yin = a11' + a21' * xref + a12' * yref + + a31' * xref ** 2 + a13' * yref ** 2 + +xxterms = "half", xyterms = "half" +xxorder = 3, xyorder = 3, yxorder = 3, yyorder = 3 + + xin = a11 + a21 * xref + a12 * yref + + a31 * xref ** 2 + a22 * xref * yref + a13 * yref ** 2 + yin = a11' + a21' * xref + a12' * yref + + a31' * xref ** 2 + a22' * xref * yref + a13' * yref ** 2 + +xxterms = "full", xyterms = "full" +xxorder = 3, xyorder = 3, yxorder = 3, yyorder = 3 + + xin = a11 + a21 * xref + a31 * xref ** 2 + + a12 * yref + a22 * xref * yref + a32 * xref ** 2 * yref + + a13 * yref ** 2 + a23 * xref * yref ** 2 + + a33 * xref ** 2 * yref ** 2 + yin = a11' + a21' * xref + a31' * xref ** 2 + + a12' * yref + a22' * xref * yref + a32' * xref ** 2 * yref + + a13' * yref ** 2 + a23' * xref * yref ** 2 + + a33' * xref ** 2 * yref ** 2 +.fi + +If the \fBfitgeometry\fR parameter is anything +other than "general", the order parameters assume the value 2 and the +cross terms switches assume the value "none", regardless of the values set +by the user. The computation can be done in either real or +double precision by setting the \fIcalctype\fR parameter. +Automatic pixel rejection may be enabled by setting the \fIreject\fR +parameter to some number > 0.0. + +The transformation computed by the "general" fitting geometry is arbitrary +and does not correspond to a physically meaningful model. However the computed +coefficients for the linear term can be given a simple geometrical geometric +interpretation for all the fitting geometries as shown below. + +.nf + fitting geometry = general (linear term) + xin = a + b * xref + c * yref + yin = d + e * xref + f * yref + + fitting geometry = shift + xin = a + xref + yin = d + yref + + fitting geometry = xyscale + xin = a + b * xref + yin = d + f * yref + + fitting geometry = rotate + xin = a + b * xref + c * yref + yin = d + e * xref + f * yref + b * f - c * e = +/-1 + b = f, c = -e or b = -f, c = e + + fitting geometry = rscale + xin = a + b * xref + c * yref + yin = d + e * xref + f * yref + b * f - c * e = +/- const + b = f, c = -e or b = -f, c = e + + fitting geometry = rxyscale + xin = a + b * xref + c * yref + yin = d + e * xref + f * yref + b * f - c * e = +/- const +.fi + + +The coefficients can be interpreted as follows. Xref0, yref0, xin0, yin0 +are the origins in the reference and input frames respectively. Orientation +and skew are the orientation of the x and y axes and their deviation from +perpendicularity respectively. Xmag and ymag are the scaling factors in x and +y and are assumed to be positive. + +.nf + general (linear term) + xrotation = rotation - skew / 2 + yrotation = rotation + skew / 2 + b = xmag * cos (xrotation) + c = ymag * sin (yrotation) + e = -xmag * sin (xrotation) + f = ymag * cos (yrotation) + a = xin0 - b * xref0 - c * yref0 = xshift + d = yin0 - e * xref0 - f * yref0 = yshift + + shift + xrotation = 0.0, yrotation = 0.0 + xmag = ymag = 1.0 + b = 1.0 + c = 0.0 + e = 0.0 + f = 1.0 + a = xin0 - xref0 = xshift + d = yin0 - yref0 = yshift + + xyscale + xrotation 0.0 / 180.0 yrotation = 0.0 + b = + /- xmag + c = 0.0 + e = 0.0 + f = ymag + a = xin0 - b * xref0 = xshift + d = yin0 - f * yref0 = yshift + + rscale + xrotation = rotation + 0 / 180, yrotation = rotation + mag = xmag = ymag + const = mag * mag + b = mag * cos (xrotation) + c = mag * sin (yrotation) + e = -mag * sin (xrotation) + f = mag * cos (yrotation) + a = xin0 - b * xref0 - c * yref0 = xshift + d = yin0 - e * xref0 - f * yref0 = yshift + + rxyscale + xrotation = rotation + 0 / 180, yrotation = rotation + const = xmag * ymag + b = xmag * cos (xrotation) + c = ymag * sin (yrotation) + e = -xmag * sin (xrotation) + f = ymag * cos (yrotation) + a = xin0 - b * xref0 - c * yref0 = xshift + d = yin0 - e * xref0 - f * yref0 = yshift +.fi + + +\fIXmin\fR, \fIxmax\fR, \fIymin\fR and \fIymax\fR define the region of +validity of the fit as well as the limits of the grid +in the reference coordinate system and must be set by +the user. These parameters are used to reject out of range data before the +actual fitting is done. + +Each computed transformation is written to the output file \fIdatabase\fR +in a record whose name is either specified by the user via the \fItransforms\fR +parameter or defaults the name of the input image. +The database file is opened in append mode and new records are written +to the end of the existing file. If more that one record of the same +name is written to the database file, the last record written is the +valid record, i.e. the one that will be used by the REGISTER or +GEOTRAN tasks. + +WCSMAP will terminate with an error if the reference and input images +are not both either 1D or 2D. +If the world coordinate system information cannot be read from either +the reference or input image header, the requested transformations +from the world <-> logical coordinate systems cannot be compiled for either +or both images, or the world coordinate systems of the reference and input +images are fundamentally incompatible in some way, the output logical +reference and input image coordinates are both set to a grid of points +spanning the logical pixel space of the input, not the reference image. +This grid of points defines an identity transformation which will leave +the input image unchanged if applied by the REGISTER or GEOTRAN tasks. + +If \fIverbose\fR is "yes" then messages about the progress of the task +as well as warning messages indicating potential problems are written to +the standard output. If \fIresults\fR is set to a file name then the input +coordinates, the fitted coordinates, and the residuals of the fit are +written to that file. + +WCSMAP may be run interactively by setting the \fIinteractive\fR +parameter to "yes". +In interactive mode the user has the option of viewing the fit, changing the +fit parameters, deleting and undeleting points, and replotting +the data until a satisfactory +fit has been achieved. + +.ih +CURSOR COMMANDS + +In interactive mode the following cursor commands are currently available. + +.nf + Interactive Keystroke Commands + +? Print options +f Fit the data and graph with the current graph type (g, x, r, y, s) +g Graph the data and the current fit +x,r Graph the x fit residuals versus x and y respectively +y,s Graph the y fit residuals versus x and y respectively +d,u Delete or undelete the data point nearest the cursor +o Overplot the next graph +c Toggle the constant x, y plotting option +t Plot a line of constant x, y through the nearest data point +l Print xshift, yshift, xmag, ymag, xrotate, yrotate +q Exit the interactive curve fitting +.fi + +The parameters listed below can be changed interactively with simple colon +commands. Typing the parameter name alone will list the current value. + +.nf + Colon Parameter Editing Commands + +:show List parameters +:fitgeometry Fitting geometry (shift,xyscale,rotate, + rscale,rxyscale,general) +:function [value] Fitting function (chebyshev,legendre, + polynomial) +:xxorder :xyorder [value] X fitting function xorder, yorder +:yxorder :yyorder [value] Y fitting function xorder, yorder +:xxterms :yxterms [n/h/f] X, Y fit cross terms type +:reject [value] Rejection threshold +.fi + + +.ih +FORMATS + +A format specification has the form "%w.dCn", where w is the field +width, d is the number of decimal places or the number of digits of +precision, C is the format code, and n is radix character for +format code "r" only. The w and d fields are optional. The format +codes C are as follows: + +.nf +b boolean (YES or NO) +c single character (c or '\c' or '\0nnn') +d decimal integer +e exponential format (D specifies the precision) +f fixed format (D specifies the number of decimal places) +g general format (D specifies the precision) +h hms format (hh:mm:ss.ss, D = no. decimal places) +m minutes, seconds (or hours, minutes) (mm:ss.ss) +o octal integer +rN convert integer in any radix N +s string (D field specifies max chars to print) +t advance To column given as field W +u unsigned decimal integer +w output the number of spaces given by field W +x hexadecimal integer +z complex format (r,r) (D = precision) + + + +Conventions for w (field width) specification: + + W = n right justify in field of N characters, blank fill + -n left justify in field of N characters, blank fill + 0n zero fill at left (only if right justified) +absent, 0 use as much space as needed (D field sets precision) + +Escape sequences (e.g. "\n" for newline): + +\b backspace (not implemented) +\f formfeed +\n newline (crlf) +\r carriage return +\t tab +\" string delimiter character +\' character constant delimiter character +\\ backslash character +\nnn octal value of character + +Examples + +%s format a string using as much space as required +%-10s left justify a string in a field of 10 characters +%-10.10s left justify and truncate a string in a field of 10 characters +%10s right justify a string in a field of 10 characters +%10.10s right justify and truncate a string in a field of 10 characters + +%7.3f print a real number right justified in floating point format +%-7.3f same as above but left justified +%15.7e print a real number right justified in exponential format +%-15.7e same as above but left justified +%12.5g print a real number right justified in general format +%-12.5g same as above but left justified + +%h format as nn:nn:nn.n +%15h right justify nn:nn:nn.n in field of 15 characters +%-15h left justify nn:nn:nn.n in a field of 15 characters +%12.2h right justify nn:nn:nn.nn +%-12.2h left justify nn:nn:nn.nn + +%H / by 15 and format as nn:nn:nn.n +%15H / by 15 and right justify nn:nn:nn.n in field of 15 characters +%-15H / by 15 and left justify nn:nn:nn.n in field of 15 characters +%12.2H / by 15 and right justify nn:nn:nn.nn +%-12.2H / by 15 and left justify nn:nn:nn.nn + +\n insert a newline +.fi + +.ih +REFERENCES + +Additional information on IRAF world coordinate systems including +more detailed descriptions of the "logical", "physical", and "world" +coordinate systems can be +found in the help pages for the WCSEDIT and WCRESET tasks. +Detailed documentation for the IRAF world coordinate system +interface MWCS can be found in the file "iraf$sys/mwcs/MWCS.hlp". +This file can be formatted and printed with the command "help +iraf$sys/mwcs/MWCS.hlp fi+ | lprint". Information on the spectral +coordinates systems and their suitability for use with WCSXYMATCH +can be obtained by typing "help specwcs | lprint". +Details of the FITS header +world coordinate system interface can be found in the document +"World Coordinate Systems Representations Within the FITS Format" +by Hanisch and Wells, available from our anonymous ftp archive. + +.ih +EXAMPLES + +1. Compute the spatial transformation required to match a radio image to an +X-ray image of the same field using a 100 point coordinate grid +and a simple linear transformation. Both images have accurate sky +projection world coordinate systems. Print the output world coordinates +in the coords file in hh:mm:ss.ss and dd:mm:ss.s format. Run geotran +on the results to do the actual registration. + +.nf + cl> wcsmap radio xray geodb wxformat=%12.2H wyformat=%12.1h \ + interactive- + + cl> geotran radio radio.tran geodb radio +.fi + +2. Repeat the previous command but begin with a higher order fit +and run the task in interactive mode in order to examine the fit +residuals. + +.nf + cl> wcsmap radio xray geodb wxformat=%12.2H wyformat=%12.1h \ + xxo=4 xyo=4 xxt=half yxo=4 yyo=4 yxt=half + + ... a plot of the fit appears + + ... type x and r to examine the residuals of the x + surface fit versus x and y + + ... type y and s to examine the residuals of the y + surface fit versus x and y + + ... delete 2 deviant points with the d key and + recompute the fit with the f key + + ... type q to quit and save the fit + + cl> geotran radio radio.tran geodb radio +.fi + +3. Repeat example 1 but assign a user name to the transform. + +.nf + cl> wcsmap radio xray geodb transforms="m82" wxformat=%12.2H \ + wyformat=%12.1h interactive- + + cl> geotran radio radio.tran geodb m82 +.fi + +.ih +TIME REQUIREMENTS +.ih +BUGS +.ih +SEE ALSO +wcstran,xregister,wcsxymatch,geomap,register,geotran +.endhelp diff --git a/pkg/images/immatch/doc/wcsxymatch.hlp b/pkg/images/immatch/doc/wcsxymatch.hlp new file mode 100644 index 00000000..0651b0c7 --- /dev/null +++ b/pkg/images/immatch/doc/wcsxymatch.hlp @@ -0,0 +1,314 @@ +.help wcsxymatch Jun95 images.immatch +.ih +NAME +wcsxymatch -- match input and reference image x-y coordinates using the WCS +.ih +USAGE +wcsxymatch input reference output +.ih +PARAMETERS +.ls input +The list of input images containing the input wcs. +.le +.ls reference +The list of reference images containing the reference wcs. The number of +reference images must be one or equal to the number of input images. +.le +.ls output +The output matched coordinate lists containing: +1) the logical x-y pixel coordinates of a point +in the reference image in columns 1 and 2, 2) the logical x-y pixel +coordinates of the same point in the input image in columns 3 and 4, +3) the world coordinates of the point in the reference and input +image in columns 5 and 6. The output coordinate list can be +input directly to the geomap task. The number of output files must be +equal to the number of input images or be the standard output STDOUT. +.le +.ls coords = "grid" +The source of the coordinate list. The options are: +.ls grid +Generate a list of \fInx * ny\fR coordinates, evenly spaced over +the reference image, and beginning and ending at logical coordinates +\fIxmin\fR and \fIxmax\fR in x and \fIymin\fR and \fIymax\fR in y. +.le +.ls <filename> +The name of the text file containing the world coordinates of a set of +points in the reference image. +.le +.le +.ls xmin = INDEF, xmax = INDEF, ymin = INDEF, ymax = INDEF +The minimum and maximum logical x and logical y coordinates used to generate +the grid of control points if \fIcoords\fR = "grid". Xmin, xmax, ymin, and +ymax default to 1, the number of columns in the reference image, 1, and the +number of lines in the reference image, respectively. +.le +.ls nx = 10, ny = 10 +The number of points in x and y used to generate the coordinate grid +if \fIcoords\fR = "grid". +.le +.ls wcs = "world" +The world coordinate system of the coordinates. The options are: +.ls physical +Physical coordinates are pixel coordinates which are invariant with +respect to linear transformations of the physical image data. For example, +if the reference +image is a rotated section of a larger input image, the physical +coordinates of an object in the reference image are equal to the physical +coordinates of the same object in the input image, although the logical +pixel coordinates are different. +.le +.ls world +World coordinates are image coordinates which are invariant with +respect to linear transformations of the physical image data and which +are in world units, normally decimal degrees for sky projection coordinate +systems and angstroms for spectral coordinate systems. Obviously if the +wcs is correct the ra and dec or wavelength and position of an object +should remain the same not matter how the image +is linearly transformed. The default world coordinate +system is either 1) the value of the environment variable "defwcs" if +set in the user's IRAF environment (normally it is undefined) and present +in the image header, 2) the value of the "system" +attribute in the image header keyword WAT0_001 if present in the +image header or, 3) the "physical" coordinate system. +Care must be taken that the wcs of the input and +reference images are compatible, e.g. it makes no sense to +match the coordinates of a 2D sky projection and a 2D spectral wcs. +.le +.le +.ls transpose = no +Force a transpose of the reference image world coordinates before evaluating +the world to logical coordinate transformation for the input image ? This +option is useful if there is not enough information in the reference and +input image headers to tell whether or not the images are transposed with +respect to each other. +.le +.ls xcolumn = 1, ycolumn = 2 +The columns in the input coordinate list containing the x and y coordinate +values if \fIcoords\fR = <filename>. +.le +.ls xunits = "", ls yunits = "" +The units of the x and y coordinates in the input coordinate list +if \fIcoords\fR = <filename>, by default decimal degrees for sky projection +coordinate systems, otherwise any units. +The options are: +.ls hours +Input coordinates specified in hours are converted to decimal degrees by +multiplying by 15.0. +.le +.ls native +The internal units of the wcs. No conversions on the input coordinates +are performed. +.le + +If the units are not specified the default is "native". +.le +.ls xformat = "%10.3f", yformat = "%10.3f" +The format of the output logical x and y reference and input pixel +coordinates in columns 1 and 2 and 3 and 4 respectively. By default the +coordinates are output right justified in a field of ten spaces with +3 digits following the decimal point. +.le +.ls wxformat = "", wyformat = "" +The format of the output world x and y reference and input image coordinates +in columns 5 and 6 respectively. The internal default formats will give +reasonable output formats and precision for both sky projection coordinates +and other types, e.g. spectral coordinates. +.le +.ls min_sigdigits = 7 +The minimum precision of the output coordinates if, the formatting parameters +are undefined, or the output world coordinate system is "world" and the wcs +format attribute is undefined. +.le +.ls verbose = yes +Print messages about the progress of the task. +.le + +.ih +DESCRIPTION + +WCSXYMATCH matches the logical x and y pixel coordinates of a set of points +in the input image \fIinput\fR with the logical x and y pixels coordinates +of the same points in the reference image \fIreference\fR +using world coordinate information +in the respective image headers, and writes the results to a coordinate file +\fIoutput\fR suitable for input to the GEOMAP task. +The input and reference images may be 1D or 2D but must both have +the same dimensionality. + +If \fIcoords\fR = "grid", WCSXYMATCH computes a grid of \fInx * ny\fR +logical x and y pixel coordinates evenly distributed over the +logical pixel space of the reference image as defined by the +\fIxmin\fR, \fIxmax\fR, \fIymin\fR, \fIymax\fR parameters. +The logical x and y pixel reference image coordinates are transformed to the +world coordinate system defined by \fIwcs\fR using +world coordinate information stored in the reference image header. +The world coordinates are then transformed back to the logical x and y pixel +input image coordinates, using world coordinate system information stored in +the input image header. + +If \fIcoords\fR is a file name, WCSXYMATCH reads a list of x and y +reference image world coordinates from columns \fIxcolumn\fR and \fIycolumn\fR +in the input coordinates file, and transforms these coordinates to +"native" coordinate units using the \fIxunits\fR and \fIyunits\fR parameters. +The reference image world coordinates are +transformed to logical reference and input image coordinates +using the value of the \fIwcs\fR parameter and world coordinate +information in the reference and input image headers. + +WCSXYMATCH will terminate with an error if the reference and input images +are not both either 1D or 2D. +If the world coordinate system information cannot be read from either +the reference or input image header, the requested transformations +from the world <-> logical coordinate systems cannot be compiled for either +or both images, or the world coordinate systems of the reference and input +images are fundamentally incompatible in some way, the output logical +reference and input image coordinates are both set to a grid of points +spanning the logical pixel space of the input, not the reference image, +and defining an identify transformation, is written to the output file. + +The computed reference and input logical coordinates and the +world coordinates are written to the output file using +the \fIxformat\fR and \fIyformat\fR, and the \fIwxformat\fR and \fIwxformat\fR +parameters respectively. If these formats are undefined and, in the +case of the world coordinates, a format attribute cannot be +read from either the reference or the input images, the coordinates are +output with the %g format and \fImin_sigdigits\fR of precision. + +If the reference and input images are 1D then the +output logical and world y coordinates are +set to 1. + +If \fIverbose\fR is "yes" then a title section is written to the output +file for each set of computed coordinates, along with messages about +what if anything went wrong with the computation. + +.ih +FORMATS + +A format specification has the form "%w.dCn", where w is the field +width, d is the number of decimal places or the number of digits of +precision, C is the format code, and n is radix character for +format code "r" only. The w and d fields are optional. The format +codes C are as follows: + +.nf +b boolean (YES or NO) +c single character (c or '\c' or '\0nnn') +d decimal integer +e exponential format (D specifies the precision) +f fixed format (D specifies the number of decimal places) +g general format (D specifies the precision) +h hms format (hh:mm:ss.ss, D = no. decimal places) +m minutes, seconds (or hours, minutes) (mm:ss.ss) +o octal integer +rN convert integer in any radix N +s string (D field specifies max chars to print) +t advance To column given as field W +u unsigned decimal integer +w output the number of spaces given by field W +x hexadecimal integer +z complex format (r,r) (D = precision) + + + +Conventions for w (field width) specification: + + W = n right justify in field of N characters, blank fill + -n left justify in field of N characters, blank fill + 0n zero fill at left (only if right justified) +absent, 0 use as much space as needed (D field sets precision) + +Escape sequences (e.g. "\n" for newline): + +\b backspace (not implemented) +\f formfeed +\n newline (crlf) +\r carriage return +\t tab +\" string delimiter character +\' character constant delimiter character +\\ backslash character +\nnn octal value of character + +Examples + +%s format a string using as much space as required +%-10s left justify a string in a field of 10 characters +%-10.10s left justify and truncate a string in a field of 10 characters +%10s right justify a string in a field of 10 characters +%10.10s right justify and truncate a string in a field of 10 characters + +%7.3f print a real number right justified in floating point format +%-7.3f same as above but left justified +%15.7e print a real number right justified in exponential format +%-15.7e same as above but left justified +%12.5g print a real number right justified in general format +%-12.5g same as above but left justified + +%h format as nn:nn:nn.n +%15h right justify nn:nn:nn.n in field of 15 characters +%-15h left justify nn:nn:nn.n in a field of 15 characters +%12.2h right justify nn:nn:nn.nn +%-12.2h left justify nn:nn:nn.nn + +%H / by 15 and format as nn:nn:nn.n +%15H / by 15 and right justify nn:nn:nn.n in field of 15 characters +%-15H / by 15 and left justify nn:nn:nn.n in field of 15 characters +%12.2H / by 15 and right justify nn:nn:nn.nn +%-12.2H / by 15 and left justify nn:nn:nn.nn + +\n insert a newline +.fi + +.ih +REFERENCES + +Additional information on IRAF world coordinate systems including +more detailed descriptions of the "logical", "physical", and "world" +coordinate systems can be +found in the help pages for the WCSEDIT and WCRESET tasks. +Detailed documentation for the IRAF world coordinate system +interface MWCS can be found in the file "iraf$sys/mwcs/MWCS.hlp". +This file can be formatted and printed with the command "help +iraf$sys/mwcs/MWCS.hlp fi+ | lprint". Information on the spectral +coordinates systems and their suitability for use with WCSXYMATCH +can be obtained by typing "help specwcs | lprint". +Details of the FITS header +world coordinate system interface can be found in the document +"World Coordinate Systems Representations Within the FITS Format" +by Hanisch and Wells, available from our anonymous ftp archive. + +.ih +EXAMPLES + +1. Compute a matched list of 100 logical x and y coordinates for an X-ray +and radio image of the same field, both of which have accurate sky +projection world coordinate systems. Print the output world coordinates +in hh:mm:ss.ss and dd:mm:ss.s format + +.nf + cl> wcsxymatch image refimage coords wxformat=%12.2H \ + wyformat=%12.1h +.fi + +2. Given a list of ras and decs of objects in the reference image, +compute a list of matched logical x and y coordinates for the two images, +both of which have a accurate sky projection wcss. The ras and decs are in +columns 3 and 4 of the input coordinate file and are in hh:mm:ss.ss and +dd:mm:ss.s format respectively. Print the output world coordinates +in the same units as the input. + +.nf + cl> wcsxymatch image refimage coords coords=radecs \ + xcolumn=3 ycolumn=4 xunits=hours wxformat=%12.2H \ + wyformat=%12.1h +.fi + +.ih +TIME REQUIREMENTS +.ih +BUGS +.ih +SEE ALSO +tprecess,wcstran,geomap,register,geotran,wcsmap,wregister +.endhelp diff --git a/pkg/images/immatch/doc/wregister.hlp b/pkg/images/immatch/doc/wregister.hlp new file mode 100644 index 00000000..e8519803 --- /dev/null +++ b/pkg/images/immatch/doc/wregister.hlp @@ -0,0 +1,761 @@ +.help wregister Dec98 images.immatch +.ih +NAME +wregister -- register a list of images to a reference image using WCS +information +.ih +USAGE +wregister input reference output +.ih +PARAMETERS +.ls input +The list of input images containing the input wcs. +.le +.ls reference +The list of reference images containing the reference wcs. The number of +reference images must be one or equal to the number of input images. +.le +.ls output +The list of output registered images. The number of output images must +be equal to the number of input images. +.le +.ls xmin = INDEF, xmax = INDEF, ymin = INDEF, ymax = INDEF +The minimum and maximum logical x and logical y coordinates used to, generate +the grid of reference image control points, define the region of validity of +the spatial transformation, and define the extent of the output image. +Xmin, xmax, ymin, and +ymax are assigned defaults of 1, the number of columns in the reference +image, 1, and the number of lines in the reference image, respectively. +.le +.ls nx = 10, ny = 10 +The number of points in x and y used to generate the coordinate grid. +.le +.ls wcs = "world" +The world coordinate system of the coordinates. The options are: +.ls physical +Physical coordinates are pixel coordinates which are invariant with +respect to linear transformations of the physical image data. For example, +if the reference +image is a rotated section of a larger input image, the physical +coordinates of an object in the reference image are equal to the physical +coordinates of the same object in the input image, although the logical +pixel coordinates are different. +.le +.ls world +World coordinates are image coordinates which are invariant with +respect to linear transformations of the physical image data and which +are in world units, normally decimal degrees for sky projection coordinate +systems and angstroms for spectral coordinate systems. Obviously if the +wcs is correct the ra and dec or wavelength and position of an object +should remain the same not matter how the image +is linearly transformed. The default world coordinate +system is either 1) the value of the environment variable "defwcs" if +set in the user's IRAF environment (normally it is undefined) and present +in the image header, 2) the value of the "system" +attribute in the image header keyword WAT0_001 if present in the +image header or, 3) the "physical" coordinate system. +Care must be taken that the wcs of the input and +reference images are compatible, e.g. it makes no sense to +match the coordinates of a 2D sky projection and a 2D spectral wcs. +.le +.le +.ls transpose = no +Force a transpose of the reference image world coordinates before evaluating +the world to logical coordinate transformation for the input image ? This +option is useful if there is not enough information in the reference and +input image headers to tell whether or not the images are transposed with +respect to each other. +.le +.ls xformat = "%10.3f", yformat = "%10.3f" +The format of the output logical x and y reference and input pixel +coordinates in columns 1 and 2 and 3 and 4 respectively. By default the +coordinates are output right justified in a field of ten spaces with +3 digits following the decimal point. +.le +.ls wxformat = "", wyformat = "" +The format of the output world x and y reference and input image coordinates +in columns 5 and 6 respectively. The internal default formats will give +reasonable output formats and precision for both sky projection coordinates +and other, e.g. spectral, coordinates. +.le +.ls fitgeometry = "general" +The fitting geometry to be used. The options are the following. +.ls shift +X and y shifts only are fit. +.le +.ls xyscale +X and y shifts and x and y magnification factors are fit. Axis flips are +allowed for. +.le +.ls rotate +X and y shifts and a rotation angle are fit. Axis flips are allowed for. +.le +.ls rscale +X and y shifts, a magnification factor assumed to be the same in x and y, and a +rotation angle are fit. Axis flips are allowed for. +.le +.ls rxyscale +X and y shifts, x and y magnifications factors, and a rotation angle are fit. +Axis flips are allowed for. +.le +.ls general +A polynomial of arbitrary order in x and y is fit. A linear term and a +distortion term are computed separately. The linear term includes an x and y +shift, an x and y scale factor, a rotation and a skew. Axis flips are also +allowed for in the linear portion of the fit. The distortion term consists +of a polynomial fit to the residuals of the linear term. By default the +distortion terms is set to zero. +.le + +For all the fitting geometries except "general" no distortion term is fit, +i.e. the x and y polynomial orders are assumed to be 2 and the cross term +switches are set to "none", regardless of the values of the \fIxxorder\fR, +\fIxyorder\fR, \fIxxterms\fR, \fIyxorder\fR, \fIyyorder\fR and \fIyxterms\fR +parameters set by the user. +.le +.ls function = "polynomial" +The type of analytic coordinate surfaces to be fit. The options are the +following: +.ls legendre +Legendre polynomials in x and y. +.le +.ls chebyshev +Chebyshev polynomials in x and y. +.le +.ls polynomial +Power series polynomials in x and y. +.le +.le +.ls xxorder = 2, xyorder = 2, yxorder = 2, yyorder = 2 +The order of the polynomials in x and y for the x and y fits respectively. +The default order and cross term settings define the linear term in x +and y, where the 6 coefficients can be interpreted in terms of an x and y shift, +an x and y scale change, and rotations of the x and y axes. The "shift", +"xyscale", "rotation", "rscale", and "rxyscale", fitting geometries +assume that the polynomial order parameters are 2 regardless of the values +set by the user. If any of the order parameters are higher than 2 and +\fIfitgeometry\fR is "general", then a distortion surface is fit to the +residuals from the linear portion of the fit. +.le +.ls xxterms = "half", yxterms = "half" +The options are: +.ls none +The individual polynomial terms contain powers of x or powers of y but not +powers of both. +.le +.ls half +The individual polynomial terms contain powers of x and powers of y, whose +maximum combined power is MAX (xxorder - 1, xyorder - 1) for the x fit and +MAX (yxorder - 1, yyorder - 1) for the y fit. +.le +.ls full +The individual polynomial terms contain powers of x and powers of y, whose +maximum combined power is MAX (xxorder - 1 + xyorder - 1) for the x fit and +MAX (yxorder - 1 + yyorder - 1) for the y fit. +.le + +The "shift", "xyscale", "rotation", "rscale", and "rxyscale" fitting +geometries, assume that the cross term switches are set to "none"regardless +of the values set by the user. If either of the cross terms parameters is +set to "half" or "full" and \fIfitgeometry\fR is "general" then a distortion +surface is fit to the residuals from the linear portion of the fit. +.le +.ls reject = INDEF +The rejection limit in units of sigma. The default is no rejection. +.le +.ls calctype = "real" +The precision of coordinate transformation calculations. The options are "real" +and "double". +.le +.ls geometry = "geometric" +The type of geometric transformation. The options are: +.ls linear +Perform only the linear part of the geometric transformation. +.le +.ls geometric +Compute both the linear and distortion portions of the geometric correction. +.le +.le +.ls xsample = 1.0, ysample = 1.0 +The coordinate surface subsampling factor. The coordinate surfaces are +evaluated at every xsample-th pixel in x and every ysample-th pixel in y. +Transformed coordinates at intermediate pixel values are determined by +bilinear interpolation in the coordinate surfaces. If the coordinate +surface is of high order setting these numbers to some reasonably high +value is recommended. +.le +.ls interpolant = "linear" +The interpolant used for rebinning the image. The choices are the following. +.ls nearest +Nearest neighbor. +.le +.ls linear +Bilinear interpolation in x and y. +.le +.ls poly3 +Third order polynomial in x and y. +.le +.ls poly5 +Fifth order polynomial in x and y. +.le +.ls spline3 +Bicubic spline. +.le +.ls sinc +2D sinc interpolation. Users can specify the sinc interpolant width by +appending a width value to the interpolant string, e.g. sinc51 specifies +a 51 by 51 pixel wide sinc interpolant. The sinc width will be rounded up to +the nearest odd number. The default sinc width is 31 by 31. +.le +.ls lsinc +Look-up table sinc interpolation. Users can specify the look-up table sinc +interpolant width by appending a width value to the interpolant string, e.g. +lsinc51 specifies a 51 by 51 pixel wide look-up table sinc interpolant. The user +supplied sinc width will be rounded up to the nearest odd number. The default +sinc width is 31 by 31 pixels. Users can specify the resolution of the lookup +table sinc by appending the look-up table size in square brackets to the +interpolant string, e.g. lsinc51[20] specifies a 20 by 20 element sinc +look-up table interpolant with a pixel resolution of 0.05 pixels in x and y. +The default look-up table size and resolution are 20 by 20 and 0.05 pixels +in x and y respectively. +.le +.ls drizzle +2D drizzle resampling. Users can specify the drizzle pixel fraction in x and y +by appending a value between 0.0 and 1.0 in square brackets to the +interpolant string, e.g. drizzle[0.5]. The default value is 1.0. +The value 0.0 is increased internally to 0.001. Drizzle resampling +with a pixel fraction of 1.0 in x and y is equivalent to fractional pixel +rotated block summing (fluxconserve = yes) or averaging (flux_conserve = no) if +xmag and ymag are > 1.0. +.le +.le +.ls boundary = "nearest" +The choices are: +.ls nearest +Use the value of the nearest boundary pixel. +.le +.ls constant +Use a user supplied constant value. +.le +.ls reflect +Generate a value by reflecting about the boundary of the image. +.le +.ls wrap +Generate a value by wrapping around to the opposite side of the image. +.le +.le +.ls constant = 0.0 +The value of the constant for boundary extension. +.le +.ls fluxconserve = yes +Preserve the total image flux? If flux conservation is turned on, the output +pixel values are multiplied by the Jacobian of the coordinate transformation. +.le +.ls nxblock = 512, nyblock = 512 +If the size of the output image is less than nxblock by nyblock then the +entire image is computed in one iteration. Otherwise the output image is +computed in blocks of nxblock by nyblock pixels. +.le +.ls wcsinherit = yes +Inherit the wcs of the reference image ? +.le +.ls verbose = yes +Print messages about the progress of the task? +.le +.ls interactive = no +Run the task interactively ? +In interactive mode the user may interact with the fitting process, e.g. +change the order of the fit, delete points, replot the data etc. +.le +.ls graphics = "stdgraph" +The graphics device. +.le +.ls gcommands = "" +The graphics cursor. +.le + +.ih +DESCRIPTION + +WREGISTER computes the spatial transformation function required to register +the input image \fIinput\fR to the reference image \fIreference\fR, +and writes the registered input image to the output image \fIoutput\fR. +The input and reference images must be one- or two-dimensional and +have the same dimensionality. WREGISTER assumes that the world +coordinate systems in the input and reference +image headers are accurate and that the two systems are compatible, e.g. both +images have the same epoch sky projection world coordinate systems, or both are +spectra whose coordinates are in the same units. + +WREGISTER computes the required spatial transformation by matching the logical +x and y pixel coordinates of a grid of points +in the input image with the logical x and y pixels coordinates +of the same grid of points in the reference image, +using world coordinate information stored in the two image headers. +The coordinate grid consists of \fInx * ny\fR points evenly distributed +over the logical pixel space of interest in the reference image defined by the +\fIxmin\fR, \fIxmax\fR, \fIymin\fR, \fIymax\fR parameters. +The logical x and y pixel reference image coordinates are transformed to the +reference image world coordinate system defined by \fIwcs\fR, using the wcs +information in the reference image header. +The reference image world coordinates are then transformed to logical x and +y pixel coordinates in the input image, using world coordinate system +information stored in the input image header. + +The computed reference and input logical coordinates and the +world coordinates are written to a temporary coordinates file which is +deleted on task termination. +The x and y coordinates are written using +the \fIxformat\fR and \fIyformat\fR and the \fIwxformat\fR and \fIwxformat\fR +parameters respectively. If these formats are undefined and, in the +case of the world coordinates a format attribute cannot be +read from either the reference or the input images, the coordinates are +output in %g format with \fImin_sigdigits\fR digits of precision. +If the reference and input images are 1D then all the output logical and +world y coordinates are set to 1. + +WREGISTER computes a spatial transformation of the following form. + +.nf + xin = f (xref, yref) + yin = g (xref, yref) +.fi + +The functions f and g are either a power series polynomial or a Legendre or +Chebyshev polynomial surface of order +\fIxxorder\fR and \fIxyorder\fR in x and \fIyxorder\fR and \fIyyorder\fR in y. + +Several polynomial cross terms options are available. Options "none", +"half", and "full" are illustrated below for a quadratic polynomial in +x and y. + +.nf +xxterms = "none", xyterms = "none" +xxorder = 3, xyorder = 3, yxorder = 3, yyorder = 3 + + xin = a11 + a21 * xref + a12 * yref + + a31 * xref ** 2 + a13 * yref ** 2 + yin = a11' + a21' * xref + a12' * yref + + a31' * xref ** 2 + a13' * yref ** 2 + +xxterms = "half", xyterms = "half" +xxorder = 3, xyorder = 3, yxorder = 3, yyorder = 3 + + xin = a11 + a21 * xref + a12 * yref + + a31 * xref ** 2 + a22 * xref * yref + a13 * yref ** 2 + yin = a11' + a21' * xref + a12' * yref + + a31' * xref ** 2 + a22' * xref * yref + a13' * yref ** 2 + +xxterms = "full", xyterms = "full" +xxorder = 3, xyorder = 3, yxorder = 3, yyorder = 3 + + xin = a11 + a21 * xref + a31 * xref ** 2 + + a12 * yref + a22 * xref * yref + a32 * xref ** 2 * yref + + a13 * yref ** 2 + a23 * xref * yref ** 2 + + a33 * xref ** 2 * yref ** 2 + yin = a11' + a21' * xref + a31' * xref ** 2 + + a12' * yref + a22' * xref * yref + a32' * xref ** 2 * yref + + a13' * yref ** 2 + a23' * xref * yref ** 2 + + a33' * xref ** 2 * yref ** 2 +.fi + + +If the \fBfitgeometry\fR parameter is anything other than "general", the order +parameters assume the value 2 and the cross terms switches assume the value +"none", regardless of the values set by the user. The computation can be done in +either real or double precision by setting the \fIcalctype\fR parameter. +Automatic pixel rejection may be enabled by setting the \fIreject\fR +parameter to some number > 0.0. + +The transformation computed by the "general" fitting geometry is arbitrary +and does not correspond to a physically meaningful model. However the computed +coefficients for the linear term can be given a simple geometrical geometric +interpretation for all the fitting geometries as shown below. + +.nf + fitting geometry = general (linear term) + xin = a + b * xref + c * yref + yin = d + e * xref + f * yref + + fitting geometry = shift + xin = a + xref + yin = d + yref + + fitting geometry = xyscale + xin = a + b * xref + yin = d + f * yref + + fitting geometry = rotate + xin = a + b * xref + c * yref + yin = d + e * xref + f * yref + b * f - c * e = +/-1 + b = f, c = -e or b = -f, c = e + + fitting geometry = rscale + xin = a + b * xref + c * yref + yin = d + e * xref + f * yref + b * f - c * e = +/- const + b = f, c = -e or b = -f, c = e + + fitting geometry = rxyscale + xin = a + b * xref + c * yref + yin = d + e * xref + f * yref + b * f - c * e = +/- const +.fi + + +The coefficients can be interpreted as follows. Xref0, yref0, xin0, yin0 +are the origins in the reference and input frames respectively. Orientation +and skew are the orientation of the x and y axes and their deviation from +perpendicularity respectively. Xmag and ymag are the scaling factors in x and +y and are assumed to be positive. + +.nf + general (linear term) + xrotation = rotation - skew / 2 + yrotation = rotation + skew / 2 + b = xmag * cos (xrotation) + c = ymag * sin (yrotation) + e = -xmag * sin (xrotation) + f = ymag * cos (yrotation) + a = xin0 - b * xref0 - c * yref0 = xshift + d = yin0 - e * xref0 - f * yref0 = yshift + + shift + xrotation = 0.0, yrotation = 0.0 + xmag = ymag = 1.0 + b = 1.0 + c = 0.0 + e = 0.0 + f = 1.0 + a = xin0 - xref0 = xshift + d = yin0 - yref0 = yshift + + xyscale + xrotation 0.0 / 180.0 yrotation = 0.0 + b = + /- xmag + c = 0.0 + e = 0.0 + f = ymag + a = xin0 - b * xref0 = xshift + d = yin0 - f * yref0 = yshift + + rscale + xrotation = rotation + 0 / 180, yrotation = rotation + mag = xmag = ymag + const = mag * mag + b = mag * cos (xrotation) + c = mag * sin (yrotation) + e = -mag * sin (xrotation) + f = mag * cos (yrotation) + a = xin0 - b * xref0 - c * yref0 = xshift + d = yin0 - e * xref0 - f * yref0 = yshift + + rxyscale + xrotation = rotation + 0 / 180, yrotation = rotation + const = xmag * ymag + b = xmag * cos (xrotation) + c = ymag * sin (yrotation) + e = -xmag * sin (xrotation) + f = ymag * cos (yrotation) + a = xin0 - b * xref0 - c * yref0 = xshift + d = yin0 - e * xref0 - f * yref0 = yshift +.fi + + +\fIXmin\fR, \fIxmax\fR, \fIymin\fR and \fIymax\fR define the region of +validity of the transformation as well as the limits of the grid +in the reference coordinate system. + +Each computed transformation is written to a temporary output text database +file which is deleted on task termination. If more that one record of the same +name is written to the database file, the last record written is the +valid record. + +WREGISTER will terminate with an error if the reference and input images +are not both either 1D or 2D. +If the world coordinate system information cannot be read from either +the reference or input image header, the requested transformations +from the world <-> logical coordinate systems cannot be compiled for either +or both images, or the world coordinate systems of the reference and input +images are fundamentally incompatible in some way, the output logical +reference and input image coordinates are both set to a grid of points +spanning the logical pixel space of the input, not the reference image. +This grid of points defines an identity transformation which results in +an output image equal to the input image. + +WREGISTER computes the output image by evaluating the fitted coordinate +surfaces and interpolating in the input image at position of the transformed +coordinates. The scale of the output image is the same as the scale of the +reference image. The extent and size of the output image are determined +by the \fIxmin\fR, \fIxmax\fR, \fIymin\fR, and \fIymax\fR parameters +as shown below + +.nf + xmin <= x <= xmax + ymin <= x <= ymax + ncols = xmax - xmin + 1 + nlines = xmax - xmin + 1 +.fi + +WREGISTER samples the coordinate surfaces at every \fIxsample\fR and +fIysample\fR pixels in x and y. +The transformed coordinates at intermediate pixel values are +determined by bilinear interpolation in the coordinate surface. If +\fIxsample\fR and \fIysample\fR = 1, the coordinate +surface is evaluated at every pixel. Use of \fIxsample\fR and \fIysample\fR +are strongly recommended for large images and high order coordinate +surfaces in order to reduce the time required to compute the output image. + +The output image gray levels are determined by interpolating in the input +image at the positions of the transformed output pixels using the +interpolant specified by the \fIinterpolant\fR parameter. If the +\fIfluxconserve\fR switch is set the output pixel values are multiplied by +the Jacobian of the transformation, which preserves the flux of the entire +image. Out-of-bounds pixels are evaluated using the \fIboundary\fR and +\fIconstant\fR parameters. + +The output image is computed in \fInxblock\fR by \fInyblock\fR pixel sections. +If possible users should set these number to values larger than the dimensions +of the output image to minimize the number of disk reads and writes required +to compute the output image. If this is not feasible and the image rotation is +small users should set nxblock to be greater than the number of columns in +the output image, and nyblock to be as large as machine memory will permit. + +If \fIwcsinherit\fR is "yes" then the world coordinate system of the +reference image will be copied to the output image. +Otherwise if the environment variable \fInomwcs\fR is "no" the +world coordinate +system of the input image is modified in the output image to reflect the +effects of the \fIlinear\fR portion of the registration operation. +Support does not yet exist in the IRAF world coordinate system interface +for the higher order distortion corrections that WREGISTER is capable +of performing. + +If \fIverbose\fR is "yes" then messages about the progress of the task +as well as warning messages indicating potential problems +are written to the standard output. + +WREGISTER may be run interactively by setting the \fIinteractive\fR +parameter to "yes". +In interactive mode the user has the option of viewing the fitted +spatial transformation, changing the +fit parameters, deleting and undeleting points, and replotting +the data until a satisfactory +fit has been achieved. + +.ih +CURSOR COMMANDS + +In interactive mode the following cursor commands are currently available. + +.nf + Interactive Keystroke Commands + +? Print options +f Fit the data and graph with the current graph type (g, x, r, y, s) +g Graph the data and the current fit +x,r Graph the x fit residuals versus x and y respectively +y,s Graph the y fit residuals versus x and y respectively +d,u Delete or undelete the data point nearest the cursor +o Overplot the next graph +c Toggle the constant x, y plotting option +t Plot a line of constant x, y through the nearest data point +l Print xshift, yshift, xmag, ymag, xrotate, yrotate +q Exit the interactive curve fitting +.fi + +The parameters listed below can be changed interactively with simple colon +commands. Typing the parameter name alone will list the current value. + +.nf + Colon Parameter Editing Commands + +:show List parameters +:fitgeometry Fitting geometry (shift,xyscale,rotate, + rscale,rxyscale,general) +:function [value] Fitting function (chebyshev,legendre, + polynomial) +:xxorder :xyorder [value] X fitting function xorder, yorder +:yxorder :yyorder [value] Y fitting function xorder, yorder +:xxterms :yxterms [nh/f] X, Y fit cross terms fit +:reject [value] Rejection threshold +.fi + + +.ih +FORMATS + +A format specification has the form "%w.dCn", where w is the field +width, d is the number of decimal places or the number of digits of +precision, C is the format code, and n is radix character for +format code "r" only. The w and d fields are optional. The format +codes C are as follows: + +.nf +b boolean (YES or NO) +c single character (c or '\c' or '\0nnn') +d decimal integer +e exponential format (D specifies the precision) +f fixed format (D specifies the number of decimal places) +g general format (D specifies the precision) +h hms format (hh:mm:ss.ss, D = no. decimal places) +m minutes, seconds (or hours, minutes) (mm:ss.ss) +o octal integer +rN convert integer in any radix N +s string (D field specifies max chars to print) +t advance To column given as field W +u unsigned decimal integer +w output the number of spaces given by field W +x hexadecimal integer +z complex format (r,r) (D = precision) + + + +Conventions for w (field width) specification: + + W = n right justify in field of N characters, blank fill + -n left justify in field of N characters, blank fill + 0n zero fill at left (only if right justified) +absent, 0 use as much space as needed (D field sets precision) + +Escape sequences (e.g. "\n" for newline): + +\b backspace (not implemented) +\f formfeed +\n newline (crlf) +\r carriage return +\t tab +\" string delimiter character +\' character constant delimiter character +\\ backslash character +\nnn octal value of character + +Examples + +%s format a string using as much space as required +%-10s left justify a string in a field of 10 characters +%-10.10s left justify and truncate a string in a field of 10 characters +%10s right justify a string in a field of 10 characters +%10.10s right justify and truncate a string in a field of 10 characters + +%7.3f print a real number right justified in floating point format +%-7.3f same as above but left justified +%15.7e print a real number right justified in exponential format +%-15.7e same as above but left justified +%12.5g print a real number right justified in general format +%-12.5g same as above but left justified + +%h format as nn:nn:nn.n +%15h right justify nn:nn:nn.n in field of 15 characters +%-15h left justify nn:nn:nn.n in a field of 15 characters +%12.2h right justify nn:nn:nn.nn +%-12.2h left justify nn:nn:nn.nn + +%H / by 15 and format as nn:nn:nn.n +%15H / by 15 and right justify nn:nn:nn.n in field of 15 characters +%-15H / by 15 and left justify nn:nn:nn.n in field of 15 characters +%12.2H / by 15 and right justify nn:nn:nn.nn +%-12.2H / by 15 and left justify nn:nn:nn.nn + +\n insert a newline +.fi + +.ih +REFERENCES + +Additional information on IRAF world coordinate systems including +more detailed descriptions of the "logical", "physical", and "world" +coordinate systems can be +found in the help pages for the WCSEDIT and WCRESET tasks. +Detailed documentation for the IRAF world coordinate system +interface MWCS can be found in the file "iraf$sys/mwcs/MWCS.hlp". +This file can be formatted and printed with the command "help +iraf$sys/mwcs/MWCS.hlp fi+ | lprint". Information on the spectral +coordinates systems and their suitability for use with WCSXYMATCH +can be obtained by typing "help specwcs | lprint". +Details of the FITS header +world coordinate system interface can be found in the document +"World Coordinate Systems Representations Within the FITS Format" +by Hanisch and Wells, available from our anonymous ftp archive. + +.ih +EXAMPLES + +1. Register a radio image to an X-ray image of the same field using +a 100 point coordinate grid and a simple linear transformation. Both +images have accurate sky projection world coordinate systems. Print the +output world coordinates in the coords file in hh:mm:ss.ss and dd:mm:ss.s +format. Display the input and output image and blink them. + +.nf + cl> wregister radio xray radio.tran wxformat=%12.2H \ + wyformat=%12.1h + + cl> display radio 1 fi+ + + cl> display radio.tran 2 fi+ +.fi + +2. Repeat the previous command but begin with a higher order fit +and run the task in interactive mode in order to examine the fit +residuals. + +.nf + cl> wregister radio xray radio.tran wxformat=%12.2H \ + wyformat=%12.1h xxo=4 xyo=4 xxt=half yxo=4 yyo=4 \ + yxt=half inter+ + + ... a plot of the fit appears + + ... type x and r to examine the residuals of the x + surface fit versus x and y + + ... type y and s to examine the residuals of the y + surface fit versus x and y + + ... delete 2 deviant points with the d key and + recompute the fit with the f key + + ... type q to quit, save the fit, and compute the registered + image +.fi + +3. Mosaic a set of 9 images covering a ~ 1 degree field into a single image +centered at 12:32:53.1 +43:13:03. Set the output image scale to 0.5 +arc-seconds / pixel which is close the detector scale of 0.51 arc-seconds +per pixel. Set the orientation to be north up and east to the left. +The 9 images all have accurate world coordinate information in their headers. + +.nf + # Create a dummy reference image big enough to cover 1 square degree + + cl> mkpattern refimage ncols=7200 nlines=7200 ... + + # Give the dummy reference image the desired coordinate system + + cl> ccsetwcs refimage "" xref=3600.5 yref=3600.5 xmag=-0.5 \ + ymag=0.5 lngref=12:32:53.1 latref=43:13:03 ... + + # Register the images using constant boundary extension and + # set uservalue to some reasonable value outside the good data + # range. Note that it may be possible to improve performance by + #increasing nxblock and nyblock. + + cl> wregister @inlist refimage @outlist boundary=constant \ + constant=<uservalue> nxblock=7200 nyblock=1024 ... + + # Combine the images using imcombine + + cl> imcombine @outlist mosaic lthreshold=<uservalue> ... + +.fi + +.ih +TIME REQUIREMENTS +.ih +BUGS +.ih +SEE ALSO +imalign,xregister,tprecess,wcsxymatch,geomap,gregister,geotran,wcscopy +.endhelp diff --git a/pkg/images/immatch/doc/xregister.hlp b/pkg/images/immatch/doc/xregister.hlp new file mode 100644 index 00000000..b0690118 --- /dev/null +++ b/pkg/images/immatch/doc/xregister.hlp @@ -0,0 +1,707 @@ +.help xregister Dec98 images.immatch +.ih +NAME +xregister -- register 1 and 2D images using X-correlation techniques +.ih +USAGE +xregister input reference regions shifts +.ih +PARAMETERS +.ls input +The list of input images to be registered. +.le +.ls reference +The list of reference images to which the input images are to be registered. +The number of reference images must be one or equal to the number of input +images. +.le +.ls regions +The list of reference image region(s) used to compute the +x and y shifts. +\fIRegions\fR may be: 1) a list of one or more image sections +separated by whitespace, 2) the name of a text file containing a list +of one or more image sections separated by whitespace and/or newlines, +3) a string of the form "grid nx ny" defining a grid of nx by ny +equally spaced and sized image sections spanning the entire image. Shifts are +computed for each specified region individually and averaged to produce the +final x and y shift. +.le +.ls shifts +The name of the text file where the computed x and y shifts +are written. If \fIdatabasefmt\fR is "yes", a single record containing the +computed x and y shifts for each image region and the final average x and y +shift is written to a text database file for each input image. +If \fIdatabasefmt\fR = "no", a single line containing the image name and the +final average x and y shift is written to a simple text file +for each input image. +.le +.ls output = "" +The list of output shifted images. If \fIoutput\fR is the NULL string +then x and y shifts are computed for each input image and written to +\fIshifts\fR but no output images are written. If \fIoutput\fR is not NULL +then the number of output images must equal the number of input images. +.le +.ls databasefmt = yes +If \fIdatabasefmt\fR is "yes" the results are written to a text database +file, otherwise they are written to a simple text file. +.le +.ls records = "" +The list of records to be written to or read from \fIshifts\fR for each +input image. If \fIrecords\fR is NULL then the output or input record names +are assumed to be the names of the input images. If \fIrecords\fR is not NULL +then the record names in \fIrecords\fR are used to write / read the +records. This parameter is useful for users +who, wish to compute the x and y shifts using images that have been processed +in some manner (e.g. smoothed), but apply the computed x and y shifts to the +original unprocessed images. If more then one record +with the same name exists in \fIshifts\fR then the most recently written +record takes precedence. The records parameter is ignored if +\fIdatabasefmt\fR is "no". +.le +.ls append = yes +Append new records to an existing \fIshifts\fR file or start a new shifts +file for each execution of XREGISTER? The append parameter is ignored +if \fIdatabasefmt\fR is "no". +.le +.ls coords = "" +An optional list of coordinates files containing the x and y coordinates of +an object in the reference image on the first line and the x and y coordinates +of the same object in the input image(s) on succeeding lines. The number +of coordinate files must be equal to the number of reference images. +The input coordinates are used to compute initial +values for the x and y lags between the input image and the reference image, +and supersede any non-zero values of \fIxlag\fR, \fIylag\fR, \fIdxlag\fR, +and \fIdylag\fR supplied by the user. +.le +.ls xlag = 0, ylag = 0 +The initial x and y lags of the input image with respect to the reference +image. Positive values imply that the input image is shifted +in the direction of increasing x and y values with respect to the +reference image. \fIXlag\fR and \fIylag\fR are overridden if an offset +has been determined using the x and y coordinates in the \fIcoords\fR file. +.le +.ls dxlag = 0, dylag = 0 +The increment in \fIxlag\fR and \fIylag\fR to be applied to successive input +images. If \fIdxlag\fR and \fIdylag\fR are set to INDEF then the +computed x and y lags for the previous image are used as the initial +x and y lags for the current image. This option is useful for images which +were taken as a time sequence and whose x and y the shifts increase or +decrease in a systematic manner. +\fIDxlag\fR and \fIdylag\fR are overridden if an offset +has been determined using x and y coordinates in the \fIcoords\fR file. +.le +.ls background = none +The default background function to be subtracted from the input +and reference image data in each region before the +cross-correlation function is computed. The options are: +.ls none +no background subtraction is done. +.le +.ls mean +the mean of the reference and input image region is computed and subtracted +from the image data. +.le +.ls median +the median of the reference and input image region is computed and subtracted +from the data. +.le +.ls plane +a plane is fit to the reference and input image region and subtracted +from the data. +.le + +By default the cross-correlation function is computed in a manner +which removes the mean intensity in the reference and input image regions +from the data. For many data sets this "correction" is sufficient to +remove first order background level effects +from the computed cross-correlation function and no additional +background subtraction is required. +.le +.ls border = INDEF +The width of the border region around the input and reference image data +regions used to compute the background function if \fIbackground\fR +is not "none". By default the entire region is used. +.le +.ls loreject = INDEF, ls hireject = INDEF +The k-sigma rejection limits for removing the effects of bad data from the +background fit. +.le +.ls apodize = 0.0 +The fraction of the input and reference image data endpoints in x and y +to apodize with a +cosine bell function before the cross-correlation function is computed. +.le +.ls filter = none +The spatial filter to be applied to the reference and input image +data before the cross-correlation function is computed. The options are: +.ls none +no spatial filtering is performed. +.le +.ls laplace +a Laplacian filter is applied to the reference and input image data. +.le +.le +.ls correlation = discrete +The algorithm used to compute the cross-correlation function. The options +are: +.ls discrete +The cross-correlation function is calculated by computing the discrete +convolution of the reference and input image regions over the x and y +window of interest. This technique is most efficient method for small +cross-correlation function x and y search windows. +.le +.ls fourier +The cross-correlation function is calculated by computing the convolution +of the reference and input image regions using Fourier techniques. +This technique is the most efficient method for computing the +cross-correlation function for small x and y search windows. +.le +.ls difference +The cross-correlation function is calculated by computing the error +function of the reference and input images as a function of position +in the x and y search window. +.le +.ls file +No cross-correlation function is computed. Instead the previously +computed x and y shifts are read from record \fIrecord\fR in the text +database file \fIshifts\fR if \fIdatabasefmt\fR is "yes", or the +next line of a simple text file if \fIdatabasefmt\fR is "no". +.le +.le +.ls xwindow = 11, ywindow = 11 +The x and y width of the cross-correlation function region +to be computed and/or searched for peaks. The search window corresponds +to shifts of - xwindow / 2 <= xshift <= xwindow /2 and - ywindow / 2 <= +yshift <= ywindow / 2. \fIXwindow\fR and \fIywindow\fR +are automatically rounded up to the next nearest odd number. +.le +.ls function = centroid +The algorithm used to compute the x and y position of the cross-correlation +function peak. The options are: +.ls none +the position of the cross-correlation function peak is set to +x and y position of the maximum pixel. +.le +.ls centroid +the position of the cross-correlation function peak is calculated +by computing the intensity-weighted mean of the marginal profiles of +the cross-correlation function in x and y. +.le +.ls sawtooth +the position of the cross-correlation function peak is calculated +by convolving 1D slices in x and y through the cross-correlation function +with a 1D sawtooth function and using the point at which the peak is +bisected to determine the x and y position of the cross-correlation +peak. +.le +.ls parabolic +a 1D parabola is fit to 1D slices in x and y through the cross-correlation +function and the fitted coefficients are used to compute the peak of +the cross-correlation function. +.le +.ls mark +mark the peak of the cross-correlation function with the graphics cursor. +This option will only work if \fIinteractive\fR = "yes". +.le +.le +.ls xcbox = 5, ycbox = 5 +The width of the box centered on the peak of the cross-correlation function +used to compute the fractional pixel x and y center. +.le +.ls interp_type = "linear" +The interpolant type use to computed the output shifted image. +The choices are the following: +.ls nearest +nearest neighbor. +.le +.ls linear +bilinear interpolation in x and y. +.le +.ls poly3 +third order interior polynomial in x and y. +.le +.ls poly5 +fifth order interior polynomial in x and y. +.le +.ls spline3 +bicubic spline. +.le +.ls sinc +2D sinc interpolation. Users can specify the sinc interpolant width by +appending a width value to the interpolant string, e.g. sinc51 specifies +a 51 by 51 pixel wide sinc interpolant. The sinc width input by the +user will be rounded up to the nearest odd number. The default sinc width +is 31 by 31. +.le +.ls drizzle +2D drizzle resampling. Users can specify the drizzle pixel fractions in x and y +by appending values between 0.0 and 1.0 in square brackets to the +interpolant string, e.g. drizzle[0.5]. The default value is 1.0. The +value 0.0 is increased to 0.001. Drizzle resampling with a pixel fraction +of 1.0 in x and y is identical to bilinear interpolation. +.le +.le +.ls boundary_type = "nearest" +The boundary extension algorithm used to compute the output shifted +image. The choices are: +.ls nearest +use the value of the nearest boundary pixel. +.le +.ls constant +use a constant value. +.le +.ls reflect +generate a value by reflecting about the boundary. +.le +.ls wrap +generate a value by wrapping around to the opposite side of the image. +.le +.le +.ls constant = 0 +The default constant for constant boundary extension. +.le +.ls interactive = no +Compute the cross-correlation function and the shifts for each image +interactively using graphics cursor and optionally image cursor input. +.le +.ls verbose +Print messages about the progress of the task during task execution +in non-interactive mode. +.le +.ls graphics = "stdgraph" +The default graphics device. +.le +.ls display = "stdimage" +The default image display device. +.le +.ls gcommands = "" +The default graphics cursor. +.le +.ls icommands = "" +The default image display cursor. +.le + +.ih +DESCRIPTION + +XREGISTER computes the x and y shifts required to register a list of input +images \fIinput\fR to a list of reference images \fIreference\fR using +cross-correlation techniques. The computed x and y shifts are stored +in the text file \fIshifts\fR, in the records \fIrecords\fR if +\fIdatabasefmt\fR is "yes" or a single line of a simple text file +if \fIdatabasefmt\fR is "no". One entry is made in the shifts file for +each input image. If a non NULL list of output images +\fIoutput\fR is supplied a shifted output image is written for each input +image. XREGISTER is intended to solve 1D and 2D image registration problems +where the images have the same size, the same pixel scale, are shifted +relative to +each other by simple translations in x and y, and contain one or more +extended features in common that will produce a peak in the computed +cross-correlation function. + +The reference image regions used to compute the cross-correlation +function shifts are defined by the parameter +\fIregions\fR. \fIRegions\fR may be: +1) a list of one or more image sections, e.g. +"[100:200,100:200] [400:500,400:500]" separated +by whitespace, 2) the name of a text file containing a list of one or +more image sections separated by whitespace and / or newline characters, +or, 3) a string +of the form "grid nx ny" specifying a grid of nx by ny +image sections spanning the entire reference image. +All reference image regions should be chosen so as to +include at least one well-defined object or feature. Cross-correlation +functions and x and y shifts are computed independently for each +reference image region +and averaged to produce the final x and y shift for each input image. + +By default the initial x and y lags between the input and reference +image are assumed to by 0.0 and 0.0 +respectively and each reference image region is cross-correlated +with the identical region in the input image, e.g reference image +region [100:200,100:200] is cross-correlated with input image +region [100:200,100:200]. + +Non-zero initial guesses for +the x and y shifts for each input image can be input to XREGISTER using +the coordinates file parameter \fIcoords\fR. +\fICoords\fR is a simple text file containing the x +and y coordinates of a single +object in the reference image in columns one and two +of line one, and the x and y coordinates of the same object in the first +input image in columns one and two of line two, etc. If \fIcoords\fR +is defined there must be one coordinate file for every reference image. +If there are fewer lines of text in \fIcoords\fR than there are +numbers of reference plus input images, then x and y shifts of 0.0 are +assumed for the extra input images. For example, +if the user specifies a single input and reference image, sets the +\fIregions\fR parameter to "[100:200,100:200]", and defines +a coordinates file which contains the numbers +50.0 50.0 in columns one and two of line one, and the numbers 52.0 and 52.0 +in columns one and two of line two, then the initial x and y +lags for the input image with respect to the reference image will be 2.0 +and 2.0 respectively, and the reference image region [100:200,100:200] will be +cross-correlated with the input image region [102:202,102:202]. + +If \fIcoords\fR is NULL, the parameters \fIxlag\fR, \fIylag\fR, +\fIdxlag\fR, and \fIdylag\fR can be used to define initial x and y lags +for each input image. \fIXlag\fR and \fIylag\fR define the x and y lags +of the first input image with respect to the reference image. In the +example above they would be set to 2.0 and 2.0 respectively. Initial +shifts for succeeding images are computed by adding the values of the +\fIdxlag\fR and \fIdylag\fR parameters to the values of +\fIxlag\fR and \fIylag\fR assumed for the previous image. +If \fIdxlag\fR and \fIdylag\fR are 0.0 and 0.0 +the same initial x and y lag will be used for all the input +images. If \fIdxlag\fR and \fIdylag\fR are both finite numbers then these +numbers will be added to +the x and y lags assumed for the previous image. If these numbers +are both INDEF then the computed x and y lags for the previous image +will be used to compute the initial x and y lags for the current image. +Both options can be useful for time series images where the x and y +shifts between successive images display some regular behavior. + +Prior to computing the cross-correlation function +large mean background values and gradients should be removed +from the input and reference image data as either +can seriously degrade the peak of the cross-correlation +function. To first order XREGISTER computes the cross-correlation function +in a manner which removes +the effect of large mean background values from the resulting +function. For many if not most typical data sets the user can safely leave +the parameter \fIbackground\fR at its default value of "none" and +achieve reasonable results. For more demanding data sets the user should +experiment with the "mean", "median", and "plane" background fitting +algorithms which compute and subtract, the mean value, median value, and +a plane from the input and reference image data respectively, +before computing the +cross-correlation function. The region used to compute the background fitting +function can be restricted to a border around the reference and +input image regions by setting the \fIborder\fR parameter. Bad +data can be rejected from the background fit by setting the \fIloreject\fR +and \fIhireject\fR parameters. + +A cosine bell function can be applied to the edges of the input and +reference image data before +computing the cross-correlation function by setting the \fIapodize\fR +parameter. + +If the \fIfilter\fR parameter is set to "laplace" instead of its default +value of "none" then a Laplacian filter is applied to the input and +reference image data before the cross-correlation function is computed. +This spatial filtering operation effectively +removes both a background and a slope from the input and reference image +data and +highlights regions of the image where the intensity is changing rapidly. +The effectiveness of this filtering operation in sharpening the +correlation peak depends on the degree to +which the intensity in adjacent pixels is correlated. + +The cross-correlation function for each region is computed by +discrete convolution, \fIcorrelation\fR = "discrete", +Fourier convolution, \fIcorrelation\fR = "fourier", or by computing +the error function, \fIcorrelation\fR = "difference". The x and y lag +space in pixels around the initial x and y lag over which the cross-correlation +function is searched for the correlation peak, is specified by the +\fIxwindow\fR and +\fIywindow\fR parameters. These parameter define a range of x and y lags from +-xwindow / 2 to xwindow / 2 and -ywindow / 2 to ywindow / 2 respectively. For +a given input and reference image region, the +execution time of XREGISTER will depend strongly on both the correlation +algorithm chosen and +the size of the search window. In general users should use discrete +or difference correlation for small search windows and fourier +correlation for large search windows. + +The x and y lags for each input and reference image +region are computed by computing +the position of the peak of the cross-correlation function in the +search window using +one of the four centering algorithms: "none", "centroid", "sawtooth", +and "parabolic". + +The computed x and y shifts for each region and the final x and y shift +for each input image (where the computed x and y shifts are just the negative +of the computed x and y lags) are written to the shifts file \fIshifts\fR. +If \fIdatabasefmt\fR is "yes" each results is written in a record whose name +is either identical to the name of the input +image or supplied by the user via the \fIrecords\fR parameter . +If \fIdatabasefmt\fR is "no", then a single containing the input image +name and the computed x and y shifts is written to the output shifts file. + +If a list of output image names have been supplied then the x and y +shifts will be applied to the input images to compute the output images +using the interpolant type specified by \fIinterp_type\fR and the +boundary extension algorithm specified by \fIboundary\fR and \fIconstant\fR. + +If the \fIcorrelation\fR parameter is set to "file" then the shifts +computed in a previous run of XREGISTER will be read from the \fIshifts\fR +file and applied to the input images to compute the output images. +If no record list is supplied by the user XREGISTER will for each input +image search for +a record whose name is the same as the input image name. If more than +one record of the same name is found then the most recently written +record will be used. + +XREGISTER does not currently trim the input images but it computes and +prints the region over which they all overlap in the form of an image +section. Although XREGISTER is designed for use with same sized images, +it may be used with images of varying size. +In this case it is possible for the calculated overlap region to be vignetted, +as XREGISTER currently preserves the size of the input image when it shifts it. +For example if an image is much smaller than the reference image +it is possible for the image to be shifted outside of its own borders. +If the smallest image is used as a reference this will not occur. If +vignetting is detected the vignetted image section is printed on the +screen. Vignetting may also occur for a list of same-sized images +if the reference image is not included in the input image list, and the +computed shifts are all positive or negative as may occur in a time +sequence. Choosing a reference image with a shift which is in the +middle of the observed range of shifts in x and y will remove this problem. + +In non-interactive mode the parameters are set at task startup +and the input images are processed sequentially. If the \fIverbose\fR +flag is set messages about the progress of the task are printed on the +screen as the task is running. + +In interactive mode the user can mark the regions to be used +to compute the cross-correlation function on the image display, +define the initial shifts from the reference image to the input image +on the image display, show/set the data and algorithm parameters, +compute, recompute, and plot the cross-correlation function, experiment +with the various peak fitting algorithms, and overlay row and column +plots of the input and reference images with and without the initial and / or +computed shifts factored in. + +.ih +CURSOR COMMANDS + +The following graphics cursor commands are currently available in +XREGISTER. + + +.nf + Interactive Keystroke Commands + +? Print help +: Colon commands +t Define the offset between the reference and the input image +c Draw a contour plot of the cross-correlation function +x Draw a column plot of the cross-correlation function +y Draw a line plot of the cross-correlation function +r Redraw the current plot +f Recompute the cross-correlation function +o Enter the image overlay plot submenu +w Update the task parameters +q Exit + + + Colon Commands + +:mark Mark regions on the display +:show Show the current values of the parameters + + Show/Set Parameters + +:reference [string] Show/set the current reference image name +:input [string] Show/set the current input image name +:regions [string] Show/set the regions list +:shifts {string] Show/set the shifts database file name +:coords [string] Show/set the current coordinates file name +:output [string] Show/set the current output image name +:records [string] Show/set the current database record name +:xlag [value] Show/set the initial lag in x +:ylag [value] Show/set the initial lag in y +:dxlag [value] Show/set the incremental lag in x +:dylag [value] Show/set the incremental lag in y +:cregion [value] Show/set the current region +:background [string] Show/set the background fitting function +:border [value] Show/set border region for background fitting +:loreject [value] Show/set low side k-sigma rejection +:hireject [value] Show/set high side k-sigma rejection +:apodize [value] Show/set percent of end points to apodize +:filter [string] Show/set the default spatial filter +:correlation [string] Show/set cross-correlation function +:xwindow [value] Show/set width of correlation window in x +:ywindow [value] Show/set width of correlation window in y +:function [string] Show/set correlation peak centering function +:xcbox [value] Show/set the centering box width in x +:ycbox [value] Show/set the centering box width in y +.fi + + +The following submenu of image cursor commands is also available. + +.nf + Image Overlay Plot Submenu + + +? Print help +c Overlay the marked column of the reference image + with the same column of the input image +l Overlay the marked line of the reference image + with the same line of the input image +x Overlay the marked column of the reference image + with the x and y lagged column of the input image +y Overlay the marked line of the reference image + with the x and y lagged line of the input image +v Overlay the marked column of the reference image + with the x and y shifted column of the input image +h Overlay the marked line of the reference image + with the x and y shifted line of the input image +q Quit + + + Image Overlay Sub-menu Colon Commands + +:c [m] [n] Overlay the middle [mth] column of the reference image + with the mth [nth] column of the input image +:l [m] [n] Overlay the middle [mth] line of the reference image + with the mth [nth] line of the input image +:x [m] Overlay the middle [mth] column of the reference image + with the x and y lagged column of the input image +:y [m] Overlay the middle [mth] line of the reference image + with the x and y lagged line of the input image +:v [m] Overlay the middle [mth] column of the reference image + with the x and y shifted column of the input image +:h [m] Overlay the middle [mth] line of the reference image + with the x and y shifted line of the input image +.fi + +.ih +ALGORITHMS + +The cross-correlation function is computed in the following manner. +The symbols I and R refer to the input and reference images respectively. + +.nf +correlation = discrete + + <I> = SUMj SUMi { I[i+xlag,j+ylag] } / (Nx * Ny) + <R> = SUMj SUMi { R[i,j] } / (Nx * Ny) + sumsqI = sqrt (SUMj SUMi { (I[i+xlag,j+ylag] - <I>) ** 2 }) + sumsqR = sqrt (SUMj SUMi { (R[i,j] - <R>) ** 2 }) + + X = SUMj SUMi { (I[i+xlag,j+ylag] - <I>) * (R[i,j] - <R>) } + ---------------------------------------------------- + sumsqI * sumsqR + + +correlation = fourier + + <I> = SUMj SUMi { I[i,j] } / (Nx * Ny) + <R> = SUMj SUMi { R[i,j] } / (Nx * Ny) + sumsqI = sqrt (SUMj SUMi { (I[i,j] - <I>) ** 2 }) + sumsqR = sqrt (SUMj SUMi { (R[i,j] - <R>) ** 2 }) + FFTI = FFT { (I - <I>) / sumsqI } + FFTR = FFT { (R - <R>) / sumsqR } + + X = FFTINV { FFTR * conj { FFTI } } + + +correlation = difference + + <I> = SUMj SUMi { I[i+xlag,j+ylag] } / (Nx * Ny) + <R> = SUMj SUMi { R[i,j] } / (Nx * Ny) + + X = SUMj SUMi { abs ((I[i+xlag,j+ylag] - <I>) - (R[i,j] - <R>)) } + X = 1.0 - X / max { X } +.fi + +.ih +EXAMPLES + +1. Register a list of images whose dimensions are all 256 by 256 pixels +and whose shifts with respect to the reference image are all less than +5.0 pixels, using the discrete cross-correlation algorithm and a search +window of 21 pixels in x and y. + +.nf + cl> xregister @inimlist refimage [*,*] shifts.db out=@outimlist \ + xwindow=21 ywindow=21 +.fi + +2. Register the previous list of images, but compute the cross_correlation +function using boxcar smoothed versions of the input images. + +.nf + cl> xregister @binimlist brefimage [*,*] shifts.db xwindow=21 \ + ywindow=21 + + cl> xregister @inimlist refimage [*,*] shifts.db out=@outimlist \ + records=@binimlist correlation=file +.fi + +3. Register the previous list of images but write the results to a simple +text file instead of a text database file and do the actual shifting with +the imshift task. + +.nf + cl> xregister @binimlist brefimage [*,*] shifts.db xwindow=21 \ + ywindow=21 databasefmt- + + cl> fields shifts.db 2,3 > shifts + + cl> imshift @inimlist @outimlist shifts_file=shifts +.fi + +4. Register list of 512 by 512 pixel square solar sunspot images that were +observed as a time series. Compute the cross-correlation function using +Fourier techniques, a search window of 21 pixels in x and y, an initial +shift of 10 pixels in x and 1 pixel in y, and use the computed shift of +the previous image as the initial guess for the current image. + +.nf + cl> xregister @inimlist refimage [*,*] shifts.db out=@outimlist \ + xlag=10 ylag=1 dxlag=INDEF dylag=INDEF correlation=fourier \ + xwindow=21 ywindow=21 +.fi + +5. Register two 2K square images interactively using discrete cross-correlation +and an initial search window of 15 pixels in x and y. + +.nf + cl> display refimage + + cl> xregister inimage refimage [900:1100,900:1100] shifts.db \ + xwindow=15 ywindow=15 interactive+ + + ... a contour plot of the cross-correlation function appears + with the graphics cursor ready to accept commands + + ... type x and y to get line and column plots of the cross- + correlation function at various points and c to return + to the default contour plot + + ... type ? to get a list of the available commands + + ... type :mark to mark a new region on the image display + + ... type f to recompute the cross-correlation function using + the new data + + ... increase the search window to 21 pixels in x and y + with the :xwindow 21 and :ywindow 21 commands + + ... type f to recompute the cross-correlation function with the + new search window + + ... type o to enter the image data overlay plot submenu, + move the cursor to a line in the displayed reference image + and type l to see of plot of the line in the input and + reference image, type h to see a plot of the same line in + the reference image and the x and y shifted line in the input + image, type q to return to the main menu + + ... type q to quit the task, and q again to verify the previous + q command +.fi + +.ih +TIME REQUIREMENTS +.ih +BUGS +.ih +SEE ALSO +rv.fxcor,proto.imalign,images.imcombine,ctio.immatch,center1d,images.imshift +.endhelp diff --git a/pkg/images/immatch/doc/xyxymatch.hlp b/pkg/images/immatch/doc/xyxymatch.hlp new file mode 100644 index 00000000..82a8c8bb --- /dev/null +++ b/pkg/images/immatch/doc/xyxymatch.hlp @@ -0,0 +1,468 @@ +.help xyxymatch Jul95 images.immatch +.ih +NAME +xyxymatch -- Match pixel coordinate lists using various methods +.ih +USAGE +xyxymatch input reference output tolerance +.ih +PARAMETERS +.ls input +The list of input coordinate files. The input file is a whitespace-delimited +text table containing the coordinates. The \fIxcolumn\fR and \fIycolumn\fR +parameters define the coordinate columns to be used. +.le +.ls reference +The list of reference coordinate files. The number of reference coordinate +files must be one or equal to the number of input coordinate files. +The reference file is a whitespace-delimited +text table containing the coordinates. The \fIxrcolumn\fR and \fIyrcolumn\fR +parameters define the coordinate columns to be used. +.le +.ls output +The output matched x-y lists containing three pairs of numbers: the coordinates +of the object in the reference list in columns 1 and 2, the +coordinates of the object in the input list in columns 3 and 4, and +the line number of the objects in the original reference and input +lists in columns 5 and 6. +.le +.ls tolerance +The matching tolerance in pixels. +.le +.ls refpoints = "" +The list of tie points used to compute the linear transformation +from the input coordinate system to the reference coordinate system. Refpoints +is a text file containing the x-y coordinates of 1-3 reference list tie points +in the first line, followed by the x-y coordinates of the 1-3 corresponding +input tie points in succeeding +lines. If refpoints is undefined then the parameters \fIxin\fR, \fIyin\fR, +\fIxmag\fR, \fIymag\fR, \fIxrotation\fR, \fIyrotataion\fR, \fIxref\fR, +and \fIyref\fR are used to compute the linear transformation from the +input coordinate system to the reference coordinate system. +.le +.ls xin = INDEF, yin = INDEF +The x and y origin of the input coordinate system. Xin and yin default to +0.0 and 0.0 respectively. +.le +.ls xmag = INDEF, ymag = INDEF +The x and y scale factors in reference pixels per input pixels. Xmag and +ymag default to 1.0 and 1.0 respectively. +.le +.ls xrotation = INDEF, yrotation = INDEF +The x and y rotation angles measured in degrees counter-clockwise with +respect to the x axis. Xrotation and yrotation default to 0.0 and 0.0 +respectively. +.le +.ls xref = INDEF, yref = INDEF +The x and y origin of the reference coordinate system. Xref and yref default +to 0.0 and 0.0 respectively. +.le +.ls xcolumn = 1, ycolumn = 2 +The columns in the input coordinate list containing the x and y coordinate +values respectively. +.le +.ls xrcolumn = 1, yrcolumn = 2 +The columns in the reference coordinate list containing the x and y coordinate +values respectively. +.le +.ls separation = 9.0 +The minimum separation for objects in the input and reference coordinate +lists. Objects closer together than separation pixels +are removed from the input and reference coordinate lists prior to matching. +.le +.ls matching = "triangles" +The matching algorithm. The choices are: +.ls tolerance +A linear transformation is applied to the input coordinate list, +the transformed input list and the reference list are sorted, +points which are too close together are removed, and the input coordinates +which most closely match the reference coordinates within the +user specified tolerance are determined. The tolerance algorithm requires +an initial estimate for the linear transformation. This estimate can be +derived interactively by pointing to common objects in the two displayed +images, by supplying the coordinates of tie points via the +\fIrefpoints\fR file, or by setting the linear transformation parameters +\fIxin\fR, \fIyin\fR, \fIxmag\fR, \fIymag\fR, \fIxrotation\fR, +\fIyrotation\fR, \fIxref\fR, and \fIyref\fR. Assuming that +well chosen tie points are supplied, the tolerance algorithm +functions well in the presence of any shifts, axis flips, x and y +scale changes, rotations, and axis skew, between the two coordinate +systems. The algorithm is sensitive to higher order distortion terms +in the coordinate transformation. +.le +.ls triangles +A linear transformation is applied to the input coordinate list, +the transformed input list and the reference list are sorted, points +which are too close together are removed, and the input coordinates +are matched to the reference coordinates using a triangle pattern +matching technique and the user specified tolerance parameter. +The triangles pattern matching algorithm does not require prior knowledge +of the linear transformation, although it will use one if one is supplied. +The algorithm functions well in the presence of +any shifts, axis flips, magnification, and rotation between the two coordinate +systems as long as both lists have a reasonable number of objects +in common and the errors in the computed coordinates are small. +However since the algorithm depends on comparisons of similar triangles, it +is sensitive to differences in the x and y coordinate scales, +any skew between the x and y axes, and higher order distortion terms +in the coordinate transformation. +.le +.le +.ls nmatch = 30 +The maximum number of reference and input coordinates used +by the "triangles" pattern matching algorithm. If either list contains +more coordinates than nmatch the lists are subsampled. Nmatch should be +kept small as the computation and memory requirements of the "triangles" +algorithm depend on a high power of the lengths of the respective lists. +.le +.ls ratio = 10.0 +The maximum ratio of the longest to shortest side of the +triangles generated by the "triangles" pattern matching algorithm. +Triangles with computed longest to shortest side ratios > ratio +are rejected from the pattern matching algorithm. \fIratio\fR should never +be set higher than 10.0 but may be set as low as 5.0. +.le +.ls nreject = 10 +The maximum number of rejection iterations for the "triangles" pattern +matching algorithm. +.le +.ls xformat = "%13.3f", yformat = "%13.3f" +The format of the output reference and input x and y coordinates. +By default the coordinates are output right justified in a field of +13 characters with 3 places following the decimal point. +.le +.ls interactive = no +Compute the initial linear transformation required to transform the +input coordinate coordinates to the reference coordinate system, by defining +up to three tie points using the image display and the image cursor. +.le +.ls verbose = yes +Print messages about the progress of the task ? +.le +.ls icommands = "" +The image display cursor. +.le + +.ih +DESCRIPTION + +XYXYMATCH matches the x and y coordinates in the reference coordinate list +\fIreference\fR to the corresponding x and y coordinates in the input +coordinate list \fIinput\fR to within a user specified tolerance +\fItolerance\fR, and writes the matched coordinates to the output +file \fIoutput\fR. The output file is suitable for input to the +GEOMAP task which computes the actual transformation required to +register the corresponding reference and input images. + +XYXYMATCH matches the coordinate lists by: 1) computing an initial +guess at the linear transformation required to match the input +coordinate system to the reference coordinate system, 2) applying +the computed transformation to the input coordinates, 3) sorting +the reference and input coordinates and removing points with a +minimum separation specified by the parameter \fIseparation\fR +from both lists, 4) matching the two lists using either the "tolerance" +or "triangles" algorithm, and 5) writing the matched list to the +output file. + +The initial estimate of the linear transformation is computed in one of +three ways. If \fIinteractive\fR is "yes" the user displays the reference and +input images corresponding to the reference and input coordinate files +on the image display, and marks up to three objects which the two +images have in common with the image cursor. The coordinates of these +tie points are used as tie points to compute the linear transformation. +If \fIrefpoints\fR is defined, the x-y coordinates of up to three tie +points are read from succeeding lines in the refpoints file. The format +of two sample refpoints files is shown below. + +.nf +# First sample refpoints file (1 reference file and N input files) + +x1 y1 [x2 y2 [x3 y3]] # tie points for reference coordinate file +x1 y1 [x2 y2 [x3 y3]] # tie points for input coordinate file 1 +x1 y1 [x2 y2 [x3 y3]] # tie points for input coordinate file 2 +... +x1 y1 [x2 y2 [x3 y3]] # tie points for input coordinate file N + + +# Second sample refpoints file (N reference files and N input files) + +x1 y1 [x2 y2 [x3 y3]] # tie points for reference coordinate file 1 +x1 y1 [x2 y2 [x3 y3]] # tie points for input coordinate file 1 +x1 y1 [x2 y2 [x3 y3]] # tie points for reference coordinate file 2 +x1 y1 [x2 y2 [x3 y3]] # tie points for input coordinate file 2 +... +x1 y1 [x2 y2 [x3 y3]] # tie points for reference coordinate file N +x1 y1 [x2 y2 [x3 y3]] # tie points for input coordinate file N + +.fi + +The coordinates of the tie points can be typed in by hand if \fIrefpoints\fR +is "STDIN". If the refpoints file is undefined the parameters +\fIxin\fR, \fIxin\fR, \fIxmag\fR, \fIymag\fR, \fIxrotation\fR, \fIyrotation\fR, +\fIxref\fR, and \fIyref\fR are used to compute the linear transformation +from the input coordinates [xi,yi] to the reference coordinates [xr,yr] +as shown below. Orientation and skew are the orientation of the x and y axes +and their deviation from non-perpendicularity respectively. + +.nf + xr = a + b * xi + c * yi + yr = d + e * xi + f * yi + + xrotation = orientation - skew / 2 + yrotation = orientation + skew / 2 + b = xmag * cos (xrotation) + c = -ymag * sin (yrotation) + e = xmag * sin (xrotation) + f = ymag * cos (yrotation) + a = xref - b * xin - c * yin = xshift + d = yref - e * xin - f * yin = yshift +.fi + +The reference and input coordinates are read from columns \fIxrcolumn\fR, +\fIyrcolumn\fR in the reference, and \fIxcolumn\fR, and \fIycolumn\fR in the +input coordinate lists respectively. The input coordinates are transformed +using the computed linear transformation and stars closer together than +\fIseparation\fR pixels are removed from both lists. + +The coordinate lists are matched using the algorithm specified by +the \fImatching\fR +parameter. If matching is "tolerance", XYXYMATCH searches the sorted +transformed input coordinate list for the object closest to the current +reference object within the matching tolerance \fItolerance\fR. +The major advantage of the "tolerance" algorithm is that it can deal +with x and y scale differences and axis skew in the coordinate +transformation. The major disadvantage is that the user must supply +tie point information in all but the simplest case of small x and y +shifts between the input and reference coordinate systems. + +If matching is "triangles" XYXYMATCH constructs a list of triangles +using up to \fInmatch\fR reference coordinates and transformed input +coordinates, and performs a pattern matching operation on the resulting +triangle lists. If the number of coordinates +in both lists is less than \fInmatch\fR the entire list is matched using +the "triangles" algorithm directly, otherwise the "triangles" algorithm +is used to estimate a new linear transformation, the input coordinate +list is transformed using the new transformation, and the entire list +is matched using the "tolerance" algorithm. The major advantage of the +"triangles" algorithm is that it requires no tie point information +from the user. The major disadvantages are that it is sensitive to +x and y scale differences and axis skews between the input and reference +coordinate systems and can be computationally expensive. + +The matched x and y reference and input coordinate lists are written to +columns 1 and 2, and 3 and 4 of the output file respectively, in a format +specified by the \fIxformat\fR and \fIyformat\fR parameters. +The respective line numbers in the original reference and input +coordinate files are written to columns 5 and 6 respectively. + +If \fIverbose\fR is yes, detailed messages about actions taken by the +task are written to the terminal as the task executes. + +.ih +ALGORITHMS + +The "triangles" algorithm uses a sophisticated pattern matching +technique which requires no tie point information from the user. +It is expensive computationally and hence is restricted to a maximum +of \fInmatch\fR objects from the reference and input coordinate lists. + +The "triangles" algorithm first generates a list +of all the possible triangles that can be formed from the points in each list. +For a list of nmatch points this number is the combinatorial factor +nmatch! / [(nmatch-3)! * 3!] or nmatch * (nmatch-1) * (nmatch-2) / 6. +The length of the perimeter, ratio of longest to shortest side, cosine +of the angle between the longest and shortest side, the tolerances in +the latter two quantities and the direction of the arrangement of the vertices +of each triangle are computed and stored in a table. +Triangles with vertices closer together than \fItolerance\fR or +with a ratio of the longest to shortest side greater than \fIratio\fR +are discarded. The remaining triangles are sorted in order of increasing +ratio. A sort merge algorithm is used to match the triangles using the +ratio and cosine information, the tolerances in these quantities, and +the maximum tolerances for both lists. Next the ratios of the +perimeters of the matched triangles are compared to the average ratio +for the entire list, and triangles which deviate too widely from the mean +are discarded. The number of triangles remaining are divided into +the number which match in the clockwise sense and the number which match +in the counter-clockwise sense. Those in the minority category +are eliminated. +The rejection step can be repeated up to \fInreject\fR times or until +no more rejections occur whichever comes first. +The last step in the algorithm is a voting procedure in which each remaining +matched triangle casts three votes, one for each matched pair of vertices. +Points which have fewer than half the maximum number of +votes are discarded. The final set of matches are written to the output file. + +The "triangles" algorithm functions well when the reference and +input coordinate lists have a sufficient number of objects (~50%, +in some cases as low as 25%) of their objects in common, any distortions +including x and y scale differences and skew between the two systems are small, +and the random errors in the coordinates are small. Increasing the value of the +\fItolerance\fR parameter will increase the ability to deal with distortions but +will also produce more false matches. + +.ih +FORMATS + +A format specification has the form "%w.dCn", where w is the field +width, d is the number of decimal places or the number of digits of +precision, C is the format code, and n is radix character for +format code "r" only. The w and d fields are optional. The format +codes C are as follows: + +.nf +b boolean (YES or NO) +c single character (c or '\c' or '\0nnn') +d decimal integer +e exponential format (D specifies the precision) +f fixed format (D specifies the number of decimal places) +g general format (D specifies the precision) +h hms format (hh:mm:ss.ss, D = no. decimal places) +m minutes, seconds (or hours, minutes) (mm:ss.ss) +o octal integer +rN convert integer in any radix N +s string (D field specifies max chars to print) +t advance To column given as field W +u unsigned decimal integer +w output the number of spaces given by field W +x hexadecimal integer +z complex format (r,r) (D = precision) + + + +Conventions for w (field width) specification: + + W = n right justify in field of N characters, blank fill + -n left justify in field of N characters, blank fill + 0n zero fill at left (only if right justified) +absent, 0 use as much space as needed (D field sets precision) + +Escape sequences (e.g. "\n" for newline): + +\b backspace (not implemented) +\f formfeed +\n newline (crlf) +\r carriage return +\t tab +\" string delimiter character +\' character constant delimiter character +\\ backslash character +\nnn octal value of character + +Examples + +%s format a string using as much space as required +%-10s left justify a string in a field of 10 characters +%-10.10s left justify and truncate a string in a field of 10 characters +%10s right justify a string in a field of 10 characters +%10.10s right justify and truncate a string in a field of 10 characters + +%7.3f print a real number right justified in floating point format +%-7.3f same as above but left justified +%15.7e print a real number right justified in exponential format +%-15.7e same as above but left justified +%12.5g print a real number right justified in general format +%-12.5g same as above but left justified + +%h format as nn:nn:nn.n +%15h right justify nn:nn:nn.n in field of 15 characters +%-15h left justify nn:nn:nn.n in a field of 15 characters +%12.2h right justify nn:nn:nn.nn +%-12.2h left justify nn:nn:nn.nn + +%H / by 15 and format as nn:nn:nn.n +%15H / by 15 and right justify nn:nn:nn.n in field of 15 characters +%-15H / by 15 and left justify nn:nn:nn.n in field of 15 characters +%12.2H / by 15 and right justify nn:nn:nn.nn +%-12.2H / by 15 and left justify nn:nn:nn.nn + +\n insert a newline +.fi + +.ih +REFERENCES + +A detailed description of the "triangles" pattern matching algorithm used here +can be found in the article "A Pattern-Matching Algorithm for Two- +Dimensional Coordinate Lists" by E.J. Groth, A.J. 91, 1244 (1986). + +.ih +EXAMPLES + +1. Match the coordinate list of an image to the coordinate list of a reference +image using the triangles matching algorithm and a tolerance of 3 pixels. +Use the resulting matched list to compute the transformation +required to register the input image lpix to the reference image. +For completeness this example demonstrates how the individual input +and reference coordinate lists can be generated. + +.nf + cl> imlintran dev$pix[-*,*] lpix xrot=15 yrot=15 xmag=1.2 \ + ymag=1.2 xin=INDEF yin=INDEF xref=265.0 yref=265.0 \ + ncols=INDEF nlines=INDEF + + cl> daofind dev$pix fwhm=2.5 sigma=5.0 threshold=100.0 + cl> daofind lpix fwhm=2.5 sigma=5.0 threshold=100.0 + + cl> xyxymatch lpix.coo.1 pix.coo.1 xymatch toler=3 \ + matching=triangles + + cl> geomap xymatch geodb 1.0 512.0 1.0 512.0 +.fi + +2. Match the coordinate lists above using the tolerance matching algorithm +and the image display and cursor. + +.nf + cl> display dev$pix 1 fi+ + cl> display lpix 2 fi+ + + cl> xyxymatch lpix.coo.1 pix.coo.1 xymatch toler=3 \ + matching=tolerance interactive+ + + ... Mark three points in the reference image dev$pix + ... Mark three points in the input image lpix + + cl> geomap xymatch geodb 1.0 512.0 1.0 512.0 +.fi + +3. Repeat example 2 but run xyxymatch non-interactively by setting the +appropriate linear transformation parameters rather than marking stars +on the image display. + +.nf + cl> ... + + cl> xyxymatch lpix.coo.1 pix.coo.1 xymatch toler=3 \ + matching=tolerance xmag=1.2 ymag=1.2 xrot=165 \ + yrot=345 xref=646.10 yref=33.38 + + cl> geomap xymatch geodb 1.0 512.0 1.0 512.0 +.fi + +4. Repeat example 2 but run xyxymatch non-interactively +inputting the appropriate linear transformation via a list of tie points +rather than marking stars on the image display or creating a refpoints +file. + +.nf + cl> ... + + cl> type refpts + 442.0 409.0 380.0 66.0 69.0 460.0 + 82.0 347.0 207.0 84.0 371.0 469.0 + + cl> xyxymatch lpix.coo.1 pix.coo.1 xymatch toler=3 \ + refpoints=refpts matching=tolerance + + cl> geomap xymatch geodb 1.0 512.0 1.0 512.0 +.fi + +.ih +TIME REQUIREMENTS +.ih +BUGS +.ih +SEE ALSO +daophot.daofind,lintran,imlintran,geomap,register,geotran +.endhelp diff --git a/pkg/images/immatch/geomap.par b/pkg/images/immatch/geomap.par new file mode 100644 index 00000000..27f46bc3 --- /dev/null +++ b/pkg/images/immatch/geomap.par @@ -0,0 +1,32 @@ +# GEOMAP Parameters + +# Required parameters +input,f,a,,,,The input coordinate files +database,f,a,,,,The output database file +xmin,r,a,INDEF,,,Minimum x reference coordinate value +xmax,r,a,INDEF,,,Maximum x reference coordinate value +ymin,r,a,INDEF,,,Minimum y reference coordinate value +ymax,r,a,INDEF,,,Maximum y reference coordinate value +transforms,s,h,"",,,The output transform records names +results,f,h,"",,,The optional results summary files +fitgeometry,s,h,"general",|shift|xyscale|rotate|rscale|rxyscale|general|,,Fitting geometry + +# Surface fitting parameters +function,s,h,"polynomial",|chebyshev|legendre|polynomial|,,Surface type +xxorder,i,h,2,2,,Order of x fit in x +xyorder,i,h,2,2,,Order of x fit in y +xxterms,s,h,"half","|none|half|full|",,X fit cross terms type +yxorder,i,h,2,2,,Order of y fit in x +yyorder,i,h,2,2,,Order of y fit in y +yxterms,s,h,"half","|none|half|full|",,Y fit cross terms type +maxiter,i,h,0,,,Maximum number of rejection iterations +reject,r,h,3.0,,,Rejection limit in sigma units +calctype,s,h,"real",|real|double|,,'Computation type' + +# Output and graphics parameters +verbose,b,h,yes,,,Print messages about progress of task ? +interactive,b,h,yes,,,Fit transformation interactively ? +graphics,s,h,"stdgraph",,,Default graphics device +cursor,*gcur,h,,,,Graphics cursor + +mode,s,h,'ql' diff --git a/pkg/images/immatch/geotran.par b/pkg/images/immatch/geotran.par new file mode 100644 index 00000000..dcae9d1c --- /dev/null +++ b/pkg/images/immatch/geotran.par @@ -0,0 +1,45 @@ +# GEOTRAN Parameters + +# required parameters +input,f,a,,,,Input data +output,f,a,,,,Output data +database,f,a,,,,Name of GEOMAP database file +transforms,s,a,,,,Names of coordinate transforms in database file + +# change transformation parameters +geometry,s,h,"geometric",|linear|geometric|,,"Transformation type (linear,geometric)" +xin,r,h,INDEF,1.,,X origin of input frame in pixels +yin,r,h,INDEF,1.,,Y origin of input frame in pixels +xshift,r,h,INDEF,,,X origin shift in pixels +yshift,r,h,INDEF,,,Y origin shift in pixels +xout,r,h,INDEF,1.,,X origin of output frame in reference units +yout,r,h,INDEF,1.,,Y origin of output frame in reference units +xmag,r,h,INDEF,,,X scale of input picture in pixels per reference unit +ymag,r,h,INDEF,,,Y scale of input picture in pixels per reference unit +xrotation,r,h,INDEF,,,X axis rotation in degrees +yrotation,r,h,INDEF,,,Y axis rotation in degrees + +# output picture format parameters +xmin,r,h,INDEF,,,Minimum reference x value of output picture +xmax,r,h,INDEF,,,Maximum reference x value of output picture +ymin,r,h,INDEF,,,Minimum reference y value of output picture +ymax,r,h,INDEF,,,Maximum reference y value of output picture +xscale,r,h,1.0,0.0,,X scale of output picture in reference units per pixel +yscale,r,h,1.0,0.0,,Y scale of output picture in reference units per pixel +ncols,i,h,INDEF,1,,Number of columns in the output picture +nlines,i,h,INDEF,1,,Number of lines in the output picture + +# coordinate surface and image interpolation parameters +xsample,r,h,1.,1.,,Coordinate surface sampling interval in x +ysample,r,h,1.,1.,,Coordinate surface sampling interval in y +interpolant,s,h,"linear",,,"Interpolant" +boundary,s,h,"nearest",|nearest|constant|reflect|wrap|,,"Boundary extension (nearest,constant,reflect,wrap)" +constant,r,h,0.,,,Constant boundary extension +fluxconserve,b,h,yes,,,Preserve image flux? + +# working blocksize +nxblock,i,h,512,,,X dimension of working block size in pixels +nyblock,i,h,512,,,Y dimension of working block size in pixels +verbose,b,h,yes,,,Print messages about the progress of the task + +mode,s,h,'ql' diff --git a/pkg/images/immatch/geoxytran.par b/pkg/images/immatch/geoxytran.par new file mode 100644 index 00000000..c0b96ac0 --- /dev/null +++ b/pkg/images/immatch/geoxytran.par @@ -0,0 +1,28 @@ +# Parameter set for the GEOXYTRAN Task + +input,s,a,,,,Input coordinate files to be transformed +output,s,a,,,,Output transformed coordinate files +database,f,a,,,,The GEOMAP database file +transforms,s,a,,,,Names of the coordinate transforms in the database + +geometry,s,h,"geometric",|linear|geometric|,,'Transformation type (linear,geometric)' +direction,s,h,"forward","forward|backward",,Transformation direction (forward|backward) +xref,r,h,INDEF,,,X input origin in reference units +yref,r,h,INDEF,,,Y input origin in reference units +xmag,r,h,INDEF,,,X scale in output units per reference unit +ymag,r,h,INDEF,,,Y scale in output units per reference unit +xrotation,r,h,INDEF,,,X axis rotation in degrees +yrotation,r,h,INDEF,,,Y axis rotation in degrees +xout,r,h,INDEF,,,X output origin in output units +yout,r,h,INDEF,,,Y output origin in output units +xshift,r,h,INDEF,,,X origin shift in output units +yshift,r,h,INDEF,,,Y origin shift in output units + +xcolumn,i,h,1,1,100,Input column containing the x coordinate +ycolumn,i,h,2,1,100,Input column containing the y coordinate +calctype,s,h,"real",|real|double|,,Data type for evaluation coordinates +xformat,s,h,"",,,Output format of the x coordinate +yformat,s,h,"",,,Output format of the y coordinate +min_sigdigits,i,h,7,,,Minimum precision of output x and y coordinates + +mode,s,h,'ql' diff --git a/pkg/images/immatch/gregister.cl b/pkg/images/immatch/gregister.cl new file mode 100644 index 00000000..70c048e7 --- /dev/null +++ b/pkg/images/immatch/gregister.cl @@ -0,0 +1,51 @@ +# GREGISTER -- Register a list of images by calling the GEOTRAN task with the +# appropriate parameters. + +procedure gregister (input, output, database, transforms, geometry, xmin, xmax, + ymin, ymax, xscale, yscale, ncols, nlines, xsample, ysample, + interpolant, boundary, constant, fluxconserve, nxblock, nyblock, + verbose) + +string input +string output +string database +string transforms +string geometry +real xmin +real xmax +real ymin +real ymax +real xscale +real yscale +int ncols +int nlines +real xsample +real ysample +string interpolant +string boundary +real constant +bool fluxconserve +int nxblock +int nyblock +bool verbose + +begin + # Declare local variables + string din, dout, ddata, dtran + + # Get the parameters. + din = input + dout = output + ddata = database + dtran = transforms + + # Call GEOTRAN. + geotran (input=din, output=dout, database=ddata, transforms=dtran, + geometry=geometry, xmin=xmin, xmax=xmax, ymin=ymin, ymax=ymax, + xscale=xscale, yscale=yscale, ncols=ncols, nlines=nlines, + interpolant=interpolant, boundary=boundary, constant=constant, + fluxconserve=fluxconserve, xsample=xsample, ysample=ysample, + nxblock=nxblock, nyblock=nyblock, xin=INDEF, yin=INDEF, xout=INDEF, + yout=INDEF, xshift=INDEF, yshift=INDEF, xmag=INDEF, ymag=INDEF, + xrotation=INDEF, yrotation=INDEF, verbose=verbose) +end diff --git a/pkg/images/immatch/gregister.par b/pkg/images/immatch/gregister.par new file mode 100644 index 00000000..ad2e28b3 --- /dev/null +++ b/pkg/images/immatch/gregister.par @@ -0,0 +1,33 @@ +# GREGISTER Parameters + +# required parameters +input,f,a,,,,Input data +output,f,a,,,,Output data +database,f,a,,,,Name of GEOMAP database file +transforms,s,a,,,,Names of coordinate transforms in database file +geometry,s,h,'geometric',,,'Geometry (linear,distortion,geometric)' + +# output picture format parameters +xmin,r,h,INDEF,,,Minimum reference x value of output picture +xmax,r,h,INDEF,,,Maximum reference x value of output picture +ymin,r,h,INDEF,,,Minimum reference y value of output picture +ymax,r,h,INDEF,,,Maximum reference y value of output picture +xscale,r,h,1.0,0.,,X scale of output picture in reference units per pixel +yscale,r,h,1.0,0.,,Y scale of output picture in reference units per pixel +ncols,i,h,INDEF,1,,Number of columns in the output picture +nlines,i,h,INDEF,1,,Number of lines in the output picture + +# coordinate surface and image interpolation parameters +xsample,r,h,1.0,1.0,,Coordinate surface sampling area in x +ysample,r,h,1.0,1.0,,Coordinate surface sampling area in y +interpolant,s,h,'linear',,,'Interpolant (nearest,linear,poly3,poly5,spline3)' +boundary,s,h,'nearest',|nearest|constant|reflect|wrap|,,'Boundary extension (nearest,constant,reflect,wrap)' +constant,r,h,0.,,,Constant for constant boundary extension +fluxconserve,b,h,yes,,,Preserve image flux ? + +# blocking factors +nxblock,i,h,512,,,X dimension of working block size in pixels +nyblock,i,h,512,,,Y dimension of working block size in pixels +verbose,b,h,yes,,,Print messages about the progress of the task ? + +mode,s,h,'ql' diff --git a/pkg/images/immatch/imalign.cl b/pkg/images/immatch/imalign.cl new file mode 100644 index 00000000..2e6a5f69 --- /dev/null +++ b/pkg/images/immatch/imalign.cl @@ -0,0 +1,119 @@ +# IMALIGN - Register a set of images using the results of the IMCENTROID, +# and the IMSHIFT, and IMCOPY tasks. + +procedure imalign (input, reference, coords, output) + +begin + bool shifts_found, trim_found + string tmpfile, outfile, shiftfile, trimsect, tmp, junk + string l_input, l_reference, l_coords, l_output + int x1, x2, y1, y2 + real xshift, yshift + struct line + + # Set up some temporary files. + tmpfile = mktemp ("tmp$ia_tmp.") + outfile = mktemp ("tmp$ia_tmp.") + shiftfile = mktemp ("tmp$ia_tmp.") + + # Get the required parameters. + l_input = input + l_reference = reference + l_coords = coords + l_output = output + + # Write the output names to outfile. + sections (l_output, option="fullname", > outfile) + + # Compute the centers and relative shifts. + imcentroid (l_input, l_reference, l_coords, shifts=shifts, + boxsize=boxsize, bigbox=bigbox, negative=negative, + background=background, lower=lower, upper=upper, + niterate=niterate, tolerance=tolerance, maxshift=maxshift, + verbose=verbose, >& tmpfile) + + # Print the centering results on the screen? + if (verbose) + type (tmpfile) + + # Shift the images. + if (shiftimages) { + + # Read the shifts. + shifts_found = no + list = tmpfile + while (fscan (list, line) != EOF) { + tmp = substr (line, 2, 7) + if (tmp == "Shifts") { + shifts_found = yes + break + } + } + + # Decode the shifts. + if (shifts_found) + while (fscan (list, junk, xshift, junk, yshift, junk) == 5) + print (xshift, " ", yshift, >> shiftfile) + else + error (1, "No shifts were calculated.") + + # Shift the images. + print ("\n# Shifting images:\n") + imshift (l_input, "@"//outfile, shifts_file=shiftfile, + interp_type=interp_type, boundary_type=boundary_type, + constant=constant) + + # Trim the images. + if (trimimages) { + + # Check for vignetting. + trim_found = no + while (fscanf (list, "%s = [%d:%d,%d:%d]", line, x1, x2, + y1, y2) != EOF) { + tmp = substr (line, 2, 5) + if (tmp == "Vign") { + print ("Images not trimmed ! Vignetting is present.") + trim_found = no + break + } else if (tmp == "Trim") { + trim_found = yes + break + } + } + + # Trim the images. + if (!trim_found) { + print ("Images not trimmed ! Trim section is undefined.") + } else { + + # Correct for boundary extension "contamination". + if (interp_type == "poly3") { + x1 += 1; x2 -= 1; y1 += 1; y2 -= 1 + } else if (interp_type == "poly5" || + interp_type == "spline3") { + x1 += 2; x2 -= 2; y1 += 2; y2 -= 2 + } + + if (1 <= x1 && x1 <= x2 && 1 <= y1 && y1 <= y2) { + trimsect = "["//x1//":"//x2//","//y1//":"//y2//"]" + + list = outfile; delete (tmpfile, ver-, >& "dev$null") + while (fscan (list, tmp) != EOF) + print (tmp//trimsect, >> tmpfile) + + print ("# Trimming images: corrected section = ", + trimsect) + imcopy ("@"//tmpfile, "@"//outfile, verbose-) + + } else { + print ("Images not trimmed ! No overlap region.") + } + } + } + } + + list = "" + delete (tmpfile, ver-, >& "dev$null") + delete (outfile, ver-, >& "dev$null") + delete (shiftfile, ver-, >& "dev$null") +end diff --git a/pkg/images/immatch/imalign.par b/pkg/images/immatch/imalign.par new file mode 100644 index 00000000..2434f735 --- /dev/null +++ b/pkg/images/immatch/imalign.par @@ -0,0 +1,28 @@ +input,s,a,,,,"Input images" +reference,s,a,,,,"Reference image" +coords,s,a,,,,"Reference coordinates file" +output,s,a,,,,"Output images" +shifts,s,h,"",,,"Initial shifts file" + +boxsize,i,h,7,1,,"Size of the small centering box" +bigbox,i,h,11,1,,"Size of the big centering box" +negative,b,h,no,,,"Are the features negative ?" +background,r,h,INDEF,,,"Reference background level" +lower,r,h,INDEF,,,"Lower threshold for data" +upper,r,h,INDEF,,,"Upper threshold for data" +niterate,i,h,3,2,,"Maximum number of iterations" +tolerance,i,h,0,0,,"Tolerance for convergence" +maxshift,r,h,INDEF,,,"Maximum acceptable pixel shift" + +shiftimages,b,h,yes,,,"Shift the images ?" +interp_type,s,h,"linear","|nearest|linear|poly3|poly5|spline3|",,"Interpolant" +boundary_type,s,h,"nearest","|constant|nearest|reflect|wrap|",,"Boundary type" +constant,r,h,0.,,,"Constant for constant boundary extension" + +trimimages,b,h,yes,,,"Trim the shifted images ?" + +verbose,b,h,yes,,,"Print the centers, shifts, and trim section ?" + +list,*s,h + +mode,s,h,'ql' diff --git a/pkg/images/immatch/imcentroid.par b/pkg/images/immatch/imcentroid.par new file mode 100644 index 00000000..8a93d787 --- /dev/null +++ b/pkg/images/immatch/imcentroid.par @@ -0,0 +1,16 @@ +input,s,a,,,,"List of input images" +reference,s,a,"",,,"Reference image" +coords,s,a,,,,"Reference coordinates file" +shifts,s,h,"",,,"Initial shifts file" + +boxsize,i,h,7,1,,"Size of the fine centering box" +bigbox,i,h,11,1,,"Size of the coarse centering box" + +negative,b,h,no,,,"Are the features negative ?" +background,r,h,INDEF,,,"Reference background level" +lower,r,h,INDEF,,,"Lower threshold for data" +upper,r,h,INDEF,,,"Upper threshold for data" +niterate,i,h,3,2,,"Maximum number of iterations" +tolerance,i,h,0,0,,"Tolerance for convergence" +maxshift,r,h,INDEF,,,"Maximum acceptable pixel shift" +verbose,b,h,yes,,,"Print the centroids for every source ?" diff --git a/pkg/images/immatch/imcombine.par b/pkg/images/immatch/imcombine.par new file mode 100644 index 00000000..ead908e4 --- /dev/null +++ b/pkg/images/immatch/imcombine.par @@ -0,0 +1,43 @@ +# IMCOMBINE -- Image combine parameters + +input,s,a,,,,List of images to combine +output,s,a,,,,List of output images +headers,s,h,"",,,List of header files (optional) +bpmasks,s,h,"",,,List of bad pixel masks (optional) +rejmasks,s,h,"",,,List of rejection masks (optional) +nrejmasks,s,h,"",,,List of number rejected masks (optional) +expmasks,s,h,"",,,List of exposure masks (optional) +sigmas,s,h,"",,,List of sigma images (optional) +imcmb,s,h,"$I",,,Keyword for IMCMB keywords +logfile,s,h,"STDOUT",,,"Log file +" +combine,s,h,"average","average|median|lmedian|sum|quadrature|nmodel",,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 +outlimits,s,h,"",,,Output limits (x1 x2 y1 y2 ...) +offsets,f,h,"none",,,Input image offsets +masktype,s,h,"none","",,Mask type +maskvalue,s,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 +expname,s,h,"",,,"Image header exposure time keyword +" +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,r,h,0.,0.,,Radius (pixels) for neighbor rejection diff --git a/pkg/images/immatch/immatch.cl b/pkg/images/immatch/immatch.cl new file mode 100644 index 00000000..eeecba73 --- /dev/null +++ b/pkg/images/immatch/immatch.cl @@ -0,0 +1,39 @@ +#{ IMMATCH -- The Image Matching Package. + +set immatch = "images$immatch/" +set imgeom = "images$imgeom/" +set imutil = "images$imutil/" + +package immatch + +# Tasks. + +task imcentroid, + imcombine, + geomap, + geotran, + geoxytran, + linmatch, + psfmatch, + skyxymatch, + wcscopy, + wcsxymatch, + xregister, + xyxymatch = "immatch$x_images.e" + +task imshift = "imgeom$x_images.e" +task imcopy = "imutil$x_images.e" +task sections = "imutil$x_images.e" +hidetask imshift, imcopy, sections + +# Scripts + +task gregister = "immatch$gregister.cl" +task imalign = "immatch$imalign.cl" +task skymap = "immatch$skymap.cl" +task sregister = "immatch$sregister.cl" +task wcsmap = "immatch$wcsmap.cl" +task wregister = "immatch$wregister.cl" + + +clbye() diff --git a/pkg/images/immatch/immatch.hd b/pkg/images/immatch/immatch.hd new file mode 100644 index 00000000..7478b683 --- /dev/null +++ b/pkg/images/immatch/immatch.hd @@ -0,0 +1,32 @@ +# Help directory for the IMMATCH package + +$immatch = "images$immatch/" +$doc = "images$immatch/doc/" +$geometry = "images$immatch/src/geometry/" +$imcombine = "images$immatch/src/imcombine/" +$linmatch = "images$immatch/src/linmatch/" +$listmatch = "images$immatch/src/listmatch/" +$psfmatch = "images$immatch/src/psfmatch/" +$wcsmatch = "images$immatch/src/wcsmatch/" +$xregister = "images$immatch/src/xregister/" + +geomap hlp=doc$geomap.hlp, src=geometry$t_geomap.x +geotran hlp=doc$geotran.hlp, src=geometry$t_geotran.x +geoxytran hlp=doc$geoxytran.hlp, src=geometry$t_geoxytran.x +gregister hlp=doc$gregister.hlp, src=immatch$gregister.cl +imalign hlp=doc$imalign.hlp, src=immatch$imalign.cl +imcentroid hlp=doc$imcentroid.hlp, src=listmatch$t_imctroid.x +imcombine hlp=doc$imcombine.hlp, src=imcombine$t_imcombine.x +linmatch hlp=doc$linmatch.hlp, src=linmatch$t_linmatch.x +psfmatch hlp=doc$psfmatch.hlp, src=psfmatch$t_psfmatch.x +skymap hlp=doc$skymap.hlp, src=immatch$skymap.cl +skyxymatch hlp=doc$skyxymatch.hlp, src=wcsmatch$t_skyxymatch.x +sregister hlp=doc$sregister.hlp, src=immatch$sregister.cl +wcscopy hlp=doc$wcscopy.hlp, src=wcsmatch$t_wcscopy.x +wcsmap hlp=doc$wcsmap.hlp, src=immatch$wcsmap.cl +wcsxymatch hlp=doc$wcsxymatch.hlp, src=wcsmatch$t_wcsxymatch.x +wregister hlp=doc$wregister.hlp, src=immatch$wregister.cl +xregister hlp=doc$xregister.hlp, src=xregister$t_xregister.x +xyxymatch hlp=doc$xyxymatch.hlp, src=listmatch$t_xyxymatch.x +revisions sys=Revisions + diff --git a/pkg/images/immatch/immatch.men b/pkg/images/immatch/immatch.men new file mode 100644 index 00000000..f9829bd7 --- /dev/null +++ b/pkg/images/immatch/immatch.men @@ -0,0 +1,18 @@ + geomap - Compute geometric transforms using matched coordinate lists + geotran - Transform 1-D or 2-D images using various mapping transforms + geoxytran - Transform coordinate lists using the geomap transforms + gregister - Register 1-D or 2-D images using the geomap transforms + imalign - Align and register 2-D images using a reference pixel list + imcentroid - Compute and print relative shifts for a list of 2-D images + imcombine - Combine images pixel-by-pixel using various algorithms + linmatch - Match the linear intensity scales of 1-D or 2-D images + psfmatch - Match the point-spread functions of 1-D or 2-D images + skymap - Compute geometric transforms using the image celestial wcs + skyxymatch - Generate matched pixel lists using the image celestial wcs + sregister - Register 1-D or 2-D images using the image celestial wcs + wcscopy - Copy the wcs from one image to another + wcsmap - Compute geometric transforms using the image wcs + wcsxymatch - Generate matched pixel lists using the image wcs + wregister - Register 1-D or 2-D images using the image wcs + xregister - Register 1-D or 2-D images using x-correlation techniques + xyxymatch - Match pixel coordinate lists diff --git a/pkg/images/immatch/immatch.par b/pkg/images/immatch/immatch.par new file mode 100644 index 00000000..cef3f3ff --- /dev/null +++ b/pkg/images/immatch/immatch.par @@ -0,0 +1 @@ +version,s,h,"Jan97" diff --git a/pkg/images/immatch/linmatch.par b/pkg/images/immatch/linmatch.par new file mode 100644 index 00000000..ae3183d5 --- /dev/null +++ b/pkg/images/immatch/linmatch.par @@ -0,0 +1,30 @@ +input,s,a,,,,"Input images" +reference,s,a,,,,"Reference images or reference photometry files" +regions,s,a,"",,,"Reference image regions or input image photometry files" +lintransform,f,a,"",,,"Input/output linear transformation database file" +output,s,h,"",,,"Output scaled images" +databasefmt,b,h,yes,,,"Write the linear transformatoin file in database format ?" +append,b,h,yes,,,"Open transformation database for writing in append mode" +records,s,h,"",,,"List of scale factors database records" +shifts,f,h,"",,,"Input shifts file" +xshift,r,h,0.,,,"The input to reference image x shift" +yshift,r,h,0.,,,"The input to reference image y shift" +dnx,r,h,31.,,,"X width of data region to extract" +dny,r,h,31.,,,"Y width of data region to extract" +maxnregions,i,h,100,,,"Maximum number of regions or objects" +scaling,s,h,"mean mean",,,"Scaling algorithm (number,mean,median,mode,fit,photometry)" +datamin,r,h,INDEF,,,"The minimum good data value" +datamax,r,h,INDEF,,,"The maximum good data value" +maxiter,i,h,10,,,"Maximum number of least squares fitting iterations" +nreject,i,h,0,,,"Maximum number of rejection iterations" +loreject,r,h,INDEF,,,"Low-side fitting sigma rejection criterion" +hireject,r,h,INDEF,,,"High-side fitting sigma rejection criterion" +gain,s,h,"1.0 1.0",,,"Image header gain keyword or value" +readnoise,s,h,"0.0 0.0",,,"Image header readout noise keyword or value" +interactive,b,h,no,,,"Interactive mode ?" +verbose,b,h,yes,,,"Verbose mode ?" +graphics,s,h,"stdgraph",,,"The standard graphics device" +display,s,h,"stdimage",,,"The standard image display device" +gcommands,*gcur,h,"",,,"The graphics cursor" +icommands,*imcur,h,"",,,"The image display cursor" +mode,s,h,"ql",,, diff --git a/pkg/images/immatch/mkpkg b/pkg/images/immatch/mkpkg new file mode 100644 index 00000000..988c7963 --- /dev/null +++ b/pkg/images/immatch/mkpkg @@ -0,0 +1,5 @@ +# MKPKG for the IMMATCH Package + +libpkg.a: + @src + ; diff --git a/pkg/images/immatch/psfmatch.par b/pkg/images/immatch/psfmatch.par new file mode 100644 index 00000000..042b383b --- /dev/null +++ b/pkg/images/immatch/psfmatch.par @@ -0,0 +1,40 @@ +# The PSFMATCH parameters + +input,f,a,,,,Input images +reference,f,a,,,,Reference images or reference psfs +psfdata,f,a,,,,Objects lists or input psfs +kernel,f,a,"",,,Input/output convolution kernels +output,f,h,"",,,Output convolved images + +convolution,s,h,"image","|image|psf|kernel|",,Kernel computation method +dnx,i,h,31,,,X width of data region to extract +dny,i,h,31,,,Y width of data region to extract +pnx,i,h,15,,,X width of convolution kernel +pny,i,h,15,,,Y width of convolution kernel + +center,b,h,"yes",,,Center the psf objects ? +background,s,h,"median",,,Background fitting function +loreject,r,h,INDEF,,,Low sigma rejection threshold +hireject,r,h,INDEF,,,High sigma rejection threshold +apodize,r,h,0,,,Fraction of endpoints to apodize + +fluxratio,s,h,INDEF,,,The reference to input integrated flux ratio +filter,s,h,"replace","|none|cosbell|replace|model|",,Filter/replace option +sx1,r,h,INDEF,,,Inner x spectral frequency for cosine bell filter +sx2,r,h,INDEF,,,Outer x spectral frequency for cosine bell filter +sy1,r,h,INDEF,,,Inner y spectral frequency for cosine bell filter +sy2,r,h,INDEF,,,Outer y spectral frequency for cosine bell filter +radsym,b,h,no,,,Radial symmetry for cosine bell filter ? +threshold,r,h,0.2,0.0,1.0,Threshold in fourier spectrum for modeling/replacing +normfactor,r,h,1.0,,,The kernel normalization factor + +boundary,s,h,'nearest',"|constant|nearest|reflect|wrap|",,Boundary extension +constant,r,h,0.0,,,Constant for constant boundary extension + +interactive,b,h,no,,,Interactive mode ? +verbose,b,h,yes,,,Verbose mode ? +graphics,s,h,"stdgraph",,,The default graphics device +display,s,h,"stdimage",,,The default display device +gcommands,*gcur,h,"",,,Graphics cursor +icommands,*imcur,h,"",,,Image display cursor +mode,s,h,"ql" diff --git a/pkg/images/immatch/skymap.cl b/pkg/images/immatch/skymap.cl new file mode 100644 index 00000000..f8785eb0 --- /dev/null +++ b/pkg/images/immatch/skymap.cl @@ -0,0 +1,114 @@ +# SKYMAP -- Compute the geometric transformation required to register an +# input image to a reference image using celestial coordinate WCS information +# in the input and reference image headers. SKYMAP is a simple script task +# which calls the SKYXYMATCH task to compute the control points followed by +# the GEOMAP task to compute the transformation. + + +procedure skymap (input, reference, database) + +file input {prompt="The input images"} +file reference {prompt="The input reference images"} +file database {prompt="The output database file"} +file transforms {"", prompt="The database transform names"} +file results {"", prompt="The optional results summary files"} +real xmin {INDEF, + prompt="Minimum logical x reference coordinate value"} +real xmax {INDEF, + prompt="Maximum logical x reference coordinate value"} +real ymin {INDEF, + prompt="Minimum logical y reference coordinate value"} +real ymax {INDEF, + prompt="Maximum logical y reference coordinate value"} +int nx {10, prompt="Number of grid points in x"} +int ny {10, prompt="Number of grid points in y"} +string wcs {"world", prompt="The default world coordinate system", + enum="physical|world"} +string xformat {"%10.3f", prompt="Output logical x coordinate format"} +string yformat {"%10.3f", prompt="Output logical y coordinate format"} +string rwxformat {"", + prompt="Output reference world x coordinate format"} +string rwyformat {"", + prompt="Output reference world y coordinate format"} +string wxformat {"", prompt="Output world x coordinate format"} +string wyformat {"", prompt="Output world y coordinate format"} +string fitgeometry {"general", + prompt="Fitting geometry", + enum="shift|xyscale|rotate|rscale|rxyscale|general"} +string function {"polynomial", prompt="Surface type", + enum="legendre|chebyshev|polynomial"} +int xxorder {2, prompt="Order of x fit in x"} +int xyorder {2, prompt="Order of x fit in y"} +string xxterms {"half", enum="none|half|full", + prompt="X fit cross terms type"} +int yxorder {2, prompt="Order of y fit in x"} +int yyorder {2, prompt="Order of y fit in y"} +string yxterms {"half", enum="none|half|full", + prompt="Y fit cross terms type"} +real reject {INDEF, prompt="Rejection limit in sigma units"} +string calctype {"real", prompt="Computation precision", + enum="real|double"} +bool verbose {yes, prompt="Print messages about progress of task ?"} +bool interactive {yes, prompt="Compute transformation interactively ? "} +string graphics {"stdgraph", prompt="Default graphics device"} +gcur gcommands {"", prompt="Graphics cursor"} + + +begin + # Declare local variables. + int nimages + string tinput, treference, tcoords, toutput, ttransforms, tresults + string tsections1, tsections2, tcname + + # Cache the sections task. + cache sections + + # Get the query parameters. + tinput = input + treference = reference + toutput = database + if (transforms == "") { + ttransforms = tinput + } else { + ttransforms = transforms + } + tresults = results + + # Get the temproary coordinates file list. + tsections1 = mktemp ("tmps1") + tsections2 = mktemp ("tmps2") + if (access ("imxymatch.1")) { + tcoords = mktemp ("imxymatch") + } else { + tcoords = "imxymatch" + } + sections (tinput, option="fullname", > tsections1) + nimages = sections.nimages + for (i = 1; i <= nimages; i = i + 1) { + printf ("%s\n", tcoords // "." // i, >> tsections2) + } + delete (tsections1, go_ahead+, verify-, default_action+, + allversions+, subfiles+, > "dev$null") + tcname = "@"//tsections2 + + # Compute the control points. + skyxymatch (tinput, treference, tcname, coords="grid", xmin=xmin, + xmax=xmax, ymin=ymin, ymax=ymax, nx=nx, ny=ny, wcs=wcs, + xcolumn=1, ycolumn=1, xunits="", yunits="", xformat=xformat, + yformat=yformat, rwxformat=rwxformat, rwyformat=rwyformat, + wxformat=wxformat, wyformat=wyformat, min_sigdigits=7, verbose=no) + + # Compute the transformation. + geomap (tcname, toutput, xmin, xmax, ymin, ymax, transforms=ttransforms, + results=tresults, fitgeometry=fitgeometry, function=function, + xxorder=xxorder, xyorder=xyorder, xxterms=xxterms, yxorder=yxorder, + yyorder=yyorder, yxterms=yxterms, reject=reject, calctype=calctype, + verbose=verbose, interactive=interactive, graphics=graphics, + cursor=gcommands) + + # Cleanup. + delete (tcname, go_ahead+, verify-, default_action+, + allversions+, subfiles+, > "dev$null") + delete (tsections2, go_ahead+, verify-, default_action+, + allversions+, subfiles+, > "dev$null") +end diff --git a/pkg/images/immatch/skyxymatch.par b/pkg/images/immatch/skyxymatch.par new file mode 100644 index 00000000..7d1f42e1 --- /dev/null +++ b/pkg/images/immatch/skyxymatch.par @@ -0,0 +1,26 @@ +# Parameter file for the SKYXYMATCH task + +input,f,a,,,,Input images +reference,f,a,,,,Input reference images +output,f,a,,,,Output matched coordinate lists +coords,f,h,"grid",,,Reference coordinate lists +xmin,r,h,INDEF,,,Minimum logical x reference coordinate value +xmax,r,h,INDEF,,,Maximum logical x reference coordinate value +ymin,r,h,INDEF,,,Minimum logical y reference coordinate value +ymax,r,h,INDEF,,,Maximum logical y reference coordinate value +nx,i,h,10,1,,Number of grid points in x +ny,i,h,10,1,,Number of grid points in y +wcs,s,h,"world","|physical|world|",,Input coordinate system +xcolumn,i,h,1,1,,Input column containing x coordinate +ycolumn,i,h,2,1,,Input column containing y coordinate +xunits,s,h,"",,,Input x coordinate units +yunits,s,h,"",,,Input y coordinate units +xformat,s,h,"%10.3f",,,Output logical x coordinate format +yformat,s,h,"%10.3f",,,Output logical y coordinate format +rwxformat,s,h,"",,,Output reference world x coordinate format +rwyformat,s,h,"",,,Output reference world y coordinate format +wxformat,s,h,"",,,Output world x coordinate format +wyformat,s,h,"",,,Output world y coordinate format +min_sigdigits,i,h,7,,,Minimum number of significant digits +verbose,b,h,yes,,,Verbose mode ? +mode,s,h,ql,,, diff --git a/pkg/images/immatch/src/geometry/geofunc.gx b/pkg/images/immatch/src/geometry/geofunc.gx new file mode 100644 index 00000000..3b34a207 --- /dev/null +++ b/pkg/images/immatch/src/geometry/geofunc.gx @@ -0,0 +1,250 @@ +include <math.h> +include <math/gsurfit.h> + +$for (rd) + +# GEO_DROTMAG -- Adjust the coefficients of the fit using the database file. + +procedure geo_drotmag$t (dt, rec, sx1, sy1, xmag, ymag, xrot, yrot) + +pointer dt #I pointer to the text database file +int rec #I record number +pointer sx1, sy1 #I/O pointers to the x and y linear surfaces +PIXEL xmag, ymag #I/O the x and y magnification +PIXEL xrot, yrot #I/O the x and y axis rotation + +real dtgetr() + +begin + if (IS_$INDEF$T(xmag)) + xmag = PIXEL (dtgetr (dt, rec, "xmag")) + if (IS_$INDEF$T(ymag)) + ymag = PIXEL (dtgetr (dt, rec, "ymag")) + if (IS_$INDEF$T(xrot)) + xrot = DEGTORAD (PIXEL(dtgetr (dt, rec, "xrotation"))) + else + xrot = DEGTORAD(xrot) + if (IS_$INDEF$T(yrot)) + yrot = DEGTORAD (PIXEL (dtgetr (dt, rec, "yrotation"))) + else + yrot = DEGTORAD(yrot) + call geo_rotmag$t (sx1, sy1, xmag, ymag, xrot, yrot) +end + + +# GEO_DXYSHIFT -- Adjust the fitted xy shift using the database file. + +procedure geo_dxyshift$t (dt, rec, sx1, sy1, xout, yout, xref, yref, + xshift, yshift) + +pointer dt #I pointer to the text file database +int rec #I the database record +pointer sx1, sy1 #I/O pointers to the x and y linear surfaces +PIXEL xout, yout #I the input coordinate system origin +PIXEL xref, yref #I the reference coordinate system origin +PIXEL xshift, yshift #I the origin shift in input coordinates + +$if (datatype == r) +PIXEL gsgetr(), gseval() +$else +PIXEL dgsgetd(), dgseval() +$endif + +begin +$if (datatype == r) + if (IS_$INDEF$T(xref)) + xref = (gsgetr (sx1, GSXMIN) + gsgetr (sx1, GSXMAX)) / 2.0 + if (IS_$INDEF$T(yref)) + yref = (gsgetr (sy1, GSYMIN) + gsgetr (sy1, GSYMAX)) / 2.0 + + if (IS_$INDEF$T(xout)) + xout = gseval (sx1, xref, yref) + if (IS_$INDEF$T(yout)) + yout = gseval (sy1, xref, yref) + + if (IS_$INDEF$T(xshift)) + xshift = xout - gseval (sx1, xref, yref) + if (IS_$INDEF$T(yshift)) + yshift = yout - gseval (sy1, xref, yref) +$else + if (IS_$INDEF$T(xref)) + xref = (dgsgetd (sx1, GSXMIN) + dgsgetd (sx1, GSXMAX)) / 2.0d0 + if (IS_$INDEF$T(yref)) + yref = (dgsgetd (sy1, GSYMIN) + dgsgetd (sy1, GSYMAX)) / 2.0d0 + + if (IS_$INDEF$T(xout)) + xout = dgseval (sx1, xref, yref) + if (IS_$INDEF$T(yout)) + yout = dgseval (sy1, xref, yref) + + if (IS_$INDEF$T(xshift)) + xshift = xout - dgseval (sx1, xref, yref) + if (IS_$INDEF$T(yshift)) + yshift = yout - dgseval (sy1, xref, yref) +$endif + + call geo_xyshift$t (sx1, sy1, xshift, yshift) +end + + +# GEO_ROTMAG -- Edit the coefficients of the linear surface which determine +# magnification and rotation. + +procedure geo_rotmag$t (sx1, sy1, xscale, yscale, xrotation, yrotation) + +pointer sx1, sy1 #I/O pointers to the linear x and y surfaces +PIXEL xscale, yscale #I the x and y scales +PIXEL xrotation,yrotation #I the x and y axis rotation angles in radians + +PIXEL cosx, sinx, cosy, siny, xrange, yrange +int ncoeff +pointer sp, xcoeff, ycoeff +$if (datatype == r) +real gsgetr() +int gsgeti() +$else +double dgsgetd() +int dgsgeti() +$endif + +begin + # Get the current solution. + call smark (sp) +$if (datatype == r) + ncoeff = max (gsgeti (sx1, GSNSAVE), gsgeti (sy1, GSNSAVE)) +$else + ncoeff = max (dgsgeti (sx1, GSNSAVE), dgsgeti (sy1, GSNSAVE)) +$endif + call salloc (xcoeff, ncoeff, TY_PIXEL) + call salloc (ycoeff, ncoeff, TY_PIXEL) +$if (datatype == r) + call gssave (sx1, Mem$t[xcoeff]) + call gssave (sy1, Mem$t[ycoeff]) +$else + call dgssave (sx1, Mem$t[xcoeff]) + call dgssave (sy1, Mem$t[ycoeff]) +$endif + + # Define the scaling parameters. + cosx = cos (xrotation) + sinx = sin (xrotation) + cosy = cos (yrotation) + siny = sin (yrotation) + + # Calculate coefficients. + Mem$t[xcoeff+GS_SAVECOEFF+1] = xscale * cosx + Mem$t[xcoeff+GS_SAVECOEFF+2] = yscale * siny + Mem$t[ycoeff+GS_SAVECOEFF+1] = -xscale * sinx + Mem$t[ycoeff+GS_SAVECOEFF+2] = yscale * cosy + + # Normalize coefficients for-non polynomial functions. +$if (datatype == r) + if (gsgeti (sx1, GSTYPE) != GS_POLYNOMIAL) { + xrange = gsget$t (sx1, GSXMAX) - gsget$t (sx1, GSXMIN) +$else + if (dgsgeti (sx1, GSTYPE) != GS_POLYNOMIAL) { + xrange = dgsget$t (sx1, GSXMAX) - dgsget$t (sx1, GSXMIN) +$endif + Mem$t[xcoeff+GS_SAVECOEFF+1] = Mem$t[xcoeff+GS_SAVECOEFF+1] * + xrange / 2.d0 + Mem$t[xcoeff+GS_SAVECOEFF+2] = Mem$t[xcoeff+GS_SAVECOEFF+2] * + yrange / 2.d0 + } +$if (datatype == r) + if (gsgeti (sy1, GSTYPE) != GS_POLYNOMIAL) { + yrange = gsget$t (sy1, GSYMAX) - gsget$t (sy1, GSYMIN) +$else + if (dgsgeti (sy1, GSTYPE) != GS_POLYNOMIAL) { + yrange = dgsget$t (sy1, GSYMAX) - dgsget$t (sy1, GSYMIN) +$endif + Mem$t[ycoeff+GS_SAVECOEFF+1] = Mem$t[ycoeff+GS_SAVECOEFF+1] * + xrange / 2.d0 + Mem$t[ycoeff+GS_SAVECOEFF+2] = Mem$t[ycoeff+GS_SAVECOEFF+2] * + yrange / 2.d0 + } + +$if (datatype == r) + # Free the original fit. + call gsfree (sx1) + call gsfree (sy1) + + # Restore the edited fit. + call gsrestore (sx1, Mem$t[xcoeff]) + call gsrestore (sy1, Mem$t[ycoeff]) +$else + # Free the original fit. + call dgsfree (sx1) + call dgsfree (sy1) + + # Restore the edited fit. + call dgsrestore (sx1, Mem$t[xcoeff]) + call dgsrestore (sy1, Mem$t[ycoeff]) +$endif + + call sfree (sp) +end + + +# GEO_XYSHIFT -- Shift the linear part of the fit in x and y. + +procedure geo_xyshift$t (sx1, sy1, xshift, yshift) + +pointer sx1, sy1 #I pointers to linear x and y surfaces +PIXEL xshift, yshift #I the input x and y shifts + +int ncoeff +pointer sp, xcoeff, ycoeff +$if (datatype == r) +int gsgeti() +$else +int dgsgeti() +$endif + +begin + call smark (sp) + + # Allocate working space. +$if (datatype == r) + ncoeff = max (gsgeti (sx1, GSNSAVE), gsgeti (sy1, GSNSAVE)) +$else + ncoeff = max (dgsgeti (sx1, GSNSAVE), dgsgeti (sy1, GSNSAVE)) +$endif + call salloc (xcoeff, ncoeff, TY_PIXEL) + call salloc (ycoeff, ncoeff, TY_PIXEL) + + # Get coefficients. +$if (datatype == r) + call gssave (sx1, Mem$t[xcoeff]) + call gssave (sy1, Mem$t[ycoeff]) +$else + call dgssave (sx1, Mem$t[xcoeff]) + call dgssave (sy1, Mem$t[ycoeff]) +$endif + + # Shift the coefficients. + Mem$t[xcoeff+GS_SAVECOEFF] = Mem$t[xcoeff+GS_SAVECOEFF] + xshift + Mem$t[ycoeff+GS_SAVECOEFF] = Mem$t[ycoeff+GS_SAVECOEFF] + yshift + +$if (datatype == r) + # Free original fit. + call gsfree (sx1) + call gsfree (sy1) + + # Restore fit. + call gsrestore (sx1, Mem$t[xcoeff]) + call gsrestore (sy1, Mem$t[ycoeff]) +$else + # Free original fit. + call dgsfree (sx1) + call dgsfree (sy1) + + # Restore fit. + call dgsrestore (sx1, Mem$t[xcoeff]) + call dgsrestore (sy1, Mem$t[ycoeff]) +$endif + + call sfree (sp) +end + + +$endfor diff --git a/pkg/images/immatch/src/geometry/geofunc.x b/pkg/images/immatch/src/geometry/geofunc.x new file mode 100644 index 00000000..c3be8fa5 --- /dev/null +++ b/pkg/images/immatch/src/geometry/geofunc.x @@ -0,0 +1,340 @@ +include <math.h> +include <math/gsurfit.h> + + + +# GEO_DROTMAG -- Adjust the coefficients of the fit using the database file. + +procedure geo_drotmagr (dt, rec, sx1, sy1, xmag, ymag, xrot, yrot) + +pointer dt #I pointer to the text database file +int rec #I record number +pointer sx1, sy1 #I/O pointers to the x and y linear surfaces +real xmag, ymag #I/O the x and y magnification +real xrot, yrot #I/O the x and y axis rotation + +real dtgetr() + +begin + if (IS_INDEFR(xmag)) + xmag = real (dtgetr (dt, rec, "xmag")) + if (IS_INDEFR(ymag)) + ymag = real (dtgetr (dt, rec, "ymag")) + if (IS_INDEFR(xrot)) + xrot = DEGTORAD (real(dtgetr (dt, rec, "xrotation"))) + else + xrot = DEGTORAD(xrot) + if (IS_INDEFR(yrot)) + yrot = DEGTORAD (real (dtgetr (dt, rec, "yrotation"))) + else + yrot = DEGTORAD(yrot) + call geo_rotmagr (sx1, sy1, xmag, ymag, xrot, yrot) +end + + +# GEO_DXYSHIFT -- Adjust the fitted xy shift using the database file. + +procedure geo_dxyshiftr (dt, rec, sx1, sy1, xout, yout, xref, yref, + xshift, yshift) + +pointer dt #I pointer to the text file database +int rec #I the database record +pointer sx1, sy1 #I/O pointers to the x and y linear surfaces +real xout, yout #I the input coordinate system origin +real xref, yref #I the reference coordinate system origin +real xshift, yshift #I the origin shift in input coordinates + +real gsgetr(), gseval() + +begin + if (IS_INDEFR(xref)) + xref = (gsgetr (sx1, GSXMIN) + gsgetr (sx1, GSXMAX)) / 2.0 + if (IS_INDEFR(yref)) + yref = (gsgetr (sy1, GSYMIN) + gsgetr (sy1, GSYMAX)) / 2.0 + + if (IS_INDEFR(xout)) + xout = gseval (sx1, xref, yref) + if (IS_INDEFR(yout)) + yout = gseval (sy1, xref, yref) + + if (IS_INDEFR(xshift)) + xshift = xout - gseval (sx1, xref, yref) + if (IS_INDEFR(yshift)) + yshift = yout - gseval (sy1, xref, yref) + + call geo_xyshiftr (sx1, sy1, xshift, yshift) +end + + +# GEO_ROTMAG -- Edit the coefficients of the linear surface which determine +# magnification and rotation. + +procedure geo_rotmagr (sx1, sy1, xscale, yscale, xrotation, yrotation) + +pointer sx1, sy1 #I/O pointers to the linear x and y surfaces +real xscale, yscale #I the x and y scales +real xrotation,yrotation #I the x and y axis rotation angles in radians + +real cosx, sinx, cosy, siny, xrange, yrange +int ncoeff +pointer sp, xcoeff, ycoeff +real gsgetr() +int gsgeti() + +begin + # Get the current solution. + call smark (sp) + ncoeff = max (gsgeti (sx1, GSNSAVE), gsgeti (sy1, GSNSAVE)) + call salloc (xcoeff, ncoeff, TY_REAL) + call salloc (ycoeff, ncoeff, TY_REAL) + call gssave (sx1, Memr[xcoeff]) + call gssave (sy1, Memr[ycoeff]) + + # Define the scaling parameters. + cosx = cos (xrotation) + sinx = sin (xrotation) + cosy = cos (yrotation) + siny = sin (yrotation) + + # Calculate coefficients. + Memr[xcoeff+GS_SAVECOEFF+1] = xscale * cosx + Memr[xcoeff+GS_SAVECOEFF+2] = yscale * siny + Memr[ycoeff+GS_SAVECOEFF+1] = -xscale * sinx + Memr[ycoeff+GS_SAVECOEFF+2] = yscale * cosy + + # Normalize coefficients for-non polynomial functions. + if (gsgeti (sx1, GSTYPE) != GS_POLYNOMIAL) { + xrange = gsgetr (sx1, GSXMAX) - gsgetr (sx1, GSXMIN) + Memr[xcoeff+GS_SAVECOEFF+1] = Memr[xcoeff+GS_SAVECOEFF+1] * + xrange / 2.d0 + Memr[xcoeff+GS_SAVECOEFF+2] = Memr[xcoeff+GS_SAVECOEFF+2] * + yrange / 2.d0 + } + if (gsgeti (sy1, GSTYPE) != GS_POLYNOMIAL) { + yrange = gsgetr (sy1, GSYMAX) - gsgetr (sy1, GSYMIN) + Memr[ycoeff+GS_SAVECOEFF+1] = Memr[ycoeff+GS_SAVECOEFF+1] * + xrange / 2.d0 + Memr[ycoeff+GS_SAVECOEFF+2] = Memr[ycoeff+GS_SAVECOEFF+2] * + yrange / 2.d0 + } + + # Free the original fit. + call gsfree (sx1) + call gsfree (sy1) + + # Restore the edited fit. + call gsrestore (sx1, Memr[xcoeff]) + call gsrestore (sy1, Memr[ycoeff]) + + call sfree (sp) +end + + +# GEO_XYSHIFT -- Shift the linear part of the fit in x and y. + +procedure geo_xyshiftr (sx1, sy1, xshift, yshift) + +pointer sx1, sy1 #I pointers to linear x and y surfaces +real xshift, yshift #I the input x and y shifts + +int ncoeff +pointer sp, xcoeff, ycoeff +int gsgeti() + +begin + call smark (sp) + + # Allocate working space. + ncoeff = max (gsgeti (sx1, GSNSAVE), gsgeti (sy1, GSNSAVE)) + call salloc (xcoeff, ncoeff, TY_REAL) + call salloc (ycoeff, ncoeff, TY_REAL) + + # Get coefficients. + call gssave (sx1, Memr[xcoeff]) + call gssave (sy1, Memr[ycoeff]) + + # Shift the coefficients. + Memr[xcoeff+GS_SAVECOEFF] = Memr[xcoeff+GS_SAVECOEFF] + xshift + Memr[ycoeff+GS_SAVECOEFF] = Memr[ycoeff+GS_SAVECOEFF] + yshift + + # Free original fit. + call gsfree (sx1) + call gsfree (sy1) + + # Restore fit. + call gsrestore (sx1, Memr[xcoeff]) + call gsrestore (sy1, Memr[ycoeff]) + + call sfree (sp) +end + + + + +# GEO_DROTMAG -- Adjust the coefficients of the fit using the database file. + +procedure geo_drotmagd (dt, rec, sx1, sy1, xmag, ymag, xrot, yrot) + +pointer dt #I pointer to the text database file +int rec #I record number +pointer sx1, sy1 #I/O pointers to the x and y linear surfaces +double xmag, ymag #I/O the x and y magnification +double xrot, yrot #I/O the x and y axis rotation + +real dtgetr() + +begin + if (IS_INDEFD(xmag)) + xmag = double (dtgetr (dt, rec, "xmag")) + if (IS_INDEFD(ymag)) + ymag = double (dtgetr (dt, rec, "ymag")) + if (IS_INDEFD(xrot)) + xrot = DEGTORAD (double(dtgetr (dt, rec, "xrotation"))) + else + xrot = DEGTORAD(xrot) + if (IS_INDEFD(yrot)) + yrot = DEGTORAD (double (dtgetr (dt, rec, "yrotation"))) + else + yrot = DEGTORAD(yrot) + call geo_rotmagd (sx1, sy1, xmag, ymag, xrot, yrot) +end + + +# GEO_DXYSHIFT -- Adjust the fitted xy shift using the database file. + +procedure geo_dxyshiftd (dt, rec, sx1, sy1, xout, yout, xref, yref, + xshift, yshift) + +pointer dt #I pointer to the text file database +int rec #I the database record +pointer sx1, sy1 #I/O pointers to the x and y linear surfaces +double xout, yout #I the input coordinate system origin +double xref, yref #I the reference coordinate system origin +double xshift, yshift #I the origin shift in input coordinates + +double dgsgetd(), dgseval() + +begin + if (IS_INDEFD(xref)) + xref = (dgsgetd (sx1, GSXMIN) + dgsgetd (sx1, GSXMAX)) / 2.0d0 + if (IS_INDEFD(yref)) + yref = (dgsgetd (sy1, GSYMIN) + dgsgetd (sy1, GSYMAX)) / 2.0d0 + + if (IS_INDEFD(xout)) + xout = dgseval (sx1, xref, yref) + if (IS_INDEFD(yout)) + yout = dgseval (sy1, xref, yref) + + if (IS_INDEFD(xshift)) + xshift = xout - dgseval (sx1, xref, yref) + if (IS_INDEFD(yshift)) + yshift = yout - dgseval (sy1, xref, yref) + + call geo_xyshiftd (sx1, sy1, xshift, yshift) +end + + +# GEO_ROTMAG -- Edit the coefficients of the linear surface which determine +# magnification and rotation. + +procedure geo_rotmagd (sx1, sy1, xscale, yscale, xrotation, yrotation) + +pointer sx1, sy1 #I/O pointers to the linear x and y surfaces +double xscale, yscale #I the x and y scales +double xrotation,yrotation #I the x and y axis rotation angles in radians + +double cosx, sinx, cosy, siny, xrange, yrange +int ncoeff +pointer sp, xcoeff, ycoeff +double dgsgetd() +int dgsgeti() + +begin + # Get the current solution. + call smark (sp) + ncoeff = max (dgsgeti (sx1, GSNSAVE), dgsgeti (sy1, GSNSAVE)) + call salloc (xcoeff, ncoeff, TY_DOUBLE) + call salloc (ycoeff, ncoeff, TY_DOUBLE) + call dgssave (sx1, Memd[xcoeff]) + call dgssave (sy1, Memd[ycoeff]) + + # Define the scaling parameters. + cosx = cos (xrotation) + sinx = sin (xrotation) + cosy = cos (yrotation) + siny = sin (yrotation) + + # Calculate coefficients. + Memd[xcoeff+GS_SAVECOEFF+1] = xscale * cosx + Memd[xcoeff+GS_SAVECOEFF+2] = yscale * siny + Memd[ycoeff+GS_SAVECOEFF+1] = -xscale * sinx + Memd[ycoeff+GS_SAVECOEFF+2] = yscale * cosy + + # Normalize coefficients for-non polynomial functions. + if (dgsgeti (sx1, GSTYPE) != GS_POLYNOMIAL) { + xrange = dgsgetd (sx1, GSXMAX) - dgsgetd (sx1, GSXMIN) + Memd[xcoeff+GS_SAVECOEFF+1] = Memd[xcoeff+GS_SAVECOEFF+1] * + xrange / 2.d0 + Memd[xcoeff+GS_SAVECOEFF+2] = Memd[xcoeff+GS_SAVECOEFF+2] * + yrange / 2.d0 + } + if (dgsgeti (sy1, GSTYPE) != GS_POLYNOMIAL) { + yrange = dgsgetd (sy1, GSYMAX) - dgsgetd (sy1, GSYMIN) + Memd[ycoeff+GS_SAVECOEFF+1] = Memd[ycoeff+GS_SAVECOEFF+1] * + xrange / 2.d0 + Memd[ycoeff+GS_SAVECOEFF+2] = Memd[ycoeff+GS_SAVECOEFF+2] * + yrange / 2.d0 + } + + # Free the original fit. + call dgsfree (sx1) + call dgsfree (sy1) + + # Restore the edited fit. + call dgsrestore (sx1, Memd[xcoeff]) + call dgsrestore (sy1, Memd[ycoeff]) + + call sfree (sp) +end + + +# GEO_XYSHIFT -- Shift the linear part of the fit in x and y. + +procedure geo_xyshiftd (sx1, sy1, xshift, yshift) + +pointer sx1, sy1 #I pointers to linear x and y surfaces +double xshift, yshift #I the input x and y shifts + +int ncoeff +pointer sp, xcoeff, ycoeff +int dgsgeti() + +begin + call smark (sp) + + # Allocate working space. + ncoeff = max (dgsgeti (sx1, GSNSAVE), dgsgeti (sy1, GSNSAVE)) + call salloc (xcoeff, ncoeff, TY_DOUBLE) + call salloc (ycoeff, ncoeff, TY_DOUBLE) + + # Get coefficients. + call dgssave (sx1, Memd[xcoeff]) + call dgssave (sy1, Memd[ycoeff]) + + # Shift the coefficients. + Memd[xcoeff+GS_SAVECOEFF] = Memd[xcoeff+GS_SAVECOEFF] + xshift + Memd[ycoeff+GS_SAVECOEFF] = Memd[ycoeff+GS_SAVECOEFF] + yshift + + # Free original fit. + call dgsfree (sx1) + call dgsfree (sy1) + + # Restore fit. + call dgsrestore (sx1, Memd[xcoeff]) + call dgsrestore (sy1, Memd[ycoeff]) + + call sfree (sp) +end + + + diff --git a/pkg/images/immatch/src/geometry/geotimtran.x b/pkg/images/immatch/src/geometry/geotimtran.x new file mode 100644 index 00000000..f84a794d --- /dev/null +++ b/pkg/images/immatch/src/geometry/geotimtran.x @@ -0,0 +1,543 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> +include <imset.h> +include <mach.h> +include <math/gsurfit.h> +include <math/iminterp.h> +include "geotran.h" + +# GEO_IMTRAN -- Correct an entire image for geometric distortion using the +# transformed coordinates and image interpolation. + +procedure geo_imtran (input, output, geo, sx1, sy1, sx2, sy2) + +pointer input #I pointer to input image +pointer output #I pointer to output image +pointer geo #I pointer to geotran structure +pointer sx1, sy1 #I pointers to linear surface descriptors +pointer sx2, sy2 #I pointer to higher order surface descriptors + +int nincr +pointer sp, xref, yref, msi +real shift +real gsgetr() + +begin + # Initialize the interpolant and compute the out-of-bounds pixel + # margin required. + if (IM_NDIM(input) == 1) { + call asitype (GT_INTERPSTR(geo), GT_INTERPOLANT(geo), + GT_NSINC(geo), nincr, shift) + call asisinit (msi, GT_INTERPOLANT(geo), GT_NSINC(geo), + nincr, shift, 0.0) + } else { + call msitype (GT_INTERPSTR(geo), GT_INTERPOLANT(geo), + GT_NSINC(geo), nincr, shift) + call msisinit (msi, GT_INTERPOLANT(geo), GT_NSINC(geo), + nincr, nincr, shift, shift, 0.0) + } + call geo_margset (sx1, sy1, sx2, sy2, GT_XMIN(geo), GT_XMAX(geo), + GT_NCOLS(geo), GT_YMIN(geo), GT_YMAX(geo), GT_NLINES(geo), + GT_INTERPOLANT(geo), GT_NSINC(geo), GT_NXYMARGIN(geo)) + + # Allocate working space. + call smark (sp) + call salloc (xref, GT_NCOLS(geo), TY_REAL) + call salloc (yref, GT_NLINES(geo), TY_REAL) + + # Calculate the reference coordinates of the input image pixels. + call geo_ref (geo, Memr[xref], 1, GT_NCOLS(geo), GT_NCOLS(geo), + Memr[yref], 1, GT_NLINES(geo), GT_NLINES(geo), gsgetr (sx1, + GSXMIN), gsgetr (sx1, GSXMAX), gsgetr (sx1, GSYMIN), gsgetr (sx1, + GSYMAX), GT_ONE) + + # Configure the out-of-bounds pixel references for the input image. + call geo_imset (input, geo, sx1, sy1, sx2, sy2, Memr[xref], + GT_NCOLS(geo), Memr[yref], GT_NLINES(geo)) + + # Interpolate. + call geo_gsvector (input, output, geo, msi, Memr[xref], 1, + GT_NCOLS(geo), Memr[yref], 1, GT_NLINES(geo), sx1, sy1, sx2, sy2) + + # Clean up. + if (IM_NDIM(input) == 1) + call asifree (msi) + else + call msifree (msi) + call sfree (sp) +end + + +# GEO_SIMTRAN -- Correct an entire image for geometric distortion using +# nterpolated coordinate surfaces to speed up computation of the transformed +# coordinates and image interpolation. + +procedure geo_simtran (input, output, geo, sx1, sy1, sx2, sy2) + +pointer input #I pointer to input image +pointer output #I pointer to output image +pointer geo #I pointer to geotran structure +pointer sx1, sy1 #I pointer to linear surface descriptors +pointer sx2, sy2 #I pointer to higher order surface descriptors + +int nxsample, nysample, nincr +pointer sp, xsample, ysample, xinterp, yinterp +pointer xmsi, ymsi, jmsi, msi, xbuf, ybuf, jbuf +real shift +real gsgetr() + +begin + # Allocate working space and intialize the interpolant. + call smark (sp) + call salloc (xsample, GT_NCOLS(geo), TY_REAL) + call salloc (ysample, GT_NLINES(geo), TY_REAL) + call salloc (xinterp, GT_NCOLS(geo), TY_REAL) + call salloc (yinterp, GT_NLINES(geo), TY_REAL) + + # Set up sampling size. + if (GT_NCOLS(geo) == 1) + nxsample = 1 + else + nxsample = GT_NCOLS(geo) / GT_XSAMPLE(geo) + if (GT_NLINES(geo) == 1) + nysample = 1 + else + nysample = GT_NLINES(geo) / GT_YSAMPLE(geo) + + # Initialize interpolants. + if (IM_NDIM(input) == 1) { + call asiinit (xmsi, II_LINEAR) + call asiinit (ymsi, II_LINEAR) + call asitype (GT_INTERPSTR(geo), GT_INTERPOLANT(geo), + GT_NSINC(geo), nincr, shift) + call asisinit (msi, GT_INTERPOLANT(geo), GT_NSINC(geo), + nincr, shift, 0.0) + if (GT_FLUXCONSERVE(geo) == YES) + call asiinit (jmsi, II_LINEAR) + } else { + call msiinit (xmsi, II_BILINEAR) + call msiinit (ymsi, II_BILINEAR) + call msitype (GT_INTERPSTR(geo), GT_INTERPOLANT(geo), + GT_NSINC(geo), nincr, shift) + call msisinit (msi, GT_INTERPOLANT(geo), GT_NSINC(geo), + nincr, nincr, shift, shift, 0.0) + if (GT_FLUXCONSERVE(geo) == YES) + call msiinit (jmsi, II_BILINEAR) + } + call geo_margset (sx1, sy1, sx2, sy2, GT_XMIN(geo), GT_XMAX(geo), + GT_NCOLS(geo), GT_YMIN(geo), GT_YMAX(geo), GT_NLINES(geo), + GT_INTERPOLANT(geo), GT_NSINC(geo), GT_NXYMARGIN(geo)) + + # Setup input image boundary extension parameters. + call geo_ref (geo, Memr[xsample], 1, GT_NCOLS(geo), GT_NCOLS(geo), + Memr[ysample], 1, GT_NLINES(geo), GT_NLINES(geo), gsgetr (sx1, + GSXMIN), gsgetr (sx1, GSXMAX), gsgetr (sx1, GSYMIN), gsgetr (sx1, + GSYMAX), GT_ONE) + call geo_imset (input, geo, sx1, sy1, sx2, sy2, Memr[xsample], + GT_NCOLS(geo), Memr[ysample], GT_NLINES(geo)) + + # Calculate the sampled reference coordinates and the interpolated + # reference coordinates. + call geo_ref (geo, Memr[xsample], 1, nxsample, nxsample, Memr[ysample], + 1, nysample, nysample, gsgetr (sx1, GSXMIN), gsgetr (sx1, GSXMAX), + gsgetr (sx1, GSYMIN), gsgetr (sx1, GSYMAX), GT_ONE) + call geo_sample (geo, Memr[xinterp], 1, GT_NCOLS(geo), nxsample, + Memr[yinterp], 1, GT_NLINES(geo), nysample, GT_ONE) + + # Initialize the buffers + xbuf = NULL + ybuf = NULL + jbuf = NULL + + # Set up interpolants + call geo_xbuffer (sx1, sx2, xmsi, Memr[xsample], Memr[ysample], 1, + nxsample, 1, nysample, xbuf) + call geo_ybuffer (sy1, sy2, ymsi, Memr[xsample], Memr[ysample], 1, + nxsample, 1, nysample, ybuf) + if (GT_FLUXCONSERVE(geo) == YES && (sx2 != NULL || sy2 != NULL)) { + if (IM_NDIM(input) == 1) + call geo_jbuffer (sx1, NULL, sx2, NULL, jmsi, Memr[xsample], + Memr[ysample], 1, nxsample, 1, nysample, jbuf) + else + call geo_jbuffer (sx1, sy1, sx2, sy2, jmsi, Memr[xsample], + Memr[ysample], 1, nxsample, 1, nysample, jbuf) + } + + # Transform the image. + call geo_msivector (input, output, geo, xmsi, ymsi, jmsi, msi, + sx1, sy1, sx2, sy2, Memr[xinterp], 1, GT_NCOLS(geo), nxsample, + Memr[yinterp], 1, GT_NLINES(geo), nysample, 1, 1) + + # Free space. + if (IM_NDIM(input) == 1) { + call asifree (xmsi) + call asifree (ymsi) + call asifree (msi) + if (GT_FLUXCONSERVE(geo) == YES) + call asifree (jmsi) + } else { + call msifree (xmsi) + call msifree (ymsi) + call msifree (msi) + if (GT_FLUXCONSERVE(geo) == YES) + call msifree (jmsi) + } + call mfree (xbuf, TY_REAL) + call mfree (ybuf, TY_REAL) + if (jbuf != NULL) + call mfree (jbuf, TY_REAL) + call sfree (sp) +end + + +## GEO_IMSIVECTOR -- Evaluate the output image using interpolated surface +## coordinates. +# +#procedure geo_imsivector (in, out, geo, xmsi, ymsi, jmsi, msi, sx1, sy1, sx2, +# sy2, xref, yref, ncols, nlines) +# +#pointer in #I pointer to input image +#pointer out #I pointer to output image +#pointer geo #I pointer to geotran structure +#pointer xmsi, ymsi #I pointer to the interpolation xy surfaces +#pointer jmsi #I pointer to Jacobian surface +#pointer msi #I pointer to interpolation surface +#pointer sx1, sy1 #I linear surface descriptors +#pointer sx2, sy2 #I distortion surface pointers +#real xref[ARB] #I x reference coordinates +#real yref[ARB] #I y reference coordinates +#int ncols, nlines #I number of columns and rows +# +#int j +#pointer sp, x, y, xin, yin, xout, yout, inbuf, outbuf +#real factor +#pointer imgs1r(), imgs2r(), imps1r(), imps2r() +#real geo_jfactor() +# +#begin +# # Allocate working space. +# call smark (sp) +# call salloc (x, ncols, TY_REAL) +# call salloc (y, ncols, TY_REAL) +# call salloc (xin, ncols, TY_REAL) +# call salloc (yin, ncols, TY_REAL) +# call salloc (xout, ncols, TY_REAL) +# call salloc (yout, ncols, TY_REAL) +# +# # Fit the interpolant +# if (IM_NDIM(in) == 1) +# inbuf = imgs1r (in, 1, int (IM_LEN(in,1))) +# else +# inbuf = imgs2r (in, 1, int (IM_LEN(in,1)), 1, int (IM_LEN(in,2))) +# if (inbuf == EOF) +# call error (0, "Error reading image") +# if (IM_NDIM(in) == 1) +# call asifit (msi, Memr[inbuf], int (IM_LEN(in,1))) +# else +# call msifit (msi, Memr[inbuf], int (IM_LEN(in,1)), +# int (IM_LEN(in,2)), int (IM_LEN(in,1))) +# +# # Compute the output bufferr. +# do j = 1, nlines { +# +# # Compute coordinates. +# call amovkr (yref[j], Memr[y], ncols) +# if (IM_NDIM(in) == 1) { +# call asivector (xmsi, xref, Memr[xin], ncols) +# call asivector (ymsi, xref, Memr[yin], ncols) +# } else { +# call msivector (xmsi, xref, Memr[y], Memr[xin], ncols) +# call msivector (ymsi, xref, Memr[y], Memr[yin], ncols) +# } +# +# # Correct for out-of-bounds pixels. +# call geo_btran (in, geo, Memr[xin], Memr[yin], Memr[xout], +# Memr[yout], ncols) +# +# # Write to output image. +# if (IM_NDIM(in) == 1) +# outbuf = imps1r (out, 1, ncols) +# else +# outbuf = imps2r (out, 1, ncols, j, j) +# if (outbuf == EOF) +# call error (0, "Error writing output image") +# if (IM_NDIM(in) == 1) +# call asivector (msi, Memr[xout], Memr[outbuf], ncols) +# else +# call msivector (msi, Memr[xout], Memr[yout], Memr[outbuf], +# ncols) +# +# # Perform constant boundary extension. +# if (GT_BOUNDARY(geo) == BT_CONSTANT) +# call geo_bconstant (in, geo, Memr[xin], Memr[yin], +# Memr[outbuf], Memr[outbuf], ncols) +# +# # Preserve flux in image. +# if (GT_FLUXCONSERVE(geo) == YES) { +# factor = GT_XSCALE(geo) * GT_YSCALE(geo) +# if (GT_GEOMODE(geo) == GT_LINEAR || (sx2 == NULL && sy2 == +# NULL)) { +# if (IM_NDIM(in) == 1) +# call amulkr (Memr[outbuf], factor * geo_jfactor (sx1, +# NULL), Memr[outbuf], ncols) +# else +# call amulkr (Memr[outbuf], factor * geo_jfactor (sx1, +# sy1), Memr[outbuf], ncols) +# } else { +# if (IM_NDIM(in) == 1) +# call geo_msiflux (jmsi, xref, yref, Memr[outbuf], +# 1, ncols, 0, 1, 1) +# else +# call geo_msiflux (jmsi, xref, yref, Memr[outbuf], +# 1, ncols, j, 1, 1) +# call amulkr (Memr[outbuf], factor, Memr[outbuf], ncols) +# } +# } +# } +# +# call sfree (sp) +#end + + +## GEO_IGSVECTOR -- Evaluate the output image using fitted coordinates. +# +#procedure geo_igsvector (input, output, geo, msi, xref, yref, ncols, nlines, +# sx1, sy1, sx2, sy2) +# +#pointer input #I pointer to input image +#pointer output #I pointer to output image +#pointer geo #I pointer to geotran structure +#pointer msi #I pointer to interpolant +#real xref[ARB] #I x reference array +#real yref[ARB] #I y reference array +#int ncols, nlines #I number of columns and lines +#pointer sx1, sy1 #I pointer to linear surface +#pointer sx2, sy2 #I pointer to distortion surface +# +#int j +#pointer sp, y, xin, yin, xout, yout, temp, inbuf, outbuf +#real factor +#pointer imgs1r(), imgs2r(), imps1r(), imps2r() +#real geo_jfactor() +# +#begin +# # Allocate working space. +# call smark (sp) +# call salloc (y, ncols, TY_REAL) +# call salloc (xin, ncols, TY_REAL) +# call salloc (yin, ncols, TY_REAL) +# call salloc (xout, ncols, TY_REAL) +# call salloc (yout, ncols, TY_REAL) +# call salloc (temp, ncols, TY_REAL) +# +# # Fill image buffer. +# if (IM_NDIM(input) == 1) +# inbuf = imgs1r (input, 1, int (IM_LEN(input,1))) +# else +# inbuf = imgs2r (input, 1, int (IM_LEN(input,1)), 1, +# int (IM_LEN(input,2))) +# if (inbuf == EOF) +# call error (0, "Error reading image") +# +# # Fit the interpolant. +# if (IM_NDIM(input) == 1) +# call asifit (msi, Memr[inbuf], int (IM_LEN(input,1))) +# else +# call msifit (msi, Memr[inbuf], int (IM_LEN(input,1)), +# int (IM_LEN(input,2)), int (IM_LEN(input,1))) +# +# # Calculate the x and y input image coordinates. +# do j = 1, nlines { +# +# # Get output image buffer. +# if (IM_NDIM(input) == 1) +# outbuf = imps1r (output, 1, ncols) +# else +# outbuf = imps2r (output, 1, ncols, j, j) +# if (output == EOF) +# call error (0, "Error writing output image") +# +# # Fit x coords. +# call amovkr (yref[j], Memr[y], ncols) +# call gsvector (sx1, xref, Memr[y], Memr[xin], ncols) +# if (sx2 != NULL) { +# call gsvector (sx2, xref, Memr[y], Memr[temp], ncols) +# call aaddr (Memr[xin], Memr[temp], Memr[xin], ncols) +# } +# +# # Fit y coords. +# call gsvector (sy1, xref, Memr[y], Memr[yin], ncols) +# if (sy2 != NULL) { +# call gsvector (sy2, xref, Memr[y], Memr[temp], ncols) +# call aaddr (Memr[yin], Memr[temp], Memr[yin], ncols) +# } +# +# # Compute of of bounds pixels. +# call geo_btran (input, geo, Memr[xin], Memr[yin], Memr[xout], +# Memr[yout], ncols) +# +# # Interpolate in input image. +# if (IM_NDIM(input) == 1) +# call asivector (msi, Memr[xout], Memr[outbuf], ncols) +# else +# call msivector (msi, Memr[xout], Memr[yout], Memr[outbuf], +# ncols) +# +# # Correct for constant boundary extension. +# if (GT_BOUNDARY(geo) == BT_CONSTANT) +# call geo_bconstant (input, geo, Memr[xin], Memr[yin], +# Memr[outbuf], Memr[outbuf], ncols) +# +# # Preserve flux in image. +# if (GT_FLUXCONSERVE(geo) == YES) { +# factor = GT_XSCALE(geo) * GT_YSCALE(geo) +# if (GT_GEOMODE(geo) == GT_LINEAR || (sx2 == NULL && sy2 == +# NULL)) { +# if (IM_NDIM(input) == 1) +# call amulkr (Memr[outbuf], factor * geo_jfactor (sx1, +# NULL), Memr[outbuf], ncols) +# else +# call amulkr (Memr[outbuf], factor * geo_jfactor (sx1, +# sy1), Memr[outbuf], ncols) +# } else { +# if (IM_NDIM(input) == 1) +# call geo_gsflux (xref, yref, Memr[outbuf], 1, ncols, j, +# sx1, NULL, sx2, NULL) +# else +# call geo_gsflux (xref, yref, Memr[outbuf], 1, ncols, j, +# sx1, sy1, sx2, sy2) +# call amulkr (Memr[outbuf], factor, Memr[outbuf], ncols) +# } +# } +# } +# +# call sfree (sp) +#end + + +## GEO_BTRAN -- Map out-of-bounds pixel into the input image. +# +#procedure geo_btran (input, geo, xin, yin, xout, yout, ncols) +# +#pointer input #I pointer to the input image +#pointer geo #I pointer to geotran strcuture +#real xin[ARB] #I x input coords +#real yin[ARB] #I y input coords +#real xout[ARB] #O x output coords +#real yout[ARB] #O y output coords +#int ncols #I number of columns +# +#int i +#real xmax, ymax, xtemp, ytemp +# +#begin +# xmax = IM_LEN(input,1) +# if (IM_NDIM(input) == 1) +# ymax = 1.0 +# else +# ymax = IM_LEN(input,2) +# +# switch (GT_BOUNDARY(geo)) { +# case BT_CONSTANT, BT_NEAREST: +# do i = 1, ncols { +# if (xin[i] < 1.0) +# xout[i] = 1.0 +# else if (xin[i] > xmax) +# xout[i] = xmax +# else +# xout[i] = xin[i] +# if (yin[i] < 1.0) +# yout[i] = 1.0 +# else if (yin[i] > ymax) +# yout[i] = ymax +# else +# yout[i] = yin[i] +# } +# case BT_REFLECT: +# do i = 1, ncols { +# if (xin[i] < 1.0) +# xout[i] = 1.0 + (1.0 - xin[i]) +# else if (xin[i] > xmax) +# xout[i] = xmax - (xin[i] - xmax) +# else +# xout[i] = xin[i] +# if (yin[i] < 1.0) +# yout[i] = 1.0 + (1.0 - yin[i]) +# else if (yin[i] > ymax) +# yout[i] = ymax - (yin[i] - ymax) +# else +# yout[i] = yin[i] +# } +# case BT_WRAP: +# do i = 1, ncols { +# xtemp = xin[i] +# ytemp = yin[i] +# +# if (xtemp < 1.0) { +# while (xtemp < 1.0) +# xtemp = xtemp + xmax +# if (xtemp < 1.0) +# xtemp = xmax - xtemp +# else if (xtemp > xmax) +# xtemp = 2.0 + xmax - xtemp +# } else if (xtemp > xmax) { +# while (xtemp > xmax) +# xtemp = xtemp - xmax +# if (xtemp < 1.0) +# xtemp = xmax - xtemp +# else if (xtemp > xmax) +# xtemp = 2.0 + xmax - xtemp +# } +# xout[i] = xtemp +# +# if (ytemp < 1.0) { +# while (ytemp < 1.0) +# ytemp = ytemp + ymax +# if (ytemp < 1.0) +# ytemp = ymax - ytemp +# else if (ytemp > ymax) +# ytemp = 2.0 + ymax - ytemp +# } else if (ytemp > ymax) { +# while (ytemp > ymax) +# ytemp = ytemp - ymax +# if (ytemp < 1.0) +# ytemp = ymax - ytemp +# else if (ytemp > ymax) +# ytemp = 2.0 + ymax - ytemp +# } +# yout[i] = ytemp +# } +# } +#end + + +## GEO_BCONSTANT -- Map constant out-of-bounds pixels into the input image. +# +#procedure geo_bconstant (input, geo, xin, yin, inbuf, outbuf, ncols) +# +#pointer input #I pointer to the input image +#pointer geo #I pointer to geotran structure +#real xin[ARB] #I x input coords +#real yin[ARB] #I y input coords +#real inbuf[ARB] #I input buffer +#real outbuf[ARB] #O output buffer +#int ncols #I number of columns +# +#int i +#real xmax, ymax, constant +# +#begin +# xmax = IM_LEN(input,1) +# if (IM_NDIM(input) == 1) +# ymax = 1.0 +# else +# ymax = IM_LEN(input,2) +# constant = GT_CONSTANT(geo) +# do i = 1, ncols { +# if (xin[i] < 1.0 || xin[i] > xmax || yin[i] < 1.0 || yin[i] > ymax) +# outbuf[i] = constant +# else +# outbuf[i] = inbuf[i] +# } +#end diff --git a/pkg/images/immatch/src/geometry/geotran.h b/pkg/images/immatch/src/geometry/geotran.h new file mode 100644 index 00000000..d2fa6b55 --- /dev/null +++ b/pkg/images/immatch/src/geometry/geotran.h @@ -0,0 +1,52 @@ +# GEOTRAN Structure + +define LEN_GEOSTRUCT (30 + SZ_FNAME) + +# output picture formatting parameters + +define GT_NCOLS Memi[$1] # number of output columns +define GT_NLINES Memi[$1+1] # number of output lines +define GT_XMIN Memr[P2R($1+2)] # x minimum +define GT_XMAX Memr[P2R($1+3)] # x maximum +define GT_YMIN Memr[P2R($1+4)] # y minimun +define GT_YMAX Memr[P2R($1+5)] # y maximum +define GT_XSCALE Memr[P2R($1+6)] # x scale +define GT_YSCALE Memr[P2R($1+7)] # y scale + +# transformation parameters + +define GT_GEOMODE Memi[$1+8] # Type of transformation +define GT_XIN Memr[P2R($1+9)] # x input pixel +define GT_YIN Memr[P2R($1+10)] # y input pixel +define GT_XOUT Memr[P2R($1+11)] # x output pixel +define GT_YOUT Memr[P2R($1+12)] # y output pixel +define GT_XSHIFT Memr[P2R($1+13)] # x shift +define GT_YSHIFT Memr[P2R($1+14)] # y shift +define GT_XMAG Memr[P2R($1+15)] # input image x scale +define GT_YMAG Memr[P2R($1+16)] # input image y scale +define GT_XROTATION Memr[P2R($1+17)] # rotation angle +define GT_YROTATION Memr[P2R($1+18)] # scale angle + +# interpolation parameters +define GT_XSAMPLE Memr[P2R($1+19)] # x surface subsampling +define GT_YSAMPLE Memr[P2R($1+20)] # y surface subsampling +define GT_INTERPOLANT Memi[$1+21] # image interpolant +define GT_NSINC Memi[$1+22] # sinc width half-width +define GT_NXYMARGIN Memi[$1+23] # the interpolation margin +define GT_BOUNDARY Memi[$1+24] # boundary extension +define GT_CONSTANT Memr[P2R($1+25)] # constant boundary extension +define GT_FLUXCONSERVE Memi[$1+26] # conserve total flux +define GT_INTERPSTR Memc[P2C($1+27)] # interpolation string + +# GEOTRAN MODES + +define GT_NONE 1 # parameters defined by user +define GT_LINEAR 2 # use linear transformation +define GT_DISTORT 3 # distortion transformation only +define GT_GEOMETRIC 4 # use full transformation + +# GEOTRAN COORDINATE MODES + +define GT_ONE 1 +define GT_TWO 2 +define GT_FOUR 3 diff --git a/pkg/images/immatch/src/geometry/geotran.x b/pkg/images/immatch/src/geometry/geotran.x new file mode 100644 index 00000000..ee689d26 --- /dev/null +++ b/pkg/images/immatch/src/geometry/geotran.x @@ -0,0 +1,1752 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> +include <imset.h> +include <mach.h> +include <math/gsurfit.h> +include <math/iminterp.h> +include "geotran.h" + +define NMARGIN 3 # number of boundary pixels +define NMARGIN_SPLINE3 16 # number of spline boundary pixels + +# GEO_TRAN -- Correct an image for geometric distortion block by block using +# fitted coordinates and image interpolation. + +procedure geo_tran (input, output, geo, sx1, sy1, sx2, sy2, nxblock, nyblock) + +pointer input #I pointer to input image +pointer output #I pointer to output image +pointer geo #I pointer to geotran structure +pointer sx1, sy1 #I pointers to linear surfaces +pointer sx2, sy2 #I pointers to higher order surfaces +int nxblock, nyblock #I working block size + +int l1, l2, c1, c2, nincr +pointer sp, xref, yref, msi +real shift +real gsgetr() + +begin + # Initialize the interpolant. + if (IM_NDIM(input) == 1) { + call asitype (GT_INTERPSTR(geo), GT_INTERPOLANT(geo), GT_NSINC(geo), + nincr, shift) + call asisinit (msi, GT_INTERPOLANT(geo), GT_NSINC(geo), nincr, + shift, 0.0) + } else { + call msitype (GT_INTERPSTR(geo), GT_INTERPOLANT(geo), + GT_NSINC(geo), nincr, shift) + call msisinit (msi, GT_INTERPOLANT(geo), GT_NSINC(geo), nincr, + nincr, shift, shift, 0.0) + } + call geo_margset (sx1, sy1, sx2, sy2, GT_XMIN(geo), GT_XMAX(geo), + GT_NCOLS(geo), GT_YMIN(geo), GT_YMAX(geo), GT_NLINES(geo), + GT_INTERPOLANT(geo), GT_NSINC(geo), GT_NXYMARGIN(geo)) + + # Allocate working space. + call smark (sp) + call salloc (xref, GT_NCOLS(geo), TY_REAL) + call salloc (yref, GT_NLINES(geo), TY_REAL) + + # Compute the reference coordinates corresponding to the center of + # the output image pixels. + call geo_ref (geo, Memr[xref], 1, GT_NCOLS(geo), GT_NCOLS(geo), + Memr[yref], 1, GT_NLINES(geo), GT_NLINES(geo), gsgetr (sx1, + GSXMIN), gsgetr (sx1, GSXMAX), gsgetr (sx1, GSYMIN), gsgetr (sx1, + GSYMAX), GT_ONE) + + # Configure the out-of-bounds pixel references for the input image. + call geo_imset (input, geo, sx1, sy1, sx2, sy2, Memr[xref], + GT_NCOLS(geo), Memr[yref], GT_NLINES(geo)) + + # Loop over the line blocks. + for (l1 = 1; l1 <= GT_NLINES(geo); l1 = l1 + nyblock) { + + # Set line limits in the output image. + l2 = min (l1 + nyblock - 1, GT_NLINES(geo)) + + # Loop over the column blocks + for (c1 = 1; c1 <= GT_NCOLS(geo); c1 = c1 + nxblock) { + + # Set column limits in the output image. + c2 = min (c1 + nxblock - 1, GT_NCOLS(geo)) + + # Interpolate + call geo_gsvector (input, output, geo, msi, Memr[xref], + c1, c2, Memr[yref], l1, l2, sx1, sy1, sx2, sy2) + } + } + + # Clean up. + if (IM_NDIM(input) == 1) + call asifree (msi) + else + call msifree (msi) + call sfree (sp) +end + + +# GEO_STRAN -- Correct an image for geometric distortion block by block using +# interpolated coordinates and image interpolation. + +procedure geo_stran (input, output, geo, sx1, sy1, sx2, sy2, nxblock, nyblock) + +pointer input #I pointer to input image +pointer output #I pointer to output image +pointer geo #I pointer to geotran structure +pointer sx1, sy1 #I pointers to linear surfaces +pointer sx2, sy2 #I pointers to higher order surfaces +int nxblock, nyblock #I working block size + +int nxsample, nysample, ncols, nlines, l1, l2, c1, c2 +int line1, line2, llast1, llast2, nincr +pointer sp, xsample, ysample, xinterp, yinterp +pointer xmsi, ymsi, jmsi, msi, xbuf, ybuf, jbuf +real shift +real gsgetr() + +begin + # Allocate working space and intialize the interpolant. + call smark (sp) + call salloc (xsample, GT_NCOLS(geo), TY_REAL) + call salloc (ysample, GT_NLINES(geo), TY_REAL) + call salloc (xinterp, GT_NCOLS(geo), TY_REAL) + call salloc (yinterp, GT_NLINES(geo), TY_REAL) + + # Compute the sample size. + if (GT_NCOLS(geo) == 1) + nxsample = 1 + else + nxsample = GT_NCOLS(geo) / GT_XSAMPLE(geo) + if (GT_NLINES(geo) == 1) + nysample = 1 + else + nysample = GT_NLINES(geo) / GT_YSAMPLE(geo) + + # Initialize interpolants. + if (IM_NDIM(input) == 1) { + call asiinit (xmsi, II_LINEAR) + call asiinit (ymsi, II_LINEAR) + call asitype (GT_INTERPSTR(geo), GT_INTERPOLANT(geo), + GT_NSINC(geo), nincr, shift) + call asisinit (msi, GT_INTERPOLANT(geo), GT_NSINC(geo), nincr, + shift, 0.0) + if (GT_FLUXCONSERVE(geo) == YES) + call asiinit (jmsi, II_LINEAR) + } else { + call msiinit (xmsi, II_BILINEAR) + call msiinit (ymsi, II_BILINEAR) + call msitype (GT_INTERPSTR(geo), GT_INTERPOLANT(geo), + GT_NSINC(geo), nincr, shift) + call msisinit (msi, GT_INTERPOLANT(geo), GT_NSINC(geo), nincr, + nincr, shift, shift, 0.0) + if (GT_FLUXCONSERVE(geo) == YES) + call msiinit (jmsi, II_BILINEAR) + } + call geo_margset (sx1, sy1, sx2, sy2, GT_XMIN(geo), GT_XMAX(geo), + GT_NCOLS(geo), GT_YMIN(geo), GT_YMAX(geo), GT_NLINES(geo), + GT_INTERPOLANT(geo), GT_NSINC(geo), GT_NXYMARGIN(geo)) + + # Setup input image boundary extension parameters. + call geo_ref (geo, Memr[xsample], 1, GT_NCOLS(geo), GT_NCOLS(geo), + Memr[ysample], 1, GT_NLINES(geo), GT_NLINES(geo), gsgetr (sx1, + GSXMIN), gsgetr (sx1, GSXMAX), gsgetr (sx1, GSYMIN), gsgetr (sx1, + GSYMAX), GT_ONE) + call geo_imset (input, geo, sx1, sy1, sx2, sy2, Memr[xsample], + GT_NCOLS(geo), Memr[ysample], GT_NLINES(geo)) + + # Calculate the sampled reference coordinates and the interpolated + # reference coordinates. + call geo_ref (geo, Memr[xsample], 1, nxsample, nxsample, Memr[ysample], + 1, nysample, nysample, gsgetr (sx1, GSXMIN), gsgetr (sx1, GSXMAX), + gsgetr (sx1, GSYMIN), gsgetr (sx1, GSYMAX), GT_ONE) + call geo_sample (geo, Memr[xinterp], 1, GT_NCOLS(geo), nxsample, + Memr[yinterp], 1, GT_NLINES(geo), nysample, GT_ONE) + + # Initialize the buffers. + xbuf = NULL + ybuf = NULL + jbuf = NULL + + # Loop over the line blocks. + for (l1 = 1; l1 <= GT_NLINES(geo); l1 = l1 + nyblock) { + + # Set line limits in the output image. + l2 = min (l1 + nyblock - 1, GT_NLINES(geo)) + nlines = l2 - l1 + 1 + + # Line1 and line2 are the coordinates in the interpolation surface + line1 = max (1, min (nysample - 1, int (Memr[yinterp+l1-1]))) + line2 = min (nysample, int (Memr[yinterp+l2-1] + 1.0)) + + if ((xbuf == NULL) || (ybuf == NULL) || (jbuf == NULL) || + (line1 < llast1) || (line2 > llast2)) { + call geo_xbuffer (sx1, sx2, xmsi, Memr[xsample], Memr[ysample], + 1, nxsample, line1, line2, xbuf) + call geo_ybuffer (sy1, sy2, ymsi, Memr[xsample], Memr[ysample], + 1, nxsample, line1, line2, ybuf) + if (GT_FLUXCONSERVE(geo) == YES) { + if (IM_NDIM(input) == 1) + call geo_jbuffer (sx1, NULL, sx2, NULL, jmsi, + Memr[xsample], Memr[ysample], 1, nxsample, + line1, line2, jbuf) + else + call geo_jbuffer (sx1, sy1, sx2, sy2, jmsi, + Memr[xsample], Memr[ysample], 1, nxsample, + line1, line2, jbuf) + } + llast1 = line1 + llast2 = line2 + } + + + # Loop over the column blocks. + for (c1 = 1; c1 <= GT_NCOLS(geo); c1 = c1 + nxblock) { + + # C1 and c2 are the column limits in the output image. + c2 = min (c1 + nxblock - 1, GT_NCOLS(geo)) + ncols = c2 - c1 + 1 + + # Calculate the coordinates of the output pixels in the input + # image. + call geo_msivector (input, output, geo, xmsi, ymsi, jmsi, msi, + sx1, sy1, sx2, sy2, Memr[xinterp], c1, c2, nxsample, + Memr[yinterp], l1, l2, nysample, 1, line1) + } + } + + # Free space. + if (IM_NDIM(input) == 1) { + call asifree (xmsi) + call asifree (ymsi) + call asifree (msi) + if (GT_FLUXCONSERVE(geo) == YES) + call asifree (jmsi) + } else { + call msifree (xmsi) + call msifree (ymsi) + call msifree (msi) + if (GT_FLUXCONSERVE(geo) == YES) + call msifree (jmsi) + } + call mfree (xbuf, TY_REAL) + call mfree (ybuf, TY_REAL) + if (GT_FLUXCONSERVE(geo) == YES) + call mfree (jbuf, TY_REAL) + call sfree (sp) +end + + +# GEO_REF -- Determine the x and y coordinates at which the coordinate +# surface will be subsampled. + +procedure geo_ref (geo, x, c1, c2, nx, y, l1, l2, ny, xmin, xmax, ymin, ymax, + cmode) + +pointer geo #I pointer to the geotran structure +real x[ARB] #O output x sample coordinates +int c1, c2, nx #I the column limits of the sampled array +real y[ARB] #O output y sample coordinates +int l1, l2, ny #I the line limits of the output coordinates +real xmin, xmax #I limits on x coordinates +real ymin, ymax #I limits on y coordinates +int cmode #I coordinate computation mode + +int i +real xtempmin, xtempmax, ytempmin, ytempmax, dx, dy + +begin + + switch (cmode) { + case GT_FOUR: + if (nx == 1) { + xtempmin = min (xmax, max (xmin, GT_XMIN(geo))) + xtempmax = min (xmax, max (xmin, GT_XMAX(geo))) + x[1] = xtempmin + x[2] = xtempmax + x[3] = xtempmax + x[4] = xtempmin + } else if (nx == GT_NCOLS(geo)) { + if (GT_XMIN(geo) > GT_XMAX(geo)) + dx = -GT_XSCALE(geo) + else + dx = GT_XSCALE(geo) + do i = c1, c2 { + xtempmin = min (xmax, max (xmin, GT_XMIN(geo) + + (i - 1.5) * dx)) + xtempmax = min (xmax, max (xmin, GT_XMIN(geo) + + (i - 0.5) * dx)) + x[4*(i-c1)+1] = xtempmin + x[4*(i-c1)+2] = xtempmax + x[4*(i-c1)+3] = xtempmax + x[4*(i-c1)+4] = xtempmin + } + } else { + if (GT_XMIN(geo) > GT_XMAX(geo)) + dx = -GT_XSCALE(geo) * (GT_NCOLS(geo) - 1.0) / (nx - 1.0) + else + dx = GT_XSCALE(geo) * (GT_NCOLS(geo) - 1.0) / (nx - 1.0) + do i = c1, c2 { + xtempmin = min (xmax, max (xmin, GT_XMIN(geo) + + (i - 1.5) * dx)) + xtempmax = min (xmax, max (xmin, GT_XMIN(geo) + + (i - 0.5) * dx)) + x[4*(i-c1)+1] = xtempmin + x[4*(i-c1)+2] = xtempmax + x[4*(i-c1)+3] = xtempmax + x[4*(i-c1)+4] = xtempmin + } + } + + case GT_TWO: + if (nx == 1) { + xtempmin = min (xmax, max (xmin, GT_XMIN(geo))) + xtempmax = min (xmax, max (xmin, GT_XMAX(geo))) + x[1] = xtempmin + x[2] = xtempmax + } else if (nx == GT_NCOLS(geo)) { + if (GT_XMIN(geo) > GT_XMAX(geo)) + dx = -GT_XSCALE(geo) + else + dx = GT_XSCALE(geo) + do i = c1, c2 { + xtempmin = min (xmax, max (xmin, GT_XMIN(geo) + + (i - 1.5) * dx)) + xtempmax = min (xmax, max (xmin, GT_XMIN(geo) + + (i - 0.5) * dx)) + x[2*(i-c1)+1] = xtempmin + x[2*(i-c1)+2] = xtempmax + } + } else { + if (GT_XMIN(geo) > GT_XMAX(geo)) + dx = -GT_XSCALE(geo) * (GT_NCOLS(geo) - 1.0) / (nx - 1.0) + else + dx = GT_XSCALE(geo) * (GT_NCOLS(geo) - 1.0) / (nx - 1.0) + do i = c1, c2 { + xtempmin = min (xmax, max (xmin, GT_XMIN(geo) + + (i - 1.5) * dx)) + xtempmax = min (xmax, max (xmin, GT_XMIN(geo) + + (i - 0.5) * dx)) + x[2*(i-c1)+1] = xtempmin + x[2*(i-c1)+2] = xtempmax + } + } + + case GT_ONE: + if (nx == 1) { + x[1] = min (xmax, max (xmin, + (GT_XMIN(geo) + GT_XMAX(geo)) / 2.0)) + } else if (nx == GT_NCOLS(geo)) { + if (GT_XMIN(geo) > GT_XMAX(geo)) + dx = -GT_XSCALE(geo) + else + dx = GT_XSCALE(geo) + do i = c1, c2 + x[i-c1+1] = min (xmax, max (xmin, GT_XMIN(geo) + + (i - 1) * dx)) + } else { + if (GT_XMIN(geo) > GT_XMAX(geo)) + dx = -GT_XSCALE(geo) * (GT_NCOLS(geo) - 1.0) / (nx - 1.0) + else + dx = GT_XSCALE(geo) * (GT_NCOLS(geo) - 1.0) / (nx - 1.0) + do i = c1, c2 + x[i-c1+1] = min (xmax, max (xmin, GT_XMIN(geo) + + (i - 1) * dx)) + } + + } + + switch (cmode) { + case GT_FOUR: + if (ny == 1) { + ytempmin = min (ymax, max (ymin, GT_YMIN(geo))) + ytempmax = min (ymax, max (ymin, GT_YMAX(geo))) + y[1] = ytempmin + y[2] = ytempmin + y[3] = ytempmax + y[4] = ytempmax + } else if (ny == GT_NLINES(geo)) { + if (GT_YMIN(geo) > GT_YMAX(geo)) + dy = -GT_YSCALE(geo) + else + dy = GT_YSCALE(geo) + do i = l1, l2 { + ytempmin = min (ymax, max (ymin, GT_YMIN(geo) + + (i - 1.5) * dy)) + ytempmax = min (ymax, max (ymin, GT_YMIN(geo) + + (i - 0.5) * dy)) + y[4*(i-l1)+1] = ytempmin + y[4*(i-l1)+2] = ytempmin + y[4*(i-l1)+3] = ytempmax + y[4*(i-l1)+4] = ytempmax + } + } else { + if (GT_YMIN(geo) > GT_YMAX(geo)) + dy = -GT_YSCALE(geo) * (GT_NLINES(geo) - 1.0) / (ny - 1.0) + else + dy = GT_YSCALE(geo) * (GT_NLINES(geo) - 1.0) / (ny - 1.0) + do i = l1, l2 { + ytempmin = min (ymax, max (ymin, GT_YMIN(geo) + + (i - 1.5) * dy)) + ytempmax = min (ymax, max (ymin, GT_YMIN(geo) + + (i - 0.5) * dy)) + y[4*(i-l1)+1] = ytempmin + y[4*(i-l1)+2] = ytempmin + y[4*(i-l1)+3] = ytempmax + y[4*(i-l1)+4] = ytempmax + } + } + + case GT_TWO: + if (ny == 1) { + ytempmin = min (ymax, max (ymin, GT_YMIN(geo))) + ytempmax = min (ymax, max (ymin, GT_YMAX(geo))) + y[1] = ytempmin + y[2] = ytempmax + } else if (ny == GT_NLINES(geo)) { + if (GT_YMIN(geo) > GT_YMAX(geo)) + dy = -GT_YSCALE(geo) + else + dy = GT_YSCALE(geo) + do i = l1, l2 { + ytempmin = min (ymax, max (ymin, GT_YMIN(geo) + + (i - 1.5) * dy)) + ytempmax = min (ymax, max (ymin, GT_YMIN(geo) + + (i - 0.5) * dy)) + y[2*(i-l1)+1] = ytempmin + y[2*(i-l1)+2] = ytempmax + } + } else { + if (GT_YMIN(geo) > GT_YMAX(geo)) + dy = -GT_YSCALE(geo) * (GT_NLINES(geo) - 1.0) / (ny - 1.0) + else + dy = GT_YSCALE(geo) * (GT_NLINES(geo) - 1.0) / (ny - 1.0) + do i = l1, l2 { + ytempmin = min (ymax, max (ymin, GT_YMIN(geo) + + (i - 1.5) * dy)) + ytempmax = min (ymax, max (ymin, GT_YMIN(geo) + + (i - 0.5) * dy)) + y[2*(i-l1)+1] = ytempmin + y[2*(i-l1)+2] = ytempmax + } + } + case GT_ONE: + if (ny == 1) { + y[1] = min (ymax, max (ymin, + (GT_YMIN(geo) + GT_YMAX(geo)) / 2.0)) + } else if (ny == GT_NLINES(geo)) { + if (GT_YMIN(geo) > GT_YMAX(geo)) + dy = -GT_YSCALE(geo) + else + dy = GT_YSCALE(geo) + do i = l1, l2 + y[i-l1+1] = min (ymax, max (ymin, GT_YMIN(geo) + + (i - 1) * dy)) + } else { + if (GT_YMIN(geo) > GT_YMAX(geo)) + dy = -GT_YSCALE(geo) * (GT_NLINES(geo) - 1.0) / (ny - 1.0) + else + dy = GT_YSCALE(geo) * (GT_NLINES(geo) - 1.0) / (ny - 1.0) + do i = l1, l2 + y[i-l1+1] = min (ymax, max (ymin, GT_YMIN(geo) + + (i - 1) * dy)) + } + + } +end + + +# GEO_SAMPLE -- Calculate the sampled reference points. + +procedure geo_sample (geo, xref, c1, c2, nxsample, yref, l1, l2, nysample, + cmode) + +pointer geo #I pointer to geotran structure +real xref[ARB] #O x reference values +int c1, c2, nxsample #I limits and number of sample points in x +real yref[ARB] #O y reference values +int l1, l2, nysample #I limits and number of sample points in y +int cmode #I coordinate computation mode + +int i +real xtempmin, xtempmax, ytempmin, ytempmax + +begin + switch (cmode) { + case GT_FOUR: + if (GT_NCOLS(geo) == 1) { + xref[1] = 0.5 + xref[2] = 1.5 + xref[3] = 1.5 + xref[4] = 0.5 + } else { + do i = c1, c2 { + xtempmin = min (real (nxsample), max (1., + real ((nxsample - 1) * (i - 0.5) + (GT_NCOLS(geo) - + nxsample)) / (GT_NCOLS(geo) - 1))) + xtempmax = min (real (nxsample), max (1., + real ((nxsample - 1) * (i + 0.5) + (GT_NCOLS(geo) - + nxsample)) / (GT_NCOLS(geo) - 1))) + xref[4*(i-c1)+1] = xtempmin + xref[4*(i-c1)+2] = xtempmax + xref[4*(i-c1)+3] = xtempmax + xref[4*(i-c1)+4] = xtempmin + } + + } + case GT_TWO: + if (GT_NCOLS(geo) == 1) { + xref[1] = 0.5 + xref[2] = 1.5 + } else { + do i = c1, c2 { + xtempmin = min (real (nxsample), max (1., + real ((nxsample - 1) * (i - 0.5) + (GT_NCOLS(geo) - + nxsample)) / (GT_NCOLS(geo) - 1))) + xtempmax = min (real (nxsample), max (1., + real ((nxsample - 1) * (i + 0.5) + (GT_NCOLS(geo) - + nxsample)) / (GT_NCOLS(geo) - 1))) + xref[2*(i-c1)+1] = xtempmin + xref[2*(i-c1)+2] = xtempmax + } + } + case GT_ONE: + if (GT_NCOLS(geo) == 1) + xref[1] = 1.0 + else { + do i = c1, c2 + xref[i-c1+1] = min (real (nxsample), max (1., + real ((nxsample - 1) * i + (GT_NCOLS(geo) - + nxsample)) / (GT_NCOLS(geo) - 1))) + } + } + + switch (cmode) { + case GT_FOUR: + if (GT_NLINES(geo) == 1) { + yref[1] = 0.5 + yref[2] = 0.5 + yref[3] = 1.5 + yref[4] = 1.5 + } else { + do i = l1, l2 { + ytempmin = min (real (nysample), max (1., + real ((nysample - 1) * (i - 0.5) + (GT_NLINES(geo) - + nysample)) / (GT_NLINES(geo) - 1))) + ytempmax = min (real (nysample), max (1., + real ((nysample - 1) * (i + 0.5) + (GT_NLINES(geo) - + nysample)) / (GT_NLINES(geo) - 1))) + yref[4*(i-l1)+1] = ytempmin + yref[4*(i-l1)+2] = ytempmin + yref[4*(i-l1)+3] = ytempmax + yref[4*(i-l1)+4] = ytempmax + } + } + case GT_TWO: + if (GT_NLINES(geo) == 1) { + yref[1] = 0.5 + yref[2] = 1.5 + } else { + do i = l1, l2 { + ytempmin = min (real (nysample), max (1., + real ((nysample - 1) * (i - 0.5) + (GT_NLINES(geo) - + nysample)) / (GT_NLINES(geo) - 1))) + ytempmax = min (real (nysample), max (1., + real ((nysample - 1) * (i + 0.5) + (GT_NLINES(geo) - + nysample)) / (GT_NLINES(geo) - 1))) + yref[2*(i-l1)+1] = ytempmin + yref[2*(i-l1)+2] = ytempmax + } + } + case GT_ONE: + if (GT_NLINES(geo) == 1) + yref[1] = 1.0 + else { + do i = l1, l2 + yref[i-l1+1] = min (real (nysample), max (1., + real ((nysample - 1) * i + (GT_NLINES(geo) - + nysample)) / (GT_NLINES(geo) - 1))) + } + } +end + + +# GEO_XBUFFER -- Compute the x interpolant and coordinates. + +procedure geo_xbuffer (s1, s2, msi, xsample, ysample, c1, c2, l1, l2, buf) + +pointer s1, s2 #I pointers to the x surface +pointer msi #I interpolant +real xsample[ARB] #I sampled x reference coordinates +real ysample[ARB] #I sampled y reference coordinates +int c1, c2 #I columns of interest in sampled image +int l1, l2 #I lines of interest in the sampled image +pointer buf #I pointer to output buffer + +int i, ncols, nlines, llast1, llast2, nclast, nllast +pointer sp, sf, y, z, buf1, buf2 + +begin + ncols = c2 - c1 + 1 + nlines = l2 - l1 + 1 + + # Combine surfaces. + if (s2 == NULL) + call gscopy (s1, sf) + else + call gsadd (s1, s2, sf) + + # Allocate working space. + call smark (sp) + call salloc (y, ncols, TY_REAL) + call salloc (z, ncols, TY_REAL) + + # If buffer undefined then allocate memory for the buffer. Reallocate + # the buffer if the number of lines or columns changes. + if (buf == NULL) { + call malloc (buf, ncols * nlines, TY_REAL) + llast1 = l1 - nlines + llast2 = l2 - nlines + } else if ((nlines != nllast) || (ncols != nclast)) { + call realloc (buf, ncols * nlines, TY_REAL) + llast1 = l1 - nlines + llast2 = l2 - nlines + } + + # Compute the coordinates. + if (l1 < llast1) { + do i = l2, l1, -1 { + if (i > llast1) + buf1 = buf + (i - llast1) * ncols + else { + buf1 = z + call amovkr (ysample[i], Memr[y], ncols) + call gsvector (sf, xsample[c1], Memr[y], Memr[buf1], ncols) + } + buf2 = buf + (i - l1) * ncols + call amovr (Memr[buf1], Memr[buf2], ncols) + } + } else if (l2 > llast2) { + do i = l1, l2 { + if (i < llast2) + buf1 = buf + (i - llast1) * ncols + else { + buf1 = z + call amovkr (ysample[i], Memr[y], ncols) + call gsvector (sf, xsample[c1], Memr[y], Memr[buf1], ncols) + } + buf2 = buf + (i - l1) * ncols + call amovr (Memr[buf1], Memr[buf2], ncols) + } + } + + llast1 = l1 + llast2 = l2 + nclast = ncols + nllast = nlines + + # Fit the interpolant. + if (nlines == 1) + call asifit (msi, Memr[buf], ncols) + else + call msifit (msi, Memr[buf], ncols, nlines, ncols) + + call gsfree (sf) + call sfree (sp) +end + + +# GEO_YBUFFER -- Compute the y interpolant and coordinates. + +procedure geo_ybuffer (s1, s2, msi, xsample, ysample, c1, c2, l1, l2, buf) + +pointer s1, s2 #I pointers to the y surface +pointer msi #I interpolant +real xsample[ARB] #I sampled x reference coordinates +real ysample[ARB] #I sampled y reference coordinates +int c1, c2 #I columns of interest in sampled image +int l1, l2 #I lines of interest in the sampled image +pointer buf #I pointer to output buffer + +int i, ncols, nlines, llast1, llast2, nclast, nllast +pointer sp, sf, y, z, buf1, buf2 + +begin + ncols = c2 - c1 + 1 + nlines = l2 - l1 + 1 + + # Combine surfaces. + if (s2 == NULL) + call gscopy (s1, sf) + else + call gsadd (s1, s2, sf) + + # Allocate working space. + call smark (sp) + call salloc (y, ncols, TY_REAL) + call salloc (z, ncols, TY_REAL) + + # If buffer undefined then allocate memory for the buffer. Reallocate + # the buffer if the number of lines or columns changes. + if (buf == NULL) { + call malloc (buf, ncols * nlines, TY_REAL) + llast1 = l1 - nlines + llast2 = l2 - nlines + } else if ((nlines != nllast) || (ncols != nclast)) { + call realloc (buf, ncols * nlines, TY_REAL) + llast1 = l1 - nlines + llast2 = l2 - nlines + } + + # Compute the coordinates. + if (l1 < llast1) { + do i = l2, l1, -1 { + if (i > llast1) + buf1 = buf + (i - llast1) * ncols + else { + buf1 = z + call amovkr (ysample[i], Memr[y], ncols) + call gsvector (sf, xsample[c1], Memr[y], Memr[buf1], ncols) + } + buf2 = buf + (i - l1) * ncols + call amovr (Memr[buf1], Memr[buf2], ncols) + } + } else if (l2 > llast2) { + do i = l1, l2 { + if (i < llast2) + buf1 = buf + (i - llast1) * ncols + else { + buf1 = z + call amovkr (ysample[i], Memr[y], ncols) + call gsvector (sf, xsample[c1], Memr[y], Memr[buf1], ncols) + } + buf2 = buf + (i - l1) * ncols + call amovr (Memr[buf1], Memr[buf2], ncols) + } + } + + llast1 = l1 + llast2 = l2 + nclast = ncols + nllast = nlines + + # Fit the interpolant. + if (nlines == 1) + call asifit (msi, Memr[buf], ncols) + else + call msifit (msi, Memr[buf], ncols, nlines, ncols) + + call gsfree (sf) + call sfree (sp) +end + + +# GEO_JBUFFER -- Fit the jacobian surface. + +procedure geo_jbuffer (sx1, sy1, sx2, sy2, jmsi, xsample, ysample, c1, c2, l1, + l2, jbuf) + +pointer sx1, sy1 #I pointers to the linear surfaces +pointer sx2, sy2 #I pointers to the distortion surfaces +pointer jmsi #I interpolant +real xsample[ARB] #I sampled x reference coordinates +real ysample[ARB] #I sampled y reference coordinates +int c1, c2 #I columns of interest in sampled image +int l1, l2 #I lines of interest in the sampled image +pointer jbuf #I pointer to output buffer + +int i, ncols, nlines, llast1, llast2, nclast, nllast +pointer sp, sx, sy, y, z, buf1, buf2 + +begin + ncols = c2 - c1 + 1 + nlines = l2 - l1 + 1 + + # Combine surfaces. + if (sx2 == NULL) + call gscopy (sx1, sx) + else + call gsadd (sx1, sx2, sx) + if (sy1 == NULL) + sy = NULL + else if (sy2 == NULL) + call gscopy (sy1, sy) + else + call gsadd (sy1, sy2, sy) + + call smark (sp) + call salloc (y, ncols, TY_REAL) + call salloc (z, ncols, TY_REAL) + + # If buffer undefined then allocate memory for the buffer. Reallocate + # the buffer if the number of lines or columns changes. + if (jbuf == NULL) { + call malloc (jbuf, ncols * nlines, TY_REAL) + llast1 = l1 - nlines + llast2 = l2 - nlines + } else if ((nlines != nllast) || (ncols != nclast)) { + call realloc (jbuf, ncols * nlines, TY_REAL) + llast1 = l1 - nlines + llast2 = l2 - nlines + } + + # Compute surface. + if (l1 < llast1) { + do i = l2, l1, -1 { + if (i > llast1) + buf1 = jbuf + (i - llast1) * ncols + else { + buf1 = z + call amovkr (ysample[i], Memr[y], ncols) + call geo_jgsvector (sx, sy, xsample[c1], Memr[y], + Memr[buf1], ncols) + } + buf2 = jbuf + (i - l1) * ncols + call amovr (Memr[buf1], Memr[buf2], ncols) + } + } else if (l2 > llast2) { + do i = l1, l2 { + if (i < llast2) + buf1 = jbuf + (i - llast1) * ncols + else { + buf1 = z + call amovkr (ysample[i], Memr[y], ncols) + call geo_jgsvector (sx, sy, xsample[c1], Memr[y], + Memr[buf1], ncols) + } + buf2 = jbuf + (i - l1) * ncols + call amovr (Memr[buf1], Memr[buf2], ncols) + } + } + + # Update buffer pointers. + llast1 = l1 + llast2 = l2 + nclast = ncols + nllast = nlines + + # Fit the interpolant. + if (nlines == 1) + call asifit (jmsi, Memr[jbuf], ncols) + else + call msifit (jmsi, Memr[jbuf], ncols, nlines, ncols) + + call gsfree (sx) + call gsfree (sy) + call sfree (sp) +end + + +# GEO_JGSVECTOR -- Procedure to compute the Jacobian of the transformation. + +procedure geo_jgsvector (sx, sy, x, y, out, ncols) + +pointer sx, sy #I surface descriptors +real x[ARB] #I x values +real y[ARB] #I y values +real out[ARB] #O output values +int ncols #I number of points + +pointer sp, der1, der2 + +begin + call smark (sp) + + if (sy == NULL) { + call gsder (sx, x, y, out, ncols, 1, 0) + } else { + call salloc (der1, ncols, TY_REAL) + call salloc (der2, ncols, TY_REAL) + call gsder (sx, x, y, Memr[der1], ncols, 1, 0) + call gsder (sy, x, y, Memr[der2], ncols, 0, 1) + call amulr (Memr[der1], Memr[der2], out, ncols) + call gsder (sx, x, y, Memr[der1], ncols, 0, 1) + call gsder (sy, x, y, Memr[der2], ncols, 1, 0) + call amulr (Memr[der1], Memr[der2], Memr[der1], ncols) + call asubr (out, Memr[der1], out, ncols) + } + + call sfree (sp) +end + + +# GEO_MSIVECTOR -- Procedure to interpolate the surface coordinates + +procedure geo_msivector (in, out, geo, xmsi, ymsi, jmsi, msi, sx1, sy1, sx2, + sy2, xref, c1, c2, nxsample, yref, l1, l2, nysample, x0, y0) + +pointer in #I pointer to input image +pointer out #I pointer to output image +pointer geo #I pointer to geotran structure +pointer xmsi, ymsi #I pointer to the interpolation cord surfaces +pointer jmsi #I pointer to Jacobian surface +pointer msi #I pointer to interpolation surface +pointer sx1, sy1 #I pointers to linear surfaces +pointer sx2, sy2 #I pointer to higher order surfaces +real xref[ARB] #I x reference coordinates +int c1, c2 #I column limits in output image +int nxsample #I the x sample size +real yref[ARB] #I y reference coordinates +int l1, l2 #I line limits in output image +int nysample #I the y sample size +int x0, y0 #I zero points of interpolation coordinates + +int j, ncols, nlines, ncols4, nlines4 +int imc1, imc2, iml1, iml2, nicols, nilines +pointer sp, txref, tyref, x, y, xin, yin, inbuf, outbuf +real xmin, xmax, ymin, ymax, factor +pointer imgs1r(), imgs2r(), imps1r(), imps2r() +real geo_jfactor() + +begin + ncols = c2 - c1 + 1 + nlines = l2 - l1 + 1 + + # Find min max of interpolation coords. + if (IM_NDIM(in) == 1) + call geo_iminmax (xref, yref, c1, c2, l1, l2, x0, 0, + xmsi, ymsi, xmin, xmax, ymin, ymax) + else + call geo_iminmax (xref, yref, c1, c2, l1, l2, x0, y0, + xmsi, ymsi, xmin, xmax, ymin, ymax) + + # Get the appropriate image section and fit the interpolant. + imc1 = int(xmin) - GT_NXYMARGIN(geo) + if (imc1 <= 0) + imc1 = imc1 - 1 + imc2 = nint (xmax) + GT_NXYMARGIN(geo) + 1 + nicols = imc2 - imc1 + 1 + if (IM_NDIM(in) == 1) { + ncols4 = 2 * ncols + nlines4 = 2 * nlines + iml1 = 1 + iml2 = 1 + nilines = 1 + inbuf = imgs1r (in, imc1, imc2) + if (inbuf == EOF) + call error (0, "Error reading image") + call asifit (msi, Memr[inbuf], nicols) + } else { + ncols4 = 4 * ncols + nlines4 = 4 * nlines + iml1 = int(ymin) - GT_NXYMARGIN(geo) + if (iml1 <= 0) + iml1 = iml1 - 1 + iml2 = nint (ymax) + GT_NXYMARGIN(geo) + 1 + nilines = iml2 - iml1 + 1 + inbuf = imgs2r (in, imc1, imc2, iml1, iml2) + if (inbuf == EOF) + call error (0, "Error reading image") + call msifit (msi, Memr[inbuf], nicols, nilines, nicols) + } + + # Allocate working space. + call smark (sp) + if (GT_INTERPOLANT(geo) == II_DRIZZLE || GT_INTERPOLANT(geo) == + II_BIDRIZZLE) { + call salloc (txref, ncols4, TY_REAL) + call salloc (tyref, nlines4, TY_REAL) + call salloc (x, ncols4, TY_REAL) + call salloc (y, ncols4, TY_REAL) + call salloc (xin, ncols4, TY_REAL) + call salloc (yin, ncols4, TY_REAL) + if (IM_NDIM(in) == 1) + call geo_sample (geo, Memr[txref], c1, c2, nxsample, + Memr[tyref], l1, l2, nysample, GT_TWO) + else + call geo_sample (geo, Memr[txref], c1, c2, nxsample, + Memr[tyref], l1, l2, nysample, GT_FOUR) + call aaddkr (Memr[txref], real (-x0 + 1), Memr[x], ncols4) + } else { + call salloc (x, ncols, TY_REAL) + call salloc (y, ncols, TY_REAL) + call salloc (xin, ncols, TY_REAL) + call salloc (yin, ncols, TY_REAL) + call aaddkr (xref[c1], real (-x0 + 1), Memr[x], ncols) + } + + # Compute the output buffer. + do j = l1, l2 { + + # Write the output image. + if (IM_NDIM(in) == 1) + outbuf = imps1r (out, c1, c2) + else + outbuf = imps2r (out, c1, c2, j, j) + if (outbuf == EOF) + call error (0, "Error writing output image") + + # Compute the interpolation coordinates. + if (GT_INTERPOLANT(geo) == II_DRIZZLE || GT_INTERPOLANT(geo) == + II_BIDRIZZLE) { + if (IM_NDIM(in) == 1) { + call asivector (xmsi, Memr[x], Memr[xin], ncols4) + call amovkr (1.0, Memr[yin], ncols4) + } else { + #call amovkr (yref[j] + real (-y0 + 1), Memr[y], ncols) + call geo_repeat (Memr[tyref+4*(j-l1)], 4, Memr[y], ncols) + call aaddkr (Memr[y], real(-y0 + 1), Memr[y], ncols4) + call msivector (xmsi, Memr[x], Memr[y], Memr[xin], ncols4) + call msivector (ymsi, Memr[x], Memr[y], Memr[yin], ncols4) + } + if (imc1 != 1) + call aaddkr (Memr[xin], real (-imc1 + 1), Memr[xin], ncols4) + if (iml1 != 1) + call aaddkr (Memr[yin], real (-iml1 + 1), Memr[yin], ncols4) + } else { + if (IM_NDIM(in) == 1) { + call asivector (xmsi, Memr[x], Memr[xin], ncols) + call amovkr (1.0, Memr[yin], ncols) + } else { + call amovkr (yref[j] + real (-y0 + 1), Memr[y], ncols) + call msivector (xmsi, Memr[x], Memr[y], Memr[xin], ncols) + call msivector (ymsi, Memr[x], Memr[y], Memr[yin], ncols) + } + if (imc1 != 1) + call aaddkr (Memr[xin], real (-imc1 + 1), Memr[xin], ncols) + if (iml1 != 1) + call aaddkr (Memr[yin], real (-iml1 + 1), Memr[yin], ncols) + } + + # Interpolate in the input image. + if (IM_NDIM(in) == 1) + call asivector (msi, Memr[xin], Memr[outbuf], ncols) + else + call msivector (msi, Memr[xin], Memr[yin], Memr[outbuf], ncols) + + # Preserve flux in image. + if (GT_FLUXCONSERVE(geo) == YES) { + factor = GT_XSCALE(geo) * GT_YSCALE(geo) + if (GT_GEOMODE(geo) == GT_LINEAR || (sx2 == NULL && sy2 == + NULL)) { + if (IM_NDIM(in) == 1) + call amulkr (Memr[outbuf], factor * geo_jfactor (sx1, + NULL), Memr[outbuf], ncols) + else + call amulkr (Memr[outbuf], factor * geo_jfactor (sx1, + sy1), Memr[outbuf], ncols) + } else { + if (IM_NDIM(in) == 1) + call geo_msiflux (jmsi, xref, yref, Memr[outbuf], + c1, c2, 0, x0, y0) + else + call geo_msiflux (jmsi, xref, yref, Memr[outbuf], + c1, c2, j, x0, y0) + call amulkr (Memr[outbuf], factor, Memr[outbuf], ncols) + } + } + } + + call sfree (sp) +end + + +# GEO_GSVECTOR -- Evaluate the output image pixels using fitted coordinate +# values and image interpolation. + +procedure geo_gsvector (input, output, geo, msi, xref, c1, c2, yref, l1, l2, + sx1, sy1, sx2, sy2) + +pointer input #I pointer to input image +pointer output #I pointer to output image +pointer geo #I pointer to geotran structure +pointer msi #I pointer to interpolant +real xref[ARB] #I x reference array +int c1, c2 #I columns of interest in output image +real yref[ARB] #I y reference array +int l1, l2 #I lines of interest in the output image +pointer sx1, sy1 #I linear surface descriptors +pointer sx2, sy2 #I distortion surface descriptors + +int j, ncols, nlines, ncols4, nlines4, nicols, nilines +int imc1, imc2, iml1, iml2 +pointer sp, txref, tyref, y, xin, yin, temp, inbuf, outbuf +real xmin, xmax, ymin, ymax, factor +pointer imgs1r(), imgs2r(), imps1r(), imps2r() +real gsgetr(), geo_jfactor() + +begin + # Compute the number of columns. + ncols = c2 - c1 + 1 + nlines = l2 - l1 + 1 + + # Compute the maximum and minimum coordinates. + call geo_minmax (xref, yref, c1, c2, l1, l2, sx1, sy1, sx2, sy2, + xmin, xmax, ymin, ymax) + + # Get the appropriate image section and fill the buffer. + imc1 = int(xmin) - GT_NXYMARGIN(geo) + if (imc1 <= 0) + imc1 = imc1 - 1 + imc2 = nint (xmax) + GT_NXYMARGIN(geo) + 1 + nicols = imc2 - imc1 + 1 + if (IM_NDIM(input) == 1) { + iml1 = 1 + iml2 = 1 + nilines = 1 + ncols4 = 2 * ncols + nlines4 = 2 * nlines + inbuf = imgs1r (input, imc1, imc2) + if (inbuf == EOF) + call error (0, "Error reading image") + call asifit (msi, Memr[inbuf], nicols) + } else { + iml1 = int(ymin) - GT_NXYMARGIN(geo) + if (iml1 <= 0) + iml1 = iml1 - 1 + iml2 = nint (ymax) + GT_NXYMARGIN(geo) + 1 + nilines = iml2 - iml1 + 1 + ncols4 = 4 * ncols + nlines4 = 4 * nlines + inbuf = imgs2r (input, imc1, imc2, iml1, iml2) + if (inbuf == EOF) + call error (0, "Error reading image") + call msifit (msi, Memr[inbuf], nicols, nilines, nicols) + } + + # Allocate working space. + call smark (sp) + if (GT_INTERPOLANT(geo) == II_DRIZZLE || GT_INTERPOLANT(geo) == + II_BIDRIZZLE) { + call salloc (txref, ncols4, TY_REAL) + call salloc (tyref, nlines4, TY_REAL) + call salloc (y, ncols4, TY_REAL) + call salloc (xin, ncols4, TY_REAL) + call salloc (yin, ncols4, TY_REAL) + call salloc (temp, ncols4, TY_REAL) + if (IM_NDIM(input) == 1) + call geo_ref (geo, Memr[txref], c1, c2, GT_NCOLS(geo), + Memr[tyref], l1, l2, GT_NLINES(geo), gsgetr (sx1, GSXMIN), + gsgetr (sx1, GSXMAX), gsgetr (sx1, GSYMIN), gsgetr (sx1, + GSYMAX), GT_TWO) + else + call geo_ref (geo, Memr[txref], c1, c2, GT_NCOLS(geo), + Memr[tyref], l1, l2, GT_NLINES(geo), gsgetr (sx1, GSXMIN), + gsgetr (sx1, GSXMAX), gsgetr (sx1, GSYMIN), gsgetr (sx1, + GSYMAX), GT_FOUR) + } else { + call salloc (y, ncols, TY_REAL) + call salloc (xin, ncols, TY_REAL) + call salloc (yin, ncols, TY_REAL) + call salloc (temp, ncols, TY_REAL) + } + + # Compute the pixels. + do j = l1, l2 { + + # Get output image buffer. + if (IM_NDIM(input) == 1) + outbuf = imps1r (output, c1, c2) + else + outbuf = imps2r (output, c1, c2, j, j) + if (output == EOF) + call error (0, "Error writing output image") + + # Compute the interpolation coordinates. + if (GT_INTERPOLANT(geo) == II_DRIZZLE || GT_INTERPOLANT(geo) == + II_BIDRIZZLE) { + + # Set the y coordinate. + if (IM_NDIM(input) == 1) + call geo_repeat (Memr[tyref+2*(j-l1)], 2, Memr[y], ncols) + else + call geo_repeat (Memr[tyref+4*(j-l1)], 4, Memr[y], ncols) + + # Fit x coords. + call gsvector (sx1, Memr[txref], Memr[y], Memr[xin], ncols4) + if (sx2 != NULL) { + call gsvector (sx2, Memr[txref], Memr[y], Memr[temp], + ncols4) + call aaddr (Memr[xin], Memr[temp], Memr[xin], ncols4) + } + if (imc1 != 1) + call aaddkr (Memr[xin], real (-imc1 + 1), Memr[xin], ncols4) + + # Fit y coords. + call gsvector (sy1, Memr[txref], Memr[y], Memr[yin], ncols4) + if (sy2 != NULL) { + call gsvector (sy2, Memr[txref], Memr[y], Memr[temp], + ncols4) + call aaddr (Memr[yin], Memr[temp], Memr[yin], ncols4) + } + if (iml1 != 1) + call aaddkr (Memr[yin], real (-iml1 + 1), Memr[yin], ncols4) + + } else { + + # Set the y coordinate. + call amovkr (yref[j], Memr[y], ncols) + + # Fit x coords. + call gsvector (sx1, xref[c1], Memr[y], Memr[xin], ncols) + if (sx2 != NULL) { + call gsvector (sx2, xref[c1], Memr[y], Memr[temp], ncols) + call aaddr (Memr[xin], Memr[temp], Memr[xin], ncols) + } + if (imc1 != 1) + call aaddkr (Memr[xin], real (-imc1 + 1), Memr[xin], ncols) + + # Fit y coords. + call gsvector (sy1, xref[c1], Memr[y], Memr[yin], ncols) + if (sy2 != NULL) { + call gsvector (sy2, xref[c1], Memr[y], Memr[temp], ncols) + call aaddr (Memr[yin], Memr[temp], Memr[yin], ncols) + } + if (iml1 != 1) + call aaddkr (Memr[yin], real (-iml1 + 1), Memr[yin], ncols) + } + + # Interpolate in input image. + if (IM_NDIM(input) == 1) + call asivector (msi, Memr[xin], Memr[outbuf], ncols) + else + call msivector (msi, Memr[xin], Memr[yin], Memr[outbuf], ncols) + + # Preserve flux in image. + if (GT_FLUXCONSERVE(geo) == YES) { + factor = GT_XSCALE(geo) * GT_YSCALE(geo) + if (GT_GEOMODE(geo) == GT_LINEAR || (sx2 == NULL && sy2 == + NULL)) { + if (IM_NDIM(input) == 1) + call amulkr (Memr[outbuf], factor * geo_jfactor (sx1, + NULL), Memr[outbuf], ncols) + else + call amulkr (Memr[outbuf], factor * geo_jfactor (sx1, + sy1), Memr[outbuf], ncols) + } else { + if (IM_NDIM(input) == 1) + call geo_gsflux (xref, yref, Memr[outbuf], c1, c2, j, + sx1, NULL, sx2, NULL) + else + call geo_gsflux (xref, yref, Memr[outbuf], c1, c2, j, + sx1, sy1, sx2, sy2) + call amulkr (Memr[outbuf], factor, Memr[outbuf], ncols) + } + } + } + + call sfree (sp) +end + + +# GEO_IMINMAX -- Find minimum and maximum interpolation coordinates. + +procedure geo_iminmax (xref, yref, c1, c2, l1, l2, x0, y0, xmsi, ymsi, xmin, + xmax, ymin, ymax) + +real xref[ARB] #I x reference coords +real yref[ARB] #I y reference coords +int c1, c2 #I columns limits +int l1, l2 #I line limits +int x0, y0 #I interpolation coord zero points +pointer xmsi, ymsi #I coord surfaces +real xmin, xmax #O output xmin and xmax +real ymin, ymax #O output ymin and ymax + +int j, ncols +pointer sp, x, y, xin, yin +real mintemp, maxtemp, x1, x2, y1, y2 +real asieval(), msieval() + +begin + call smark (sp) + ncols = c2 - c1 + 1 + call salloc (x, ncols, TY_REAL) + call salloc (y, ncols, TY_REAL) + call salloc (xin, ncols, TY_REAL) + call salloc (yin, ncols, TY_REAL) + + xmin = MAX_REAL + xmax = -MAX_REAL + ymin = MAX_REAL + ymax = -MAX_REAL + + # find the minimum and maximum + do j = l1, l2 { + + if (j == l1 || j == l2) { + + call aaddkr (xref[c1], real (-x0 + 1), Memr[x], ncols) + if (y0 <= 0) { + call asivector (xmsi, Memr[x], Memr[xin], ncols) + ymin = 1.0 + ymax = 1.0 + } else { + call amovkr (yref[j] + real (-y0 + 1), Memr[y], ncols) + call msivector (xmsi, Memr[x], Memr[y], Memr[xin], ncols) + call msivector (ymsi, Memr[x], Memr[y], Memr[yin], ncols) + call alimr (Memr[yin], ncols, mintemp, maxtemp) + ymin = min (ymin, mintemp) + ymax = max (ymax, maxtemp) + } + call alimr (Memr[xin], ncols, mintemp, maxtemp) + xmin = min (xmin, mintemp) + xmax = max (xmax, maxtemp) + } else { + if (y0 <= 0) { + x1 = asieval (xmsi, xref[c1] + real (-x0 + 1)) + x2 = asieval (xmsi, xref[c1+ncols-1] + real (-x0 + 1)) + ymin = 1.0 + ymax = 1.0 + } else { + x1 = msieval (xmsi, xref[c1] + real (-x0 + 1), + yref[j] + real (-y0 + 1)) + x2 = msieval (xmsi, xref[c1+ncols-1] + real (-x0 + 1), + yref[j] + real (-y0 + 1)) + y1 = msieval (ymsi, xref[c1] + real (-x0 + 1), + yref[j] + real (-y0 + 1)) + y2 = msieval (ymsi, xref[c1+ncols-1] + real (-x0 + 1), + yref[j] + real (-y0 + 1)) + ymin = min (ymin, y1, y2) + ymax = max (ymax, y1, y2) + } + xmin = min (xmin, x1, x2) + xmax = max (xmax, x1, x2) + + } + } + + call sfree (sp) + +end + + +# GEO_MINMAX -- Compute the minimum and maximum fitted coordinates. + +procedure geo_minmax (xref, yref, c1, c2, l1, l2, sx1, sy1, sx2, sy2, + xmin, xmax, ymin, ymax) + +real xref[ARB] #I x reference coords +real yref[ARB] #I y reference coords +int c1, c2 #I columns limits +int l1, l2 #I line limits +pointer sx1, sy1 #I linear surface descriptors +pointer sx2, sy2 #I distortion surface descriptors +real xmin, xmax #O output xmin and xmax +real ymin, ymax #O output ymin and ymax + +int j, ncols +pointer sp, y, xin, yin, temp +real x1, x2, y1, y2, mintemp, maxtemp +real gseval() + +begin + call smark (sp) + ncols = c2 - c1 + 1 + call salloc (y, ncols, TY_REAL) + call salloc (xin, ncols, TY_REAL) + call salloc (yin, ncols, TY_REAL) + call salloc (temp, ncols, TY_REAL) + + xmin = MAX_REAL + xmax = -MAX_REAL + ymin = MAX_REAL + ymax = -MAX_REAL + + # Find the maximum and minimum coordinates. + do j = l1, l2 { + + if (j == l1 || j == l2) { + + call amovkr (yref[j], Memr[y], ncols) + call gsvector (sx1, xref[c1], Memr[y], Memr[xin], ncols) + if (sx2 != NULL) { + call gsvector (sx2, xref[c1], Memr[y], Memr[temp], ncols) + call aaddr (Memr[xin], Memr[temp], Memr[xin], ncols) + } + call gsvector (sy1, xref[c1], Memr[y], Memr[yin], ncols) + if (sy2 != NULL) { + call gsvector (sy2, xref[c1], Memr[y], Memr[temp], ncols) + call aaddr (Memr[yin], Memr[temp], Memr[yin], ncols) + } + + call alimr (Memr[xin], ncols, mintemp, maxtemp) + xmin = min (xmin, mintemp) + xmax = max (xmax, maxtemp) + call alimr (Memr[yin], ncols, mintemp, maxtemp) + ymin = min (ymin, mintemp) + ymax = max (ymax, maxtemp) + + } else { + + x1 = gseval (sx1, xref[c1], yref[j]) + x2 = gseval (sx1, xref[c1+ncols-1], yref[j]) + if (sx2 != NULL) { + x1 = x1 + gseval (sx2, xref[c1], yref[j]) + x2 = x2 + gseval (sx2, xref[c1+ncols-1], yref[j]) + } + xmin = min (xmin, x1, x2) + xmax = max (xmax, x1, x2) + + y1 = gseval (sy1, xref[c1], yref[j]) + y2 = gseval (sy1, xref[c1+ncols-1], yref[j]) + if (sy2 != NULL) { + y1 = y1 + gseval (sy2, xref[c1], yref[j]) + y2 = y2 + gseval (sy2, xref[c1+ncols-1], yref[j]) + } + ymin = min (ymin, y1, y2) + ymax = max (ymax, y1, y2) + + } + } + + call sfree (sp) +end + + +# GEO_MARGSET -- Set up interpolation margin + +procedure geo_margset (sx1, sy1, sx2, sy2, xmin, xmax, ncols, ymin, ymax, + nlines, interpolant, nsinc, nxymargin) + +pointer sx1, sy1 #I linear surface descriptors +pointer sx2, sy2 #I distortion surface descriptors +real xmin, xmax #I the reference coordinate x limits +int ncols #I the number of output image columns +real ymin, ymax #I the reference coordinate y limits +int nlines #I the number of output image lines +int interpolant #I the interpolant type +int nsinc #I the sinc width +int nxymargin #O the interpolation margin + +int dist1, dist2, dist3, dist4, dist5, dist6 +pointer newsx, newsy +real x1, y1, x2, y2 +real gseval() + +begin + if (interpolant == II_SPLINE3 || interpolant == II_BISPLINE3) { + nxymargin = NMARGIN_SPLINE3 + } else if (interpolant == II_LSINC || interpolant == II_BILSINC) { + nxymargin = nsinc + } else if (interpolant == II_SINC || interpolant == II_BISINC) { + nxymargin = nsinc + } else if (interpolant == II_DRIZZLE || interpolant == II_BIDRIZZLE) { + if (sx2 == NULL) + call gscopy (sx1, newsx) + else + call gsadd (sx1, sx2, newsx) + if (sy2 == NULL) + call gscopy (sy1, newsy) + else + call gsadd (sy1, sy2, newsy) + x1 = gseval (newsx, xmin, ymin) + y1 = gseval (newsy, xmin, ymin) + x2 = gseval (newsx, xmax, ymin) + y2 = gseval (newsy, xmax, ymin) + dist1 = sqrt ((x1 - x2) ** 2 + (y1 - y2) ** 2) / ncols + x1 = gseval (newsx, xmax, ymax) + y1 = gseval (newsy, xmax, ymax) + dist2 = sqrt ((x1 - x2) ** 2 + (y1 - y2) ** 2) / nlines + x2 = gseval (newsx, xmin, ymax) + y2 = gseval (newsy, xmin, ymax) + dist3 = sqrt ((x1 - x2) ** 2 + (y1 - y2) ** 2) / ncols + x1 = gseval (newsx, xmin, ymin) + y1 = gseval (newsy, xmin, ymin) + dist4 = sqrt ((x1 - x2) ** 2 + (y1 - y2) ** 2) / nlines + x1 = gseval (newsx, xmin, (ymin + ymax) / 2.0) + y1 = gseval (newsy, xmin, (ymin + ymax) / 2.0) + x2 = gseval (newsx, xmax, (ymin + ymax) / 2.0) + y2 = gseval (newsy, xmax, (ymin + ymax) / 2.0) + dist5 = sqrt ((x1 - x2) ** 2 + (y1 - y2) ** 2) / ncols + x1 = gseval (newsx, (xmin + xmax) / 2.0, ymin) + y1 = gseval (newsy, (xmin + xmax) / 2.0, ymin) + x2 = gseval (newsx, (xmin + xmax) / 2.0, ymax) + y2 = gseval (newsy, (xmin + xmax) / 2.0, ymax) + dist6 = sqrt ((x1 - x2) ** 2 + (y1 - y2) ** 2) / nlines + nxymargin = max (NMARGIN, dist1, dist2, dist3, dist4, + dist5, dist6) + call gsfree (newsx) + call gsfree (newsy) + } else { + nxymargin = NMARGIN + } +end + + +# GEO_IMSET -- Set up input image boundary conditions. + +procedure geo_imset (im, geo, sx1, sy1, sx2, sy2, xref, nx, yref, ny) + +pointer im #I pointer to image +pointer geo #I pointer to geotran structure +pointer sx1, sy1 #I linear surface descriptors +pointer sx2, sy2 #I distortion surface descriptors +real xref[ARB] #I x reference coordinates +int nx #I number of x reference coordinates +real yref[ARB] #I y reference coordinates +int ny #I number of y reference coordinates + +int bndry, npts +pointer sp, x1, x2, y1, y2, xtemp, ytemp +real xn1, xn2, xn3, xn4, yn1, yn2, yn3, yn4, xmin, xmax, ymin, ymax +real gseval() + +begin + npts = max (nx, ny) + + xn1 = gseval (sx1, GT_XMIN(geo), GT_YMIN(geo)) + xn2 = gseval (sx1, GT_XMAX(geo), GT_YMIN(geo)) + xn3 = gseval (sx1, GT_XMAX(geo), GT_YMAX(geo)) + xn4 = gseval (sx1, GT_XMIN(geo), GT_YMAX(geo)) + + yn1 = gseval (sy1, GT_XMIN(geo), GT_YMIN(geo)) + yn2 = gseval (sy1, GT_XMAX(geo), GT_YMIN(geo)) + yn3 = gseval (sy1, GT_XMAX(geo), GT_YMAX(geo)) + yn4 = gseval (sy1, GT_XMIN(geo), GT_YMAX(geo)) + + xmin = min (xn1, xn2, xn3, xn4) + ymin = min (yn1, yn2, yn3, yn4) + xmax = max (xn1, xn2, xn3, xn4) + ymax = max (yn1, yn2, yn3, yn4) + + if (sx2 != NULL) { + call smark (sp) + call salloc (x1, npts, TY_REAL) + call salloc (x2, npts, TY_REAL) + call salloc (xtemp, npts, TY_REAL) + call salloc (ytemp, npts, TY_REAL) + + call amovkr (GT_YMIN(geo), Memr[ytemp], nx) + call gsvector (sx1, xref, Memr[ytemp], Memr[x1], nx) + call gsvector (sx2, xref, Memr[ytemp], Memr[x2], nx) + call aaddr (Memr[x1], Memr[x2], Memr[x1], nx) + call alimr (Memr[x1], nx, xn1, yn1) + + call amovkr (GT_XMAX(geo), Memr[xtemp], ny) + call gsvector (sx1, Memr[xtemp], yref, Memr[x1], ny) + call gsvector (sx2, Memr[xtemp], yref, Memr[x2], ny) + call aaddr (Memr[x1], Memr[x2], Memr[x1], ny) + call alimr (Memr[x1], ny, xn2, yn2) + + call amovkr (GT_YMAX(geo), Memr[ytemp], nx) + call gsvector (sx1, xref, Memr[ytemp], Memr[x1], nx) + call gsvector (sx2, xref, Memr[ytemp], Memr[x2], nx) + call aaddr (Memr[x1], Memr[x2], Memr[x1], nx) + call alimr (Memr[x1], nx, xn3, yn3) + + call amovkr (GT_XMIN(geo), Memr[xtemp], ny) + call gsvector (sx1, Memr[xtemp], yref, Memr[x1], ny) + call gsvector (sx2, Memr[xtemp], yref, Memr[x2], ny) + call aaddr (Memr[x1], Memr[x2], Memr[x1], ny) + call alimr (Memr[x1], ny, xn4, yn4) + + xmin = min (xn1, xn2, xn3, xn4) + xmax = max (yn1, yn2, yn3, yn4) + + call sfree (sp) + } + + if (sy2 != NULL) { + call smark (sp) + call salloc (y1, npts, TY_REAL) + call salloc (y2, npts, TY_REAL) + call salloc (xtemp, npts, TY_REAL) + call salloc (ytemp, npts, TY_REAL) + + call amovkr (GT_YMIN(geo), Memr[ytemp], nx) + call gsvector (sy1, xref, Memr[ytemp], Memr[y1], nx) + call gsvector (sy2, xref, Memr[ytemp], Memr[y2], nx) + call aaddr (Memr[y1], Memr[y2], Memr[y1], nx) + call alimr (Memr[y1], nx, xn1, yn1) + + call amovkr (GT_XMAX(geo), Memr[xtemp], ny) + call gsvector (sy1, Memr[xtemp], yref, Memr[y1], ny) + call gsvector (sy2, Memr[xtemp], yref, Memr[y2], ny) + call aaddr (Memr[y1], Memr[y2], Memr[y1], ny) + call alimr (Memr[y1], ny, xn2, yn2) + + call amovkr (GT_YMAX(geo), Memr[ytemp], nx) + call gsvector (sy1, xref, Memr[ytemp], Memr[y1], nx) + call gsvector (sy2, xref, Memr[ytemp], Memr[y2], nx) + call aaddr (Memr[y1], Memr[y2], Memr[y1], nx) + call alimr (Memr[y1], nx, xn3, yn3) + + call amovkr (GT_XMIN(geo), Memr[xtemp], ny) + call gsvector (sy1, Memr[xtemp], yref, Memr[y1], ny) + call gsvector (sy2, Memr[xtemp], yref, Memr[y2], ny) + call aaddr (Memr[y1], Memr[y2], Memr[y1], ny) + call alimr (Memr[y1], ny, xn4, yn4) + + ymin = min (xn1, xn2, xn3, xn4) + ymax = max (yn1, yn2, yn3, yn4) + + call sfree (sp) + } + + # Compute the out-of-bounds limit. + if (IM_NDIM(im) == 1) { + if (xmin < 1.0 || xmax > real (IM_LEN(im,1))) + bndry = max (1.0 - xmin, xmax - IM_LEN(im,1)) + 1 + else + bndry = 1 + } else { + if (xmin < 1.0 || ymin < 1.0 || xmax > real (IM_LEN(im,1)) || + ymax > real (IM_LEN(im,2))) + bndry = max (1.0 - xmin, 1.0 - ymin, xmax - IM_LEN(im,1), + ymax - IM_LEN(im,2)) + 1 + else + bndry = 1 + } + + call imseti (im, IM_NBNDRYPIX, bndry + GT_NXYMARGIN(geo) + 1) + call imseti (im, IM_TYBNDRY, GT_BOUNDARY(geo)) + call imsetr (im, IM_BNDRYPIXVAL, GT_CONSTANT(geo)) +end + + +# GEO_GSFLUX -- Preserve the image flux after a transformation. + +procedure geo_gsflux (xref, yref, buf, c1, c2, line, sx1, sy1, sx2, sy2) + +real xref[ARB] #I x reference coordinates +real yref[ARB] #I y reference coordinates +real buf[ARB] #O output image buffer +int c1, c2 #I column limits in the output image +int line #I line in the output image +pointer sx1, sy1 #I linear surface descriptors +pointer sx2, sy2 #I distortion surface descriptors + +int ncols +pointer sp, y, der1, der2, jacob, sx, sy + +begin + ncols = c2 - c1 + 1 + + # Get the reference coordinates. + call smark (sp) + call salloc (y, ncols, TY_REAL) + call salloc (jacob, ncols, TY_REAL) + + # Add the two surfaces together for efficiency. + if (sx2 != NULL) + call gsadd (sx1, sx2, sx) + else + call gscopy (sx1, sx) + if (sy1 == NULL) + sy = NULL + else if (sy2 != NULL) + call gsadd (sy1, sy2, sy) + else + call gscopy (sy1, sy) + + # Multiply the output buffer by the Jacobian. + call amovkr (yref[line], Memr[y], ncols) + if (sy == NULL) + call gsder (sx, xref[c1], Memr[y], Memr[jacob], ncols, 1, 0) + else { + call salloc (der1, ncols, TY_REAL) + call salloc (der2, ncols, TY_REAL) + call gsder (sx, xref[c1], Memr[y], Memr[der1], ncols, 1, 0) + call gsder (sy, xref[c1], Memr[y], Memr[der2], ncols, 0, 1) + call amulr (Memr[der1], Memr[der2], Memr[jacob], ncols) + call gsder (sx, xref[c1], Memr[y], Memr[der1], ncols, 0, 1) + call gsder (sy, xref[c1], Memr[y], Memr[der2], ncols, 1, 0) + call amulr (Memr[der1], Memr[der2], Memr[der1], ncols) + call asubr (Memr[jacob], Memr[der1], Memr[jacob], ncols) + } + call aabsr (Memr[jacob], Memr[jacob], ncols) + call amulr (buf, Memr[jacob], buf, ncols) + + # Clean up. + call gsfree (sx) + if (sy != NULL) + call gsfree (sy) + call sfree (sp) +end + + +# GEO_MSIFLUX -- Procedure to interpolate the surface coordinates + +procedure geo_msiflux (jmsi, xinterp, yinterp, outdata, c1, c2, line, x0, y0) + +pointer jmsi #I pointer to the jacobian interpolant +real xinterp[ARB] #I x reference coordinates +real yinterp[ARB] #I y reference coordinates +real outdata[ARB] #O output data +int c1, c2 #I column limits in output image +int line #I line to be flux corrected +int x0, y0 #I zero points of interpolation coordinates + +int ncols +pointer sp, x, y, jacob + +begin + # Allocate tempoaray space. + call smark (sp) + ncols = c2 - c1 + 1 + call salloc (x, ncols, TY_REAL) + call salloc (jacob, ncols, TY_REAL) + + # Calculate the x points. + if (x0 == 1) + call amovr (xinterp[c1], Memr[x], ncols) + else + call aaddkr (xinterp[c1], real (-x0 + 1), Memr[x], ncols) + + # Multiply the data by the Jacobian. + if (line == 0) { + call asivector (jmsi, Memr[x], Memr[jacob], ncols) + } else { + call salloc (y, ncols, TY_REAL) + call amovkr ((yinterp[line] + real (-y0 + 1)), Memr[y], ncols) + call msivector (jmsi, Memr[x], Memr[y], Memr[jacob], ncols) + } + call aabsr (Memr[jacob], Memr[jacob], ncols) + call amulr (outdata, Memr[jacob], outdata, ncols) + + call sfree (sp) +end + + +# GEO_JFACTOR -- Compute the Jacobian of a linear transformation. + +real procedure geo_jfactor (sx1, sy1) + +pointer sx1 #I pointer to x surface +pointer sy1 #I pointer to y surface + +real xval, yval, xx, xy, yx, yy +real gsgetr() + +begin + xval = (gsgetr (sx1, GSXMIN) + gsgetr (sx1, GSXMAX)) / 2.0 + if (sy1 == NULL) + yval = 1.0 + else + yval = (gsgetr (sy1, GSYMIN) + gsgetr (sy1, GSYMIN)) / 2.0 + + call gsder (sx1, xval, yval, xx, 1, 1, 0) + if (sy1 == NULL) { + xy = 0.0 + yy = 1.0 + yx = 0.0 + } else { + call gsder (sx1, xval, yval, xy, 1, 0, 1) + call gsder (sy1, xval, yval, yx, 1, 1, 0) + call gsder (sy1, xval, yval, yy, 1, 0, 1) + } + + return (abs (xx * yy - xy * yx)) +end + + +# GEO_REPEAT -- Copy a small repeated pattern into the output buffer. + +procedure geo_repeat (pat, npat, output, ntimes) + +real pat[ARB] #I the input pattern to be repeated +int npat #I the size of the pattern +real output[ARB] #O the output array +int ntimes #I the number of times the pattern is to be repeated + +int j, i, offset + +begin + do j = 1, ntimes { + offset = npat * j - npat + do i = 1, npat + output[offset+i] = pat[i] + } +end diff --git a/pkg/images/immatch/src/geometry/geoxytran.gx b/pkg/images/immatch/src/geometry/geoxytran.gx new file mode 100644 index 00000000..22d577f1 --- /dev/null +++ b/pkg/images/immatch/src/geometry/geoxytran.gx @@ -0,0 +1,327 @@ +include <ctype.h> +include <mach.h> +include <math.h> +include <math/gsurfit.h> + +define GEO_LINEAR 1 # Linear transformation only +define GEO_DISTORTION 2 # Distortion correction only +define GEO_GEOMETRIC 3 # Full transformation + +$for (rd) + +# GEO_LINIT -- Initialize the linear part of the transformation. + +$if (datatype == r) +procedure geo_linitr (sx1, sy1, sx2, sy2) +$else +procedure geo_linitd (sx1, sy1, sx2, sy2) +$endif + +pointer sx1, sy1 #I/O pointers to the linear x and y surfaces +pointer sx2, sy2 #I/O pointer to the distortion x and y surfaces + +PIXEL xmag, ymag, xrot, yrot, xref, yref, xout, yout, xshift, yshift +$if (datatype == r) +real clgetr(), gseval() +$else +double clgetd(), dgseval() +$endif + +begin + # Initialize the surfaces. +$if (datatype == r) + call gsinit (sx1, GS_POLYNOMIAL, 2, 2, GS_XNONE, -MAX_REAL, MAX_REAL, + -MAX_REAL, MAX_REAL) + call gsinit (sy1, GS_POLYNOMIAL, 2, 2, GS_XNONE, -MAX_REAL, MAX_REAL, + -MAX_REAL, MAX_REAL) +$else + call dgsinit (sx1, GS_POLYNOMIAL, 2, 2, GS_XNONE, double (-MAX_REAL), + double (MAX_REAL), double (-MAX_REAL), double (MAX_REAL)) + call dgsinit (sy1, GS_POLYNOMIAL, 2, 2, GS_XNONE, double (-MAX_REAL), + double (MAX_REAL), double (-MAX_REAL), double (MAX_REAL)) +$endif + sx2 = NULL + sy2 = NULL + + # Get the magnification parameters. + xmag = clget$t ("xmag") + if (IS_$INDEF$T(xmag)) + xmag = PIXEL(1.0) + ymag = clget$t ("ymag") + if (IS_$INDEF$T(ymag)) + ymag = PIXEL(1.0) + + # Get the rotation parameters. + xrot = clget$t ("xrot") + if (IS_$INDEF$T(xrot)) + xrot = PIXEL(0.0) + xrot = -DEGTORAD(xrot) + yrot = clget$t ("yrot") + if (IS_$INDEF$T(yrot)) + yrot = PIXEL(0.0) + yrot = -DEGTORAD(yrot) + + # Set the magnification and rotation coefficients. + call geo_rotmag$t (sx1, sy1, xmag, ymag, xrot, yrot) + + # Compute the origin of the reference coordinates. + xref = clget$t ("xref") + if (IS_$INDEF$T(xref)) + xref = PIXEL(0.0) + yref = clget$t ("yref") + if (IS_$INDEF$T(yref)) + yref = PIXEL(0.0) + + # Compute the corresponding input coordinates. + xout = clget$t ("xout") + if (IS_$INDEF$T(xout)) +$if (datatype == r) + xout = gseval (sx1, xref, yref) +$else + xout = dgseval (sx1, xref, yref) +$endif + yout = clget$t ("yout") + if (IS_$INDEF$T(yout)) +$if (datatype == r) + yout = gseval (sy1, xref, yref) +$else + yout = dgseval (sy1, xref, yref) +$endif + + # Set the shifts. + xshift = clget$t ("xshift") + yshift = clget$t ("yshift") +$if (datatype == r) + if (IS_$INDEF$T(xshift)) + xshift = xout - gseval (sx1, xref, yref) + if (IS_$INDEF$T(yshift)) + yshift = yout - gseval (sy1, xref, yref) +$else + if (IS_$INDEF$T(xshift)) + xshift = xout - $tgseval (sx1, xref, yref) + if (IS_$INDEF$T(yshift)) + yshift = yout - $tgseval (sy1, xref, yref) +$endif + call geo_xyshift$t (sx1, sy1, xshift, yshift) +end + + +# GEO_SFREE -- Free the x and y surface fitting descriptors. + +$if (datatype == r) +procedure geo_sfreer (sx1, sy1, sx2, sy2) +$else +procedure geo_sfreed (sx1, sy1, sx2, sy2) +$endif + +pointer sx1, sy1 #I/O pointers to the linear x and y surfaces +pointer sx2, sy2 #I/O pointer to the distortion x and y surfaces + +begin +$if (datatype == r) + call gsfree (sx1) + call gsfree (sy1) + if (sx2 != NULL) + call gsfree (sx2) + if (sy2 != NULL) + call gsfree (sy2) +$else + call dgsfree (sx1) + call dgsfree (sy1) + if (sx2 != NULL) + call dgsfree (sx2) + if (sy2 != NULL) + call dgsfree (sy2) +$endif +end + + +# GEO_SINIT -- Read the surface fits from the database file and make +# any requested changes. + +procedure geo_sinit$t (dt, record, geometry, sx1, sy1, sx2, sy2) + +pointer dt #I pointer to database file produced by geomap +char record[ARB] #I the name of the database record +int geometry #I the type of geometry to be computed +pointer sx1, sy1 #O pointers to the linear x and y surfaces +pointer sx2, sy2 #O pointers to the x and y distortion surfaces + +int i, rec, ncoeff, junk +PIXEL xmag, ymag, xrot, yrot, xref, yref, xout, yout, xshift, yshift +pointer newsx1, newsy1, xcoeff, ycoeff +int dtlocate(), dtscan(), dtgeti() +PIXEL clget$t() +$if (datatype == r) +errchk gsrestore +$else +errchk dgsrestore +$endif + +begin + # Locate record. + rec = dtlocate (dt, record) + + # Get linear part of fit. + ncoeff = dtgeti (dt, rec, "surface1") + call malloc (xcoeff, ncoeff, TY_PIXEL) + call malloc (ycoeff, ncoeff, TY_PIXEL) + do i = 1, ncoeff { + junk = dtscan (dt) + call garg$t (Mem$t[xcoeff+i-1]) + call garg$t (Mem$t[ycoeff+i-1]) + } + + # Restore linear part of fit. +$if (datatype == r) + call gsrestore (sx1, Mem$t[xcoeff]) + call gsrestore (sy1, Mem$t[ycoeff]) +$else + call dgsrestore (sx1, Mem$t[xcoeff]) + call dgsrestore (sy1, Mem$t[ycoeff]) +$endif + + # Get geometric transformation. + xmag = clget$t ("xmag") + ymag = clget$t ("ymag") + xrot = clget$t ("xrotation") + yrot = clget$t ("yrotation") + xout = clget$t ("xout") + yout = clget$t ("yout") + xref = clget$t ("xref") + yref = clget$t ("yref") + xshift = clget$t ("xshift") + yshift = clget$t ("yshift") + + # Get set to adjust linear part of the fit. +$if (datatype == r) + call gscopy (sx1, newsx1) + call gscopy (sy1, newsy1) +$else + call dgscopy (sx1, newsx1) + call dgscopy (sy1, newsy1) +$endif + + if (geometry == GEO_DISTORTION) + call geo_rotmag$t (newsx1, newsy1, PIXEL(1.0), PIXEL(1.0), + PIXEL(0.0), PIXEL(0.0)) + else if (! IS_$INDEF$T(xmag) || ! IS_$INDEF$T(ymag) || + ! IS_$INDEF$T(xrot) || ! IS_$INDEF$T(yrot)) + call geo_drotmag$t (dt, rec, newsx1, newsy1, xmag, ymag, + xrot, yrot) + call geo_dxyshift$t (dt, rec, newsx1, newsy1, xout, yout, xref, yref, + xshift, yshift) +$if (datatype == r) + call gssave (newsx1, Mem$t[xcoeff]) + call gssave (newsy1, Mem$t[ycoeff]) +$else + call dgssave (newsx1, Mem$t[xcoeff]) + call dgssave (newsy1, Mem$t[ycoeff]) +$endif + + # Get distortion part of fit. + ncoeff = dtgeti (dt, rec, "surface2") + if (ncoeff > 0 && (geometry == GEO_GEOMETRIC || + geometry == GEO_DISTORTION)) { + + call realloc (xcoeff, ncoeff, TY_PIXEL) + call realloc (ycoeff, ncoeff, TY_PIXEL) + do i = 1, ncoeff { + junk = dtscan (dt) + call garg$t (Mem$t[xcoeff+i-1]) + call garg$t (Mem$t[ycoeff+i-1]) + } + + # Restore distortion part of fit. +$if (datatype == r) + iferr { + call gsrestore (sx2, Mem$t[xcoeff]) + } then { + call mfree (sx2, TY_STRUCT) + sx2 = NULL + } + iferr { + call gsrestore (sy2, Mem$t[ycoeff]) + } then { + call mfree (sy2, TY_STRUCT) + sy2 = NULL + } +$else + iferr { + call dgsrestore (sx2, Mem$t[xcoeff]) + } then { + call mfree (sx2, TY_STRUCT) + sx2 = NULL + } + iferr { + call dgsrestore (sy2, Mem$t[ycoeff]) + } then { + call mfree (sy2, TY_STRUCT) + sy2 = NULL + } +$endif + + } else { + sx2 = NULL + sy2 = NULL + } + + # Redefine the linear surfaces. +$if (datatype == r) + call gsfree (sx1) + call gscopy (newsx1, sx1) + call gsfree (newsx1) + call gsfree (sy1) + call gscopy (newsy1, sy1) + call gsfree (newsy1) +$else + call dgsfree (sx1) + call dgscopy (newsx1, sx1) + call dgsfree (newsx1) + call dgsfree (sy1) + call dgscopy (newsy1, sy1) + call dgsfree (newsy1) +$endif + + # Cleanup. + call mfree (xcoeff, TY_PIXEL) + call mfree (ycoeff, TY_PIXEL) +end + + +# GEO_DO_TRANSFORM -- The linear transformation is performed in this procedure. +# First the coordinates are scaled, then rotated and translated. The +# transformed coordinates are returned. + +procedure geo_do_transform$t (x, y, xt, yt, sx1, sy1, sx2, sy2) + +PIXEL x, y # initial positions +PIXEL xt, yt # transformed positions +pointer sx1, sy1 # pointer to linear surfaces +pointer sx2, sy2 # pointer to distortion surfaces + +$if (datatype == r) +real gseval() +$else +double dgseval() +$endif + +begin +$if (datatype == r) + xt = gseval (sx1, x, y) + if (sx2 != NULL) + xt = xt + gseval (sx2, x, y) + yt = gseval (sy1, x, y) + if (sy2 != NULL) + yt = yt + gseval (sy2, x, y) +$else + xt = dgseval (sx1, x, y) + if (sx2 != NULL) + xt = xt + dgseval (sx2, x, y) + yt = dgseval (sy1, x, y) + if (sy2 != NULL) + yt = yt + dgseval (sy2, x, y) +$endif +end + +$endfor diff --git a/pkg/images/immatch/src/geometry/geoxytran.x b/pkg/images/immatch/src/geometry/geoxytran.x new file mode 100644 index 00000000..e8bb9f64 --- /dev/null +++ b/pkg/images/immatch/src/geometry/geoxytran.x @@ -0,0 +1,446 @@ +include <ctype.h> +include <mach.h> +include <math.h> +include <math/gsurfit.h> + +define GEO_LINEAR 1 # Linear transformation only +define GEO_DISTORTION 2 # Distortion correction only +define GEO_GEOMETRIC 3 # Full transformation + + + +# GEO_LINIT -- Initialize the linear part of the transformation. + +procedure geo_linitr (sx1, sy1, sx2, sy2) + +pointer sx1, sy1 #I/O pointers to the linear x and y surfaces +pointer sx2, sy2 #I/O pointer to the distortion x and y surfaces + +real xmag, ymag, xrot, yrot, xref, yref, xout, yout, xshift, yshift +real clgetr(), gseval() + +begin + # Initialize the surfaces. + call gsinit (sx1, GS_POLYNOMIAL, 2, 2, GS_XNONE, -MAX_REAL, MAX_REAL, + -MAX_REAL, MAX_REAL) + call gsinit (sy1, GS_POLYNOMIAL, 2, 2, GS_XNONE, -MAX_REAL, MAX_REAL, + -MAX_REAL, MAX_REAL) + sx2 = NULL + sy2 = NULL + + # Get the magnification parameters. + xmag = clgetr ("xmag") + if (IS_INDEFR(xmag)) + xmag = real(1.0) + ymag = clgetr ("ymag") + if (IS_INDEFR(ymag)) + ymag = real(1.0) + + # Get the rotation parameters. + xrot = clgetr ("xrot") + if (IS_INDEFR(xrot)) + xrot = real(0.0) + xrot = -DEGTORAD(xrot) + yrot = clgetr ("yrot") + if (IS_INDEFR(yrot)) + yrot = real(0.0) + yrot = -DEGTORAD(yrot) + + # Set the magnification and rotation coefficients. + call geo_rotmagr (sx1, sy1, xmag, ymag, xrot, yrot) + + # Compute the origin of the reference coordinates. + xref = clgetr ("xref") + if (IS_INDEFR(xref)) + xref = real(0.0) + yref = clgetr ("yref") + if (IS_INDEFR(yref)) + yref = real(0.0) + + # Compute the corresponding input coordinates. + xout = clgetr ("xout") + if (IS_INDEFR(xout)) + xout = gseval (sx1, xref, yref) + yout = clgetr ("yout") + if (IS_INDEFR(yout)) + yout = gseval (sy1, xref, yref) + + # Set the shifts. + xshift = clgetr ("xshift") + yshift = clgetr ("yshift") + if (IS_INDEFR(xshift)) + xshift = xout - gseval (sx1, xref, yref) + if (IS_INDEFR(yshift)) + yshift = yout - gseval (sy1, xref, yref) + call geo_xyshiftr (sx1, sy1, xshift, yshift) +end + + +# GEO_SFREE -- Free the x and y surface fitting descriptors. + +procedure geo_sfreer (sx1, sy1, sx2, sy2) + +pointer sx1, sy1 #I/O pointers to the linear x and y surfaces +pointer sx2, sy2 #I/O pointer to the distortion x and y surfaces + +begin + call gsfree (sx1) + call gsfree (sy1) + if (sx2 != NULL) + call gsfree (sx2) + if (sy2 != NULL) + call gsfree (sy2) +end + + +# GEO_SINIT -- Read the surface fits from the database file and make +# any requested changes. + +procedure geo_sinitr (dt, record, geometry, sx1, sy1, sx2, sy2) + +pointer dt #I pointer to database file produced by geomap +char record[ARB] #I the name of the database record +int geometry #I the type of geometry to be computed +pointer sx1, sy1 #O pointers to the linear x and y surfaces +pointer sx2, sy2 #O pointers to the x and y distortion surfaces + +int i, rec, ncoeff, junk +real xmag, ymag, xrot, yrot, xref, yref, xout, yout, xshift, yshift +pointer newsx1, newsy1, xcoeff, ycoeff +int dtlocate(), dtscan(), dtgeti() +real clgetr() +errchk gsrestore + +begin + # Locate record. + rec = dtlocate (dt, record) + + # Get linear part of fit. + ncoeff = dtgeti (dt, rec, "surface1") + call malloc (xcoeff, ncoeff, TY_REAL) + call malloc (ycoeff, ncoeff, TY_REAL) + do i = 1, ncoeff { + junk = dtscan (dt) + call gargr (Memr[xcoeff+i-1]) + call gargr (Memr[ycoeff+i-1]) + } + + # Restore linear part of fit. + call gsrestore (sx1, Memr[xcoeff]) + call gsrestore (sy1, Memr[ycoeff]) + + # Get geometric transformation. + xmag = clgetr ("xmag") + ymag = clgetr ("ymag") + xrot = clgetr ("xrotation") + yrot = clgetr ("yrotation") + xout = clgetr ("xout") + yout = clgetr ("yout") + xref = clgetr ("xref") + yref = clgetr ("yref") + xshift = clgetr ("xshift") + yshift = clgetr ("yshift") + + # Get set to adjust linear part of the fit. + call gscopy (sx1, newsx1) + call gscopy (sy1, newsy1) + + if (geometry == GEO_DISTORTION) + call geo_rotmagr (newsx1, newsy1, real(1.0), real(1.0), + real(0.0), real(0.0)) + else if (! IS_INDEFR(xmag) || ! IS_INDEFR(ymag) || + ! IS_INDEFR(xrot) || ! IS_INDEFR(yrot)) + call geo_drotmagr (dt, rec, newsx1, newsy1, xmag, ymag, + xrot, yrot) + call geo_dxyshiftr (dt, rec, newsx1, newsy1, xout, yout, xref, yref, + xshift, yshift) + call gssave (newsx1, Memr[xcoeff]) + call gssave (newsy1, Memr[ycoeff]) + + # Get distortion part of fit. + ncoeff = dtgeti (dt, rec, "surface2") + if (ncoeff > 0 && (geometry == GEO_GEOMETRIC || + geometry == GEO_DISTORTION)) { + + call realloc (xcoeff, ncoeff, TY_REAL) + call realloc (ycoeff, ncoeff, TY_REAL) + do i = 1, ncoeff { + junk = dtscan (dt) + call gargr (Memr[xcoeff+i-1]) + call gargr (Memr[ycoeff+i-1]) + } + + # Restore distortion part of fit. + iferr { + call gsrestore (sx2, Memr[xcoeff]) + } then { + call mfree (sx2, TY_STRUCT) + sx2 = NULL + } + iferr { + call gsrestore (sy2, Memr[ycoeff]) + } then { + call mfree (sy2, TY_STRUCT) + sy2 = NULL + } + + } else { + sx2 = NULL + sy2 = NULL + } + + # Redefine the linear surfaces. + call gsfree (sx1) + call gscopy (newsx1, sx1) + call gsfree (newsx1) + call gsfree (sy1) + call gscopy (newsy1, sy1) + call gsfree (newsy1) + + # Cleanup. + call mfree (xcoeff, TY_REAL) + call mfree (ycoeff, TY_REAL) +end + + +# GEO_DO_TRANSFORM -- The linear transformation is performed in this procedure. +# First the coordinates are scaled, then rotated and translated. The +# transformed coordinates are returned. + +procedure geo_do_transformr (x, y, xt, yt, sx1, sy1, sx2, sy2) + +real x, y # initial positions +real xt, yt # transformed positions +pointer sx1, sy1 # pointer to linear surfaces +pointer sx2, sy2 # pointer to distortion surfaces + +real gseval() + +begin + xt = gseval (sx1, x, y) + if (sx2 != NULL) + xt = xt + gseval (sx2, x, y) + yt = gseval (sy1, x, y) + if (sy2 != NULL) + yt = yt + gseval (sy2, x, y) +end + + + +# GEO_LINIT -- Initialize the linear part of the transformation. + +procedure geo_linitd (sx1, sy1, sx2, sy2) + +pointer sx1, sy1 #I/O pointers to the linear x and y surfaces +pointer sx2, sy2 #I/O pointer to the distortion x and y surfaces + +double xmag, ymag, xrot, yrot, xref, yref, xout, yout, xshift, yshift +double clgetd(), dgseval() + +begin + # Initialize the surfaces. + call dgsinit (sx1, GS_POLYNOMIAL, 2, 2, GS_XNONE, double (-MAX_REAL), + double (MAX_REAL), double (-MAX_REAL), double (MAX_REAL)) + call dgsinit (sy1, GS_POLYNOMIAL, 2, 2, GS_XNONE, double (-MAX_REAL), + double (MAX_REAL), double (-MAX_REAL), double (MAX_REAL)) + sx2 = NULL + sy2 = NULL + + # Get the magnification parameters. + xmag = clgetd ("xmag") + if (IS_INDEFD(xmag)) + xmag = double(1.0) + ymag = clgetd ("ymag") + if (IS_INDEFD(ymag)) + ymag = double(1.0) + + # Get the rotation parameters. + xrot = clgetd ("xrot") + if (IS_INDEFD(xrot)) + xrot = double(0.0) + xrot = -DEGTORAD(xrot) + yrot = clgetd ("yrot") + if (IS_INDEFD(yrot)) + yrot = double(0.0) + yrot = -DEGTORAD(yrot) + + # Set the magnification and rotation coefficients. + call geo_rotmagd (sx1, sy1, xmag, ymag, xrot, yrot) + + # Compute the origin of the reference coordinates. + xref = clgetd ("xref") + if (IS_INDEFD(xref)) + xref = double(0.0) + yref = clgetd ("yref") + if (IS_INDEFD(yref)) + yref = double(0.0) + + # Compute the corresponding input coordinates. + xout = clgetd ("xout") + if (IS_INDEFD(xout)) + xout = dgseval (sx1, xref, yref) + yout = clgetd ("yout") + if (IS_INDEFD(yout)) + yout = dgseval (sy1, xref, yref) + + # Set the shifts. + xshift = clgetd ("xshift") + yshift = clgetd ("yshift") + if (IS_INDEFD(xshift)) + xshift = xout - dgseval (sx1, xref, yref) + if (IS_INDEFD(yshift)) + yshift = yout - dgseval (sy1, xref, yref) + call geo_xyshiftd (sx1, sy1, xshift, yshift) +end + + +# GEO_SFREE -- Free the x and y surface fitting descriptors. + +procedure geo_sfreed (sx1, sy1, sx2, sy2) + +pointer sx1, sy1 #I/O pointers to the linear x and y surfaces +pointer sx2, sy2 #I/O pointer to the distortion x and y surfaces + +begin + call dgsfree (sx1) + call dgsfree (sy1) + if (sx2 != NULL) + call dgsfree (sx2) + if (sy2 != NULL) + call dgsfree (sy2) +end + + +# GEO_SINIT -- Read the surface fits from the database file and make +# any requested changes. + +procedure geo_sinitd (dt, record, geometry, sx1, sy1, sx2, sy2) + +pointer dt #I pointer to database file produced by geomap +char record[ARB] #I the name of the database record +int geometry #I the type of geometry to be computed +pointer sx1, sy1 #O pointers to the linear x and y surfaces +pointer sx2, sy2 #O pointers to the x and y distortion surfaces + +int i, rec, ncoeff, junk +double xmag, ymag, xrot, yrot, xref, yref, xout, yout, xshift, yshift +pointer newsx1, newsy1, xcoeff, ycoeff +int dtlocate(), dtscan(), dtgeti() +double clgetd() +errchk dgsrestore + +begin + # Locate record. + rec = dtlocate (dt, record) + + # Get linear part of fit. + ncoeff = dtgeti (dt, rec, "surface1") + call malloc (xcoeff, ncoeff, TY_DOUBLE) + call malloc (ycoeff, ncoeff, TY_DOUBLE) + do i = 1, ncoeff { + junk = dtscan (dt) + call gargd (Memd[xcoeff+i-1]) + call gargd (Memd[ycoeff+i-1]) + } + + # Restore linear part of fit. + call dgsrestore (sx1, Memd[xcoeff]) + call dgsrestore (sy1, Memd[ycoeff]) + + # Get geometric transformation. + xmag = clgetd ("xmag") + ymag = clgetd ("ymag") + xrot = clgetd ("xrotation") + yrot = clgetd ("yrotation") + xout = clgetd ("xout") + yout = clgetd ("yout") + xref = clgetd ("xref") + yref = clgetd ("yref") + xshift = clgetd ("xshift") + yshift = clgetd ("yshift") + + # Get set to adjust linear part of the fit. + call dgscopy (sx1, newsx1) + call dgscopy (sy1, newsy1) + + if (geometry == GEO_DISTORTION) + call geo_rotmagd (newsx1, newsy1, double(1.0), double(1.0), + double(0.0), double(0.0)) + else if (! IS_INDEFD(xmag) || ! IS_INDEFD(ymag) || + ! IS_INDEFD(xrot) || ! IS_INDEFD(yrot)) + call geo_drotmagd (dt, rec, newsx1, newsy1, xmag, ymag, + xrot, yrot) + call geo_dxyshiftd (dt, rec, newsx1, newsy1, xout, yout, xref, yref, + xshift, yshift) + call dgssave (newsx1, Memd[xcoeff]) + call dgssave (newsy1, Memd[ycoeff]) + + # Get distortion part of fit. + ncoeff = dtgeti (dt, rec, "surface2") + if (ncoeff > 0 && (geometry == GEO_GEOMETRIC || + geometry == GEO_DISTORTION)) { + + call realloc (xcoeff, ncoeff, TY_DOUBLE) + call realloc (ycoeff, ncoeff, TY_DOUBLE) + do i = 1, ncoeff { + junk = dtscan (dt) + call gargd (Memd[xcoeff+i-1]) + call gargd (Memd[ycoeff+i-1]) + } + + # Restore distortion part of fit. + iferr { + call dgsrestore (sx2, Memd[xcoeff]) + } then { + call mfree (sx2, TY_STRUCT) + sx2 = NULL + } + iferr { + call dgsrestore (sy2, Memd[ycoeff]) + } then { + call mfree (sy2, TY_STRUCT) + sy2 = NULL + } + + } else { + sx2 = NULL + sy2 = NULL + } + + # Redefine the linear surfaces. + call dgsfree (sx1) + call dgscopy (newsx1, sx1) + call dgsfree (newsx1) + call dgsfree (sy1) + call dgscopy (newsy1, sy1) + call dgsfree (newsy1) + + # Cleanup. + call mfree (xcoeff, TY_DOUBLE) + call mfree (ycoeff, TY_DOUBLE) +end + + +# GEO_DO_TRANSFORM -- The linear transformation is performed in this procedure. +# First the coordinates are scaled, then rotated and translated. The +# transformed coordinates are returned. + +procedure geo_do_transformd (x, y, xt, yt, sx1, sy1, sx2, sy2) + +double x, y # initial positions +double xt, yt # transformed positions +pointer sx1, sy1 # pointer to linear surfaces +pointer sx2, sy2 # pointer to distortion surfaces + +double dgseval() + +begin + xt = dgseval (sx1, x, y) + if (sx2 != NULL) + xt = xt + dgseval (sx2, x, y) + yt = dgseval (sy1, x, y) + if (sy2 != NULL) + yt = yt + dgseval (sy2, x, y) +end + + diff --git a/pkg/images/immatch/src/geometry/mkpkg b/pkg/images/immatch/src/geometry/mkpkg new file mode 100644 index 00000000..e6e98b24 --- /dev/null +++ b/pkg/images/immatch/src/geometry/mkpkg @@ -0,0 +1,34 @@ +# Make the GEOMAP/GEOXYTRAN and CCMAP/CCSETWCS/CCTRAN tasks + +$checkout libpkg.a ../../../ +$update libpkg.a +$checkin libpkg.a ../../../ +$exit + +generic: + $set GEN = "$$generic -k" + + $ifolder (geofunc.x, geofunc.gx) + $(GEN) geofunc.gx -o geofunc.x $endif + $ifolder (t_geomap.x, t_geomap.gx) + $(GEN) t_geomap.gx -o t_geomap.x $endif + $ifolder (geoxytran.x,geoxytran.gx) + $(GEN) geoxytran.gx -o geoxytran.x $endif + ; + +libpkg.a: + $ifeq (USE_GENERIC, yes) $call generic $endif + + geofunc.x <math.h> <math/gsurfit.h> + geotimtran.x <imhdr.h> <imset.h> <mach.h> <math/gsurfit.h> \ + <math/iminterp.h> geotran.h + geotran.x <imhdr.h> <imset.h> <mach.h> <math/gsurfit.h> \ + <math/iminterp.h> geotran.h + geoxytran.x <mach.h> <ctype.h> <math.h> <math/gsurfit.h> + t_geomap.x <fset.h> <error.h> <mach.h> <math/gsurfit.h> \ + <math.h> "../../../lib/geomap.h" + t_geotran.x <imhdr.h> <mwset.h> <math.h> <math/gsurfit.h> \ + geotran.h + t_geoxytran.x <fset.h> <ctype.h> + trinvert.x + ; diff --git a/pkg/images/immatch/src/geometry/t_geomap.gx b/pkg/images/immatch/src/geometry/t_geomap.gx new file mode 100644 index 00000000..02d530e5 --- /dev/null +++ b/pkg/images/immatch/src/geometry/t_geomap.gx @@ -0,0 +1,921 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <fset.h> +include <error.h> +include <mach.h> +include <math.h> +include <math/gsurfit.h> +include "../../../lib/geomap.h" + +define GM_REAL 1 # computation type is real +define GM_DOUBLE 2 # computation type is double + +$for (r) + +# T_GEOMAP -- Procedure to calculate the transformation required to transform +# the coordinate system of a reference image to the coordinate system of +# an input image. The transformation is of the following form. +# +# xin = f (xref, yref) +# yin = g (xref, yref) + +procedure t_geomap () + +bool verbose, interactive +double xmin, xmax, ymin, ymax, reject +int geometry, function, calctype, nfiles, list, in, reclist, nrecords +int xxorder, xyorder, xxterms, yxorder, yyorder, yxterms, maxiter +int reslist, nresfiles, res +pointer sp, in_name, str, out, fit, gd, graphics +real rxmin, rxmax, rymin, rymax + +bool clgetb() +double clgetd() +int clgeti(), clgwrd(), clplen(), errget(), imtopenp(), imtlen() +int imtgetim() +pointer clpopnu(), clgfil(), dtmap(), gopen(), open() + +errchk geo_mapr(), geo_mapd() + +begin + # Get working space. + call smark (sp) + call salloc (in_name, SZ_FNAME, TY_CHAR) + call salloc (graphics, SZ_FNAME, TY_CHAR) + call salloc (str, max(SZ_LINE, SZ_FNAME), TY_CHAR) + + # Get input data file(s). + list = clpopnu ("input") + nfiles = clplen (list) + + # Open database output file. + call clgstr ("database", Memc[str], SZ_FNAME) + out = dtmap (Memc[str], APPEND) + + # Get minimum and maximum reference values. + xmin = clgetd ("xmin") + if (IS_INDEFD(xmin)) + rxmin = INDEFR + else + rxmin = xmin + xmax = clgetd ("xmax") + if (IS_INDEFD(xmax)) + rxmax = INDEFR + else + rxmax = xmax + ymin = clgetd ("ymin") + if (IS_INDEFD(ymin)) + rymin = INDEFR + else + rymin = ymin + ymax = clgetd ("ymax") + if (IS_INDEFD(ymax)) + rymax = INDEFR + else + rymax = ymax + + # Get the records list. + reclist = imtopenp ("transforms") + nrecords = imtlen (reclist) + if ((nrecords > 0) && (nrecords != nfiles)) { + call eprintf ( + "The number of records is not equal to the number of input files") + call clpcls (list) + call dtunmap (out) + call imtclose (reclist) + call sfree (sp) + return + } + + # Get the results file list. + reslist = clpopnu ("results") + nresfiles = clplen (reslist) + if (nresfiles > 1 && nresfiles != nfiles) { + call eprintf ("Error: there are too few results files\n") + call clpcls (list) + call dtunmap (out) + call imtclose (reclist) + call clpcls (reslist) + call sfree (sp) + return + } + + # Get the surface fitting parameters. + geometry = clgwrd ("fitgeometry", Memc[str], SZ_LINE, GM_GEOMETRIES) + function = clgwrd ("function", Memc[str], SZ_LINE, GM_FUNCS) + xxorder = clgeti ("xxorder") + xyorder = clgeti ("xyorder") + xxterms = clgwrd ("xxterms", Memc[str], SZ_LINE, GM_XFUNCS) - 1 + yxorder = clgeti ("yxorder") + yyorder = clgeti ("yyorder") + yxterms = clgwrd ("yxterms", Memc[str], SZ_LINE, GM_XFUNCS) - 1 + maxiter = clgeti ("maxiter") + reject = clgetd ("reject") + calctype = clgwrd ("calctype", Memc[str], SZ_LINE, ",real,double,") + + # Get the graphics parameters. + verbose = clgetb ("verbose") + interactive = clgetb ("interactive") + call clgstr ("graphics", Memc[graphics], SZ_FNAME) + + # Flush standard output on newline. + call fseti (STDOUT, F_FLUSHNL, YES) + + # Initialize the fit structure. + call geo_minit (fit, GM_NONE, geometry, function, xxorder, xyorder, + xxterms, yxorder, yyorder, yxterms, maxiter, reject) + + # Loop over the files. + while (clgfil (list, Memc[in_name], SZ_FNAME) != EOF) { + + # Open text file of coordinates. + in = open (Memc[in_name], READ_ONLY, TEXT_FILE) + + # Open the results files. + if (nresfiles <= 0) + res = NULL + else if (clgfil (reslist, Memc[str], SZ_FNAME) != EOF) + res = open (Memc[str], NEW_FILE, TEXT_FILE) + + # Set file name in structure. + if (nrecords > 0) { + if (imtgetim (reclist, GM_RECORD(fit), SZ_FNAME) != EOF) + ; + } else + call strcpy (Memc[in_name], GM_RECORD(fit), SZ_FNAME) + + if (verbose && res != STDOUT) { + call fstats (in, F_FILENAME, Memc[str], SZ_FNAME) + call printf ("\nCoordinate list: %s Transform: %s\n") + call pargstr (Memc[str]) + call pargstr (GM_RECORD(fit)) + if (res != NULL) + call fstats (res, F_FILENAME, Memc[str], SZ_FNAME) + else + call strcpy ("", Memc[str], SZ_FNAME) + call printf (" Results file: %s\n") + call pargstr (Memc[str]) + call flush (STDOUT) + } + if (res != NULL) { + call fstats (in, F_FILENAME, Memc[str], SZ_FNAME) + call fprintf (res, "\n# Coordinate list: %s Transform: %s\n") + call pargstr (Memc[str]) + call pargstr (GM_RECORD(fit)) + if (res != NULL) + call fstats (res, F_FILENAME, Memc[str], SZ_FNAME) + else + call strcpy ("", Memc[str], SZ_FNAME) + call fprintf (res, "# Results file: %s\n") + call pargstr (Memc[str]) + call flush (STDOUT) + } + + if (interactive) { + gd = gopen (Memc[graphics], NEW_FILE, STDGRAPH) + } else + gd = NULL + + iferr { + if (calctype == GM_REAL) + call geo_mapr (gd, in, out, res, fit, rxmin, rxmax, rymin, + rymax, verbose) + else + call geo_mapd (gd, in, out, res, fit, xmin, xmax, ymin, + ymax, verbose) + } then { + if (verbose && res != STDOUT) { + call printf ("Error fitting coordinate list: %s\n") + call pargstr (Memc[in_name]) + call flush (STDOUT) + if (errget (Memc[str], SZ_LINE) == 0) + ; + call printf ("\t%s\n") + call pargstr (Memc[str)) + } + if (res != NULL) { + call fprintf (res, "# Error fitting coordinate list: %s\n") + call pargstr (Memc[in_name]) + call flush (STDOUT) + if (errget (Memc[str], SZ_LINE) == 0) + ; + call fprintf (res, "# %s\n") + call pargstr (Memc[str)) + } + } + + call close (in) + if (nresfiles == nfiles) + call close ( res) + + if (gd != NULL) + call gclose (gd) + } + + # Close up. + call geo_free (fit) + if (nresfiles < nfiles) + call close ( res) + call dtunmap (out) + call imtclose (reclist) + call clpcls (list) + call sfree (sp) +end + +$endfor + +$for (rd) + +# GEO_MAP -- Procedure to calculate the coordinate transformations + +procedure geo_map$t (gd, in, out, res, fit, xmin, xmax, ymin, ymax, verbose) + +pointer gd #I the graphics stream +int in #I the input file descriptor +pointer out #I the output file descriptor +int res #I the results file descriptor +pointer fit #I pointer to fit parameters +PIXEL xmin, xmax #I max and min xref values +PIXEL ymin, ymax #I max and min yref values +bool verbose #I verbose mode + +int npts, ngood +pointer sp, str, xref, yref, xin, yin, wts, xfit, yfit, xerrmsg, yerrmsg +pointer sx1, sy1, sx2, sy2 +PIXEL mintemp, maxtemp + +PIXEL asum$t() +int geo_rdxy$t() +errchk geo_fit$t, geo_mgfit$t() + +begin + # Get working space. + call smark (sp) + call salloc (str, SZ_FNAME, TY_CHAR) + call salloc (xerrmsg, SZ_LINE, TY_CHAR) + call salloc (yerrmsg, SZ_LINE, TY_CHAR) + + # Initialize pointers. + xref = NULL + yref = NULL + xin = NULL + yin = NULL + wts = NULL + + # Read in data and check that data is in range. + npts = geo_rdxy$t (in, xref, yref, xin, yin, xmin, xmax, ymin, ymax) + if (npts <= 0) { + call fstats (in, F_FILENAME, Memc[str], SZ_FNAME) + call printf ("Coordinate list: %s has no data in range.\n") + call pargstr (Memc[str]) + call sfree (sp) + return + } + + # Compute the mean of the reference and input coordinates. + GM_XOREF(fit) = double (asum$t (Mem$t[xref], npts) / npts) + GM_YOREF(fit) = double (asum$t (Mem$t[yref], npts) / npts) + GM_XOIN(fit) = double (asum$t (Mem$t[xin], npts) / npts) + GM_YOIN(fit) = double (asum$t (Mem$t[yin], npts) / npts) + + # Set the reference point for the projections to INDEF. + GM_XREFPT(fit) = INDEFD + GM_YREFPT(fit) = INDEFD + + # Compute the weights. + call malloc (xfit, npts, TY_PIXEL) + call malloc (yfit, npts, TY_PIXEL) + call malloc (wts, npts, TY_PIXEL) + call amovk$t (PIXEL(1.), Mem$t[wts], npts) + + # Determine the x max and min. + if (IS_$INDEF$T(xmin) || IS_$INDEF$T(xmax)) { + call alim$t (Mem$t[xref], npts, mintemp, maxtemp) + if (! IS_$INDEF$T(xmin)) + GM_XMIN(fit) = double (xmin) + else + GM_XMIN(fit) = double (mintemp) + if (! IS_$INDEF$T(xmax)) + GM_XMAX(fit) = double (xmax) + else + GM_XMAX(fit) = double (maxtemp) + } else { + GM_XMIN(fit) = double (xmin) + GM_XMAX(fit) = double (xmax) + } + + # Determine the y max and min. + if (IS_$INDEF$T(ymin) || IS_$INDEF$T(ymax)) { + call alim$t (Mem$t[yref], npts, mintemp, maxtemp) + if (! IS_$INDEF$T(ymin)) + GM_YMIN(fit) = double (ymin) + else + GM_YMIN(fit) = double (mintemp) + if (! IS_$INDEF$T(ymax)) + GM_YMAX(fit) = double (ymax) + else + GM_YMAX(fit) = double (maxtemp) + } else { + GM_YMIN(fit) = double (ymin) + GM_YMAX(fit) = double (ymax) + } + + # Initalize surface pointers. + sx1 = NULL + sy1 = NULL + sx2 = NULL + sy2 = NULL + + # Fit the data. + if (gd != NULL) { + iferr { + call geo_mgfit$t (gd, fit, sx1, sy1, sx2, sy2, Mem$t[xref], + Mem$t[yref], Mem$t[xin], Mem$t[yin], Mem$t[wts], npts, + Memc[xerrmsg], Memc[yerrmsg], SZ_LINE) + } then { + call gdeactivate (gd, 0) + call mfree (xfit, TY_PIXEL) + call mfree (yfit, TY_PIXEL) + call mfree (wts, TY_PIXEL) + call geo_mmfree$t (sx1, sy1, sx2, sy2) + call sfree (sp) + call error (3, "Too few points for X or Y fits.") + } + call gdeactivate (gd, 0) + if (verbose && res != STDOUT) { + call printf ("Coordinate mapping status\n") + call flush (STDOUT) + } + if (res != NULL) { + call fprintf (res, "# Coordinate mapping status\n") + } + } else { + if (verbose && res != STDOUT) { + call printf ("Coordinate mapping status\n ") + call flush (STDOUT) + } + if (res != NULL) { + call fprintf (res, "# Coordinate mapping status\n# ") + } + iferr { + call geo_fit$t (fit, sx1, sy1, sx2, sy2, Mem$t[xref], + Mem$t[yref], Mem$t[xin], Mem$t[yin], Mem$t[wts], npts, + Memc[xerrmsg], Memc[yerrmsg], SZ_LINE) + } then { + call mfree (xfit, TY_PIXEL) + call mfree (yfit, TY_PIXEL) + call mfree (wts, TY_PIXEL) + call geo_mmfree$t (sx1, sy1, sx2, sy2) + call sfree (sp) + call error (3, "Too few points for X or Y fits.") + } + if (verbose && res != STDOUT) { + call printf ("%s %s\n") + call pargstr (Memc[xerrmsg]) + call pargstr (Memc[yerrmsg]) + call flush (STDOUT) + } + if (res != NULL) { + call fprintf (res, "%s %s\n") + call pargstr (Memc[xerrmsg]) + call pargstr (Memc[yerrmsg]) + call flush (STDOUT) + } + } + ngood = GM_NPTS(fit) - GM_NWTS0(fit) + if (verbose && res != STDOUT) { + call printf (" Xin and Yin fit rms: %0.7g %0.7g\n") + if (ngood <= 1) { + call pargd (0.0d0) + call pargd (0.0d0) + } else { + call pargd (sqrt (GM_XRMS(fit) / (ngood - 1))) + call pargd (sqrt (GM_YRMS(fit) / (ngood - 1))) + } + call geo_show$t (STDOUT, fit, sx1, sy1, NO) + } + if (res != NULL) { + call fprintf (res, "# Xin and Yin fit rms: %0.7g %0.7g\n") + if (ngood <= 1) { + call pargd (0.0) + call pargd (0.0) + } else { + call pargd (sqrt (GM_XRMS(fit) / (ngood - 1))) + call pargd (sqrt (GM_YRMS(fit) / (ngood - 1))) + } + call geo_show$t (res, fit, sx1, sy1, YES) + } + + # Compute and print the fitted x and y values. + if (res != NULL) { + call geo_eval$t (sx1, sy1, sx2, sy2, Mem$t[xref], Mem$t[yref], + Mem$t[xfit], Mem$t[yfit], npts) + call geo_plist$t (res, fit, Mem$t[xref], Mem$t[yref], Mem$t[xin], + Mem$t[yin], Mem$t[xfit], Mem$t[yfit], Mem$t[wts], npts) + } + + # Free the data + if (xref != NULL) + call mfree (xref, TY_PIXEL) + if (yref != NULL) + call mfree (yref, TY_PIXEL) + if (xin != NULL) + call mfree (xin, TY_PIXEL) + if (yin != NULL) + call mfree (yin, TY_PIXEL) + if (xfit != NULL) + call mfree (xfit, TY_PIXEL) + if (yfit != NULL) + call mfree (yfit, TY_PIXEL) + if (wts != NULL) + call mfree (wts, TY_PIXEL) + + # Output the data. + call geo_mout$t (fit, out, sx1, sy1, sx2, sy2) + + # Free the space and close files. + call geo_mmfree$t (sx1, sy1, sx2, sy2) + call sfree (sp) +end + + +define GEO_DEFBUFSIZE 1000 # default data buffer sizes + +# GEO_RDXY -- Read in the data points. + +int procedure geo_rdxy$t (fd, xref, yref, xin, yin, xmin, xmax, ymin, ymax) + +int fd # the input file descriptor +pointer xref # the x reference coordinates +pointer yref # the y reference coordinates +pointer xin # the x coordinates +pointer yin # the y coordinates +PIXEL xmin, xmax # the range of the x coordinates +PIXEL ymin, ymax # the range of the y coordinates + +int npts, bufsize +int fscan(), nscan() + +begin + bufsize = GEO_DEFBUFSIZE + call malloc (xref, bufsize, TY_PIXEL) + call malloc (yref, bufsize, TY_PIXEL) + call malloc (xin, bufsize, TY_PIXEL) + call malloc (yin, bufsize, TY_PIXEL) + + npts = 0 + while (fscan (fd) != EOF) { + + # Decode the data. + call garg$t (Mem$t[xref+npts]) + call garg$t (Mem$t[yref+npts]) + call garg$t (Mem$t[xin+npts]) + call garg$t (Mem$t[yin+npts]) + if (nscan() < 4) + next + + # Check the data limits. + if (! IS_$INDEF$T(xmin)) { + if (Mem$t[xref+npts] < xmin) + next + } + if (! IS_$INDEF$T(xmax)) { + if (Mem$t[xref+npts] > xmax) + next + } + if (! IS_$INDEF$T(ymin)) { + if (Mem$t[yref+npts] < ymin) + next + } + if (! IS_$INDEF$T(ymax)) { + if (Mem$t[yref+npts] > ymax) + next + } + + npts = npts + 1 + if (npts >= bufsize) { + bufsize = bufsize + GEO_DEFBUFSIZE + call realloc (xref, bufsize, TY_PIXEL) + call realloc (yref, bufsize, TY_PIXEL) + call realloc (xin, bufsize, TY_PIXEL) + call realloc (yin, bufsize, TY_PIXEL) + } + } + + if (npts <= 0) { + call mfree (xref, TY_PIXEL) + call mfree (yref, TY_PIXEL) + call mfree (xin, TY_PIXEL) + call mfree (yin, TY_PIXEL) + xref = NULL + yref = NULL + xin = NULL + yin = NULL + } else if (npts < bufsize) { + call realloc (xref, npts, TY_PIXEL) + call realloc (yref, npts, TY_PIXEL) + call realloc (xin, npts, TY_PIXEL) + call realloc (yin, npts, TY_PIXEL) + } + + return (npts) +end + + +# GEO_EVAL -- Evalute the fit. + +procedure geo_eval$t (sx1, sy1, sx2, sy2, xref, yref, xi, eta, npts) + +pointer sx1, sy1 #I pointer to linear surfaces +pointer sx2, sy2 #I pointer to higher order surfaces +PIXEL xref[ARB] #I the x reference coordinates +PIXEL yref[ARB] #I the y reference coordinates +PIXEL xi[ARB] #O the fitted xi coordinates +PIXEL eta[ARB] #O the fitted eta coordinates +int npts #I the number of points + +pointer sp, temp + +begin + call smark (sp) + call salloc (temp, npts, TY_PIXEL) + +$if (datatype == r) + call gsvector (sx1, xref, yref, xi, npts) +$else + call dgsvector (sx1, xref, yref, xi, npts) +$endif + if (sx2 != NULL) { +$if (datatype == r) + call gsvector (sx2, xref, yref, Mem$t[temp], npts) +$else + call dgsvector (sx2, xref, yref, Mem$t[temp], npts) +$endif + call aadd$t (Mem$t[temp], xi, xi, npts) + } +$if (datatype == r) + call gsvector (sy1, xref, yref, eta, npts) +$else + call dgsvector (sy1, xref, yref, eta, npts) +$endif + if (sy2 != NULL) { +$if (datatype == r) + call gsvector (sy2, xref, yref, Mem$t[temp], npts) +$else + call dgsvector (sy2, xref, yref, Mem$t[temp], npts) +$endif + + call aadd$t (Mem$t[temp], eta, eta, npts) + } + + call sfree (sp) +end + + +# GEO_MOUT -- Write the output database file. + +procedure geo_mout$t (fit, out, sx1, sy1, sx2, sy2) + +pointer fit #I pointer to fitting structure +int out #I pointer to database file +pointer sx1, sy1 #I pointer to linear surfaces +pointer sx2, sy2 #I pointer to distortion surfaces + +int i, npts, ncoeff +pointer sp, str, xcoeff, ycoeff +PIXEL xrms, yrms, xshift, yshift, xscale, yscale, xrot, yrot +$if (datatype == r) +int gsgeti() +$else +int dgsgeti() +$endif +int rg_wrdstr() + +begin + call smark (sp) + call salloc (str, SZ_FNAME, TY_CHAR) + + # Compute the x and y fit rms. + #npts = max (0, GM_NPTS(fit) - GM_NREJECT(fit) - GM_NWTS0(fit)) + npts = max (0, GM_NPTS(fit) - GM_NWTS0(fit)) + xrms = max (0.0d0, GM_XRMS(fit)) + yrms = max (0.0d0, GM_YRMS(fit)) + if (npts > 1) { + xrms = sqrt (xrms / (npts - 1)) + yrms = sqrt (yrms / (npts - 1)) + } else { + xrms = 0.0d0 + yrms = 0.0d0 + } + + # Print title. + call dtptime (out) + call dtput (out, "begin\t%s\n") + call pargstr (GM_RECORD(fit)) + + # Print the x and y mean values. + call dtput (out, "\txrefmean\t%g\n") + call pargd (GM_XOREF(fit)) + call dtput (out, "\tyrefmean\t%g\n") + call pargd (GM_YOREF(fit)) + call dtput (out, "\txmean\t\t%g\n") + call pargd (GM_XOIN(fit)) + call dtput (out, "\tymean\t\t%g\n") + call pargd (GM_YOIN(fit)) + + # Print some of the fitting parameters. + if (rg_wrdstr (GM_FIT(fit), Memc[str], SZ_FNAME, GM_GEOMETRIES) <= 0) + call strcpy ("general", Memc[str], SZ_FNAME) + call dtput (out, "\tgeometry\t%s\n") + call pargstr (Memc[str]) + if (rg_wrdstr (GM_FUNCTION(fit), Memc[str], SZ_FNAME, GM_FUNCS) <= 0) + call strcpy ("polynomial", Memc[str], SZ_FNAME) + call dtput (out, "\tfunction\t%s\n") + call pargstr (Memc[str]) + + # Output the geometric parameters. + call geo_lcoeff$t (sx1, sy1, xshift, yshift, xscale, yscale, xrot, yrot) + call dtput (out, "\txshift\t\t%g\n") + call parg$t (xshift) + call dtput (out, "\tyshift\t\t%g\n") + call parg$t (yshift) + call dtput (out, "\txmag\t\t%g\n") + call parg$t (xscale) + call dtput (out, "\tymag\t\t%g\n") + call parg$t (yscale) + call dtput (out, "\txrotation\t%g\n") + call parg$t (xrot) + call dtput (out, "\tyrotation\t%g\n") + call parg$t (yrot) + + # Out the rms values. + call dtput (out, "\txrms\t\t%g\n") + call parg$t (PIXEL(xrms)) + call dtput (out, "\tyrms\t\t%g\n") + call parg$t (PIXEL(yrms)) + + # Allocate memory for linear coefficients. +$if (datatype == r) + ncoeff = max (gsgeti (sx1, GSNSAVE), gsgeti (sy1, GSNSAVE)) +$else + ncoeff = max (dgsgeti (sx1, GSNSAVE), dgsgeti (sy1, GSNSAVE)) +$endif + call calloc (xcoeff, ncoeff, TY_PIXEL) + call calloc (ycoeff, ncoeff, TY_PIXEL) + + # Output the linear coefficients. +$if (datatype == r) + call gssave (sx1, Mem$t[xcoeff]) + call gssave (sy1, Mem$t[ycoeff]) +$else + call dgssave (sx1, Mem$t[xcoeff]) + call dgssave (sy1, Mem$t[ycoeff]) +$endif + call dtput (out, "\tsurface1\t%d\n") + call pargi (ncoeff) + do i = 1, ncoeff { + call dtput (out, "\t\t\t%g\t%g\n") + call parg$t (Mem$t[xcoeff+i-1]) + call parg$t (Mem$t[ycoeff+i-1]) + } + + call mfree (xcoeff, TY_PIXEL) + call mfree (ycoeff, TY_PIXEL) + + # Allocate memory for higer order coefficients. + if (sx2 == NULL) + ncoeff = 0 + else +$if (datatype == r) + ncoeff = gsgeti (sx2, GSNSAVE) +$else + ncoeff = dgsgeti (sx2, GSNSAVE) +$endif + if (sy2 == NULL) + ncoeff = max (0, ncoeff) + else +$if (datatype == r) + ncoeff = max (gsgeti (sy2, GSNSAVE), ncoeff) +$else + ncoeff = max (dgsgeti (sy2, GSNSAVE), ncoeff) +$endif + call calloc (xcoeff, ncoeff, TY_PIXEL) + call calloc (ycoeff, ncoeff, TY_PIXEL) + + # Save the coefficients. +$if (datatype == r) + call gssave (sx2, Mem$t[xcoeff]) + call gssave (sy2, Mem$t[ycoeff]) +$else + call dgssave (sx2, Mem$t[xcoeff]) + call dgssave (sy2, Mem$t[ycoeff]) +$endif + + # Output the coefficients. + call dtput (out, "\tsurface2\t%d\n") + call pargi (ncoeff) + do i = 1, ncoeff { + call dtput (out, "\t\t\t%g\t%g\n") + call parg$t (Mem$t[xcoeff+i-1]) + call parg$t (Mem$t[ycoeff+i-1]) + } + + # Cleanup. + call mfree (xcoeff, TY_PIXEL) + call mfree (ycoeff, TY_PIXEL) + call sfree (sp) +end + + +# GEO_PLIST -- Print the input, output, and fitted data and the residuals. + +procedure geo_plist$t (fd, fit, xref, yref, xin, yin, xfit, yfit, wts, npts) + +int fd #I the results file descriptor +pointer fit #I pointer to the fit structure +PIXEL xref[ARB] #I the input x coordinates +PIXEL yref[ARB] #I the input y coordinates +PIXEL xin[ARB] #I the input ra / longitude coordinates +PIXEL yin[ARB] #I the input dec / latitude coordinates +PIXEL xfit[ARB] #I the fitted ra / longitude coordinates +PIXEL yfit[ARB] #I the fitted dec / latitude coordinates +PIXEL wts[ARB] #I the weights array +int npts #I the number of data points + +int i, index +pointer sp, fmtstr, twts + +begin + # Allocate working space. + call smark (sp) + call salloc (fmtstr, SZ_LINE, TY_CHAR) + call salloc (twts, npts, TY_PIXEL) + + # Compute the weights. + call amov$t (wts, Mem$t[twts], npts) + do i = 1, GM_NREJECT(fit) { + index = Memi[GM_REJ(fit)+i-1] + if (wts[index] > PIXEL(0.0)) + Mem$t[twts+index-1] = PIXEL(0.0) + } + + # Print banner. + call fprintf (fd, "\n# Input Coordinate Listing\n") + call fprintf (fd, "# Column 1: X (reference) \n") + call fprintf (fd, "# Column 2: Y (reference)\n") + call fprintf (fd, "# Column 3: X (input)\n") + call fprintf (fd, "# Column 4: Y (input)\n") + call fprintf (fd, "# Column 5: X (fit)\n") + call fprintf (fd, "# Column 6: Y (fit)\n") + call fprintf (fd, "# Column 7: X (residual)\n") + call fprintf (fd, "# Column 8: Y (residual)\n\n") + + # Create the format string. + call sprintf (Memc[fmtstr], SZ_LINE, "%s %s %s %s %s %s %s %s\n") +$if (datatype == r) + call pargstr ("%9.7g") + call pargstr ("%9.7g") + call pargstr ("%9.7g") + call pargstr ("%9.7g") + call pargstr ("%9.7g") + call pargstr ("%9.7g") + call pargstr ("%9.7g") + call pargstr ("%9.7g") +$else + call pargstr ("%16.14g") + call pargstr ("%16.14g") + call pargstr ("%16.14g") + call pargstr ("%16.14g") + call pargstr ("%16.14g") + call pargstr ("%16.14g") + call pargstr ("%16.14g") + call pargstr ("%16.14g") +$endif + + # Print the data. + do i = 1, npts { + call fprintf (fd, Memc[fmtstr]) + call parg$t (xref[i]) + call parg$t (yref[i]) + call parg$t (xin[i]) + call parg$t (yin[i]) + if (Mem$t[twts+i-1] > 0.0d0) { + call parg$t (xfit[i]) + call parg$t (yfit[i]) + call parg$t (xin[i] - xfit[i]) + call parg$t (yin[i] - yfit[i]) + } else { + call parg$t (INDEF) + call parg$t (INDEF) + call parg$t (INDEF) + call parg$t (INDEF) + } + + } + + call fprintf (fd, "\n") + + call sfree (sp) + +end + +# GEO_SHOW -- Print the coordinate mapping parameters. + +procedure geo_show$t (fd, fit, sx1, sy1, comment) + +int fd #I the output file descriptor +pointer fit #I pointer to the fit structure +pointer sx1, sy1 #I pointer to linear surfaces +int comment #I comment the output ? + +PIXEL xshift, yshift, a, b, c, d +PIXEL xscale, yscale, xrot, yrot +pointer sp, str +bool fp_equal$t() + +begin + # Allocate temporary space. + call smark (sp) + call salloc (str, SZ_LINE, TY_CHAR) + + # Compute the geometric parameters. + call geo_gcoeff$t (sx1, sy1, xshift, yshift, a, b, c, d) + + if (comment == NO) { + call fprintf (fd, "Coordinate mapping parameters\n") + } else { + call fprintf (fd, "# Coordinate mapping parameters\n") + } + + if (comment == NO) { + call fprintf (fd, + " Mean Xref and Yref: %0.7g %0.7g\n") + call pargd (GM_XOREF(fit)) + call pargd (GM_YOREF(fit)) + call fprintf (fd, + " Mean Xin and Yin: %0.7g %0.7g\n") + call pargd (GM_XOIN(fit)) + call pargd (GM_YOIN(fit)) + call fprintf (fd, + " X and Y shift: %0.7g %0.7g (xin yin)\n") + call parg$t (xshift) + call parg$t (yshift) + } else { + call fprintf (fd, + "# Mean Xref and Yref: %0.7g %0.7g\n") + call pargd (GM_XOREF(fit)) + call pargd (GM_YOREF(fit)) + call fprintf (fd, + "# Mean Xin and Yin: %0.7g %g0.7\n") + call pargd (GM_XOIN(fit)) + call pargd (GM_YOIN(fit)) + call fprintf (fd, + "# X and Y shift: %0.7g %0.7g (xin yin)\n") + call parg$t (xshift) + call parg$t (yshift) + } + + # Output the scale factors. + xscale = sqrt (a * a + c * c) + yscale = sqrt (b * b + d * d) + if (comment == NO) { + call fprintf (fd, + " X and Y scale: %0.7g %0.7g (xin / xref yin / yref)\n") + call parg$t (xscale) + call parg$t (yscale) + } else { + call fprintf (fd, + "# X and Y scale: %0.7g %0.7g (xin / xref yin / yref)\n") + call parg$t (xscale) + call parg$t (yscale) + } + + # Output the rotation factors. + if (fp_equal$t (a, PIXEL(0.0)) && fp_equal$t (c, PIXEL(0.0))) + xrot = PIXEL(0.0) + else + xrot = RADTODEG (atan2 (-c, a)) + if (xrot < PIXEL(0.0)) + xrot = xrot + PIXEL(360.0) + if (fp_equal$t (b, PIXEL(0.0)) && fp_equal$t (d, PIXEL(0.0))) + yrot = PIXEL(0.0) + else + yrot = RADTODEG (atan2 (b, d)) + if (yrot < PIXEL(0.0)) + yrot = yrot + PIXEL(360.0) + if (comment == NO) { + call fprintf (fd, + " X and Y axis rotation: %0.5f %0.5f (degrees degrees)\n") + call parg$t (xrot) + call parg$t (yrot) + } else { + call fprintf (fd, + "# X and Y axis rotation: %0.5f %0.5f (degrees degrees)\n") + call parg$t (xrot) + call parg$t (yrot) + } + + call sfree (sp) +end + +$endfor diff --git a/pkg/images/immatch/src/geometry/t_geomap.x b/pkg/images/immatch/src/geometry/t_geomap.x new file mode 100644 index 00000000..6f1c20f0 --- /dev/null +++ b/pkg/images/immatch/src/geometry/t_geomap.x @@ -0,0 +1,1509 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <fset.h> +include <error.h> +include <mach.h> +include <math.h> +include <math/gsurfit.h> +include "../../../lib/geomap.h" + +define GM_REAL 1 # computation type is real +define GM_DOUBLE 2 # computation type is double + + + +# T_GEOMAP -- Procedure to calculate the transformation required to transform +# the coordinate system of a reference image to the coordinate system of +# an input image. The transformation is of the following form. +# +# xin = f (xref, yref) +# yin = g (xref, yref) + +procedure t_geomap () + +bool verbose, interactive +double xmin, xmax, ymin, ymax, reject +int geometry, function, calctype, nfiles, list, in, reclist, nrecords +int xxorder, xyorder, xxterms, yxorder, yyorder, yxterms, maxiter +int reslist, nresfiles, res +pointer sp, in_name, str, out, fit, gd, graphics +real rxmin, rxmax, rymin, rymax + +bool clgetb() +double clgetd() +int clgeti(), clgwrd(), clplen(), errget(), imtopenp(), imtlen() +int imtgetim() +pointer clpopnu(), clgfil(), dtmap(), gopen(), open() + +errchk geo_mapr(), geo_mapd() + +begin + # Get working space. + call smark (sp) + call salloc (in_name, SZ_FNAME, TY_CHAR) + call salloc (graphics, SZ_FNAME, TY_CHAR) + call salloc (str, max(SZ_LINE, SZ_FNAME), TY_CHAR) + + # Get input data file(s). + list = clpopnu ("input") + nfiles = clplen (list) + + # Open database output file. + call clgstr ("database", Memc[str], SZ_FNAME) + out = dtmap (Memc[str], APPEND) + + # Get minimum and maximum reference values. + xmin = clgetd ("xmin") + if (IS_INDEFD(xmin)) + rxmin = INDEFR + else + rxmin = xmin + xmax = clgetd ("xmax") + if (IS_INDEFD(xmax)) + rxmax = INDEFR + else + rxmax = xmax + ymin = clgetd ("ymin") + if (IS_INDEFD(ymin)) + rymin = INDEFR + else + rymin = ymin + ymax = clgetd ("ymax") + if (IS_INDEFD(ymax)) + rymax = INDEFR + else + rymax = ymax + + # Get the records list. + reclist = imtopenp ("transforms") + nrecords = imtlen (reclist) + if ((nrecords > 0) && (nrecords != nfiles)) { + call eprintf ( + "The number of records is not equal to the number of input files") + call clpcls (list) + call dtunmap (out) + call imtclose (reclist) + call sfree (sp) + return + } + + # Get the results file list. + reslist = clpopnu ("results") + nresfiles = clplen (reslist) + if (nresfiles > 1 && nresfiles != nfiles) { + call eprintf ("Error: there are too few results files\n") + call clpcls (list) + call dtunmap (out) + call imtclose (reclist) + call clpcls (reslist) + call sfree (sp) + return + } + + # Get the surface fitting parameters. + geometry = clgwrd ("fitgeometry", Memc[str], SZ_LINE, GM_GEOMETRIES) + function = clgwrd ("function", Memc[str], SZ_LINE, GM_FUNCS) + xxorder = clgeti ("xxorder") + xyorder = clgeti ("xyorder") + xxterms = clgwrd ("xxterms", Memc[str], SZ_LINE, GM_XFUNCS) - 1 + yxorder = clgeti ("yxorder") + yyorder = clgeti ("yyorder") + yxterms = clgwrd ("yxterms", Memc[str], SZ_LINE, GM_XFUNCS) - 1 + maxiter = clgeti ("maxiter") + reject = clgetd ("reject") + calctype = clgwrd ("calctype", Memc[str], SZ_LINE, ",real,double,") + + # Get the graphics parameters. + verbose = clgetb ("verbose") + interactive = clgetb ("interactive") + call clgstr ("graphics", Memc[graphics], SZ_FNAME) + + # Flush standard output on newline. + call fseti (STDOUT, F_FLUSHNL, YES) + + # Initialize the fit structure. + call geo_minit (fit, GM_NONE, geometry, function, xxorder, xyorder, + xxterms, yxorder, yyorder, yxterms, maxiter, reject) + + # Loop over the files. + while (clgfil (list, Memc[in_name], SZ_FNAME) != EOF) { + + # Open text file of coordinates. + in = open (Memc[in_name], READ_ONLY, TEXT_FILE) + + # Open the results files. + if (nresfiles <= 0) + res = NULL + else if (clgfil (reslist, Memc[str], SZ_FNAME) != EOF) + res = open (Memc[str], NEW_FILE, TEXT_FILE) + + # Set file name in structure. + if (nrecords > 0) { + if (imtgetim (reclist, GM_RECORD(fit), SZ_FNAME) != EOF) + ; + } else + call strcpy (Memc[in_name], GM_RECORD(fit), SZ_FNAME) + + if (verbose && res != STDOUT) { + call fstats (in, F_FILENAME, Memc[str], SZ_FNAME) + call printf ("\nCoordinate list: %s Transform: %s\n") + call pargstr (Memc[str]) + call pargstr (GM_RECORD(fit)) + if (res != NULL) + call fstats (res, F_FILENAME, Memc[str], SZ_FNAME) + else + call strcpy ("", Memc[str], SZ_FNAME) + call printf (" Results file: %s\n") + call pargstr (Memc[str]) + call flush (STDOUT) + } + if (res != NULL) { + call fstats (in, F_FILENAME, Memc[str], SZ_FNAME) + call fprintf (res, "\n# Coordinate list: %s Transform: %s\n") + call pargstr (Memc[str]) + call pargstr (GM_RECORD(fit)) + if (res != NULL) + call fstats (res, F_FILENAME, Memc[str], SZ_FNAME) + else + call strcpy ("", Memc[str], SZ_FNAME) + call fprintf (res, "# Results file: %s\n") + call pargstr (Memc[str]) + call flush (STDOUT) + } + + if (interactive) { + gd = gopen (Memc[graphics], NEW_FILE, STDGRAPH) + } else + gd = NULL + + iferr { + if (calctype == GM_REAL) + call geo_mapr (gd, in, out, res, fit, rxmin, rxmax, rymin, + rymax, verbose) + else + call geo_mapd (gd, in, out, res, fit, xmin, xmax, ymin, + ymax, verbose) + } then { + if (verbose && res != STDOUT) { + call printf ("Error fitting coordinate list: %s\n") + call pargstr (Memc[in_name]) + call flush (STDOUT) + if (errget (Memc[str], SZ_LINE) == 0) + ; + call printf ("\t%s\n") + call pargstr (Memc[str)) + } + if (res != NULL) { + call fprintf (res, "# Error fitting coordinate list: %s\n") + call pargstr (Memc[in_name]) + call flush (STDOUT) + if (errget (Memc[str], SZ_LINE) == 0) + ; + call fprintf (res, "# %s\n") + call pargstr (Memc[str)) + } + } + + call close (in) + if (nresfiles == nfiles) + call close ( res) + + if (gd != NULL) + call gclose (gd) + } + + # Close up. + call geo_free (fit) + if (nresfiles < nfiles) + call close ( res) + call dtunmap (out) + call imtclose (reclist) + call clpcls (list) + call sfree (sp) +end + + + + + +# GEO_MAP -- Procedure to calculate the coordinate transformations + +procedure geo_mapr (gd, in, out, res, fit, xmin, xmax, ymin, ymax, verbose) + +pointer gd #I the graphics stream +int in #I the input file descriptor +pointer out #I the output file descriptor +int res #I the results file descriptor +pointer fit #I pointer to fit parameters +real xmin, xmax #I max and min xref values +real ymin, ymax #I max and min yref values +bool verbose #I verbose mode + +int npts, ngood +pointer sp, str, xref, yref, xin, yin, wts, xfit, yfit, xerrmsg, yerrmsg +pointer sx1, sy1, sx2, sy2 +real mintemp, maxtemp + +real asumr() +int geo_rdxyr() +errchk geo_fitr, geo_mgfitr() + +begin + # Get working space. + call smark (sp) + call salloc (str, SZ_FNAME, TY_CHAR) + call salloc (xerrmsg, SZ_LINE, TY_CHAR) + call salloc (yerrmsg, SZ_LINE, TY_CHAR) + + # Initialize pointers. + xref = NULL + yref = NULL + xin = NULL + yin = NULL + wts = NULL + + # Read in data and check that data is in range. + npts = geo_rdxyr (in, xref, yref, xin, yin, xmin, xmax, ymin, ymax) + if (npts <= 0) { + call fstats (in, F_FILENAME, Memc[str], SZ_FNAME) + call printf ("Coordinate list: %s has no data in range.\n") + call pargstr (Memc[str]) + call sfree (sp) + return + } + + # Compute the mean of the reference and input coordinates. + GM_XOREF(fit) = double (asumr (Memr[xref], npts) / npts) + GM_YOREF(fit) = double (asumr (Memr[yref], npts) / npts) + GM_XOIN(fit) = double (asumr (Memr[xin], npts) / npts) + GM_YOIN(fit) = double (asumr (Memr[yin], npts) / npts) + + # Set the reference point for the projections to INDEF. + GM_XREFPT(fit) = INDEFD + GM_YREFPT(fit) = INDEFD + + # Compute the weights. + call malloc (xfit, npts, TY_REAL) + call malloc (yfit, npts, TY_REAL) + call malloc (wts, npts, TY_REAL) + call amovkr (real(1.), Memr[wts], npts) + + # Determine the x max and min. + if (IS_INDEFR(xmin) || IS_INDEFR(xmax)) { + call alimr (Memr[xref], npts, mintemp, maxtemp) + if (! IS_INDEFR(xmin)) + GM_XMIN(fit) = double (xmin) + else + GM_XMIN(fit) = double (mintemp) + if (! IS_INDEFR(xmax)) + GM_XMAX(fit) = double (xmax) + else + GM_XMAX(fit) = double (maxtemp) + } else { + GM_XMIN(fit) = double (xmin) + GM_XMAX(fit) = double (xmax) + } + + # Determine the y max and min. + if (IS_INDEFR(ymin) || IS_INDEFR(ymax)) { + call alimr (Memr[yref], npts, mintemp, maxtemp) + if (! IS_INDEFR(ymin)) + GM_YMIN(fit) = double (ymin) + else + GM_YMIN(fit) = double (mintemp) + if (! IS_INDEFR(ymax)) + GM_YMAX(fit) = double (ymax) + else + GM_YMAX(fit) = double (maxtemp) + } else { + GM_YMIN(fit) = double (ymin) + GM_YMAX(fit) = double (ymax) + } + + # Initalize surface pointers. + sx1 = NULL + sy1 = NULL + sx2 = NULL + sy2 = NULL + + # Fit the data. + if (gd != NULL) { + iferr { + call geo_mgfitr (gd, fit, sx1, sy1, sx2, sy2, Memr[xref], + Memr[yref], Memr[xin], Memr[yin], Memr[wts], npts, + Memc[xerrmsg], Memc[yerrmsg], SZ_LINE) + } then { + call gdeactivate (gd, 0) + call mfree (xfit, TY_REAL) + call mfree (yfit, TY_REAL) + call mfree (wts, TY_REAL) + call geo_mmfreer (sx1, sy1, sx2, sy2) + call sfree (sp) + call error (3, "Too few points for X or Y fits.") + } + call gdeactivate (gd, 0) + if (verbose && res != STDOUT) { + call printf ("Coordinate mapping status\n") + call flush (STDOUT) + } + if (res != NULL) { + call fprintf (res, "# Coordinate mapping status\n") + } + } else { + if (verbose && res != STDOUT) { + call printf ("Coordinate mapping status\n ") + call flush (STDOUT) + } + if (res != NULL) { + call fprintf (res, "# Coordinate mapping status\n# ") + } + iferr { + call geo_fitr (fit, sx1, sy1, sx2, sy2, Memr[xref], + Memr[yref], Memr[xin], Memr[yin], Memr[wts], npts, + Memc[xerrmsg], Memc[yerrmsg], SZ_LINE) + } then { + call mfree (xfit, TY_REAL) + call mfree (yfit, TY_REAL) + call mfree (wts, TY_REAL) + call geo_mmfreer (sx1, sy1, sx2, sy2) + call sfree (sp) + call error (3, "Too few points for X or Y fits.") + } + if (verbose && res != STDOUT) { + call printf ("%s %s\n") + call pargstr (Memc[xerrmsg]) + call pargstr (Memc[yerrmsg]) + call flush (STDOUT) + } + if (res != NULL) { + call fprintf (res, "%s %s\n") + call pargstr (Memc[xerrmsg]) + call pargstr (Memc[yerrmsg]) + call flush (STDOUT) + } + } + ngood = GM_NPTS(fit) - GM_NWTS0(fit) + if (verbose && res != STDOUT) { + call printf (" Xin and Yin fit rms: %0.7g %0.7g\n") + if (ngood <= 1) { + call pargd (0.0d0) + call pargd (0.0d0) + } else { + call pargd (sqrt (GM_XRMS(fit) / (ngood - 1))) + call pargd (sqrt (GM_YRMS(fit) / (ngood - 1))) + } + call geo_showr (STDOUT, fit, sx1, sy1, NO) + } + if (res != NULL) { + call fprintf (res, "# Xin and Yin fit rms: %0.7g %0.7g\n") + if (ngood <= 1) { + call pargd (0.0) + call pargd (0.0) + } else { + call pargd (sqrt (GM_XRMS(fit) / (ngood - 1))) + call pargd (sqrt (GM_YRMS(fit) / (ngood - 1))) + } + call geo_showr (res, fit, sx1, sy1, YES) + } + + # Compute and print the fitted x and y values. + if (res != NULL) { + call geo_evalr (sx1, sy1, sx2, sy2, Memr[xref], Memr[yref], + Memr[xfit], Memr[yfit], npts) + call geo_plistr (res, fit, Memr[xref], Memr[yref], Memr[xin], + Memr[yin], Memr[xfit], Memr[yfit], Memr[wts], npts) + } + + # Free the data + if (xref != NULL) + call mfree (xref, TY_REAL) + if (yref != NULL) + call mfree (yref, TY_REAL) + if (xin != NULL) + call mfree (xin, TY_REAL) + if (yin != NULL) + call mfree (yin, TY_REAL) + if (xfit != NULL) + call mfree (xfit, TY_REAL) + if (yfit != NULL) + call mfree (yfit, TY_REAL) + if (wts != NULL) + call mfree (wts, TY_REAL) + + # Output the data. + call geo_moutr (fit, out, sx1, sy1, sx2, sy2) + + # Free the space and close files. + call geo_mmfreer (sx1, sy1, sx2, sy2) + call sfree (sp) +end + + +define GEO_DEFBUFSIZE 1000 # default data buffer sizes + +# GEO_RDXY -- Read in the data points. + +int procedure geo_rdxyr (fd, xref, yref, xin, yin, xmin, xmax, ymin, ymax) + +int fd # the input file descriptor +pointer xref # the x reference coordinates +pointer yref # the y reference coordinates +pointer xin # the x coordinates +pointer yin # the y coordinates +real xmin, xmax # the range of the x coordinates +real ymin, ymax # the range of the y coordinates + +int npts, bufsize +int fscan(), nscan() + +begin + bufsize = GEO_DEFBUFSIZE + call malloc (xref, bufsize, TY_REAL) + call malloc (yref, bufsize, TY_REAL) + call malloc (xin, bufsize, TY_REAL) + call malloc (yin, bufsize, TY_REAL) + + npts = 0 + while (fscan (fd) != EOF) { + + # Decode the data. + call gargr (Memr[xref+npts]) + call gargr (Memr[yref+npts]) + call gargr (Memr[xin+npts]) + call gargr (Memr[yin+npts]) + if (nscan() < 4) + next + + # Check the data limits. + if (! IS_INDEFR(xmin)) { + if (Memr[xref+npts] < xmin) + next + } + if (! IS_INDEFR(xmax)) { + if (Memr[xref+npts] > xmax) + next + } + if (! IS_INDEFR(ymin)) { + if (Memr[yref+npts] < ymin) + next + } + if (! IS_INDEFR(ymax)) { + if (Memr[yref+npts] > ymax) + next + } + + npts = npts + 1 + if (npts >= bufsize) { + bufsize = bufsize + GEO_DEFBUFSIZE + call realloc (xref, bufsize, TY_REAL) + call realloc (yref, bufsize, TY_REAL) + call realloc (xin, bufsize, TY_REAL) + call realloc (yin, bufsize, TY_REAL) + } + } + + if (npts <= 0) { + call mfree (xref, TY_REAL) + call mfree (yref, TY_REAL) + call mfree (xin, TY_REAL) + call mfree (yin, TY_REAL) + xref = NULL + yref = NULL + xin = NULL + yin = NULL + } else if (npts < bufsize) { + call realloc (xref, npts, TY_REAL) + call realloc (yref, npts, TY_REAL) + call realloc (xin, npts, TY_REAL) + call realloc (yin, npts, TY_REAL) + } + + return (npts) +end + + +# GEO_EVAL -- Evalute the fit. + +procedure geo_evalr (sx1, sy1, sx2, sy2, xref, yref, xi, eta, npts) + +pointer sx1, sy1 #I pointer to linear surfaces +pointer sx2, sy2 #I pointer to higher order surfaces +real xref[ARB] #I the x reference coordinates +real yref[ARB] #I the y reference coordinates +real xi[ARB] #O the fitted xi coordinates +real eta[ARB] #O the fitted eta coordinates +int npts #I the number of points + +pointer sp, temp + +begin + call smark (sp) + call salloc (temp, npts, TY_REAL) + + call gsvector (sx1, xref, yref, xi, npts) + if (sx2 != NULL) { + call gsvector (sx2, xref, yref, Memr[temp], npts) + call aaddr (Memr[temp], xi, xi, npts) + } + call gsvector (sy1, xref, yref, eta, npts) + if (sy2 != NULL) { + call gsvector (sy2, xref, yref, Memr[temp], npts) + + call aaddr (Memr[temp], eta, eta, npts) + } + + call sfree (sp) +end + + +# GEO_MOUT -- Write the output database file. + +procedure geo_moutr (fit, out, sx1, sy1, sx2, sy2) + +pointer fit #I pointer to fitting structure +int out #I pointer to database file +pointer sx1, sy1 #I pointer to linear surfaces +pointer sx2, sy2 #I pointer to distortion surfaces + +int i, npts, ncoeff +pointer sp, str, xcoeff, ycoeff +real xrms, yrms, xshift, yshift, xscale, yscale, xrot, yrot +int gsgeti() +int rg_wrdstr() + +begin + call smark (sp) + call salloc (str, SZ_FNAME, TY_CHAR) + + # Compute the x and y fit rms. + #npts = max (0, GM_NPTS(fit) - GM_NREJECT(fit) - GM_NWTS0(fit)) + npts = max (0, GM_NPTS(fit) - GM_NWTS0(fit)) + xrms = max (0.0d0, GM_XRMS(fit)) + yrms = max (0.0d0, GM_YRMS(fit)) + if (npts > 1) { + xrms = sqrt (xrms / (npts - 1)) + yrms = sqrt (yrms / (npts - 1)) + } else { + xrms = 0.0d0 + yrms = 0.0d0 + } + + # Print title. + call dtptime (out) + call dtput (out, "begin\t%s\n") + call pargstr (GM_RECORD(fit)) + + # Print the x and y mean values. + call dtput (out, "\txrefmean\t%g\n") + call pargd (GM_XOREF(fit)) + call dtput (out, "\tyrefmean\t%g\n") + call pargd (GM_YOREF(fit)) + call dtput (out, "\txmean\t\t%g\n") + call pargd (GM_XOIN(fit)) + call dtput (out, "\tymean\t\t%g\n") + call pargd (GM_YOIN(fit)) + + # Print some of the fitting parameters. + if (rg_wrdstr (GM_FIT(fit), Memc[str], SZ_FNAME, GM_GEOMETRIES) <= 0) + call strcpy ("general", Memc[str], SZ_FNAME) + call dtput (out, "\tgeometry\t%s\n") + call pargstr (Memc[str]) + if (rg_wrdstr (GM_FUNCTION(fit), Memc[str], SZ_FNAME, GM_FUNCS) <= 0) + call strcpy ("polynomial", Memc[str], SZ_FNAME) + call dtput (out, "\tfunction\t%s\n") + call pargstr (Memc[str]) + + # Output the geometric parameters. + call geo_lcoeffr (sx1, sy1, xshift, yshift, xscale, yscale, xrot, yrot) + call dtput (out, "\txshift\t\t%g\n") + call pargr (xshift) + call dtput (out, "\tyshift\t\t%g\n") + call pargr (yshift) + call dtput (out, "\txmag\t\t%g\n") + call pargr (xscale) + call dtput (out, "\tymag\t\t%g\n") + call pargr (yscale) + call dtput (out, "\txrotation\t%g\n") + call pargr (xrot) + call dtput (out, "\tyrotation\t%g\n") + call pargr (yrot) + + # Out the rms values. + call dtput (out, "\txrms\t\t%g\n") + call pargr (real(xrms)) + call dtput (out, "\tyrms\t\t%g\n") + call pargr (real(yrms)) + + # Allocate memory for linear coefficients. + ncoeff = max (gsgeti (sx1, GSNSAVE), gsgeti (sy1, GSNSAVE)) + call calloc (xcoeff, ncoeff, TY_REAL) + call calloc (ycoeff, ncoeff, TY_REAL) + + # Output the linear coefficients. + call gssave (sx1, Memr[xcoeff]) + call gssave (sy1, Memr[ycoeff]) + call dtput (out, "\tsurface1\t%d\n") + call pargi (ncoeff) + do i = 1, ncoeff { + call dtput (out, "\t\t\t%g\t%g\n") + call pargr (Memr[xcoeff+i-1]) + call pargr (Memr[ycoeff+i-1]) + } + + call mfree (xcoeff, TY_REAL) + call mfree (ycoeff, TY_REAL) + + # Allocate memory for higer order coefficients. + if (sx2 == NULL) + ncoeff = 0 + else + ncoeff = gsgeti (sx2, GSNSAVE) + if (sy2 == NULL) + ncoeff = max (0, ncoeff) + else + ncoeff = max (gsgeti (sy2, GSNSAVE), ncoeff) + call calloc (xcoeff, ncoeff, TY_REAL) + call calloc (ycoeff, ncoeff, TY_REAL) + + # Save the coefficients. + call gssave (sx2, Memr[xcoeff]) + call gssave (sy2, Memr[ycoeff]) + + # Output the coefficients. + call dtput (out, "\tsurface2\t%d\n") + call pargi (ncoeff) + do i = 1, ncoeff { + call dtput (out, "\t\t\t%g\t%g\n") + call pargr (Memr[xcoeff+i-1]) + call pargr (Memr[ycoeff+i-1]) + } + + # Cleanup. + call mfree (xcoeff, TY_REAL) + call mfree (ycoeff, TY_REAL) + call sfree (sp) +end + + +# GEO_PLIST -- Print the input, output, and fitted data and the residuals. + +procedure geo_plistr (fd, fit, xref, yref, xin, yin, xfit, yfit, wts, npts) + +int fd #I the results file descriptor +pointer fit #I pointer to the fit structure +real xref[ARB] #I the input x coordinates +real yref[ARB] #I the input y coordinates +real xin[ARB] #I the input ra / longitude coordinates +real yin[ARB] #I the input dec / latitude coordinates +real xfit[ARB] #I the fitted ra / longitude coordinates +real yfit[ARB] #I the fitted dec / latitude coordinates +real wts[ARB] #I the weights array +int npts #I the number of data points + +int i, index +pointer sp, fmtstr, twts + +begin + # Allocate working space. + call smark (sp) + call salloc (fmtstr, SZ_LINE, TY_CHAR) + call salloc (twts, npts, TY_REAL) + + # Compute the weights. + call amovr (wts, Memr[twts], npts) + do i = 1, GM_NREJECT(fit) { + index = Memi[GM_REJ(fit)+i-1] + if (wts[index] > real(0.0)) + Memr[twts+index-1] = real(0.0) + } + + # Print banner. + call fprintf (fd, "\n# Input Coordinate Listing\n") + call fprintf (fd, "# Column 1: X (reference) \n") + call fprintf (fd, "# Column 2: Y (reference)\n") + call fprintf (fd, "# Column 3: X (input)\n") + call fprintf (fd, "# Column 4: Y (input)\n") + call fprintf (fd, "# Column 5: X (fit)\n") + call fprintf (fd, "# Column 6: Y (fit)\n") + call fprintf (fd, "# Column 7: X (residual)\n") + call fprintf (fd, "# Column 8: Y (residual)\n\n") + + # Create the format string. + call sprintf (Memc[fmtstr], SZ_LINE, "%s %s %s %s %s %s %s %s\n") + call pargstr ("%9.7g") + call pargstr ("%9.7g") + call pargstr ("%9.7g") + call pargstr ("%9.7g") + call pargstr ("%9.7g") + call pargstr ("%9.7g") + call pargstr ("%9.7g") + call pargstr ("%9.7g") + + # Print the data. + do i = 1, npts { + call fprintf (fd, Memc[fmtstr]) + call pargr (xref[i]) + call pargr (yref[i]) + call pargr (xin[i]) + call pargr (yin[i]) + if (Memr[twts+i-1] > 0.0d0) { + call pargr (xfit[i]) + call pargr (yfit[i]) + call pargr (xin[i] - xfit[i]) + call pargr (yin[i] - yfit[i]) + } else { + call pargr (INDEFR) + call pargr (INDEFR) + call pargr (INDEFR) + call pargr (INDEFR) + } + + } + + call fprintf (fd, "\n") + + call sfree (sp) + +end + +# GEO_SHOW -- Print the coordinate mapping parameters. + +procedure geo_showr (fd, fit, sx1, sy1, comment) + +int fd #I the output file descriptor +pointer fit #I pointer to the fit structure +pointer sx1, sy1 #I pointer to linear surfaces +int comment #I comment the output ? + +real xshift, yshift, a, b, c, d +real xscale, yscale, xrot, yrot +pointer sp, str +bool fp_equalr() + +begin + # Allocate temporary space. + call smark (sp) + call salloc (str, SZ_LINE, TY_CHAR) + + # Compute the geometric parameters. + call geo_gcoeffr (sx1, sy1, xshift, yshift, a, b, c, d) + + if (comment == NO) { + call fprintf (fd, "Coordinate mapping parameters\n") + } else { + call fprintf (fd, "# Coordinate mapping parameters\n") + } + + if (comment == NO) { + call fprintf (fd, + " Mean Xref and Yref: %0.7g %0.7g\n") + call pargd (GM_XOREF(fit)) + call pargd (GM_YOREF(fit)) + call fprintf (fd, + " Mean Xin and Yin: %0.7g %0.7g\n") + call pargd (GM_XOIN(fit)) + call pargd (GM_YOIN(fit)) + call fprintf (fd, + " X and Y shift: %0.7g %0.7g (xin yin)\n") + call pargr (xshift) + call pargr (yshift) + } else { + call fprintf (fd, + "# Mean Xref and Yref: %0.7g %0.7g\n") + call pargd (GM_XOREF(fit)) + call pargd (GM_YOREF(fit)) + call fprintf (fd, + "# Mean Xin and Yin: %0.7g %g0.7\n") + call pargd (GM_XOIN(fit)) + call pargd (GM_YOIN(fit)) + call fprintf (fd, + "# X and Y shift: %0.7g %0.7g (xin yin)\n") + call pargr (xshift) + call pargr (yshift) + } + + # Output the scale factors. + xscale = sqrt (a * a + c * c) + yscale = sqrt (b * b + d * d) + if (comment == NO) { + call fprintf (fd, + " X and Y scale: %0.7g %0.7g (xin / xref yin / yref)\n") + call pargr (xscale) + call pargr (yscale) + } else { + call fprintf (fd, + "# X and Y scale: %0.7g %0.7g (xin / xref yin / yref)\n") + call pargr (xscale) + call pargr (yscale) + } + + # Output the rotation factors. + if (fp_equalr (a, real(0.0)) && fp_equalr (c, real(0.0))) + xrot = real(0.0) + else + xrot = RADTODEG (atan2 (-c, a)) + if (xrot < real(0.0)) + xrot = xrot + real(360.0) + if (fp_equalr (b, real(0.0)) && fp_equalr (d, real(0.0))) + yrot = real(0.0) + else + yrot = RADTODEG (atan2 (b, d)) + if (yrot < real(0.0)) + yrot = yrot + real(360.0) + if (comment == NO) { + call fprintf (fd, + " X and Y axis rotation: %0.5f %0.5f (degrees degrees)\n") + call pargr (xrot) + call pargr (yrot) + } else { + call fprintf (fd, + "# X and Y axis rotation: %0.5f %0.5f (degrees degrees)\n") + call pargr (xrot) + call pargr (yrot) + } + + call sfree (sp) +end + + + +# GEO_MAP -- Procedure to calculate the coordinate transformations + +procedure geo_mapd (gd, in, out, res, fit, xmin, xmax, ymin, ymax, verbose) + +pointer gd #I the graphics stream +int in #I the input file descriptor +pointer out #I the output file descriptor +int res #I the results file descriptor +pointer fit #I pointer to fit parameters +double xmin, xmax #I max and min xref values +double ymin, ymax #I max and min yref values +bool verbose #I verbose mode + +int npts, ngood +pointer sp, str, xref, yref, xin, yin, wts, xfit, yfit, xerrmsg, yerrmsg +pointer sx1, sy1, sx2, sy2 +double mintemp, maxtemp + +double asumd() +int geo_rdxyd() +errchk geo_fitd, geo_mgfitd() + +begin + # Get working space. + call smark (sp) + call salloc (str, SZ_FNAME, TY_CHAR) + call salloc (xerrmsg, SZ_LINE, TY_CHAR) + call salloc (yerrmsg, SZ_LINE, TY_CHAR) + + # Initialize pointers. + xref = NULL + yref = NULL + xin = NULL + yin = NULL + wts = NULL + + # Read in data and check that data is in range. + npts = geo_rdxyd (in, xref, yref, xin, yin, xmin, xmax, ymin, ymax) + if (npts <= 0) { + call fstats (in, F_FILENAME, Memc[str], SZ_FNAME) + call printf ("Coordinate list: %s has no data in range.\n") + call pargstr (Memc[str]) + call sfree (sp) + return + } + + # Compute the mean of the reference and input coordinates. + GM_XOREF(fit) = double (asumd (Memd[xref], npts) / npts) + GM_YOREF(fit) = double (asumd (Memd[yref], npts) / npts) + GM_XOIN(fit) = double (asumd (Memd[xin], npts) / npts) + GM_YOIN(fit) = double (asumd (Memd[yin], npts) / npts) + + # Set the reference point for the projections to INDEF. + GM_XREFPT(fit) = INDEFD + GM_YREFPT(fit) = INDEFD + + # Compute the weights. + call malloc (xfit, npts, TY_DOUBLE) + call malloc (yfit, npts, TY_DOUBLE) + call malloc (wts, npts, TY_DOUBLE) + call amovkd (double(1.), Memd[wts], npts) + + # Determine the x max and min. + if (IS_INDEFD(xmin) || IS_INDEFD(xmax)) { + call alimd (Memd[xref], npts, mintemp, maxtemp) + if (! IS_INDEFD(xmin)) + GM_XMIN(fit) = double (xmin) + else + GM_XMIN(fit) = double (mintemp) + if (! IS_INDEFD(xmax)) + GM_XMAX(fit) = double (xmax) + else + GM_XMAX(fit) = double (maxtemp) + } else { + GM_XMIN(fit) = double (xmin) + GM_XMAX(fit) = double (xmax) + } + + # Determine the y max and min. + if (IS_INDEFD(ymin) || IS_INDEFD(ymax)) { + call alimd (Memd[yref], npts, mintemp, maxtemp) + if (! IS_INDEFD(ymin)) + GM_YMIN(fit) = double (ymin) + else + GM_YMIN(fit) = double (mintemp) + if (! IS_INDEFD(ymax)) + GM_YMAX(fit) = double (ymax) + else + GM_YMAX(fit) = double (maxtemp) + } else { + GM_YMIN(fit) = double (ymin) + GM_YMAX(fit) = double (ymax) + } + + # Initalize surface pointers. + sx1 = NULL + sy1 = NULL + sx2 = NULL + sy2 = NULL + + # Fit the data. + if (gd != NULL) { + iferr { + call geo_mgfitd (gd, fit, sx1, sy1, sx2, sy2, Memd[xref], + Memd[yref], Memd[xin], Memd[yin], Memd[wts], npts, + Memc[xerrmsg], Memc[yerrmsg], SZ_LINE) + } then { + call gdeactivate (gd, 0) + call mfree (xfit, TY_DOUBLE) + call mfree (yfit, TY_DOUBLE) + call mfree (wts, TY_DOUBLE) + call geo_mmfreed (sx1, sy1, sx2, sy2) + call sfree (sp) + call error (3, "Too few points for X or Y fits.") + } + call gdeactivate (gd, 0) + if (verbose && res != STDOUT) { + call printf ("Coordinate mapping status\n") + call flush (STDOUT) + } + if (res != NULL) { + call fprintf (res, "# Coordinate mapping status\n") + } + } else { + if (verbose && res != STDOUT) { + call printf ("Coordinate mapping status\n ") + call flush (STDOUT) + } + if (res != NULL) { + call fprintf (res, "# Coordinate mapping status\n# ") + } + iferr { + call geo_fitd (fit, sx1, sy1, sx2, sy2, Memd[xref], + Memd[yref], Memd[xin], Memd[yin], Memd[wts], npts, + Memc[xerrmsg], Memc[yerrmsg], SZ_LINE) + } then { + call mfree (xfit, TY_DOUBLE) + call mfree (yfit, TY_DOUBLE) + call mfree (wts, TY_DOUBLE) + call geo_mmfreed (sx1, sy1, sx2, sy2) + call sfree (sp) + call error (3, "Too few points for X or Y fits.") + } + if (verbose && res != STDOUT) { + call printf ("%s %s\n") + call pargstr (Memc[xerrmsg]) + call pargstr (Memc[yerrmsg]) + call flush (STDOUT) + } + if (res != NULL) { + call fprintf (res, "%s %s\n") + call pargstr (Memc[xerrmsg]) + call pargstr (Memc[yerrmsg]) + call flush (STDOUT) + } + } + ngood = GM_NPTS(fit) - GM_NWTS0(fit) + if (verbose && res != STDOUT) { + call printf (" Xin and Yin fit rms: %0.7g %0.7g\n") + if (ngood <= 1) { + call pargd (0.0d0) + call pargd (0.0d0) + } else { + call pargd (sqrt (GM_XRMS(fit) / (ngood - 1))) + call pargd (sqrt (GM_YRMS(fit) / (ngood - 1))) + } + call geo_showd (STDOUT, fit, sx1, sy1, NO) + } + if (res != NULL) { + call fprintf (res, "# Xin and Yin fit rms: %0.7g %0.7g\n") + if (ngood <= 1) { + call pargd (0.0) + call pargd (0.0) + } else { + call pargd (sqrt (GM_XRMS(fit) / (ngood - 1))) + call pargd (sqrt (GM_YRMS(fit) / (ngood - 1))) + } + call geo_showd (res, fit, sx1, sy1, YES) + } + + # Compute and print the fitted x and y values. + if (res != NULL) { + call geo_evald (sx1, sy1, sx2, sy2, Memd[xref], Memd[yref], + Memd[xfit], Memd[yfit], npts) + call geo_plistd (res, fit, Memd[xref], Memd[yref], Memd[xin], + Memd[yin], Memd[xfit], Memd[yfit], Memd[wts], npts) + } + + # Free the data + if (xref != NULL) + call mfree (xref, TY_DOUBLE) + if (yref != NULL) + call mfree (yref, TY_DOUBLE) + if (xin != NULL) + call mfree (xin, TY_DOUBLE) + if (yin != NULL) + call mfree (yin, TY_DOUBLE) + if (xfit != NULL) + call mfree (xfit, TY_DOUBLE) + if (yfit != NULL) + call mfree (yfit, TY_DOUBLE) + if (wts != NULL) + call mfree (wts, TY_DOUBLE) + + # Output the data. + call geo_moutd (fit, out, sx1, sy1, sx2, sy2) + + # Free the space and close files. + call geo_mmfreed (sx1, sy1, sx2, sy2) + call sfree (sp) +end + + +define GEO_DEFBUFSIZE 1000 # default data buffer sizes + +# GEO_RDXY -- Read in the data points. + +int procedure geo_rdxyd (fd, xref, yref, xin, yin, xmin, xmax, ymin, ymax) + +int fd # the input file descriptor +pointer xref # the x reference coordinates +pointer yref # the y reference coordinates +pointer xin # the x coordinates +pointer yin # the y coordinates +double xmin, xmax # the range of the x coordinates +double ymin, ymax # the range of the y coordinates + +int npts, bufsize +int fscan(), nscan() + +begin + bufsize = GEO_DEFBUFSIZE + call malloc (xref, bufsize, TY_DOUBLE) + call malloc (yref, bufsize, TY_DOUBLE) + call malloc (xin, bufsize, TY_DOUBLE) + call malloc (yin, bufsize, TY_DOUBLE) + + npts = 0 + while (fscan (fd) != EOF) { + + # Decode the data. + call gargd (Memd[xref+npts]) + call gargd (Memd[yref+npts]) + call gargd (Memd[xin+npts]) + call gargd (Memd[yin+npts]) + if (nscan() < 4) + next + + # Check the data limits. + if (! IS_INDEFD(xmin)) { + if (Memd[xref+npts] < xmin) + next + } + if (! IS_INDEFD(xmax)) { + if (Memd[xref+npts] > xmax) + next + } + if (! IS_INDEFD(ymin)) { + if (Memd[yref+npts] < ymin) + next + } + if (! IS_INDEFD(ymax)) { + if (Memd[yref+npts] > ymax) + next + } + + npts = npts + 1 + if (npts >= bufsize) { + bufsize = bufsize + GEO_DEFBUFSIZE + call realloc (xref, bufsize, TY_DOUBLE) + call realloc (yref, bufsize, TY_DOUBLE) + call realloc (xin, bufsize, TY_DOUBLE) + call realloc (yin, bufsize, TY_DOUBLE) + } + } + + if (npts <= 0) { + call mfree (xref, TY_DOUBLE) + call mfree (yref, TY_DOUBLE) + call mfree (xin, TY_DOUBLE) + call mfree (yin, TY_DOUBLE) + xref = NULL + yref = NULL + xin = NULL + yin = NULL + } else if (npts < bufsize) { + call realloc (xref, npts, TY_DOUBLE) + call realloc (yref, npts, TY_DOUBLE) + call realloc (xin, npts, TY_DOUBLE) + call realloc (yin, npts, TY_DOUBLE) + } + + return (npts) +end + + +# GEO_EVAL -- Evalute the fit. + +procedure geo_evald (sx1, sy1, sx2, sy2, xref, yref, xi, eta, npts) + +pointer sx1, sy1 #I pointer to linear surfaces +pointer sx2, sy2 #I pointer to higher order surfaces +double xref[ARB] #I the x reference coordinates +double yref[ARB] #I the y reference coordinates +double xi[ARB] #O the fitted xi coordinates +double eta[ARB] #O the fitted eta coordinates +int npts #I the number of points + +pointer sp, temp + +begin + call smark (sp) + call salloc (temp, npts, TY_DOUBLE) + + call dgsvector (sx1, xref, yref, xi, npts) + if (sx2 != NULL) { + call dgsvector (sx2, xref, yref, Memd[temp], npts) + call aaddd (Memd[temp], xi, xi, npts) + } + call dgsvector (sy1, xref, yref, eta, npts) + if (sy2 != NULL) { + call dgsvector (sy2, xref, yref, Memd[temp], npts) + + call aaddd (Memd[temp], eta, eta, npts) + } + + call sfree (sp) +end + + +# GEO_MOUT -- Write the output database file. + +procedure geo_moutd (fit, out, sx1, sy1, sx2, sy2) + +pointer fit #I pointer to fitting structure +int out #I pointer to database file +pointer sx1, sy1 #I pointer to linear surfaces +pointer sx2, sy2 #I pointer to distortion surfaces + +int i, npts, ncoeff +pointer sp, str, xcoeff, ycoeff +double xrms, yrms, xshift, yshift, xscale, yscale, xrot, yrot +int dgsgeti() +int rg_wrdstr() + +begin + call smark (sp) + call salloc (str, SZ_FNAME, TY_CHAR) + + # Compute the x and y fit rms. + #npts = max (0, GM_NPTS(fit) - GM_NREJECT(fit) - GM_NWTS0(fit)) + npts = max (0, GM_NPTS(fit) - GM_NWTS0(fit)) + xrms = max (0.0d0, GM_XRMS(fit)) + yrms = max (0.0d0, GM_YRMS(fit)) + if (npts > 1) { + xrms = sqrt (xrms / (npts - 1)) + yrms = sqrt (yrms / (npts - 1)) + } else { + xrms = 0.0d0 + yrms = 0.0d0 + } + + # Print title. + call dtptime (out) + call dtput (out, "begin\t%s\n") + call pargstr (GM_RECORD(fit)) + + # Print the x and y mean values. + call dtput (out, "\txrefmean\t%g\n") + call pargd (GM_XOREF(fit)) + call dtput (out, "\tyrefmean\t%g\n") + call pargd (GM_YOREF(fit)) + call dtput (out, "\txmean\t\t%g\n") + call pargd (GM_XOIN(fit)) + call dtput (out, "\tymean\t\t%g\n") + call pargd (GM_YOIN(fit)) + + # Print some of the fitting parameters. + if (rg_wrdstr (GM_FIT(fit), Memc[str], SZ_FNAME, GM_GEOMETRIES) <= 0) + call strcpy ("general", Memc[str], SZ_FNAME) + call dtput (out, "\tgeometry\t%s\n") + call pargstr (Memc[str]) + if (rg_wrdstr (GM_FUNCTION(fit), Memc[str], SZ_FNAME, GM_FUNCS) <= 0) + call strcpy ("polynomial", Memc[str], SZ_FNAME) + call dtput (out, "\tfunction\t%s\n") + call pargstr (Memc[str]) + + # Output the geometric parameters. + call geo_lcoeffd (sx1, sy1, xshift, yshift, xscale, yscale, xrot, yrot) + call dtput (out, "\txshift\t\t%g\n") + call pargd (xshift) + call dtput (out, "\tyshift\t\t%g\n") + call pargd (yshift) + call dtput (out, "\txmag\t\t%g\n") + call pargd (xscale) + call dtput (out, "\tymag\t\t%g\n") + call pargd (yscale) + call dtput (out, "\txrotation\t%g\n") + call pargd (xrot) + call dtput (out, "\tyrotation\t%g\n") + call pargd (yrot) + + # Out the rms values. + call dtput (out, "\txrms\t\t%g\n") + call pargd (double(xrms)) + call dtput (out, "\tyrms\t\t%g\n") + call pargd (double(yrms)) + + # Allocate memory for linear coefficients. + ncoeff = max (dgsgeti (sx1, GSNSAVE), dgsgeti (sy1, GSNSAVE)) + call calloc (xcoeff, ncoeff, TY_DOUBLE) + call calloc (ycoeff, ncoeff, TY_DOUBLE) + + # Output the linear coefficients. + call dgssave (sx1, Memd[xcoeff]) + call dgssave (sy1, Memd[ycoeff]) + call dtput (out, "\tsurface1\t%d\n") + call pargi (ncoeff) + do i = 1, ncoeff { + call dtput (out, "\t\t\t%g\t%g\n") + call pargd (Memd[xcoeff+i-1]) + call pargd (Memd[ycoeff+i-1]) + } + + call mfree (xcoeff, TY_DOUBLE) + call mfree (ycoeff, TY_DOUBLE) + + # Allocate memory for higer order coefficients. + if (sx2 == NULL) + ncoeff = 0 + else + ncoeff = dgsgeti (sx2, GSNSAVE) + if (sy2 == NULL) + ncoeff = max (0, ncoeff) + else + ncoeff = max (dgsgeti (sy2, GSNSAVE), ncoeff) + call calloc (xcoeff, ncoeff, TY_DOUBLE) + call calloc (ycoeff, ncoeff, TY_DOUBLE) + + # Save the coefficients. + call dgssave (sx2, Memd[xcoeff]) + call dgssave (sy2, Memd[ycoeff]) + + # Output the coefficients. + call dtput (out, "\tsurface2\t%d\n") + call pargi (ncoeff) + do i = 1, ncoeff { + call dtput (out, "\t\t\t%g\t%g\n") + call pargd (Memd[xcoeff+i-1]) + call pargd (Memd[ycoeff+i-1]) + } + + # Cleanup. + call mfree (xcoeff, TY_DOUBLE) + call mfree (ycoeff, TY_DOUBLE) + call sfree (sp) +end + + +# GEO_PLIST -- Print the input, output, and fitted data and the residuals. + +procedure geo_plistd (fd, fit, xref, yref, xin, yin, xfit, yfit, wts, npts) + +int fd #I the results file descriptor +pointer fit #I pointer to the fit structure +double xref[ARB] #I the input x coordinates +double yref[ARB] #I the input y coordinates +double xin[ARB] #I the input ra / longitude coordinates +double yin[ARB] #I the input dec / latitude coordinates +double xfit[ARB] #I the fitted ra / longitude coordinates +double yfit[ARB] #I the fitted dec / latitude coordinates +double wts[ARB] #I the weights array +int npts #I the number of data points + +int i, index +pointer sp, fmtstr, twts + +begin + # Allocate working space. + call smark (sp) + call salloc (fmtstr, SZ_LINE, TY_CHAR) + call salloc (twts, npts, TY_DOUBLE) + + # Compute the weights. + call amovd (wts, Memd[twts], npts) + do i = 1, GM_NREJECT(fit) { + index = Memi[GM_REJ(fit)+i-1] + if (wts[index] > double(0.0)) + Memd[twts+index-1] = double(0.0) + } + + # Print banner. + call fprintf (fd, "\n# Input Coordinate Listing\n") + call fprintf (fd, "# Column 1: X (reference) \n") + call fprintf (fd, "# Column 2: Y (reference)\n") + call fprintf (fd, "# Column 3: X (input)\n") + call fprintf (fd, "# Column 4: Y (input)\n") + call fprintf (fd, "# Column 5: X (fit)\n") + call fprintf (fd, "# Column 6: Y (fit)\n") + call fprintf (fd, "# Column 7: X (residual)\n") + call fprintf (fd, "# Column 8: Y (residual)\n\n") + + # Create the format string. + call sprintf (Memc[fmtstr], SZ_LINE, "%s %s %s %s %s %s %s %s\n") + call pargstr ("%16.14g") + call pargstr ("%16.14g") + call pargstr ("%16.14g") + call pargstr ("%16.14g") + call pargstr ("%16.14g") + call pargstr ("%16.14g") + call pargstr ("%16.14g") + call pargstr ("%16.14g") + + # Print the data. + do i = 1, npts { + call fprintf (fd, Memc[fmtstr]) + call pargd (xref[i]) + call pargd (yref[i]) + call pargd (xin[i]) + call pargd (yin[i]) + if (Memd[twts+i-1] > 0.0d0) { + call pargd (xfit[i]) + call pargd (yfit[i]) + call pargd (xin[i] - xfit[i]) + call pargd (yin[i] - yfit[i]) + } else { + call pargd (INDEFD) + call pargd (INDEFD) + call pargd (INDEFD) + call pargd (INDEFD) + } + + } + + call fprintf (fd, "\n") + + call sfree (sp) + +end + +# GEO_SHOW -- Print the coordinate mapping parameters. + +procedure geo_showd (fd, fit, sx1, sy1, comment) + +int fd #I the output file descriptor +pointer fit #I pointer to the fit structure +pointer sx1, sy1 #I pointer to linear surfaces +int comment #I comment the output ? + +double xshift, yshift, a, b, c, d +double xscale, yscale, xrot, yrot +pointer sp, str +bool fp_equald() + +begin + # Allocate temporary space. + call smark (sp) + call salloc (str, SZ_LINE, TY_CHAR) + + # Compute the geometric parameters. + call geo_gcoeffd (sx1, sy1, xshift, yshift, a, b, c, d) + + if (comment == NO) { + call fprintf (fd, "Coordinate mapping parameters\n") + } else { + call fprintf (fd, "# Coordinate mapping parameters\n") + } + + if (comment == NO) { + call fprintf (fd, + " Mean Xref and Yref: %0.7g %0.7g\n") + call pargd (GM_XOREF(fit)) + call pargd (GM_YOREF(fit)) + call fprintf (fd, + " Mean Xin and Yin: %0.7g %0.7g\n") + call pargd (GM_XOIN(fit)) + call pargd (GM_YOIN(fit)) + call fprintf (fd, + " X and Y shift: %0.7g %0.7g (xin yin)\n") + call pargd (xshift) + call pargd (yshift) + } else { + call fprintf (fd, + "# Mean Xref and Yref: %0.7g %0.7g\n") + call pargd (GM_XOREF(fit)) + call pargd (GM_YOREF(fit)) + call fprintf (fd, + "# Mean Xin and Yin: %0.7g %g0.7\n") + call pargd (GM_XOIN(fit)) + call pargd (GM_YOIN(fit)) + call fprintf (fd, + "# X and Y shift: %0.7g %0.7g (xin yin)\n") + call pargd (xshift) + call pargd (yshift) + } + + # Output the scale factors. + xscale = sqrt (a * a + c * c) + yscale = sqrt (b * b + d * d) + if (comment == NO) { + call fprintf (fd, + " X and Y scale: %0.7g %0.7g (xin / xref yin / yref)\n") + call pargd (xscale) + call pargd (yscale) + } else { + call fprintf (fd, + "# X and Y scale: %0.7g %0.7g (xin / xref yin / yref)\n") + call pargd (xscale) + call pargd (yscale) + } + + # Output the rotation factors. + if (fp_equald (a, double(0.0)) && fp_equald (c, double(0.0))) + xrot = double(0.0) + else + xrot = RADTODEG (atan2 (-c, a)) + if (xrot < double(0.0)) + xrot = xrot + double(360.0) + if (fp_equald (b, double(0.0)) && fp_equald (d, double(0.0))) + yrot = double(0.0) + else + yrot = RADTODEG (atan2 (b, d)) + if (yrot < double(0.0)) + yrot = yrot + double(360.0) + if (comment == NO) { + call fprintf (fd, + " X and Y axis rotation: %0.5f %0.5f (degrees degrees)\n") + call pargd (xrot) + call pargd (yrot) + } else { + call fprintf (fd, + "# X and Y axis rotation: %0.5f %0.5f (degrees degrees)\n") + call pargd (xrot) + call pargd (yrot) + } + + call sfree (sp) +end + + diff --git a/pkg/images/immatch/src/geometry/t_geotran.x b/pkg/images/immatch/src/geometry/t_geotran.x new file mode 100644 index 00000000..5e5cd2e3 --- /dev/null +++ b/pkg/images/immatch/src/geometry/t_geotran.x @@ -0,0 +1,880 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> +include <mwset.h> +include <math.h> +include <math/gsurfit.h> +include "geotran.h" + +# T_GEOTRAN -- Geometrically transform a list of images either linearly or +# using a transformation computed by the GEOMAP task. + +procedure t_geotran () + +int ncols, nlines # output picture size +real xmin, xmax, ymin, ymax # minimum and maximum ref values +real xscale, yscale # output picture scale +real xin, yin # input picture origin +real xshift, yshift # x and y shifts +real xout, yout # output picture origin +real xmag, ymag # input picture scale +real xrotation, yrotation # rotation angle +int nxblock, nyblock # block size of image to be used + +bool verbose +int list1, list2, tflist, ndim, nc, nl, mode +pointer sp, imtlist1, imtlist2, database, transform, record +pointer image1, image2, imtemp, imroot, section, str +pointer geo, sx1, sy1, sx2, sy2, in, out, mw +real xs, ys, txshift, tyshift, txmag, tymag, txrot, tyrot +double oltv[2], nltv[2], oltm[2,2], nltm[2,2] + +bool clgetb(), envgetb(), streq() +int imtopen(), imtlen(), clgeti(), imtgetim(), clgwrd(), btoi() +pointer immap(), mw_openim() +real clgetr() +errchk immap() + +begin + # Set up the geotran structure. + call smark (sp) + call salloc (imtlist1, SZ_LINE, TY_CHAR) + call salloc (imtlist2, SZ_LINE, TY_CHAR) + call salloc (database, SZ_FNAME, TY_CHAR) + call salloc (transform, SZ_FNAME, TY_CHAR) + call salloc (record, SZ_FNAME, TY_CHAR) + call salloc (image1, SZ_FNAME, TY_CHAR) + call salloc (image2, SZ_FNAME, TY_CHAR) + call salloc (imtemp, SZ_FNAME, TY_CHAR) + call salloc (imroot, SZ_FNAME, TY_CHAR) + call salloc (section, SZ_FNAME, TY_CHAR) + call salloc (str, SZ_LINE, TY_CHAR) + call salloc (geo, LEN_GEOSTRUCT, TY_STRUCT) + + # Get the input and output lists and database file. + call clgstr ("input", Memc[imtlist1], SZ_FNAME) + call clgstr ("output", Memc[imtlist2], SZ_FNAME) + call clgstr ("database", Memc[database], SZ_FNAME) + if (Memc[database] != EOS) { + call clgstr ("transforms", Memc[transform], SZ_FNAME) + tflist = imtopen (Memc[transform]) + GT_GEOMODE(geo) = clgwrd ("geometry", Memc[str], SZ_LINE, + ",junk,linear,distortion,geometric,") + } else { + tflist = NULL + GT_GEOMODE(geo) = GT_NONE + } + + # Get the output picture format parameters. + xmin = clgetr ("xmin") + xmax = clgetr ("xmax") + ymin = clgetr ("ymin") + ymax = clgetr ("ymax") + xscale = clgetr ("xscale") + yscale = clgetr ("yscale") + ncols= clgeti ("ncols") + nlines = clgeti ("nlines") + + # Get the geometric transformation parameters. + xin = clgetr ("xin") + yin = clgetr ("yin") + xshift = clgetr ("xshift") + yshift = clgetr ("yshift") + xout = clgetr ("xout") + yout = clgetr ("yout") + xmag = clgetr ("xmag") + ymag = clgetr ("ymag") + xrotation = clgetr ("xrotation") + yrotation = clgetr ("yrotation") + + # Get the interpolation parameters. + call clgstr ("interpolant", GT_INTERPSTR(geo), SZ_FNAME) + #GT_INTERPOLANT(geo) = clgwrd ("interpolant", Memc[str], SZ_LINE, + #",nearest,linear,poly3,poly5,spline3,") + GT_BOUNDARY(geo) = clgwrd ("boundary", Memc[str], SZ_LINE, + ",constant,nearest,reflect,wrap,") + GT_CONSTANT(geo) = clgetr ("constant") + GT_XSAMPLE(geo) = clgetr ("xsample") + GT_YSAMPLE(geo) = clgetr ("ysample") + GT_FLUXCONSERVE(geo) = btoi (clgetb("fluxconserve")) + + nxblock = clgeti ("nxblock") + nyblock = clgeti ("nyblock") + verbose = clgetb ("verbose") + + # Open the lists of images and check the scale lengths. + list1 = imtopen (Memc[imtlist1]) + list2 = imtopen (Memc[imtlist2]) + if (imtlen (list1) != imtlen (list2)) { + call imtclose (list1) + call imtclose (list2) + if (tflist != NULL) + call imtclose (tflist) + call error (0, "Input and output lists not the same length.") + } + + # Check the transform list. + if (tflist != NULL) { + if (imtlen (tflist) > 1 && imtlen (tflist) != imtlen (list1)) { + call imtclose (list1) + call imtclose (list2) + call imtclose (tflist) + call error (0, "Transform and input lists not the same length.") + } + } + + # Loop over the images. + if (verbose) { + call printf ("\n") + } + while (imtgetim (list1, Memc[image1], SZ_FNAME) != EOF && + imtgetim (list2, Memc[image2], SZ_FNAME) != EOF) { + + # Print messages. + if (verbose) { + call printf ("Transforming image %s to image %s\n") + call pargstr (Memc[image1]) + call pargstr (Memc[image2]) + call flush (STDOUT) + } + + # Open the images. + in = immap (Memc[image1], READ_ONLY, 0) + call imgimage (Memc[image1], Memc[str], SZ_FNAME) + call imgimage (Memc[image2], Memc[imroot], SZ_FNAME) + call imgsection (Memc[image2], Memc[section], SZ_FNAME) + if (streq (Memc[str], Memc[imroot])) { + call strcpy (Memc[imroot], Memc[imtemp], SZ_FNAME) + call mktemp ("tmp", Memc[image2], SZ_FNAME) + } else + call strcpy (Memc[image2], Memc[imtemp], SZ_FNAME) + ifnoerr (out = immap (Memc[image2], READ_WRITE, 0)) { + mode = READ_WRITE + nc = IM_LEN(out,1) + nl = IM_LEN(out,2) + xs = INDEF + ys = INDEF + } else if (Memc[section] != EOS) { + mode = NEW_IMAGE + out = immap (Memc[imroot], NEW_IMAGE, 0) + IM_NDIM(out) = IM_NDIM(in) + if (IS_INDEFI(ncols)) + IM_LEN(out,1) = IM_LEN(in,1) + else + IM_LEN(out,1) = ncols + if (IS_INDEFI(nlines)) + IM_LEN(out,2) = IM_LEN(in,2) + else + IM_LEN(out,2) = nlines + IM_PIXTYPE(out) = IM_PIXTYPE(in) + call geo_imzero (out, GT_CONSTANT(geo)) + call imunmap (out) + out = immap (Memc[image2], READ_WRITE, 0) + nc = IM_LEN(out,1) + nl = IM_LEN(out,2) + xs = INDEF + ys = INDEF + } else { + mode = NEW_COPY + out = immap (Memc[image2], NEW_COPY, in) + nc = ncols + nl = nlines + xs = xscale + ys = yscale + } + + # Set the geometry parameters. + call geo_set (geo, xmin, xmax, ymin, ymax, xs, ys, nc, nl, xin, + yin, xshift, yshift, xout, yout, xmag, ymag, xrotation, + yrotation) + + # Get the coordinate surfaces. + if (GT_GEOMODE(geo) == GT_NONE) { + call geo_format (in, out, geo, sx1, sy1, sx2, sy2) + if (verbose) { + call geo_lcoeffr (sx1, sy1, txshift, tyshift, txmag, + tymag, txrot, tyrot) + call printf (" xshift: %.2f yshift: %.2f ") + call pargr (txshift) + call pargr (tyshift) + call printf ("xmag: %.2f ymag: %.2f ") + call pargr (txmag) + call pargr (tymag) + call printf ("xrot: %.2f yrot: %.2f\n") + call pargr (txrot) + call pargr (tyrot) + call flush (STDOUT) + } + } else { + if (imtgetim (tflist, Memc[str], SZ_FNAME) != EOF) + call strcpy (Memc[str], Memc[record], SZ_FNAME) + call geo_dformat (in, out, geo, Memc[database], Memc[record], + sx1, sy1, sx2, sy2) + if (verbose) { + call printf (" Using transform %s in database %s\n") + call pargstr (Memc[record]) + call pargstr (Memc[database]) + call flush (STDOUT) + } + } + + # Transform the image. + if (IM_LEN(out,1) <= nxblock && IM_LEN(out,2) <= nyblock) { + if (GT_XSAMPLE(geo) > 1.0 || GT_YSAMPLE(geo) > 1.0) + call geo_simtran (in, out, geo, sx1, sy1, sx2, sy2) + else + call geo_imtran (in, out, geo, sx1, sy1, sx2, sy2) + } else { + if (GT_XSAMPLE(geo) > 1.0 || GT_YSAMPLE(geo) > 1.0) { + if (IM_NDIM(out) == 1) + call geo_stran (in, out, geo, sx1, sy1, sx2, sy2, + nxblock, 1) + else + call geo_stran (in, out, geo, sx1, sy1, sx2, sy2, + nxblock, nyblock) + } else { + if (IM_NDIM(out) == 1) + call geo_tran (in, out, geo, sx1, sy1, sx2, sy2, + nxblock, 1) + else + call geo_tran (in, out, geo, sx1, sy1, sx2, sy2, + nxblock, nyblock) + } + } + + # Update the linear part of the wcs. + if (!envgetb ("nomwcs") && mode == NEW_COPY) { + ndim = IM_NDIM(in) + mw = mw_openim (in) + call geo_gwcs (geo, sx1, sy1, oltm, oltv) + call mw_invertd (oltm, nltm, ndim) + call mw_vmuld (nltm, oltv, nltv, ndim) + call anegd (nltv, nltv, ndim) + call geo_swcs (mw, nltm, nltv, ndim) + call mw_saveim (mw, out) + call mw_close (mw) + } + + # Free the surfaces. + call gsfree (sx1) + call gsfree (sy1) + call gsfree (sx2) + call gsfree (sy2) + + # Close the images. + call imunmap (in) + call imunmap (out) + + call xt_delimtemp (Memc[image2], Memc[imtemp]) + } + + # Clean up. + call sfree (sp) + if (tflist != NULL) + call imtclose (tflist) + call imtclose (list1) + call imtclose (list2) +end + + +# GEO_IMZERO -- Create a dummy output image filled with the constant boundary +# extension value. + +procedure geo_imzero (im, constant) + +pointer im #I pointer to the input image +real constant #I the constant value to insert in the imagw + +int npix +pointer sp, v, buf +int impnls(), impnll(), impnlr(), impnld(), impnlx() + +begin + # Setup start vector for sequential reads and writes. + call smark (sp) + call salloc (v, IM_MAXDIM, TY_LONG) + call amovkl (long(1), Meml[v], IM_MAXDIM) + + # Initialize the image. + npix = IM_LEN(im, 1) + switch (IM_PIXTYPE(im)) { + case TY_SHORT: + while (impnls (im, buf, Meml[v]) != EOF) + call amovks (short (constant), Mems[buf], npix) + case TY_USHORT, TY_INT, TY_LONG: + while (impnll (im, buf, Meml[v]) != EOF) + call amovkl (long (constant), Meml[buf], npix) + case TY_REAL: + while (impnlr (im, buf, Meml[v]) != EOF) + call amovkr (constant, Memr[buf], npix) + case TY_DOUBLE: + while (impnld (im, buf, Meml[v]) != EOF) + call amovkd (double (constant), Memd[buf], npix) + case TY_COMPLEX: + while (impnlx (im, buf, Meml[v]) != EOF) + call amovkx (complex (constant, 0.0), Memx[buf], npix) + default: + call error (1, "Unknown pixel datatype") + } + + call sfree (sp) +end + + +# GEO_SET -- Set the image dependent task parameters individually for each +# image. + +procedure geo_set (geo, xmin, xmax, ymin, ymax, xscale, yscale, ncols, nlines, + xin, yin, xshift, yshift, xout, yout, xmag, ymag, xrotation, yrotation) + +pointer geo #I pointer to geotran structure +real xmin, xmax #I minimum and maximum reference values +real ymin, ymax #I minimum and maximum reference values +real xscale, yscale #I output picture scale +int ncols, nlines #I output picture size +real xin, yin #I input picture pixel coordinates +real xshift, yshift #I shift of origin +real xout, yout #I corresponding output picture coords +real xmag, ymag #I input picture scale +real xrotation, yrotation #I scale angle + +begin + # Set the output picture format parameters. + GT_XMIN(geo) = xmin + GT_XMAX(geo) = xmax + GT_YMIN(geo) = ymin + GT_YMAX(geo) = ymax + GT_XSCALE(geo) = xscale + GT_YSCALE(geo) = yscale + GT_NCOLS(geo) = ncols + GT_NLINES(geo) = nlines + + # Set the transformation parameters. + GT_XIN(geo) = xin + GT_YIN(geo) = yin + GT_XSHIFT(geo) = xshift + GT_YSHIFT(geo) = yshift + GT_XOUT(geo) = xout + GT_YOUT(geo) = yout + GT_XMAG(geo) = xmag + GT_YMAG(geo) = ymag + GT_XROTATION(geo) = xrotation + GT_YROTATION(geo) = yrotation +end + + +# GEO_FORMAT -- Format the output picture when there is no database file. + +procedure geo_format (in, out, geo, sx1, sy1, sx2, sy2) + +pointer in #I pointer to the input image +pointer out #I pointer to the ouput image +pointer geo #I pointer to the geotran structure +pointer sx1, sy1 #O pointer to linear surfaces +pointer sx2, sy2 #O pointer to distortion surfaces + +real xmax, ymax + +begin + # Get the scale transformation parameters. + if (IS_INDEFR(GT_XMAG(geo))) + GT_XMAG(geo) = 1. + if (IM_NDIM(in) == 1) + GT_YMAG(geo) = 1. + else if (IS_INDEFR(GT_YMAG(geo))) + GT_YMAG(geo) = 1. + + # Get the rotate transformation parameters. + if (IM_NDIM(in) == 1) + GT_XROTATION(geo) = DEGTORAD(0.) + else if (IS_INDEFR(GT_XROTATION(geo))) + GT_XROTATION(geo) = DEGTORAD(0.) + else + GT_XROTATION(geo) = DEGTORAD(GT_XROTATION(geo)) + if (IM_NDIM(in) == 1) + GT_YROTATION(geo) = DEGTORAD(0.) + else if (IS_INDEFR(GT_YROTATION(geo))) + GT_YROTATION(geo) = DEGTORAD(0.) + else + GT_YROTATION(geo) = DEGTORAD(GT_YROTATION(geo)) + + # Automatically compute the maximum extent of the image. + if (GT_XMAX(geo) <= 0.0 || GT_YMAX(geo) <= 0.0) { + + # Compute the size of the output image. + xmax = abs (cos(GT_XROTATION(geo)) * IM_LEN(in,1) / + GT_XMAG(geo)) + abs(sin(GT_YROTATION(geo)) * IM_LEN(in,2) / + GT_YMAG(geo)) + ymax = abs (sin(GT_XROTATION(geo)) * IM_LEN(in, 1) / + GT_XMAG(geo)) + abs (cos(GT_YROTATION(geo)) * IM_LEN(in,2) / + GT_YMAG(geo)) + } + + # Set up the x reference coordinate limits. + if (IS_INDEF(GT_XMIN(geo))) + GT_XMIN(geo) = 1. + else + GT_XMIN(geo) = max (1.0, GT_XMIN(geo)) + if (IS_INDEF(GT_XMAX(geo))) + GT_XMAX(geo) = IM_LEN(in,1) + else if (GT_XMAX(geo) <= 0.0) + #GT_XMAX(geo) = int (xmax + 1.0) + GT_XMAX(geo) = xmax + + # Set up the y reference coordinate limits. + if (IS_INDEF(GT_YMIN(geo))) + GT_YMIN(geo) = 1. + else + GT_YMIN(geo) = max (1.0, GT_YMIN(geo)) + if (IS_INDEF(GT_YMAX(geo))) + GT_YMAX(geo) = IM_LEN(in, 2) + else if (GT_YMAX(geo) <= 0.0) + #GT_YMAX(geo) = int (ymax + 1.0) + GT_YMAX(geo) = ymax + + # Set the number of columns and rows. + if (IS_INDEFI(GT_NCOLS(geo))) + GT_NCOLS(geo) = IM_LEN(in, 1) + if (IM_NDIM(in) == 1) + GT_NLINES(geo) = 1 + else if (IS_INDEFI(GT_NLINES(geo))) + GT_NLINES(geo) = IM_LEN(in, 2) + + # Set scale, overiding number of columns and rows if necessary. + if (IS_INDEFR(GT_XSCALE(geo))) + GT_XSCALE(geo) = (GT_XMAX(geo) - GT_XMIN(geo)) / (GT_NCOLS(geo) - 1) + else + GT_NCOLS(geo) = (GT_XMAX(geo) - GT_XMIN(geo)) / GT_XSCALE(geo) + 1 + if (IM_NDIM(in) == 1) + GT_YSCALE(geo) = 1.0 + else if (IS_INDEFR(GT_YSCALE(geo))) + GT_YSCALE(geo) = (GT_YMAX(geo) - GT_YMIN(geo)) / + (GT_NLINES(geo) - 1) + else + GT_NLINES(geo) = (GT_YMAX(geo) - GT_YMIN(geo)) / GT_YSCALE(geo) + 1 + IM_LEN(out, 1) = GT_NCOLS(geo) + IM_LEN(out, 2) = GT_NLINES(geo) + + # Set up the surfaces, distortion surfaces are NULL. + if (IM_NDIM(in) == 1) { + call gsinit (sx1, GS_POLYNOMIAL, 2, 2, GS_XNONE, GT_XMIN(geo), + GT_XMAX(geo), 0.5, 1.5) + call gsinit (sy1, GS_POLYNOMIAL, 2, 2, GS_XNONE, GT_XMIN(geo), + GT_XMAX(geo), 0.5, 1.5) + } else { + call gsinit (sx1, GS_POLYNOMIAL, 2, 2, GS_XNONE, GT_XMIN(geo), + GT_XMAX(geo), GT_YMIN(geo), GT_YMAX(geo)) + call gsinit (sy1, GS_POLYNOMIAL, 2, 2, GS_XNONE, GT_XMIN(geo), + GT_XMAX(geo), GT_YMIN(geo), GT_YMAX(geo)) + } + sx2 = NULL + sy2 = NULL + + # Adjust rotation, x and y scale, scale angle, and flip. + call geo_rotmagr (sx1, sy1, GT_XMAG(geo), GT_YMAG(geo), + GT_XROTATION(geo), GT_YROTATION(geo)) + + # Adjust the shift. + call geo_shift (in, out, geo, sx1, sy1) +end + + +# GEO_DFORMAT -- Get the coordinate transformation from a database file. + +procedure geo_dformat (in, out, geo, database, transform, sx1, sy1, sx2, sy2) + +pointer in, out #I pointers to input and output images +pointer geo #I pointer to geotran structure +char database[ARB] #I name of database file +char transform[ARB] #I name of transform +pointer sx1, sy1 #O pointer to linear part of surface fit +pointer sx2, sy2 #O pointer to higher order surface + +int i, dt, rec, ncoeff, junk +pointer xcoeff, ycoeff, newsx1, newsy1 +int dtmap(), dtlocate(), dtgeti(), dtscan() +errchk gsrestore + +begin + # Map the database and locate the transformation record. + dt = dtmap (database, READ_ONLY) + rec = dtlocate (dt, transform) + + # Get the linear part of the fit. + ncoeff = dtgeti (dt, rec, "surface1") + call malloc (xcoeff, ncoeff, TY_REAL) + call malloc (ycoeff, ncoeff, TY_REAL) + do i = 1, ncoeff { + junk = dtscan (dt) + call gargr (Memr[xcoeff+i-1]) + call gargr (Memr[ycoeff+i-1]) + } + call gsrestore (sx1, Memr[xcoeff]) + call gsrestore (sy1, Memr[ycoeff]) + + # Set the output image format parameters. + call geo_dout (in, out, geo, sx1, sy1) + + # Adjust the linear part of the fit. + call gscopy (sx1, newsx1) + call gscopy (sy1, newsy1) + if (GT_GEOMODE(geo) == GT_DISTORT) + call geo_rotmagr (newsx1, newsy1, 1.0, 1.0, 0.0, 0.0) + else if (! IS_INDEFR(GT_XMAG(geo)) || ! IS_INDEFR(GT_YMAG(geo)) || + ! IS_INDEFR(GT_XROTATION(geo)) || ! IS_INDEFR(GT_YROTATION(geo))) + call geo_dcoeff (geo, dt, rec, newsx1, newsy1) + call geo_dshift (in, out, dt, rec, geo, newsx1, newsy1) + + # Get the higher order part of the fit. + ncoeff = dtgeti (dt, rec, "surface2") + if (ncoeff > 0 && (GT_GEOMODE(geo) == GT_GEOMETRIC || GT_GEOMODE(geo) == + GT_DISTORT)) { + + # Get the distortion coefficients. + call realloc (xcoeff, ncoeff, TY_REAL) + call realloc (ycoeff, ncoeff, TY_REAL) + do i = 1, ncoeff { + junk = dtscan(dt) + call gargr (Memr[xcoeff+i-1]) + call gargr (Memr[ycoeff+i-1]) + } + iferr { + call gsrestore (sx2, Memr[xcoeff]) + } then { + call mfree (sx2, TY_STRUCT) + sx2 = NULL + } + iferr { + call gsrestore (sy2, Memr[ycoeff]) + } then { + call mfree (sy2, TY_STRUCT) + sy2 = NULL + } + + } else { + + sx2 = NULL + sy2 = NULL + } + + # Redefine the surfaces. + call gsfree (sx1) + call gscopy (newsx1, sx1) + call gsfree (newsx1) + call gsfree (sy1) + call gscopy (newsy1, sy1) + call gsfree (newsy1) + + # Cleanup. + call mfree (xcoeff, TY_REAL) + call mfree (ycoeff, TY_REAL) + call dtunmap (dt) +end + + +# GEO_DOUT -- Set the output image format using information in the database +# file. + +procedure geo_dout (in, out, geo, sx1, sy1) + +pointer in, out #I pointers to input and output image +pointer geo #I pointer to geotran sturcture +pointer sx1, sy1 #I pointers to linear surface descriptors + +real gsgetr () + +begin + # Set the reference coordinate limits. + if (IS_INDEFR(GT_XMIN(geo))) + GT_XMIN(geo) = gsgetr (sx1, GSXMIN) + if (IS_INDEFR(GT_XMAX(geo))) + GT_XMAX(geo) = gsgetr (sx1, GSXMAX) + if (IS_INDEFR(GT_YMIN(geo))) + GT_YMIN(geo) = gsgetr (sy1, GSYMIN) + if (IS_INDEFR(GT_YMAX(geo))) + GT_YMAX(geo) = gsgetr (sy1, GSYMAX) + + # Set the number of lines and columns. + if (IS_INDEFI(GT_NCOLS(geo))) + GT_NCOLS(geo) = IM_LEN(in, 1) + if (IM_NDIM(in) == 1) + GT_NLINES(geo) = 1 + else if (IS_INDEFI(GT_NLINES(geo))) + GT_NLINES(geo) = IM_LEN(in, 2) + + # Set scale, overiding the number of columns and rows if necessary. + if (IS_INDEFR(GT_XSCALE(geo))) + GT_XSCALE(geo) = (GT_XMAX(geo) - GT_XMIN(geo)) / (GT_NCOLS(geo) - 1) + else + GT_NCOLS(geo) = abs ((GT_XMAX(geo) - GT_XMIN(geo)) / + GT_XSCALE(geo)) + 1 + if (IM_NDIM(in) == 1) + GT_YSCALE(geo) = 1.0 + else if (IS_INDEFR(GT_YSCALE(geo))) + GT_YSCALE(geo) = (GT_YMAX(geo) - GT_YMIN(geo)) / + (GT_NLINES(geo) - 1) + else + GT_NLINES(geo) = abs ((GT_YMAX(geo) - GT_YMIN(geo)) / + GT_YSCALE(geo)) + 1 + + # Set the output image size. + IM_LEN(out,1) = GT_NCOLS(geo) + IM_LEN(out,2) = GT_NLINES(geo) +end + + +# GEO_DSHIFT -- Adjust the shifts using information in the database file. + +procedure geo_dshift (in, out, dt, rec, geo, sx1, sy1) + +pointer in, out #I pointer to input and output images +pointer dt #I pointer to database +int rec #I pointer to database record +pointer geo #I pointer to geotran structure +pointer sx1, sy1 #U pointers to linear surfaces + +real gseval() + +begin + # Define the output origin. + if (IS_INDEFR(GT_XOUT(geo))) + GT_XOUT(geo) = (GT_XMAX(geo) + GT_XMIN(geo)) / 2.0 + if (IS_INDEFR(GT_YOUT(geo))) + GT_YOUT(geo) = (GT_YMAX(geo) + GT_YMIN(geo)) / 2.0 + + # Define the input image origin. + if (IS_INDEFR(GT_XIN(geo))) + GT_XIN(geo) = gseval (sx1, GT_XOUT(geo), GT_YOUT(geo)) + if (IS_INDEFR(GT_YIN(geo))) + GT_YIN(geo) = gseval (sy1, GT_XOUT(geo), GT_YOUT(geo)) + + # Define the shifts. + if (IS_INDEFR(GT_XSHIFT(geo))) + GT_XSHIFT(geo) = GT_XIN(geo) - gseval (sx1, GT_XOUT(geo), + GT_YOUT(geo)) + if (IS_INDEFR(GT_YSHIFT(geo))) + GT_YSHIFT(geo) = GT_YIN(geo) - gseval (sy1, GT_XOUT(geo), + GT_YOUT(geo)) + + # Correct the coefficients. + call geo_xyshiftr (sx1, sy1, GT_XSHIFT(geo), GT_YSHIFT(geo)) +end + + +# GEO_SHIFT -- Compute the shift. + +procedure geo_shift (in, out, geo, sx1, sy1) + +pointer in, out #I pointer to input and output images +pointer geo #I pointer to geotran structure +pointer sx1, sy1 #I pointers to linear surfaces + +real gseval() + +begin + # Determine the output origin. + if (IS_INDEFR(GT_XOUT(geo))) + GT_XOUT(geo) = (GT_XMAX(geo) + GT_XMIN(geo)) / 2.0 + if (IS_INDEFR(GT_YOUT(geo))) + GT_YOUT(geo) = (GT_YMAX(geo) + GT_YMIN(geo)) / 2.0 + + # Determine the input origin. + if (IS_INDEFR(GT_XIN(geo))) + GT_XIN(geo) = (real (IM_LEN (in, 1)) + 1.) / 2. + if (IS_INDEFR(GT_YIN(geo))) + GT_YIN(geo) = (real (IM_LEN (in, 2)) + 1.) / 2. + + # Determine the final x and y shifts. + if (! IS_INDEFR(GT_XSHIFT(geo))) + GT_XOUT(geo) = GT_XIN(geo) + GT_XSHIFT(geo) + if (! IS_INDEFR(GT_YSHIFT(geo))) + GT_YOUT(geo) = GT_YIN(geo) + GT_YSHIFT(geo) + GT_XSHIFT(geo) = GT_XIN(geo) - gseval (sx1, GT_XOUT(geo), + GT_YOUT(geo)) + GT_YSHIFT(geo) = GT_YIN(geo) - gseval (sy1, GT_XOUT(geo), + GT_YOUT(geo)) + + # Alter coefficients. + call geo_xyshiftr (sx1, sy1, GT_XSHIFT(geo), GT_YSHIFT(geo)) +end + + +# GEO_DCOEFF -- Alter the linear componets of the surface fit after the fact. + +procedure geo_dcoeff (geo, dt, rec, sx1, sy1) + +pointer geo #I pointer to geotran structure +pointer dt #I pointer to database record +int rec #I database record +pointer sx1, sy1 #U pointers to the linear surface + +real dtgetr() +errchk dtgetr() + +begin + # Get the transformation parameters. + if (IS_INDEFR(GT_XMAG(geo))) { + iferr (GT_XMAG(geo) = dtgetr (dt, rec, "xmag")) + GT_XMAG(geo) = dtgetr (dt, rec, "xscale") + } + if (IS_INDEFR(GT_YMAG(geo))) { + iferr (GT_YMAG(geo) = dtgetr (dt, rec, "ymag")) + GT_YMAG(geo) = dtgetr (dt, rec, "yscale") + } + if (IS_INDEFR(GT_XROTATION(geo))) + GT_XROTATION(geo) = DEGTORAD(dtgetr (dt, rec, "xrotation")) + else + GT_XROTATION(geo) = DEGTORAD(GT_XROTATION(geo)) + if (IS_INDEFR(GT_YROTATION(geo))) + GT_YROTATION(geo) = DEGTORAD(dtgetr (dt, rec, "yrotation")) + else + GT_YROTATION(geo) = DEGTORAD(GT_YROTATION(geo)) + + call geo_rotmagr (sx1, sy1, GT_XMAG(geo), GT_YMAG(geo), + GT_XROTATION(geo), GT_YROTATION(geo)) +end + + +# GEO_GWCS -- Compute the ltm and ltv vectors using the GEOTRAN coordinate +# surfaces. + +procedure geo_gwcs (geo, sx1, sy1, ltm, ltv) + +pointer geo # pointer to the geotran structure +pointer sx1 # pointer to the linear x coordinate surface +pointer sy1 # pointer to the linear y coordinate surface +double ltm[2,2] # rotation matrix +double ltv[2] # shift vector + +double xscale, yscale, xmin, ymin +int ncoeff +pointer sp, xcoeff, ycoeff +real xrange, yrange +int gsgeti() +real gsgetr() + +begin + # Allocate space for the coefficients. + call smark (sp) + ncoeff = max (gsgeti (sx1, GSNSAVE), gsgeti (sy1, GSNSAVE)) + call salloc (xcoeff, ncoeff, TY_REAL) + call salloc (ycoeff, ncoeff, TY_REAL) + + # Fetch the coefficients. + call gssave (sx1, Memr[xcoeff]) + call gssave (sy1, Memr[ycoeff]) + + # Denormalize the coefficients for non-polynomial functions. + xrange = gsgetr (sx1, GSXMAX) - gsgetr (sx1, GSXMIN) + yrange = gsgetr (sy1, GSYMAX) - gsgetr (sy1, GSYMIN) + if (gsgeti (sx1, GSTYPE) != GS_POLYNOMIAL) { + Memr[xcoeff+GS_SAVECOEFF+1] = Memr[xcoeff+GS_SAVECOEFF+1] * 2. / + xrange + Memr[xcoeff+GS_SAVECOEFF+2] = Memr[xcoeff+GS_SAVECOEFF+2] * 2. / + yrange + } + if (gsgeti (sy1, GSTYPE) != GS_POLYNOMIAL) { + Memr[ycoeff+GS_SAVECOEFF+1] = Memr[ycoeff+GS_SAVECOEFF+1] * 2. / + xrange + Memr[ycoeff+GS_SAVECOEFF+2] = Memr[ycoeff+GS_SAVECOEFF+2] * 2. / + yrange + } + + # Set the shift vector. + ltv[1] = Memr[xcoeff+GS_SAVECOEFF] + ltv[2] = Memr[ycoeff+GS_SAVECOEFF] + + # Set the rotation vector. + ltm[1,1] = Memr[xcoeff+GS_SAVECOEFF+1] + ltm[2,1] = Memr[xcoeff+GS_SAVECOEFF+2] + ltm[1,2] = Memr[ycoeff+GS_SAVECOEFF+1] + ltm[2,2] = Memr[ycoeff+GS_SAVECOEFF+2] + + # Get the sign of the scale vector which is always +ve. + xmin = GT_XMIN(geo) + ymin = GT_YMIN(geo) + if (GT_XMIN(geo) > GT_XMAX(geo)) + xscale = -GT_XSCALE(geo) + else + xscale = GT_XSCALE(geo) + if (GT_YMIN(geo) > GT_YMAX(geo)) + yscale = -GT_YSCALE(geo) + else + yscale = GT_YSCALE(geo) + + # Correct for reference units that are not in pixels. + ltv[1] = ltv[1] + ltm[1,1] * xmin + ltm[2,1] * ymin - ltm[1,1] * + xscale - ltm[2,1] * yscale + ltv[2] = ltv[2] + ltm[1,2] * xmin + ltm[2,2] * ymin - ltm[1,2] * + xscale - ltm[2,2] * yscale + ltm[1,1] = ltm[1,1] * xscale + ltm[2,1] = ltm[2,1] * yscale + ltm[1,2] = ltm[1,2] * xscale + ltm[2,2] = ltm[2,2] * yscale + + call sfree (sp) +end + + +define LTM Memd[ltm+(($2)-1)*pdim+($1)-1] + +# GEO_SWCS -- Update the wcs and write it to the image header. + +procedure geo_swcs (mw, gltm, gltv, ldim) + +pointer mw # the mwcs descriptor +double gltm[ldim,ldim] # the input cd matrix from geotran +double gltv[ldim] # the input shift vector from geotran +int ldim # number of logical dimensions + +int axes[IM_MAXDIM], naxes, pdim, nelem, axmap, ax1, ax2 +pointer sp, ltm, ltv_1, ltv_2 +int mw_stati() + +begin + # Convert axis bitflags to the axis lists. + if (ldim == 1) { + call mw_gaxlist (mw, 01B, axes, naxes) + if (naxes < 1) + return + } else { + call mw_gaxlist (mw, 03B, axes, naxes) + if (naxes < 2) + return + } + + # Initialize the parameters. + pdim = mw_stati (mw, MW_NDIM) + nelem = pdim * pdim + axmap = mw_stati (mw, MW_USEAXMAP) + call mw_seti (mw, MW_USEAXMAP, NO) + + # Allocate working space. + call smark (sp) + call salloc (ltm, nelem, TY_DOUBLE) + call salloc (ltv_1, pdim, TY_DOUBLE) + call salloc (ltv_2, pdim, TY_DOUBLE) + + # Initialize the vectors and matrices. + call mw_mkidmd (Memd[ltm], pdim) + call aclrd (Memd[ltv_1], pdim) + call aclrd (Memd[ltv_2], pdim) + + # Enter the linear operation. + ax1 = axes[1] + Memd[ltv_2+ax1-1] = gltv[1] + LTM(ax1,ax1) = gltm[1,1] + if (ldim == 2) { + ax2 = axes[2] + Memd[ltv_2+ax2-1] = gltv[2] + LTM(ax2,ax1) = gltm[2,1] + LTM(ax1,ax2) = gltm[1,2] + LTM(ax2,ax2) = gltm[2,2] + } + + # Perform the translation. + call mw_translated (mw, Memd[ltv_1], Memd[ltm], Memd[ltv_2], pdim) + + call sfree (sp) + call mw_seti (mw, MW_USEAXMAP, axmap) +end diff --git a/pkg/images/immatch/src/geometry/t_geoxytran.x b/pkg/images/immatch/src/geometry/t_geoxytran.x new file mode 100644 index 00000000..c99b9a0c --- /dev/null +++ b/pkg/images/immatch/src/geometry/t_geoxytran.x @@ -0,0 +1,343 @@ +include <fset.h> +include <ctype.h> +include <math/gsurfit.h> + +define MAX_FIELDS 100 # Maximum number of fields in list +define TABSIZE 8 # Spacing of tab stops + +# Define the permitted computation types +define GEO_REAL 1 # Computation type is real +define GEO_DOUBLE 2 # Computation type is double + +# T_GEOXYTRAN -- Transform a list of x and y coordinates using the geometric +# transformation operations computed by the GEOMAP task. + +procedure t_geoxytran() + +int inlist, outlist, reclist, calctype, geometry, dir, xcolumn, ycolumn +int min_sigdigits, infd, outfd +pointer sp, in_fname, out_fname, record, xformat, yformat, str, dt +pointer sx1, sy1, sx2, sy2 +int clgwrd(), clgeti(), open() +bool streq() +int fntopnb(), fntlenb(), fntgfnb(), imtopenp(), imtlen(), imtgetim() +pointer dtmap() + +begin + # Allocate memory for transformation parameters structure + call smark (sp) + call salloc (in_fname, SZ_FNAME, TY_CHAR) + call salloc (out_fname, SZ_FNAME, TY_CHAR) + call salloc (record, SZ_FNAME, TY_CHAR) + call salloc (xformat, SZ_FNAME, TY_CHAR) + call salloc (yformat, SZ_FNAME, TY_CHAR) + call salloc (str, SZ_LINE, TY_CHAR) + + # Open the input and output file lists. + call clgstr ("input", Memc[str], SZ_FNAME) + if (Memc[str] == EOS) + call strcpy ("STDIN", Memc[str], SZ_FNAME) + inlist = fntopnb(Memc[str], NO) + call clgstr ("output", Memc[str], SZ_FNAME) + if (Memc[str] == EOS) + call strcpy ("STDOUT", Memc[str], SZ_FNAME) + outlist = fntopnb (Memc[str], NO) + call clgstr ("database", Memc[str], SZ_FNAME) + if (Memc[str] != EOS) { + dt = dtmap (Memc[str], READ_ONLY) + reclist = imtopenp ("transforms") + } else { + dt = NULL + reclist = NULL + } + + # Test the input and out file and record lists for validity. + if (fntlenb(inlist) <= 0) + call error (0, "The input file list is empty") + if (fntlenb(outlist) <= 0) + call error (0, "The output file list is empty") + if (fntlenb(outlist) > 1 && fntlenb(outlist) != fntlenb(inlist)) + call error (0, + "Input and output file lists are not the same length") + if (dt != NULL && reclist != NULL) { + if (imtlen (reclist) > 1 && imtlen (reclist) != fntlenb (inlist)) + call error (0, + "Input file and record lists are not the same length.") + } + + # Get geometry and transformation direction. + geometry = clgwrd ("geometry", Memc[str], SZ_LINE, + ",linear,distortion,geometric,") + dir = clgwrd ("direction", Memc[str], SZ_LINE, + ",forward,backward,") + + # Get field numbers from cl + if (dir == 1) + calctype = clgwrd ("calctype", Memc[str], SZ_LINE, + ",real,double,") + else + calctype = GEO_DOUBLE + xcolumn = clgeti ("xcolumn") + ycolumn = clgeti ("ycolumn") + call clgstr ("xformat", Memc[xformat], SZ_FNAME) + call clgstr ("yformat", Memc[yformat], SZ_FNAME) + min_sigdigits = clgeti ("min_sigdigits") + + # Get the output file name. + if (fntgfnb (outlist, Memc[out_fname], SZ_FNAME) == EOF) + call strcpy ("STDOUT", Memc[out_fname], SZ_FNAME) + outfd = open (Memc[out_fname], NEW_FILE, TEXT_FILE) + if (streq (Memc[out_fname], "STDOUT") || outfd == STDOUT) + call fseti (outfd, F_FLUSHNL, YES) + + # Get the record name. + if (reclist == NULL) + Memc[record] = EOS + else if (imtgetim (reclist, Memc[record], SZ_FNAME) == EOF) + Memc[record] = EOS + + # Call procedure to get parameters and fill structure. + sx1 = NULL; sy1 = NULL; sx2 = NULL; sy2 = NULL + call geo_init_transform (dt, Memc[record], calctype, geometry, + sx1, sy1, sx2, sy2) + + # While input list is not depleted, open file and transform list. + while (fntgfnb (inlist, Memc[in_fname], SZ_FNAME) != EOF) { + + infd = open (Memc[in_fname], READ_ONLY, TEXT_FILE) + + # Transform the coordinates. + call geo_transform_file (infd, outfd, xcolumn, ycolumn, dir, + calctype, Memc[xformat], Memc[yformat], min_sigdigits, + sx1, sy1, sx2, sy2) + + # Do not get a new output file name if there is not output + # file list or if only one output file was specified. + # Otherwise fetch the new name. + if (fntlenb(outlist) > 1) { + call close (outfd) + if (fntgfnb (outlist, Memc[out_fname], SZ_FNAME) != EOF) + outfd = open (Memc[out_fname], NEW_FILE, TEXT_FILE) + if (streq (Memc[out_fname], "STDOUT") || outfd == STDOUT) + call fseti (outfd, F_FLUSHNL, YES) + } + + call close (infd) + + # Do not reset the transformation if there is no record list + # or only one record is specified. Otherwise fetch the next + # record name. + if (reclist != NULL && imtlen (reclist) > 1) { + if (imtgetim (reclist, Memc[record], SZ_FNAME) != EOF) { + call geo_free_transform (calctype, sx1, sy1, sx2, sy2) + call geo_init_transform (dt, Memc[record], calctype, + geometry, sx1, sy1, sx2, sy2) + } + } + } + + # Free the surface descriptors. + call geo_free_transform (calctype, sx1, sy1, sx2, sy2) + + # Close up file and record templates. + if (dt != NULL) + call dtunmap (dt) + call close (outfd) + call fntclsb (inlist) + call fntclsb (outlist) + if (reclist != NULL) + call imtclose (reclist) + call sfree (sp) +end + + +# GEO_INIT_TRANSFORM -- gets parameter values relevant to the +# transformation from the cl. List entries will be transformed +# in procedure rg_transform. + +procedure geo_init_transform (dt, record, calctype, geometry, sx1, sy1, + sx2, sy2) + +pointer dt #I pointer to database file produced by geomap +char record[ARB] #I the name of the database record +int calctype #I the computation data type +int geometry #I the type of geometry to be computed +pointer sx1, sy1 #O pointers to the linear x and y surfaces +pointer sx2, sy2 #O pointers to the x and y distortion surfaces + +begin + if (dt == NULL) { + + if (calctype == GEO_REAL) + call geo_linitr (sx1, sy1, sx2, sy2) + else + call geo_linitd (sx1, sy1, sx2, sy2) + + } else { + + if (calctype == GEO_REAL) + call geo_sinitr (dt, record, geometry, sx1, sy1, + sx2, sy2) + else + call geo_sinitd (dt, record, geometry, sx1, sy1, + sx2, sy2) + } +end + + +# GEO_FREE_TRANSFORM -- Free the previously defined transformation + +procedure geo_free_transform (calctype, sx1, sy1, sx2, sy2) + +int calctype #I the computation data type +pointer sx1, sy1 #O pointers to the linear x and y surfaces +pointer sx2, sy2 #O pointers to the x and y distortion surfaces + +begin + if (calctype == GEO_REAL) + call geo_sfreer (sx1, sy1, sx2, sy2) + else + call geo_sfreed (sx1, sy1, sx2, sy2) +end + + +# GEO_TRANSFORM_FILE -- This procedure is called once for each file +# in the input list. For each line in the input file that isn't +# blank or comment, the line is transformed. Blank and comment +# lines are output unaltered. + +procedure geo_transform_file (infd, outfd, xfield, yfield, dir, calctype, + xformat, yformat, min_sigdigits, sx1, sy1, sx2, sy2) + +int infd #I the input file descriptor +int outfd #I the output file descriptor +int xfield #I the x column number +int yfield #I the y column number +int dir #I transform direction +int calctype #I the computation type +char xformat[ARB] #I output format of the x coordinate +char yformat[ARB] #I output format of the y coordinate +int min_sigdigits #I the minimum number of digits to be output +pointer sx1, sy1 #I pointers to the linear x and y surfaces +pointer sx2, sy2 #I pointers to the x and y distortion surfaces + +double xd, yd, xtd, ytd +int max_fields, nline, nfields, nchars, nsdig_x, nsdig_y, offset +real xr, yr, xtr, ytr +pointer sp, inbuf, linebuf, field_pos, outbuf, ip +int getline(), li_get_numr(), li_get_numd() + +int nsx, nsy +double der[8], xmin, xmax, ymin, ymax, tol +pointer sx[2], sy[2] +double dgsgetd() + +#double x, y, xt, yt + +begin + call smark (sp) + call salloc (inbuf, SZ_LINE, TY_CHAR) + call salloc (linebuf, SZ_LINE, TY_CHAR) + call salloc (field_pos, MAX_FIELDS, TY_INT) + call salloc (outbuf, SZ_LINE, TY_CHAR) + + max_fields = MAX_FIELDS + + # Initialize for backward transform. + if (dir == 2) { + sx[1] = sx1; sy[1] = sy1; sx[2] = sx2; sy[2] = sy2 + nsx = 2; nsy = 2 + if (sx2 == NULL) + nsx = 1 + if (sy2 == NULL) + nsy = 1 + xmin = dgsgetd (sx1, GSXMIN) + xmax = dgsgetd (sx1, GSXMAX) + ymin = dgsgetd (sx1, GSYMIN) + ymax = dgsgetd (sx1, GSYMAX) + tol = abs (xmax - xmin) / 1E10 + xd = (xmin + xmax) / 2 + yd = (ymin + ymax) / 2 + call tr_init (sx, nsx, sy, nsy, xd, yd, der) + } + + for (nline=1; getline (infd, Memc[inbuf]) != EOF; nline = nline + 1) { + for (ip=inbuf; IS_WHITE(Memc[ip]); ip=ip+1) + ; + if (Memc[ip] == '#') { + # Pass comment lines on to the output unchanged. + call putline (outfd, Memc[inbuf]) + next + } else if (Memc[ip] == '\n' || Memc[ip] == EOS) { + # Blank lines too. + call putline (outfd, Memc[inbuf]) + next + } + + # Expand tabs into blanks, determine field offsets. + call strdetab (Memc[inbuf], Memc[linebuf], SZ_LINE, TABSIZE) + call li_find_fields (Memc[linebuf], Memi[field_pos], max_fields, + nfields) + + if (xfield > nfields || yfield > nfields) { + call fstats (infd, F_FILENAME, Memc[outbuf], SZ_LINE) + call eprintf ("Not enough fields in file %s line %d\n") + call pargstr (Memc[outbuf]) + call pargi (nline) + call putline (outfd, Memc[linebuf]) + next + } + + offset = Memi[field_pos+xfield-1] + if (calctype == GEO_REAL) + nchars = li_get_numr (Memc[linebuf+offset-1], xr, nsdig_x) + else + nchars = li_get_numd (Memc[linebuf+offset-1], xd, nsdig_x) + if (nchars == 0) { + call fstats (infd, F_FILENAME, Memc[outbuf], SZ_LINE) + call eprintf ("Bad x value in file '%s' at line %d:\n") + call pargstr (Memc[outbuf]) + call pargi (nline) + call putline (outfd, Memc[linebuf]) + next + } + + offset = Memi[field_pos+yfield-1] + if (calctype == GEO_REAL) + nchars = li_get_numr (Memc[linebuf+offset-1], yr, nsdig_y) + else + nchars = li_get_numd (Memc[linebuf+offset-1], yd, nsdig_y) + if (nchars == 0) { + call fstats (infd, F_FILENAME, Memc[outbuf], SZ_LINE) + call eprintf ("Bad y value in file '%s' at line %d:\n") + call pargstr (Memc[outbuf]) + call pargi (nline) + call putline (outfd, Memc[linebuf]) + next + } + + if (calctype == GEO_REAL) { + call geo_do_transformr (xr, yr, xtr, ytr, + sx1, sy1, sx2, sy2) + call li_pack_liner (Memc[linebuf], Memc[outbuf], SZ_LINE, + Memi[field_pos], nfields, xfield, yfield, xtr, ytr, + xformat, yformat, nsdig_x, nsdig_y, min_sigdigits) + + } else { + if (dir == 1) + call geo_do_transformd (xd, yd, xtd, ytd, + sx1, sy1, sx2, sy2) + else + call tr_invert (sx, nsx, sy, nsy, xd, yd, xtd, ytd, + der, xmin, xmax, ymin, ymax, tol) + call li_pack_lined (Memc[linebuf], Memc[outbuf], SZ_LINE, + Memi[field_pos], nfields, xfield, yfield, xtd, ytd, + xformat, yformat, nsdig_x, nsdig_y, min_sigdigits) + } + + call putline (outfd, Memc[outbuf]) + } + + call sfree (sp) +end + diff --git a/pkg/images/immatch/src/geometry/trinvert.x b/pkg/images/immatch/src/geometry/trinvert.x new file mode 100644 index 00000000..5f75cdc2 --- /dev/null +++ b/pkg/images/immatch/src/geometry/trinvert.x @@ -0,0 +1,163 @@ +# The code here is taken from t_transform.x in the longslit package. The +# changes are to use a sum instead of an average when multiple surfaces +# are given and not to use the xgs interface. Also the convergence +# tolerance is user specified since in this application the units might +# not be pixels. + + +define MAX_ITERATE 20 +define ERROR 0.05 +define FUDGE 0.5 + +# TR_INVERT -- Given user coordinate surfaces U(X,Y) and V(X,Y) +# (if none use one-to-one mapping and if more than one sum) +# corresponding to a given U and V and also the various partial +# derivatives. This is done using a gradient following interative +# method based on evaluating the partial derivative at each point +# and solving the linear Taylor expansions simultaneously. The last +# point sampled is used as the starting point. Thus, if the +# input U and V progress smoothly then the number of iterations +# can be small. The output is returned in x and y and in the derivative array +# DER. A point outside of the surfaces is returned as the nearest +# point at the edge of the surfaces in the DER array. + +procedure tr_invert (usf, nusf, vsf, nvsf, u, v, x, y, der, + xmin, xmax, ymin, ymax, tol) + +pointer usf[ARB], vsf[ARB] # User coordinate surfaces U(X,Y) and V(X,Y) +int nusf, nvsf # Number of surfaces for each coordinate +double u, v # Input U and V to determine X and Y +double x, y # Output X and Y +double der[8] # Last result as input, new result as output + # 1=X, 2=Y, 3=U, 4=DUDX, 5=DUDY, 6=V, + # 7=DVDX, 8=DVDY +double xmin, xmax, ymin, ymax # Limits of coordinate surfaces. +double tol # Tolerance + +int i, j, nedge +double fudge, du, dv, dx, dy, tmp[3] + +begin + # Use the last result as the starting point for the next position. + # If this is near the desired value then the interation will converge + # quickly. Allow a iteration to go off the surface twice. + # Quit when DX and DY are within tol. + + nedge = 0 + do i = 1, MAX_ITERATE { + du = u - der[3] + dv = v - der[6] + dx = (der[8] * du - der[5] * dv) / + (der[8] * der[4] - der[5] * der[7]) + dy = (dv - der[7] * dx) / der[8] + fudge = 1 - FUDGE / i + x = der[1] + fudge * dx + y = der[2] + fudge * dy + der[1] = max (xmin, min (xmax, x)) + der[2] = max (ymin, min (ymax, y)) + if ((abs (dx) < tol) && (abs (dy) < tol)) + break + + if (nusf == 0) + der[3] = der[1] + else if (nusf == 1) { + call dgsder (usf[1], der[1], der[2], der[3], 1, 0, 0) + call dgsder (usf[1], der[1], der[2], der[4], 1, 1, 0) + call dgsder (usf[1], der[1], der[2], der[5], 1, 0, 1) + } else { + call dgsder (usf[1], der[1], der[2], der[3], 1, 0, 0) + call dgsder (usf[1], der[1], der[2], der[4], 1, 1, 0) + call dgsder (usf[1], der[1], der[2], der[5], 1, 0, 1) + do j = 2, nusf { + call dgsder (usf[j], der[1], der[2], tmp[1], 1, 0, 0) + call dgsder (usf[j], der[1], der[2], tmp[2], 1, 1, 0) + call dgsder (usf[j], der[1], der[2], tmp[3], 1, 0, 1) + der[3] = der[3] + tmp[1] + der[4] = der[4] + tmp[2] + der[5] = der[5] + tmp[3] + } + } + + if (nvsf == 0) + der[6] = der[2] + else if (nvsf == 1) { + call dgsder (vsf[1], der[1], der[2], der[6], 1, 0, 0) + call dgsder (vsf[1], der[1], der[2], der[7], 1, 1, 0) + call dgsder (vsf[1], der[1], der[2], der[8], 1, 0, 1) + } else { + call dgsder (vsf[1], der[1], der[2], der[6], 1, 0, 0) + call dgsder (vsf[1], der[1], der[2], der[7], 1, 1, 0) + call dgsder (vsf[1], der[1], der[2], der[8], 1, 0, 1) + do j = 2, nvsf { + call dgsder (vsf[j], der[1], der[2], tmp[1], 1, 0, 0) + call dgsder (vsf[j], der[1], der[2], tmp[2], 1, 1, 0) + call dgsder (vsf[j], der[1], der[2], tmp[3], 1, 0, 1) + der[6] = der[6] + tmp[1] + der[7] = der[7] + tmp[2] + der[8] = der[8] + tmp[3] + } + } + } +end + + +# TR_INIT -- Since the inversion iteration always begins from the last +# point we need to initialize before the first call to TR_INVERT. + +procedure tr_init (usf, nusf, vsf, nvsf, x, y, der) + +pointer usf[ARB], vsf[ARB] # User coordinate surfaces +int nusf, nvsf # Number of surfaces for each coordinate +double x, y # Starting X and Y +double der[8] # Inversion data + +int j +double tmp[3] + +begin + der[1] = x + der[2] = y + if (nusf == 0) { + der[3] = der[1] + der[4] = 1. + der[5] = 0. + } else if (nusf == 1) { + call dgsder (usf[1], der[1], der[2], der[3], 1, 0, 0) + call dgsder (usf[1], der[1], der[2], der[4], 1, 1, 0) + call dgsder (usf[1], der[1], der[2], der[5], 1, 0, 1) + } else { + call dgsder (usf[1], der[1], der[2], der[3], 1, 0, 0) + call dgsder (usf[1], der[1], der[2], der[4], 1, 1, 0) + call dgsder (usf[1], der[1], der[2], der[5], 1, 0, 1) + do j = 2, nusf { + call dgsder (usf[j], der[1], der[2], tmp[1], 1, 0, 0) + call dgsder (usf[j], der[1], der[2], tmp[2], 1, 1, 0) + call dgsder (usf[j], der[1], der[2], tmp[3], 1, 0, 1) + der[3] = der[3] + tmp[1] + der[4] = der[4] + tmp[2] + der[5] = der[5] + tmp[3] + } + } + + if (nvsf == 0) { + der[6] = der[2] + der[7] = 0. + der[8] = 1. + } else if (nvsf == 1) { + call dgsder (vsf[1], der[1], der[2], der[6], 1, 0, 0) + call dgsder (vsf[1], der[1], der[2], der[7], 1, 1, 0) + call dgsder (vsf[1], der[1], der[2], der[8], 1, 0, 1) + } else { + call dgsder (vsf[1], der[1], der[2], der[6], 1, 0, 0) + call dgsder (vsf[1], der[1], der[2], der[7], 1, 1, 0) + call dgsder (vsf[1], der[1], der[2], der[8], 1, 0, 1) + do j = 2, nvsf { + call dgsder (vsf[j], der[1], der[2], tmp[1], 1, 0, 0) + call dgsder (vsf[j], der[1], der[2], tmp[2], 1, 1, 0) + call dgsder (vsf[j], der[1], der[2], tmp[3], 1, 0, 1) + der[6] = der[6] + tmp[1] + der[7] = der[7] + tmp[2] + der[8] = der[8] + tmp[3] + } + } +end diff --git a/pkg/images/immatch/src/imcombine/imcombine.par b/pkg/images/immatch/src/imcombine/imcombine.par new file mode 100644 index 00000000..ead908e4 --- /dev/null +++ b/pkg/images/immatch/src/imcombine/imcombine.par @@ -0,0 +1,43 @@ +# IMCOMBINE -- Image combine parameters + +input,s,a,,,,List of images to combine +output,s,a,,,,List of output images +headers,s,h,"",,,List of header files (optional) +bpmasks,s,h,"",,,List of bad pixel masks (optional) +rejmasks,s,h,"",,,List of rejection masks (optional) +nrejmasks,s,h,"",,,List of number rejected masks (optional) +expmasks,s,h,"",,,List of exposure masks (optional) +sigmas,s,h,"",,,List of sigma images (optional) +imcmb,s,h,"$I",,,Keyword for IMCMB keywords +logfile,s,h,"STDOUT",,,"Log file +" +combine,s,h,"average","average|median|lmedian|sum|quadrature|nmodel",,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 +outlimits,s,h,"",,,Output limits (x1 x2 y1 y2 ...) +offsets,f,h,"none",,,Input image offsets +masktype,s,h,"none","",,Mask type +maskvalue,s,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 +expname,s,h,"",,,"Image header exposure time keyword +" +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,r,h,0.,0.,,Radius (pixels) for neighbor rejection diff --git a/pkg/images/immatch/src/imcombine/mkpkg b/pkg/images/immatch/src/imcombine/mkpkg new file mode 100644 index 00000000..456232e8 --- /dev/null +++ b/pkg/images/immatch/src/imcombine/mkpkg @@ -0,0 +1,20 @@ +# Make the IMCOMBINE Task. + +$checkout libpkg.a ../../../ +$update libpkg.a +$checkin libpkg.a ../../../ +$exit + +standalone: + $set LIBS1 = "src/libimc.a -lxtools -lcurfit -lsurfit -lgsurfit" + $set LIBS2 = "-liminterp -lnlfit -lslalib -lncar -lgks" + $update libimc.a@src + $update libpkg.a + $omake x_imcombine.x + $link x_imcombine.o libpkg.a $(LIBS1) $(LIBS2) -o xx_imcombine.e + ; + +libpkg.a: + t_imcombine.x src/icombine.com src/icombine.h <error.h> <mach.h> \ + <imhdr.h> + ; diff --git a/pkg/images/immatch/src/imcombine/src/Revisions b/pkg/images/immatch/src/imcombine/src/Revisions new file mode 100644 index 00000000..469f9e5c --- /dev/null +++ b/pkg/images/immatch/src/imcombine/src/Revisions @@ -0,0 +1,36 @@ +.help revisions Jul04 imcombine/src +.nf + +This directory contains generic code used in various tasks that combine +images. + +======= +V2.13 +======= + +icgdata.gx + Fixed a problem where 3-D images were closing an image in the case + of many bands leading to a slow execution (10/20/06, Valdes) + +======= +V2.12.3 +======= + +icmask.x +iclog.x +icombine.h + As a special unadvertised feature the "maskvalue" parameter may be + specified with a leading '<' or '>'. Ultimately a full expression + should be added and documented. (7/26/04, Valdes) + +icmask.x + Added a feature to allow masks specified without a path to be found + either in the current directory or the directory with the image. This + is useful when images to be combined are distributed across multiple + directories. (7/16/04, Valdes) + +======== +V2.12.2a +======== + +.endhelp diff --git a/pkg/images/immatch/src/imcombine/src/generic/icaclip.x b/pkg/images/immatch/src/imcombine/src/generic/icaclip.x new file mode 100644 index 00000000..8fb89b1b --- /dev/null +++ b/pkg/images/immatch/src/imcombine/src/generic/icaclip.x @@ -0,0 +1,2207 @@ +# 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 = max (0, n[1]) + s = 0. + n2 = 0 + do i = 1, npts { + k = i - 1 + n1 = max (0, 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 = max (0, 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 (max (0, 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, sig, 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 = max (0, n[1]) + do i = 1, npts { + k = i - 1 + n1 = max (0, 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) + sig = sqrt (s / (n2 - 1)) + else { + call sfree (sp) + return + } + + # Compute individual sigmas and iteratively clip. + do i = 1, npts { + k = i - 1 + n1 = max (0, 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) && sig > 0.) { + if (doscale1) { + for (; nl <= nh; nl = nl + 1) { + l = Memi[m[nl]+k] + s1 = sig * 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 = sig * 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 = sig * sqrt (max (one, med)) + for (; nl <= nh; 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 == max (0, 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 >= 1.)) { + j = max (nl, n1 + 1) + if (keepids) { + do l = 1, min (n1, nl-1) { + Mems[d[l]+k] = Mems[d[j]+k] + if (grow >= 1.) { + 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 (max (0, 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_aavsigclipi (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 = max (0, n[1]) + s = 0. + n2 = 0 + do i = 1, npts { + k = i - 1 + n1 = max (0, n[i]) + if (n1 < 3) + next + + # Unweighted average with the high and low rejected + low = Memi[d[1]+k] + high = Memi[d[2]+k] + if (low > high) { + d1 = low + low = high + high = d1 + } + sum = 0. + do j = 3, n1 { + d1 = Memi[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 = Memi[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 + (Memi[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 = max (0, 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 = Memi[d[1]+k] + do j = 2, n1 + sum = sum + Memi[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 = Memi[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 + Memi[dp1] = Memi[dp2] + Memi[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 = Memi[dp1] + r = (d1 - a) / s1 + if (r < -lsigma || r > hsigma) { + Memr[resid+n1] = abs(r) + if (j < n1) { + dp2 = d[n1] + k + Memi[dp1] = Memi[dp2] + Memi[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 = Memi[dp1] + Memi[dp1] = Memi[dp2] + Memi[dp2] = d1 + mp2 = m[l] + k + s = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = s + } + } + } + sum = sum + Memi[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 = Memi[dp1] + Memi[dp1] = Memi[dp2] + Memi[dp2] = d1 + if (keepids) { + mp1 = m[j] + k + mp2 = m[l] + k + s = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = s + } + } + } + } + sum = sum + Memi[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 (max (0, 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_mavsigclipi (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, sig, 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 = max (0, n[1]) + do i = 1, npts { + k = i - 1 + n1 = max (0, n[i]) + if (n1 < 3) { + if (n1 == 0) + median[i] = blank + else if (n1 == 1) + median[i] = Memi[d[1]+k] + else { + low = Memi[d[1]+k] + high = Memi[d[2]+k] + median[i] = (low + high) / 2. + } + next + } + + # Median + n3 = 1 + n1 / 2 + if (mod (n1, 2) == 0) { + low = Memi[d[n3-1]+k] + high = Memi[d[n3]+k] + med = (low + high) / 2. + } else + med = Memi[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 + (Memi[d[j]+k] - med) ** 2 / s1 + } + } else { + s1 = max (one, med) + do j = 1, n1 + s = s + (Memi[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) + sig = sqrt (s / (n2 - 1)) + else { + call sfree (sp) + return + } + + # Compute individual sigmas and iteratively clip. + do i = 1, npts { + k = i - 1 + n1 = max (0, 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) && sig > 0.) { + if (doscale1) { + for (; nl <= nh; nl = nl + 1) { + l = Memi[m[nl]+k] + s1 = sig * sqrt (max (one, (med+zeros[l])/scales[l])) + r = (med - Memi[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 = sig * sqrt (max (one, (med+zeros[l])/scales[l])) + r = (Memi[d[nh]+k] - med) / s1 + if (r <= hsigma) + break + Memr[resid+nh] = r + n1 = n1 - 1 + } + } else { + s1 = sig * sqrt (max (one, med)) + for (; nl <= nh; nl = nl + 1) { + r = (med - Memi[d[nl]+k]) / s1 + if (r <= lsigma) + break + Memr[resid+nl] = r + n1 = n1 - 1 + } + for (; nh >= nl; nh = nh - 1) { + r = (Memi[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 = Memi[d[n3-1]+k] + high = Memi[d[n3]+k] + med = (low + high) / 2. + } else + med = Memi[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 == max (0, 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 = Memi[d[n3-1]+k] + high = Memi[d[n3]+k] + med = (low + high) / 2. + } else + med = Memi[d[n3]+k] + } else + med = blank + } + } + + # Only set median and reorder if needed + n[i] = n1 + if (n1 > 0 && nl > 1 && (combine != MEDIAN || grow >= 1.)) { + j = max (nl, n1 + 1) + if (keepids) { + do l = 1, min (n1, nl-1) { + Memi[d[l]+k] = Memi[d[j]+k] + if (grow >= 1.) { + 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) { + Memi[d[l]+k] = Memi[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 (max (0, 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 = max (0, n[1]) + s = 0. + n2 = 0 + do i = 1, npts { + k = i - 1 + n1 = max (0, 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 = max (0, 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 (max (0, 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, sig, 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 = max (0, n[1]) + do i = 1, npts { + k = i - 1 + n1 = max (0, 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) + sig = sqrt (s / (n2 - 1)) + else { + call sfree (sp) + return + } + + # Compute individual sigmas and iteratively clip. + do i = 1, npts { + k = i - 1 + n1 = max (0, 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) && sig > 0.) { + if (doscale1) { + for (; nl <= nh; nl = nl + 1) { + l = Memi[m[nl]+k] + s1 = sig * 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 = sig * 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 = sig * sqrt (max (one, med)) + for (; nl <= nh; 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 == max (0, 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 >= 1.)) { + j = max (nl, n1 + 1) + if (keepids) { + do l = 1, min (n1, nl-1) { + Memr[d[l]+k] = Memr[d[j]+k] + if (grow >= 1.) { + 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 (max (0, 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_aavsigclipd (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 +double average[npts] # Average + +int i, j, k, l, jj, n1, n2, nin, nk, maxkeep +double d1, low, high, sum, a, s, s1, r, one +data one /1.0D0/ +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 = max (0, n[1]) + s = 0. + n2 = 0 + do i = 1, npts { + k = i - 1 + n1 = max (0, n[i]) + if (n1 < 3) + next + + # Unweighted average with the high and low rejected + low = Memd[d[1]+k] + high = Memd[d[2]+k] + if (low > high) { + d1 = low + low = high + high = d1 + } + sum = 0. + do j = 3, n1 { + d1 = Memd[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 = Memd[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 + (Memd[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 = max (0, 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 = Memd[d[1]+k] + do j = 2, n1 + sum = sum + Memd[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 = Memd[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 + Memd[dp1] = Memd[dp2] + Memd[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 = Memd[dp1] + r = (d1 - a) / s1 + if (r < -lsigma || r > hsigma) { + Memr[resid+n1] = abs(r) + if (j < n1) { + dp2 = d[n1] + k + Memd[dp1] = Memd[dp2] + Memd[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 = Memd[dp1] + Memd[dp1] = Memd[dp2] + Memd[dp2] = d1 + mp2 = m[l] + k + s = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = s + } + } + } + sum = sum + Memd[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 = Memd[dp1] + Memd[dp1] = Memd[dp2] + Memd[dp2] = d1 + if (keepids) { + mp1 = m[j] + k + mp2 = m[l] + k + s = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = s + } + } + } + } + sum = sum + Memd[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 (max (0, 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_mavsigclipd (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 +double median[npts] # Median + +int i, j, k, l, id, n1, n2, n3, nl, nh, nin, maxkeep +pointer sp, resid, mp1, mp2 +double med, low, high, sig, r, s, s1, one +data one /1.0D0/ + +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 = max (0, n[1]) + do i = 1, npts { + k = i - 1 + n1 = max (0, n[i]) + if (n1 < 3) { + if (n1 == 0) + median[i] = blank + else if (n1 == 1) + median[i] = Memd[d[1]+k] + else { + low = Memd[d[1]+k] + high = Memd[d[2]+k] + median[i] = (low + high) / 2. + } + next + } + + # Median + n3 = 1 + n1 / 2 + if (mod (n1, 2) == 0) { + low = Memd[d[n3-1]+k] + high = Memd[d[n3]+k] + med = (low + high) / 2. + } else + med = Memd[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 + (Memd[d[j]+k] - med) ** 2 / s1 + } + } else { + s1 = max (one, med) + do j = 1, n1 + s = s + (Memd[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) + sig = sqrt (s / (n2 - 1)) + else { + call sfree (sp) + return + } + + # Compute individual sigmas and iteratively clip. + do i = 1, npts { + k = i - 1 + n1 = max (0, 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) && sig > 0.) { + if (doscale1) { + for (; nl <= nh; nl = nl + 1) { + l = Memi[m[nl]+k] + s1 = sig * sqrt (max (one, (med+zeros[l])/scales[l])) + r = (med - Memd[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 = sig * sqrt (max (one, (med+zeros[l])/scales[l])) + r = (Memd[d[nh]+k] - med) / s1 + if (r <= hsigma) + break + Memr[resid+nh] = r + n1 = n1 - 1 + } + } else { + s1 = sig * sqrt (max (one, med)) + for (; nl <= nh; nl = nl + 1) { + r = (med - Memd[d[nl]+k]) / s1 + if (r <= lsigma) + break + Memr[resid+nl] = r + n1 = n1 - 1 + } + for (; nh >= nl; nh = nh - 1) { + r = (Memd[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 = Memd[d[n3-1]+k] + high = Memd[d[n3]+k] + med = (low + high) / 2. + } else + med = Memd[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 == max (0, 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 = Memd[d[n3-1]+k] + high = Memd[d[n3]+k] + med = (low + high) / 2. + } else + med = Memd[d[n3]+k] + } else + med = blank + } + } + + # Only set median and reorder if needed + n[i] = n1 + if (n1 > 0 && nl > 1 && (combine != MEDIAN || grow >= 1.)) { + j = max (nl, n1 + 1) + if (keepids) { + do l = 1, min (n1, nl-1) { + Memd[d[l]+k] = Memd[d[j]+k] + if (grow >= 1.) { + 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) { + Memd[d[l]+k] = Memd[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 (max (0, 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/pkg/images/immatch/src/imcombine/src/generic/icaverage.x b/pkg/images/immatch/src/imcombine/src/generic/icaverage.x new file mode 100644 index 00000000..7167d301 --- /dev/null +++ b/pkg/images/immatch/src/imcombine/src/generic/icaverage.x @@ -0,0 +1,424 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> +include <mach.h> +include "../icombine.h" +include "../icmask.h" + + +# IC_AVERAGE -- Compute the average (or summed) image line. +# Options include a weighted average/sum. + +procedure ic_averages (d, m, n, wts, nimages, npts, doblank, doaverage, + average) + +pointer d[nimages] # Data pointers +pointer m[nimages] # Image ID pointers +int n[npts] # Number of points +real wts[nimages] # Weights +int nimages # Number of images +int npts # Number of output points per line +int doblank # Set blank values? +int doaverage # Do average? +real average[npts] # Average (returned) + +int i, j, k, n1 +real sumwt, wt +real sum + +include "../icombine.com" + +begin + # If no data has been excluded do the average/sum 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/sum + # to the blank value if requested. + + if (dflag == D_ALL) { + if (dowts && doaverage == YES) { + 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] + if (doaverage == YES) + average[i] = sum / n[i] + else + average[i] = sum + } + } + } else if (dflag == D_NONE) { + if (doblank == YES) { + do i = 1, npts + average[i] = blank + } + } else { + if (dowts && doaverage == YES) { + do i = 1, npts { + n1 = abs(n[i]) + if (n1 > 0) { + k = i - 1 + wt = wts[Memi[m[1]+k]] + sum = Mems[d[1]+k] * wt + sumwt = wt + do j = 2, n1 { + wt = wts[Memi[m[j]+k]] + sum = sum + Mems[d[j]+k] * wt + sumwt = sumwt + wt + } + if (doaverage == YES) { + if (sumwt > 0) + average[i] = sum / sumwt + else { + sum = Mems[d[1]+k] + do j = 2, n1 + sum = sum + Mems[d[j]+k] + average[i] = sum / n1 + } + } else + average[i] = sum + } else if (doblank == YES) + average[i] = blank + } + } else { + do i = 1, npts { + n1 = abs(n[i]) + if (n1 > 0) { + k = i - 1 + sum = Mems[d[1]+k] + do j = 2, n1 + sum = sum + Mems[d[j]+k] + if (doaverage == YES) + average[i] = sum / n1 + else + average[i] = sum + } else if (doblank == YES) + average[i] = blank + } + } + } +end + +# IC_AVERAGE -- Compute the average (or summed) image line. +# Options include a weighted average/sum. + +procedure ic_averagei (d, m, n, wts, nimages, npts, doblank, doaverage, + average) + +pointer d[nimages] # Data pointers +pointer m[nimages] # Image ID pointers +int n[npts] # Number of points +real wts[nimages] # Weights +int nimages # Number of images +int npts # Number of output points per line +int doblank # Set blank values? +int doaverage # Do average? +real average[npts] # Average (returned) + +int i, j, k, n1 +real sumwt, wt +real sum + +include "../icombine.com" + +begin + # If no data has been excluded do the average/sum 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/sum + # to the blank value if requested. + + if (dflag == D_ALL) { + if (dowts && doaverage == YES) { + do i = 1, npts { + k = i - 1 + wt = wts[Memi[m[1]+k]] + sum = Memi[d[1]+k] * wt + do j = 2, n[i] { + wt = wts[Memi[m[j]+k]] + sum = sum + Memi[d[j]+k] * wt + } + average[i] = sum + } + } else { + do i = 1, npts { + k = i - 1 + sum = Memi[d[1]+k] + do j = 2, n[i] + sum = sum + Memi[d[j]+k] + if (doaverage == YES) + average[i] = sum / n[i] + else + average[i] = sum + } + } + } else if (dflag == D_NONE) { + if (doblank == YES) { + do i = 1, npts + average[i] = blank + } + } else { + if (dowts && doaverage == YES) { + do i = 1, npts { + n1 = abs(n[i]) + if (n1 > 0) { + k = i - 1 + wt = wts[Memi[m[1]+k]] + sum = Memi[d[1]+k] * wt + sumwt = wt + do j = 2, n1 { + wt = wts[Memi[m[j]+k]] + sum = sum + Memi[d[j]+k] * wt + sumwt = sumwt + wt + } + if (doaverage == YES) { + if (sumwt > 0) + average[i] = sum / sumwt + else { + sum = Memi[d[1]+k] + do j = 2, n1 + sum = sum + Memi[d[j]+k] + average[i] = sum / n1 + } + } else + average[i] = sum + } else if (doblank == YES) + average[i] = blank + } + } else { + do i = 1, npts { + n1 = abs(n[i]) + if (n1 > 0) { + k = i - 1 + sum = Memi[d[1]+k] + do j = 2, n1 + sum = sum + Memi[d[j]+k] + if (doaverage == YES) + average[i] = sum / n1 + else + average[i] = sum + } else if (doblank == YES) + average[i] = blank + } + } + } +end + +# IC_AVERAGE -- Compute the average (or summed) image line. +# Options include a weighted average/sum. + +procedure ic_averager (d, m, n, wts, nimages, npts, doblank, doaverage, + average) + +pointer d[nimages] # Data pointers +pointer m[nimages] # Image ID pointers +int n[npts] # Number of points +real wts[nimages] # Weights +int nimages # Number of images +int npts # Number of output points per line +int doblank # Set blank values? +int doaverage # Do average? +real average[npts] # Average (returned) + +int i, j, k, n1 +real sumwt, wt +real sum + +include "../icombine.com" + +begin + # If no data has been excluded do the average/sum 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/sum + # to the blank value if requested. + + if (dflag == D_ALL) { + if (dowts && doaverage == YES) { + 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] + if (doaverage == YES) + average[i] = sum / n[i] + else + average[i] = sum + } + } + } else if (dflag == D_NONE) { + if (doblank == YES) { + do i = 1, npts + average[i] = blank + } + } else { + if (dowts && doaverage == YES) { + do i = 1, npts { + n1 = abs(n[i]) + if (n1 > 0) { + k = i - 1 + wt = wts[Memi[m[1]+k]] + sum = Memr[d[1]+k] * wt + sumwt = wt + do j = 2, n1 { + wt = wts[Memi[m[j]+k]] + sum = sum + Memr[d[j]+k] * wt + sumwt = sumwt + wt + } + if (doaverage == YES) { + if (sumwt > 0) + average[i] = sum / sumwt + else { + sum = Memr[d[1]+k] + do j = 2, n1 + sum = sum + Memr[d[j]+k] + average[i] = sum / n1 + } + } else + average[i] = sum + } else if (doblank == YES) + average[i] = blank + } + } else { + do i = 1, npts { + n1 = abs(n[i]) + if (n1 > 0) { + k = i - 1 + sum = Memr[d[1]+k] + do j = 2, n1 + sum = sum + Memr[d[j]+k] + if (doaverage == YES) + average[i] = sum / n1 + else + average[i] = sum + } else if (doblank == YES) + average[i] = blank + } + } + } +end + +# IC_AVERAGE -- Compute the average (or summed) image line. +# Options include a weighted average/sum. + +procedure ic_averaged (d, m, n, wts, nimages, npts, doblank, doaverage, + average) + +pointer d[nimages] # Data pointers +pointer m[nimages] # Image ID pointers +int n[npts] # Number of points +real wts[nimages] # Weights +int nimages # Number of images +int npts # Number of output points per line +int doblank # Set blank values? +int doaverage # Do average? +double average[npts] # Average (returned) + +int i, j, k, n1 +real sumwt, wt +double sum + +include "../icombine.com" + +begin + # If no data has been excluded do the average/sum 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/sum + # to the blank value if requested. + + if (dflag == D_ALL) { + if (dowts && doaverage == YES) { + do i = 1, npts { + k = i - 1 + wt = wts[Memi[m[1]+k]] + sum = Memd[d[1]+k] * wt + do j = 2, n[i] { + wt = wts[Memi[m[j]+k]] + sum = sum + Memd[d[j]+k] * wt + } + average[i] = sum + } + } else { + do i = 1, npts { + k = i - 1 + sum = Memd[d[1]+k] + do j = 2, n[i] + sum = sum + Memd[d[j]+k] + if (doaverage == YES) + average[i] = sum / n[i] + else + average[i] = sum + } + } + } else if (dflag == D_NONE) { + if (doblank == YES) { + do i = 1, npts + average[i] = blank + } + } else { + if (dowts && doaverage == YES) { + do i = 1, npts { + n1 = abs(n[i]) + if (n1 > 0) { + k = i - 1 + wt = wts[Memi[m[1]+k]] + sum = Memd[d[1]+k] * wt + sumwt = wt + do j = 2, n1 { + wt = wts[Memi[m[j]+k]] + sum = sum + Memd[d[j]+k] * wt + sumwt = sumwt + wt + } + if (doaverage == YES) { + if (sumwt > 0) + average[i] = sum / sumwt + else { + sum = Memd[d[1]+k] + do j = 2, n1 + sum = sum + Memd[d[j]+k] + average[i] = sum / n1 + } + } else + average[i] = sum + } else if (doblank == YES) + average[i] = blank + } + } else { + do i = 1, npts { + n1 = abs(n[i]) + if (n1 > 0) { + k = i - 1 + sum = Memd[d[1]+k] + do j = 2, n1 + sum = sum + Memd[d[j]+k] + if (doaverage == YES) + average[i] = sum / n1 + else + average[i] = sum + } else if (doblank == YES) + average[i] = blank + } + } + } +end + diff --git a/pkg/images/immatch/src/imcombine/src/generic/iccclip.x b/pkg/images/immatch/src/imcombine/src/generic/iccclip.x new file mode 100644 index 00000000..cf60c779 --- /dev/null +++ b/pkg/images/immatch/src/imcombine/src/generic/iccclip.x @@ -0,0 +1,1791 @@ +# 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 = max (0, n[1]) + do i = 1, npts { + k = i - 1 + n1 = max (0, 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 (max (0, 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 = max (0, n[1]) + do i = 1, npts { + k = i - 1 + n1 = max (0, 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 <= nh; 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 <= nh; 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 == max (0, 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 >= 1.)) { + j = max (nl, n1 + 1) + if (keepids) { + do l = 1, min (n1, nl-1) { + Mems[d[l]+k] = Mems[d[j]+k] + if (grow >= 1.) { + 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 (max (0, 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_accdclipi (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 = max (0, n[1]) + do i = 1, npts { + k = i - 1 + n1 = max (0, 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 = Memi[d[1]+k] + do j = 2, n1 + sum = sum + Memi[d[j]+k] + average[i] = sum / n1 + } + } + next + } + + repeat { + if (n1 == 2) { + sum = Memi[d[1]+k] + sum = sum + Memi[d[2]+k] + a = sum / 2 + } else { + low = Memi[d[1]+k] + high = Memi[d[2]+k] + if (low > high) { + d1 = low + low = high + high = d1 + } + sum = 0. + do j = 3, n1 { + d1 = Memi[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 = Memi[dp1] + r = (d1 - a) / s + if (r < -lsigma || r > hsigma) { + Memr[resid+n1] = abs(r) + if (j < n1) { + dp2 = d[n1] + k + Memi[dp1] = Memi[dp2] + Memi[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 = Memi[dp1] + r = (d1 - a) / s + if (r < -lsigma || r > hsigma) { + Memr[resid+n1] = abs(r) + if (j < n1) { + dp2 = d[n1] + k + Memi[dp1] = Memi[dp2] + Memi[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 = Memi[dp1] + Memi[dp1] = Memi[dp2] + Memi[dp2] = d1 + mp2 = m[l] + k + s = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = s + } + } + } + sum = sum + Memi[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 = Memi[dp1] + Memi[dp1] = Memi[dp2] + Memi[dp2] = d1 + if (keepids) { + mp1 = m[j] + k + mp2 = m[l] + k + s = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = s + } + } + } + } + sum = sum + Memi[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 (max (0, n[i]) != nin) { + dflag = D_MIX + break + } + } + } + + call sfree (sp) +end + + +# IC_CCDCLIP -- Reject pixels using CCD noise parameters about the median + +procedure ic_mccdclipi (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 = max (0, n[1]) + do i = 1, npts { + k = i - 1 + n1 = max (0, 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 = Memi[d[n3-1]+k] + med = (med + Memi[d[n3]+k]) / 2. + } else + med = Memi[d[n3]+k] + + if (n1 >= max (MINCLIP, maxkeep+1)) { + if (doscale1) { + for (; nl <= nh; 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 - Memi[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 = (Memi[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 <= nh; 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 - Memi[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 = (Memi[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 == max (0, 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 >= 1.)) { + j = max (nl, n1 + 1) + if (keepids) { + do l = 1, min (n1, nl-1) { + Memi[d[l]+k] = Memi[d[j]+k] + if (grow >= 1.) { + 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) { + Memi[d[l]+k] = Memi[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 (max (0, 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 = max (0, n[1]) + do i = 1, npts { + k = i - 1 + n1 = max (0, 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 (max (0, 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 = max (0, n[1]) + do i = 1, npts { + k = i - 1 + n1 = max (0, 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 <= nh; 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 <= nh; 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 == max (0, 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 >= 1.)) { + j = max (nl, n1 + 1) + if (keepids) { + do l = 1, min (n1, nl-1) { + Memr[d[l]+k] = Memr[d[j]+k] + if (grow >= 1.) { + 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 (max (0, 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_accdclipd (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 +double average[npts] # Average + +int i, j, k, l, jj, n1, n2, nin, nk, maxkeep +double d1, low, high, sum, a, s, r, zero +data zero /0.0D0/ +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 = max (0, n[1]) + do i = 1, npts { + k = i - 1 + n1 = max (0, 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 = Memd[d[1]+k] + do j = 2, n1 + sum = sum + Memd[d[j]+k] + average[i] = sum / n1 + } + } + next + } + + repeat { + if (n1 == 2) { + sum = Memd[d[1]+k] + sum = sum + Memd[d[2]+k] + a = sum / 2 + } else { + low = Memd[d[1]+k] + high = Memd[d[2]+k] + if (low > high) { + d1 = low + low = high + high = d1 + } + sum = 0. + do j = 3, n1 { + d1 = Memd[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 = Memd[dp1] + r = (d1 - a) / s + if (r < -lsigma || r > hsigma) { + Memr[resid+n1] = abs(r) + if (j < n1) { + dp2 = d[n1] + k + Memd[dp1] = Memd[dp2] + Memd[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 = Memd[dp1] + r = (d1 - a) / s + if (r < -lsigma || r > hsigma) { + Memr[resid+n1] = abs(r) + if (j < n1) { + dp2 = d[n1] + k + Memd[dp1] = Memd[dp2] + Memd[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 = Memd[dp1] + Memd[dp1] = Memd[dp2] + Memd[dp2] = d1 + mp2 = m[l] + k + s = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = s + } + } + } + sum = sum + Memd[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 = Memd[dp1] + Memd[dp1] = Memd[dp2] + Memd[dp2] = d1 + if (keepids) { + mp1 = m[j] + k + mp2 = m[l] + k + s = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = s + } + } + } + } + sum = sum + Memd[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 (max (0, n[i]) != nin) { + dflag = D_MIX + break + } + } + } + + call sfree (sp) +end + + +# IC_CCDCLIP -- Reject pixels using CCD noise parameters about the median + +procedure ic_mccdclipd (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 +double median[npts] # Median + +int i, j, k, l, id, n1, n2, n3, nl, nh, nin, maxkeep +real r, s +pointer sp, resid, mp1, mp2 +double med, zero +data zero /0.0D0/ + +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 = max (0, n[1]) + do i = 1, npts { + k = i - 1 + n1 = max (0, 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 = Memd[d[n3-1]+k] + med = (med + Memd[d[n3]+k]) / 2. + } else + med = Memd[d[n3]+k] + + if (n1 >= max (MINCLIP, maxkeep+1)) { + if (doscale1) { + for (; nl <= nh; 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 - Memd[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 = (Memd[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 <= nh; 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 - Memd[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 = (Memd[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 == max (0, 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 >= 1.)) { + j = max (nl, n1 + 1) + if (keepids) { + do l = 1, min (n1, nl-1) { + Memd[d[l]+k] = Memd[d[j]+k] + if (grow >= 1.) { + 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) { + Memd[d[l]+k] = Memd[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 (max (0, 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/pkg/images/immatch/src/imcombine/src/generic/icgdata.x b/pkg/images/immatch/src/imcombine/src/generic/icgdata.x new file mode 100644 index 00000000..774de63c --- /dev/null +++ b/pkg/images/immatch/src/imcombine/src/generic/icgdata.x @@ -0,0 +1,1531 @@ +# 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 kept 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 +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 + +short temp +int i, j, k, l, n1, n2, npix, nin, nout, ndim, nused, mtype, xt_imgnls() +real a, b +pointer buf, dp, ip, mp +errchk xt_cpix, xt_imgnls + +short max_pixel +data max_pixel/MAX_SHORT/ + +include "../icombine.com" + +begin + # Get masks and return if there is no data + call ic_mget (in, out, offsets, v1, v2, m, lflag, nimages, mtype) + if (dflag == D_NONE) { + call aclri (n, npts) + return + } + + # Close images which are not needed. + nout = IM_LEN(out[1],1) + ndim = IM_NDIM(out[1]) + if (!project && ndim < 3) { + do i = 1, nimages { + nin = IM_LEN(in[i],1) + j = max (0, offsets[i,1]) + k = min (nout, nin + offsets[i,1]) + npix = k - j + if (npix < 1) + call xt_cpix (i) + if (ndim > 1) { + j = v1[2] - offsets[i,2] + if (j < 1 || j > IM_LEN(in[i],2)) + call xt_cpix (i) + } + } + } + + # Get data and fill data buffers. Correct for offsets if needed. + do i = 1, nimages { + if (lflag[i] == D_NONE) + next + if (dbuf[i] == NULL) { + call amovl (v1, v2, IM_MAXDIM) + if (project) + v2[ndim+1] = i + j = xt_imgnls (in[i], i, d[i], v2, v1[2]) + } else { + nin = IM_LEN(in[i],1) + j = max (0, offsets[i,1]) + k = min (nout, nin + offsets[i,1]) + npix = k - j + if (npix < 1) { + lflag[i] = D_NONE + next + } + k = 1 + j - offsets[i,1] + v2[1] = k + do l = 2, ndim { + v2[l] = v1[l] - offsets[i,l] + if (v2[l] < 1 || v2[l] > IM_LEN(in[i],l)) { + lflag[i] = D_NONE + break + } + } + if (lflag[i] == D_NONE) + next + if (project) + v2[ndim+1] = i + l = xt_imgnls (in[i], i, buf, v2, v1[2]) + call amovs (Mems[buf+k-1], Mems[dbuf[i]+j], npix) + d[i] = dbuf[i] + } + } + + # Set values to max_pixel if needed. + if (mtype == M_NOVAL) { + do i = 1, nimages { + dp = d[i]; mp = m[i] + if (lflag[i] == D_NONE || dp == NULL) + next + else if (lflag[i] == D_MIX) { + do j = 1, npts { + if (Memi[mp] == 1) + Mems[dp] = max_pixel + dp = dp + 1 + mp = mp + 1 + } + } + } + } + + # Apply threshold if needed + if (dothresh) { + do i = 1, nimages { + if (lflag[i] == D_ALL) { + dp = d[i] + do j = 1, npts { + a = Mems[dp] + if (a < lthresh || a > hthresh) { + if (mtype == M_NOVAL) + Memi[m[i]+j-1] = 2 + else + Memi[m[i]+j-1] = 1 + + lflag[i] = D_MIX + dflag = D_MIX + } + dp = dp + 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 + } + } + } else if (lflag[i] == D_MIX) { + nin = IM_LEN(in[i],1) + j = max (0, offsets[i,1]) + k = min (nout, nin + offsets[i,1]) + npix = k - j + n1 = 1 + j + n2 = n1 + npix - 1 + dp = d[i] + n1 - 1 + mp = m[i] + n1 - 1 + do j = n1, n2 { + if (Memi[mp] != 1) { + a = Mems[dp] + if (a < lthresh || a > hthresh) { + if (mtype == M_NOVAL) + Memi[m[i]+j-1] = 2 + else + Memi[m[i]+j-1] = 1 + dflag = D_MIX + } + } + dp = dp + 1 + mp = mp + 1 + } + + # Check for completely empty lines + lflag[i] = D_NONE + mp = m[i] + n1 - 1 + do j = n1, n2 { + 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 { + a = scales[i] + b = -zeros[i] + if (lflag[i] == D_ALL) { + dp = d[i] + do j = 1, npts { + Mems[dp] = Mems[dp] / a + b + dp = dp + 1 + } + } else if (lflag[i] == D_MIX) { + nin = IM_LEN(in[i],1) + j = max (0, offsets[i,1]) + k = min (nout, nin + offsets[i,1]) + npix = k - j + n1 = 1 + j + n2 = n1 + npix - 1 + dp = d[i] + n1 - 1 + mp = m[i] + n1 - 1 + do j = n1, n2 { + if (Memi[mp] != 1) + 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 + } + } + do i = nused+1, nimages + d[i] = NULL + 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] + nin = IM_LEN(in[l],1) + j = max (0, offsets[l,1]) + k = min (nout, nin + offsets[l,1]) + npix = k - j + n1 = 1 + j + n2 = n1 + npix - 1 + dp = d[i] + n1 - 1 + ip = id[i] + n1 - 1 + mp = m[i] + n1 - 1 + do j = n1, n2 { + Memi[ip] = l + if (Memi[mp] == 0) { + n[j] = n[j] + 1 + k = n[j] + if (k < i) { + temp = Mems[d[k]+j-1] + Mems[d[k]+j-1] = Mems[dp] + Mems[dp] = temp + Memi[ip] = Memi[id[k]+j-1] + Memi[id[k]+j-1] = l + Memi[mp] = Memi[m[k]+j-1] + Memi[m[k]+j-1] = 0 + } + } else + Memi[ip] = 0 + dp = dp + 1 + ip = ip + 1 + mp = mp + 1 + } + } + if (grow >= 1.) { + do j = 1, npts { + do i = n[j]+1, nimages + Memi[id[i]+j-1] = 0 + } + } + } else { + do i = 1, nused { + l = lflag[i] + nin = IM_LEN(in[l],1) + j = max (0, offsets[l,1]) + k = min (nout, nin + offsets[l,1]) + npix = k - j + n1 = 1 + j + n2 = n1 + npix - 1 + dp = d[i] + n1 - 1 + mp = m[i] + n1 - 1 + do j = n1, n2 { + if (Memi[mp] == 0) { + n[j] = n[j] + 1 + k = n[j] + if (k < i) { + temp = Mems[d[k]+j-1] + Mems[d[k]+j-1] = Mems[dp] + Mems[dp] = temp + Memi[mp] = Memi[m[k]+j-1] + Memi[m[k]+j-1] = 0 + } + } + dp = dp + 1 + mp = mp + 1 + } + } + } + } + + # Sort the pixels and IDs if needed + if (mclip) { + call malloc (dp, nused, TY_SHORT) + if (keepids) { + call malloc (ip, nused, 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) + } + + # If no good pixels set the number of usable values as -n and + # shift them to lower values. + if (mtype == M_NOVAL) { + if (keepids) { + do j = 1, npts { + if (n[j] > 0) + next + n[j] = 0 + do i = 1, nused { + dp = d[i] + j - 1 + ip = id[i] + j - 1 + if (Mems[dp] < max_pixel) { + n[j] = n[j] - 1 + k = -n[j] + if (k < i) { + Mems[d[k]+j-1] = Mems[dp] + Memi[id[k]+j-1] = Memi[ip] + } + } + } + } + } else { + do j = 1, npts { + if (n[j] > 0) + next + n[j] = 0 + do i = 1, nused { + dp = d[i] + j - 1 + if (Mems[dp] < max_pixel) { + n[j] = n[j] - 1 + k = -n[j] + if (k < i) + Mems[d[k]+j-1] = Mems[dp] + } + } + } + } + } +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 kept in the returned m data pointers. + +procedure ic_gdatai (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 +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 temp +int i, j, k, l, n1, n2, npix, nin, nout, ndim, nused, mtype, xt_imgnli() +real a, b +pointer buf, dp, ip, mp +errchk xt_cpix, xt_imgnli + +int max_pixel +data max_pixel/MAX_INT/ + +include "../icombine.com" + +begin + # Get masks and return if there is no data + call ic_mget (in, out, offsets, v1, v2, m, lflag, nimages, mtype) + if (dflag == D_NONE) { + call aclri (n, npts) + return + } + + # Close images which are not needed. + nout = IM_LEN(out[1],1) + ndim = IM_NDIM(out[1]) + if (!project && ndim < 3) { + do i = 1, nimages { + nin = IM_LEN(in[i],1) + j = max (0, offsets[i,1]) + k = min (nout, nin + offsets[i,1]) + npix = k - j + if (npix < 1) + call xt_cpix (i) + if (ndim > 1) { + j = v1[2] - offsets[i,2] + if (j < 1 || j > IM_LEN(in[i],2)) + call xt_cpix (i) + } + } + } + + # Get data and fill data buffers. Correct for offsets if needed. + do i = 1, nimages { + if (lflag[i] == D_NONE) + next + if (dbuf[i] == NULL) { + call amovl (v1, v2, IM_MAXDIM) + if (project) + v2[ndim+1] = i + j = xt_imgnli (in[i], i, d[i], v2, v1[2]) + } else { + nin = IM_LEN(in[i],1) + j = max (0, offsets[i,1]) + k = min (nout, nin + offsets[i,1]) + npix = k - j + if (npix < 1) { + lflag[i] = D_NONE + next + } + k = 1 + j - offsets[i,1] + v2[1] = k + do l = 2, ndim { + v2[l] = v1[l] - offsets[i,l] + if (v2[l] < 1 || v2[l] > IM_LEN(in[i],l)) { + lflag[i] = D_NONE + break + } + } + if (lflag[i] == D_NONE) + next + if (project) + v2[ndim+1] = i + l = xt_imgnli (in[i], i, buf, v2, v1[2]) + call amovi (Memi[buf+k-1], Memi[dbuf[i]+j], npix) + d[i] = dbuf[i] + } + } + + # Set values to max_pixel if needed. + if (mtype == M_NOVAL) { + do i = 1, nimages { + dp = d[i]; mp = m[i] + if (lflag[i] == D_NONE || dp == NULL) + next + else if (lflag[i] == D_MIX) { + do j = 1, npts { + if (Memi[mp] == 1) + Memi[dp] = max_pixel + dp = dp + 1 + mp = mp + 1 + } + } + } + } + + # Apply threshold if needed + if (dothresh) { + do i = 1, nimages { + if (lflag[i] == D_ALL) { + dp = d[i] + do j = 1, npts { + a = Memi[dp] + if (a < lthresh || a > hthresh) { + if (mtype == M_NOVAL) + Memi[m[i]+j-1] = 2 + else + Memi[m[i]+j-1] = 1 + + lflag[i] = D_MIX + dflag = D_MIX + } + dp = dp + 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 + } + } + } else if (lflag[i] == D_MIX) { + nin = IM_LEN(in[i],1) + j = max (0, offsets[i,1]) + k = min (nout, nin + offsets[i,1]) + npix = k - j + n1 = 1 + j + n2 = n1 + npix - 1 + dp = d[i] + n1 - 1 + mp = m[i] + n1 - 1 + do j = n1, n2 { + if (Memi[mp] != 1) { + a = Memi[dp] + if (a < lthresh || a > hthresh) { + if (mtype == M_NOVAL) + Memi[m[i]+j-1] = 2 + else + Memi[m[i]+j-1] = 1 + dflag = D_MIX + } + } + dp = dp + 1 + mp = mp + 1 + } + + # Check for completely empty lines + lflag[i] = D_NONE + mp = m[i] + n1 - 1 + do j = n1, n2 { + 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 { + Memi[dp] = Memi[dp] / a + b + dp = dp + 1 + } + } + } else if (dflag == D_MIX) { + do i = 1, nimages { + a = scales[i] + b = -zeros[i] + if (lflag[i] == D_ALL) { + dp = d[i] + do j = 1, npts { + Memi[dp] = Memi[dp] / a + b + dp = dp + 1 + } + } else if (lflag[i] == D_MIX) { + nin = IM_LEN(in[i],1) + j = max (0, offsets[i,1]) + k = min (nout, nin + offsets[i,1]) + npix = k - j + n1 = 1 + j + n2 = n1 + npix - 1 + dp = d[i] + n1 - 1 + mp = m[i] + n1 - 1 + do j = n1, n2 { + if (Memi[mp] != 1) + Memi[dp] = Memi[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 + } + } + do i = nused+1, nimages + d[i] = NULL + 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] + nin = IM_LEN(in[l],1) + j = max (0, offsets[l,1]) + k = min (nout, nin + offsets[l,1]) + npix = k - j + n1 = 1 + j + n2 = n1 + npix - 1 + dp = d[i] + n1 - 1 + ip = id[i] + n1 - 1 + mp = m[i] + n1 - 1 + do j = n1, n2 { + Memi[ip] = l + if (Memi[mp] == 0) { + n[j] = n[j] + 1 + k = n[j] + if (k < i) { + temp = Memi[d[k]+j-1] + Memi[d[k]+j-1] = Memi[dp] + Memi[dp] = temp + Memi[ip] = Memi[id[k]+j-1] + Memi[id[k]+j-1] = l + Memi[mp] = Memi[m[k]+j-1] + Memi[m[k]+j-1] = 0 + } + } else + Memi[ip] = 0 + dp = dp + 1 + ip = ip + 1 + mp = mp + 1 + } + } + if (grow >= 1.) { + do j = 1, npts { + do i = n[j]+1, nimages + Memi[id[i]+j-1] = 0 + } + } + } else { + do i = 1, nused { + l = lflag[i] + nin = IM_LEN(in[l],1) + j = max (0, offsets[l,1]) + k = min (nout, nin + offsets[l,1]) + npix = k - j + n1 = 1 + j + n2 = n1 + npix - 1 + dp = d[i] + n1 - 1 + mp = m[i] + n1 - 1 + do j = n1, n2 { + if (Memi[mp] == 0) { + n[j] = n[j] + 1 + k = n[j] + if (k < i) { + temp = Memi[d[k]+j-1] + Memi[d[k]+j-1] = Memi[dp] + Memi[dp] = temp + Memi[mp] = Memi[m[k]+j-1] + Memi[m[k]+j-1] = 0 + } + } + dp = dp + 1 + mp = mp + 1 + } + } + } + } + + # Sort the pixels and IDs if needed + if (mclip) { + call malloc (dp, nused, TY_INT) + if (keepids) { + call malloc (ip, nused, TY_INT) + call ic_2sorti (d, Memi[dp], id, Memi[ip], n, npts) + call mfree (ip, TY_INT) + } else + call ic_sorti (d, Memi[dp], n, npts) + call mfree (dp, TY_INT) + } + + # If no good pixels set the number of usable values as -n and + # shift them to lower values. + if (mtype == M_NOVAL) { + if (keepids) { + do j = 1, npts { + if (n[j] > 0) + next + n[j] = 0 + do i = 1, nused { + dp = d[i] + j - 1 + ip = id[i] + j - 1 + if (Memi[dp] < max_pixel) { + n[j] = n[j] - 1 + k = -n[j] + if (k < i) { + Memi[d[k]+j-1] = Memi[dp] + Memi[id[k]+j-1] = Memi[ip] + } + } + } + } + } else { + do j = 1, npts { + if (n[j] > 0) + next + n[j] = 0 + do i = 1, nused { + dp = d[i] + j - 1 + if (Memi[dp] < max_pixel) { + n[j] = n[j] - 1 + k = -n[j] + if (k < i) + Memi[d[k]+j-1] = Memi[dp] + } + } + } + } + } +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 kept 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 +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 + +real temp +int i, j, k, l, n1, n2, npix, nin, nout, ndim, nused, mtype, xt_imgnlr() +real a, b +pointer buf, dp, ip, mp +errchk xt_cpix, xt_imgnlr + +real max_pixel +data max_pixel/MAX_REAL/ + +include "../icombine.com" + +begin + # Get masks and return if there is no data + call ic_mget (in, out, offsets, v1, v2, m, lflag, nimages, mtype) + if (dflag == D_NONE) { + call aclri (n, npts) + return + } + + # Close images which are not needed. + nout = IM_LEN(out[1],1) + ndim = IM_NDIM(out[1]) + if (!project && ndim < 3) { + do i = 1, nimages { + nin = IM_LEN(in[i],1) + j = max (0, offsets[i,1]) + k = min (nout, nin + offsets[i,1]) + npix = k - j + if (npix < 1) + call xt_cpix (i) + if (ndim > 1) { + j = v1[2] - offsets[i,2] + if (j < 1 || j > IM_LEN(in[i],2)) + call xt_cpix (i) + } + } + } + + # Get data and fill data buffers. Correct for offsets if needed. + do i = 1, nimages { + if (lflag[i] == D_NONE) + next + if (dbuf[i] == NULL) { + call amovl (v1, v2, IM_MAXDIM) + if (project) + v2[ndim+1] = i + j = xt_imgnlr (in[i], i, d[i], v2, v1[2]) + } else { + nin = IM_LEN(in[i],1) + j = max (0, offsets[i,1]) + k = min (nout, nin + offsets[i,1]) + npix = k - j + if (npix < 1) { + lflag[i] = D_NONE + next + } + k = 1 + j - offsets[i,1] + v2[1] = k + do l = 2, ndim { + v2[l] = v1[l] - offsets[i,l] + if (v2[l] < 1 || v2[l] > IM_LEN(in[i],l)) { + lflag[i] = D_NONE + break + } + } + if (lflag[i] == D_NONE) + next + if (project) + v2[ndim+1] = i + l = xt_imgnlr (in[i], i, buf, v2, v1[2]) + call amovr (Memr[buf+k-1], Memr[dbuf[i]+j], npix) + d[i] = dbuf[i] + } + } + + # Set values to max_pixel if needed. + if (mtype == M_NOVAL) { + do i = 1, nimages { + dp = d[i]; mp = m[i] + if (lflag[i] == D_NONE || dp == NULL) + next + else if (lflag[i] == D_MIX) { + do j = 1, npts { + if (Memi[mp] == 1) + Memr[dp] = max_pixel + dp = dp + 1 + mp = mp + 1 + } + } + } + } + + # Apply threshold if needed + if (dothresh) { + do i = 1, nimages { + if (lflag[i] == D_ALL) { + dp = d[i] + do j = 1, npts { + a = Memr[dp] + if (a < lthresh || a > hthresh) { + if (mtype == M_NOVAL) + Memi[m[i]+j-1] = 2 + else + Memi[m[i]+j-1] = 1 + + lflag[i] = D_MIX + dflag = D_MIX + } + dp = dp + 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 + } + } + } else if (lflag[i] == D_MIX) { + nin = IM_LEN(in[i],1) + j = max (0, offsets[i,1]) + k = min (nout, nin + offsets[i,1]) + npix = k - j + n1 = 1 + j + n2 = n1 + npix - 1 + dp = d[i] + n1 - 1 + mp = m[i] + n1 - 1 + do j = n1, n2 { + if (Memi[mp] != 1) { + a = Memr[dp] + if (a < lthresh || a > hthresh) { + if (mtype == M_NOVAL) + Memi[m[i]+j-1] = 2 + else + Memi[m[i]+j-1] = 1 + dflag = D_MIX + } + } + dp = dp + 1 + mp = mp + 1 + } + + # Check for completely empty lines + lflag[i] = D_NONE + mp = m[i] + n1 - 1 + do j = n1, n2 { + 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 { + a = scales[i] + b = -zeros[i] + if (lflag[i] == D_ALL) { + dp = d[i] + do j = 1, npts { + Memr[dp] = Memr[dp] / a + b + dp = dp + 1 + } + } else if (lflag[i] == D_MIX) { + nin = IM_LEN(in[i],1) + j = max (0, offsets[i,1]) + k = min (nout, nin + offsets[i,1]) + npix = k - j + n1 = 1 + j + n2 = n1 + npix - 1 + dp = d[i] + n1 - 1 + mp = m[i] + n1 - 1 + do j = n1, n2 { + if (Memi[mp] != 1) + 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 + } + } + do i = nused+1, nimages + d[i] = NULL + 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] + nin = IM_LEN(in[l],1) + j = max (0, offsets[l,1]) + k = min (nout, nin + offsets[l,1]) + npix = k - j + n1 = 1 + j + n2 = n1 + npix - 1 + dp = d[i] + n1 - 1 + ip = id[i] + n1 - 1 + mp = m[i] + n1 - 1 + do j = n1, n2 { + Memi[ip] = l + if (Memi[mp] == 0) { + n[j] = n[j] + 1 + k = n[j] + if (k < i) { + temp = Memr[d[k]+j-1] + Memr[d[k]+j-1] = Memr[dp] + Memr[dp] = temp + Memi[ip] = Memi[id[k]+j-1] + Memi[id[k]+j-1] = l + Memi[mp] = Memi[m[k]+j-1] + Memi[m[k]+j-1] = 0 + } + } else + Memi[ip] = 0 + dp = dp + 1 + ip = ip + 1 + mp = mp + 1 + } + } + if (grow >= 1.) { + do j = 1, npts { + do i = n[j]+1, nimages + Memi[id[i]+j-1] = 0 + } + } + } else { + do i = 1, nused { + l = lflag[i] + nin = IM_LEN(in[l],1) + j = max (0, offsets[l,1]) + k = min (nout, nin + offsets[l,1]) + npix = k - j + n1 = 1 + j + n2 = n1 + npix - 1 + dp = d[i] + n1 - 1 + mp = m[i] + n1 - 1 + do j = n1, n2 { + if (Memi[mp] == 0) { + n[j] = n[j] + 1 + k = n[j] + if (k < i) { + temp = Memr[d[k]+j-1] + Memr[d[k]+j-1] = Memr[dp] + Memr[dp] = temp + Memi[mp] = Memi[m[k]+j-1] + Memi[m[k]+j-1] = 0 + } + } + dp = dp + 1 + mp = mp + 1 + } + } + } + } + + # Sort the pixels and IDs if needed + if (mclip) { + call malloc (dp, nused, TY_REAL) + if (keepids) { + call malloc (ip, nused, 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) + } + + # If no good pixels set the number of usable values as -n and + # shift them to lower values. + if (mtype == M_NOVAL) { + if (keepids) { + do j = 1, npts { + if (n[j] > 0) + next + n[j] = 0 + do i = 1, nused { + dp = d[i] + j - 1 + ip = id[i] + j - 1 + if (Memr[dp] < max_pixel) { + n[j] = n[j] - 1 + k = -n[j] + if (k < i) { + Memr[d[k]+j-1] = Memr[dp] + Memi[id[k]+j-1] = Memi[ip] + } + } + } + } + } else { + do j = 1, npts { + if (n[j] > 0) + next + n[j] = 0 + do i = 1, nused { + dp = d[i] + j - 1 + if (Memr[dp] < max_pixel) { + n[j] = n[j] - 1 + k = -n[j] + if (k < i) + Memr[d[k]+j-1] = Memr[dp] + } + } + } + } + } +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 kept in the returned m data pointers. + +procedure ic_gdatad (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 +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 + +double temp +int i, j, k, l, n1, n2, npix, nin, nout, ndim, nused, mtype, xt_imgnld() +real a, b +pointer buf, dp, ip, mp +errchk xt_cpix, xt_imgnld + +double max_pixel +data max_pixel/MAX_DOUBLE/ + +include "../icombine.com" + +begin + # Get masks and return if there is no data + call ic_mget (in, out, offsets, v1, v2, m, lflag, nimages, mtype) + if (dflag == D_NONE) { + call aclri (n, npts) + return + } + + # Close images which are not needed. + nout = IM_LEN(out[1],1) + ndim = IM_NDIM(out[1]) + if (!project && ndim < 3) { + do i = 1, nimages { + nin = IM_LEN(in[i],1) + j = max (0, offsets[i,1]) + k = min (nout, nin + offsets[i,1]) + npix = k - j + if (npix < 1) + call xt_cpix (i) + if (ndim > 1) { + j = v1[2] - offsets[i,2] + if (j < 1 || j > IM_LEN(in[i],2)) + call xt_cpix (i) + } + } + } + + # Get data and fill data buffers. Correct for offsets if needed. + do i = 1, nimages { + if (lflag[i] == D_NONE) + next + if (dbuf[i] == NULL) { + call amovl (v1, v2, IM_MAXDIM) + if (project) + v2[ndim+1] = i + j = xt_imgnld (in[i], i, d[i], v2, v1[2]) + } else { + nin = IM_LEN(in[i],1) + j = max (0, offsets[i,1]) + k = min (nout, nin + offsets[i,1]) + npix = k - j + if (npix < 1) { + lflag[i] = D_NONE + next + } + k = 1 + j - offsets[i,1] + v2[1] = k + do l = 2, ndim { + v2[l] = v1[l] - offsets[i,l] + if (v2[l] < 1 || v2[l] > IM_LEN(in[i],l)) { + lflag[i] = D_NONE + break + } + } + if (lflag[i] == D_NONE) + next + if (project) + v2[ndim+1] = i + l = xt_imgnld (in[i], i, buf, v2, v1[2]) + call amovd (Memd[buf+k-1], Memd[dbuf[i]+j], npix) + d[i] = dbuf[i] + } + } + + # Set values to max_pixel if needed. + if (mtype == M_NOVAL) { + do i = 1, nimages { + dp = d[i]; mp = m[i] + if (lflag[i] == D_NONE || dp == NULL) + next + else if (lflag[i] == D_MIX) { + do j = 1, npts { + if (Memi[mp] == 1) + Memd[dp] = max_pixel + dp = dp + 1 + mp = mp + 1 + } + } + } + } + + # Apply threshold if needed + if (dothresh) { + do i = 1, nimages { + if (lflag[i] == D_ALL) { + dp = d[i] + do j = 1, npts { + a = Memd[dp] + if (a < lthresh || a > hthresh) { + if (mtype == M_NOVAL) + Memi[m[i]+j-1] = 2 + else + Memi[m[i]+j-1] = 1 + + lflag[i] = D_MIX + dflag = D_MIX + } + dp = dp + 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 + } + } + } else if (lflag[i] == D_MIX) { + nin = IM_LEN(in[i],1) + j = max (0, offsets[i,1]) + k = min (nout, nin + offsets[i,1]) + npix = k - j + n1 = 1 + j + n2 = n1 + npix - 1 + dp = d[i] + n1 - 1 + mp = m[i] + n1 - 1 + do j = n1, n2 { + if (Memi[mp] != 1) { + a = Memd[dp] + if (a < lthresh || a > hthresh) { + if (mtype == M_NOVAL) + Memi[m[i]+j-1] = 2 + else + Memi[m[i]+j-1] = 1 + dflag = D_MIX + } + } + dp = dp + 1 + mp = mp + 1 + } + + # Check for completely empty lines + lflag[i] = D_NONE + mp = m[i] + n1 - 1 + do j = n1, n2 { + 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 { + Memd[dp] = Memd[dp] / a + b + dp = dp + 1 + } + } + } else if (dflag == D_MIX) { + do i = 1, nimages { + a = scales[i] + b = -zeros[i] + if (lflag[i] == D_ALL) { + dp = d[i] + do j = 1, npts { + Memd[dp] = Memd[dp] / a + b + dp = dp + 1 + } + } else if (lflag[i] == D_MIX) { + nin = IM_LEN(in[i],1) + j = max (0, offsets[i,1]) + k = min (nout, nin + offsets[i,1]) + npix = k - j + n1 = 1 + j + n2 = n1 + npix - 1 + dp = d[i] + n1 - 1 + mp = m[i] + n1 - 1 + do j = n1, n2 { + if (Memi[mp] != 1) + Memd[dp] = Memd[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 + } + } + do i = nused+1, nimages + d[i] = NULL + 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] + nin = IM_LEN(in[l],1) + j = max (0, offsets[l,1]) + k = min (nout, nin + offsets[l,1]) + npix = k - j + n1 = 1 + j + n2 = n1 + npix - 1 + dp = d[i] + n1 - 1 + ip = id[i] + n1 - 1 + mp = m[i] + n1 - 1 + do j = n1, n2 { + Memi[ip] = l + if (Memi[mp] == 0) { + n[j] = n[j] + 1 + k = n[j] + if (k < i) { + temp = Memd[d[k]+j-1] + Memd[d[k]+j-1] = Memd[dp] + Memd[dp] = temp + Memi[ip] = Memi[id[k]+j-1] + Memi[id[k]+j-1] = l + Memi[mp] = Memi[m[k]+j-1] + Memi[m[k]+j-1] = 0 + } + } else + Memi[ip] = 0 + dp = dp + 1 + ip = ip + 1 + mp = mp + 1 + } + } + if (grow >= 1.) { + do j = 1, npts { + do i = n[j]+1, nimages + Memi[id[i]+j-1] = 0 + } + } + } else { + do i = 1, nused { + l = lflag[i] + nin = IM_LEN(in[l],1) + j = max (0, offsets[l,1]) + k = min (nout, nin + offsets[l,1]) + npix = k - j + n1 = 1 + j + n2 = n1 + npix - 1 + dp = d[i] + n1 - 1 + mp = m[i] + n1 - 1 + do j = n1, n2 { + if (Memi[mp] == 0) { + n[j] = n[j] + 1 + k = n[j] + if (k < i) { + temp = Memd[d[k]+j-1] + Memd[d[k]+j-1] = Memd[dp] + Memd[dp] = temp + Memi[mp] = Memi[m[k]+j-1] + Memi[m[k]+j-1] = 0 + } + } + dp = dp + 1 + mp = mp + 1 + } + } + } + } + + # Sort the pixels and IDs if needed + if (mclip) { + call malloc (dp, nused, TY_DOUBLE) + if (keepids) { + call malloc (ip, nused, TY_INT) + call ic_2sortd (d, Memd[dp], id, Memi[ip], n, npts) + call mfree (ip, TY_INT) + } else + call ic_sortd (d, Memd[dp], n, npts) + call mfree (dp, TY_DOUBLE) + } + + # If no good pixels set the number of usable values as -n and + # shift them to lower values. + if (mtype == M_NOVAL) { + if (keepids) { + do j = 1, npts { + if (n[j] > 0) + next + n[j] = 0 + do i = 1, nused { + dp = d[i] + j - 1 + ip = id[i] + j - 1 + if (Memd[dp] < max_pixel) { + n[j] = n[j] - 1 + k = -n[j] + if (k < i) { + Memd[d[k]+j-1] = Memd[dp] + Memi[id[k]+j-1] = Memi[ip] + } + } + } + } + } else { + do j = 1, npts { + if (n[j] > 0) + next + n[j] = 0 + do i = 1, nused { + dp = d[i] + j - 1 + if (Memd[dp] < max_pixel) { + n[j] = n[j] - 1 + k = -n[j] + if (k < i) + Memd[d[k]+j-1] = Memd[dp] + } + } + } + } + } +end + diff --git a/pkg/images/immatch/src/imcombine/src/generic/icgrow.x b/pkg/images/immatch/src/imcombine/src/generic/icgrow.x new file mode 100644 index 00000000..1ccb7885 --- /dev/null +++ b/pkg/images/immatch/src/imcombine/src/generic/icgrow.x @@ -0,0 +1,263 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> +include <pmset.h> +include "../icombine.h" + +# IC_GROW -- Mark neigbors of rejected pixels. +# The rejected pixels (original plus grown) are saved in pixel masks. + +procedure ic_grow (out, v, m, n, buf, nimages, npts, pms) + +pointer out # Output image pointer +long v[ARB] # Output vector +pointer m[ARB] # Image id pointers +int n[ARB] # Number of good pixels +int buf[npts,nimages] # Working buffer +int nimages # Number of images +int npts # Number of output points per line +pointer pms # Pointer to array of pixel masks + +int i, j, k, l, line, nl, rop, igrow, nset, ncompress, or() +real grow2, i2 +pointer mp, pm, pm_newmask() +errchk pm_newmask() + +include "../icombine.com" + +begin + if (dflag == D_NONE || grow == 0.) + return + + line = v[2] + nl = IM_LEN(out,2) + rop = or (PIX_SRC, PIX_DST) + + igrow = grow + grow2 = grow**2 + do l = 0, igrow { + i2 = grow2 - l * l + call aclri (buf, npts*nimages) + nset = 0 + do j = 1, npts { + do k = n[j]+1, nimages { + mp = Memi[m[k]+j-1] + if (mp == 0) + next + do i = 0, igrow { + if (i**2 > i2) + next + if (j > i) + buf[j-i,mp] = 1 + if (j+i <= npts) + buf[j+i,mp] = 1 + nset = nset + 1 + } + } + } + if (nset == 0) + return + + if (pms == NULL) { + call malloc (pms, nimages, TY_POINTER) + do i = 1, nimages + Memi[pms+i-1] = pm_newmask (out, 1) + ncompress = 0 + } + do i = 1, nimages { + pm = Memi[pms+i-1] + v[2] = line - l + if (v[2] > 0) + call pmplpi (pm, v, buf[1,i], 1, npts, rop) + if (l > 0) { + v[2] = line + l + if (v[2] <= nl) + call pmplpi (pm, v, buf[1,i], 1, npts, rop) + } + } + } + v[2] = line + + if (ncompress > 10) { + do i = 1, nimages { + pm = Memi[pms+i-1] + call pm_compress (pm) + } + ncompress = 0 + } else + ncompress = ncompress + 1 +end + + + +# IC_GROW$T -- Reject pixels. + +procedure ic_grows (v, d, m, n, buf, nimages, npts, pms) + +long v[ARB] # Output vector +pointer d[ARB] # Data pointers +pointer m[ARB] # Image id pointers +int n[ARB] # Number of good pixels +int buf[ARB] # Buffer of npts +int nimages # Number of images +int npts # Number of output points per line +pointer pms # Pointer to array of pixel masks + +int i, j, k +pointer pm +bool pl_linenotempty() + +include "../icombine.com" + +begin + do k = 1, nimages { + pm = Memi[pms+k-1] + if (!pl_linenotempty (pm, v)) + next + call pmglpi (pm, v, buf, 1, npts, PIX_SRC) + do i = 1, npts { + if (buf[i] == 0) + next + for (j = 1; j <= n[i]; j = j + 1) { + if (Memi[m[j]+i-1] == k) { + if (j < n[i]) { + Mems[d[j]+i-1] = Mems[d[n[i]]+i-1] + Memi[m[j]+i-1] = Memi[m[n[i]]+i-1] + } + n[i] = n[i] - 1 + dflag = D_MIX + break + } + } + } + } +end + +# IC_GROW$T -- Reject pixels. + +procedure ic_growi (v, d, m, n, buf, nimages, npts, pms) + +long v[ARB] # Output vector +pointer d[ARB] # Data pointers +pointer m[ARB] # Image id pointers +int n[ARB] # Number of good pixels +int buf[ARB] # Buffer of npts +int nimages # Number of images +int npts # Number of output points per line +pointer pms # Pointer to array of pixel masks + +int i, j, k +pointer pm +bool pl_linenotempty() + +include "../icombine.com" + +begin + do k = 1, nimages { + pm = Memi[pms+k-1] + if (!pl_linenotempty (pm, v)) + next + call pmglpi (pm, v, buf, 1, npts, PIX_SRC) + do i = 1, npts { + if (buf[i] == 0) + next + for (j = 1; j <= n[i]; j = j + 1) { + if (Memi[m[j]+i-1] == k) { + if (j < n[i]) { + Memi[d[j]+i-1] = Memi[d[n[i]]+i-1] + Memi[m[j]+i-1] = Memi[m[n[i]]+i-1] + } + n[i] = n[i] - 1 + dflag = D_MIX + break + } + } + } + } +end + +# IC_GROW$T -- Reject pixels. + +procedure ic_growr (v, d, m, n, buf, nimages, npts, pms) + +long v[ARB] # Output vector +pointer d[ARB] # Data pointers +pointer m[ARB] # Image id pointers +int n[ARB] # Number of good pixels +int buf[ARB] # Buffer of npts +int nimages # Number of images +int npts # Number of output points per line +pointer pms # Pointer to array of pixel masks + +int i, j, k +pointer pm +bool pl_linenotempty() + +include "../icombine.com" + +begin + do k = 1, nimages { + pm = Memi[pms+k-1] + if (!pl_linenotempty (pm, v)) + next + call pmglpi (pm, v, buf, 1, npts, PIX_SRC) + do i = 1, npts { + if (buf[i] == 0) + next + for (j = 1; j <= n[i]; j = j + 1) { + if (Memi[m[j]+i-1] == k) { + if (j < n[i]) { + Memr[d[j]+i-1] = Memr[d[n[i]]+i-1] + Memi[m[j]+i-1] = Memi[m[n[i]]+i-1] + } + n[i] = n[i] - 1 + dflag = D_MIX + break + } + } + } + } +end + +# IC_GROW$T -- Reject pixels. + +procedure ic_growd (v, d, m, n, buf, nimages, npts, pms) + +long v[ARB] # Output vector +pointer d[ARB] # Data pointers +pointer m[ARB] # Image id pointers +int n[ARB] # Number of good pixels +int buf[ARB] # Buffer of npts +int nimages # Number of images +int npts # Number of output points per line +pointer pms # Pointer to array of pixel masks + +int i, j, k +pointer pm +bool pl_linenotempty() + +include "../icombine.com" + +begin + do k = 1, nimages { + pm = Memi[pms+k-1] + if (!pl_linenotempty (pm, v)) + next + call pmglpi (pm, v, buf, 1, npts, PIX_SRC) + do i = 1, npts { + if (buf[i] == 0) + next + for (j = 1; j <= n[i]; j = j + 1) { + if (Memi[m[j]+i-1] == k) { + if (j < n[i]) { + Memd[d[j]+i-1] = Memd[d[n[i]]+i-1] + Memi[m[j]+i-1] = Memi[m[n[i]]+i-1] + } + n[i] = n[i] - 1 + dflag = D_MIX + break + } + } + } + } +end diff --git a/pkg/images/immatch/src/imcombine/src/generic/icmedian.x b/pkg/images/immatch/src/imcombine/src/generic/icmedian.x new file mode 100644 index 00000000..c482454b --- /dev/null +++ b/pkg/images/immatch/src/imcombine/src/generic/icmedian.x @@ -0,0 +1,753 @@ +# 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, doblank, median) + +pointer d[ARB] # Input data line pointers +int n[npts] # Number of good pixels +int npts # Number of output points per line +int doblank # Set blank values? +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) { + if (doblank == YES) { + 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] + j1 = n1 / 2 + 1 + j2 = n1 / 2 + even = (mod(n1,2)==0 && (medtype==MEDAVG || 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] + } + return + } else { + # Check for negative n values. If found then there are + # pixels with no good values but with values we want to + # use as a substitute median. In this case ignore that + # the good pixels have been sorted. + do i = 1, npts { + if (n[i] < 0) + break + } + + if (n[i] >= 0) { + do i = 1, npts { + k = i - 1 + n1 = n[i] + if (n1 > 0) { + j1 = n1 / 2 + 1 + if (mod(n1,2)==0 && (medtype==MEDAVG || n1>2)) { + 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 if (doblank == YES) + median[i] = blank + } + return + } + } + } + + # Compute the median. + do i = 1, npts { + k = i - 1 + n1 = abs(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 && (medtype==MEDAVG || n1 > 2)) { + 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] + if (medtype == MEDAVG) + median[i] = (val1 + val2) / 2 + else + median[i] = min (val1, val2) + + # 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 if (doblank == YES) + median[i] = blank + } +end + +# IC_MEDIAN -- Median of lines + +procedure ic_mediani (d, n, npts, doblank, median) + +pointer d[ARB] # Input data line pointers +int n[npts] # Number of good pixels +int npts # Number of output points per line +int doblank # Set blank values? +real median[npts] # Median + +int i, j, k, j1, j2, n1, lo, up, lo1, up1 +bool even +real val1, val2, val3 +int temp, wtemp + +include "../icombine.com" + +begin + # If no data return after possibly setting blank values. + if (dflag == D_NONE) { + if (doblank == YES) { + 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] + j1 = n1 / 2 + 1 + j2 = n1 / 2 + even = (mod(n1,2)==0 && (medtype==MEDAVG || n1>2)) + do i = 1, npts { + k = i - 1 + if (even) { + val1 = Memi[d[j1]+k] + val2 = Memi[d[j2]+k] + median[i] = (val1 + val2) / 2. + } else + median[i] = Memi[d[j1]+k] + } + return + } else { + # Check for negative n values. If found then there are + # pixels with no good values but with values we want to + # use as a substitute median. In this case ignore that + # the good pixels have been sorted. + do i = 1, npts { + if (n[i] < 0) + break + } + + if (n[i] >= 0) { + do i = 1, npts { + k = i - 1 + n1 = n[i] + if (n1 > 0) { + j1 = n1 / 2 + 1 + if (mod(n1,2)==0 && (medtype==MEDAVG || n1>2)) { + j2 = n1 / 2 + val1 = Memi[d[j1]+k] + val2 = Memi[d[j2]+k] + median[i] = (val1 + val2) / 2. + } else + median[i] = Memi[d[j1]+k] + } else if (doblank == YES) + median[i] = blank + } + return + } + } + } + + # Compute the median. + do i = 1, npts { + k = i - 1 + n1 = abs(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 = Memi[d[j]+k]; lo1 = lo; up1 = up + + repeat { + while (Memi[d[lo1]+k] < temp) + lo1 = lo1 + 1 + while (temp < Memi[d[up1]+k]) + up1 = up1 - 1 + if (lo1 <= up1) { + wtemp = Memi[d[lo1]+k] + Memi[d[lo1]+k] = Memi[d[up1]+k] + Memi[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] = Memi[d[j]+k] + + if (mod(n1,2)==0 && (medtype==MEDAVG || n1 > 2)) { + lo = 1 + up = n1 + j = max (lo, min (up, (up+1)/2)+1) + + while (lo < up) { + if (! (lo < up)) + break + + temp = Memi[d[j]+k]; lo1 = lo; up1 = up + + repeat { + while (Memi[d[lo1]+k] < temp) + lo1 = lo1 + 1 + while (temp < Memi[d[up1]+k]) + up1 = up1 - 1 + if (lo1 <= up1) { + wtemp = Memi[d[lo1]+k] + Memi[d[lo1]+k] = Memi[d[up1]+k] + Memi[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] + Memi[d[j]+k]) / 2 + } + + # If 3 points find the median directly. + } else if (n1 == 3) { + val1 = Memi[d[1]+k] + val2 = Memi[d[2]+k] + val3 = Memi[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 = Memi[d[1]+k] + val2 = Memi[d[2]+k] + if (medtype == MEDAVG) + median[i] = (val1 + val2) / 2 + else + median[i] = min (val1, val2) + + # If 1 point return the value. + } else if (n1 == 1) + median[i] = Memi[d[1]+k] + + # If no points return with a possibly blank value. + else if (doblank == YES) + median[i] = blank + } +end + +# IC_MEDIAN -- Median of lines + +procedure ic_medianr (d, n, npts, doblank, median) + +pointer d[ARB] # Input data line pointers +int n[npts] # Number of good pixels +int npts # Number of output points per line +int doblank # Set blank values? +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) { + if (doblank == YES) { + 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] + j1 = n1 / 2 + 1 + j2 = n1 / 2 + even = (mod(n1,2)==0 && (medtype==MEDAVG || 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] + } + return + } else { + # Check for negative n values. If found then there are + # pixels with no good values but with values we want to + # use as a substitute median. In this case ignore that + # the good pixels have been sorted. + do i = 1, npts { + if (n[i] < 0) + break + } + + if (n[i] >= 0) { + do i = 1, npts { + k = i - 1 + n1 = n[i] + if (n1 > 0) { + j1 = n1 / 2 + 1 + if (mod(n1,2)==0 && (medtype==MEDAVG || n1>2)) { + 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 if (doblank == YES) + median[i] = blank + } + return + } + } + } + + # Compute the median. + do i = 1, npts { + k = i - 1 + n1 = abs(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 && (medtype==MEDAVG || n1 > 2)) { + 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] + if (medtype == MEDAVG) + median[i] = (val1 + val2) / 2 + else + median[i] = min (val1, val2) + + # 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 if (doblank == YES) + median[i] = blank + } +end + +# IC_MEDIAN -- Median of lines + +procedure ic_mediand (d, n, npts, doblank, median) + +pointer d[ARB] # Input data line pointers +int n[npts] # Number of good pixels +int npts # Number of output points per line +int doblank # Set blank values? +double median[npts] # Median + +int i, j, k, j1, j2, n1, lo, up, lo1, up1 +bool even +double val1, val2, val3 +double temp, wtemp + +include "../icombine.com" + +begin + # If no data return after possibly setting blank values. + if (dflag == D_NONE) { + if (doblank == YES) { + 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] + j1 = n1 / 2 + 1 + j2 = n1 / 2 + even = (mod(n1,2)==0 && (medtype==MEDAVG || n1>2)) + do i = 1, npts { + k = i - 1 + if (even) { + val1 = Memd[d[j1]+k] + val2 = Memd[d[j2]+k] + median[i] = (val1 + val2) / 2. + } else + median[i] = Memd[d[j1]+k] + } + return + } else { + # Check for negative n values. If found then there are + # pixels with no good values but with values we want to + # use as a substitute median. In this case ignore that + # the good pixels have been sorted. + do i = 1, npts { + if (n[i] < 0) + break + } + + if (n[i] >= 0) { + do i = 1, npts { + k = i - 1 + n1 = n[i] + if (n1 > 0) { + j1 = n1 / 2 + 1 + if (mod(n1,2)==0 && (medtype==MEDAVG || n1>2)) { + j2 = n1 / 2 + val1 = Memd[d[j1]+k] + val2 = Memd[d[j2]+k] + median[i] = (val1 + val2) / 2. + } else + median[i] = Memd[d[j1]+k] + } else if (doblank == YES) + median[i] = blank + } + return + } + } + } + + # Compute the median. + do i = 1, npts { + k = i - 1 + n1 = abs(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 = Memd[d[j]+k]; lo1 = lo; up1 = up + + repeat { + while (Memd[d[lo1]+k] < temp) + lo1 = lo1 + 1 + while (temp < Memd[d[up1]+k]) + up1 = up1 - 1 + if (lo1 <= up1) { + wtemp = Memd[d[lo1]+k] + Memd[d[lo1]+k] = Memd[d[up1]+k] + Memd[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] = Memd[d[j]+k] + + if (mod(n1,2)==0 && (medtype==MEDAVG || n1 > 2)) { + lo = 1 + up = n1 + j = max (lo, min (up, (up+1)/2)+1) + + while (lo < up) { + if (! (lo < up)) + break + + temp = Memd[d[j]+k]; lo1 = lo; up1 = up + + repeat { + while (Memd[d[lo1]+k] < temp) + lo1 = lo1 + 1 + while (temp < Memd[d[up1]+k]) + up1 = up1 - 1 + if (lo1 <= up1) { + wtemp = Memd[d[lo1]+k] + Memd[d[lo1]+k] = Memd[d[up1]+k] + Memd[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] + Memd[d[j]+k]) / 2 + } + + # If 3 points find the median directly. + } else if (n1 == 3) { + val1 = Memd[d[1]+k] + val2 = Memd[d[2]+k] + val3 = Memd[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 = Memd[d[1]+k] + val2 = Memd[d[2]+k] + if (medtype == MEDAVG) + median[i] = (val1 + val2) / 2 + else + median[i] = min (val1, val2) + + # If 1 point return the value. + } else if (n1 == 1) + median[i] = Memd[d[1]+k] + + # If no points return with a possibly blank value. + else if (doblank == YES) + median[i] = blank + } +end + diff --git a/pkg/images/immatch/src/imcombine/src/generic/icmm.x b/pkg/images/immatch/src/imcombine/src/generic/icmm.x new file mode 100644 index 00000000..9c8274c8 --- /dev/null +++ b/pkg/images/immatch/src/imcombine/src/generic/icmm.x @@ -0,0 +1,645 @@ +# 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 = max (0, 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 = max (0, 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 + k = Memi[m[jmax]+i1] + Memi[m[jmax]+i1] = Memi[m[j]+i1] + Memi[m[j]+i1] = k + } else { + Mems[kmax] = d1 + k = Memi[m[jmax]+i1] + Memi[m[jmax]+i1] = Memi[m[n1]+i1] + Memi[m[n1]+i1] = k + } + } + if (jmin < j) { + if (jmax != n1) { + Mems[kmin] = d1 + k = Memi[m[jmin]+i1] + Memi[m[jmin]+i1] = Memi[m[n1]+i1] + Memi[m[n1]+i1] = k + } else { + Mems[kmin] = d2 + k = Memi[m[jmin]+i1] + Memi[m[jmin]+i1] = Memi[m[j]+i1] + Memi[m[j]+i1] = k + } + } + } 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 + k = Memi[m[jmin]+i1] + Memi[m[jmin]+i1] = Memi[m[n1]+i1] + Memi[m[n1]+i1] = k + } + } 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 + k = Memi[m[jmax]+i1] + Memi[m[jmax]+i1] = Memi[m[n1]+i1] + Memi[m[n1]+i1] = k + } + } 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_mmi (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 +int d1, d2, dmin, dmax + +include "../icombine.com" + +begin + if (dflag == D_NONE) + return + + if (dflag == D_ALL) { + n1 = max (0, 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 = max (0, 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 = Memi[k] + dmax = d1; dmin = d1; jmax = 1; jmin = 1; kmax = k; kmin = k + do j = 2, n1 { + d2 = d1 + k = d[j] + i1 + d1 = Memi[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) { + Memi[kmax] = d2 + k = Memi[m[jmax]+i1] + Memi[m[jmax]+i1] = Memi[m[j]+i1] + Memi[m[j]+i1] = k + } else { + Memi[kmax] = d1 + k = Memi[m[jmax]+i1] + Memi[m[jmax]+i1] = Memi[m[n1]+i1] + Memi[m[n1]+i1] = k + } + } + if (jmin < j) { + if (jmax != n1) { + Memi[kmin] = d1 + k = Memi[m[jmin]+i1] + Memi[m[jmin]+i1] = Memi[m[n1]+i1] + Memi[m[n1]+i1] = k + } else { + Memi[kmin] = d2 + k = Memi[m[jmin]+i1] + Memi[m[jmin]+i1] = Memi[m[j]+i1] + Memi[m[j]+i1] = k + } + } + } else { + if (jmax < j) { + if (jmin != j) + Memi[kmax] = d2 + else + Memi[kmax] = d1 + } + if (jmin < j) { + if (jmax != n1) + Memi[kmin] = d1 + else + Memi[kmin] = d2 + } + } + n1 = n1 - 2 + } + + # Reject the excess low points. + do np = 1, nlow { + k = d[1] + i1 + d1 = Memi[k] + dmin = d1; jmin = 1; kmin = k + do j = 2, n1 { + k = d[j] + i1 + d1 = Memi[k] + if (d1 < dmin) { + dmin = d1; jmin = j; kmin = k + } + } + if (keepids) { + if (jmin < n1) { + Memi[kmin] = d1 + k = Memi[m[jmin]+i1] + Memi[m[jmin]+i1] = Memi[m[n1]+i1] + Memi[m[n1]+i1] = k + } + } else { + if (jmin < n1) + Memi[kmin] = d1 + } + n1 = n1 - 1 + } + + # Reject the excess high points. + do np = 1, nhigh { + k = d[1] + i1 + d1 = Memi[k] + dmax = d1; jmax = 1; kmax = k + do j = 2, n1 { + k = d[j] + i1 + d1 = Memi[k] + if (d1 > dmax) { + dmax = d1; jmax = j; kmax = k + } + } + if (keepids) { + if (jmax < n1) { + Memi[kmax] = d1 + k = Memi[m[jmax]+i1] + Memi[m[jmax]+i1] = Memi[m[n1]+i1] + Memi[m[n1]+i1] = k + } + } else { + if (jmax < n1) + Memi[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 = max (0, 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 = max (0, 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 + k = Memi[m[jmax]+i1] + Memi[m[jmax]+i1] = Memi[m[j]+i1] + Memi[m[j]+i1] = k + } else { + Memr[kmax] = d1 + k = Memi[m[jmax]+i1] + Memi[m[jmax]+i1] = Memi[m[n1]+i1] + Memi[m[n1]+i1] = k + } + } + if (jmin < j) { + if (jmax != n1) { + Memr[kmin] = d1 + k = Memi[m[jmin]+i1] + Memi[m[jmin]+i1] = Memi[m[n1]+i1] + Memi[m[n1]+i1] = k + } else { + Memr[kmin] = d2 + k = Memi[m[jmin]+i1] + Memi[m[jmin]+i1] = Memi[m[j]+i1] + Memi[m[j]+i1] = k + } + } + } 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 + k = Memi[m[jmin]+i1] + Memi[m[jmin]+i1] = Memi[m[n1]+i1] + Memi[m[n1]+i1] = k + } + } 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 + k = Memi[m[jmax]+i1] + Memi[m[jmax]+i1] = Memi[m[n1]+i1] + Memi[m[n1]+i1] = k + } + } 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 + +# IC_MM -- Reject a specified number of high and low pixels + +procedure ic_mmd (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 +double d1, d2, dmin, dmax + +include "../icombine.com" + +begin + if (dflag == D_NONE) + return + + if (dflag == D_ALL) { + n1 = max (0, 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 = max (0, 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 = Memd[k] + dmax = d1; dmin = d1; jmax = 1; jmin = 1; kmax = k; kmin = k + do j = 2, n1 { + d2 = d1 + k = d[j] + i1 + d1 = Memd[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) { + Memd[kmax] = d2 + k = Memi[m[jmax]+i1] + Memi[m[jmax]+i1] = Memi[m[j]+i1] + Memi[m[j]+i1] = k + } else { + Memd[kmax] = d1 + k = Memi[m[jmax]+i1] + Memi[m[jmax]+i1] = Memi[m[n1]+i1] + Memi[m[n1]+i1] = k + } + } + if (jmin < j) { + if (jmax != n1) { + Memd[kmin] = d1 + k = Memi[m[jmin]+i1] + Memi[m[jmin]+i1] = Memi[m[n1]+i1] + Memi[m[n1]+i1] = k + } else { + Memd[kmin] = d2 + k = Memi[m[jmin]+i1] + Memi[m[jmin]+i1] = Memi[m[j]+i1] + Memi[m[j]+i1] = k + } + } + } else { + if (jmax < j) { + if (jmin != j) + Memd[kmax] = d2 + else + Memd[kmax] = d1 + } + if (jmin < j) { + if (jmax != n1) + Memd[kmin] = d1 + else + Memd[kmin] = d2 + } + } + n1 = n1 - 2 + } + + # Reject the excess low points. + do np = 1, nlow { + k = d[1] + i1 + d1 = Memd[k] + dmin = d1; jmin = 1; kmin = k + do j = 2, n1 { + k = d[j] + i1 + d1 = Memd[k] + if (d1 < dmin) { + dmin = d1; jmin = j; kmin = k + } + } + if (keepids) { + if (jmin < n1) { + Memd[kmin] = d1 + k = Memi[m[jmin]+i1] + Memi[m[jmin]+i1] = Memi[m[n1]+i1] + Memi[m[n1]+i1] = k + } + } else { + if (jmin < n1) + Memd[kmin] = d1 + } + n1 = n1 - 1 + } + + # Reject the excess high points. + do np = 1, nhigh { + k = d[1] + i1 + d1 = Memd[k] + dmax = d1; jmax = 1; kmax = k + do j = 2, n1 { + k = d[j] + i1 + d1 = Memd[k] + if (d1 > dmax) { + dmax = d1; jmax = j; kmax = k + } + } + if (keepids) { + if (jmax < n1) { + Memd[kmax] = d1 + k = Memi[m[jmax]+i1] + Memi[m[jmax]+i1] = Memi[m[n1]+i1] + Memi[m[n1]+i1] = k + } + } else { + if (jmax < n1) + Memd[kmax] = d1 + } + n1 = n1 - 1 + } + n[i] = n1 + } + + if (dflag == D_ALL && npairs + nlow + nhigh > 0) + dflag = D_MIX +end + diff --git a/pkg/images/immatch/src/imcombine/src/generic/icnmodel.x b/pkg/images/immatch/src/imcombine/src/generic/icnmodel.x new file mode 100644 index 00000000..559cba73 --- /dev/null +++ b/pkg/images/immatch/src/imcombine/src/generic/icnmodel.x @@ -0,0 +1,528 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> +include <mach.h> +include "../icombine.h" +include "../icmask.h" + + +# IC_NMODEL -- Compute the quadrature average (or summed) noise model. +# Options include a weighted average/sum. + +procedure ic_nmodels (d, m, n, nm, wts, nimages, npts, doblank, doaverage, + average) + +pointer d[nimages] # Data pointers +pointer m[nimages] # Image ID pointers +int n[npts] # Number of points +real nm[3,nimages] # Noise model parameters +real wts[nimages] # Weights +int nimages # Number of images +int npts # Number of output points per line +int doblank # Set blank values? +int doaverage # Do average? +real average[npts] # Average (returned) + +int i, j, k, n1 +real val, wt, sumwt +real sum, zero +data zero /0.0/ + +include "../icombine.com" + +begin + # If no data has been excluded do the average/sum 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/sum + # to the blank value if requested. + + if (dflag == D_ALL) { + if (dowts && doaverage == YES) { + do i = 1, npts { + k = i - 1 + val = max (zero, Mems[d[1]+k]) + val = nm[1,1] + val/nm[2,1] + (val*nm[3,1])**2 + wt = wts[Memi[m[1]+k]] + sum = val * wt**2 + do j = 2, n[i] { + val = max (zero, Mems[d[j]+k]) + val = nm[1,j] + val/nm[2,j] + (val*nm[3,j])**2 + wt = wts[Memi[m[j]+k]] + sum = sum + val * wt**2 + } + average[i] = sqrt(sum) + } + } else { + do i = 1, npts { + k = i - 1 + val = max (zero, Mems[d[1]+k]) + val = nm[1,1] + val/nm[2,1] + (val*nm[3,1])**2 + sum = val + do j = 2, n[i] { + val = max (zero, Mems[d[j]+k]) + val = nm[1,j] + val/nm[2,j] + (val*nm[3,j])**2 + sum = sum + val + } + if (doaverage == YES) + average[i] = sqrt(sum) / n[i] + else + average[i] = sqrt(sum) + } + } + } else if (dflag == D_NONE) { + if (doblank == YES) { + do i = 1, npts + average[i] = blank + } + } else { + if (dowts && doaverage == YES) { + do i = 1, npts { + n1 = abs(n[i]) + if (n1 > 0) { + k = i - 1 + val = max (zero, Mems[d[1]+k]) + val = nm[1,1] + val/nm[2,1] + (val*nm[3,1])**2 + wt = wts[Memi[m[1]+k]] + sum = val * wt**2 + sumwt = wt + do j = 2, n1 { + val = max (zero, Mems[d[j]+k]) + val = nm[1,j] + val/nm[2,j] + (val*nm[3,j])**2 + wt = wts[Memi[m[j]+k]] + sum = sum + val * wt**2 + sumwt = sumwt + wt + } + if (doaverage == YES) { + if (sumwt > 0) + average[i] = sqrt(sum) / sumwt + else { + val = max (zero, Mems[d[1]+k]) + val = nm[1,1] + val/nm[2,1] + (val*nm[3,1])**2 + sum = Mems[d[1]+k]**2 + do j = 2, n1 { + val = max (zero, Mems[d[j]+k]) + val = nm[1,j] + val/nm[2,j] + + (val*nm[3,j])**2 + sum = sum + val + } + average[i] = sqrt(sum) / n1 + } + } else + average[i] = sqrt(sum) + } else if (doblank == YES) + average[i] = blank + } + } else { + do i = 1, npts { + n1 = abs(n[i]) + if (n1 > 0) { + k = i - 1 + val = max (zero, Mems[d[1]+k]) + val = nm[1,1] + val/nm[2,1] + (val*nm[3,1])**2 + sum = val + do j = 2, n1 { + val = max (zero, Mems[d[j]+k]) + val = nm[1,j] + val/nm[2,j] + (val*nm[3,j])**2 + sum = sum + val + } + if (doaverage == YES) + average[i] = sqrt(sum) / n1 + else + average[i] = sqrt(sum) + } else if (doblank == YES) + average[i] = blank + } + } + } +end + +# IC_NMODEL -- Compute the quadrature average (or summed) noise model. +# Options include a weighted average/sum. + +procedure ic_nmodeli (d, m, n, nm, wts, nimages, npts, doblank, doaverage, + average) + +pointer d[nimages] # Data pointers +pointer m[nimages] # Image ID pointers +int n[npts] # Number of points +real nm[3,nimages] # Noise model parameters +real wts[nimages] # Weights +int nimages # Number of images +int npts # Number of output points per line +int doblank # Set blank values? +int doaverage # Do average? +real average[npts] # Average (returned) + +int i, j, k, n1 +real val, wt, sumwt +real sum, zero +data zero /0.0/ + +include "../icombine.com" + +begin + # If no data has been excluded do the average/sum 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/sum + # to the blank value if requested. + + if (dflag == D_ALL) { + if (dowts && doaverage == YES) { + do i = 1, npts { + k = i - 1 + val = max (zero, Memi[d[1]+k]) + val = nm[1,1] + val/nm[2,1] + (val*nm[3,1])**2 + wt = wts[Memi[m[1]+k]] + sum = val * wt**2 + do j = 2, n[i] { + val = max (zero, Memi[d[j]+k]) + val = nm[1,j] + val/nm[2,j] + (val*nm[3,j])**2 + wt = wts[Memi[m[j]+k]] + sum = sum + val * wt**2 + } + average[i] = sqrt(sum) + } + } else { + do i = 1, npts { + k = i - 1 + val = max (zero, Memi[d[1]+k]) + val = nm[1,1] + val/nm[2,1] + (val*nm[3,1])**2 + sum = val + do j = 2, n[i] { + val = max (zero, Memi[d[j]+k]) + val = nm[1,j] + val/nm[2,j] + (val*nm[3,j])**2 + sum = sum + val + } + if (doaverage == YES) + average[i] = sqrt(sum) / n[i] + else + average[i] = sqrt(sum) + } + } + } else if (dflag == D_NONE) { + if (doblank == YES) { + do i = 1, npts + average[i] = blank + } + } else { + if (dowts && doaverage == YES) { + do i = 1, npts { + n1 = abs(n[i]) + if (n1 > 0) { + k = i - 1 + val = max (zero, Memi[d[1]+k]) + val = nm[1,1] + val/nm[2,1] + (val*nm[3,1])**2 + wt = wts[Memi[m[1]+k]] + sum = val * wt**2 + sumwt = wt + do j = 2, n1 { + val = max (zero, Memi[d[j]+k]) + val = nm[1,j] + val/nm[2,j] + (val*nm[3,j])**2 + wt = wts[Memi[m[j]+k]] + sum = sum + val * wt**2 + sumwt = sumwt + wt + } + if (doaverage == YES) { + if (sumwt > 0) + average[i] = sqrt(sum) / sumwt + else { + val = max (zero, Memi[d[1]+k]) + val = nm[1,1] + val/nm[2,1] + (val*nm[3,1])**2 + sum = Memi[d[1]+k]**2 + do j = 2, n1 { + val = max (zero, Memi[d[j]+k]) + val = nm[1,j] + val/nm[2,j] + + (val*nm[3,j])**2 + sum = sum + val + } + average[i] = sqrt(sum) / n1 + } + } else + average[i] = sqrt(sum) + } else if (doblank == YES) + average[i] = blank + } + } else { + do i = 1, npts { + n1 = abs(n[i]) + if (n1 > 0) { + k = i - 1 + val = max (zero, Memi[d[1]+k]) + val = nm[1,1] + val/nm[2,1] + (val*nm[3,1])**2 + sum = val + do j = 2, n1 { + val = max (zero, Memi[d[j]+k]) + val = nm[1,j] + val/nm[2,j] + (val*nm[3,j])**2 + sum = sum + val + } + if (doaverage == YES) + average[i] = sqrt(sum) / n1 + else + average[i] = sqrt(sum) + } else if (doblank == YES) + average[i] = blank + } + } + } +end + +# IC_NMODEL -- Compute the quadrature average (or summed) noise model. +# Options include a weighted average/sum. + +procedure ic_nmodelr (d, m, n, nm, wts, nimages, npts, doblank, doaverage, + average) + +pointer d[nimages] # Data pointers +pointer m[nimages] # Image ID pointers +int n[npts] # Number of points +real nm[3,nimages] # Noise model parameters +real wts[nimages] # Weights +int nimages # Number of images +int npts # Number of output points per line +int doblank # Set blank values? +int doaverage # Do average? +real average[npts] # Average (returned) + +int i, j, k, n1 +real val, wt, sumwt +real sum, zero +data zero /0.0/ + +include "../icombine.com" + +begin + # If no data has been excluded do the average/sum 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/sum + # to the blank value if requested. + + if (dflag == D_ALL) { + if (dowts && doaverage == YES) { + do i = 1, npts { + k = i - 1 + val = max (zero, Memr[d[1]+k]) + val = nm[1,1] + val/nm[2,1] + (val*nm[3,1])**2 + wt = wts[Memi[m[1]+k]] + sum = val * wt**2 + do j = 2, n[i] { + val = max (zero, Memr[d[j]+k]) + val = nm[1,j] + val/nm[2,j] + (val*nm[3,j])**2 + wt = wts[Memi[m[j]+k]] + sum = sum + val * wt**2 + } + average[i] = sqrt(sum) + } + } else { + do i = 1, npts { + k = i - 1 + val = max (zero, Memr[d[1]+k]) + val = nm[1,1] + val/nm[2,1] + (val*nm[3,1])**2 + sum = val + do j = 2, n[i] { + val = max (zero, Memr[d[j]+k]) + val = nm[1,j] + val/nm[2,j] + (val*nm[3,j])**2 + sum = sum + val + } + if (doaverage == YES) + average[i] = sqrt(sum) / n[i] + else + average[i] = sqrt(sum) + } + } + } else if (dflag == D_NONE) { + if (doblank == YES) { + do i = 1, npts + average[i] = blank + } + } else { + if (dowts && doaverage == YES) { + do i = 1, npts { + n1 = abs(n[i]) + if (n1 > 0) { + k = i - 1 + val = max (zero, Memr[d[1]+k]) + val = nm[1,1] + val/nm[2,1] + (val*nm[3,1])**2 + wt = wts[Memi[m[1]+k]] + sum = val * wt**2 + sumwt = wt + do j = 2, n1 { + val = max (zero, Memr[d[j]+k]) + val = nm[1,j] + val/nm[2,j] + (val*nm[3,j])**2 + wt = wts[Memi[m[j]+k]] + sum = sum + val * wt**2 + sumwt = sumwt + wt + } + if (doaverage == YES) { + if (sumwt > 0) + average[i] = sqrt(sum) / sumwt + else { + val = max (zero, Memr[d[1]+k]) + val = nm[1,1] + val/nm[2,1] + (val*nm[3,1])**2 + sum = Memr[d[1]+k]**2 + do j = 2, n1 { + val = max (zero, Memr[d[j]+k]) + val = nm[1,j] + val/nm[2,j] + + (val*nm[3,j])**2 + sum = sum + val + } + average[i] = sqrt(sum) / n1 + } + } else + average[i] = sqrt(sum) + } else if (doblank == YES) + average[i] = blank + } + } else { + do i = 1, npts { + n1 = abs(n[i]) + if (n1 > 0) { + k = i - 1 + val = max (zero, Memr[d[1]+k]) + val = nm[1,1] + val/nm[2,1] + (val*nm[3,1])**2 + sum = val + do j = 2, n1 { + val = max (zero, Memr[d[j]+k]) + val = nm[1,j] + val/nm[2,j] + (val*nm[3,j])**2 + sum = sum + val + } + if (doaverage == YES) + average[i] = sqrt(sum) / n1 + else + average[i] = sqrt(sum) + } else if (doblank == YES) + average[i] = blank + } + } + } +end + +# IC_NMODEL -- Compute the quadrature average (or summed) noise model. +# Options include a weighted average/sum. + +procedure ic_nmodeld (d, m, n, nm, wts, nimages, npts, doblank, doaverage, + average) + +pointer d[nimages] # Data pointers +pointer m[nimages] # Image ID pointers +int n[npts] # Number of points +real nm[3,nimages] # Noise model parameters +real wts[nimages] # Weights +int nimages # Number of images +int npts # Number of output points per line +int doblank # Set blank values? +int doaverage # Do average? +double average[npts] # Average (returned) + +int i, j, k, n1 +real val, wt, sumwt +double sum, zero +data zero /0.0D0/ + +include "../icombine.com" + +begin + # If no data has been excluded do the average/sum 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/sum + # to the blank value if requested. + + if (dflag == D_ALL) { + if (dowts && doaverage == YES) { + do i = 1, npts { + k = i - 1 + val = max (zero, Memd[d[1]+k]) + val = nm[1,1] + val/nm[2,1] + (val*nm[3,1])**2 + wt = wts[Memi[m[1]+k]] + sum = val * wt**2 + do j = 2, n[i] { + val = max (zero, Memd[d[j]+k]) + val = nm[1,j] + val/nm[2,j] + (val*nm[3,j])**2 + wt = wts[Memi[m[j]+k]] + sum = sum + val * wt**2 + } + average[i] = sqrt(sum) + } + } else { + do i = 1, npts { + k = i - 1 + val = max (zero, Memd[d[1]+k]) + val = nm[1,1] + val/nm[2,1] + (val*nm[3,1])**2 + sum = val + do j = 2, n[i] { + val = max (zero, Memd[d[j]+k]) + val = nm[1,j] + val/nm[2,j] + (val*nm[3,j])**2 + sum = sum + val + } + if (doaverage == YES) + average[i] = sqrt(sum) / n[i] + else + average[i] = sqrt(sum) + } + } + } else if (dflag == D_NONE) { + if (doblank == YES) { + do i = 1, npts + average[i] = blank + } + } else { + if (dowts && doaverage == YES) { + do i = 1, npts { + n1 = abs(n[i]) + if (n1 > 0) { + k = i - 1 + val = max (zero, Memd[d[1]+k]) + val = nm[1,1] + val/nm[2,1] + (val*nm[3,1])**2 + wt = wts[Memi[m[1]+k]] + sum = val * wt**2 + sumwt = wt + do j = 2, n1 { + val = max (zero, Memd[d[j]+k]) + val = nm[1,j] + val/nm[2,j] + (val*nm[3,j])**2 + wt = wts[Memi[m[j]+k]] + sum = sum + val * wt**2 + sumwt = sumwt + wt + } + if (doaverage == YES) { + if (sumwt > 0) + average[i] = sqrt(sum) / sumwt + else { + val = max (zero, Memd[d[1]+k]) + val = nm[1,1] + val/nm[2,1] + (val*nm[3,1])**2 + sum = Memd[d[1]+k]**2 + do j = 2, n1 { + val = max (zero, Memd[d[j]+k]) + val = nm[1,j] + val/nm[2,j] + + (val*nm[3,j])**2 + sum = sum + val + } + average[i] = sqrt(sum) / n1 + } + } else + average[i] = sqrt(sum) + } else if (doblank == YES) + average[i] = blank + } + } else { + do i = 1, npts { + n1 = abs(n[i]) + if (n1 > 0) { + k = i - 1 + val = max (zero, Memd[d[1]+k]) + val = nm[1,1] + val/nm[2,1] + (val*nm[3,1])**2 + sum = val + do j = 2, n1 { + val = max (zero, Memd[d[j]+k]) + val = nm[1,j] + val/nm[2,j] + (val*nm[3,j])**2 + sum = sum + val + } + if (doaverage == YES) + average[i] = sqrt(sum) / n1 + else + average[i] = sqrt(sum) + } else if (doblank == YES) + average[i] = blank + } + } + } +end + diff --git a/pkg/images/immatch/src/imcombine/src/generic/icomb.x b/pkg/images/immatch/src/imcombine/src/generic/icomb.x new file mode 100644 index 00000000..3466073b --- /dev/null +++ b/pkg/images/immatch/src/imcombine/src/generic/icomb.x @@ -0,0 +1,2198 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> +include <imset.h> +include <pmset.h> +include <error.h> +include <syserr.h> +include <mach.h> +include "../icombine.h" + +# The following is for compiling under V2.11. +define IM_BUFFRAC IM_BUFSIZE +include <imset.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, scales, zeros, wts, offsets, nimages, bufsize) + +pointer in[nimages] # Input images +pointer out[ARB] # Output images +real scales[nimages] # Scales +real zeros[nimages] # Zeros +real wts[nimages] # Weights +int offsets[nimages,ARB] # Input image offsets +int nimages # Number of input images +int bufsize # IMIO buffer size + +char str[1] +int i, j, k, npts, fd, stropen(), xt_imgnls() +pointer sp, d, id, n, m, lflag, v, dbuf +pointer im, buf, xt_opix(), impl1i() +errchk stropen, xt_cpix, xt_opix, xt_imgnls, impl1i, ic_combines +pointer impl1r() +errchk impl1r + +include "../icombine.com" + +begin + npts = IM_LEN(out[1],1) + + # Allocate memory. + call smark (sp) + call salloc (dbuf, nimages, TY_POINTER) + 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 (v, IM_MAXDIM, TY_LONG) + call amovki (D_ALL, Memi[lflag], nimages) + call amovkl (1, Meml[v], IM_MAXDIM) + + # If not aligned or growing create data buffers of output length + # otherwise use the IMIO buffers. + + if (!aligned || grow >= 1.) { + do i = 1, nimages { + call salloc (Memi[dbuf+i-1], npts, TY_SHORT) + call aclrs (Mems[Memi[dbuf+i-1]], npts) + } + } else { + do i = 1, nimages { + im = xt_opix (in[i], i, 1) + if (im != in[i]) { + call salloc (Memi[dbuf+i-1], npts, TY_SHORT) + call aclrs (Mems[Memi[dbuf+i-1]], npts) + } + } + call amovki (NULL, Memi[dbuf], nimages) + } + + if (project) { + call imseti (in[1], IM_NBUFS, nimages) + call imseti (in[1], IM_BUFFRAC, 0) + call imseti (in[1], IM_BUFSIZE, bufsize) + do i = 1, 6 { + if (out[i] != NULL) { + call imseti (out[i], IM_BUFFRAC, 0) + 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, 6 { + if (out[i] != NULL) { + call imseti (out[i], IM_BUFFRAC, 0) + 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) + } + if (out[4] != NULL) { + buf = impl1i (out[4]) + call aclri (Memi[buf], npts) + } + if (out[5] != NULL) { + buf = impl1i (out[5]) + call aclri (Memi[buf], npts) + } + if (out[6] != NULL) { + buf = impl1i (out[6]) + call aclri (Memi[buf], npts) + } + + # Do I/O for first input image line. + if (!project) { + do i = 1, nimages { + call xt_imseti (i, "bufsize", bufsize) + j = max (0, offsets[i,1]) + k = min (npts, IM_LEN(in[i],1) + offsets[i,1]) + if (k - j < 1) + call xt_cpix (i) + j = 1 - offsets[i,2] + if (j < 1 || j > IM_LEN(in[i],2)) + call xt_cpix (i) + } + + do i = 1, nimages { + j = max (0, offsets[i,1]) + k = min (npts, IM_LEN(in[i],1) + offsets[i,1]) + if (k - j < 1) + next + j = 1 - offsets[i,2] + if (j < 1 || j > IM_LEN(in[i],2)) + next + iferr { + Meml[v+1] = j + j = xt_imgnls (in[i], i, buf, Meml[v], 1) + } then { + call imseti (im, IM_PIXFD, NULL) + 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, scales, zeros, 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, ext, ctor(), errcode() +real r, imgetr() +pointer sp, fname, imname, v1, v2, v3, work +pointer outdata, buf, nmod, nm, pms +pointer immap(), impnli() +pointer impnlr(), imgnlr() +errchk immap, ic_scale, imgetr, ic_grow, ic_grows, ic_rmasks, ic_emask +errchk ic_gdatas + +include "../icombine.com" +data ext/0/ + +begin + call smark (sp) + call salloc (fname, SZ_FNAME, TY_CHAR) + call salloc (imname, SZ_FNAME, TY_CHAR) + 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, SUM, QUAD, NMODEL: + if (dowts) + keepids = true + else + keepids = false + case MEDIAN: + dowts = false + keepids = false + } + docombine = true + + # Get noise model parameters. + if (combine==NMODEL) { + call salloc (nmod, 3*nimages, TY_REAL) + i = 1 + if (ctor (Memc[rdnoise], i, r) > 0) { + do i = 1, nimages + Memr[nmod+3*(i-1)] = r + } else { + do i = 1, nimages + Memr[nmod+3*(i-1)] = imgetr (in[i], Memc[rdnoise]) + } + i = 1 + if (ctor (Memc[gain], i, r) > 0) { + do i = 1, nimages { + Memr[nmod+3*(i-1)+1] = r * scales[i] + Memr[nmod+3*(i-1)] = + max ((Memr[nmod+3*(i-1)] / Memr[nmod+3*(i-1)+1]) ** 2, + 1e4 / MAX_REAL) + } + } else { + do i = 1, nimages { + r = imgetr (in[i], Memc[gain]) + Memr[nmod+3*(i-1)+1] = r * scales[i] + Memr[nmod+3*(i-1)] = + max ((Memr[nmod+3*(i-1)] / Memr[nmod+3*(i-1)+1]) ** 2, + 1e4 / MAX_REAL) + } + } + i = 1 + if (ctor (Memc[snoise], i, r) > 0) { + do i = 1, nimages + Memr[nmod+3*(i-1)+2] = r + } else { + do i = 1, nimages { + r = imgetr (in[i], Memc[snoise]) + Memr[nmod+3*(i-1)+2] = r + } + } + } + + # 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) + 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 + case PCLIP: + mclip = true + case AVSIGCLIP, SIGCLIP: + if (doscale1) + keepids = true + case NONE: + mclip = false + } + + if (out[4] != NULL) + keepids = true + + if (out[6] != NULL) { + keepids = true + call ic_einit (in, nimages, Memc[expkeyword], 1., 2**27-1) + } + + if (grow >= 1.) { + keepids = true + call salloc (work, npts * nimages, TY_INT) + } + pms = NULL + + if (keepids) { + do i = 1, nimages + call salloc (id[i], npts, TY_INT) + } + +# This idea turns out to has a problem with masks are used with wcs offsets. +# the matching of masks to images based on WCS requires access to the WCS +# of the images. For now we drop this idea but maybe a way can be identified +# to know when this is not going to be needed. +# # Reduce header memory use. +# do i = 1, nimages +# call xt_minhdr (i) + + 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 (pms == NULL || nkeep > 0) { + if (docombine) { + switch (combine) { + case AVERAGE: + call ic_averages (d, id, n, wts, nimages, npts, + YES, YES, Memr[outdata]) + case MEDIAN: + call ic_medians (d, n, npts, YES, Memr[outdata]) + case SUM: + call ic_averages (d, id, n, wts, nimages, npts, + YES, NO, Memr[outdata]) + case QUAD: + call ic_quads (d, id, n, wts, nimages, npts, + YES, YES, Memr[outdata]) + case NMODEL: + call ic_nmodels (d, id, n, Memr[nmod], wts, + nimages, npts, YES, YES, Memr[outdata]) + } + } + } + + if (grow >= 1.) + call ic_grow (out, Meml[v2], id, n, Memi[work], nimages, npts, + pms) + + if (pms == NULL) { + if (out[2] != NULL) { + call amovl (Meml[v2], Meml[v1], IM_MAXDIM) + i = impnli (out[2], buf, Meml[v1]) + do i = 1, npts { + if (n[i] > 0) + Memi[buf] = 0 + else if (n[i] == 0) + Memi[buf] = 1 + else + Memi[buf] = 1 + } + } + + 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]) + } + + if (out[4] != NULL) + call ic_rmasks (out[4], Meml[v2], id, nimages, n, npts) + + if (out[5] != NULL) { + call amovl (Meml[v2], Meml[v1], IM_MAXDIM) + i = impnli (out[5], buf, Meml[v1]) + call amovki (nimages, Memi[buf], npts) + call asubi (Memi[buf], n, Memi[buf], npts) + } + + if (out[6] != NULL) + call ic_emask (out[6], Meml[v2], id, nimages, n, wts, npts) + } + + call amovl (Meml[v1], Meml[v2], IM_MAXDIM) + } + + if (pms != NULL) { + if (nkeep > 0) { + call imstats (out[1], IM_IMAGENAME, Memc[fname], SZ_FNAME) + call imunmap (out[1]) + iferr (buf = immap (Memc[fname], READ_WRITE, 0)) { + switch (errcode()) { + case SYS_FXFOPNOEXTNV: + call imgcluster (Memc[fname], Memc[fname], SZ_FNAME) + ext = ext + 1 + call sprintf (Memc[imname], SZ_FNAME, "%s[%d]") + call pargstr (Memc[fname]) + call pargi (ext) + iferr (buf = immap (Memc[imname], READ_WRITE, 0)) { + buf = NULL + ext = 0 + } + repeat { + call sprintf (Memc[imname], SZ_FNAME, "%s[%d]") + call pargstr (Memc[fname]) + call pargi (ext+1) + iferr (outdata = immap (Memc[imname],READ_WRITE,0)) + break + if (buf != NULL) + call imunmap (buf) + buf = outdata + ext = ext + 1 + } + default: + call erract (EA_ERROR) + } + } + out[1] = buf + } + + call amovkl (long(1), Meml[v1], IM_MAXDIM) + call amovkl (long(1), Meml[v2], IM_MAXDIM) + call amovkl (long(1), Meml[v3], IM_MAXDIM) + 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]) + + call ic_grows (Meml[v2], d, id, n, Memi[work], nimages, npts, + pms) + + if (nkeep > 0) { + do i = 1, npts { + if (n[i] < nkeep) { + Meml[v1+1] = Meml[v1+1] - 1 + if (imgnlr (out[1], buf, Meml[v1]) == EOF) + ; + call amovr (Memr[buf], Memr[outdata], npts) + break + } + } + } + + switch (combine) { + case AVERAGE: + call ic_averages (d, id, n, wts, nimages, npts, + NO, YES, Memr[outdata]) + case MEDIAN: + call ic_medians (d, n, npts, NO, Memr[outdata]) + case SUM: + call ic_averages (d, id, n, wts, nimages, npts, + NO, NO, Memr[outdata]) + case QUAD: + call ic_quads (d, id, n, wts, nimages, npts, + NO, YES, Memr[outdata]) + case NMODEL: + call ic_nmodels (d, id, n, Memr[nmod], wts, + nimages, npts, NO, YES, Memr[outdata]) + } + + if (out[2] != NULL) { + call amovl (Meml[v2], Meml[v1], IM_MAXDIM) + i = impnli (out[2], buf, Meml[v1]) + do i = 1, npts { + if (n[i] > 0) + Memi[buf] = 0 + else if (n[i] == 0) + Memi[buf] = 1 + else + Memi[buf] = 2 + buf = buf + 1 + } + } + + 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]) + } + + if (out[4] != NULL) + call ic_rmasks (out[4], Meml[v2], id, nimages, n, npts) + + if (out[5] != NULL) { + call amovl (Meml[v2], Meml[v1], IM_MAXDIM) + i = impnli (out[5], buf, Meml[v1]) + call amovki (nimages, Memi[buf], npts) + call asubi (Memi[buf], n, Memi[buf], npts) + } + + if (out[6] != NULL) + call ic_emask (out[6], Meml[v2], id, nimages, n, wts, npts) + + call amovl (Meml[v1], Meml[v2], IM_MAXDIM) + } + + do i = 1, nimages + call pm_close (Memi[pms+i-1]) + call mfree (pms, TY_POINTER) + } + + call sfree (sp) +end + +procedure icombinei (in, out, scales, zeros, wts, offsets, nimages, bufsize) + +pointer in[nimages] # Input images +pointer out[ARB] # Output images +real scales[nimages] # Scales +real zeros[nimages] # Zeros +real wts[nimages] # Weights +int offsets[nimages,ARB] # Input image offsets +int nimages # Number of input images +int bufsize # IMIO buffer size + +char str[1] +int i, j, k, npts, fd, stropen(), xt_imgnli() +pointer sp, d, id, n, m, lflag, v, dbuf +pointer im, buf, xt_opix(), impl1i() +errchk stropen, xt_cpix, xt_opix, xt_imgnli, impl1i, ic_combinei +pointer impl1r() +errchk impl1r + +include "../icombine.com" + +begin + npts = IM_LEN(out[1],1) + + # Allocate memory. + call smark (sp) + call salloc (dbuf, nimages, TY_POINTER) + 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 (v, IM_MAXDIM, TY_LONG) + call amovki (D_ALL, Memi[lflag], nimages) + call amovkl (1, Meml[v], IM_MAXDIM) + + # If not aligned or growing create data buffers of output length + # otherwise use the IMIO buffers. + + if (!aligned || grow >= 1.) { + do i = 1, nimages { + call salloc (Memi[dbuf+i-1], npts, TY_INT) + call aclri (Memi[Memi[dbuf+i-1]], npts) + } + } else { + do i = 1, nimages { + im = xt_opix (in[i], i, 1) + if (im != in[i]) { + call salloc (Memi[dbuf+i-1], npts, TY_INT) + call aclri (Memi[Memi[dbuf+i-1]], npts) + } + } + call amovki (NULL, Memi[dbuf], nimages) + } + + if (project) { + call imseti (in[1], IM_NBUFS, nimages) + call imseti (in[1], IM_BUFFRAC, 0) + call imseti (in[1], IM_BUFSIZE, bufsize) + do i = 1, 6 { + if (out[i] != NULL) { + call imseti (out[i], IM_BUFFRAC, 0) + 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, 6 { + if (out[i] != NULL) { + call imseti (out[i], IM_BUFFRAC, 0) + 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) + } + if (out[4] != NULL) { + buf = impl1i (out[4]) + call aclri (Memi[buf], npts) + } + if (out[5] != NULL) { + buf = impl1i (out[5]) + call aclri (Memi[buf], npts) + } + if (out[6] != NULL) { + buf = impl1i (out[6]) + call aclri (Memi[buf], npts) + } + + # Do I/O for first input image line. + if (!project) { + do i = 1, nimages { + call xt_imseti (i, "bufsize", bufsize) + j = max (0, offsets[i,1]) + k = min (npts, IM_LEN(in[i],1) + offsets[i,1]) + if (k - j < 1) + call xt_cpix (i) + j = 1 - offsets[i,2] + if (j < 1 || j > IM_LEN(in[i],2)) + call xt_cpix (i) + } + + do i = 1, nimages { + j = max (0, offsets[i,1]) + k = min (npts, IM_LEN(in[i],1) + offsets[i,1]) + if (k - j < 1) + next + j = 1 - offsets[i,2] + if (j < 1 || j > IM_LEN(in[i],2)) + next + iferr { + Meml[v+1] = j + j = xt_imgnli (in[i], i, buf, Meml[v], 1) + } then { + call imseti (im, IM_PIXFD, NULL) + call sfree (sp) + call strclose (fd) + call erract (EA_ERROR) + } + } + } + + call strclose (fd) + } + + call ic_combinei (in, out, Memi[dbuf], Memi[d], Memi[id], Memi[n], + Memi[m], Memi[lflag], offsets, scales, zeros, wts, nimages, npts) +end + + +# IC_COMBINE -- Combine images. + +procedure ic_combinei (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, ext, ctor(), errcode() +real r, imgetr() +pointer sp, fname, imname, v1, v2, v3, work +pointer outdata, buf, nmod, nm, pms +pointer immap(), impnli() +pointer impnlr(), imgnlr() +errchk immap, ic_scale, imgetr, ic_grow, ic_growi, ic_rmasks, ic_emask +errchk ic_gdatai + +include "../icombine.com" +data ext/0/ + +begin + call smark (sp) + call salloc (fname, SZ_FNAME, TY_CHAR) + call salloc (imname, SZ_FNAME, TY_CHAR) + 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, SUM, QUAD, NMODEL: + if (dowts) + keepids = true + else + keepids = false + case MEDIAN: + dowts = false + keepids = false + } + docombine = true + + # Get noise model parameters. + if (combine==NMODEL) { + call salloc (nmod, 3*nimages, TY_REAL) + i = 1 + if (ctor (Memc[rdnoise], i, r) > 0) { + do i = 1, nimages + Memr[nmod+3*(i-1)] = r + } else { + do i = 1, nimages + Memr[nmod+3*(i-1)] = imgetr (in[i], Memc[rdnoise]) + } + i = 1 + if (ctor (Memc[gain], i, r) > 0) { + do i = 1, nimages { + Memr[nmod+3*(i-1)+1] = r * scales[i] + Memr[nmod+3*(i-1)] = + max ((Memr[nmod+3*(i-1)] / Memr[nmod+3*(i-1)+1]) ** 2, + 1e4 / MAX_REAL) + } + } else { + do i = 1, nimages { + r = imgetr (in[i], Memc[gain]) + Memr[nmod+3*(i-1)+1] = r * scales[i] + Memr[nmod+3*(i-1)] = + max ((Memr[nmod+3*(i-1)] / Memr[nmod+3*(i-1)+1]) ** 2, + 1e4 / MAX_REAL) + } + } + i = 1 + if (ctor (Memc[snoise], i, r) > 0) { + do i = 1, nimages + Memr[nmod+3*(i-1)+2] = r + } else { + do i = 1, nimages { + r = imgetr (in[i], Memc[snoise]) + Memr[nmod+3*(i-1)+2] = r + } + } + } + + # 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) + 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 + case PCLIP: + mclip = true + case AVSIGCLIP, SIGCLIP: + if (doscale1) + keepids = true + case NONE: + mclip = false + } + + if (out[4] != NULL) + keepids = true + + if (out[6] != NULL) { + keepids = true + call ic_einit (in, nimages, Memc[expkeyword], 1., 2**27-1) + } + + if (grow >= 1.) { + keepids = true + call salloc (work, npts * nimages, TY_INT) + } + pms = NULL + + if (keepids) { + do i = 1, nimages + call salloc (id[i], npts, TY_INT) + } + +# This idea turns out to has a problem with masks are used with wcs offsets. +# the matching of masks to images based on WCS requires access to the WCS +# of the images. For now we drop this idea but maybe a way can be identified +# to know when this is not going to be needed. +# # Reduce header memory use. +# do i = 1, nimages +# call xt_minhdr (i) + + while (impnlr (out[1], outdata, Meml[v1]) != EOF) { + call ic_gdatai (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_mccdclipi (d, id, n, scales, zeros, Memr[nm], + nimages, npts, Memr[outdata]) + else + call ic_accdclipi (d, id, n, scales, zeros, Memr[nm], + nimages, npts, Memr[outdata]) + case MINMAX: + call ic_mmi (d, id, n, npts) + case PCLIP: + call ic_pclipi (d, id, n, nimages, npts, Memr[outdata]) + case SIGCLIP: + if (mclip) + call ic_msigclipi (d, id, n, scales, zeros, nimages, npts, + Memr[outdata]) + else + call ic_asigclipi (d, id, n, scales, zeros, nimages, npts, + Memr[outdata]) + case AVSIGCLIP: + if (mclip) + call ic_mavsigclipi (d, id, n, scales, zeros, nimages, + npts, Memr[outdata]) + else + call ic_aavsigclipi (d, id, n, scales, zeros, nimages, + npts, Memr[outdata]) + } + + if (pms == NULL || nkeep > 0) { + if (docombine) { + switch (combine) { + case AVERAGE: + call ic_averagei (d, id, n, wts, nimages, npts, + YES, YES, Memr[outdata]) + case MEDIAN: + call ic_mediani (d, n, npts, YES, Memr[outdata]) + case SUM: + call ic_averagei (d, id, n, wts, nimages, npts, + YES, NO, Memr[outdata]) + case QUAD: + call ic_quadi (d, id, n, wts, nimages, npts, + YES, YES, Memr[outdata]) + case NMODEL: + call ic_nmodeli (d, id, n, Memr[nmod], wts, + nimages, npts, YES, YES, Memr[outdata]) + } + } + } + + if (grow >= 1.) + call ic_grow (out, Meml[v2], id, n, Memi[work], nimages, npts, + pms) + + if (pms == NULL) { + if (out[2] != NULL) { + call amovl (Meml[v2], Meml[v1], IM_MAXDIM) + i = impnli (out[2], buf, Meml[v1]) + do i = 1, npts { + if (n[i] > 0) + Memi[buf] = 0 + else if (n[i] == 0) + Memi[buf] = 1 + else + Memi[buf] = 1 + } + } + + if (out[3] != NULL) { + call amovl (Meml[v2], Meml[v1], IM_MAXDIM) + i = impnlr (out[3], buf, Meml[v1]) + call ic_sigmai (d, id, n, wts, npts, Memr[outdata], + Memr[buf]) + } + + if (out[4] != NULL) + call ic_rmasks (out[4], Meml[v2], id, nimages, n, npts) + + if (out[5] != NULL) { + call amovl (Meml[v2], Meml[v1], IM_MAXDIM) + i = impnli (out[5], buf, Meml[v1]) + call amovki (nimages, Memi[buf], npts) + call asubi (Memi[buf], n, Memi[buf], npts) + } + + if (out[6] != NULL) + call ic_emask (out[6], Meml[v2], id, nimages, n, wts, npts) + } + + call amovl (Meml[v1], Meml[v2], IM_MAXDIM) + } + + if (pms != NULL) { + if (nkeep > 0) { + call imstats (out[1], IM_IMAGENAME, Memc[fname], SZ_FNAME) + call imunmap (out[1]) + iferr (buf = immap (Memc[fname], READ_WRITE, 0)) { + switch (errcode()) { + case SYS_FXFOPNOEXTNV: + call imgcluster (Memc[fname], Memc[fname], SZ_FNAME) + ext = ext + 1 + call sprintf (Memc[imname], SZ_FNAME, "%s[%d]") + call pargstr (Memc[fname]) + call pargi (ext) + iferr (buf = immap (Memc[imname], READ_WRITE, 0)) { + buf = NULL + ext = 0 + } + repeat { + call sprintf (Memc[imname], SZ_FNAME, "%s[%d]") + call pargstr (Memc[fname]) + call pargi (ext+1) + iferr (outdata = immap (Memc[imname],READ_WRITE,0)) + break + if (buf != NULL) + call imunmap (buf) + buf = outdata + ext = ext + 1 + } + default: + call erract (EA_ERROR) + } + } + out[1] = buf + } + + call amovkl (long(1), Meml[v1], IM_MAXDIM) + call amovkl (long(1), Meml[v2], IM_MAXDIM) + call amovkl (long(1), Meml[v3], IM_MAXDIM) + while (impnlr (out[1], outdata, Meml[v1]) != EOF) { + call ic_gdatai (in, out, dbuf, d, id, n, m, lflag, offsets, + scales, zeros, nimages, npts, Meml[v2], Meml[v3]) + + call ic_growi (Meml[v2], d, id, n, Memi[work], nimages, npts, + pms) + + if (nkeep > 0) { + do i = 1, npts { + if (n[i] < nkeep) { + Meml[v1+1] = Meml[v1+1] - 1 + if (imgnlr (out[1], buf, Meml[v1]) == EOF) + ; + call amovr (Memr[buf], Memr[outdata], npts) + break + } + } + } + + switch (combine) { + case AVERAGE: + call ic_averagei (d, id, n, wts, nimages, npts, + NO, YES, Memr[outdata]) + case MEDIAN: + call ic_mediani (d, n, npts, NO, Memr[outdata]) + case SUM: + call ic_averagei (d, id, n, wts, nimages, npts, + NO, NO, Memr[outdata]) + case QUAD: + call ic_quadi (d, id, n, wts, nimages, npts, + NO, YES, Memr[outdata]) + case NMODEL: + call ic_nmodeli (d, id, n, Memr[nmod], wts, + nimages, npts, NO, YES, Memr[outdata]) + } + + if (out[2] != NULL) { + call amovl (Meml[v2], Meml[v1], IM_MAXDIM) + i = impnli (out[2], buf, Meml[v1]) + do i = 1, npts { + if (n[i] > 0) + Memi[buf] = 0 + else if (n[i] == 0) + Memi[buf] = 1 + else + Memi[buf] = 2 + buf = buf + 1 + } + } + + if (out[3] != NULL) { + call amovl (Meml[v2], Meml[v1], IM_MAXDIM) + i = impnlr (out[3], buf, Meml[v1]) + call ic_sigmai (d, id, n, wts, npts, Memr[outdata], + Memr[buf]) + } + + if (out[4] != NULL) + call ic_rmasks (out[4], Meml[v2], id, nimages, n, npts) + + if (out[5] != NULL) { + call amovl (Meml[v2], Meml[v1], IM_MAXDIM) + i = impnli (out[5], buf, Meml[v1]) + call amovki (nimages, Memi[buf], npts) + call asubi (Memi[buf], n, Memi[buf], npts) + } + + if (out[6] != NULL) + call ic_emask (out[6], Meml[v2], id, nimages, n, wts, npts) + + call amovl (Meml[v1], Meml[v2], IM_MAXDIM) + } + + do i = 1, nimages + call pm_close (Memi[pms+i-1]) + call mfree (pms, TY_POINTER) + } + + call sfree (sp) +end + +procedure icombiner (in, out, scales, zeros, wts, offsets, nimages, bufsize) + +pointer in[nimages] # Input images +pointer out[ARB] # Output images +real scales[nimages] # Scales +real zeros[nimages] # Zeros +real wts[nimages] # Weights +int offsets[nimages,ARB] # Input image offsets +int nimages # Number of input images +int bufsize # IMIO buffer size + +char str[1] +int i, j, k, npts, fd, stropen(), xt_imgnlr() +pointer sp, d, id, n, m, lflag, v, dbuf +pointer im, buf, xt_opix(), impl1i() +errchk stropen, xt_cpix, xt_opix, xt_imgnlr, impl1i, ic_combiner +pointer impl1r() +errchk impl1r + +include "../icombine.com" + +begin + npts = IM_LEN(out[1],1) + + # Allocate memory. + call smark (sp) + call salloc (dbuf, nimages, TY_POINTER) + 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 (v, IM_MAXDIM, TY_LONG) + call amovki (D_ALL, Memi[lflag], nimages) + call amovkl (1, Meml[v], IM_MAXDIM) + + # If not aligned or growing create data buffers of output length + # otherwise use the IMIO buffers. + + if (!aligned || grow >= 1.) { + do i = 1, nimages { + call salloc (Memi[dbuf+i-1], npts, TY_REAL) + call aclrr (Memr[Memi[dbuf+i-1]], npts) + } + } else { + do i = 1, nimages { + im = xt_opix (in[i], i, 1) + if (im != in[i]) { + call salloc (Memi[dbuf+i-1], npts, TY_REAL) + call aclrr (Memr[Memi[dbuf+i-1]], npts) + } + } + call amovki (NULL, Memi[dbuf], nimages) + } + + if (project) { + call imseti (in[1], IM_NBUFS, nimages) + call imseti (in[1], IM_BUFFRAC, 0) + call imseti (in[1], IM_BUFSIZE, bufsize) + do i = 1, 6 { + if (out[i] != NULL) { + call imseti (out[i], IM_BUFFRAC, 0) + 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, 6 { + if (out[i] != NULL) { + call imseti (out[i], IM_BUFFRAC, 0) + 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) + } + if (out[4] != NULL) { + buf = impl1i (out[4]) + call aclri (Memi[buf], npts) + } + if (out[5] != NULL) { + buf = impl1i (out[5]) + call aclri (Memi[buf], npts) + } + if (out[6] != NULL) { + buf = impl1i (out[6]) + call aclri (Memi[buf], npts) + } + + # Do I/O for first input image line. + if (!project) { + do i = 1, nimages { + call xt_imseti (i, "bufsize", bufsize) + j = max (0, offsets[i,1]) + k = min (npts, IM_LEN(in[i],1) + offsets[i,1]) + if (k - j < 1) + call xt_cpix (i) + j = 1 - offsets[i,2] + if (j < 1 || j > IM_LEN(in[i],2)) + call xt_cpix (i) + } + + do i = 1, nimages { + j = max (0, offsets[i,1]) + k = min (npts, IM_LEN(in[i],1) + offsets[i,1]) + if (k - j < 1) + next + j = 1 - offsets[i,2] + if (j < 1 || j > IM_LEN(in[i],2)) + next + iferr { + Meml[v+1] = j + j = xt_imgnlr (in[i], i, buf, Meml[v], 1) + } then { + call imseti (im, IM_PIXFD, NULL) + 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, scales, zeros, 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, ext, ctor(), errcode() +real r, imgetr() +pointer sp, fname, imname, v1, v2, v3, work +pointer outdata, buf, nmod, nm, pms +pointer immap(), impnli() +pointer impnlr(), imgnlr +errchk immap, ic_scale, imgetr, ic_grow, ic_growr, ic_rmasks, ic_emask +errchk ic_gdatar + +include "../icombine.com" +data ext/0/ + +begin + call smark (sp) + call salloc (fname, SZ_FNAME, TY_CHAR) + call salloc (imname, SZ_FNAME, TY_CHAR) + 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, SUM, QUAD, NMODEL: + if (dowts) + keepids = true + else + keepids = false + case MEDIAN: + dowts = false + keepids = false + } + docombine = true + + # Get noise model parameters. + if (combine==NMODEL) { + call salloc (nmod, 3*nimages, TY_REAL) + i = 1 + if (ctor (Memc[rdnoise], i, r) > 0) { + do i = 1, nimages + Memr[nmod+3*(i-1)] = r + } else { + do i = 1, nimages + Memr[nmod+3*(i-1)] = imgetr (in[i], Memc[rdnoise]) + } + i = 1 + if (ctor (Memc[gain], i, r) > 0) { + do i = 1, nimages { + Memr[nmod+3*(i-1)+1] = r * scales[i] + Memr[nmod+3*(i-1)] = + max ((Memr[nmod+3*(i-1)] / Memr[nmod+3*(i-1)+1]) ** 2, + 1e4 / MAX_REAL) + } + } else { + do i = 1, nimages { + r = imgetr (in[i], Memc[gain]) + Memr[nmod+3*(i-1)+1] = r * scales[i] + Memr[nmod+3*(i-1)] = + max ((Memr[nmod+3*(i-1)] / Memr[nmod+3*(i-1)+1]) ** 2, + 1e4 / MAX_REAL) + } + } + i = 1 + if (ctor (Memc[snoise], i, r) > 0) { + do i = 1, nimages + Memr[nmod+3*(i-1)+2] = r + } else { + do i = 1, nimages { + r = imgetr (in[i], Memc[snoise]) + Memr[nmod+3*(i-1)+2] = r + } + } + } + + # 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) + 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 + case PCLIP: + mclip = true + case AVSIGCLIP, SIGCLIP: + if (doscale1) + keepids = true + case NONE: + mclip = false + } + + if (out[4] != NULL) + keepids = true + + if (out[6] != NULL) { + keepids = true + call ic_einit (in, nimages, Memc[expkeyword], 1., 2**27-1) + } + + if (grow >= 1.) { + keepids = true + call salloc (work, npts * nimages, TY_INT) + } + pms = NULL + + if (keepids) { + do i = 1, nimages + call salloc (id[i], npts, TY_INT) + } + +# This idea turns out to has a problem with masks are used with wcs offsets. +# the matching of masks to images based on WCS requires access to the WCS +# of the images. For now we drop this idea but maybe a way can be identified +# to know when this is not going to be needed. +# # Reduce header memory use. +# do i = 1, nimages +# call xt_minhdr (i) + + 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 (pms == NULL || nkeep > 0) { + if (docombine) { + switch (combine) { + case AVERAGE: + call ic_averager (d, id, n, wts, nimages, npts, + YES, YES, Memr[outdata]) + case MEDIAN: + call ic_medianr (d, n, npts, YES, Memr[outdata]) + case SUM: + call ic_averager (d, id, n, wts, nimages, npts, + YES, NO, Memr[outdata]) + case QUAD: + call ic_quadr (d, id, n, wts, nimages, npts, + YES, YES, Memr[outdata]) + case NMODEL: + call ic_nmodelr (d, id, n, Memr[nmod], wts, + nimages, npts, YES, YES, Memr[outdata]) + } + } + } + + if (grow >= 1.) + call ic_grow (out, Meml[v2], id, n, Memi[work], nimages, npts, + pms) + + if (pms == NULL) { + if (out[2] != NULL) { + call amovl (Meml[v2], Meml[v1], IM_MAXDIM) + i = impnli (out[2], buf, Meml[v1]) + do i = 1, npts { + if (n[i] > 0) + Memi[buf] = 0 + else if (n[i] == 0) + Memi[buf] = 1 + else + Memi[buf] = 2 + buf = buf + 1 + } + } + + 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]) + } + + if (out[4] != NULL) + call ic_rmasks (out[4], Meml[v2], id, nimages, n, npts) + + if (out[5] != NULL) { + call amovl (Meml[v2], Meml[v1], IM_MAXDIM) + i = impnli (out[5], buf, Meml[v1]) + call amovki (nimages, Memi[buf], npts) + call asubi (Memi[buf], n, Memi[buf], npts) + } + + if (out[6] != NULL) + call ic_emask (out[6], Meml[v2], id, nimages, n, wts, npts) + } + + call amovl (Meml[v1], Meml[v2], IM_MAXDIM) + } + + if (pms != NULL) { + if (nkeep > 0) { + call imstats (out[1], IM_IMAGENAME, Memc[fname], SZ_FNAME) + call imunmap (out[1]) + iferr (buf = immap (Memc[fname], READ_WRITE, 0)) { + switch (errcode()) { + case SYS_FXFOPNOEXTNV: + call imgcluster (Memc[fname], Memc[fname], SZ_FNAME) + ext = ext + 1 + call sprintf (Memc[imname], SZ_FNAME, "%s[%d]") + call pargstr (Memc[fname]) + call pargi (ext) + iferr (buf = immap (Memc[imname], READ_WRITE, 0)) { + buf = NULL + ext = 0 + } + repeat { + call sprintf (Memc[imname], SZ_FNAME, "%s[%d]") + call pargstr (Memc[fname]) + call pargi (ext+1) + iferr (outdata = immap (Memc[imname],READ_WRITE,0)) + break + if (buf != NULL) + call imunmap (buf) + buf = outdata + ext = ext + 1 + } + default: + call erract (EA_ERROR) + } + } + out[1] = buf + } + + call amovkl (long(1), Meml[v1], IM_MAXDIM) + call amovkl (long(1), Meml[v2], IM_MAXDIM) + call amovkl (long(1), Meml[v3], IM_MAXDIM) + 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]) + + call ic_growr (Meml[v2], d, id, n, Memi[work], nimages, npts, + pms) + + if (nkeep > 0) { + do i = 1, npts { + if (n[i] < nkeep) { + Meml[v1+1] = Meml[v1+1] - 1 + if (imgnlr (out[1], buf, Meml[v1]) == EOF) + ; + call amovr (Memr[buf], Memr[outdata], npts) + break + } + } + } + + switch (combine) { + case AVERAGE: + call ic_averager (d, id, n, wts, nimages, npts, + NO, YES, Memr[outdata]) + case MEDIAN: + call ic_medianr (d, n, npts, NO, Memr[outdata]) + case SUM: + call ic_averager (d, id, n, wts, nimages, npts, + NO, NO, Memr[outdata]) + case QUAD: + call ic_quadr (d, id, n, wts, nimages, npts, + NO, YES, Memr[outdata]) + case NMODEL: + call ic_nmodelr (d, id, n, Memr[nmod], wts, + nimages, npts, NO, YES, Memr[outdata]) + } + + if (out[2] != NULL) { + call amovl (Meml[v2], Meml[v1], IM_MAXDIM) + i = impnli (out[2], buf, Meml[v1]) + do i = 1, npts { + if (n[i] > 0) + Memi[buf] = 0 + else if (n[i] == 0) + Memi[buf] = 1 + else + Memi[buf] = 2 + buf = buf + 1 + } + } + + 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]) + } + + if (out[4] != NULL) + call ic_rmasks (out[4], Meml[v2], id, nimages, n, npts) + + if (out[5] != NULL) { + call amovl (Meml[v2], Meml[v1], IM_MAXDIM) + i = impnli (out[5], buf, Meml[v1]) + call amovki (nimages, Memi[buf], npts) + call asubi (Memi[buf], n, Memi[buf], npts) + } + + if (out[6] != NULL) + call ic_emask (out[6], Meml[v2], id, nimages, n, wts, npts) + + call amovl (Meml[v1], Meml[v2], IM_MAXDIM) + } + + do i = 1, nimages + call pm_close (Memi[pms+i-1]) + call mfree (pms, TY_POINTER) + } + + call sfree (sp) +end + +procedure icombined (in, out, scales, zeros, wts, offsets, nimages, bufsize) + +pointer in[nimages] # Input images +pointer out[ARB] # Output images +real scales[nimages] # Scales +real zeros[nimages] # Zeros +real wts[nimages] # Weights +int offsets[nimages,ARB] # Input image offsets +int nimages # Number of input images +int bufsize # IMIO buffer size + +char str[1] +int i, j, k, npts, fd, stropen(), xt_imgnld() +pointer sp, d, id, n, m, lflag, v, dbuf +pointer im, buf, xt_opix(), impl1i() +errchk stropen, xt_cpix, xt_opix, xt_imgnld, impl1i, ic_combined +pointer impl1d() +errchk impl1d + +include "../icombine.com" + +begin + npts = IM_LEN(out[1],1) + + # Allocate memory. + call smark (sp) + call salloc (dbuf, nimages, TY_POINTER) + 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 (v, IM_MAXDIM, TY_LONG) + call amovki (D_ALL, Memi[lflag], nimages) + call amovkl (1, Meml[v], IM_MAXDIM) + + # If not aligned or growing create data buffers of output length + # otherwise use the IMIO buffers. + + if (!aligned || grow >= 1.) { + do i = 1, nimages { + call salloc (Memi[dbuf+i-1], npts, TY_DOUBLE) + call aclrd (Memd[Memi[dbuf+i-1]], npts) + } + } else { + do i = 1, nimages { + im = xt_opix (in[i], i, 1) + if (im != in[i]) { + call salloc (Memi[dbuf+i-1], npts, TY_DOUBLE) + call aclrd (Memd[Memi[dbuf+i-1]], npts) + } + } + call amovki (NULL, Memi[dbuf], nimages) + } + + if (project) { + call imseti (in[1], IM_NBUFS, nimages) + call imseti (in[1], IM_BUFFRAC, 0) + call imseti (in[1], IM_BUFSIZE, bufsize) + do i = 1, 6 { + if (out[i] != NULL) { + call imseti (out[i], IM_BUFFRAC, 0) + 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, 6 { + if (out[i] != NULL) { + call imseti (out[i], IM_BUFFRAC, 0) + call imseti (out[i], IM_BUFSIZE, bufsize) + } + } + buf = impl1d (out[1]) + call aclrd (Memd[buf], npts) + if (out[3] != NULL) { + buf = impl1d (out[3]) + call aclrd (Memd[buf], npts) + } + if (out[2] != NULL) { + buf = impl1i (out[2]) + call aclri (Memi[buf], npts) + } + if (out[4] != NULL) { + buf = impl1i (out[4]) + call aclri (Memi[buf], npts) + } + if (out[5] != NULL) { + buf = impl1i (out[5]) + call aclri (Memi[buf], npts) + } + if (out[6] != NULL) { + buf = impl1i (out[6]) + call aclri (Memi[buf], npts) + } + + # Do I/O for first input image line. + if (!project) { + do i = 1, nimages { + call xt_imseti (i, "bufsize", bufsize) + j = max (0, offsets[i,1]) + k = min (npts, IM_LEN(in[i],1) + offsets[i,1]) + if (k - j < 1) + call xt_cpix (i) + j = 1 - offsets[i,2] + if (j < 1 || j > IM_LEN(in[i],2)) + call xt_cpix (i) + } + + do i = 1, nimages { + j = max (0, offsets[i,1]) + k = min (npts, IM_LEN(in[i],1) + offsets[i,1]) + if (k - j < 1) + next + j = 1 - offsets[i,2] + if (j < 1 || j > IM_LEN(in[i],2)) + next + iferr { + Meml[v+1] = j + j = xt_imgnld (in[i], i, buf, Meml[v], 1) + } then { + call imseti (im, IM_PIXFD, NULL) + call sfree (sp) + call strclose (fd) + call erract (EA_ERROR) + } + } + } + + call strclose (fd) + } + + call ic_combined (in, out, Memi[dbuf], Memi[d], Memi[id], Memi[n], + Memi[m], Memi[lflag], offsets, scales, zeros, wts, nimages, npts) +end + + +# IC_COMBINE -- Combine images. + +procedure ic_combined (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, ext, ctor(), errcode() +real r, imgetr() +pointer sp, fname, imname, v1, v2, v3, work +pointer outdata, buf, nmod, nm, pms +pointer immap(), impnli() +pointer impnld(), imgnld +errchk immap, ic_scale, imgetr, ic_grow, ic_growd, ic_rmasks, ic_emask +errchk ic_gdatad + +include "../icombine.com" +data ext/0/ + +begin + call smark (sp) + call salloc (fname, SZ_FNAME, TY_CHAR) + call salloc (imname, SZ_FNAME, TY_CHAR) + 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, SUM, QUAD, NMODEL: + if (dowts) + keepids = true + else + keepids = false + case MEDIAN: + dowts = false + keepids = false + } + docombine = true + + # Get noise model parameters. + if (combine==NMODEL) { + call salloc (nmod, 3*nimages, TY_REAL) + i = 1 + if (ctor (Memc[rdnoise], i, r) > 0) { + do i = 1, nimages + Memr[nmod+3*(i-1)] = r + } else { + do i = 1, nimages + Memr[nmod+3*(i-1)] = imgetr (in[i], Memc[rdnoise]) + } + i = 1 + if (ctor (Memc[gain], i, r) > 0) { + do i = 1, nimages { + Memr[nmod+3*(i-1)+1] = r * scales[i] + Memr[nmod+3*(i-1)] = + max ((Memr[nmod+3*(i-1)] / Memr[nmod+3*(i-1)+1]) ** 2, + 1e4 / MAX_REAL) + } + } else { + do i = 1, nimages { + r = imgetr (in[i], Memc[gain]) + Memr[nmod+3*(i-1)+1] = r * scales[i] + Memr[nmod+3*(i-1)] = + max ((Memr[nmod+3*(i-1)] / Memr[nmod+3*(i-1)+1]) ** 2, + 1e4 / MAX_REAL) + } + } + i = 1 + if (ctor (Memc[snoise], i, r) > 0) { + do i = 1, nimages + Memr[nmod+3*(i-1)+2] = r + } else { + do i = 1, nimages { + r = imgetr (in[i], Memc[snoise]) + Memr[nmod+3*(i-1)+2] = r + } + } + } + + # 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) + 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 + case PCLIP: + mclip = true + case AVSIGCLIP, SIGCLIP: + if (doscale1) + keepids = true + case NONE: + mclip = false + } + + if (out[4] != NULL) + keepids = true + + if (out[6] != NULL) { + keepids = true + call ic_einit (in, nimages, Memc[expkeyword], 1., 2**27-1) + } + + if (grow >= 1.) { + keepids = true + call salloc (work, npts * nimages, TY_INT) + } + pms = NULL + + if (keepids) { + do i = 1, nimages + call salloc (id[i], npts, TY_INT) + } + +# This idea turns out to has a problem with masks are used with wcs offsets. +# the matching of masks to images based on WCS requires access to the WCS +# of the images. For now we drop this idea but maybe a way can be identified +# to know when this is not going to be needed. +# # Reduce header memory use. +# do i = 1, nimages +# call xt_minhdr (i) + + while (impnld (out[1], outdata, Meml[v1]) != EOF) { + call ic_gdatad (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_mccdclipd (d, id, n, scales, zeros, Memr[nm], + nimages, npts, Memd[outdata]) + else + call ic_accdclipd (d, id, n, scales, zeros, Memr[nm], + nimages, npts, Memd[outdata]) + case MINMAX: + call ic_mmd (d, id, n, npts) + case PCLIP: + call ic_pclipd (d, id, n, nimages, npts, Memd[outdata]) + case SIGCLIP: + if (mclip) + call ic_msigclipd (d, id, n, scales, zeros, nimages, npts, + Memd[outdata]) + else + call ic_asigclipd (d, id, n, scales, zeros, nimages, npts, + Memd[outdata]) + case AVSIGCLIP: + if (mclip) + call ic_mavsigclipd (d, id, n, scales, zeros, nimages, + npts, Memd[outdata]) + else + call ic_aavsigclipd (d, id, n, scales, zeros, nimages, + npts, Memd[outdata]) + } + + if (pms == NULL || nkeep > 0) { + if (docombine) { + switch (combine) { + case AVERAGE: + call ic_averaged (d, id, n, wts, nimages, npts, + YES, YES, Memd[outdata]) + case MEDIAN: + call ic_mediand (d, n, npts, YES, Memd[outdata]) + case SUM: + call ic_averaged (d, id, n, wts, nimages, npts, + YES, NO, Memd[outdata]) + case QUAD: + call ic_quadd (d, id, n, wts, nimages, npts, + YES, YES, Memd[outdata]) + case NMODEL: + call ic_nmodeld (d, id, n, Memr[nmod], wts, + nimages, npts, YES, YES, Memd[outdata]) + } + } + } + + if (grow >= 1.) + call ic_grow (out, Meml[v2], id, n, Memi[work], nimages, npts, + pms) + + if (pms == NULL) { + if (out[2] != NULL) { + call amovl (Meml[v2], Meml[v1], IM_MAXDIM) + i = impnli (out[2], buf, Meml[v1]) + do i = 1, npts { + if (n[i] > 0) + Memi[buf] = 0 + else if (n[i] == 0) + Memi[buf] = 1 + else + Memi[buf] = 2 + buf = buf + 1 + } + } + + if (out[3] != NULL) { + call amovl (Meml[v2], Meml[v1], IM_MAXDIM) + i = impnld (out[3], buf, Meml[v1]) + call ic_sigmad (d, id, n, wts, npts, Memd[outdata], + Memd[buf]) + } + + if (out[4] != NULL) + call ic_rmasks (out[4], Meml[v2], id, nimages, n, npts) + + if (out[5] != NULL) { + call amovl (Meml[v2], Meml[v1], IM_MAXDIM) + i = impnli (out[5], buf, Meml[v1]) + call amovki (nimages, Memi[buf], npts) + call asubi (Memi[buf], n, Memi[buf], npts) + } + + if (out[6] != NULL) + call ic_emask (out[6], Meml[v2], id, nimages, n, wts, npts) + } + + call amovl (Meml[v1], Meml[v2], IM_MAXDIM) + } + + if (pms != NULL) { + if (nkeep > 0) { + call imstats (out[1], IM_IMAGENAME, Memc[fname], SZ_FNAME) + call imunmap (out[1]) + iferr (buf = immap (Memc[fname], READ_WRITE, 0)) { + switch (errcode()) { + case SYS_FXFOPNOEXTNV: + call imgcluster (Memc[fname], Memc[fname], SZ_FNAME) + ext = ext + 1 + call sprintf (Memc[imname], SZ_FNAME, "%s[%d]") + call pargstr (Memc[fname]) + call pargi (ext) + iferr (buf = immap (Memc[imname], READ_WRITE, 0)) { + buf = NULL + ext = 0 + } + repeat { + call sprintf (Memc[imname], SZ_FNAME, "%s[%d]") + call pargstr (Memc[fname]) + call pargi (ext+1) + iferr (outdata = immap (Memc[imname],READ_WRITE,0)) + break + if (buf != NULL) + call imunmap (buf) + buf = outdata + ext = ext + 1 + } + default: + call erract (EA_ERROR) + } + } + out[1] = buf + } + + call amovkl (long(1), Meml[v1], IM_MAXDIM) + call amovkl (long(1), Meml[v2], IM_MAXDIM) + call amovkl (long(1), Meml[v3], IM_MAXDIM) + while (impnld (out[1], outdata, Meml[v1]) != EOF) { + call ic_gdatad (in, out, dbuf, d, id, n, m, lflag, offsets, + scales, zeros, nimages, npts, Meml[v2], Meml[v3]) + + call ic_growd (Meml[v2], d, id, n, Memi[work], nimages, npts, + pms) + + if (nkeep > 0) { + do i = 1, npts { + if (n[i] < nkeep) { + Meml[v1+1] = Meml[v1+1] - 1 + if (imgnld (out[1], buf, Meml[v1]) == EOF) + ; + call amovd (Memd[buf], Memd[outdata], npts) + break + } + } + } + + switch (combine) { + case AVERAGE: + call ic_averaged (d, id, n, wts, nimages, npts, + NO, YES, Memd[outdata]) + case MEDIAN: + call ic_mediand (d, n, npts, NO, Memd[outdata]) + case SUM: + call ic_averaged (d, id, n, wts, nimages, npts, + NO, NO, Memd[outdata]) + case QUAD: + call ic_quadd (d, id, n, wts, nimages, npts, + NO, YES, Memd[outdata]) + case NMODEL: + call ic_nmodeld (d, id, n, Memr[nmod], wts, + nimages, npts, NO, YES, Memd[outdata]) + } + + if (out[2] != NULL) { + call amovl (Meml[v2], Meml[v1], IM_MAXDIM) + i = impnli (out[2], buf, Meml[v1]) + do i = 1, npts { + if (n[i] > 0) + Memi[buf] = 0 + else if (n[i] == 0) + Memi[buf] = 1 + else + Memi[buf] = 2 + buf = buf + 1 + } + } + + if (out[3] != NULL) { + call amovl (Meml[v2], Meml[v1], IM_MAXDIM) + i = impnld (out[3], buf, Meml[v1]) + call ic_sigmad (d, id, n, wts, npts, Memd[outdata], + Memd[buf]) + } + + if (out[4] != NULL) + call ic_rmasks (out[4], Meml[v2], id, nimages, n, npts) + + if (out[5] != NULL) { + call amovl (Meml[v2], Meml[v1], IM_MAXDIM) + i = impnli (out[5], buf, Meml[v1]) + call amovki (nimages, Memi[buf], npts) + call asubi (Memi[buf], n, Memi[buf], npts) + } + + if (out[6] != NULL) + call ic_emask (out[6], Meml[v2], id, nimages, n, wts, npts) + + call amovl (Meml[v1], Meml[v2], IM_MAXDIM) + } + + do i = 1, nimages + call pm_close (Memi[pms+i-1]) + call mfree (pms, TY_POINTER) + } + + call sfree (sp) +end + diff --git a/pkg/images/immatch/src/imcombine/src/generic/icpclip.x b/pkg/images/immatch/src/imcombine/src/generic/icpclip.x new file mode 100644 index 00000000..3dfe7f48 --- /dev/null +++ b/pkg/images/immatch/src/imcombine/src/generic/icpclip.x @@ -0,0 +1,879 @@ +# 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 = max (0, 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 = max (0, 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 == max (0, 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 >= 1.)) { + k = max (nl, n4 + 1) + if (keepids) { + do l = 1, min (n1, nl-1) { + Mems[d[l]+j] = Mems[d[k]+j] + if (grow >= 1.) { + 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 (max (0, 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_pclipi (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 = max (0, 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 = max (0, 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 = Memi[d[n2-1]+j] + med = (med + Memi[d[n2]+j]) / 2. + } else + med = Memi[d[n2]+j] + + if (n1 < max (MINCLIP, maxkeep+1)) { + if (combine == MEDIAN) + median[i] = med + next + } + + # Define sigma for clipping + sigma = t * (Memi[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 - Memi[d[nl]+j]) / sigma + if (r < lsigma) + break + Memr[resid+nl] = r + } + for (nh=n1; nh>=1; nh=nh-1) { + r = (Memi[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 == max (0, 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 = Memi[d[n5-1]+j] + med = (med + Memi[d[n5]+j]) / 2. + } else + med = Memi[d[n5]+j] + n[i] = n4 + } + if (combine == MEDIAN) + median[i] = med + + # Reorder if pixels only if necessary. + if (nl > 1 && (combine != MEDIAN || grow >= 1.)) { + k = max (nl, n4 + 1) + if (keepids) { + do l = 1, min (n1, nl-1) { + Memi[d[l]+j] = Memi[d[k]+j] + if (grow >= 1.) { + 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) { + Memi[d[l]+j] = Memi[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 (max (0, 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 = max (0, 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 = max (0, 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 == max (0, 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 >= 1.)) { + k = max (nl, n4 + 1) + if (keepids) { + do l = 1, min (n1, nl-1) { + Memr[d[l]+j] = Memr[d[k]+j] + if (grow >= 1.) { + 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 (max (0, 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_pclipd (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 +double 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 +double 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 = max (0, 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 = max (0, 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 = Memd[d[n2-1]+j] + med = (med + Memd[d[n2]+j]) / 2. + } else + med = Memd[d[n2]+j] + + if (n1 < max (MINCLIP, maxkeep+1)) { + if (combine == MEDIAN) + median[i] = med + next + } + + # Define sigma for clipping + sigma = t * (Memd[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 - Memd[d[nl]+j]) / sigma + if (r < lsigma) + break + Memr[resid+nl] = r + } + for (nh=n1; nh>=1; nh=nh-1) { + r = (Memd[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 == max (0, 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 = Memd[d[n5-1]+j] + med = (med + Memd[d[n5]+j]) / 2. + } else + med = Memd[d[n5]+j] + n[i] = n4 + } + if (combine == MEDIAN) + median[i] = med + + # Reorder if pixels only if necessary. + if (nl > 1 && (combine != MEDIAN || grow >= 1.)) { + k = max (nl, n4 + 1) + if (keepids) { + do l = 1, min (n1, nl-1) { + Memd[d[l]+j] = Memd[d[k]+j] + if (grow >= 1.) { + 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) { + Memd[d[l]+j] = Memd[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 (max (0, 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/pkg/images/immatch/src/imcombine/src/generic/icquad.x b/pkg/images/immatch/src/imcombine/src/generic/icquad.x new file mode 100644 index 00000000..4ba5eb14 --- /dev/null +++ b/pkg/images/immatch/src/imcombine/src/generic/icquad.x @@ -0,0 +1,476 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> +include <mach.h> +include "../icombine.h" +include "../icmask.h" + + +# IC_QUAD -- Compute the quadrature average (or summed) image line. +# Options include a weighted average/sum. + +procedure ic_quads (d, m, n, wts, nimages, npts, doblank, doaverage, + average) + +pointer d[nimages] # Data pointers +pointer m[nimages] # Image ID pointers +int n[npts] # Number of points +real wts[nimages] # Weights +int nimages # Number of images +int npts # Number of output points per line +int doblank # Set blank values? +int doaverage # Do average? +real average[npts] # Average (returned) + +int i, j, k, n1 +real val, wt, sumwt +real sum + +include "../icombine.com" + +begin + # If no data has been excluded do the average/sum 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/sum + # to the blank value if requested. + + if (dflag == D_ALL) { + if (dowts && doaverage == YES) { + do i = 1, npts { + k = i - 1 + val = Mems[d[1]+k] + wt = wts[Memi[m[1]+k]] + sum = (val * wt) ** 2 + do j = 2, n[i] { + val = Mems[d[j]+k] + wt = wts[Memi[m[j]+k]] + sum = sum + (val * wt) ** 2 + } + average[i] = sqrt(sum) + } + } else { + do i = 1, npts { + k = i - 1 + val = Mems[d[1]+k] + sum = val**2 + do j = 2, n[i] { + val = Mems[d[j]+k] + sum = sum + val**2 + } + if (doaverage == YES) + average[i] = sqrt(sum) / n[i] + else + average[i] = sqrt(sum) + } + } + } else if (dflag == D_NONE) { + if (doblank == YES) { + do i = 1, npts + average[i] = blank + } + } else { + if (dowts && doaverage == YES) { + do i = 1, npts { + n1 = abs(n[i]) + if (n1 > 0) { + k = i - 1 + val = Mems[d[1]+k] + wt = wts[Memi[m[1]+k]] + sum = (val * wt) ** 2 + sumwt = wt + do j = 2, n1 { + val = Mems[d[j]+k] + wt = wts[Memi[m[j]+k]] + sum = sum + (val* wt) ** 2 + sumwt = sumwt + wt + } + if (doaverage == YES) { + if (sumwt > 0) + average[i] = sqrt(sum) / sumwt + else { + val = Mems[d[1]+k] + sum = val**2 + do j = 2, n1 { + val = Mems[d[j]+k] + sum = sum + val**2 + } + average[i] = sqrt(sum) / n1 + } + } else + average[i] = sqrt(sum) + } else if (doblank == YES) + average[i] = blank + } + } else { + do i = 1, npts { + n1 = abs(n[i]) + if (n1 > 0) { + k = i - 1 + val = Mems[d[1]+k] + sum = val**2 + do j = 2, n1 { + val = Mems[d[j]+k] + sum = sum + val**2 + } + if (doaverage == YES) + average[i] = sqrt(sum) / n1 + else + average[i] = sqrt(sum) + } else if (doblank == YES) + average[i] = blank + } + } + } +end + +# IC_QUAD -- Compute the quadrature average (or summed) image line. +# Options include a weighted average/sum. + +procedure ic_quadi (d, m, n, wts, nimages, npts, doblank, doaverage, + average) + +pointer d[nimages] # Data pointers +pointer m[nimages] # Image ID pointers +int n[npts] # Number of points +real wts[nimages] # Weights +int nimages # Number of images +int npts # Number of output points per line +int doblank # Set blank values? +int doaverage # Do average? +real average[npts] # Average (returned) + +int i, j, k, n1 +real val, wt, sumwt +real sum + +include "../icombine.com" + +begin + # If no data has been excluded do the average/sum 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/sum + # to the blank value if requested. + + if (dflag == D_ALL) { + if (dowts && doaverage == YES) { + do i = 1, npts { + k = i - 1 + val = Memi[d[1]+k] + wt = wts[Memi[m[1]+k]] + sum = (val * wt) ** 2 + do j = 2, n[i] { + val = Memi[d[j]+k] + wt = wts[Memi[m[j]+k]] + sum = sum + (val * wt) ** 2 + } + average[i] = sqrt(sum) + } + } else { + do i = 1, npts { + k = i - 1 + val = Memi[d[1]+k] + sum = val**2 + do j = 2, n[i] { + val = Memi[d[j]+k] + sum = sum + val**2 + } + if (doaverage == YES) + average[i] = sqrt(sum) / n[i] + else + average[i] = sqrt(sum) + } + } + } else if (dflag == D_NONE) { + if (doblank == YES) { + do i = 1, npts + average[i] = blank + } + } else { + if (dowts && doaverage == YES) { + do i = 1, npts { + n1 = abs(n[i]) + if (n1 > 0) { + k = i - 1 + val = Memi[d[1]+k] + wt = wts[Memi[m[1]+k]] + sum = (val * wt) ** 2 + sumwt = wt + do j = 2, n1 { + val = Memi[d[j]+k] + wt = wts[Memi[m[j]+k]] + sum = sum + (val* wt) ** 2 + sumwt = sumwt + wt + } + if (doaverage == YES) { + if (sumwt > 0) + average[i] = sqrt(sum) / sumwt + else { + val = Memi[d[1]+k] + sum = val**2 + do j = 2, n1 { + val = Memi[d[j]+k] + sum = sum + val**2 + } + average[i] = sqrt(sum) / n1 + } + } else + average[i] = sqrt(sum) + } else if (doblank == YES) + average[i] = blank + } + } else { + do i = 1, npts { + n1 = abs(n[i]) + if (n1 > 0) { + k = i - 1 + val = Memi[d[1]+k] + sum = val**2 + do j = 2, n1 { + val = Memi[d[j]+k] + sum = sum + val**2 + } + if (doaverage == YES) + average[i] = sqrt(sum) / n1 + else + average[i] = sqrt(sum) + } else if (doblank == YES) + average[i] = blank + } + } + } +end + +# IC_QUAD -- Compute the quadrature average (or summed) image line. +# Options include a weighted average/sum. + +procedure ic_quadr (d, m, n, wts, nimages, npts, doblank, doaverage, + average) + +pointer d[nimages] # Data pointers +pointer m[nimages] # Image ID pointers +int n[npts] # Number of points +real wts[nimages] # Weights +int nimages # Number of images +int npts # Number of output points per line +int doblank # Set blank values? +int doaverage # Do average? +real average[npts] # Average (returned) + +int i, j, k, n1 +real val, wt, sumwt +real sum + +include "../icombine.com" + +begin + # If no data has been excluded do the average/sum 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/sum + # to the blank value if requested. + + if (dflag == D_ALL) { + if (dowts && doaverage == YES) { + do i = 1, npts { + k = i - 1 + val = Memr[d[1]+k] + wt = wts[Memi[m[1]+k]] + sum = (val * wt) ** 2 + do j = 2, n[i] { + val = Memr[d[j]+k] + wt = wts[Memi[m[j]+k]] + sum = sum + (val * wt) ** 2 + } + average[i] = sqrt(sum) + } + } else { + do i = 1, npts { + k = i - 1 + val = Memr[d[1]+k] + sum = val**2 + do j = 2, n[i] { + val = Memr[d[j]+k] + sum = sum + val**2 + } + if (doaverage == YES) + average[i] = sqrt(sum) / n[i] + else + average[i] = sqrt(sum) + } + } + } else if (dflag == D_NONE) { + if (doblank == YES) { + do i = 1, npts + average[i] = blank + } + } else { + if (dowts && doaverage == YES) { + do i = 1, npts { + n1 = abs(n[i]) + if (n1 > 0) { + k = i - 1 + val = Memr[d[1]+k] + wt = wts[Memi[m[1]+k]] + sum = (val * wt) ** 2 + sumwt = wt + do j = 2, n1 { + val = Memr[d[j]+k] + wt = wts[Memi[m[j]+k]] + sum = sum + (val* wt) ** 2 + sumwt = sumwt + wt + } + if (doaverage == YES) { + if (sumwt > 0) + average[i] = sqrt(sum) / sumwt + else { + val = Memr[d[1]+k] + sum = val**2 + do j = 2, n1 { + val = Memr[d[j]+k] + sum = sum + val**2 + } + average[i] = sqrt(sum) / n1 + } + } else + average[i] = sqrt(sum) + } else if (doblank == YES) + average[i] = blank + } + } else { + do i = 1, npts { + n1 = abs(n[i]) + if (n1 > 0) { + k = i - 1 + val = Memr[d[1]+k] + sum = val**2 + do j = 2, n1 { + val = Memr[d[j]+k] + sum = sum + val**2 + } + if (doaverage == YES) + average[i] = sqrt(sum) / n1 + else + average[i] = sqrt(sum) + } else if (doblank == YES) + average[i] = blank + } + } + } +end + +# IC_QUAD -- Compute the quadrature average (or summed) image line. +# Options include a weighted average/sum. + +procedure ic_quadd (d, m, n, wts, nimages, npts, doblank, doaverage, + average) + +pointer d[nimages] # Data pointers +pointer m[nimages] # Image ID pointers +int n[npts] # Number of points +real wts[nimages] # Weights +int nimages # Number of images +int npts # Number of output points per line +int doblank # Set blank values? +int doaverage # Do average? +double average[npts] # Average (returned) + +int i, j, k, n1 +real val, wt, sumwt +double sum + +include "../icombine.com" + +begin + # If no data has been excluded do the average/sum 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/sum + # to the blank value if requested. + + if (dflag == D_ALL) { + if (dowts && doaverage == YES) { + do i = 1, npts { + k = i - 1 + val = Memd[d[1]+k] + wt = wts[Memi[m[1]+k]] + sum = (val * wt) ** 2 + do j = 2, n[i] { + val = Memd[d[j]+k] + wt = wts[Memi[m[j]+k]] + sum = sum + (val * wt) ** 2 + } + average[i] = sqrt(sum) + } + } else { + do i = 1, npts { + k = i - 1 + val = Memd[d[1]+k] + sum = val**2 + do j = 2, n[i] { + val = Memd[d[j]+k] + sum = sum + val**2 + } + if (doaverage == YES) + average[i] = sqrt(sum) / n[i] + else + average[i] = sqrt(sum) + } + } + } else if (dflag == D_NONE) { + if (doblank == YES) { + do i = 1, npts + average[i] = blank + } + } else { + if (dowts && doaverage == YES) { + do i = 1, npts { + n1 = abs(n[i]) + if (n1 > 0) { + k = i - 1 + val = Memd[d[1]+k] + wt = wts[Memi[m[1]+k]] + sum = (val * wt) ** 2 + sumwt = wt + do j = 2, n1 { + val = Memd[d[j]+k] + wt = wts[Memi[m[j]+k]] + sum = sum + (val* wt) ** 2 + sumwt = sumwt + wt + } + if (doaverage == YES) { + if (sumwt > 0) + average[i] = sqrt(sum) / sumwt + else { + val = Memd[d[1]+k] + sum = val**2 + do j = 2, n1 { + val = Memd[d[j]+k] + sum = sum + val**2 + } + average[i] = sqrt(sum) / n1 + } + } else + average[i] = sqrt(sum) + } else if (doblank == YES) + average[i] = blank + } + } else { + do i = 1, npts { + n1 = abs(n[i]) + if (n1 > 0) { + k = i - 1 + val = Memd[d[1]+k] + sum = val**2 + do j = 2, n1 { + val = Memd[d[j]+k] + sum = sum + val**2 + } + if (doaverage == YES) + average[i] = sqrt(sum) / n1 + else + average[i] = sqrt(sum) + } else if (doblank == YES) + average[i] = blank + } + } + } +end + diff --git a/pkg/images/immatch/src/imcombine/src/generic/icsclip.x b/pkg/images/immatch/src/imcombine/src/generic/icsclip.x new file mode 100644 index 00000000..2f2ac17e --- /dev/null +++ b/pkg/images/immatch/src/imcombine/src/generic/icsclip.x @@ -0,0 +1,1923 @@ +# 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 = max (0, n[1]) + do i = 1, npts { + k = i - 1 + n1 = max (0, 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 (max (0, 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 = max (0, n[1]) + do i = 1, npts { + k = i - 1 + n1 = max (0, 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 <= nh; 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 <= nh; 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 == max (0, 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 >= 1.)) { + j = max (nl, n1 + 1) + if (keepids) { + do l = 1, min (n1, nl-1) { + Mems[d[l]+k] = Mems[d[j]+k] + if (grow >= 1.) { + 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 (max (0, 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_asigclipi (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 = max (0, n[1]) + do i = 1, npts { + k = i - 1 + n1 = max (0, 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 = Memi[d[1]+k] + do j = 2, n1 + sum = sum + Memi[d[j]+k] + average[i] = sum / n1 + } + } + next + } + + # Compute average with the high and low rejected. + low = Memi[d[1]+k] + high = Memi[d[2]+k] + if (low > high) { + d1 = low + low = high + high = d1 + } + sum = 0. + do j = 3, n1 { + d1 = Memi[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 = Memi[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 = Memi[dp1] + r = (d1 - a) / (s * Memr[wp]) + if (r < -lsigma || r > hsigma) { + Memr[resid+n1] = abs (r) + if (j < n1) { + dp2 = d[n1] + k + Memi[dp1] = Memi[dp2] + Memi[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 + (Memi[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 = Memi[dp1] + r = (d1 - a) / s + if (r < -lsigma || r > hsigma) { + Memr[resid+n1] = abs (r) + if (j < n1) { + dp2 = d[n1] + k + Memi[dp1] = Memi[dp2] + Memi[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 = Memi[dp1] + Memi[dp1] = Memi[dp2] + Memi[dp2] = d1 + mp2 = m[l] + k + s = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = s + } + } + } + sum = sum + Memi[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 = Memi[dp1] + Memi[dp1] = Memi[dp2] + Memi[dp2] = d1 + if (keepids) { + mp1 = m[j] + k + mp2 = m[l] + k + s = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = s + } + } + } + } + sum = sum + Memi[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 (max (0, n[i]) != nin) { + dflag = D_MIX + break + } + } + } + + call sfree (sp) +end + + +# IC_MSIGCLIP -- Reject pixels using sigma clipping about the median + +procedure ic_msigclipi (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 = max (0, n[1]) + do i = 1, npts { + k = i - 1 + n1 = max (0, 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 = (Memi[d[n3-1]+k] + Memi[d[n3]+k]) / 2. + else + med = Memi[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 + ((Memi[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 <= nh; nl = nl + 1) { + r = (med - Memi[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 = (Memi[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 + (Memi[d[j]+k] - med) ** 2 + s = sqrt (s / (n1 - 1)) + + # Reject pixels and save the residuals. + if (s > 0.) { + for (; nl <= nh; nl = nl + 1) { + r = (med - Memi[d[nl]+k]) / s + if (r <= lsigma) + break + Memr[resid+nl] = r + n1 = n1 - 1 + } + for (; nh >= nl; nh = nh - 1) { + r = (Memi[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 == max (0, 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 >= 1.)) { + j = max (nl, n1 + 1) + if (keepids) { + do l = 1, min (n1, nl-1) { + Memi[d[l]+k] = Memi[d[j]+k] + if (grow >= 1.) { + 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) { + Memi[d[l]+k] = Memi[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 (max (0, 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 = max (0, n[1]) + do i = 1, npts { + k = i - 1 + n1 = max (0, 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 (max (0, 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 = max (0, n[1]) + do i = 1, npts { + k = i - 1 + n1 = max (0, 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 <= nh; 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 <= nh; 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 == max (0, 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 >= 1.)) { + j = max (nl, n1 + 1) + if (keepids) { + do l = 1, min (n1, nl-1) { + Memr[d[l]+k] = Memr[d[j]+k] + if (grow >= 1.) { + 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 (max (0, 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_asigclipd (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 +double average[npts] # Average + +int i, j, k, l, jj, n1, n2, nin, nk, maxkeep +double d1, low, high, sum, a, s, r, one +data one /1.0D0/ +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 = max (0, n[1]) + do i = 1, npts { + k = i - 1 + n1 = max (0, 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 = Memd[d[1]+k] + do j = 2, n1 + sum = sum + Memd[d[j]+k] + average[i] = sum / n1 + } + } + next + } + + # Compute average with the high and low rejected. + low = Memd[d[1]+k] + high = Memd[d[2]+k] + if (low > high) { + d1 = low + low = high + high = d1 + } + sum = 0. + do j = 3, n1 { + d1 = Memd[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 = Memd[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 = Memd[dp1] + r = (d1 - a) / (s * Memr[wp]) + if (r < -lsigma || r > hsigma) { + Memr[resid+n1] = abs (r) + if (j < n1) { + dp2 = d[n1] + k + Memd[dp1] = Memd[dp2] + Memd[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 + (Memd[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 = Memd[dp1] + r = (d1 - a) / s + if (r < -lsigma || r > hsigma) { + Memr[resid+n1] = abs (r) + if (j < n1) { + dp2 = d[n1] + k + Memd[dp1] = Memd[dp2] + Memd[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 = Memd[dp1] + Memd[dp1] = Memd[dp2] + Memd[dp2] = d1 + mp2 = m[l] + k + s = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = s + } + } + } + sum = sum + Memd[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 = Memd[dp1] + Memd[dp1] = Memd[dp2] + Memd[dp2] = d1 + if (keepids) { + mp1 = m[j] + k + mp2 = m[l] + k + s = Memi[mp1] + Memi[mp1] = Memi[mp2] + Memi[mp2] = s + } + } + } + } + sum = sum + Memd[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 (max (0, n[i]) != nin) { + dflag = D_MIX + break + } + } + } + + call sfree (sp) +end + + +# IC_MSIGCLIP -- Reject pixels using sigma clipping about the median + +procedure ic_msigclipd (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 +double 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 +double med, one +data one /1.0D0/ + +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 = max (0, n[1]) + do i = 1, npts { + k = i - 1 + n1 = max (0, 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 = (Memd[d[n3-1]+k] + Memd[d[n3]+k]) / 2. + else + med = Memd[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 + ((Memd[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 <= nh; nl = nl + 1) { + r = (med - Memd[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 = (Memd[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 + (Memd[d[j]+k] - med) ** 2 + s = sqrt (s / (n1 - 1)) + + # Reject pixels and save the residuals. + if (s > 0.) { + for (; nl <= nh; nl = nl + 1) { + r = (med - Memd[d[nl]+k]) / s + if (r <= lsigma) + break + Memr[resid+nl] = r + n1 = n1 - 1 + } + for (; nh >= nl; nh = nh - 1) { + r = (Memd[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 == max (0, 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 >= 1.)) { + j = max (nl, n1 + 1) + if (keepids) { + do l = 1, min (n1, nl-1) { + Memd[d[l]+k] = Memd[d[j]+k] + if (grow >= 1.) { + 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) { + Memd[d[l]+k] = Memd[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 (max (0, 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/pkg/images/immatch/src/imcombine/src/generic/icsigma.x b/pkg/images/immatch/src/imcombine/src/generic/icsigma.x new file mode 100644 index 00000000..b9c9a781 --- /dev/null +++ b/pkg/images/immatch/src/imcombine/src/generic/icsigma.x @@ -0,0 +1,434 @@ +# 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 + } + if (sumwt > 0) + sigma[i] = sqrt (sum / sumwt * sigcor) + else { + sum = (Mems[d[1]+k] - a) ** 2 + do j = 2, n1 + sum = sum + (Mems[d[j]+k] - a) ** 2 + sigma[i] = sqrt (sum / n1 * 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_sigmai (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 = (Memi[d[1]+k] - a) ** 2 * wt + do j = 2, n1 { + wt = wts[Memi[m[j]+k]] + sum = sum + (Memi[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 = (Memi[d[1]+k] - a) ** 2 + do j = 2, n1 + sum = sum + (Memi[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 = (Memi[d[1]+k] - a) ** 2 * wt + sumwt = wt + do j = 2, n1 { + wt = wts[Memi[m[j]+k]] + sum = sum + (Memi[d[j]+k] - a) ** 2 * wt + sumwt = sumwt + wt + } + if (sumwt > 0) + sigma[i] = sqrt (sum / sumwt * sigcor) + else { + sum = (Memi[d[1]+k] - a) ** 2 + do j = 2, n1 + sum = sum + (Memi[d[j]+k] - a) ** 2 + sigma[i] = sqrt (sum / n1 * 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 = (Memi[d[1]+k] - a) ** 2 + do j = 2, n1 + sum = sum + (Memi[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 + } + if (sumwt > 0) + sigma[i] = sqrt (sum / sumwt * sigcor) + else { + sum = (Memr[d[1]+k] - a) ** 2 + do j = 2, n1 + sum = sum + (Memr[d[j]+k] - a) ** 2 + sigma[i] = sqrt (sum / n1 * 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 + +# IC_SIGMA -- Compute the sigma image line. +# The estimated sigma includes a correction for the finite population. +# Weights are used if desired. + +procedure ic_sigmad (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 +double average[npts] # Average +double sigma[npts] # Sigma line (returned) + +int i, j, k, n1 +real wt, sigcor, sumwt +double 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 = (Memd[d[1]+k] - a) ** 2 * wt + do j = 2, n1 { + wt = wts[Memi[m[j]+k]] + sum = sum + (Memd[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 = (Memd[d[1]+k] - a) ** 2 + do j = 2, n1 + sum = sum + (Memd[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 = (Memd[d[1]+k] - a) ** 2 * wt + sumwt = wt + do j = 2, n1 { + wt = wts[Memi[m[j]+k]] + sum = sum + (Memd[d[j]+k] - a) ** 2 * wt + sumwt = sumwt + wt + } + if (sumwt > 0) + sigma[i] = sqrt (sum / sumwt * sigcor) + else { + sum = (Memd[d[1]+k] - a) ** 2 + do j = 2, n1 + sum = sum + (Memd[d[j]+k] - a) ** 2 + sigma[i] = sqrt (sum / n1 * 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 = (Memd[d[1]+k] - a) ** 2 + do j = 2, n1 + sum = sum + (Memd[d[j]+k] - a) ** 2 + sigma[i] = sqrt (sum * sigcor) + } else + sigma[i] = blank + } + } + } +end + diff --git a/pkg/images/immatch/src/imcombine/src/generic/icsort.x b/pkg/images/immatch/src/imcombine/src/generic/icsort.x new file mode 100644 index 00000000..3ec1d27e --- /dev/null +++ b/pkg/images/immatch/src/imcombine/src/generic/icsort.x @@ -0,0 +1,1096 @@ +# 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_sorti (a, b, nvecs, npts) + +pointer a[ARB] # pointer to input vectors +int b[ARB] # work array +int nvecs[npts] # number of vectors +int npts # number of points in vectors + +int 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] = Memi[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] = Memi[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 + Memi[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_2sorti (a, b, c, d, nvecs, npts) + +pointer a[ARB] # pointer to input vectors +int 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 + +int 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] = Memi[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 { + Memi[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 + +# 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_sortd (a, b, nvecs, npts) + +pointer a[ARB] # pointer to input vectors +double b[ARB] # work array +int nvecs[npts] # number of vectors +int npts # number of points in vectors + +double 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] = Memd[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] = Memd[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 + Memd[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_2sortd (a, b, c, d, nvecs, npts) + +pointer a[ARB] # pointer to input vectors +double 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 + +double 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] = Memd[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 { + Memd[a[i]+l] = b[i] + Memi[c[i]+l] = d[i] + } + } +end diff --git a/pkg/images/immatch/src/imcombine/src/generic/icstat.x b/pkg/images/immatch/src/imcombine/src/generic/icstat.x new file mode 100644 index 00000000..3a0ed49c --- /dev/null +++ b/pkg/images/immatch/src/imcombine/src/generic/icstat.x @@ -0,0 +1,892 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> +include "../icombine.h" + +define NMAX 100000 # 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() + +real asums() +short ic_modes() + +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, nimages, 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) + } + + # Close mask until it is needed again. + call ic_mclose1 (image, nimages) + + 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.7 # 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_stati (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, imgnli() + +real asumi() +int ic_modei() + +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_INT) + dp = data + while (imgnli (im, lp, Memi[vb]) != EOF) { + call ic_mget1 (im, image, nimages, 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 = Memi[lp] + if (a >= lthresh && a <= hthresh) { + Memi[dp] = a + dp = dp + 1 + } + lp = lp + Memi[dv] + } + } else { + do i = Memi[v1], Memi[v2], Memi[dv] { + Memi[dp] = Memi[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 = Memi[lp] + if (a >= lthresh && a <= hthresh) { + Memi[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) { + Memi[dp] = Memi[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) + } + + # Close mask until it is needed again. + call ic_mclose1 (image, nimages) + + 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 asrti (Memi[data], Memi[data], n) + mode = ic_modei (Memi[data], n) + median = Memi[data+n/2-1] + } + if (domean) + mean = asumi (Memi[data], n) / n + + call sfree (sp) +end + + +define NMIN 10 # Minimum number of pixels for mode calculation +define ZRANGE 0.7 # 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. + +int procedure ic_modei (a, n) + +int a[n] # Data array +int n # Number of points + +int i, j, k, nmax +real z1, z2, zstep, zbin +int 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 asumr() +real ic_moder() + +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, nimages, 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) + } + + # Close mask until it is needed again. + call ic_mclose1 (image, nimages) + + 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.7 # 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 + +# 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_statd (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, imgnld() + +double asumd() +double ic_moded() + +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_DOUBLE) + dp = data + while (imgnld (im, lp, Memi[vb]) != EOF) { + call ic_mget1 (im, image, nimages, 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 = Memd[lp] + if (a >= lthresh && a <= hthresh) { + Memd[dp] = a + dp = dp + 1 + } + lp = lp + Memi[dv] + } + } else { + do i = Memi[v1], Memi[v2], Memi[dv] { + Memd[dp] = Memd[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 = Memd[lp] + if (a >= lthresh && a <= hthresh) { + Memd[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) { + Memd[dp] = Memd[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) + } + + # Close mask until it is needed again. + call ic_mclose1 (image, nimages) + + 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 asrtd (Memd[data], Memd[data], n) + mode = ic_moded (Memd[data], n) + median = Memd[data+n/2-1] + } + if (domean) + mean = asumd (Memd[data], n) / n + + call sfree (sp) +end + + +define NMIN 10 # Minimum number of pixels for mode calculation +define ZRANGE 0.7 # 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. + +double procedure ic_moded (a, n) + +double a[n] # Data array +int n # Number of points + +int i, j, k, nmax +real z1, z2, zstep, zbin +double 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/pkg/images/immatch/src/imcombine/src/generic/mkpkg b/pkg/images/immatch/src/imcombine/src/generic/mkpkg new file mode 100644 index 00000000..af2fd0a8 --- /dev/null +++ b/pkg/images/immatch/src/imcombine/src/generic/mkpkg @@ -0,0 +1,27 @@ +# Make IMCOMBINE. + +$checkout libimc.a lib$ +$update libimc.a +$checkin libimc.a lib$ +$exit + +libimc.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 <imhdr.h> <pmset.h> + icmedian.x ../icombine.com ../icombine.h + icmm.x ../icombine.com ../icombine.h + icnmodel.x ../icombine.com ../icombine.h <imhdr.h> + icomb.x ../icombine.com ../icombine.h <error.h> <imhdr.h>\ + <imset.h> <mach.h> <pmset.h> <syserr.h> + icpclip.x ../icombine.com ../icombine.h + icquad.x ../icombine.com ../icombine.h <imhdr.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> + + xtimmap.x xtimmap.com <config.h> <error.h> <imhdr.h> <imset.h> + ; diff --git a/pkg/images/immatch/src/imcombine/src/generic/xtimmap.com b/pkg/images/immatch/src/imcombine/src/generic/xtimmap.com new file mode 100644 index 00000000..57fcb8a0 --- /dev/null +++ b/pkg/images/immatch/src/imcombine/src/generic/xtimmap.com @@ -0,0 +1,9 @@ +int option +int nopen +int nopenpix +int nalloc +int last_flag +int min_open +int max_openim +pointer ims +common /xtimmapcom/ option, ims, nopen, nopenpix, nalloc, last_flag, min_open, max_openim diff --git a/pkg/images/immatch/src/imcombine/src/generic/xtimmap.x b/pkg/images/immatch/src/imcombine/src/generic/xtimmap.x new file mode 100644 index 00000000..fcc53124 --- /dev/null +++ b/pkg/images/immatch/src/imcombine/src/generic/xtimmap.x @@ -0,0 +1,1207 @@ +include <syserr.h> +include <error.h> +include <imhdr.h> +include <imset.h> +include <config.h> + +# The following is for compiling under V2.11. +define IM_BUFFRAC IM_BUFSIZE +include <imset.h> + +define VERBOSE false + +# These routines maintain an arbitrary number of indexed "open" images which +# must be READ_ONLY. The calling program may use the returned pointer for +# header accesses but must call xt_opix before I/O. Subsequent calls to +# xt_opix may invalidate the pointer. The xt_imunmap call will free memory. + +define MAX_OPENIM (LAST_FD-16) # Maximum images kept open +define MAX_OPENPIX 45 # Maximum pixel files kept open + +define XT_SZIMNAME 299 # Size of IMNAME string +define XT_LEN 179 # Structure length +define XT_IMNAME Memc[P2C($1)] # Image name +define XT_ARG Memi[$1+150] # IMMAP header argument +define XT_IM Memi[$1+151] # IMIO pointer +define XT_HDR Memi[$1+152] # Copy of IMIO pointer +define XT_CLOSEFD Memi[$1+153] # Close FD? +define XT_FLAG Memi[$1+154] # Flag +define XT_BUFSIZE Memi[$1+155] # Buffer size +define XT_BUF Memi[$1+156] # Data buffer +define XT_BTYPE Memi[$1+157] # Data buffer type +define XT_VS Memi[$1+157+$2] # Start vector (10) +define XT_VE Memi[$1+167+$2] # End vector (10) + +# Options +define XT_MAPUNMAP 1 # Map and unmap images. + +# XT_IMMAP -- Map an image and save it as an indexed open image. +# The returned pointer may be used for header access but not I/O. +# The indexed image is closed by xt_imunmap. + +pointer procedure xt_immap (imname, acmode, hdr_arg, index, retry) + +char imname[ARB] #I Image name +int acmode #I Access mode +int hdr_arg #I Header argument +int index #I Save index +int retry #I Retry counter +pointer im #O Image pointer (returned) + +int i, envgeti() +pointer xt, xt_opix() +errchk xt_opix + +int first_time +data first_time /YES/ + +include "xtimmap.com" + +begin + if (acmode != READ_ONLY) + call error (1, "XT_IMMAP: Only READ_ONLY allowed") + + # Set maximum number of open images based on retry. + if (retry > 0) + max_openim = min (1024, MAX_OPENIM) / retry + else + max_openim = MAX_OPENIM + + # Initialize once per process. + if (first_time == YES) { + iferr (option = envgeti ("imcombine_option")) + option = 1 + min_open = 1 + nopen = 0 + nopenpix = 0 + nalloc = max_openim + call calloc (ims, nalloc, TY_POINTER) + first_time = NO + } + + # Free image if needed. + call xt_imunmap (NULL, index) + + # Allocate structure. + if (index > nalloc) { + i = nalloc + nalloc = index + max_openim + call realloc (ims, nalloc, TY_STRUCT) + call amovki (NULL, Memi[ims+i], nalloc-i) + } + call calloc (xt, XT_LEN, TY_STRUCT) + Memi[ims+index-1] = xt + + # Initialize. + call strcpy (imname, XT_IMNAME(xt), XT_SZIMNAME) + XT_ARG(xt) = hdr_arg + XT_IM(xt) = NULL + XT_HDR(xt) = NULL + + # Open image. + last_flag = 0 + im = xt_opix (NULL, index, 0) + + # Make copy of IMIO pointer for header keyword access. + call malloc (XT_HDR(xt), LEN_IMDES+IM_HDRLEN(im)+1, TY_STRUCT) + call amovi (Memi[im], Memi[XT_HDR(xt)], LEN_IMDES) + call amovi (IM_MAGIC(im), IM_MAGIC(XT_HDR(xt)), IM_HDRLEN(im)+1) + + return (XT_HDR(xt)) +end + + +# XT_OPIX -- Open the image for I/O. +# If the image has not been mapped return the default pointer. + +pointer procedure xt_opix (imdef, index, flag) + +int index #I index +pointer imdef #I Default pointer +int flag #I Flag + +int i, open(), imstati() +pointer im, xt, xt1, immap() +errchk open, immap, imunmap + +include "xtimmap.com" + +begin + # Get index pointer. + xt = NULL + if (index <= nalloc && index > 0) + xt = Memi[ims+index-1] + + # Use default pointer if index has not been mapped. + if (xt == NULL) + return (imdef) + + # Close images not accessed during previous line. + # In normal usage this should only occur once per line over all + # indexed images. + if (flag != last_flag) { + do i = 1, nalloc { + xt1 = Memi[ims+i-1] + if (xt1 == NULL) + next + im = XT_IM(xt1) + if (im == NULL || XT_FLAG(xt1) == last_flag) + next + if (VERBOSE) { + call eprintf ("%d: xt_opix imunmap %s\n") + call pargi (i) + call pargstr (XT_IMNAME(xt1)) + } + call imunmap (XT_IM(xt1)) + call mfree (XT_BUF(xt1), XT_BTYPE(xt1)) + nopen = nopen - 1 + if (XT_CLOSEFD(xt1) == NO) + nopenpix = nopenpix - 1 + } + + # Optimize the file I/O. + do i = nalloc, 1, -1 { + xt1 = Memi[ims+i-1] + if (xt1 == NULL) + next + im = XT_IM(xt1) + if (im == NULL) + next + min_open = i + if (nopenpix < MAX_OPENPIX) { + if (XT_CLOSEFD(xt1) == NO) + next + XT_CLOSEFD(xt1) = NO + call imseti (im, IM_CLOSEFD, NO) + nopenpix = nopenpix + 1 + } + } + last_flag = flag + } + + # Return pointer for already opened images. + im = XT_IM(xt) + if (im != NULL) { + XT_FLAG(xt) = flag + return (im) + } + + # Handle more images than the maximum that can be open at one time. + if (nopen >= max_openim) { + if (option == XT_MAPUNMAP || flag == 0) { + do i = min_open, nalloc { + xt1 = Memi[ims+i-1] + if (xt1 == NULL) + next + im = XT_IM(xt1) + if (im == NULL) + next + if (VERBOSE) { + call eprintf ("%d: imunmap %s\n") + call pargi (i) + call pargstr (XT_IMNAME(xt1)) + } + call imunmap (XT_IM(xt1)) + nopen = nopen - 1 + if (XT_CLOSEFD(xt1) == NO) + nopenpix = nopenpix - 1 + min_open = i + 1 + break + } + if (index <= min_open) + min_open = index + else { + do i = min_open, nalloc { + xt1 = Memi[ims+i-1] + if (xt1 == NULL) + next + im = XT_IM(xt1) + if (im == NULL) + next + min_open = i + break + } + } + } else { + # Check here because we can't catch error in immap. + i = open ("dev$null", READ_ONLY, BINARY_FILE) + call close (i) + if (i == LAST_FD - 1) + call error (SYS_FTOOMANYFILES, "Too many open files") + } + } + + # Open image. + if (VERBOSE) { + call eprintf ("%d: xt_opix immap %s\n") + call pargi (index) + call pargstr (XT_IMNAME(xt)) + } + im = immap (XT_IMNAME(xt), READ_ONLY, XT_ARG(xt)) + XT_IM(xt) = im + if (!IS_INDEFI(XT_BUFSIZE(xt))) + call imseti (im, IM_BUFSIZE, XT_BUFSIZE(xt)) + else + XT_BUFSIZE(xt) = imstati (im, IM_BUFSIZE) + nopen = nopen + 1 + XT_CLOSEFD(xt) = YES + if (nopenpix < MAX_OPENPIX) { + XT_CLOSEFD(xt) = NO + nopenpix = nopenpix + 1 + } + if (XT_CLOSEFD(xt) == YES) + call imseti (im, IM_CLOSEFD, YES) + XT_FLAG(xt) = flag + + return (im) +end + + +# XT_CPIX -- Close image. + +procedure xt_cpix (index) + +int index #I index + +pointer xt +errchk imunmap + +include "xtimmap.com" + +begin + xt = NULL + if (index <= nalloc && index > 0) + xt = Memi[ims+index-1] + + if (xt == NULL) + return + + if (XT_IM(xt) != NULL) { + if (VERBOSE) { + call eprintf ("%d: xt_cpix imunmap %s\n") + call pargi (index) + call pargstr (XT_IMNAME(xt)) + } + call imunmap (XT_IM(xt)) + nopen = nopen - 1 + if (XT_CLOSEFD(xt) == NO) + nopenpix = nopenpix - 1 + } + call mfree (XT_BUF(xt), XT_BTYPE(xt)) +end + + +# XT_IMSETI -- Set IMIO value. + +procedure xt_imseti (index, param, value) + +int index #I index +int param #I IMSET parameter +int value #I Value + +pointer xt +bool streq() + +include "xtimmap.com" + +begin + xt = NULL + if (index <= nalloc && index > 0) + xt = Memi[ims+index-1] + + if (xt == NULL) { + if (streq (param, "option")) + option = value + } else { + if (streq (param, "bufsize")) { + XT_BUFSIZE(xt) = value + if (XT_IM(xt) != NULL) { + call imseti (XT_IM(xt), IM_BUFFRAC, 0) + call imseti (XT_IM(xt), IM_BUFSIZE, value) + } + } + } +end + + +# XT_IMUNMAP -- Unmap indexed open image. +# The header pointer is set to NULL to indicate the image has been closed. + +procedure xt_imunmap (im, index) + +int im #U IMIO header pointer +int index #I index + +pointer xt +errchk imunmap + +include "xtimmap.com" + +begin + # Check for an indexed image. If it is not unmap the pointer + # as a regular IMIO pointer. + + xt = NULL + if (index <= nalloc && index > 0) + xt = Memi[ims+index-1] + if (xt == NULL) { + if (im != NULL) + call imunmap (im) + return + } + + # Close indexed image. + if (XT_IM(xt) != NULL) { + if (VERBOSE) { + call eprintf ("%d: xt_imunmap imunmap %s\n") + call pargi (index) + call pargstr (XT_IMNAME(xt)) + } + iferr (call imunmap (XT_IM(xt))) { + XT_IM(xt) = NULL + call erract (EA_WARN) + } + nopen = nopen - 1 + if (XT_CLOSEFD(xt) == NO) + nopenpix = nopenpix - 1 + if (index == min_open) + min_open = 1 + } + + # Free any buffered memory. + call mfree (XT_BUF(xt), XT_BTYPE(xt)) + + # Free header pointer. Note that if the supplied pointer is not + # header pointer then it is not set to NULL. + if (XT_HDR(xt) == im) + im = NULL + call mfree (XT_HDR(xt), TY_STRUCT) + + # Free save structure. + call mfree (Memi[ims+index-1], TY_STRUCT) + Memi[ims+index-1] = NULL +end + + +# XT_MINHDR -- Minimize header assuming keywords will not be accessed. + +procedure xt_minhdr (index) + +int index #I index + +pointer xt +errchk realloc + +include "xtimmap.com" + +begin + # Check for an indexed image. If it is not unmap the pointer + # as a regular IMIO pointer. + + xt = NULL + if (index <= nalloc && index > 0) + xt = Memi[ims+index-1] + if (xt == NULL) + return + + # Minimize header pointer. + if (VERBOSE) { + call eprintf ("%d: xt_minhdr %s\n") + call pargi (index) + call pargstr (XT_IMNAME(xt)) + } + call realloc (XT_HDR(xt), IMU+1, TY_STRUCT) + if (XT_IM(xt) != NULL) + call realloc (XT_IM(xt), IMU+1, TY_STRUCT) +end + + +# XT_REINDEX -- Reindex open images. +# This is used when some images are closed by xt_imunmap. It is up to +# the calling program to reindex the header pointers and to subsequently +# use the new index values. + +procedure xt_reindex () + +int old, new + +include "xtimmap.com" + +begin + new = 0 + do old = 0, nalloc-1 { + if (Memi[ims+old] == NULL) + next + Memi[ims+new] = Memi[ims+old] + new = new + 1 + } + do old = new, nalloc-1 + Memi[ims+old] = NULL +end + + + +# XT_IMGNL -- Return the next line for the indexed image. +# Possibly unmap another image if too many files are open. +# Buffer data when an image is unmmaped to minimize the mapping of images. +# If the requested index has not been mapped use the default pointer. + +int procedure xt_imgnls (imdef, index, buf, v, flag) + +pointer imdef #I Default pointer +int index #I index +pointer buf #O Data buffer +long v[ARB] #I Line vector +int flag #I Flag (=output line) + +int i, j, nc, nl, open(), imgnls(), sizeof(), imloop() +pointer im, xt, xt1, ptr, immap(), imggss() +errchk open, immap, imgnls, imggss, imunmap + +long unit_v[IM_MAXDIM] +data unit_v /IM_MAXDIM * 1/ + +include "xtimmap.com" + +begin + # Get index pointer. + xt = NULL + if (index <= nalloc && index > 0) + xt = Memi[ims+index-1] + + # Use default pointer if index has not been mapped. + if (xt == NULL) + return (imgnls (imdef, buf, v)) + + # Close images not accessed during previous line. + # In normal usage this should only occur once per line over all + # indexed images. + if (flag != last_flag) { + do i = 1, nalloc { + xt1 = Memi[ims+i-1] + if (xt1 == NULL) + next + im = XT_IM(xt1) + if (im == NULL || XT_FLAG(xt1) == last_flag) + next + if (VERBOSE) { + call eprintf ("%d: xt_imgnl imunmap %s\n") + call pargi (i) + call pargstr (XT_IMNAME(xt1)) + } + call imunmap (XT_IM(xt1)) + call mfree (XT_BUF(xt1), XT_BTYPE(xt1)) + nopen = nopen - 1 + if (XT_CLOSEFD(xt1) == NO) + nopenpix = nopenpix - 1 + } + + # Optimize the file I/O. + do i = nalloc, 1, -1 { + xt1 = Memi[ims+i-1] + if (xt1 == NULL) + next + im = XT_IM(xt1) + if (im == NULL) + next + min_open = i + if (nopenpix < MAX_OPENPIX) { + if (XT_CLOSEFD(xt1) == NO) + next + XT_CLOSEFD(xt1) = NO + call imseti (im, IM_CLOSEFD, NO) + nopenpix = nopenpix + 1 + } + } + last_flag = flag + } + + # Use IMIO for already opened images. + im = XT_IM(xt) + if (im != NULL) { + XT_FLAG(xt) = flag + return (imgnls (im, buf, v)) + } + + # If the image is not currently mapped use the stored header. + im = XT_HDR(xt) + + # Check for EOF. + i = IM_NDIM(im) + if (v[i] > IM_LEN(im,i)) + return (EOF) + + # Check for buffered data. + if (XT_BUF(xt) != NULL) { + if (v[2] >= XT_VS(xt,2) && v[2] <= XT_VE(xt,2)) { + if (XT_BTYPE(xt) != TY_SHORT) + call error (1, "Cannot mix data types") + nc = IM_LEN(im,1) + buf = XT_BUF(xt) + (v[2]-XT_VS(xt,2)) * IM_LEN(im,1) + XT_FLAG(xt) = flag + if (i == 1) + v[1] = nc + 1 + else + j = imloop (v, unit_v, IM_LEN(im,1), unit_v, i) + return (nc) + } + } + + # Handle more images than the maximum that can be open at one time. + if (nopen >= max_openim) { + if (option == XT_MAPUNMAP || v[2] == 0) { + do i = min_open, nalloc { + xt1 = Memi[ims+i-1] + if (xt1 == NULL) + next + im = XT_IM(xt1) + if (im == NULL) + next + + # Buffer some number of lines. + nl = XT_BUFSIZE(xt1) / sizeof (TY_SHORT) / IM_LEN(im,1) + if (nl > 1) { + nc = IM_LEN(im,1) + call amovl (v, XT_VS(xt1,1), IM_MAXDIM) + call amovl (v, XT_VE(xt1,1), IM_MAXDIM) + XT_VS(xt1,1) = 1 + XT_VE(xt1,1) = nc + XT_VE(xt1,2) = min (XT_VS(xt1,2)+(nl-1), IM_LEN(im,2)) + nl = XT_VE(xt1,2) - XT_VS(xt1,2) + 1 + XT_BTYPE(xt1) = TY_SHORT + call malloc (XT_BUF(xt1), nl*nc, XT_BTYPE(xt1)) + ptr = imggss (im, XT_VS(xt1,1), XT_VE(xt1,1), + IM_NDIM(im)) + call amovs (Mems[ptr], Mems[XT_BUF(xt1)], nl*nc) + } + + if (VERBOSE) { + call eprintf ("%d: xt_imgnl imunmap %s\n") + call pargi (i) + call pargstr (XT_IMNAME(xt1)) + } + call imunmap (XT_IM(xt1)) + nopen = nopen - 1 + if (XT_CLOSEFD(xt1) == NO) + nopenpix = nopenpix - 1 + min_open = i + 1 + break + } + if (index <= min_open) + min_open = index + else { + do i = min_open, nalloc { + xt1 = Memi[ims+i-1] + if (xt1 == NULL) + next + if (XT_IM(xt1) == NULL) + next + min_open = i + break + } + } + } else { + # Check here because we can't catch error in immap. + i = open ("dev$null", READ_ONLY, BINARY_FILE) + call close (i) + if (i == LAST_FD - 1) + call error (SYS_FTOOMANYFILES, "Too many open files") + } + } + + # Open image. + if (VERBOSE) { + call eprintf ("%d: xt_imgnl immap %s\n") + call pargi (index) + call pargstr (XT_IMNAME(xt)) + } + im = immap (XT_IMNAME(xt), READ_ONLY, XT_ARG(xt)) + XT_IM(xt) = im + call imseti (im, IM_BUFSIZE, XT_BUFSIZE(xt)) + call mfree (XT_BUF(xt), XT_BTYPE(xt)) + nopen = nopen + 1 + XT_CLOSEFD(xt) = YES + if (nopenpix < MAX_OPENPIX) { + XT_CLOSEFD(xt) = NO + nopenpix = nopenpix + 1 + } + if (XT_CLOSEFD(xt) == YES) + call imseti (im, IM_CLOSEFD, YES) + XT_FLAG(xt) = flag + + return (imgnls (im, buf, v)) +end + +# XT_IMGNL -- Return the next line for the indexed image. +# Possibly unmap another image if too many files are open. +# Buffer data when an image is unmmaped to minimize the mapping of images. +# If the requested index has not been mapped use the default pointer. + +int procedure xt_imgnli (imdef, index, buf, v, flag) + +pointer imdef #I Default pointer +int index #I index +pointer buf #O Data buffer +long v[ARB] #I Line vector +int flag #I Flag (=output line) + +int i, j, nc, nl, open(), imgnli(), sizeof(), imloop() +pointer im, xt, xt1, ptr, immap(), imggsi() +errchk open, immap, imgnli, imggsi, imunmap + +long unit_v[IM_MAXDIM] +data unit_v /IM_MAXDIM * 1/ + +include "xtimmap.com" + +begin + # Get index pointer. + xt = NULL + if (index <= nalloc && index > 0) + xt = Memi[ims+index-1] + + # Use default pointer if index has not been mapped. + if (xt == NULL) + return (imgnli (imdef, buf, v)) + + # Close images not accessed during previous line. + # In normal usage this should only occur once per line over all + # indexed images. + if (flag != last_flag) { + do i = 1, nalloc { + xt1 = Memi[ims+i-1] + if (xt1 == NULL) + next + im = XT_IM(xt1) + if (im == NULL || XT_FLAG(xt1) == last_flag) + next + if (VERBOSE) { + call eprintf ("%d: xt_imgnl imunmap %s\n") + call pargi (i) + call pargstr (XT_IMNAME(xt1)) + } + call imunmap (XT_IM(xt1)) + call mfree (XT_BUF(xt1), XT_BTYPE(xt1)) + nopen = nopen - 1 + if (XT_CLOSEFD(xt1) == NO) + nopenpix = nopenpix - 1 + } + + # Optimize the file I/O. + do i = nalloc, 1, -1 { + xt1 = Memi[ims+i-1] + if (xt1 == NULL) + next + im = XT_IM(xt1) + if (im == NULL) + next + min_open = i + if (nopenpix < MAX_OPENPIX) { + if (XT_CLOSEFD(xt1) == NO) + next + XT_CLOSEFD(xt1) = NO + call imseti (im, IM_CLOSEFD, NO) + nopenpix = nopenpix + 1 + } + } + last_flag = flag + } + + # Use IMIO for already opened images. + im = XT_IM(xt) + if (im != NULL) { + XT_FLAG(xt) = flag + return (imgnli (im, buf, v)) + } + + # If the image is not currently mapped use the stored header. + im = XT_HDR(xt) + + # Check for EOF. + i = IM_NDIM(im) + if (v[i] > IM_LEN(im,i)) + return (EOF) + + # Check for buffered data. + if (XT_BUF(xt) != NULL) { + if (v[2] >= XT_VS(xt,2) && v[2] <= XT_VE(xt,2)) { + if (XT_BTYPE(xt) != TY_INT) + call error (1, "Cannot mix data types") + nc = IM_LEN(im,1) + buf = XT_BUF(xt) + (v[2]-XT_VS(xt,2)) * IM_LEN(im,1) + XT_FLAG(xt) = flag + if (i == 1) + v[1] = nc + 1 + else + j = imloop (v, unit_v, IM_LEN(im,1), unit_v, i) + return (nc) + } + } + + # Handle more images than the maximum that can be open at one time. + if (nopen >= max_openim) { + if (option == XT_MAPUNMAP || v[2] == 0) { + do i = min_open, nalloc { + xt1 = Memi[ims+i-1] + if (xt1 == NULL) + next + im = XT_IM(xt1) + if (im == NULL) + next + + # Buffer some number of lines. + nl = XT_BUFSIZE(xt1) / sizeof (TY_INT) / IM_LEN(im,1) + if (nl > 1) { + nc = IM_LEN(im,1) + call amovl (v, XT_VS(xt1,1), IM_MAXDIM) + call amovl (v, XT_VE(xt1,1), IM_MAXDIM) + XT_VS(xt1,1) = 1 + XT_VE(xt1,1) = nc + XT_VE(xt1,2) = min (XT_VS(xt1,2)+(nl-1), IM_LEN(im,2)) + nl = XT_VE(xt1,2) - XT_VS(xt1,2) + 1 + XT_BTYPE(xt1) = TY_INT + call malloc (XT_BUF(xt1), nl*nc, XT_BTYPE(xt1)) + ptr = imggsi (im, XT_VS(xt1,1), XT_VE(xt1,1), + IM_NDIM(im)) + call amovi (Memi[ptr], Memi[XT_BUF(xt1)], nl*nc) + } + + if (VERBOSE) { + call eprintf ("%d: xt_imgnl imunmap %s\n") + call pargi (i) + call pargstr (XT_IMNAME(xt1)) + } + call imunmap (XT_IM(xt1)) + nopen = nopen - 1 + if (XT_CLOSEFD(xt1) == NO) + nopenpix = nopenpix - 1 + min_open = i + 1 + break + } + if (index <= min_open) + min_open = index + else { + do i = min_open, nalloc { + xt1 = Memi[ims+i-1] + if (xt1 == NULL) + next + if (XT_IM(xt1) == NULL) + next + min_open = i + break + } + } + } else { + # Check here because we can't catch error in immap. + i = open ("dev$null", READ_ONLY, BINARY_FILE) + call close (i) + if (i == LAST_FD - 1) + call error (SYS_FTOOMANYFILES, "Too many open files") + } + } + + # Open image. + if (VERBOSE) { + call eprintf ("%d: xt_imgnl immap %s\n") + call pargi (index) + call pargstr (XT_IMNAME(xt)) + } + im = immap (XT_IMNAME(xt), READ_ONLY, XT_ARG(xt)) + XT_IM(xt) = im + call imseti (im, IM_BUFSIZE, XT_BUFSIZE(xt)) + call mfree (XT_BUF(xt), XT_BTYPE(xt)) + nopen = nopen + 1 + XT_CLOSEFD(xt) = YES + if (nopenpix < MAX_OPENPIX) { + XT_CLOSEFD(xt) = NO + nopenpix = nopenpix + 1 + } + if (XT_CLOSEFD(xt) == YES) + call imseti (im, IM_CLOSEFD, YES) + XT_FLAG(xt) = flag + + return (imgnli (im, buf, v)) +end + +# XT_IMGNL -- Return the next line for the indexed image. +# Possibly unmap another image if too many files are open. +# Buffer data when an image is unmmaped to minimize the mapping of images. +# If the requested index has not been mapped use the default pointer. + +int procedure xt_imgnlr (imdef, index, buf, v, flag) + +pointer imdef #I Default pointer +int index #I index +pointer buf #O Data buffer +long v[ARB] #I Line vector +int flag #I Flag (=output line) + +int i, j, nc, nl, open(), imgnlr(), sizeof(), imloop() +pointer im, xt, xt1, ptr, immap(), imggsr() +errchk open, immap, imgnlr, imggsr, imunmap + +long unit_v[IM_MAXDIM] +data unit_v /IM_MAXDIM * 1/ + +include "xtimmap.com" + +begin + # Get index pointer. + xt = NULL + if (index <= nalloc && index > 0) + xt = Memi[ims+index-1] + + # Use default pointer if index has not been mapped. + if (xt == NULL) + return (imgnlr (imdef, buf, v)) + + # Close images not accessed during previous line. + # In normal usage this should only occur once per line over all + # indexed images. + if (flag != last_flag) { + do i = 1, nalloc { + xt1 = Memi[ims+i-1] + if (xt1 == NULL) + next + im = XT_IM(xt1) + if (im == NULL || XT_FLAG(xt1) == last_flag) + next + if (VERBOSE) { + call eprintf ("%d: xt_imgnl imunmap %s\n") + call pargi (i) + call pargstr (XT_IMNAME(xt1)) + } + call imunmap (XT_IM(xt1)) + call mfree (XT_BUF(xt1), XT_BTYPE(xt1)) + nopen = nopen - 1 + if (XT_CLOSEFD(xt1) == NO) + nopenpix = nopenpix - 1 + } + + # Optimize the file I/O. + do i = nalloc, 1, -1 { + xt1 = Memi[ims+i-1] + if (xt1 == NULL) + next + im = XT_IM(xt1) + if (im == NULL) + next + min_open = i + if (nopenpix < MAX_OPENPIX) { + if (XT_CLOSEFD(xt1) == NO) + next + XT_CLOSEFD(xt1) = NO + call imseti (im, IM_CLOSEFD, NO) + nopenpix = nopenpix + 1 + } + } + last_flag = flag + } + + # Use IMIO for already opened images. + im = XT_IM(xt) + if (im != NULL) { + XT_FLAG(xt) = flag + return (imgnlr (im, buf, v)) + } + + # If the image is not currently mapped use the stored header. + im = XT_HDR(xt) + + # Check for EOF. + i = IM_NDIM(im) + if (v[i] > IM_LEN(im,i)) + return (EOF) + + # Check for buffered data. + if (XT_BUF(xt) != NULL) { + if (v[2] >= XT_VS(xt,2) && v[2] <= XT_VE(xt,2)) { + if (XT_BTYPE(xt) != TY_REAL) + call error (1, "Cannot mix data types") + nc = IM_LEN(im,1) + buf = XT_BUF(xt) + (v[2]-XT_VS(xt,2)) * IM_LEN(im,1) + XT_FLAG(xt) = flag + if (i == 1) + v[1] = nc + 1 + else + j = imloop (v, unit_v, IM_LEN(im,1), unit_v, i) + return (nc) + } + } + + # Handle more images than the maximum that can be open at one time. + if (nopen >= max_openim) { + if (option == XT_MAPUNMAP || v[2] == 0) { + do i = min_open, nalloc { + xt1 = Memi[ims+i-1] + if (xt1 == NULL) + next + im = XT_IM(xt1) + if (im == NULL) + next + + # Buffer some number of lines. + nl = XT_BUFSIZE(xt1) / sizeof (TY_REAL) / IM_LEN(im,1) + if (nl > 1) { + nc = IM_LEN(im,1) + call amovl (v, XT_VS(xt1,1), IM_MAXDIM) + call amovl (v, XT_VE(xt1,1), IM_MAXDIM) + XT_VS(xt1,1) = 1 + XT_VE(xt1,1) = nc + XT_VE(xt1,2) = min (XT_VS(xt1,2)+(nl-1), IM_LEN(im,2)) + nl = XT_VE(xt1,2) - XT_VS(xt1,2) + 1 + XT_BTYPE(xt1) = TY_REAL + call malloc (XT_BUF(xt1), nl*nc, XT_BTYPE(xt1)) + ptr = imggsr (im, XT_VS(xt1,1), XT_VE(xt1,1), + IM_NDIM(im)) + call amovr (Memr[ptr], Memr[XT_BUF(xt1)], nl*nc) + } + + if (VERBOSE) { + call eprintf ("%d: xt_imgnl imunmap %s\n") + call pargi (i) + call pargstr (XT_IMNAME(xt1)) + } + call imunmap (XT_IM(xt1)) + nopen = nopen - 1 + if (XT_CLOSEFD(xt1) == NO) + nopenpix = nopenpix - 1 + min_open = i + 1 + break + } + if (index <= min_open) + min_open = index + else { + do i = min_open, nalloc { + xt1 = Memi[ims+i-1] + if (xt1 == NULL) + next + if (XT_IM(xt1) == NULL) + next + min_open = i + break + } + } + } else { + # Check here because we can't catch error in immap. + i = open ("dev$null", READ_ONLY, BINARY_FILE) + call close (i) + if (i == LAST_FD - 1) + call error (SYS_FTOOMANYFILES, "Too many open files") + } + } + + # Open image. + if (VERBOSE) { + call eprintf ("%d: xt_imgnl immap %s\n") + call pargi (index) + call pargstr (XT_IMNAME(xt)) + } + im = immap (XT_IMNAME(xt), READ_ONLY, XT_ARG(xt)) + XT_IM(xt) = im + call imseti (im, IM_BUFSIZE, XT_BUFSIZE(xt)) + call mfree (XT_BUF(xt), XT_BTYPE(xt)) + nopen = nopen + 1 + XT_CLOSEFD(xt) = YES + if (nopenpix < MAX_OPENPIX) { + XT_CLOSEFD(xt) = NO + nopenpix = nopenpix + 1 + } + if (XT_CLOSEFD(xt) == YES) + call imseti (im, IM_CLOSEFD, YES) + XT_FLAG(xt) = flag + + return (imgnlr (im, buf, v)) +end + +# XT_IMGNL -- Return the next line for the indexed image. +# Possibly unmap another image if too many files are open. +# Buffer data when an image is unmmaped to minimize the mapping of images. +# If the requested index has not been mapped use the default pointer. + +int procedure xt_imgnld (imdef, index, buf, v, flag) + +pointer imdef #I Default pointer +int index #I index +pointer buf #O Data buffer +long v[ARB] #I Line vector +int flag #I Flag (=output line) + +int i, j, nc, nl, open(), imgnld(), sizeof(), imloop() +pointer im, xt, xt1, ptr, immap(), imggsd() +errchk open, immap, imgnld, imggsd, imunmap + +long unit_v[IM_MAXDIM] +data unit_v /IM_MAXDIM * 1/ + +include "xtimmap.com" + +begin + # Get index pointer. + xt = NULL + if (index <= nalloc && index > 0) + xt = Memi[ims+index-1] + + # Use default pointer if index has not been mapped. + if (xt == NULL) + return (imgnld (imdef, buf, v)) + + # Close images not accessed during previous line. + # In normal usage this should only occur once per line over all + # indexed images. + if (flag != last_flag) { + do i = 1, nalloc { + xt1 = Memi[ims+i-1] + if (xt1 == NULL) + next + im = XT_IM(xt1) + if (im == NULL || XT_FLAG(xt1) == last_flag) + next + if (VERBOSE) { + call eprintf ("%d: xt_imgnl imunmap %s\n") + call pargi (i) + call pargstr (XT_IMNAME(xt1)) + } + call imunmap (XT_IM(xt1)) + call mfree (XT_BUF(xt1), XT_BTYPE(xt1)) + nopen = nopen - 1 + if (XT_CLOSEFD(xt1) == NO) + nopenpix = nopenpix - 1 + } + + # Optimize the file I/O. + do i = nalloc, 1, -1 { + xt1 = Memi[ims+i-1] + if (xt1 == NULL) + next + im = XT_IM(xt1) + if (im == NULL) + next + min_open = i + if (nopenpix < MAX_OPENPIX) { + if (XT_CLOSEFD(xt1) == NO) + next + XT_CLOSEFD(xt1) = NO + call imseti (im, IM_CLOSEFD, NO) + nopenpix = nopenpix + 1 + } + } + last_flag = flag + } + + # Use IMIO for already opened images. + im = XT_IM(xt) + if (im != NULL) { + XT_FLAG(xt) = flag + return (imgnld (im, buf, v)) + } + + # If the image is not currently mapped use the stored header. + im = XT_HDR(xt) + + # Check for EOF. + i = IM_NDIM(im) + if (v[i] > IM_LEN(im,i)) + return (EOF) + + # Check for buffered data. + if (XT_BUF(xt) != NULL) { + if (v[2] >= XT_VS(xt,2) && v[2] <= XT_VE(xt,2)) { + if (XT_BTYPE(xt) != TY_DOUBLE) + call error (1, "Cannot mix data types") + nc = IM_LEN(im,1) + buf = XT_BUF(xt) + (v[2]-XT_VS(xt,2)) * IM_LEN(im,1) + XT_FLAG(xt) = flag + if (i == 1) + v[1] = nc + 1 + else + j = imloop (v, unit_v, IM_LEN(im,1), unit_v, i) + return (nc) + } + } + + # Handle more images than the maximum that can be open at one time. + if (nopen >= max_openim) { + if (option == XT_MAPUNMAP || v[2] == 0) { + do i = min_open, nalloc { + xt1 = Memi[ims+i-1] + if (xt1 == NULL) + next + im = XT_IM(xt1) + if (im == NULL) + next + + # Buffer some number of lines. + nl = XT_BUFSIZE(xt1) / sizeof (TY_DOUBLE) / IM_LEN(im,1) + if (nl > 1) { + nc = IM_LEN(im,1) + call amovl (v, XT_VS(xt1,1), IM_MAXDIM) + call amovl (v, XT_VE(xt1,1), IM_MAXDIM) + XT_VS(xt1,1) = 1 + XT_VE(xt1,1) = nc + XT_VE(xt1,2) = min (XT_VS(xt1,2)+(nl-1), IM_LEN(im,2)) + nl = XT_VE(xt1,2) - XT_VS(xt1,2) + 1 + XT_BTYPE(xt1) = TY_DOUBLE + call malloc (XT_BUF(xt1), nl*nc, XT_BTYPE(xt1)) + ptr = imggsd (im, XT_VS(xt1,1), XT_VE(xt1,1), + IM_NDIM(im)) + call amovd (Memd[ptr], Memd[XT_BUF(xt1)], nl*nc) + } + + if (VERBOSE) { + call eprintf ("%d: xt_imgnl imunmap %s\n") + call pargi (i) + call pargstr (XT_IMNAME(xt1)) + } + call imunmap (XT_IM(xt1)) + nopen = nopen - 1 + if (XT_CLOSEFD(xt1) == NO) + nopenpix = nopenpix - 1 + min_open = i + 1 + break + } + if (index <= min_open) + min_open = index + else { + do i = min_open, nalloc { + xt1 = Memi[ims+i-1] + if (xt1 == NULL) + next + if (XT_IM(xt1) == NULL) + next + min_open = i + break + } + } + } else { + # Check here because we can't catch error in immap. + i = open ("dev$null", READ_ONLY, BINARY_FILE) + call close (i) + if (i == LAST_FD - 1) + call error (SYS_FTOOMANYFILES, "Too many open files") + } + } + + # Open image. + if (VERBOSE) { + call eprintf ("%d: xt_imgnl immap %s\n") + call pargi (index) + call pargstr (XT_IMNAME(xt)) + } + im = immap (XT_IMNAME(xt), READ_ONLY, XT_ARG(xt)) + XT_IM(xt) = im + call imseti (im, IM_BUFSIZE, XT_BUFSIZE(xt)) + call mfree (XT_BUF(xt), XT_BTYPE(xt)) + nopen = nopen + 1 + XT_CLOSEFD(xt) = YES + if (nopenpix < MAX_OPENPIX) { + XT_CLOSEFD(xt) = NO + nopenpix = nopenpix + 1 + } + if (XT_CLOSEFD(xt) == YES) + call imseti (im, IM_CLOSEFD, YES) + XT_FLAG(xt) = flag + + return (imgnld (im, buf, v)) +end + diff --git a/pkg/images/immatch/src/imcombine/src/icaclip.gx b/pkg/images/immatch/src/imcombine/src/icaclip.gx new file mode 100644 index 00000000..de3b04d6 --- /dev/null +++ b/pkg/images/immatch/src/imcombine/src/icaclip.gx @@ -0,0 +1,575 @@ +# 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 (sird) +# 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 = max (0, n[1]) + s = 0. + n2 = 0 + do i = 1, npts { + k = i - 1 + n1 = max (0, 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 = max (0, 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 (max (0, 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, sig, r, s, s1, one +data one /1.0/ +$else +PIXEL med, low, high, sig, 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 = max (0, n[1]) + do i = 1, npts { + k = i - 1 + n1 = max (0, 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) + sig = sqrt (s / (n2 - 1)) + else { + call sfree (sp) + return + } + + # Compute individual sigmas and iteratively clip. + do i = 1, npts { + k = i - 1 + n1 = max (0, 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) && sig > 0.) { + if (doscale1) { + for (; nl <= nh; nl = nl + 1) { + l = Memi[m[nl]+k] + s1 = sig * 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 = sig * 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 = sig * sqrt (max (one, med)) + for (; nl <= nh; 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 == max (0, 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 >= 1.)) { + 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 >= 1.) { + 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 (max (0, 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/pkg/images/immatch/src/imcombine/src/icaverage.gx b/pkg/images/immatch/src/imcombine/src/icaverage.gx new file mode 100644 index 00000000..a474bb9d --- /dev/null +++ b/pkg/images/immatch/src/imcombine/src/icaverage.gx @@ -0,0 +1,120 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> +include <mach.h> +include "../icombine.h" +include "../icmask.h" + +$for (sird) +# IC_AVERAGE -- Compute the average (or summed) image line. +# Options include a weighted average/sum. + +procedure ic_average$t (d, m, n, wts, nimages, npts, doblank, doaverage, + average) + +pointer d[nimages] # Data pointers +pointer m[nimages] # Image ID pointers +int n[npts] # Number of points +real wts[nimages] # Weights +int nimages # Number of images +int npts # Number of output points per line +int doblank # Set blank values? +int doaverage # Do average? +$if (datatype == sil) +real average[npts] # Average (returned) +$else +PIXEL average[npts] # Average (returned) +$endif + +int i, j, k, n1 +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/sum 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/sum + # to the blank value if requested. + + if (dflag == D_ALL) { + if (dowts && doaverage == YES) { + 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] + if (doaverage == YES) + average[i] = sum / n[i] + else + average[i] = sum + } + } + } else if (dflag == D_NONE) { + if (doblank == YES) { + do i = 1, npts + average[i] = blank + } + } else { + if (dowts && doaverage == YES) { + do i = 1, npts { + n1 = abs(n[i]) + if (n1 > 0) { + k = i - 1 + wt = wts[Memi[m[1]+k]] + sum = Mem$t[d[1]+k] * wt + sumwt = wt + do j = 2, n1 { + wt = wts[Memi[m[j]+k]] + sum = sum + Mem$t[d[j]+k] * wt + sumwt = sumwt + wt + } + if (doaverage == YES) { + if (sumwt > 0) + average[i] = sum / sumwt + else { + sum = Mem$t[d[1]+k] + do j = 2, n1 + sum = sum + Mem$t[d[j]+k] + average[i] = sum / n1 + } + } else + average[i] = sum + } else if (doblank == YES) + average[i] = blank + } + } else { + do i = 1, npts { + n1 = abs(n[i]) + if (n1 > 0) { + k = i - 1 + sum = Mem$t[d[1]+k] + do j = 2, n1 + sum = sum + Mem$t[d[j]+k] + if (doaverage == YES) + average[i] = sum / n1 + else + average[i] = sum + } else if (doblank == YES) + average[i] = blank + } + } + } +end +$endfor diff --git a/pkg/images/immatch/src/imcombine/src/iccclip.gx b/pkg/images/immatch/src/imcombine/src/iccclip.gx new file mode 100644 index 00000000..5b1b724e --- /dev/null +++ b/pkg/images/immatch/src/imcombine/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 (sird) +# 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 = max (0, n[1]) + do i = 1, npts { + k = i - 1 + n1 = max (0, 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 (max (0, 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 = max (0, n[1]) + do i = 1, npts { + k = i - 1 + n1 = max (0, 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 <= nh; 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 <= nh; 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 == max (0, 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 >= 1.)) { + 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 >= 1.) { + 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 (max (0, 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/pkg/images/immatch/src/imcombine/src/icemask.x b/pkg/images/immatch/src/imcombine/src/icemask.x new file mode 100644 index 00000000..e29edd5e --- /dev/null +++ b/pkg/images/immatch/src/imcombine/src/icemask.x @@ -0,0 +1,115 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> +include <mach.h> + + +# IC_EMASK -- Create exposure mask. + +procedure ic_emask (pm, v, id, nimages, n, wts, npts) + +pointer pm #I Pixel mask +long v[ARB] #I Output vector +pointer id[nimages] #I Image id pointers +int nimages #I Number of images +int n[npts] #I Number of good pixels +real wts[npts] #I Weights +int npts #I Number of output pixels per line + +int i, j, k, impnli() +real exp +pointer buf +errchk impnli + +pointer exps # Exposure times +pointer ev # IMIO coordinate vector +real ezero # Integer to real zero +real escale # Integer to real scale +int einit # Initialization flag +common /emask/ exps, ev, ezero, escale, einit + +begin + # Write scaling factors to the header. + if (einit == NO) { + if (ezero != 0. || escale != 1.) { + call imaddr (pm, "MASKZERO", ezero) + call imaddr (pm, "MASKSCAL", escale) + } + einit = YES + } + + call amovl (v, Meml[ev], IM_MAXDIM) + i = impnli (pm, buf, Meml[ev]) + call aclri (Memi[buf], npts) + do i = 1, npts { + exp = 0. + do j = 1, n[i] { + k = Memi[id[j]+i-1] + if (wts[k] > 0.) + exp = exp + Memr[exps+k-1] + } + Memi[buf] = nint((exp-ezero)/escale) + buf = buf + 1 + } +end + + +# IC_EINIT -- Initialize exposure mask. + +procedure ic_einit (in, nimages, key, default, maxval) + +int in[nimages] #I Image pointers +int nimages #I Number of images +char key[ARB] #I Exposure time keyword +real default #I Default exposure time +int maxval #I Maximum mask value + +int i +real exp, emin, emax, efrac, imgetr() + +pointer exps # Exposure times +pointer ev # IMIO coordinate vector +real ezero # Integer to real zero +real escale # Integer to real scale +int einit # Initialization flag +common /emask/ exps, ev, ezero, escale, einit + +begin + call malloc (ev, IM_MAXDIM, TY_LONG) + call malloc (exps, nimages, TY_REAL) + + emax = 0. + emin = MAX_REAL + efrac = 0 + do i = 1, nimages { + iferr (exp = imgetr (in[i], key)) + exp = default + exp = max (0., exp) + emax = emax + exp + if (exp > 0.) + emin = min (exp, emin) + efrac = max (abs(exp-nint(exp)), efrac) + Memr[exps+i-1] = exp + } + + # Set scaling. + ezero = 0. + escale = 1. + if (emin < 1.) { + escale = emin + emin = emin / escale + emax = emax / escale + } else if (emin == MAX_REAL) + emin = 0. + if (efrac > 0.001 && emax-emin < 1000.) { + escale = escale / 1000. + emin = emin * 1000. + emax = emax * 1000. + } + while (emax > maxval) { + escale = escale * 10. + emin = emin / 10. + emax = emax / 10. + } + einit = NO +end diff --git a/pkg/images/immatch/src/imcombine/src/icgdata.gx b/pkg/images/immatch/src/imcombine/src/icgdata.gx new file mode 100644 index 00000000..a05f5646 --- /dev/null +++ b/pkg/images/immatch/src/imcombine/src/icgdata.gx @@ -0,0 +1,396 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> +include <mach.h> +include "../icombine.h" + +$for (sird) +# 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 kept 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 +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 + +PIXEL temp +int i, j, k, l, n1, n2, npix, nin, nout, ndim, nused, mtype, xt_imgnl$t() +real a, b +pointer buf, dp, ip, mp +errchk xt_cpix, xt_imgnl$t + +PIXEL max_pixel +$if (datatype == s) +data max_pixel/MAX_SHORT/ +$else $if (datatype == i) +data max_pixel/MAX_INT/ +$else $if (datatype == r) +data max_pixel/MAX_REAL/ +$else +data max_pixel/MAX_DOUBLE/ +$endif $endif $endif + +include "../icombine.com" + +begin + # Get masks and return if there is no data + call ic_mget (in, out, offsets, v1, v2, m, lflag, nimages, mtype) + if (dflag == D_NONE) { + call aclri (n, npts) + return + } + + # Close images which are not needed. + nout = IM_LEN(out[1],1) + ndim = IM_NDIM(out[1]) + if (!project && ndim < 3) { + do i = 1, nimages { + nin = IM_LEN(in[i],1) + j = max (0, offsets[i,1]) + k = min (nout, nin + offsets[i,1]) + npix = k - j + if (npix < 1) + call xt_cpix (i) + if (ndim > 1) { + j = v1[2] - offsets[i,2] + if (j < 1 || j > IM_LEN(in[i],2)) + call xt_cpix (i) + } + } + } + + # Get data and fill data buffers. Correct for offsets if needed. + do i = 1, nimages { + if (lflag[i] == D_NONE) + next + if (dbuf[i] == NULL) { + call amovl (v1, v2, IM_MAXDIM) + if (project) + v2[ndim+1] = i + j = xt_imgnl$t (in[i], i, d[i], v2, v1[2]) + } else { + nin = IM_LEN(in[i],1) + j = max (0, offsets[i,1]) + k = min (nout, nin + offsets[i,1]) + npix = k - j + if (npix < 1) { + lflag[i] = D_NONE + next + } + k = 1 + j - offsets[i,1] + v2[1] = k + do l = 2, ndim { + v2[l] = v1[l] - offsets[i,l] + if (v2[l] < 1 || v2[l] > IM_LEN(in[i],l)) { + lflag[i] = D_NONE + break + } + } + if (lflag[i] == D_NONE) + next + if (project) + v2[ndim+1] = i + l = xt_imgnl$t (in[i], i, buf, v2, v1[2]) + call amov$t (Mem$t[buf+k-1], Mem$t[dbuf[i]+j], npix) + d[i] = dbuf[i] + } + } + + # Set values to max_pixel if needed. + if (mtype == M_NOVAL) { + do i = 1, nimages { + dp = d[i]; mp = m[i] + if (lflag[i] == D_NONE || dp == NULL) + next + else if (lflag[i] == D_MIX) { + do j = 1, npts { + if (Memi[mp] == 1) + Mem$t[dp] = max_pixel + dp = dp + 1 + mp = mp + 1 + } + } + } + } + + # Apply threshold if needed + if (dothresh) { + do i = 1, nimages { + if (lflag[i] == D_ALL) { + dp = d[i] + do j = 1, npts { + a = Mem$t[dp] + if (a < lthresh || a > hthresh) { + if (mtype == M_NOVAL) + Memi[m[i]+j-1] = 2 + else + Memi[m[i]+j-1] = 1 + + lflag[i] = D_MIX + dflag = D_MIX + } + dp = dp + 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 + } + } + } else if (lflag[i] == D_MIX) { + nin = IM_LEN(in[i],1) + j = max (0, offsets[i,1]) + k = min (nout, nin + offsets[i,1]) + npix = k - j + n1 = 1 + j + n2 = n1 + npix - 1 + dp = d[i] + n1 - 1 + mp = m[i] + n1 - 1 + do j = n1, n2 { + if (Memi[mp] != 1) { + a = Mem$t[dp] + if (a < lthresh || a > hthresh) { + if (mtype == M_NOVAL) + Memi[m[i]+j-1] = 2 + else + Memi[m[i]+j-1] = 1 + dflag = D_MIX + } + } + dp = dp + 1 + mp = mp + 1 + } + + # Check for completely empty lines + lflag[i] = D_NONE + mp = m[i] + n1 - 1 + do j = n1, n2 { + 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 { + a = scales[i] + b = -zeros[i] + if (lflag[i] == D_ALL) { + dp = d[i] + do j = 1, npts { + Mem$t[dp] = Mem$t[dp] / a + b + dp = dp + 1 + } + } else if (lflag[i] == D_MIX) { + nin = IM_LEN(in[i],1) + j = max (0, offsets[i,1]) + k = min (nout, nin + offsets[i,1]) + npix = k - j + n1 = 1 + j + n2 = n1 + npix - 1 + dp = d[i] + n1 - 1 + mp = m[i] + n1 - 1 + do j = n1, n2 { + if (Memi[mp] != 1) + 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 + } + } + do i = nused+1, nimages + d[i] = NULL + 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] + nin = IM_LEN(in[l],1) + j = max (0, offsets[l,1]) + k = min (nout, nin + offsets[l,1]) + npix = k - j + n1 = 1 + j + n2 = n1 + npix - 1 + dp = d[i] + n1 - 1 + ip = id[i] + n1 - 1 + mp = m[i] + n1 - 1 + do j = n1, n2 { + Memi[ip] = l + if (Memi[mp] == 0) { + n[j] = n[j] + 1 + k = n[j] + if (k < i) { + temp = Mem$t[d[k]+j-1] + Mem$t[d[k]+j-1] = Mem$t[dp] + Mem$t[dp] = temp + Memi[ip] = Memi[id[k]+j-1] + Memi[id[k]+j-1] = l + Memi[mp] = Memi[m[k]+j-1] + Memi[m[k]+j-1] = 0 + } + } else + Memi[ip] = 0 + dp = dp + 1 + ip = ip + 1 + mp = mp + 1 + } + } + if (grow >= 1.) { + do j = 1, npts { + do i = n[j]+1, nimages + Memi[id[i]+j-1] = 0 + } + } + } else { + do i = 1, nused { + l = lflag[i] + nin = IM_LEN(in[l],1) + j = max (0, offsets[l,1]) + k = min (nout, nin + offsets[l,1]) + npix = k - j + n1 = 1 + j + n2 = n1 + npix - 1 + dp = d[i] + n1 - 1 + mp = m[i] + n1 - 1 + do j = n1, n2 { + if (Memi[mp] == 0) { + n[j] = n[j] + 1 + k = n[j] + if (k < i) { + temp = Mem$t[d[k]+j-1] + Mem$t[d[k]+j-1] = Mem$t[dp] + Mem$t[dp] = temp + Memi[mp] = Memi[m[k]+j-1] + Memi[m[k]+j-1] = 0 + } + } + dp = dp + 1 + mp = mp + 1 + } + } + } + } + + # Sort the pixels and IDs if needed + if (mclip) { + call malloc (dp, nused, TY_PIXEL) + if (keepids) { + call malloc (ip, nused, 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) + } + + # If no good pixels set the number of usable values as -n and + # shift them to lower values. + if (mtype == M_NOVAL) { + if (keepids) { + do j = 1, npts { + if (n[j] > 0) + next + n[j] = 0 + do i = 1, nused { + dp = d[i] + j - 1 + ip = id[i] + j - 1 + if (Mem$t[dp] < max_pixel) { + 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] = Memi[ip] + } + } + } + } + } else { + do j = 1, npts { + if (n[j] > 0) + next + n[j] = 0 + do i = 1, nused { + dp = d[i] + j - 1 + if (Mem$t[dp] < max_pixel) { + n[j] = n[j] - 1 + k = -n[j] + if (k < i) + Mem$t[d[k]+j-1] = Mem$t[dp] + } + } + } + } + } +end +$endfor diff --git a/pkg/images/immatch/src/imcombine/src/icgrow.gx b/pkg/images/immatch/src/imcombine/src/icgrow.gx new file mode 100644 index 00000000..caf7dd29 --- /dev/null +++ b/pkg/images/immatch/src/imcombine/src/icgrow.gx @@ -0,0 +1,135 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> +include <pmset.h> +include "../icombine.h" + +# IC_GROW -- Mark neigbors of rejected pixels. +# The rejected pixels (original plus grown) are saved in pixel masks. + +procedure ic_grow (out, v, m, n, buf, nimages, npts, pms) + +pointer out # Output image pointer +long v[ARB] # Output vector +pointer m[ARB] # Image id pointers +int n[ARB] # Number of good pixels +int buf[npts,nimages] # Working buffer +int nimages # Number of images +int npts # Number of output points per line +pointer pms # Pointer to array of pixel masks + +int i, j, k, l, line, nl, rop, igrow, nset, ncompress, or() +real grow2, i2 +pointer mp, pm, pm_newmask() +errchk pm_newmask() + +include "../icombine.com" + +begin + if (dflag == D_NONE || grow == 0.) + return + + line = v[2] + nl = IM_LEN(out,2) + rop = or (PIX_SRC, PIX_DST) + + igrow = grow + grow2 = grow**2 + do l = 0, igrow { + i2 = grow2 - l * l + call aclri (buf, npts*nimages) + nset = 0 + do j = 1, npts { + do k = n[j]+1, nimages { + mp = Memi[m[k]+j-1] + if (mp == 0) + next + do i = 0, igrow { + if (i**2 > i2) + next + if (j > i) + buf[j-i,mp] = 1 + if (j+i <= npts) + buf[j+i,mp] = 1 + nset = nset + 1 + } + } + } + if (nset == 0) + return + + if (pms == NULL) { + call malloc (pms, nimages, TY_POINTER) + do i = 1, nimages + Memi[pms+i-1] = pm_newmask (out, 1) + ncompress = 0 + } + do i = 1, nimages { + pm = Memi[pms+i-1] + v[2] = line - l + if (v[2] > 0) + call pmplpi (pm, v, buf[1,i], 1, npts, rop) + if (l > 0) { + v[2] = line + l + if (v[2] <= nl) + call pmplpi (pm, v, buf[1,i], 1, npts, rop) + } + } + } + v[2] = line + + if (ncompress > 10) { + do i = 1, nimages { + pm = Memi[pms+i-1] + call pm_compress (pm) + } + ncompress = 0 + } else + ncompress = ncompress + 1 +end + + +$for (sird) +# IC_GROW$T -- Reject pixels. + +procedure ic_grow$t (v, d, m, n, buf, nimages, npts, pms) + +long v[ARB] # Output vector +pointer d[ARB] # Data pointers +pointer m[ARB] # Image id pointers +int n[ARB] # Number of good pixels +int buf[ARB] # Buffer of npts +int nimages # Number of images +int npts # Number of output points per line +pointer pms # Pointer to array of pixel masks + +int i, j, k +pointer pm +bool pl_linenotempty() + +include "../icombine.com" + +begin + do k = 1, nimages { + pm = Memi[pms+k-1] + if (!pl_linenotempty (pm, v)) + next + call pmglpi (pm, v, buf, 1, npts, PIX_SRC) + do i = 1, npts { + if (buf[i] == 0) + next + for (j = 1; j <= n[i]; j = j + 1) { + if (Memi[m[j]+i-1] == k) { + if (j < n[i]) { + Mem$t[d[j]+i-1] = Mem$t[d[n[i]]+i-1] + Memi[m[j]+i-1] = Memi[m[n[i]]+i-1] + } + n[i] = n[i] - 1 + dflag = D_MIX + break + } + } + } + } +end +$endfor diff --git a/pkg/images/immatch/src/imcombine/src/icgscale.x b/pkg/images/immatch/src/imcombine/src/icgscale.x new file mode 100644 index 00000000..570697ad --- /dev/null +++ b/pkg/images/immatch/src/imcombine/src/icgscale.x @@ -0,0 +1,88 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "icombine.h" + + +# IC_GSCALE -- Get scale values as directed by CL parameter. +# Only those values which are INDEF are changed. +# 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, imgetr() +pointer errstr +errchk open, imgetr + +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 + do i = 1, nimages + if (IS_INDEFR(values[i])) + break + if (i <= nimages) { + 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 + if (IS_INDEFR(values[i])) + values[i] = rval + } + call close (fd) + if (i < nimages) { + call salloc (errstr, SZ_LINE, TY_CHAR) + call sprintf (errstr, SZ_FNAME, + "Insufficient %s values in %s") + call pargstr (param) + call pargstr (name[2]) + call error (1, errstr) + } + } + } else if (name[1] == '!') { + type = S_KEYWORD + do i = 1, nimages { + if (IS_INDEFR(values[i])) + values[i] = imgetr (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 + if (IS_INDEFR(values[i])) + values[i] = max (0.001, exptime[i]) + } + + return (type) +end diff --git a/pkg/images/immatch/src/imcombine/src/ichdr.x b/pkg/images/immatch/src/imcombine/src/ichdr.x new file mode 100644 index 00000000..b4d925c1 --- /dev/null +++ b/pkg/images/immatch/src/imcombine/src/ichdr.x @@ -0,0 +1,72 @@ +include <imset.h> + + +# IC_HDR -- Set output header. + +procedure ic_hdr (in, out, nimages) + +pointer in[nimages] #I Input images +pointer out[ARB] #I Output images +int nimages #I Number of images + +int i, j, imgnfn(), nowhite(), strldxs() +pointer sp, inkey, key, str, list, imofnlu() +bool streq() + +begin + call smark (sp) + call salloc (inkey, SZ_FNAME, TY_CHAR) + call salloc (key, SZ_FNAME, TY_CHAR) + call salloc (str, SZ_FNAME, TY_CHAR) + + call clgstr ("imcmb", Memc[inkey], SZ_FNAME) + i = nowhite (Memc[inkey], Memc[inkey], SZ_FNAME) + + if (i > 0 && streq (Memc[inkey], "$I")) { + # Set new PROCID. + call xt_procid (out) + + # Set input PROCIDs. + if (nimages < 100) { + list = imofnlu (out, "PROCID[0-9][0-9]") + while (imgnfn (list, Memc[key], SZ_LINE) != EOF) + call imdelf (out, Memc[key]) + call imcfnl (list) + do i = 1, nimages { + call sprintf (Memc[key], 8, "PROCID%02d") + call pargi (i) + iferr (call imgstr (in[i], "PROCID", Memc[str], SZ_LINE)) { + iferr (call imgstr (in[i], "OBSID", Memc[str], SZ_LINE)) + Memc[str] = EOS + } + if (Memc[str] != EOS) + call imastr (out, Memc[key], Memc[str]) + } + } + } + + if (i > 0 && nimages < 1000) { + list = imofnlu (out, "IMCMB[0-9][0-9][0-9]") + while (imgnfn (list, Memc[key], SZ_LINE) != EOF) + call imdelf (out, Memc[key]) + call imcfnl (list) + do i = 1, nimages { + if (streq (Memc[inkey], "$I")) { + call imstats (in[i], IM_IMAGENAME, Memc[str], SZ_LINE) + j = strldxs ("/$", Memc[str]) + if (j > 0) + call strcpy (Memc[str+j], Memc[str], SZ_LINE) + } else { + iferr (call imgstr (in[i], Memc[inkey], Memc[str], SZ_LINE)) + Memc[str] = EOS + } + if (Memc[str] == EOS) + next + call sprintf (Memc[key], SZ_LINE, "IMCMB%03d") + call pargi (i) + call imastr (out, Memc[key], Memc[str]) + } + } + + call sfree (sp) +end diff --git a/pkg/images/immatch/src/imcombine/src/icimstack.x b/pkg/images/immatch/src/imcombine/src/icimstack.x new file mode 100644 index 00000000..d5628694 --- /dev/null +++ b/pkg/images/immatch/src/imcombine/src/icimstack.x @@ -0,0 +1,186 @@ +# 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 (list, output, mask) + +int list #I List of images +char output[ARB] #I Name of output image +char mask[ARB] #I Name of output mask + +int i, j, npix +long line_in[IM_MAXDIM], line_out[IM_MAXDIM], line_outbpm[IM_MAXDIM] +pointer sp, input, bpmname, key, in, out, inbpm, outbpm, buf_in, buf_out, ptr + +int imtgetim(), imtlen(), errget() +int imgnls(), imgnli(), imgnll(), imgnlr(), imgnld(), imgnlx() +int impnls(), impnli(), impnll(), impnlr(), impnld(), impnlx() +pointer immap(), pm_newmask() +errchk immap +errchk imgnls, imgnli, imgnll, imgnlr, imgnld, imgnlx +errchk impnls, impnli, impnll, impnlr, impnld, impnlx + +begin + call smark (sp) + call salloc (input, SZ_FNAME, TY_CHAR) + call salloc (bpmname, SZ_FNAME, TY_CHAR) + call salloc (key, SZ_FNAME, TY_CHAR) + + iferr { + # Add each input image to the output image. + out = NULL; outbpm = NULL + i = 0 + while (imtgetim (list, Memc[input], SZ_FNAME) != EOF) { + + i = i + 1 + in = NULL; inbpm = NULL + ptr = immap (Memc[input], 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)) = imtlen (list) + npix = IM_LEN(out, 1) + call amovkl (long(1), line_out, IM_MAXDIM) + + if (mask[1] != EOS) { + ptr = immap (mask, NEW_COPY, in) + outbpm = ptr + IM_NDIM(outbpm) = IM_NDIM(outbpm) + 1 + IM_LEN(outbpm, IM_NDIM(outbpm)) = imtlen (list) + call amovkl (long(1), line_outbpm, 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], Memc[input]) + + # 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) + } + } + + # Copy mask. + if (mask[1] != EOS) { + iferr (call imgstr (in, "bpm", Memc[bpmname], SZ_FNAME)) { + Memc[bpmname] = EOS + ptr = pm_newmask (in, 27) + } else + ptr = immap (Memc[bpmname], READ_ONLY, 0) + inbpm = ptr + + if (IM_NDIM(inbpm) != IM_NDIM(outbpm) - 1) + call error (0, "Input images not consistent") + do j = 1, IM_NDIM(inbpm) { + if (IM_LEN(inbpm, j) != IM_LEN(outbpm, j)) + call error (0, "Masks not consistent") + } + + call amovkl (long(1), line_in, IM_MAXDIM) + while (imgnli (inbpm, buf_in, line_in) != EOF) { + if (impnli (outbpm, buf_out, line_outbpm) == EOF) + call error (0, "Error writing output mask") + call amovi (Memi[buf_in], Memi[buf_out], npix) + } + + call sprintf (Memc[key], SZ_FNAME, "bpm%04d") + call pargi (i) + call imastr (out, Memc[key], Memc[bpmname]) + + call imunmap (inbpm) + } + + call imunmap (in) + } + } then { + i = errget (Memc[key], SZ_FNAME) + call erract (EA_WARN) + if (outbpm != NULL) { + call imunmap (outbpm) + iferr (call imdelete (mask)) + ; + } + if (out != NULL) { + call imunmap (out) + iferr (call imdelete (output)) + ; + } + if (inbpm != NULL) + call imunmap (inbpm) + if (in != NULL) + call imunmap (in) + call sfree (sp) + call error (i, "Can't make temporary stack images") + } + + # Finish up. + if (outbpm != NULL) { + call imunmap (outbpm) + call imastr (out, "bpm", mask) + } + call imunmap (out) + call sfree (sp) +end diff --git a/pkg/images/immatch/src/imcombine/src/iclog.x b/pkg/images/immatch/src/imcombine/src/iclog.x new file mode 100644 index 00000000..53420cd5 --- /dev/null +++ b/pkg/images/immatch/src/imcombine/src/iclog.x @@ -0,0 +1,431 @@ +# 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) + +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 + +int i, j, stack, ctor() +real rval, imgetr() +long clktime() +bool prncombine, prexptime, prmode, prmedian, prmean, prmask +bool prrdn, prgain, prsn +pointer sp, fname, bpname, key +errchk imgetr + +include "icombine.com" + +begin + if (logfd == NULL) + return + + call smark (sp) + call salloc (fname, SZ_LINE, TY_CHAR) + call salloc (bpname, 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, ") + case SUM: + call fprintf (logfd, " combine = sum, ") + } + call fprintf (logfd, "scale = %s, zero = %s, weight = %s\n") + call pargstr (sname) + call pargstr (zname) + call pargstr (wname) + if (combine == NMODEL && reject!=CCDCLIP && reject!=CRREJECT) { + call fprintf (logfd, + " rdnoise = %s, gain = %s, snoise = %s\n") + call pargstr (Memc[rdnoise]) + call pargstr (Memc[gain]) + call pargstr (Memc[snoise]) + } + + 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 >= 1.) { + call fprintf (logfd, " grow = %g\n") + call pargr (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) + if (Memc[statsec] != 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_NOVAL: + call fprintf (logfd, " masktype = noval, 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)) + case M_LTVAL: + call fprintf (logfd, " masktype = goodval, maskval < %d\n") + call pargi (ICM_VALUE(icm)) + case M_GTVAL: + call fprintf (logfd, " masktype = goodval, 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) { + if (project) + bpname = Memi[ICM_NAMES(icm)] + else + bpname = Memi[ICM_NAMES(icm)+i-1] + if (Memc[bpname] != EOS) + prmask = true + } + if (combine == NMODEL || 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) { + if (stack == YES) { + call sprintf (Memc[key], SZ_FNAME, "bpm%04d") + call pargi (i) + ifnoerr (call imgstr (in[i], Memc[key], Memc[fname], + SZ_LINE)) { + call fprintf (logfd, " %s") + call pargstr (Memc[fname]) + } else { + call fprintf (logfd, " %s") + call pargstr (Memc[bpname]) + } + } else if (ICM_TYPE(icm) != M_NONE) { + if (project) + bpname = Memi[ICM_NAMES(icm)] + else + bpname = Memi[ICM_NAMES(icm)+i-1] + if (Memc[bpname] != EOS) { + call fprintf (logfd, " %s") + call pargstr (Memc[bpname]) + } + } + } + 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) + call fprintf (logfd, "\n") + + if (out[2] != NULL) { + call imstats (out[2], IM_IMAGENAME, Memc[fname], SZ_LINE) + call fprintf (logfd, " Bad pixel mask = %s\n") + call pargstr (Memc[fname]) + } + + if (out[4] != NULL) { + call imstats (out[4], IM_IMAGENAME, Memc[fname], SZ_LINE) + call fprintf (logfd, " Rejection mask = %s\n") + call pargstr (Memc[fname]) + } + + if (out[5] != NULL) { + call imstats (out[5], IM_IMAGENAME, Memc[fname], SZ_LINE) + call fprintf (logfd, " Number rejected mask = %s\n") + call pargstr (Memc[fname]) + } + + if (out[6] != NULL) { + call imstats (out[6], IM_IMAGENAME, Memc[fname], SZ_LINE) + call fprintf (logfd, " Exposure mask = %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/pkg/images/immatch/src/imcombine/src/icmask.com b/pkg/images/immatch/src/imcombine/src/icmask.com new file mode 100644 index 00000000..baba6f6a --- /dev/null +++ b/pkg/images/immatch/src/imcombine/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/pkg/images/immatch/src/imcombine/src/icmask.h b/pkg/images/immatch/src/imcombine/src/icmask.h new file mode 100644 index 00000000..ffb64aa9 --- /dev/null +++ b/pkg/images/immatch/src/imcombine/src/icmask.h @@ -0,0 +1,12 @@ +# ICMASK -- Data structure for IMCOMBINE mask interface. + +define ICM_LEN 6 # Structure length +define ICM_TYPE Memi[$1] # Mask type +define ICM_VALUE Memi[$1+1] # Mask value +define ICM_IOMODE Memi[$1+2] # I/O mode +define ICM_BUFS Memi[$1+3] # Pointer to data line buffers +define ICM_PMS Memi[$1+4] # Pointer to array of PMIO pointers +define ICM_NAMES Memi[$1+5] # Pointer to array of mask names + +define ICM_OPEN 0 # Keep masks open +define ICM_CLOSED 1 # Keep masks closed diff --git a/pkg/images/immatch/src/imcombine/src/icmask.x b/pkg/images/immatch/src/imcombine/src/icmask.x new file mode 100644 index 00000000..ca9c1d02 --- /dev/null +++ b/pkg/images/immatch/src/imcombine/src/icmask.x @@ -0,0 +1,685 @@ +include <imhdr.h> +include <imset.h> +include <pmset.h> +include "icombine.h" +include "icmask.h" + +# IC_MASK -- ICOMBINE mask interface +# +# IC_MOPEN -- Initialize mask interface +# 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_MCLOSE1-- Close a mask for the specified image index + + +# IC_MOPEN -- Initialize mask interface. + +procedure ic_mopen (in, out, nimages, offsets, iomode) + +pointer in[nimages] #I Input images +pointer out[ARB] #I Output images +int nimages #I Number of images +int offsets[nimages,ARB] #I Offsets to output image +int iomode #I I/O mode + +int mtype # Mask type +int mvalue # Mask value +pointer bufs # Pointer to data line buffers +pointer pms # Pointer to array of PMIO pointers +pointer names # Pointer to array of string pointers + +int i, j, k, nin, nout, npix, npms, nscan(), strdic(), ctor() +real rval +pointer sp, str, key, fname, title, image, pm, pm_open() +bool invert, pm_empty() +errchk calloc, pm_open, ic_pmload + +include "icombine.com" + +begin + icm = NULL + if (IM_NDIM(out[1]) == 0) + return + + call smark (sp) + call salloc (str, SZ_LINE, TY_CHAR) + call salloc (key, SZ_FNAME, TY_CHAR) + call salloc (fname, SZ_FNAME, TY_CHAR) + call salloc (title, SZ_FNAME, TY_CHAR) + call salloc (image, 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 = M_NONE + call clgstr ("masktype", Memc[str], SZ_LINE) + call sscan (Memc[str]) + call gargwrd (Memc[title], SZ_FNAME) + call gargwrd (Memc[key], SZ_FNAME) + i = nscan() + if (i > 0) { + if (Memc[title] == '!') { + if (i == 1) + mtype = M_GOODVAL + else + mtype = strdic (Memc[key], Memc[key], SZ_FNAME, MASKTYPES) + call strcpy (Memc[title+1], Memc[key], SZ_FNAME) + } else { + mtype = strdic (Memc[title], Memc[title], SZ_FNAME, MASKTYPES) + call strcpy ("BPM", Memc[key], SZ_FNAME) + } + if (mtype == 0) { + call sprintf (Memc[title], SZ_FNAME, + "Invalid or ambiguous masktype (%s)") + call pargstr (Memc[str]) + call error (1, Memc[title]) + } + } + npix = IM_LEN(out[1],1) + call calloc (pms, nimages, TY_POINTER) + call calloc (bufs, nimages, TY_POINTER) + call calloc (names, 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. + + # Eventually we want to allow general expressions. For now we only + # allow a special '<' or '>' operator. + + call clgstr ("maskvalue", Memc[title], SZ_FNAME) + i = 1 + if (Memc[title] == '<') { + mtype = M_LTVAL + i = i + 1 + } else if (Memc[title] == '>') { + mtype = M_GTVAL + i = i + 1 + } + if (ctor (Memc[title], i, rval) == 0) + call error (1, "Bad mask value") + mvalue = rval + if (mvalue < 0) + call error (1, "Bad mask value") + else if (mvalue == 0 && mtype == M_NOVAL) + call error (1, "maskvalue cannot be 0 for masktype of 'novalue'") + + if (mtype == 0) + mtype = M_NONE + else if (mtype == M_BADBITS && mvalue == 0) + mtype = M_NONE + else if (mvalue == 0 && (mtype == M_GOODVAL || mtype == M_GOODBITS)) + mtype = M_BOOLEAN + else 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. + + nout = IM_LEN(out[1],1) + npms = 0 + do i = 1, nimages { + if (mtype != M_NONE) { + call malloc (Memi[names+i-1], SZ_FNAME, TY_CHAR) + fname = Memi[names+i-1] + ifnoerr (call imgstr (in[i],Memc[key],Memc[fname],SZ_FNAME)) { + nin = IM_LEN(in[i],1) + j = max (0, offsets[i,1]) + k = min (nout, nin + offsets[i,1]) + npix = k - j + if (npix < 1) + Memc[fname] = EOS + else { + pm = pm_open (NULL) + call ic_pmload (in[i], pm, Memc[fname], SZ_FNAME) + call pm_seti (pm, P_REFIM, in[i]) + if (pm_empty (pm) && !invert) + Memc[fname] = EOS + else { + if (project) + npms = nimages + else + npms = npms + 1 + } + call pm_close (pm) + } + if (project) + break + } else + Memc[fname] = EOS + } + } + + # 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_IOMODE(icm) = iomode + ICM_BUFS(icm) = bufs + ICM_PMS(icm) = pms + ICM_NAMES(icm) = names + + call sfree (sp) +end + + +# IC_PMLOAD -- Find and load a mask. +# This is more complicated because we want to allow a mask name specified +# without a path to be found either in the current directory or in the +# directory of the image. + +procedure ic_pmload (im, pm, fname, maxchar) + +pointer im #I Image pointer to be associated with mask +pointer pm #O Mask pointer to be returned +char fname[ARB] #U Mask name +int maxchar #I Max size of mask name + +bool match +pointer sp, str, imname, yt_pmload() +int i, fnldir(), stridxs(), envfind() + +begin + call smark (sp) + call salloc (str, SZ_PATHNAME, TY_CHAR) + + # First check if the specified file can be loaded. + match = (envfind ("pmatch", Memc[str], SZ_PATHNAME) > 0) + if (match) { + call pm_close (pm) + iferr (pm = yt_pmload (fname,im,"logical",Memc[str],SZ_PATHNAME)) + pm = NULL + if (pm != NULL) + return + } else { + ifnoerr (call pm_loadf (pm, fname, Memc[str], SZ_PATHNAME)) + return + ifnoerr (call pm_loadim (pm, fname, Memc[str], SZ_PATHNAME)) + return + } + + # Check if the file has a path in which case we return an error. + # Must deal with possible [] which is a VMS directory delimiter. + call strcpy (fname, Memc[str], SZ_PATHNAME) + i = stridxs ("[", Memc[str]) + if (i > 0) + Memc[str+i-1] = EOS + if (fnldir (Memc[str], Memc[str], SZ_PATHNAME) > 0) { + call sprintf (Memc[str], SZ_PATHNAME, + "Bad pixel mask not found (%s)") + call pargstr (fname) + call error (1, Memc[str]) + } + + # Check if the image has a path. If not return an error. + call salloc (imname, SZ_PATHNAME, TY_CHAR) + call imstats (im, IM_IMAGENAME, Memc[imname], SZ_PATHNAME) + if (fnldir (Memc[imname], Memc[str], SZ_PATHNAME) == 0) { + call sprintf (Memc[str], SZ_PATHNAME, + "Bad pixel mask not found (%s)") + call pargstr (fname) + call error (1, Memc[str]) + } + + # Try using the image path for the mask file. + call strcat (fname, Memc[str], SZ_PATHNAME) + if (match) { + iferr (pm = yt_pmload (Memc[imname], im, "logical", + Memc[str], SZ_PATHNAME)) + pm = NULL + if (pm != NULL) { + call strcpy (Memc[str], fname, maxchar) + return + } + } else { + ifnoerr (call pm_loadf (pm, Memc[str], Memc[imname], SZ_PATHNAME)) { + call strcpy (Memc[str], fname, maxchar) + return + } + } + + # No mask found. + call sprintf (Memc[str], SZ_PATHNAME, + "Bad pixel mask not found (%s)") + call pargstr (fname) + call error (1, Memc[str]) + + # This will not be reached and we let the calling program free + # the stack. We include smark/sfree for lint detectors. + 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_NAMES(icm)+i-1], TY_CHAR) + 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_NAMES(icm), TY_POINTER) + 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, mtype) + +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 +int iomode # I/O mode +pointer bufs # Pointer to data line buffers +pointer pms # Pointer to array of PMIO pointers + +char title[1] +int i, j, k, l, ndim, nin, nout, npix, envfind() +pointer buf, pm, names, fname, pm_open(), yt_pmload() +bool match, pm_linenotempty() +errchk pm_glpi, pm_open, pm_loadf, pm_loadim, yt_pmload + +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 + mtype = M_NONE + if (icm == NULL) + return + if (ICM_TYPE(icm) == M_NONE && aligned && !dothresh) + return + + mtype = ICM_TYPE(icm) + mvalue = ICM_VALUE(icm) + iomode = ICM_IOMODE(icm) + bufs = ICM_BUFS(icm) + pms = ICM_PMS(icm) + names = ICM_NAMES(icm) + match = (envfind ("pmmatch", title, 1) > 0) + + # 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 { + nin = IM_LEN(in[i],1) + j = max (0, offsets[i,1]) + k = min (nout, nin + offsets[i,1]) + npix = k - j + + m[i] = Memi[bufs+i-1] + buf = Memi[bufs+i-1] + j + if (project) { + pm = Memi[pms] + fname = Memi[names] + } else { + pm = Memi[pms+i-1] + fname = Memi[names+i-1] + } + + if (npix < 1) + lflag[i] = D_NONE + else if (npix == nout) + lflag[i] = D_ALL + else + lflag[i] = D_MIX + + if (lflag[i] != D_NONE) { + v2[1] = 1 + j - offsets[i,1] + do l = 2, ndim { + v2[l] = v1[l] - offsets[i,l] + if (v2[l] < 1 || v2[l] > IM_LEN(in[i],l)) { + lflag[i] = D_NONE + break + } + } + } + if (project) + v2[ndim+1] = i + + if (lflag[i] == D_NONE) { + if (pm != NULL && !project) { + call pm_close (pm) + Memi[pms+i-1] = NULL + } + call amovki (1, Memi[m[i]], nout) + next + } else if (lflag[i] == D_MIX) { + if (j > 0) + call amovki (1, Memi[m[i]], j) + if (nout-k > 0) + call amovki (1, Memi[m[i]+k], nout-k) + } + + if (fname == NULL) { + call aclri (Memi[buf], npix) + next + } else if (Memc[fname] == EOS) { + call aclri (Memi[buf], npix) + next + } + + # Do mask I/O and convert to appropriate values in order of + # expected usage. + + if (pm == NULL) { + if (match) { + pm = yt_pmload (Memc[fname], in[i], "logical", + Memc[fname], SZ_FNAME) + } else { + pm = pm_open (NULL) + iferr (call pm_loadf (pm, Memc[fname], title, 1)) + call pm_loadim (pm, Memc[fname], title, 1) + call pm_seti (pm, P_REFIM, in[i]) + } + if (project) + Memi[pms] = pm + else + Memi[pms+i-1] = pm + } + + 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_NOVAL) { + do j = 0, npix-1 { + if (Memi[buf+j] == 0) + next + if (Memi[buf+j] == mvalue) + Memi[buf+j] = 1 + else + Memi[buf+j] = 2 + } + } 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) + else if (mtype == M_LTVAL) + call abgeki (Memi[buf], mvalue, Memi[buf], npix) + else if (mtype == M_GTVAL) + call ableki (Memi[buf], mvalue, Memi[buf], npix) + + lflag[i] = D_NONE + do j = 1, npix + if (Memi[buf+j-1] != 1) { + 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_NOVAL && mvalue != 0) || + (mtype == M_GOODVAL && mvalue == 0)) { + call aclri (Memi[buf], npix) + } else if (mtype == M_LTVAL && mvalue > 0) { + call aclri (Memi[buf], npix) + } else { + call amovki (1, Memi[buf], npix) + lflag[i] = D_NONE + } + } + + if (iomode == ICM_CLOSED) + call ic_mclose1 (i, nimages) + } + + # 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, nimages, offset, v, m) + +pointer in # Input image pointer +int image # Image index +int nimages # Number of images +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 + +char title[1] +int i, npix, envfind() +pointer buf, pm, names, fname, pm_open(), yt_pmload() +bool pm_linenotempty() +errchk pm_glpi, pm_open, pm_loadf, pm_loadim, yt_pmload + +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) + names = ICM_NAMES(icm) + + npix = IM_LEN(in,1) + m = Memi[bufs+image-1] + offset + if (project) { + pm = Memi[pms] + fname = Memi[names] + } else { + pm = Memi[pms+image-1] + fname = Memi[names+image-1] + } + + if (fname == NULL) + return + if (Memc[fname] == EOS) + return + + if (pm == NULL) { + if (envfind ("pmmatch", title, 1) > 0) { + pm = yt_pmload (Memc[fname], in, "logical", Memc[fname], + SZ_FNAME) + } else { + pm = pm_open (NULL) + iferr (call pm_loadf (pm, Memc[fname], title, 1)) + call pm_loadim (pm, Memc[fname], title, 1) + call pm_seti (pm, P_REFIM, in) + } + if (project) + Memi[pms] = pm + else + Memi[pms+image-1] = pm + } + + # 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_NOVAL) { + do i = 0, npix-1 { + if (Memi[buf+i] == 0) + next + if (Memi[buf+i] == mvalue) + Memi[buf+i] = 1 + else + Memi[buf+i] = 2 + } + } 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) + else if (mtype == M_LTVAL) + call abgeki (Memi[buf], mvalue, Memi[buf], npix) + else if (mtype == M_GTVAL) + call ableki (Memi[buf], mvalue, Memi[buf], npix) + + dflag = D_NONE + do i = 1, npix + if (Memi[buf+i-1] != 1) { + dflag = D_MIX + break + } + } else { + if (mtype == M_BOOLEAN || mtype == M_BADBITS) { + ; + } else if ((mtype == M_BADVAL && mvalue != 0) || + (mtype == M_NOVAL && mvalue != 0) || + (mtype == M_GOODVAL && mvalue == 0)) { + ; + } else if (mtype == M_LTVAL && mvalue > 0) { + ; + } else + dflag = D_NONE + } +end + + +# IC_MCLOSE1 -- Close mask by index. + +procedure ic_mclose1 (image, nimages) + +int image # Image index +int nimages # Number of images + +pointer pms, names, pm, fname +include "icombine.com" + +begin + if (icm == NULL) + return + + pms = ICM_PMS(icm) + names = ICM_NAMES(icm) + + if (project) { + pm = Memi[pms] + fname = Memi[names] + } else { + pm = Memi[pms+image-1] + fname = Memi[names+image-1] + } + + if (fname == NULL || pm == NULL) + return + if (Memc[fname] == EOS || pm == NULL) + return + + call pm_close (pm) + if (project) + Memi[pms] = NULL + else + Memi[pms+image-1] = NULL +end + + +# YT_PMLOAD -- This is like yt_mappm except it returns the mask pointer. + +pointer procedure yt_pmload (pmname, refim, match, mname, sz_mname) + +char pmname[ARB] #I Pixel mask name +pointer refim #I Reference image pointer +char match[ARB] #I Match by physical coordinates? +char mname[ARB] #O Expanded mask name +int sz_mname #O Size of expanded mask name +pointer pm #R Pixel mask pointer + +int imstati() +pointer im, yt_mappm() +errchk yt_mappm + +begin + im = yt_mappm (pmname, refim, match, mname, sz_mname) + if (im != NULL) { + pm = imstati (im, IM_PMDES) + call imseti (im, IM_PMDES, NULL) + call imunmap (im) + } else + pm = NULL + return (pm) +end diff --git a/pkg/images/immatch/src/imcombine/src/icmedian.gx b/pkg/images/immatch/src/imcombine/src/icmedian.gx new file mode 100644 index 00000000..164140a1 --- /dev/null +++ b/pkg/images/immatch/src/imcombine/src/icmedian.gx @@ -0,0 +1,246 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "../icombine.h" + +$for (sird) +# IC_MEDIAN -- Median of lines + +procedure ic_median$t (d, n, npts, doblank, median) + +pointer d[ARB] # Input data line pointers +int n[npts] # Number of good pixels +int npts # Number of output points per line +int doblank # Set blank values? +$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) { + if (doblank == YES) { + 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] + j1 = n1 / 2 + 1 + j2 = n1 / 2 + even = (mod(n1,2)==0 && (medtype==MEDAVG || 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] + } + return + } else { + # Check for negative n values. If found then there are + # pixels with no good values but with values we want to + # use as a substitute median. In this case ignore that + # the good pixels have been sorted. + do i = 1, npts { + if (n[i] < 0) + break + } + + if (n[i] >= 0) { + do i = 1, npts { + k = i - 1 + n1 = n[i] + if (n1 > 0) { + j1 = n1 / 2 + 1 + if (mod(n1,2)==0 && (medtype==MEDAVG || n1>2)) { + 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 if (doblank == YES) + median[i] = blank + } + return + } + } + } + + # Compute the median. + do i = 1, npts { + k = i - 1 + n1 = abs(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 && (medtype==MEDAVG || n1 > 2)) { + 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] + if (medtype == MEDAVG) + median[i] = (val1 + val2) / 2 + else + median[i] = min (val1, val2) + + # 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 if (doblank == YES) + median[i] = blank + } +end +$endfor diff --git a/pkg/images/immatch/src/imcombine/src/icmm.gx b/pkg/images/immatch/src/imcombine/src/icmm.gx new file mode 100644 index 00000000..860cb512 --- /dev/null +++ b/pkg/images/immatch/src/imcombine/src/icmm.gx @@ -0,0 +1,189 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "../icombine.h" + +$for (sird) +# 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 = max (0, 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 = max (0, 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 + k = Memi[m[jmax]+i1] + Memi[m[jmax]+i1] = Memi[m[j]+i1] + Memi[m[j]+i1] = k + } else { + Mem$t[kmax] = d1 + k = Memi[m[jmax]+i1] + Memi[m[jmax]+i1] = Memi[m[n1]+i1] + Memi[m[n1]+i1] = k + } + } + if (jmin < j) { + if (jmax != n1) { + Mem$t[kmin] = d1 + k = Memi[m[jmin]+i1] + Memi[m[jmin]+i1] = Memi[m[n1]+i1] + Memi[m[n1]+i1] = k + } else { + Mem$t[kmin] = d2 + k = Memi[m[jmin]+i1] + Memi[m[jmin]+i1] = Memi[m[j]+i1] + Memi[m[j]+i1] = k + } + } + } 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 + k = Memi[m[jmin]+i1] + Memi[m[jmin]+i1] = Memi[m[n1]+i1] + Memi[m[n1]+i1] = k + } + } 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 + k = Memi[m[jmax]+i1] + Memi[m[jmax]+i1] = Memi[m[n1]+i1] + Memi[m[n1]+i1] = k + } + } 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/pkg/images/immatch/src/imcombine/src/icnmodel.gx b/pkg/images/immatch/src/imcombine/src/icnmodel.gx new file mode 100644 index 00000000..0e020dc9 --- /dev/null +++ b/pkg/images/immatch/src/imcombine/src/icnmodel.gx @@ -0,0 +1,147 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> +include <mach.h> +include "../icombine.h" +include "../icmask.h" + +$for (sird) +# IC_NMODEL -- Compute the quadrature average (or summed) noise model. +# Options include a weighted average/sum. + +procedure ic_nmodel$t (d, m, n, nm, wts, nimages, npts, doblank, doaverage, + average) + +pointer d[nimages] # Data pointers +pointer m[nimages] # Image ID pointers +int n[npts] # Number of points +real nm[3,nimages] # Noise model parameters +real wts[nimages] # Weights +int nimages # Number of images +int npts # Number of output points per line +int doblank # Set blank values? +int doaverage # Do average? +$if (datatype == sil) +real average[npts] # Average (returned) +$else +PIXEL average[npts] # Average (returned) +$endif + +int i, j, k, n1 +real val, wt, sumwt +$if (datatype == sil) +real sum, zero +data zero /0.0/ +$else +PIXEL sum, zero +data zero /0$f/ +$endif + +include "../icombine.com" + +begin + # If no data has been excluded do the average/sum 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/sum + # to the blank value if requested. + + if (dflag == D_ALL) { + if (dowts && doaverage == YES) { + do i = 1, npts { + k = i - 1 + val = max (zero, Mem$t[d[1]+k]) + val = nm[1,1] + val/nm[2,1] + (val*nm[3,1])**2 + wt = wts[Memi[m[1]+k]] + sum = val * wt**2 + do j = 2, n[i] { + val = max (zero, Mem$t[d[j]+k]) + val = nm[1,j] + val/nm[2,j] + (val*nm[3,j])**2 + wt = wts[Memi[m[j]+k]] + sum = sum + val * wt**2 + } + average[i] = sqrt(sum) + } + } else { + do i = 1, npts { + k = i - 1 + val = max (zero, Mem$t[d[1]+k]) + val = nm[1,1] + val/nm[2,1] + (val*nm[3,1])**2 + sum = val + do j = 2, n[i] { + val = max (zero, Mem$t[d[j]+k]) + val = nm[1,j] + val/nm[2,j] + (val*nm[3,j])**2 + sum = sum + val + } + if (doaverage == YES) + average[i] = sqrt(sum) / n[i] + else + average[i] = sqrt(sum) + } + } + } else if (dflag == D_NONE) { + if (doblank == YES) { + do i = 1, npts + average[i] = blank + } + } else { + if (dowts && doaverage == YES) { + do i = 1, npts { + n1 = abs(n[i]) + if (n1 > 0) { + k = i - 1 + val = max (zero, Mem$t[d[1]+k]) + val = nm[1,1] + val/nm[2,1] + (val*nm[3,1])**2 + wt = wts[Memi[m[1]+k]] + sum = val * wt**2 + sumwt = wt + do j = 2, n1 { + val = max (zero, Mem$t[d[j]+k]) + val = nm[1,j] + val/nm[2,j] + (val*nm[3,j])**2 + wt = wts[Memi[m[j]+k]] + sum = sum + val * wt**2 + sumwt = sumwt + wt + } + if (doaverage == YES) { + if (sumwt > 0) + average[i] = sqrt(sum) / sumwt + else { + val = max (zero, Mem$t[d[1]+k]) + val = nm[1,1] + val/nm[2,1] + (val*nm[3,1])**2 + sum = Mem$t[d[1]+k]**2 + do j = 2, n1 { + val = max (zero, Mem$t[d[j]+k]) + val = nm[1,j] + val/nm[2,j] + + (val*nm[3,j])**2 + sum = sum + val + } + average[i] = sqrt(sum) / n1 + } + } else + average[i] = sqrt(sum) + } else if (doblank == YES) + average[i] = blank + } + } else { + do i = 1, npts { + n1 = abs(n[i]) + if (n1 > 0) { + k = i - 1 + val = max (zero, Mem$t[d[1]+k]) + val = nm[1,1] + val/nm[2,1] + (val*nm[3,1])**2 + sum = val + do j = 2, n1 { + val = max (zero, Mem$t[d[j]+k]) + val = nm[1,j] + val/nm[2,j] + (val*nm[3,j])**2 + sum = sum + val + } + if (doaverage == YES) + average[i] = sqrt(sum) / n1 + else + average[i] = sqrt(sum) + } else if (doblank == YES) + average[i] = blank + } + } + } +end +$endfor diff --git a/pkg/images/immatch/src/imcombine/src/icomb.gx b/pkg/images/immatch/src/imcombine/src/icomb.gx new file mode 100644 index 00000000..ae489158 --- /dev/null +++ b/pkg/images/immatch/src/imcombine/src/icomb.gx @@ -0,0 +1,761 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> +include <imset.h> +include <pmset.h> +include <error.h> +include <syserr.h> +include <mach.h> +include "../icombine.h" + +# The following is for compiling under V2.11. +define IM_BUFFRAC IM_BUFSIZE +include <imset.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 (sird) +procedure icombine$t (in, out, scales, zeros, wts, offsets, nimages, bufsize) + +pointer in[nimages] # Input images +pointer out[ARB] # Output images +real scales[nimages] # Scales +real zeros[nimages] # Zeros +real wts[nimages] # Weights +int offsets[nimages,ARB] # Input image offsets +int nimages # Number of input images +int bufsize # IMIO buffer size + +char str[1] +int i, j, k, npts, fd, stropen(), xt_imgnl$t() +pointer sp, d, id, n, m, lflag, v, dbuf +pointer im, buf, xt_opix(), impl1i() +errchk stropen, xt_cpix, xt_opix, xt_imgnl$t, impl1i, ic_combine$t +$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 (dbuf, nimages, TY_POINTER) + 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 (v, IM_MAXDIM, TY_LONG) + call amovki (D_ALL, Memi[lflag], nimages) + call amovkl (1, Meml[v], IM_MAXDIM) + + # If not aligned or growing create data buffers of output length + # otherwise use the IMIO buffers. + + if (!aligned || grow >= 1.) { + do i = 1, nimages { + call salloc (Memi[dbuf+i-1], npts, TY_PIXEL) + call aclr$t (Mem$t[Memi[dbuf+i-1]], npts) + } + } else { + do i = 1, nimages { + im = xt_opix (in[i], i, 1) + if (im != in[i]) { + call salloc (Memi[dbuf+i-1], npts, TY_PIXEL) + call aclr$t (Mem$t[Memi[dbuf+i-1]], npts) + } + } + call amovki (NULL, Memi[dbuf], nimages) + } + + if (project) { + call imseti (in[1], IM_NBUFS, nimages) + call imseti (in[1], IM_BUFFRAC, 0) + call imseti (in[1], IM_BUFSIZE, bufsize) + do i = 1, 6 { + if (out[i] != NULL) { + call imseti (out[i], IM_BUFFRAC, 0) + 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, 6 { + if (out[i] != NULL) { + call imseti (out[i], IM_BUFFRAC, 0) + 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) + } + if (out[4] != NULL) { + buf = impl1i (out[4]) + call aclri (Memi[buf], npts) + } + if (out[5] != NULL) { + buf = impl1i (out[5]) + call aclri (Memi[buf], npts) + } + if (out[6] != NULL) { + buf = impl1i (out[6]) + call aclri (Memi[buf], npts) + } + + # Do I/O for first input image line. + if (!project) { + do i = 1, nimages { + call xt_imseti (i, "bufsize", bufsize) + j = max (0, offsets[i,1]) + k = min (npts, IM_LEN(in[i],1) + offsets[i,1]) + if (k - j < 1) + call xt_cpix (i) + j = 1 - offsets[i,2] + if (j < 1 || j > IM_LEN(in[i],2)) + call xt_cpix (i) + } + + do i = 1, nimages { + j = max (0, offsets[i,1]) + k = min (npts, IM_LEN(in[i],1) + offsets[i,1]) + if (k - j < 1) + next + j = 1 - offsets[i,2] + if (j < 1 || j > IM_LEN(in[i],2)) + next + iferr { + Meml[v+1] = j + j = xt_imgnl$t (in[i], i, buf, Meml[v], 1) + } then { + call imseti (im, IM_PIXFD, NULL) + 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, scales, zeros, 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, ext, ctor(), errcode() +real r, imgetr() +pointer sp, fname, imname, v1, v2, v3, work +pointer outdata, buf, nmod, nm, pms +pointer immap(), impnli() +$if (datatype == sil) +pointer impnlr(), imgnlr() +$else +pointer impnl$t(), imgnl$t +$endif +errchk immap, ic_scale, imgetr, ic_grow, ic_grow$t, ic_rmasks, ic_emask +errchk ic_gdata$t + +include "../icombine.com" +data ext/0/ + +begin + call smark (sp) + call salloc (fname, SZ_FNAME, TY_CHAR) + call salloc (imname, SZ_FNAME, TY_CHAR) + 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, SUM, QUAD, NMODEL: + if (dowts) + keepids = true + else + keepids = false + case MEDIAN: + dowts = false + keepids = false + } + docombine = true + + # Get noise model parameters. + if (combine==NMODEL) { + call salloc (nmod, 3*nimages, TY_REAL) + i = 1 + if (ctor (Memc[rdnoise], i, r) > 0) { + do i = 1, nimages + Memr[nmod+3*(i-1)] = r + } else { + do i = 1, nimages + Memr[nmod+3*(i-1)] = imgetr (in[i], Memc[rdnoise]) + } + i = 1 + if (ctor (Memc[gain], i, r) > 0) { + do i = 1, nimages { + Memr[nmod+3*(i-1)+1] = r * scales[i] + Memr[nmod+3*(i-1)] = + max ((Memr[nmod+3*(i-1)] / Memr[nmod+3*(i-1)+1]) ** 2, + 1e4 / MAX_REAL) + } + } else { + do i = 1, nimages { + r = imgetr (in[i], Memc[gain]) + Memr[nmod+3*(i-1)+1] = r * scales[i] + Memr[nmod+3*(i-1)] = + max ((Memr[nmod+3*(i-1)] / Memr[nmod+3*(i-1)+1]) ** 2, + 1e4 / MAX_REAL) + } + } + i = 1 + if (ctor (Memc[snoise], i, r) > 0) { + do i = 1, nimages + Memr[nmod+3*(i-1)+2] = r + } else { + do i = 1, nimages { + r = imgetr (in[i], Memc[snoise]) + Memr[nmod+3*(i-1)+2] = r + } + } + } + + # 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) + 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 + case PCLIP: + mclip = true + case AVSIGCLIP, SIGCLIP: + if (doscale1) + keepids = true + case NONE: + mclip = false + } + + if (out[4] != NULL) + keepids = true + + if (out[6] != NULL) { + keepids = true + call ic_einit (in, nimages, Memc[expkeyword], 1., 2**27-1) + } + + if (grow >= 1.) { + keepids = true + call salloc (work, npts * nimages, TY_INT) + } + pms = NULL + + if (keepids) { + do i = 1, nimages + call salloc (id[i], npts, TY_INT) + } + +# This idea turns out to has a problem with masks are used with wcs offsets. +# the matching of masks to images based on WCS requires access to the WCS +# of the images. For now we drop this idea but maybe a way can be identified +# to know when this is not going to be needed. +# # Reduce header memory use. +# do i = 1, nimages +# call xt_minhdr (i) + + $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 (pms == NULL || nkeep > 0) { + if (docombine) { + switch (combine) { + case AVERAGE: + call ic_average$t (d, id, n, wts, nimages, npts, + YES, YES, Memr[outdata]) + case MEDIAN: + call ic_median$t (d, n, npts, YES, Memr[outdata]) + case SUM: + call ic_average$t (d, id, n, wts, nimages, npts, + YES, NO, Memr[outdata]) + case QUAD: + call ic_quad$t (d, id, n, wts, nimages, npts, + YES, YES, Memr[outdata]) + case NMODEL: + call ic_nmodel$t (d, id, n, Memr[nmod], wts, + nimages, npts, YES, YES, Memr[outdata]) + } + } + } + + if (grow >= 1.) + call ic_grow (out, Meml[v2], id, n, Memi[work], nimages, npts, + pms) + + if (pms == NULL) { + if (out[2] != NULL) { + call amovl (Meml[v2], Meml[v1], IM_MAXDIM) + i = impnli (out[2], buf, Meml[v1]) + do i = 1, npts { + if (n[i] > 0) + Memi[buf] = 0 + else if (n[i] == 0) + Memi[buf] = 1 + else + Memi[buf] = 1 + } + } + + 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]) + } + + if (out[4] != NULL) + call ic_rmasks (out[4], Meml[v2], id, nimages, n, npts) + + if (out[5] != NULL) { + call amovl (Meml[v2], Meml[v1], IM_MAXDIM) + i = impnli (out[5], buf, Meml[v1]) + call amovki (nimages, Memi[buf], npts) + call asubi (Memi[buf], n, Memi[buf], npts) + } + + if (out[6] != NULL) + call ic_emask (out[6], Meml[v2], id, nimages, n, wts, npts) + } + + 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 (pms == NULL || nkeep > 0) { + if (docombine) { + switch (combine) { + case AVERAGE: + call ic_average$t (d, id, n, wts, nimages, npts, + YES, YES, Mem$t[outdata]) + case MEDIAN: + call ic_median$t (d, n, npts, YES, Mem$t[outdata]) + case SUM: + call ic_average$t (d, id, n, wts, nimages, npts, + YES, NO, Mem$t[outdata]) + case QUAD: + call ic_quad$t (d, id, n, wts, nimages, npts, + YES, YES, Mem$t[outdata]) + case NMODEL: + call ic_nmodel$t (d, id, n, Memr[nmod], wts, + nimages, npts, YES, YES, Mem$t[outdata]) + } + } + } + + if (grow >= 1.) + call ic_grow (out, Meml[v2], id, n, Memi[work], nimages, npts, + pms) + + if (pms == NULL) { + if (out[2] != NULL) { + call amovl (Meml[v2], Meml[v1], IM_MAXDIM) + i = impnli (out[2], buf, Meml[v1]) + do i = 1, npts { + if (n[i] > 0) + Memi[buf] = 0 + else if (n[i] == 0) + Memi[buf] = 1 + else + Memi[buf] = 2 + buf = buf + 1 + } + } + + 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]) + } + + if (out[4] != NULL) + call ic_rmasks (out[4], Meml[v2], id, nimages, n, npts) + + if (out[5] != NULL) { + call amovl (Meml[v2], Meml[v1], IM_MAXDIM) + i = impnli (out[5], buf, Meml[v1]) + call amovki (nimages, Memi[buf], npts) + call asubi (Memi[buf], n, Memi[buf], npts) + } + + if (out[6] != NULL) + call ic_emask (out[6], Meml[v2], id, nimages, n, wts, npts) + } + + call amovl (Meml[v1], Meml[v2], IM_MAXDIM) + } + $endif + + if (pms != NULL) { + if (nkeep > 0) { + call imstats (out[1], IM_IMAGENAME, Memc[fname], SZ_FNAME) + call imunmap (out[1]) + iferr (buf = immap (Memc[fname], READ_WRITE, 0)) { + switch (errcode()) { + case SYS_FXFOPNOEXTNV: + call imgcluster (Memc[fname], Memc[fname], SZ_FNAME) + ext = ext + 1 + call sprintf (Memc[imname], SZ_FNAME, "%s[%d]") + call pargstr (Memc[fname]) + call pargi (ext) + iferr (buf = immap (Memc[imname], READ_WRITE, 0)) { + buf = NULL + ext = 0 + } + repeat { + call sprintf (Memc[imname], SZ_FNAME, "%s[%d]") + call pargstr (Memc[fname]) + call pargi (ext+1) + iferr (outdata = immap (Memc[imname],READ_WRITE,0)) + break + if (buf != NULL) + call imunmap (buf) + buf = outdata + ext = ext + 1 + } + default: + call erract (EA_ERROR) + } + } + out[1] = buf + } + + call amovkl (long(1), Meml[v1], IM_MAXDIM) + call amovkl (long(1), Meml[v2], IM_MAXDIM) + call amovkl (long(1), Meml[v3], IM_MAXDIM) + $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]) + + call ic_grow$t (Meml[v2], d, id, n, Memi[work], nimages, npts, + pms) + + if (nkeep > 0) { + do i = 1, npts { + if (n[i] < nkeep) { + Meml[v1+1] = Meml[v1+1] - 1 + if (imgnlr (out[1], buf, Meml[v1]) == EOF) + ; + call amovr (Memr[buf], Memr[outdata], npts) + break + } + } + } + + switch (combine) { + case AVERAGE: + call ic_average$t (d, id, n, wts, nimages, npts, + NO, YES, Memr[outdata]) + case MEDIAN: + call ic_median$t (d, n, npts, NO, Memr[outdata]) + case SUM: + call ic_average$t (d, id, n, wts, nimages, npts, + NO, NO, Memr[outdata]) + case QUAD: + call ic_quad$t (d, id, n, wts, nimages, npts, + NO, YES, Memr[outdata]) + case NMODEL: + call ic_nmodel$t (d, id, n, Memr[nmod], wts, + nimages, npts, NO, YES, Memr[outdata]) + } + + if (out[2] != NULL) { + call amovl (Meml[v2], Meml[v1], IM_MAXDIM) + i = impnli (out[2], buf, Meml[v1]) + do i = 1, npts { + if (n[i] > 0) + Memi[buf] = 0 + else if (n[i] == 0) + Memi[buf] = 1 + else + Memi[buf] = 2 + buf = buf + 1 + } + } + + 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]) + } + + if (out[4] != NULL) + call ic_rmasks (out[4], Meml[v2], id, nimages, n, npts) + + if (out[5] != NULL) { + call amovl (Meml[v2], Meml[v1], IM_MAXDIM) + i = impnli (out[5], buf, Meml[v1]) + call amovki (nimages, Memi[buf], npts) + call asubi (Memi[buf], n, Memi[buf], npts) + } + + if (out[6] != NULL) + call ic_emask (out[6], Meml[v2], id, nimages, n, wts, npts) + + 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]) + + call ic_grow$t (Meml[v2], d, id, n, Memi[work], nimages, npts, + pms) + + if (nkeep > 0) { + do i = 1, npts { + if (n[i] < nkeep) { + Meml[v1+1] = Meml[v1+1] - 1 + if (imgnl$t (out[1], buf, Meml[v1]) == EOF) + ; + call amov$t (Mem$t[buf], Mem$t[outdata], npts) + break + } + } + } + + switch (combine) { + case AVERAGE: + call ic_average$t (d, id, n, wts, nimages, npts, + NO, YES, Mem$t[outdata]) + case MEDIAN: + call ic_median$t (d, n, npts, NO, Mem$t[outdata]) + case SUM: + call ic_average$t (d, id, n, wts, nimages, npts, + NO, NO, Mem$t[outdata]) + case QUAD: + call ic_quad$t (d, id, n, wts, nimages, npts, + NO, YES, Mem$t[outdata]) + case NMODEL: + call ic_nmodel$t (d, id, n, Memr[nmod], wts, + nimages, npts, NO, YES, Mem$t[outdata]) + } + + if (out[2] != NULL) { + call amovl (Meml[v2], Meml[v1], IM_MAXDIM) + i = impnli (out[2], buf, Meml[v1]) + do i = 1, npts { + if (n[i] > 0) + Memi[buf] = 0 + else if (n[i] == 0) + Memi[buf] = 1 + else + Memi[buf] = 2 + buf = buf + 1 + } + } + + 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]) + } + + if (out[4] != NULL) + call ic_rmasks (out[4], Meml[v2], id, nimages, n, npts) + + if (out[5] != NULL) { + call amovl (Meml[v2], Meml[v1], IM_MAXDIM) + i = impnli (out[5], buf, Meml[v1]) + call amovki (nimages, Memi[buf], npts) + call asubi (Memi[buf], n, Memi[buf], npts) + } + + if (out[6] != NULL) + call ic_emask (out[6], Meml[v2], id, nimages, n, wts, npts) + + call amovl (Meml[v1], Meml[v2], IM_MAXDIM) + } + $endif + + do i = 1, nimages + call pm_close (Memi[pms+i-1]) + call mfree (pms, TY_POINTER) + } + + call sfree (sp) +end +$endfor diff --git a/pkg/images/immatch/src/imcombine/src/icombine.com b/pkg/images/immatch/src/imcombine/src/icombine.com new file mode 100644 index 00000000..55ad308b --- /dev/null +++ b/pkg/images/immatch/src/imcombine/src/icombine.com @@ -0,0 +1,45 @@ +# ICOMBINE Common + +int combine # Combine algorithm +int medtype # Median type +int reject # Rejection algorithm +bool project # Combine across the highest dimension? +real blank # Blank value +pointer expkeyword # Exposure time keyword +pointer statsec # Statistics section +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 +real 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? +bool verbose # Verbose? + +pointer icm # Mask data structure + +common /imccom/ combine, medtype, reject, blank, expkeyword, statsec, 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, verbose, icm diff --git a/pkg/images/immatch/src/imcombine/src/icombine.h b/pkg/images/immatch/src/imcombine/src/icombine.h new file mode 100644 index 00000000..51f60887 --- /dev/null +++ b/pkg/images/immatch/src/imcombine/src/icombine.h @@ -0,0 +1,63 @@ +# ICOMBINE Definitions + +# Memory management parameters; +define MAXMEMORY 500000000 # maximum memory +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|lmedian|sum|quadrature|nmodel|" +define AVERAGE 1 +define MEDIAN 2 +define LMEDIAN 3 +define SUM 4 +define QUAD 5 +define NMODEL 6 + +# Median types: +define MEDAVG 1 # Central average for even N +define MEDLOW 2 # Lower value for even N + +# 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|novalue|" +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_NOVAL 6 # Value selecting no value (good = 0) +define M_LTVAL 7 # Values less than specified are good +define M_GTVAL 8 # Values greater than specified are good +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/pkg/images/immatch/src/imcombine/src/icombine.x b/pkg/images/immatch/src/imcombine/src/icombine.x new file mode 100644 index 00000000..b6e5ddd4 --- /dev/null +++ b/pkg/images/immatch/src/imcombine/src/icombine.x @@ -0,0 +1,520 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> +include <imset.h> +include <error.h> +include <syserr.h> +include "icombine.h" + + +# ICOMBINE -- Combine input list or image. +# 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 (list, output, headers, bmask, rmask, nrmask, emask, + sigma, logfile, scales, zeros, wts, stack, delete, listonly) + +int list #I List of input images +char output[ARB] #I Output image +char headers[ARB] #I Output header rootname +char bmask[ARB] #I Bad pixel mask +char rmask[ARB] #I Rejection mask +char nrmask[ARB] #I Nreject mask +char emask[ARB] #I Exposure mask +char sigma[ARB] #I Sigma image (optional) +char logfile[ARB] #I Logfile (optional) +real scales[ARB] #I Scale factors +real zeros[ARB] #I Offset factors +real wts[ARB] #I Weights +int stack #I Stack input images? +int delete #I Delete input images? +int listonly #I List images to combine? + +bool proj +char input[SZ_FNAME], errstr[SZ_LINE] +int i, j, nimages, intype, bufsize, oldsize, stack1, err, retry +int maxsize, maxmemory, memory +pointer sp, im, in1, in, out[6], offsets, key, tmp, bpmstack + +char clgetc() +int clgwrd(), imtlen(), imtgetim(), imtrgetim(), getdatatype(), envgeti() +int begmem(), errget(), open(), ty_max(), sizeof(), strmatch() +pointer immap(), xt_immap(), ic_pmmap() +errchk ic_imstack, immap, imunmap, xt_immap, ic_pmmap, ic_setout + +include "icombine.com" + +define retry_ 98 +define err_ 99 + +begin + if (listonly == YES) { + # Write the output list. + if (output[1] == EOS) { + call imtrew (list) + while (imtgetim (list, input, SZ_FNAME)!=EOF) { + i = strmatch (input, "[0]") - 3 + if (i > 0) + call strcpy (input[i+3], input[i], SZ_FNAME) + call printf ("%s\n") + call pargstr (input) + } + } else { + call sprintf (errstr, SZ_LINE, "%s.list") + call pargstr (output) + iferr (logfd = open (errstr, APPEND, TEXT_FILE)) + call erract (EA_WARN) + call imtrew (list) + while (imtgetim (list, input, SZ_FNAME)!=EOF) { + i = strmatch (input, "[0]") - 3 + if (i > 0) + call strcpy (input[i+3], input[i], SZ_FNAME) + call printf ("%s -> %s\n") + call pargstr (input) + call pargstr (errstr) + call fprintf (logfd, "%s\n") + call pargstr (input) + } + call close (logfd) + } + return + } + + nimages = imtlen (list) + if (nimages == 0) + call error (1, "No images to combine") + + if (project) { + if (imtgetim (list, input, SZ_FNAME) == EOF) + call error (1, "No image to project") + } + + bufsize = 0 +# if (nimages > LAST_FD - 15) +# stack1 = YES +# else + stack1 = stack + + retry = 0 + +retry_ + iferr { + call smark (sp) + call salloc (in, 1, TY_POINTER) + + nimages = 0 + in1 = NULL; Memi[in] = NULL; logfd = NULL + out[1] = NULL; out[2] = NULL; out[3] = NULL + out[4] = NULL; out[5] = NULL; out[6] = NULL + + # Stack the input images. + if (stack1 == YES) { + proj = project + project = true + call salloc (bpmstack, SZ_FNAME, TY_CHAR) + i = clgwrd ("masktype", Memc[bpmstack], SZ_FNAME, MASKTYPES) + if (i == M_NONE) + Memc[bpmstack] = EOS + else { + call mktemp ("tmp", Memc[bpmstack], SZ_FNAME) + call strcat (".pl", Memc[bpmstack], SZ_FNAME) + } + call mktemp ("tmp", input, SZ_FNAME) + call imtrew (list) + call ic_imstack (list, input, Memc[bpmstack]) + } + + # Open the input image(s). + if (project) { + tmp = immap (input, 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 salloc (in, nimages, TY_POINTER) + call amovki (out[1], Memi[in], nimages) + } else { + call salloc (in, imtlen(list), TY_POINTER) + call amovki (NULL, Memi[in], imtlen(list)) + call imtrew (list) + while (imtgetim (list, input, SZ_FNAME)!=EOF) { + nimages = nimages + 1 + tmp = xt_immap (input, READ_ONLY, 0, nimages, retry) + Memi[in+nimages-1] = tmp + } + + # Check sizes and set I/O option. + intype = 0 + tmp = Memi[in] + do i = 2, nimages { + do j = 1, IM_NDIM(tmp) { + if (IM_LEN(tmp,j) != IM_LEN(Memi[in+i-1],j)) + intype = 1 + } + if (intype == 1) + break + } + if (intype == 1) + call xt_imseti (0, "option", intype) + } + + # Check if there are no images. + if (nimages == 0) + call error (1, "No images to combine") + + # 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. + + if (reject == PCLIP) { + 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) { + 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 error (1, "Bad minmax rejection parameters") + } + + # Map the output image and set dimensions and offsets. + if (stack1 == YES) { + call imtrew (list) + i = imtgetim (list, errstr, SZ_LINE) + in1 = immap (errstr, READ_ONLY, 0) + tmp = immap (output, NEW_COPY, in1); out[1] = tmp + call salloc (key, SZ_FNAME, TY_CHAR) + do i = 1, nimages { + call sprintf (Memc[key], SZ_FNAME, "stck%04d") + call pargi (i) + iferr (call imdelf (out[1], Memc[key])) + ; + if (Memc[bpmstack] != EOS) { + call sprintf (Memc[key], SZ_FNAME, "bpm%04d") + call pargi (i) + iferr (call imdelf (out[1], Memc[key])) + ; + } + } + } else { + tmp = immap (output, NEW_COPY, Memi[in]); out[1] = tmp + if (project) { + IM_LEN(out[1],IM_NDIM(out[1])) = 1 + IM_NDIM(out[1]) = IM_NDIM(out[1]) - 1 + } + } + call salloc (offsets, nimages*IM_NDIM(out[1]), TY_INT) + iferr (call ic_setout (Memi[in], out, Memi[offsets], nimages)) { + call erract (EA_WARN) + call error (1, "Can't set output geometry") + } + call ic_hdr (Memi[in], out, nimages) + iferr (call imdelf (out, "BPM")) + ; + + # 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 rejection masks + if (rmask[1] != EOS) { + tmp = ic_pmmap (rmask, NEW_COPY, out[1]); out[4] = tmp + IM_NDIM(out[4]) = IM_NDIM(out[4]) + 1 + IM_LEN(out[4],IM_NDIM(out[4])) = nimages + if (!project) { + if (key == NULL) + call salloc (key, SZ_FNAME, TY_CHAR) + do i = 100, nimages { + j = imtrgetim (list, i, input, SZ_FNAME) + if (i < 999) + call sprintf (Memc[key], SZ_FNAME, "imcmb%d") + else if (i < 9999) + call sprintf (Memc[key], SZ_FNAME, "imcm%d") + else + call sprintf (Memc[key], SZ_FNAME, "imc%d") + call pargi (i) + call imastr (out[4], Memc[key], input) + } + } + } else + out[4] = NULL + + # Open bad pixel pixel list file if given. + if (bmask[1] != EOS) { + tmp = ic_pmmap (bmask, NEW_COPY, out[1]); out[2] = tmp + } else + out[2] = NULL + + # Open nreject pixel list file if given. + if (nrmask[1] != EOS) { + tmp = ic_pmmap (nrmask, NEW_COPY, out[1]); out[5] = tmp + } else + out[5] = NULL + + # Open exposure mask if given. + if (emask[1] != EOS) { + tmp = ic_pmmap (emask, NEW_COPY, out[1]); out[6] = tmp + } else + out[6] = 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 + + # Open masks. + call ic_mopen (Memi[in], out, nimages, Memi[offsets], + min(retry,1)) + + # 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. + + iferr (maxmemory = envgeti ("imcombine_maxmemory")) + maxmemory = MAXMEMORY + memory = begmem (0, oldsize, maxsize) + memory = min (memory, maxsize, maxmemory) + bufsize = FUDGE * memory / (nimages + 1) / sizeof (intype) + } + + # 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 (ty_max (intype, IM_PIXTYPE(out[1]))) { + case TY_SHORT: + call icombines (Memi[in], out, scales, zeros, + wts, Memi[offsets], nimages, bufsize) + case TY_USHORT, TY_INT, TY_LONG: + call icombinei (Memi[in], out, scales, zeros, + wts, Memi[offsets], nimages, bufsize) + case TY_DOUBLE: + call icombined (Memi[in], out, scales, zeros, + wts, Memi[offsets], nimages, bufsize) + case TY_COMPLEX: + call error (1, "Complex images not allowed") + default: + call icombiner (Memi[in], out, scales, zeros, + wts, Memi[offsets], nimages, bufsize) + } + } then { + err = errget (errstr, SZ_LINE) + if (err == SYS_IKIOPIX && nimages < 250) + err = SYS_MFULL + call ic_mclose (nimages) + if (!project) { + do j = 2, nimages { + if (Memi[in+j-1] != NULL) + call xt_imunmap (Memi[in+j-1], j) + } + } + if (out[2] != NULL) { + iferr (call imunmap (out[2])) + ; + iferr (call imdelete (bmask)) + ; + } + if (out[3] != NULL) { + iferr (call imunmap (out[3])) + ; + iferr (call imdelete (sigma)) + ; + } + if (out[4] != NULL) { + iferr (call imunmap (out[4])) + ; + iferr (call imdelete (rmask)) + ; + } + if (out[5] != NULL) { + iferr (call imunmap (out[5])) + ; + iferr (call imdelete (nrmask)) + ; + } + if (out[6] != NULL) { + iferr (call imunmap (out[6])) + ; + iferr (call imdelete (emask)) + ; + } + if (out[1] != NULL) { + iferr (call imunmap (out[1])) + ; + iferr (call imdelete (output)) + ; + } + if (Memi[in] != NULL) + call xt_imunmap (Memi[in], 1) + if (in1 != NULL) + call imunmap (in1) + if (logfd != NULL) + call close (logfd) + + switch (err) { + case SYS_MFULL: + if (project) + goto err_ + + if (bufsize < 10000 && retry > 2) { + call strcat ("- Maybe min_lenuserarea is too large", + errstr, SZ_LINE) + goto err_ + } + + bufsize = bufsize / 2 + retry = retry + 1 + call sfree (sp) + goto retry_ + case SYS_FTOOMANYFILES, SYS_IKIOPEN, SYS_IKIOPIX, SYS_FOPEN, SYS_FWTNOACC: + if (project) + goto err_ + stack1 = YES + call sfree (sp) + goto retry_ + default: +err_ + if (stack1 == YES) { + iferr (call imdelete (input)) + ; + if (Memc[bpmstack] != EOS) { + iferr (call imdelete (Memc[bpmstack])) + ; + } + } + call fixmem (oldsize) + while (imtgetim (list, input, SZ_FNAME)!=EOF) + ; + call sfree (sp) + call error (err, errstr) + } + } + + # Unmap all the images, close the log file, and restore memory. + if (out[2] != NULL) + iferr (call imunmap (out[2])) + call erract (EA_WARN) + if (out[3] != NULL) + iferr (call imunmap (out[3])) + call erract (EA_WARN) + if (out[4] != NULL) { + # Close the output first so that there is no confusion with + # inheriting the output header. Then update the WCS for the + # extra dimension. Note that this may not be correct with + # axis reduced WCS. + iferr { + call imunmap (out[4]) + out[4] = immap (rmask, READ_WRITE, 0) + i = IM_NDIM(out[4]) + call imaddi (out[4], "WCSDIM", i) + call sprintf (errstr, SZ_LINE, "LTM%d_%d") + call pargi (i) + call pargi (i) + call imaddr (out[4], errstr, 1.) + call sprintf (errstr, SZ_LINE, "CD%d_%d") + call pargi (i) + call pargi (i) + call imaddr (out[4], errstr, 1.) + call imunmap (out[4]) + } then + call erract (EA_WARN) + } + if (out[5] != NULL) + iferr (call imunmap (out[5])) + call erract (EA_WARN) + if (out[6] != NULL) + iferr (call imunmap (out[6])) + call erract (EA_WARN) + if (out[1] != NULL) { + call imunmap (out[1]) + if (headers[1] != EOS) { + # Write input headers to a multiextension file if desired. + # This might be the same as the output image. + iferr { + do i = 1, nimages { + im = Memi[in+i-1] + call imstats (im, IM_IMAGENAME, input, SZ_FNAME) + if (strmatch (headers, ".fits$") == 0) { + call sprintf (errstr, SZ_LINE, "%s.fits[append]") + call pargstr (headers) + } else { + call sprintf (errstr, SZ_LINE, "%s[append]") + call pargstr (headers) + } + tmp = immap (errstr, NEW_COPY, im) + IM_NDIM(tmp) = 0 + do j = 1, IM_NDIM(im) { + call sprintf (errstr, SZ_LINE, "AXLEN%d") + call pargi (j) + call imaddi (tmp, errstr, IM_LEN(im,j)) + } + call imastr (tmp, "INIMAGE", input) + call imastr (tmp, "OUTIMAGE", output) + call imastr (tmp, "EXTNAME", input) + call imunmap (tmp) + } + if (logfd != NULL) { + call eprintf (" Headers = %s\n") + call pargstr (headers) + } + } then + call erract (EA_WARN) + } + } + if (!project) { + do i = 2, nimages { + if (Memi[in+i-1] != NULL) + call xt_imunmap (Memi[in+i-1], i) + } + } + if (Memi[in] != NULL) + call xt_imunmap (Memi[in], 1) + if (in1 != NULL) + call imunmap (in1) + if (stack1 == YES) { + call imdelete (input) + if (Memc[bpmstack] != EOS) + call imdelete (Memc[bpmstack]) + project = proj + } + if (logfd != NULL) + call close (logfd) + call ic_mclose (nimages) + call fixmem (oldsize) + call sfree (sp) +end diff --git a/pkg/images/immatch/src/imcombine/src/icpclip.gx b/pkg/images/immatch/src/imcombine/src/icpclip.gx new file mode 100644 index 00000000..628dca0d --- /dev/null +++ b/pkg/images/immatch/src/imcombine/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 (sird) +# 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 = max (0, 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 = max (0, 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 == max (0, 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 >= 1.)) { + 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 >= 1.) { + 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 (max (0, 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/pkg/images/immatch/src/imcombine/src/icpmmap.x b/pkg/images/immatch/src/imcombine/src/icpmmap.x new file mode 100644 index 00000000..1afeedd7 --- /dev/null +++ b/pkg/images/immatch/src/imcombine/src/icpmmap.x @@ -0,0 +1,34 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <pmset.h> + + +# IC_PMMAP -- Map pixel mask. + +pointer procedure ic_pmmap (fname, mode, refim) + +char fname[ARB] # Mask name +int mode # Image mode +pointer refim # Reference image +pointer pm # IMIO pointer (returned) + +int i, fnextn() +pointer sp, extn, immap() +bool streq() + +begin + call smark (sp) + call salloc (extn, SZ_FNAME, TY_CHAR) + + i = fnextn (fname, Memc[extn], SZ_FNAME) + if (streq (Memc[extn], "pl")) + pm = immap (fname, mode, refim) + else { + call strcpy (fname, Memc[extn], SZ_FNAME) + call strcat (".pl", Memc[extn], SZ_FNAME) + pm = immap (Memc[extn], mode, refim) + } + + call sfree (sp) + return (pm) +end diff --git a/pkg/images/immatch/src/imcombine/src/icquad.gx b/pkg/images/immatch/src/imcombine/src/icquad.gx new file mode 100644 index 00000000..4ecf3aa0 --- /dev/null +++ b/pkg/images/immatch/src/imcombine/src/icquad.gx @@ -0,0 +1,133 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> +include <mach.h> +include "../icombine.h" +include "../icmask.h" + +$for (sird) +# IC_QUAD -- Compute the quadrature average (or summed) image line. +# Options include a weighted average/sum. + +procedure ic_quad$t (d, m, n, wts, nimages, npts, doblank, doaverage, + average) + +pointer d[nimages] # Data pointers +pointer m[nimages] # Image ID pointers +int n[npts] # Number of points +real wts[nimages] # Weights +int nimages # Number of images +int npts # Number of output points per line +int doblank # Set blank values? +int doaverage # Do average? +$if (datatype == sil) +real average[npts] # Average (returned) +$else +PIXEL average[npts] # Average (returned) +$endif + +int i, j, k, n1 +real val, wt, sumwt +$if (datatype == sil) +real sum +$else +PIXEL sum +$endif + +include "../icombine.com" + +begin + # If no data has been excluded do the average/sum 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/sum + # to the blank value if requested. + + if (dflag == D_ALL) { + if (dowts && doaverage == YES) { + do i = 1, npts { + k = i - 1 + val = Mem$t[d[1]+k] + wt = wts[Memi[m[1]+k]] + sum = (val * wt) ** 2 + do j = 2, n[i] { + val = Mem$t[d[j]+k] + wt = wts[Memi[m[j]+k]] + sum = sum + (val * wt) ** 2 + } + average[i] = sqrt(sum) + } + } else { + do i = 1, npts { + k = i - 1 + val = Mem$t[d[1]+k] + sum = val**2 + do j = 2, n[i] { + val = Mem$t[d[j]+k] + sum = sum + val**2 + } + if (doaverage == YES) + average[i] = sqrt(sum) / n[i] + else + average[i] = sqrt(sum) + } + } + } else if (dflag == D_NONE) { + if (doblank == YES) { + do i = 1, npts + average[i] = blank + } + } else { + if (dowts && doaverage == YES) { + do i = 1, npts { + n1 = abs(n[i]) + if (n1 > 0) { + k = i - 1 + val = Mem$t[d[1]+k] + wt = wts[Memi[m[1]+k]] + sum = (val * wt) ** 2 + sumwt = wt + do j = 2, n1 { + val = Mem$t[d[j]+k] + wt = wts[Memi[m[j]+k]] + sum = sum + (val* wt) ** 2 + sumwt = sumwt + wt + } + if (doaverage == YES) { + if (sumwt > 0) + average[i] = sqrt(sum) / sumwt + else { + val = Mem$t[d[1]+k] + sum = val**2 + do j = 2, n1 { + val = Mem$t[d[j]+k] + sum = sum + val**2 + } + average[i] = sqrt(sum) / n1 + } + } else + average[i] = sqrt(sum) + } else if (doblank == YES) + average[i] = blank + } + } else { + do i = 1, npts { + n1 = abs(n[i]) + if (n1 > 0) { + k = i - 1 + val = Mem$t[d[1]+k] + sum = val**2 + do j = 2, n1 { + val = Mem$t[d[j]+k] + sum = sum + val**2 + } + if (doaverage == YES) + average[i] = sqrt(sum) / n1 + else + average[i] = sqrt(sum) + } else if (doblank == YES) + average[i] = blank + } + } + } +end +$endfor diff --git a/pkg/images/immatch/src/imcombine/src/icrmasks.x b/pkg/images/immatch/src/imcombine/src/icrmasks.x new file mode 100644 index 00000000..8b9a0c3d --- /dev/null +++ b/pkg/images/immatch/src/imcombine/src/icrmasks.x @@ -0,0 +1,41 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> + + +# IC_RMASKS -- Set pixels for rejection mask. + +procedure ic_rmasks (pm, v, id, nimages, n, npts) + +pointer pm #I Pixel mask +long v[ARB] #I Output vector (input) +pointer id[nimages] #I Image id pointers +int nimages #I Number of images +int n[npts] #I Number of good pixels +int npts #I Number of output points per line + +int i, j, k, ndim, impnls() +long v1[IM_MAXDIM] +pointer buf + +begin + ndim = IM_NDIM(pm) + do k = 1, nimages { + call amovl (v, v1, ndim-1) + v1[ndim] = k + i = impnls (pm, buf, v1) + do j = 1, npts { + if (n[j] == nimages) + Mems[buf+j-1] = 0 + else { + Mems[buf+j-1] = 1 + do i = 1, n[j] { + if (Memi[id[i]+j-1] == k) { + Mems[buf+j-1] = 0 + break + } + } + } + } + } +end diff --git a/pkg/images/immatch/src/imcombine/src/icscale.x b/pkg/images/immatch/src/imcombine/src/icscale.x new file mode 100644 index 00000000..42d62f8d --- /dev/null +++ b/pkg/images/immatch/src/imcombine/src/icscale.x @@ -0,0 +1,351 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> +include <imset.h> +include "icombine.h" + + +# IC_SCALE -- Get and set the scaling factors. +# +# If the scaling parameters have been set earlier then this routine +# just normalizes the factors and writes the log output. +# When dealing with individual images using image statistics for scaling +# factors this routine determines the image statistics rather than being +# done earlier since the input images have all been mapped at this stage. + +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, sumwts +pointer sp, ncombine, exptime, modes, medians, means +pointer section, str, sname, zname, wname, im, imref +bool domode, domedian, domean, dozero, dos, doz, dow, snorm, znorm, wflag + +int imgeti(), strdic(), ic_gscale() +real imgetr(), asumr(), asumi() +pointer xt_opix() +errchk ic_gscale, xt_opix, 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_LINE, 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) + + # 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] = imgeti (in[i], "ncombine")) + Memi[ncombine+i-1] = 1 + if (Memc[expkeyword] != EOS) { + iferr (Memr[exptime+i-1] = imgetr (in[i], Memc[expkeyword])) + Memr[exptime+i-1] = 0. + } else + Memr[exptime+i-1] = 0. + if (project) { + call amovki (Memi[ncombine], Memi[ncombine], nimages) + call amovkr (Memr[exptime], Memr[exptime], nimages) + break + } + } + + # Set scaling type and 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 if needed. + dos = ((stype==S_MODE)||(stype==S_MEDIAN)||(stype==S_MEAN)) + doz = ((ztype==S_MODE)||(ztype==S_MEDIAN)||(ztype==S_MEAN)) + dow = ((wtype==S_MODE)||(wtype==S_MEDIAN)||(wtype==S_MEAN)) + if (dos) { + dos = false + do i = 1, nimages + if (IS_INDEFR(scales[i])) { + dos = true + break + } + } + if (doz) { + doz = false + do i = 1, nimages + if (IS_INDEFR(zeros[i])) { + doz = true + break + } + } + if (dow) { + dow = false + do i = 1, nimages + if (IS_INDEFR(wts[i])) { + dow = true + break + } + } + + if (dos || doz || dow) { + 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)) + + Memc[section] = EOS + Memc[str] = EOS + call sscan (Memc[statsec]) + 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 { + im = xt_opix (in[i], i, 0) + if (imref != out[1]) + imref = im + if ((dos && IS_INDEFR(scales[i])) || + (doz && IS_INDEFR(zeros[i])) || + (dow && IS_INDEFR(wts[i]))) { + call ic_statr (im, imref, Memc[section], offsets, i, + nimages, domode, domedian, domean, mode, median, mean) + if (domode) { + if (stype == S_MODE && IS_INDEFR(scales[i])) + scales[i] = mode + if (ztype == S_MODE && IS_INDEFR(zeros[i])) + zeros[i] = mode + if (wtype == S_MODE && IS_INDEFR(wts[i])) + wts[i] = mode + } + if (domedian) { + if (stype == S_MEDIAN && IS_INDEFR(scales[i])) + scales[i] = median + if (ztype == S_MEDIAN && IS_INDEFR(zeros[i])) + zeros[i] = median + if (wtype == S_MEDIAN && IS_INDEFR(wts[i])) + wts[i] = median + } + if (domean) { + if (stype == S_MEAN && IS_INDEFR(scales[i])) + scales[i] = mean + if (ztype == S_MEAN && IS_INDEFR(zeros[i])) + zeros[i] = mean + if (wtype == S_MEAN && IS_INDEFR(wts[i])) + wts[i] = mean + } + } + } + } + + # Save the image statistics if computed. + call amovkr (INDEFR, Memr[modes], nimages) + call amovkr (INDEFR, Memr[medians], nimages) + call amovkr (INDEFR, Memr[means], nimages) + if (stype == S_MODE) + call amovr (scales, Memr[modes], nimages) + if (stype == S_MEDIAN) + call amovr (scales, Memr[medians], nimages) + if (stype == S_MEAN) + call amovr (scales, Memr[means], nimages) + if (ztype == S_MODE) + call amovr (zeros, Memr[modes], nimages) + if (ztype == S_MEDIAN) + call amovr (zeros, Memr[medians], nimages) + if (ztype == S_MEAN) + call amovr (zeros, Memr[means], nimages) + if (wtype == S_MODE) + call amovr (wts, Memr[modes], nimages) + if (wtype == S_MEDIAN) + call amovr (wts, Memr[medians], nimages) + if (wtype == S_MEAN) + call amovr (wts, Memr[means], nimages) + + # If nothing else has set the scaling factors set them to defaults. + do i = 1, nimages { + if (IS_INDEFR(scales[i])) + scales[i] = 1. + if (IS_INDEFR(zeros[i])) + zeros[i] = 0. + if (IS_INDEFR(wts[i])) + wts[i] = 1. + } + + 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 factors relative to the first image. + 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) + mean = scales[1] + call adivkr (scales, mean, scales, nimages) + call adivr (zeros, scales, zeros, 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] * zeros[1] / 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. + + mean = zeros[1] + call asubkr (zeros, mean, 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) + if (mean > 0.) + call adivkr (wts, mean, wts, nimages) + else { + call eprintf ("WARNING: Mean weight is zero -- using no weights\n") + call amovkr (1., wts, nimages) + mean = 1. + } + + # 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 + } + } + } + + # Set the output header parameters. + nout = asumi (Memi[ncombine], nimages) + call imaddi (out[1], "ncombine", nout) + mean = 0. + sumwts = 0. + do i = 1, nimages { + ifnoerr (mode = imgetr (in[i], "ccdmean")) { + mean = mean + wts[i] * mode / scales[i] + sumwts = sumwts + wts[i] + } + } + if (sumwts > 0.) { + mean = mean / sumwts + ifnoerr (mode = imgetr (out[1], "ccdmean")) { + call imaddr (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 (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) + + 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) + + doscale = (doscale || dozero) + + call sfree (sp) +end diff --git a/pkg/images/immatch/src/imcombine/src/icsclip.gx b/pkg/images/immatch/src/imcombine/src/icsclip.gx new file mode 100644 index 00000000..e4d8f027 --- /dev/null +++ b/pkg/images/immatch/src/imcombine/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 (sird) +# 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 = max (0, n[1]) + do i = 1, npts { + k = i - 1 + n1 = max (0, 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 (max (0, 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 = max (0, n[1]) + do i = 1, npts { + k = i - 1 + n1 = max (0, 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 <= nh; 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 <= nh; 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 == max (0, 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 >= 1.)) { + 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 >= 1.) { + 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 (max (0, 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/pkg/images/immatch/src/imcombine/src/icsection.x b/pkg/images/immatch/src/imcombine/src/icsection.x new file mode 100644 index 00000000..746c1f51 --- /dev/null +++ b/pkg/images/immatch/src/imcombine/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/pkg/images/immatch/src/imcombine/src/icsetout.x b/pkg/images/immatch/src/imcombine/src/icsetout.x new file mode 100644 index 00000000..efe55681 --- /dev/null +++ b/pkg/images/immatch/src/imcombine/src/icsetout.x @@ -0,0 +1,332 @@ +include <imhdr.h> +include <imset.h> +include <mwset.h> + +define OFFTYPES "|none|wcs|world|physical|grid|" +define FILE 0 +define NONE 1 +define WCS 2 +define WORLD 3 +define PHYSICAL 4 +define GRID 5 + +# 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, offtype, npix +real val +bool proj, reloff, flip, streq(), fp_equald() +pointer sp, str, fname +pointer ltv, lref, wref, cd, ltm, coord, shift, axno, axval, section +pointer mw, ct, mw_openim(), mw_sctran(), xt_immap() +int open(), fscan(), nscan(), mw_stati(), strlen(), strdic() +errchk mw_openim, mw_gwtermd, mw_gltermd, mw_gaxmap +errchk mw_sctran, mw_ctrand, open, xt_immap + +include "icombine.com" +define newscan_ 10 + +begin + call smark (sp) + call salloc (str, SZ_FNAME, TY_CHAR) + call salloc (fname, SZ_FNAME, TY_CHAR) + call salloc (ltv, IM_MAXDIM, TY_DOUBLE) + call salloc (ltm, IM_MAXDIM*IM_MAXDIM, TY_DOUBLE) + 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]) + proj = (indim != outdim) + if (!proj) { + 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]) + call mw_seti (mw, MW_USEAXMAP, NO) + 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 (proj) + Memd[lref+outdim] = 1 + + # Parse the user offset string. If "none" then there are no offsets. + # If "world" or "wcs" then set the offsets based on the world WCS. + # If "physical" then set the offsets based on the physical WCS. + # If "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) + offtype = NONE + else { + offtype = strdic (Memc[fname], Memc[str], SZ_FNAME, OFFTYPES) + if (offtype > 0 && !streq (Memc[fname], Memc[str])) + offtype = 0 + } + if (offtype == 0) + offtype = FILE + + switch (offtype) { + case NONE: + call aclri (offsets, outdim*nimages) + reloff = true + case WORLD, WCS: + do j = 1, outdim + offsets[1,j] = 0 + if (proj) { + 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 { + ct = mw_sctran (mw, "world", "logical", 0) + call mw_ctrand (ct, Memd[wref], Memd[lref], indim) + 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 + case PHYSICAL: + call salloc (section, SZ_FNAME, TY_CHAR) + + call mw_gltermd (mw, Memd[ltm], Memd[coord], indim) + do i = 2, nimages { + call mw_close (mw) + mw = mw_openim (in[i]) + call mw_gltermd (mw, Memd[cd], Memd[coord], indim) + call strcpy ("[", Memc[section], SZ_FNAME) + flip = false + do j = 0, indim*indim-1, indim+1 { + if (Memd[ltm+j] * Memd[cd+j] >= 0.) + call strcat ("*,", Memc[section], SZ_FNAME) + else { + call strcat ("-*,", Memc[section], SZ_FNAME) + flip = true + } + } + Memc[section+strlen(Memc[section])-1] = ']' + if (flip) { + call imstats (in[i], IM_IMAGENAME, Memc[fname], SZ_FNAME) + call strcat (Memc[section], Memc[fname], SZ_FNAME) + call xt_imunmap (in[i], i) + in[i] = xt_immap (Memc[fname], READ_ONLY, TY_CHAR, i, 0) + call mw_close (mw) + mw = mw_openim (in[i]) + call mw_gltermd (mw, Memd[cd], Memd[coord], indim) + do j = 0, indim*indim-1 + if (!fp_equald (Memd[ltm+j], Memd[cd+j])) + call error (1, + "Cannot match physical coordinates") + } + } + + call mw_close (mw) + mw = mw_openim (in[1]) + ct = mw_sctran (mw, "logical", "physical", 0) + call mw_ctrand (ct, Memd[lref], Memd[ltv], indim) + call mw_ctfree (ct) + do j = 1, outdim + offsets[1,j] = 0 + if (proj) { + ct = mw_sctran (mw, "physical", "logical", 0) + do i = 2, nimages { + Memd[ltv+outdim] = i + call mw_ctrand (ct, Memd[ltv], 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, "physical", "logical", 0) + call mw_ctrand (ct, Memd[ltv], 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 + case GRID: + amin = 1 + do j = 1, outdim { + call gargi (a) + call gargi (b) + if (nscan() < 1+2*j) { + a = 1 + b = 0 + } + do i = 1, nimages + offsets[i,j] = mod ((i-1)/amin, a) * b + amin = amin * a + } + reloff = true + case FILE: + 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 + } + } + + # Get the output limits. + call clgstr ("outlimits", Memc[fname], SZ_FNAME) + call sscan (Memc[fname]) + do j = 1, outdim { + call gargi (a) + call gargi (b) + if (nscan() < 2*j) + break + if (!IS_INDEFI(a)) { + do i = 1, nimages { + offsets[i,j] = offsets[i,j] - a + 1 + if (offsets[i,j] != 0) + aligned = false + } + IM_LEN(out[1],j) = IM_LEN(out[1],j) - a + 1 + } + if (!IS_INDEFI(a) && !IS_INDEFI(b)) + IM_LEN(out[1],j) = min (IM_LEN(out[1],j), b - a + 1) + } + + # Update the WCS. + if (proj || !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] + } + if (proj) + Memd[lref+mwdim-1] = 0. + call mw_sltermd (mw, Memd[cd], Memd[lref], mwdim) + } + if (proj) { + # 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) + } + + # Reset physical coordinates. + if (offtype == WCS || offtype == WORLD) { + call mw_gltermd (mw, Memd[ltm], Memd[ltv], mwdim) + call mw_gwtermd (mw, Memd[lref], Memd[wref], Memd[cd], mwdim) + call mwvmuld (Memd[ltm], Memd[lref], Memd[lref], mwdim) + call aaddd (Memd[lref], Memd[ltv], Memd[lref], mwdim) + call mwinvertd (Memd[ltm], Memd[ltm], mwdim) + call mwmmuld (Memd[cd], Memd[ltm], Memd[cd], mwdim) + call mw_swtermd (mw, Memd[lref], Memd[wref], Memd[cd], mwdim) + call aclrd (Memd[ltv], mwdim) + call aclrd (Memd[ltm], mwdim*mwdim) + do i = 1, mwdim + Memd[ltm+(i-1)*(mwdim+1)] = 1. + call mw_sltermd (mw, Memd[ltm], Memd[ltv], mwdim) + } + call mw_saveim (mw, out) + } + call mw_close (mw) + + # Throw an error if the output size is too large. + if (offtype != NONE) { + npix = IM_LEN(out[1],1) + do i = 2, outdim + npix = npix * IM_LEN(out[1],i) + npix = npix / 1000000000 + if (npix > 100) + call error (1, "Output has more than 100 Gpixels (check offsets)") + } + + call sfree (sp) +end diff --git a/pkg/images/immatch/src/imcombine/src/icsigma.gx b/pkg/images/immatch/src/imcombine/src/icsigma.gx new file mode 100644 index 00000000..1304d940 --- /dev/null +++ b/pkg/images/immatch/src/imcombine/src/icsigma.gx @@ -0,0 +1,122 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> +include "../icombine.h" + +$for (sird) +# 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 + } + if (sumwt > 0) + sigma[i] = sqrt (sum / sumwt * sigcor) + else { + 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 / n1 * 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/pkg/images/immatch/src/imcombine/src/icsort.gx b/pkg/images/immatch/src/imcombine/src/icsort.gx new file mode 100644 index 00000000..e124da15 --- /dev/null +++ b/pkg/images/immatch/src/imcombine/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 (sird) +# 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/pkg/images/immatch/src/imcombine/src/icstat.gx b/pkg/images/immatch/src/imcombine/src/icstat.gx new file mode 100644 index 00000000..c594182b --- /dev/null +++ b/pkg/images/immatch/src/imcombine/src/icstat.gx @@ -0,0 +1,238 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> +include "../icombine.h" + +define NMAX 100000 # Maximum number of pixels to sample + +$for (sird) +# 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() + +$if (datatype == csir) +real asum$t() +$else $if (datatype == ld) +double asum$t() +$else +PIXEL asum$t() +$endif $endif +PIXEL ic_mode$t() + +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, nimages, 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) + } + + # Close mask until it is needed again. + call ic_mclose1 (image, nimages) + + 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.7 # 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/pkg/images/immatch/src/imcombine/src/mkpkg b/pkg/images/immatch/src/imcombine/src/mkpkg new file mode 100644 index 00000000..5f53d4b8 --- /dev/null +++ b/pkg/images/immatch/src/imcombine/src/mkpkg @@ -0,0 +1,67 @@ +# Make the IMCOMBINE library. + +update: + $checkout libimc.a lib$ + $update libimc.a + $checkin libimc.a lib$ + ; + +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/icquad.x, icquad.gx) + $(GEN) icquad.gx -o generic/icquad.x $endif + $ifolder (generic/icnmodel.x, icnmodel.gx) + $(GEN) icnmodel.gx -o generic/icnmodel.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/icomb.x, icomb.gx) + $(GEN) icomb.gx -o generic/icomb.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 + + $ifolder (generic/xtimmap.x, xtimmap.gx) + $(GEN) xtimmap.gx -o generic/xtimmap.x $endif + ; + +libimc.a: + $ifeq (USE_GENERIC, yes) $call generic $endif + + @generic + + icemask.x <imhdr.h> <mach.h> + icgscale.x icombine.com icombine.h + ichdr.x <imset.h> + 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 <imhdr.h> <pmset.h> + icombine.x icombine.com icombine.h <error.h> <imhdr.h> <imset.h> + icpmmap.x <pmset.h> + icrmasks.x <imhdr.h> + icscale.x icombine.com icombine.h <imhdr.h> <imset.h> + icsection.x <ctype.h> + icsetout.x icombine.com <imhdr.h> <imset.h> <mwset.h> + tymax.x <mach.h> + xtprocid.x + ; diff --git a/pkg/images/immatch/src/imcombine/src/tymax.x b/pkg/images/immatch/src/imcombine/src/tymax.x new file mode 100644 index 00000000..a7f4f469 --- /dev/null +++ b/pkg/images/immatch/src/imcombine/src/tymax.x @@ -0,0 +1,27 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <mach.h> + + +# 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 diff --git a/pkg/images/immatch/src/imcombine/src/xtimmap.gx b/pkg/images/immatch/src/imcombine/src/xtimmap.gx new file mode 100644 index 00000000..2e6cfb1e --- /dev/null +++ b/pkg/images/immatch/src/imcombine/src/xtimmap.gx @@ -0,0 +1,634 @@ +include <syserr.h> +include <error.h> +include <imhdr.h> +include <imset.h> +include <config.h> + +# The following is for compiling under V2.11. +define IM_BUFFRAC IM_BUFSIZE +include <imset.h> + +define VERBOSE false + +# These routines maintain an arbitrary number of indexed "open" images which +# must be READ_ONLY. The calling program may use the returned pointer for +# header accesses but must call xt_opix before I/O. Subsequent calls to +# xt_opix may invalidate the pointer. The xt_imunmap call will free memory. + +define MAX_OPENIM (LAST_FD-16) # Maximum images kept open +define MAX_OPENPIX 45 # Maximum pixel files kept open + +define XT_SZIMNAME 299 # Size of IMNAME string +define XT_LEN 179 # Structure length +define XT_IMNAME Memc[P2C($1)] # Image name +define XT_ARG Memi[$1+150] # IMMAP header argument +define XT_IM Memi[$1+151] # IMIO pointer +define XT_HDR Memi[$1+152] # Copy of IMIO pointer +define XT_CLOSEFD Memi[$1+153] # Close FD? +define XT_FLAG Memi[$1+154] # Flag +define XT_BUFSIZE Memi[$1+155] # Buffer size +define XT_BUF Memi[$1+156] # Data buffer +define XT_BTYPE Memi[$1+157] # Data buffer type +define XT_VS Memi[$1+157+$2] # Start vector (10) +define XT_VE Memi[$1+167+$2] # End vector (10) + +# Options +define XT_MAPUNMAP 1 # Map and unmap images. + +# XT_IMMAP -- Map an image and save it as an indexed open image. +# The returned pointer may be used for header access but not I/O. +# The indexed image is closed by xt_imunmap. + +pointer procedure xt_immap (imname, acmode, hdr_arg, index, retry) + +char imname[ARB] #I Image name +int acmode #I Access mode +int hdr_arg #I Header argument +int index #I Save index +int retry #I Retry counter +pointer im #O Image pointer (returned) + +int i, envgeti() +pointer xt, xt_opix() +errchk xt_opix + +int first_time +data first_time /YES/ + +include "xtimmap.com" + +begin + if (acmode != READ_ONLY) + call error (1, "XT_IMMAP: Only READ_ONLY allowed") + + # Set maximum number of open images based on retry. + if (retry > 0) + max_openim = min (1024, MAX_OPENIM) / retry + else + max_openim = MAX_OPENIM + + # Initialize once per process. + if (first_time == YES) { + iferr (option = envgeti ("imcombine_option")) + option = 1 + min_open = 1 + nopen = 0 + nopenpix = 0 + nalloc = max_openim + call calloc (ims, nalloc, TY_POINTER) + first_time = NO + } + + # Free image if needed. + call xt_imunmap (NULL, index) + + # Allocate structure. + if (index > nalloc) { + i = nalloc + nalloc = index + max_openim + call realloc (ims, nalloc, TY_STRUCT) + call amovki (NULL, Memi[ims+i], nalloc-i) + } + call calloc (xt, XT_LEN, TY_STRUCT) + Memi[ims+index-1] = xt + + # Initialize. + call strcpy (imname, XT_IMNAME(xt), XT_SZIMNAME) + XT_ARG(xt) = hdr_arg + XT_IM(xt) = NULL + XT_HDR(xt) = NULL + + # Open image. + last_flag = 0 + im = xt_opix (NULL, index, 0) + + # Make copy of IMIO pointer for header keyword access. + call malloc (XT_HDR(xt), LEN_IMDES+IM_HDRLEN(im)+1, TY_STRUCT) + call amovi (Memi[im], Memi[XT_HDR(xt)], LEN_IMDES) + call amovi (IM_MAGIC(im), IM_MAGIC(XT_HDR(xt)), IM_HDRLEN(im)+1) + + return (XT_HDR(xt)) +end + + +# XT_OPIX -- Open the image for I/O. +# If the image has not been mapped return the default pointer. + +pointer procedure xt_opix (imdef, index, flag) + +int index #I index +pointer imdef #I Default pointer +int flag #I Flag + +int i, open(), imstati() +pointer im, xt, xt1, immap() +errchk open, immap, imunmap + +include "xtimmap.com" + +begin + # Get index pointer. + xt = NULL + if (index <= nalloc && index > 0) + xt = Memi[ims+index-1] + + # Use default pointer if index has not been mapped. + if (xt == NULL) + return (imdef) + + # Close images not accessed during previous line. + # In normal usage this should only occur once per line over all + # indexed images. + if (flag != last_flag) { + do i = 1, nalloc { + xt1 = Memi[ims+i-1] + if (xt1 == NULL) + next + im = XT_IM(xt1) + if (im == NULL || XT_FLAG(xt1) == last_flag) + next + if (VERBOSE) { + call eprintf ("%d: xt_opix imunmap %s\n") + call pargi (i) + call pargstr (XT_IMNAME(xt1)) + } + call imunmap (XT_IM(xt1)) + call mfree (XT_BUF(xt1), XT_BTYPE(xt1)) + nopen = nopen - 1 + if (XT_CLOSEFD(xt1) == NO) + nopenpix = nopenpix - 1 + } + + # Optimize the file I/O. + do i = nalloc, 1, -1 { + xt1 = Memi[ims+i-1] + if (xt1 == NULL) + next + im = XT_IM(xt1) + if (im == NULL) + next + min_open = i + if (nopenpix < MAX_OPENPIX) { + if (XT_CLOSEFD(xt1) == NO) + next + XT_CLOSEFD(xt1) = NO + call imseti (im, IM_CLOSEFD, NO) + nopenpix = nopenpix + 1 + } + } + last_flag = flag + } + + # Return pointer for already opened images. + im = XT_IM(xt) + if (im != NULL) { + XT_FLAG(xt) = flag + return (im) + } + + # Handle more images than the maximum that can be open at one time. + if (nopen >= max_openim) { + if (option == XT_MAPUNMAP || flag == 0) { + do i = min_open, nalloc { + xt1 = Memi[ims+i-1] + if (xt1 == NULL) + next + im = XT_IM(xt1) + if (im == NULL) + next + if (VERBOSE) { + call eprintf ("%d: imunmap %s\n") + call pargi (i) + call pargstr (XT_IMNAME(xt1)) + } + call imunmap (XT_IM(xt1)) + nopen = nopen - 1 + if (XT_CLOSEFD(xt1) == NO) + nopenpix = nopenpix - 1 + min_open = i + 1 + break + } + if (index <= min_open) + min_open = index + else { + do i = min_open, nalloc { + xt1 = Memi[ims+i-1] + if (xt1 == NULL) + next + im = XT_IM(xt1) + if (im == NULL) + next + min_open = i + break + } + } + } else { + # Check here because we can't catch error in immap. + i = open ("dev$null", READ_ONLY, BINARY_FILE) + call close (i) + if (i == LAST_FD - 1) + call error (SYS_FTOOMANYFILES, "Too many open files") + } + } + + # Open image. + if (VERBOSE) { + call eprintf ("%d: xt_opix immap %s\n") + call pargi (index) + call pargstr (XT_IMNAME(xt)) + } + im = immap (XT_IMNAME(xt), READ_ONLY, XT_ARG(xt)) + XT_IM(xt) = im + if (!IS_INDEFI(XT_BUFSIZE(xt))) + call imseti (im, IM_BUFSIZE, XT_BUFSIZE(xt)) + else + XT_BUFSIZE(xt) = imstati (im, IM_BUFSIZE) + nopen = nopen + 1 + XT_CLOSEFD(xt) = YES + if (nopenpix < MAX_OPENPIX) { + XT_CLOSEFD(xt) = NO + nopenpix = nopenpix + 1 + } + if (XT_CLOSEFD(xt) == YES) + call imseti (im, IM_CLOSEFD, YES) + XT_FLAG(xt) = flag + + return (im) +end + + +# XT_CPIX -- Close image. + +procedure xt_cpix (index) + +int index #I index + +pointer xt +errchk imunmap + +include "xtimmap.com" + +begin + xt = NULL + if (index <= nalloc && index > 0) + xt = Memi[ims+index-1] + + if (xt == NULL) + return + + if (XT_IM(xt) != NULL) { + if (VERBOSE) { + call eprintf ("%d: xt_cpix imunmap %s\n") + call pargi (index) + call pargstr (XT_IMNAME(xt)) + } + call imunmap (XT_IM(xt)) + nopen = nopen - 1 + if (XT_CLOSEFD(xt) == NO) + nopenpix = nopenpix - 1 + } + call mfree (XT_BUF(xt), XT_BTYPE(xt)) +end + + +# XT_IMSETI -- Set IMIO value. + +procedure xt_imseti (index, param, value) + +int index #I index +int param #I IMSET parameter +int value #I Value + +pointer xt +bool streq() + +include "xtimmap.com" + +begin + xt = NULL + if (index <= nalloc && index > 0) + xt = Memi[ims+index-1] + + if (xt == NULL) { + if (streq (param, "option")) + option = value + } else { + if (streq (param, "bufsize")) { + XT_BUFSIZE(xt) = value + if (XT_IM(xt) != NULL) { + call imseti (XT_IM(xt), IM_BUFFRAC, 0) + call imseti (XT_IM(xt), IM_BUFSIZE, value) + } + } + } +end + + +# XT_IMUNMAP -- Unmap indexed open image. +# The header pointer is set to NULL to indicate the image has been closed. + +procedure xt_imunmap (im, index) + +int im #U IMIO header pointer +int index #I index + +pointer xt +errchk imunmap + +include "xtimmap.com" + +begin + # Check for an indexed image. If it is not unmap the pointer + # as a regular IMIO pointer. + + xt = NULL + if (index <= nalloc && index > 0) + xt = Memi[ims+index-1] + if (xt == NULL) { + if (im != NULL) + call imunmap (im) + return + } + + # Close indexed image. + if (XT_IM(xt) != NULL) { + if (VERBOSE) { + call eprintf ("%d: xt_imunmap imunmap %s\n") + call pargi (index) + call pargstr (XT_IMNAME(xt)) + } + iferr (call imunmap (XT_IM(xt))) { + XT_IM(xt) = NULL + call erract (EA_WARN) + } + nopen = nopen - 1 + if (XT_CLOSEFD(xt) == NO) + nopenpix = nopenpix - 1 + if (index == min_open) + min_open = 1 + } + + # Free any buffered memory. + call mfree (XT_BUF(xt), XT_BTYPE(xt)) + + # Free header pointer. Note that if the supplied pointer is not + # header pointer then it is not set to NULL. + if (XT_HDR(xt) == im) + im = NULL + call mfree (XT_HDR(xt), TY_STRUCT) + + # Free save structure. + call mfree (Memi[ims+index-1], TY_STRUCT) + Memi[ims+index-1] = NULL +end + + +# XT_MINHDR -- Minimize header assuming keywords will not be accessed. + +procedure xt_minhdr (index) + +int index #I index + +pointer xt +errchk realloc + +include "xtimmap.com" + +begin + # Check for an indexed image. If it is not unmap the pointer + # as a regular IMIO pointer. + + xt = NULL + if (index <= nalloc && index > 0) + xt = Memi[ims+index-1] + if (xt == NULL) + return + + # Minimize header pointer. + if (VERBOSE) { + call eprintf ("%d: xt_minhdr %s\n") + call pargi (index) + call pargstr (XT_IMNAME(xt)) + } + call realloc (XT_HDR(xt), IMU+1, TY_STRUCT) + if (XT_IM(xt) != NULL) + call realloc (XT_IM(xt), IMU+1, TY_STRUCT) +end + + +# XT_REINDEX -- Reindex open images. +# This is used when some images are closed by xt_imunmap. It is up to +# the calling program to reindex the header pointers and to subsequently +# use the new index values. + +procedure xt_reindex () + +int old, new + +include "xtimmap.com" + +begin + new = 0 + do old = 0, nalloc-1 { + if (Memi[ims+old] == NULL) + next + Memi[ims+new] = Memi[ims+old] + new = new + 1 + } + do old = new, nalloc-1 + Memi[ims+old] = NULL +end + + +$for(sird) +# XT_IMGNL -- Return the next line for the indexed image. +# Possibly unmap another image if too many files are open. +# Buffer data when an image is unmmaped to minimize the mapping of images. +# If the requested index has not been mapped use the default pointer. + +int procedure xt_imgnl$t (imdef, index, buf, v, flag) + +pointer imdef #I Default pointer +int index #I index +pointer buf #O Data buffer +long v[ARB] #I Line vector +int flag #I Flag (=output line) + +int i, j, nc, nl, open(), imgnl$t(), sizeof(), imloop() +pointer im, xt, xt1, ptr, immap(), imggs$t() +errchk open, immap, imgnl$t, imggs$t, imunmap + +long unit_v[IM_MAXDIM] +data unit_v /IM_MAXDIM * 1/ + +include "xtimmap.com" + +begin + # Get index pointer. + xt = NULL + if (index <= nalloc && index > 0) + xt = Memi[ims+index-1] + + # Use default pointer if index has not been mapped. + if (xt == NULL) + return (imgnl$t (imdef, buf, v)) + + # Close images not accessed during previous line. + # In normal usage this should only occur once per line over all + # indexed images. + if (flag != last_flag) { + do i = 1, nalloc { + xt1 = Memi[ims+i-1] + if (xt1 == NULL) + next + im = XT_IM(xt1) + if (im == NULL || XT_FLAG(xt1) == last_flag) + next + if (VERBOSE) { + call eprintf ("%d: xt_imgnl imunmap %s\n") + call pargi (i) + call pargstr (XT_IMNAME(xt1)) + } + call imunmap (XT_IM(xt1)) + call mfree (XT_BUF(xt1), XT_BTYPE(xt1)) + nopen = nopen - 1 + if (XT_CLOSEFD(xt1) == NO) + nopenpix = nopenpix - 1 + } + + # Optimize the file I/O. + do i = nalloc, 1, -1 { + xt1 = Memi[ims+i-1] + if (xt1 == NULL) + next + im = XT_IM(xt1) + if (im == NULL) + next + min_open = i + if (nopenpix < MAX_OPENPIX) { + if (XT_CLOSEFD(xt1) == NO) + next + XT_CLOSEFD(xt1) = NO + call imseti (im, IM_CLOSEFD, NO) + nopenpix = nopenpix + 1 + } + } + last_flag = flag + } + + # Use IMIO for already opened images. + im = XT_IM(xt) + if (im != NULL) { + XT_FLAG(xt) = flag + return (imgnl$t (im, buf, v)) + } + + # If the image is not currently mapped use the stored header. + im = XT_HDR(xt) + + # Check for EOF. + i = IM_NDIM(im) + if (v[i] > IM_LEN(im,i)) + return (EOF) + + # Check for buffered data. + if (XT_BUF(xt) != NULL) { + if (v[2] >= XT_VS(xt,2) && v[2] <= XT_VE(xt,2)) { + if (XT_BTYPE(xt) != TY_PIXEL) + call error (1, "Cannot mix data types") + nc = IM_LEN(im,1) + buf = XT_BUF(xt) + (v[2]-XT_VS(xt,2)) * IM_LEN(im,1) + XT_FLAG(xt) = flag + if (i == 1) + v[1] = nc + 1 + else + j = imloop (v, unit_v, IM_LEN(im,1), unit_v, i) + return (nc) + } + } + + # Handle more images than the maximum that can be open at one time. + if (nopen >= max_openim) { + if (option == XT_MAPUNMAP || v[2] == 0) { + do i = min_open, nalloc { + xt1 = Memi[ims+i-1] + if (xt1 == NULL) + next + im = XT_IM(xt1) + if (im == NULL) + next + + # Buffer some number of lines. + nl = XT_BUFSIZE(xt1) / sizeof (TY_PIXEL) / IM_LEN(im,1) + if (nl > 1) { + nc = IM_LEN(im,1) + call amovl (v, XT_VS(xt1,1), IM_MAXDIM) + call amovl (v, XT_VE(xt1,1), IM_MAXDIM) + XT_VS(xt1,1) = 1 + XT_VE(xt1,1) = nc + XT_VE(xt1,2) = min (XT_VS(xt1,2)+(nl-1), IM_LEN(im,2)) + nl = XT_VE(xt1,2) - XT_VS(xt1,2) + 1 + XT_BTYPE(xt1) = TY_PIXEL + call malloc (XT_BUF(xt1), nl*nc, XT_BTYPE(xt1)) + ptr = imggs$t (im, XT_VS(xt1,1), XT_VE(xt1,1), + IM_NDIM(im)) + call amov$t (Mem$t[ptr], Mem$t[XT_BUF(xt1)], nl*nc) + } + + if (VERBOSE) { + call eprintf ("%d: xt_imgnl imunmap %s\n") + call pargi (i) + call pargstr (XT_IMNAME(xt1)) + } + call imunmap (XT_IM(xt1)) + nopen = nopen - 1 + if (XT_CLOSEFD(xt1) == NO) + nopenpix = nopenpix - 1 + min_open = i + 1 + break + } + if (index <= min_open) + min_open = index + else { + do i = min_open, nalloc { + xt1 = Memi[ims+i-1] + if (xt1 == NULL) + next + if (XT_IM(xt1) == NULL) + next + min_open = i + break + } + } + } else { + # Check here because we can't catch error in immap. + i = open ("dev$null", READ_ONLY, BINARY_FILE) + call close (i) + if (i == LAST_FD - 1) + call error (SYS_FTOOMANYFILES, "Too many open files") + } + } + + # Open image. + if (VERBOSE) { + call eprintf ("%d: xt_imgnl immap %s\n") + call pargi (index) + call pargstr (XT_IMNAME(xt)) + } + im = immap (XT_IMNAME(xt), READ_ONLY, XT_ARG(xt)) + XT_IM(xt) = im + call imseti (im, IM_BUFSIZE, XT_BUFSIZE(xt)) + call mfree (XT_BUF(xt), XT_BTYPE(xt)) + nopen = nopen + 1 + XT_CLOSEFD(xt) = YES + if (nopenpix < MAX_OPENPIX) { + XT_CLOSEFD(xt) = NO + nopenpix = nopenpix + 1 + } + if (XT_CLOSEFD(xt) == YES) + call imseti (im, IM_CLOSEFD, YES) + XT_FLAG(xt) = flag + + return (imgnl$t (im, buf, v)) +end +$endfor diff --git a/pkg/images/immatch/src/imcombine/src/xtprocid.x b/pkg/images/immatch/src/imcombine/src/xtprocid.x new file mode 100644 index 00000000..0a82d81b --- /dev/null +++ b/pkg/images/immatch/src/imcombine/src/xtprocid.x @@ -0,0 +1,38 @@ +# XT_PROCID -- Set or ppdate PROCID keyword. + +procedure xt_procid (im) + +pointer im #I Image header + +int i, j, ver, patmake(), gpatmatch(), strlen(), ctoi() +pointer sp, pat, str + +begin + call smark (sp) + call salloc (pat, SZ_LINE, TY_CHAR) + call salloc (str, SZ_FNAME, TY_CHAR) + + # Get current ID. + iferr (call imgstr (im, "PROCID", Memc[str], SZ_LINE)) { + iferr (call imgstr (im, "OBSID", Memc[str], SZ_LINE)) { + call sfree (sp) + return + } + } + + # Set new PROCID. + ver = 0 + i = patmake ("V[0-9]*$", Memc[pat], SZ_LINE) + if (gpatmatch (Memc[str], Memc[pat], i, j) == 0) + ; + if (j > 0) { + j = i+1 + if (ctoi (Memc[str], j, ver) == 0) + ver = 0 + i = i - 1 + } else + i = strlen (Memc[str]) + call sprintf (Memc[str+i], SZ_LINE, "V%d") + call pargi (ver+1) + call imastr (im, "PROCID", Memc[str]) +end diff --git a/pkg/images/immatch/src/imcombine/t_imcombine.x b/pkg/images/immatch/src/imcombine/t_imcombine.x new file mode 100644 index 00000000..d3774958 --- /dev/null +++ b/pkg/images/immatch/src/imcombine/t_imcombine.x @@ -0,0 +1,230 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <error.h> +include <mach.h> +include <imhdr.h> +include "src/icombine.h" + + +# T_IMCOMBINE - This task combines a list of images into an output image +# and an optional sigma image. There are many combining options from +# which to choose. + +procedure t_imcombine () + +pointer sp, fname, output, headers, bmask, rmask, sigma, nrmask, emask, logfile +pointer scales, zeros, wts, im +int n, input, ilist, olist, hlist, blist, rlist, slist, nrlist, elist + +bool clgetb() +real clgetr() +int clgwrd(), clgeti(), imtopenp(), imtopen(), imtgetim(), imtlen() +pointer immap() +errchk immap, icombine + +include "src/icombine.com" + +begin + call smark (sp) + call salloc (fname, SZ_FNAME, TY_CHAR) + call salloc (output, SZ_FNAME, TY_CHAR) + call salloc (headers, SZ_FNAME, TY_CHAR) + call salloc (bmask, SZ_FNAME, TY_CHAR) + call salloc (rmask, SZ_FNAME, TY_CHAR) + call salloc (nrmask, SZ_FNAME, TY_CHAR) + call salloc (emask, SZ_FNAME, TY_CHAR) + call salloc (sigma, SZ_FNAME, TY_CHAR) + call salloc (expkeyword, SZ_FNAME, TY_CHAR) + call salloc (statsec, SZ_FNAME, TY_CHAR) + call salloc (gain, SZ_FNAME, TY_CHAR) + call salloc (rdnoise, SZ_FNAME, TY_CHAR) + call salloc (snoise, SZ_FNAME, TY_CHAR) + call salloc (logfile, SZ_FNAME, TY_CHAR) + + # Get task parameters. Some additional parameters are obtained later. + ilist = imtopenp ("input") + olist = imtopenp ("output") + hlist = imtopenp ("headers") + blist = imtopenp ("bpmasks") + rlist = imtopenp ("rejmasks") + nrlist = imtopenp ("nrejmasks") + elist = imtopenp ("expmasks") + slist = imtopenp ("sigmas") + call clgstr ("logfile", Memc[logfile], SZ_FNAME) + + project = clgetb ("project") + combine = clgwrd ("combine", Memc[fname], SZ_FNAME, COMBINE) + if (combine == MEDIAN || combine == LMEDIAN) { + if (combine == MEDIAN) + medtype = MEDAVG + else { + medtype = MEDLOW + combine = MEDIAN + } + } + reject = clgwrd ("reject", Memc[fname], SZ_FNAME, REJECT) + blank = clgetr ("blank") + call clgstr ("expname", Memc[expkeyword], SZ_FNAME) + call clgstr ("statsec", Memc[statsec], SZ_FNAME) + 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") + pclip = clgetr ("pclip") + flow = clgetr ("nlow") + fhigh = clgetr ("nhigh") + nkeep = clgeti ("nkeep") + grow = clgetr ("grow") + mclip = clgetb ("mclip") + sigscale = clgetr ("sigscale") + verbose = false + + # Check lists. + n = imtlen (ilist) + if (n == 0) + call error (1, "No input images to combine") + + if (project) { + if (imtlen (olist) != n) + call error (1, "Wrong number of output images") + if (imtlen (hlist) != 0 && imtlen (hlist) != n) + call error (1, "Wrong number of header files") + if (imtlen (blist) != 0 && imtlen (blist) != n) + call error (1, "Wrong number of bad pixel masks") + if (imtlen (rlist) != 0 && imtlen (rlist) != n) + call error (1, "Wrong number of rejection masks") + if (imtlen (nrlist) > 0 && imtlen (nrlist) != n) + call error (1, "Wrong number of number rejected masks") + if (imtlen (elist) > 0 && imtlen (elist) != n) + call error (1, "Wrong number of exposure masks") + if (imtlen (slist) > 0 && imtlen (slist) != n) + call error (1, "Wrong number of sigma images") + } else { + if (imtlen (olist) != 1) + call error (1, "Wrong number of output images") + if (imtlen (hlist) > 1) + call error (1, "Wrong number of header files") + if (imtlen (blist) > 1) + call error (1, "Wrong number of bad pixel masks") + if (imtlen (rlist) > 1) + call error (1, "Wrong number of rejection masks") + if (imtlen (nrlist) > 1) + call error (1, "Wrong number of number rejected masks") + if (imtlen (elist) > 1) + call error (1, "Wrong number of exposure masks") + if (imtlen (slist) > 1) + call error (1, "Wrong number of sigma images") + } + + # Check parameters, map INDEFs, and set threshold flag + if (pclip == 0. && reject == PCLIP) + call error (1, "Pclip parameter may not be zero") + if (IS_INDEFR (blank)) + blank = 0. + if (IS_INDEFR (lsigma)) + lsigma = MAX_REAL + if (IS_INDEFR (hsigma)) + hsigma = MAX_REAL + if (IS_INDEFR (pclip)) + pclip = -0.5 + if (IS_INDEFR (flow)) + flow = 0 + if (IS_INDEFR (fhigh)) + fhigh = 0 + if (IS_INDEFR (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 + } + + # Loop through image lists. + while (imtgetim (ilist, Memc[fname], SZ_FNAME) != EOF) { + iferr { + scales = NULL; input = ilist + + if (imtgetim (olist, Memc[output], SZ_FNAME) == EOF) { + if (project) { + call sprintf (Memc[output], SZ_FNAME, + "IMCOMBINE: No output image for %s") + call pargstr (Memc[fname]) + call error (1, Memc[output]) + } else + call error (1, "IMCOMBINE: No output image") + } + if (imtgetim (hlist, Memc[headers], SZ_FNAME) == EOF) + Memc[headers] = EOS + if (imtgetim (blist, Memc[bmask], SZ_FNAME) == EOF) + Memc[bmask] = EOS + if (imtgetim (rlist, Memc[rmask], SZ_FNAME) == EOF) + Memc[rmask] = EOS + if (imtgetim (nrlist, Memc[nrmask], SZ_FNAME) == EOF) + Memc[nrmask] = EOS + if (imtgetim (elist, Memc[emask], SZ_FNAME) == EOF) + Memc[emask] = EOS + if (imtgetim (slist, Memc[sigma], SZ_FNAME) == EOF) + Memc[sigma] = EOS + + # Set the input list and initialize the scaling factors. + if (project) { + im = immap (Memc[fname], READ_ONLY, 0) + if (IM_NDIM(im) == 1) + n = 0 + else + n = IM_LEN(im,IM_NDIM(im)) + call imunmap (im) + if (n == 0) { + call sprintf (Memc[output], SZ_FNAME, + "IMCOMBINE: Can't project one dimensional image %s") + call pargstr (Memc[fname]) + call error (1, Memc[output]) + } + input = imtopen (Memc[fname]) + } else { + call imtrew (ilist) + n = imtlen (ilist) + input = ilist + } + + # Allocate and initialize scaling factors. + call malloc (scales, 3*n, TY_REAL) + zeros = scales + n + wts = scales + 2 * n + call amovkr (INDEFR, Memr[scales], 3*n) + + call icombine (input, Memc[output], Memc[headers], Memc[bmask], + Memc[rmask], Memc[nrmask], Memc[emask], Memc[sigma], + Memc[logfile], Memr[scales], Memr[zeros], Memr[wts], + NO, NO, NO) + + } then + call erract (EA_WARN) + + if (input != ilist) + call imtclose (input) + call mfree (scales, TY_REAL) + if (!project) + break + } + + call imtclose (ilist) + call imtclose (olist) + call imtclose (hlist) + call imtclose (blist) + call imtclose (rlist) + call imtclose (nrlist) + call imtclose (elist) + call imtclose (slist) + call sfree (sp) +end diff --git a/pkg/images/immatch/src/imcombine/x_imcombine.x b/pkg/images/immatch/src/imcombine/x_imcombine.x new file mode 100644 index 00000000..a85e34f6 --- /dev/null +++ b/pkg/images/immatch/src/imcombine/x_imcombine.x @@ -0,0 +1 @@ +task imcombine = t_imcombine diff --git a/pkg/images/immatch/src/linmatch/linmatch.h b/pkg/images/immatch/src/linmatch/linmatch.h new file mode 100644 index 00000000..0f776901 --- /dev/null +++ b/pkg/images/immatch/src/linmatch/linmatch.h @@ -0,0 +1,298 @@ +# Header file for LINSCALE + +define LEN_LSSTRUCT (70 + 12 * SZ_FNAME + 12) + +# Quantities that define the current region and the number of regions + +define LS_CNREGION Memi[$1] # the current region +define LS_NREGIONS Memi[$1+1] # the number of regions +define LS_MAXNREGIONS Memi[$1+2] # the maximum number of regions + +# Quantities that are dependent on the number of regions + +define LS_RC1 Memi[$1+3] # pointers to first columns of regions +define LS_RC2 Memi[$1+4] # pointers to last columns of regions +define LS_RL1 Memi[$1+5] # pointer to first lines of regions +define LS_RL2 Memi[$1+6] # pointers to last lines of regions +define LS_RXSTEP Memi[$1+7] # pointers to the x step sizes +define LS_RYSTEP Memi[$1+8] # pointers to the y step sizes +define LS_XSHIFT Memr[P2R($1+9)] # the x shift from image to reference +define LS_YSHIFT Memr[P2R($1+10)] # the y shift from image to reference +define LS_SXSHIFT Memr[P2R($1+11)] # the x shift from image to reference +define LS_SYSHIFT Memr[P2R($1+12)] # the y shift from image to reference + +define LS_RBUF Memi[$1+14] # pointer to the reference image data +define LS_RGAIN Memr[P2R($1+15)] # the reference image gain +define LS_RREADNOISE Memr[P2R($1+16)] # the reference image readout noise +define LS_RMEAN Memi[$1+17] # pointers to means of ref regions +define LS_RMEDIAN Memi[$1+18] # pointers to medians of ref regions +define LS_RMODE Memi[$1+19] # pointers to modes of ref regions +define LS_RSIGMA Memi[$1+20] # pointers to stdevs of ref regions +define LS_RSKY Memi[$1+21] # pointers to sky values of ref regions +define LS_RSKYERR Memi[$1+22] # pointers to sky errors of ref regions +define LS_RMAG Memi[$1+23] # pointers to magnitudes of ref regions +define LS_RMAGERR Memi[$1+24] # pointers to mag errors of ref regions +define LS_RNPTS Memi[$1+25] # pointers to npts of ref regions + +define LS_IBUF Memi[$1+27] # pointer to the input image data +define LS_IGAIN Memr[P2R($1+28)] # the input image gain +define LS_IREADNOISE Memr[P2R($1+29)] # the input image readout noise +define LS_IMEAN Memi[$1+30] # pointers to means of image regions +define LS_IMEDIAN Memi[$1+31] # pointers to medians of image regions +define LS_IMODE Memi[$1+32] # pointers to modes of image regions +define LS_ISIGMA Memi[$1+33] # pointers to stdevs of image regions +define LS_ISKY Memi[$1+34] # pointers to sky values of image regions +define LS_ISKYERR Memi[$1+35] # pointers to sky errors of image regions +define LS_IMAG Memi[$1+36] # pointers to magnitudes of image regions +define LS_IMAGERR Memi[$1+37] # pointers to mag errors of image regions +define LS_INPTS Memi[$1+38] # pointers to npts of image regions + +define LS_RBSCALE Memi[$1+39] # pointers to bscales of regions +define LS_RBSCALEERR Memi[$1+40] # pointers to bscale errors of regions +define LS_RBZERO Memi[$1+41] # pointers to bzero errors of regions +define LS_RBZEROERR Memi[$1+42] # pointers to bzero errors of regions +define LS_RDELETE Memi[$1+43] # pointer to the delete array +define LS_RCHI Memi[$1+44] # pointer to the resid array + +# Quantities that affect the fitting algorithms + +define LS_BSALGORITHM Memi[$1+45] # bscale fitting algorithm +define LS_BZALGORITHM Memi[$1+46] # bzero fitting algorithm +define LS_CBZERO Memr[P2R($1+47)] # constant bzero +define LS_CBSCALE Memr[P2R($1+48)] # constant bscale +define LS_DNX Memi[$1+49] # x width of data region to extract +define LS_DNY Memi[$1+50] # y width of data region to extract +#define LS_PNX Memi[$1+51] # x width of photometry region +#define LS_PNY Memi[$1+52] # y widht of photometry region +define LS_DATAMIN Memr[P2R($1+51)] # the minimum good data value +define LS_DATAMAX Memr[P2R($1+52)] # the maximum good data value +define LS_MAXITER Memi[$1+53] # maximum number of iterations +define LS_NREJECT Memi[$1+54] # maximum number of rejections cycles +define LS_LOREJECT Memr[P2R($1+55)] # low-side sigma rejection criterion +define LS_HIREJECT Memr[P2R($1+56)] # high-side sigma rejection criterion +define LS_GAIN Memr[P2R($1+57)] # the constant gain value in e-/adu +define LS_READNOISE Memr[P2R($1+58)] # the constant readout noise value in e- + +# Quantities that define the answers + +define LS_TBSCALE Memr[P2R($1+59)] # bzero value +define LS_TBSCALEERR Memr[P2R($1+60)] # bscale error estimate +define LS_TBZERO Memr[P2R($1+61)] # bzero value +define LS_TBZEROERR Memr[P2R($1+62)] # bzero error estimate + +# String quantities + +define LS_BSSTRING Memc[P2C($1+65)] # bscale string +define LS_BZSTRING Memc[P2C($1+65+SZ_FNAME+1)] # bzero string +define LS_CCDGAIN Memc[P2C($1+65+2*SZ_FNAME+2)] # gain keyword +define LS_CCDREAD Memc[P2C($1+65+3*SZ_FNAME+3)] # readout noise keyword +define LS_IMAGE Memc[P2C($1+65+4*SZ_FNAME+4)] # input image +define LS_REFIMAGE Memc[P2C($1+65+5*SZ_FNAME+5)] # reference image +define LS_REGIONS Memc[P2C($1+65+6*SZ_FNAME+6)] # regions list +define LS_DATABASE Memc[P2C($1+65+7*SZ_FNAME+7)] # database file +define LS_OUTIMAGE Memc[P2C($1+65+8*SZ_FNAME+8)] # output image +define LS_SHIFTSFILE Memc[P2C($1+65+9*SZ_FNAME+9)] # shifts file +define LS_PHOTFILE Memc[P2C($1+65+10*SZ_FNAME+10)] # shifts file +define LS_RECORD Memc[P2C($1+65+11*SZ_FNAME+11)] # the record name + + +# Define the bzero and bscale fitting algorithms + +define LS_MEAN 1 +define LS_MEDIAN 2 +define LS_MODE 3 +define LS_FIT 4 +define LS_PHOTOMETRY 5 +define LS_FILE 6 +define LS_NUMBER 7 + +define LS_SCALING "|mean|median|mode|fit|photometry|file|" + +# Define the parameters + +define CNREGION 1 +define NREGIONS 2 +define MAXNREGIONS 3 + +define RC1 4 +define RC2 5 +define RL1 6 +define RL2 7 +define RXSTEP 8 +define RYSTEP 9 +define XSHIFT 10 +define YSHIFT 11 +define SXSHIFT 12 +define SYSHIFT 13 + +define RBUF 14 +define RGAIN 15 +define RREADNOISE 16 +define RMEAN 17 +define RMEDIAN 18 +define RMODE 19 +define RSIGMA 20 +define RSKY 21 +define RSKYERR 22 +define RMAG 23 +define RMAGERR 24 +define RNPTS 25 + +define IBUF 26 +define IGAIN 27 +define IREADNOISE 28 +define IMEAN 29 +define IMEDIAN 30 +define IMODE 31 +define ISIGMA 32 +define ISKY 33 +define ISKYERR 34 +define IMAG 35 +define IMAGERR 36 +define INPTS 37 + +define RBSCALE 38 +define RBSCALEERR 39 +define RBZERO 40 +define RBZEROERR 41 +define RDELETE 42 +define RCHI 43 + +define BZALGORITHM 44 +define BSALGORITHM 45 +define CBZERO 46 +define CBSCALE 47 +define DNX 48 +define DNY 49 +#define PNX 50 +#define PNY 51 +define DATAMIN 50 +define DATAMAX 51 +define MAXITER 52 + +define NREJECT 53 +define LOREJECT 54 +define HIREJECT 55 +define GAIN 56 +define READNOISE 57 + +define TBZERO 58 +define TBZEROERR 59 +define TBSCALE 60 +define TBSCALEERR 61 + +define BSSTRING 62 +define BZSTRING 63 +define CCDGAIN 64 +define CCDREAD 65 + +define IMAGE 66 +define REFIMAGE 67 +define REGIONS 68 +define DATABASE 69 +define OUTIMAGE 70 +define RECORD 71 +define SHIFTSFILE 72 +define PHOTFILE 73 + +# Set some default values + +define DEF_MAXNREGIONS 100 +define DEF_BZALGORITHM LS_FIT +define DEF_BSALGORITHM LS_FIT +define DEF_CBZERO 0.0 +define DEF_CBSCALE 1.0 +define DEF_DNX 31 +define DEF_DNY 31 +define DEF_MAXITER 10 +define DEF_DATAMIN INDEFR +define DEF_DATAMAX INDEFR +define DEF_NREJECT 0 +define DEF_LOREJECT INDEFR +define DEF_HIREJECT INDEFR +define DEF_GAIN INDEFR +define DEF_READNOISE INDEFR + +# The mode computation parameters. + +define LMODE_NMIN 10 +define LMODE_ZRANGE 1.0 +define LMODE_ZBIN 0.1 +define LMODE_ZSTEP 0.01 +define LMODE_HWIDTH 3.0 + +# The default plot types. + +define LS_MMHIST 1 +define LS_MMFIT 2 +define LS_MMRESID 3 +define LS_RIFIT 4 +define LS_RIRESID 5 +define LS_BSZFIT 6 +define LS_BSZRESID 7 +define LS_MAGSKYFIT 8 +define LS_MAGSKYRESID 9 + +# The bad point deletions code. + +define LS_NO 0 +define LS_BADREGION 1 +define LS_BADSIGMA 2 +define LS_DELETED 3 + +# Commands + +define LSCMDS "|input|reference|regions|lintransform|output|photfile|\ +shifts|records|xshift|yshift|dnx|dny|maxnregions|datamin|datamax|\ +maxiter|nreject|loreject|hireject|gain|readnoise|show|markcoords|marksections|" + +define LSCMD_IMAGE 1 +define LSCMD_REFIMAGE 2 +define LSCMD_REGIONS 3 +define LSCMD_DATABASE 4 +define LSCMD_OUTIMAGE 5 +define LSCMD_PHOTFILE 6 +define LSCMD_SHIFTSFILE 7 +define LSCMD_RECORD 8 +define LSCMD_XSHIFT 9 +define LSCMD_YSHIFT 10 +define LSCMD_DNX 11 +define LSCMD_DNY 12 +define LSCMD_MAXNREGIONS 13 +define LSCMD_DATAMIN 14 +define LSCMD_DATAMAX 15 +define LSCMD_MAXITER 16 +define LSCMD_NREJECT 17 +define LSCMD_LOREJECT 18 +define LSCMD_HIREJECT 19 +define LSCMD_GAIN 20 +define LSCMD_READNOISE 21 +define LSCMD_SHOW 22 +define LSCMD_MARKCOORDS 23 +define LSCMD_MARKSECTIONS 24 + +# Keywords + +define KY_REFIMAGE "reference" +define KY_IMAGE "input" +define KY_REGIONS "regions" +define KY_DATABASE "lintransform" +define KY_OUTIMAGE "output" +define KY_PHOTFILE "photfile" +define KY_SHIFTSFILE "shifts" +define KY_RECORD "records" +define KY_XSHIFT "xshift" +define KY_YSHIFT "yshift" +define KY_DNX "dnx" +define KY_DNY "dny" +define KY_MAXNREGIONS "maxnregions" +define KY_DATAMIN "datamin" +define KY_DATAMAX "datamax" +define KY_MAXITER "maxiter" +define KY_NREJECT "nreject" +define KY_LOREJECT "loreject" +define KY_HIREJECT "hireject" +define KY_GAIN "gain" +define KY_READNOISE "readnoise" +define KY_NREGIONS "nregions" + diff --git a/pkg/images/immatch/src/linmatch/linmatch.key b/pkg/images/immatch/src/linmatch/linmatch.key new file mode 100644 index 00000000..824f6b26 --- /dev/null +++ b/pkg/images/immatch/src/linmatch/linmatch.key @@ -0,0 +1,51 @@ + Interactive Keystroke Commands + +? Print help +: Colon commands + +g Draw a plot of the current fit +i Draw the residuals plot for the current fit +p Draw a plot of current photometry +s Draw histograms for the image region nearest the cursor +l Draw the least squares fit for the image region nearest the cursor +h Draw histogram plot of each image region in turn +l Draw least squares fits plot of each image region in turn +r Redraw the current plot +d Delete the image region nearest the cursor +u Undelete the image region nearest the cursor +f Recompute the intensity matching function +w Update the task parameters +q Exit + + + Colon Commands + +:markcoords Mark objects on the display +:marksections Mark image sections on the display +:show Show current values of all the parameters + + Show/set Parameters + +:input [string] Show/set the current input image +:reference [string] Show/set the current reference image / phot file +:regions [string] Show/set the current image regions +:photfile [string] Show/set the current input photometry file +:lintransform [string] Show/set the linear transform database file name +:dnx [value] Show/set the default x size of an image region +:dny [value] Show/set the default y size of an image region +:shifts [string] Show/set the current shifts file +:xshift [value] Show/set the input image x shift +:yshift [value] Show/set the input image y shift +:output [string] Show/set the current output image name +:maxnregions Show the maximum number of objects / regions +:gain [string] Show/set the gain value / image header keyword +:readnoise [string] Show/set the readout noise value / image header + keyword + +:scaling Show the current scaling algorithm +:datamin [value] Show/set the minimum good data value +:datamax [value] Show/set the maximum good data value +:nreject [value] Show/set the maximum number of rejection cycles +:loreject [value] Show/set low side k-sigma rejection parameter +:hireject [value] Show/set high side k-sigma rejection parameter + diff --git a/pkg/images/immatch/src/linmatch/lsqfit.h b/pkg/images/immatch/src/linmatch/lsqfit.h new file mode 100644 index 00000000..69691935 --- /dev/null +++ b/pkg/images/immatch/src/linmatch/lsqfit.h @@ -0,0 +1,18 @@ +# The definitions file for the least squares fitting routines. + +define MAX_NFITPARS 7 # number of parameters following + +define YINCPT $1[1] # y-intercept +define EYINCPT $1[2] # error in y-intercept +define SLOPE $1[3] # slope of fit +define ESLOPE $1[4] # error in slope +define CHI $1[5] # mean error of unit weight +define RMS $1[6] # mean error of unit weight + +#define ME1 $1[1] # mean error of unit weight +#define OFFSET $1[2] # intercept +#define EOFFSET $1[3] # error in intercept +#define SLOPE1 $1[4] # slope of fit to first variable +#define ESLOPE1 $1[5] # error in slope1 +#define SLOPE2 $1[6] # slope of fit to second variable +#define ESLOPE2 $1[7] # error in slope2 diff --git a/pkg/images/immatch/src/linmatch/mkpkg b/pkg/images/immatch/src/linmatch/mkpkg new file mode 100644 index 00000000..5a8894f2 --- /dev/null +++ b/pkg/images/immatch/src/linmatch/mkpkg @@ -0,0 +1,21 @@ +# Make the LINMATCH task + +$checkout libpkg.a ../../../ +$update libpkg.a +$checkin libpkg.a ../../../ +$exit + +libpkg.a: + rglcolon.x <imhdr.h> <error.h> linmatch.h + rgldbio.x linmatch.h + rgldelete.x <gset.h> <mach.h> linmatch.h + rgliscale.x <imhdr.h> <gset.h> <ctype.h> linmatch.h + rglpars.x <lexnum.h> linmatch.h + rglplot.x <mach.h> <gset.h> linmatch.h + rglregions.x <fset.h> <imhdr.h> <ctype.h> linmatch.h + rglscale.x <mach.h> <imhdr.h> linmatch.h lsqfit.h + rglshow.x linmatch.h + rglsqfit.x <mach.h> lsqfit.h + rgltools.x linmatch.h + t_linmatch.x <fset.h> <imhdr.h> <imset.h> <error.h> linmatch.h + ; diff --git a/pkg/images/immatch/src/linmatch/rglcolon.x b/pkg/images/immatch/src/linmatch/rglcolon.x new file mode 100644 index 00000000..8c1d48ef --- /dev/null +++ b/pkg/images/immatch/src/linmatch/rglcolon.x @@ -0,0 +1,564 @@ +include <imhdr.h> +include <error.h> +include "linmatch.h" + +# RG_LCOLON -- Show/set the linmatch task algorithm parameters. + +procedure rg_lcolon (gd, ls, imr, im1, im2, db, dformat, reglist, rpfd, ipfd, + sfd, cmdstr, newref, newimage, newfit, newavg) + +pointer gd #I pointer to the graphics stream +pointer ls #I pointer to linmatch structure +pointer imr #I pointer to the reference image +pointer im1 #I pointer to the input image +pointer im2 #I pointer to the output image +pointer db #I pointer to the databas file +int dformat #I the database file format +int reglist #I the regions / photometry file descriptor +int rpfd #I the reference photometry file descriptor +int ipfd #I the input photometry file descriptor +int sfd #I the shifts file descriptor +char cmdstr[ARB] #I command string +int newref #I/O new reference image +int newimage #I/O new input image +int newfit #I/O new fit +int newavg #I/O new averages + +int ncmd, nref, nim, ival, fd +pointer sp, cmd, str +real rval +bool streq() +int strdic(), rg_lstati(), rg_lregions(), open(), fntopnb(), nscan() +int rg_lrphot(), access(), rg_lmkxy(), rg_lmkregions() +pointer immap(), dtmap() +real rg_lstatr() +errchk immap(), open(), fntopnb() + +begin + call smark (sp) + call salloc (cmd, SZ_LINE, TY_CHAR) + call salloc (str, SZ_LINE, TY_CHAR) + + # Get the command. + call sscan (cmdstr) + call gargwrd (Memc[cmd], SZ_LINE) + if (Memc[cmd] == EOS) { + call sfree (sp) + return + } + + # Process the command. + ncmd = strdic (Memc[cmd], Memc[cmd], SZ_LINE, LSCMDS) + + switch (ncmd) { + + case LSCMD_REFIMAGE: + call gargwrd (Memc[cmd], SZ_LINE) + call rg_lstats (ls, REFIMAGE, Memc[str], SZ_FNAME) + if (Memc[cmd] == EOS || streq (Memc[cmd], Memc[str])) { + call printf ("%s: %s\n") + call pargstr (KY_REFIMAGE) + call pargstr (Memc[str]) + } else if (rg_lstati(ls, BSALGORITHM) == LS_PHOTOMETRY || + rg_lstati(ls, BZALGORITHM) == LS_PHOTOMETRY) { + if (rpfd != NULL) { + call close (rpfd) + rpfd = NULL + } + iferr { + rpfd = open (Memc[cmd], READ_ONLY, TEXT_FILE) + } then { + call erract (EA_WARN) + rpfd = open (Memc[str], READ_ONLY, TEXT_FILE) + if (rg_lrphot (rpfd, ls, 1, rg_lstati(ls, MAXNREGIONS), + YES) <= 0) + ; + call seek (ipfd, BOF) + if (rg_lrphot (ipfd, ls, 1, rg_lstati(ls, NREGIONS), + NO) <= 0) + ; + } else { + nref = rg_lrphot (rpfd, ls, 1, rg_lstati(ls, MAXNREGIONS), + YES) + if (nref > 0) { + call seek (ipfd, BOF) + nim = rg_lrphot (ipfd, ls, 1, rg_lstati(ls, NREGIONS), + NO) + if (nim < nref) + call printf ("There are too few input points\n") + } else { + call close (rpfd) + rpfd = open (Memc[str], READ_ONLY, TEXT_FILE) + if (rg_lrphot (rpfd, ls, 1, rg_lstati(ls, MAXNREGIONS), + YES) <= 0) + ; + call seek (ipfd, BOF) + if (rg_lrphot (ipfd, ls, 1, rg_lstati(ls, NREGIONS), + NO) <= 0) + ; + call printf ( + "The new reference photometry file is empty\n") + } + call rg_lsets (ls, REFIMAGE, Memc[cmd]) + newref = YES; newimage = YES; newfit = YES; newavg = YES + } + } else { + if (imr != NULL) { + call imunmap (imr) + imr = NULL + } + iferr { + imr = immap (Memc[cmd], READ_ONLY, 0) + } then { + call erract (EA_WARN) + imr = immap (Memc[str], READ_ONLY, 0) + } else if (IM_NDIM(imr) > 2 || IM_NDIM(imr) != IM_NDIM(im1)) { + call printf ( + "Reference image has the wrong number of dimensions\n") + call imunmap (imr) + imr = immap (Memc[str], READ_ONLY, 0) + } else { + call rg_lgain (imr, ls) + if (!IS_INDEFR(rg_lstatr(ls,GAIN))) + call rg_lsetr (ls, RGAIN, rg_lstatr (ls,GAIN)) + call rg_lrdnoise (imr, ls) + if (!IS_INDEFR(rg_lstatr(ls,READNOISE))) + call rg_lsetr (ls, RREADNOISE, rg_lstatr (ls,READNOISE)) + call rg_lsets (ls, REFIMAGE, Memc[cmd]) + newref = YES; newimage = YES; newfit = YES; newavg = YES + } + } + + case LSCMD_IMAGE: + + call gargwrd (Memc[cmd], SZ_LINE) + call rg_lstats (ls, IMAGE, Memc[str], SZ_FNAME) + if (Memc[cmd] == EOS || streq (Memc[cmd], Memc[str])) { + call printf ("%s: %s\n") + call pargstr (KY_IMAGE) + call pargstr (Memc[str]) + } else { + if (im1 != NULL) { + call imunmap (im1) + im1 = NULL + } + iferr { + im1 = immap (Memc[cmd], READ_ONLY, 0) + } then { + call erract (EA_WARN) + im1 = immap (Memc[str], READ_ONLY, 0) + } else if (IM_NDIM(im1) > 2 || IM_NDIM(im1) != IM_NDIM(imr)) { + call printf ( + "Reference image has the wrong number of dimensions\n") + call imunmap (im1) + im1 = immap (Memc[str], READ_ONLY, 0) + } else { + call rg_lgain (im1, ls) + if (!IS_INDEFR(rg_lstatr(ls,GAIN))) + call rg_lsetr (ls, IGAIN, rg_lstatr (ls,GAIN)) + call rg_lrdnoise (im1, ls) + if (!IS_INDEFR(rg_lstatr(ls,READNOISE))) + call rg_lsetr (ls, IREADNOISE, rg_lstatr (ls,READNOISE)) + call rg_lsets (ls, IMAGE, Memc[cmd]) + newimage = YES; newref = YES; newfit = YES; newavg = YES + } + } + + case LSCMD_REGIONS: + call gargwrd (Memc[cmd], SZ_LINE) + call rg_lstats (ls, REGIONS, Memc[str], SZ_FNAME) + if (reglist == NULL || nscan() == 1 || (streq (Memc[cmd], + Memc[str]) && Memc[cmd] != EOS)) { + call printf ("%s [string/file]: %s\n") + call pargstr (KY_REGIONS) + call pargstr (Memc[str]) + } else if (rg_lstati(ls, BSALGORITHM) != LS_PHOTOMETRY && + rg_lstati(ls, BZALGORITHM) != LS_PHOTOMETRY) { + call fntclsb (reglist) + iferr { + reglist = fntopnb (Memc[cmd], NO) + } then { + reglist = fntopnb (Memc[str], NO) + } else { + if (rg_lregions (reglist, imr, ls, 1, NO) > 0) + ; + call rg_lsets (ls, REGIONS, Memc[cmd]) + newimage = YES; newref = YES; newfit = YES; newavg = YES + } + } + + case LSCMD_PHOTFILE: + call gargwrd (Memc[cmd], SZ_LINE) + call rg_lstats (ls, PHOTFILE, Memc[str], SZ_FNAME) + if (ipfd == NULL || Memc[cmd] == EOS || streq (Memc[cmd], + Memc[str])) { + call printf ("%s: %s\n") + call pargstr (KY_PHOTFILE) + call pargstr (Memc[str]) + } else { + if (ipfd != NULL) { + call close (ipfd) + ipfd = NULL + } + iferr { + ipfd = open (Memc[cmd], READ_ONLY, TEXT_FILE) + } then { + call erract (EA_WARN) + ipfd = open (Memc[str], READ_ONLY, TEXT_FILE) + } else { + nim = rg_lrphot (ipfd, ls, 1, rg_lstati(ls, NREGIONS), + NO) + if (nim > 0) { + call rg_lsets (ls, PHOTFILE, Memc[cmd]) + newref = YES; newimage = YES + newfit = YES; newavg = YES + } else { + call close (ipfd) + ipfd = open (Memc[str], READ_ONLY, TEXT_FILE) + nim = rg_lrphot (ipfd, ls, 1, rg_lstati(ls, NREGIONS), + NO) + } + } + } + + case LSCMD_SHIFTSFILE: + call gargwrd (Memc[cmd], SZ_LINE) + call rg_lstats (ls, SHIFTSFILE, Memc[str], SZ_FNAME) + if (Memc[cmd] == EOS || streq (Memc[cmd], + Memc[str])) { + call printf ("%s: %s\n") + call pargstr (KY_SHIFTSFILE) + call pargstr (Memc[str]) + } else { + if (sfd != NULL) { + call close (sfd) + sfd = NULL + } + iferr { + sfd = open (Memc[cmd], READ_ONLY, TEXT_FILE) + } then { + call erract (EA_WARN) + sfd = open (Memc[str], READ_ONLY, sfd) + } else { + call rg_lgshift (sfd, ls) + call rg_lstats (ls, SHIFTSFILE, Memc[cmd], SZ_FNAME) + } + } + + case LSCMD_OUTIMAGE: + call gargwrd (Memc[cmd], SZ_LINE) + call rg_lstats (ls, OUTIMAGE, Memc[str], SZ_FNAME) + if (im2 == NULL || Memc[cmd] == EOS || streq (Memc[cmd], + Memc[str])) { + call printf ("%s: %s\n") + call pargstr (KY_OUTIMAGE) + call pargstr (Memc[str]) + } else { + if (im2 != NULL) { + call imunmap (im2) + im2 = NULL + } + iferr { + im2 = immap (Memc[cmd], NEW_COPY, im1) + } then { + call erract (EA_WARN) + im2 = immap (Memc[str], NEW_COPY, im1) + } else { + call rg_lsets (ls, OUTIMAGE, Memc[cmd]) + } + } + + case LSCMD_DATABASE: + call gargwrd (Memc[cmd], SZ_LINE) + call rg_lstats (ls, DATABASE, Memc[str], SZ_FNAME) + if (Memc[cmd] == EOS || streq (Memc[cmd], Memc[str])) { + call printf ("%s: %s\n") + call pargstr (KY_DATABASE) + call pargstr (Memc[str]) + } else { + if (db != NULL) { + if (dformat == YES) + call dtunmap (db) + else + call close (db) + db = NULL + } + iferr { + if (dformat == YES) + db = dtmap (Memc[cmd], APPEND) + else + db = open (Memc[cmd], NEW_FILE, TEXT_FILE) + } then { + call erract (EA_WARN) + if (dformat == YES) + db = dtmap (Memc[str], APPEND) + else + db = open (Memc[str], APPEND, TEXT_FILE) + } else { + call rg_lsets (ls, DATABASE, Memc[cmd]) + } + } + + CASE LSCMD_RECORD: + call gargstr (Memc[cmd], SZ_LINE) + if (Memc[cmd] == EOS) { + call rg_lstats (ls, RECORD, Memc[str], SZ_FNAME) + call printf ("%s: %s\n") + call pargstr (KY_RECORD) + call pargstr (Memc[str]) + } else + call rg_lsets (ls, RECORD, Memc[cmd]) + + case LSCMD_XSHIFT: + call gargr (rval) + if (nscan() == 1) { + call printf ("%s = %g\n") + call pargstr (KY_XSHIFT) + call pargr (rg_lstatr (ls, XSHIFT)) + } else { + call rg_lsetr (ls, XSHIFT, rval) + if (sfd == NULL) { + call rg_lsetr (ls, SXSHIFT, rg_lstatr (ls, XSHIFT)) + call rg_lsetr (ls, SYSHIFT, rg_lstatr (ls, YSHIFT)) + } + newref = YES; newimage = YES; newfit = YES; newavg = YES + } + + case LSCMD_YSHIFT: + call gargr (rval) + if (nscan() == 1) { + call printf ("%s = %g\n") + call pargstr (KY_YSHIFT) + call pargr (rg_lstatr (ls, YSHIFT)) + } else { + call rg_lsetr (ls, YSHIFT, rval) + if (sfd == NULL) { + call rg_lsetr (ls, SXSHIFT, rg_lstatr (ls, XSHIFT)) + call rg_lsetr (ls, SYSHIFT, rg_lstatr (ls, YSHIFT)) + } + newref = YES; newimage = YES; newfit = YES; newavg = YES + } + + case LSCMD_DNX: + call gargi (ival) + if (nscan() == 1) { + call printf ("%s = %d\n") + call pargstr (KY_DNX) + call pargi (rg_lstati (ls, DNX)) + } else { + if (mod (ival, 2) == 0) + ival = ival + 1 + call rg_lseti (ls, DNX, ival) + newref = YES; newimage = YES; newfit = YES; newavg = YES + } + + case LSCMD_DNY: + call gargi (ival) + if (nscan() == 1) { + call printf ("%s = %d\n") + call pargstr (KY_DNY) + call pargi (rg_lstati (ls, DNY)) + } else { + if (mod (ival, 2) == 0) + ival = ival + 1 + call rg_lseti (ls, DNY, ival) + newref = YES; newimage = YES; newfit = YES; newavg = YES + } + + case LSCMD_MAXNREGIONS: + call gargi (ival) + if (nscan() == 1) { + call printf ("%s = %d\n") + call pargstr (KY_MAXNREGIONS) + call pargi (rg_lstati (ls, MAXNREGIONS)) + } + + case LSCMD_DATAMIN: + call gargr (rval) + if (nscan() == 1) { + call printf ("%s = %g\n") + call pargstr (KY_DATAMIN) + call pargr (rg_lstatr (ls, DATAMIN)) + } else { + call rg_lsetr (ls, DATAMIN, rval) + if (rg_lstati(ls,BSALGORITHM) != LS_PHOTOMETRY && + rg_lstati(ls,BZALGORITHM) != LS_PHOTOMETRY) + newfit = YES; newavg = YES + } + + case LSCMD_DATAMAX: + call gargr (rval) + if (nscan() == 1) { + call printf ("%s = %g\n") + call pargstr (KY_DATAMAX) + call pargr (rg_lstatr (ls, DATAMAX)) + } else { + call rg_lsetr (ls, DATAMAX, rval) + if (rg_lstati(ls,BSALGORITHM) != LS_PHOTOMETRY && + rg_lstati(ls,BZALGORITHM) != LS_PHOTOMETRY) + newfit = YES; newavg = YES + } + + case LSCMD_MAXITER: + call gargi (ival) + if (nscan() == 1) { + call printf ("%s = %d\n") + call pargstr (KY_MAXITER) + call pargi (rg_lstati (ls, MAXITER)) + } else { + call rg_lseti (ls, MAXITER, ival) + if (rg_lstati(ls,BSALGORITHM) != LS_PHOTOMETRY && + rg_lstati(ls,BZALGORITHM) != LS_PHOTOMETRY) { + if (rg_lstati(ls,BSALGORITHM) == LS_FIT && + rg_lstati(ls,BZALGORITHM) == LS_FIT) { + newfit = YES; newavg = YES + } else + newavg = YES + } + } + + case LSCMD_NREJECT: + call gargi (ival) + if (nscan() == 1) { + call printf ("%s = %d\n") + call pargstr (KY_NREJECT) + call pargi (rg_lstati (ls, NREJECT)) + } else { + call rg_lseti (ls, NREJECT, ival) + newfit = YES; newavg = YES + if (rg_lstati(ls,BSALGORITHM) == LS_FIT || + rg_lstati(ls,BZALGORITHM) == LS_FIT) + newfit = YES + newavg = YES + } + + case LSCMD_LOREJECT: + call gargr (rval) + if (nscan() == 1) { + call printf ("%s = %g\n") + call pargstr (KY_LOREJECT) + call pargr (rg_lstatr (ls, LOREJECT)) + } else { + call rg_lsetr (ls, LOREJECT, rval) + if (rg_lstati(ls,BSALGORITHM) == LS_FIT || + rg_lstati(ls,BZALGORITHM) == LS_FIT) + newfit = YES + newavg = YES + } + + case LSCMD_HIREJECT: + call gargr (rval) + if (nscan() == 1) { + call printf ("%s = %g\n") + call pargstr (KY_HIREJECT) + call pargr (rg_lstatr (ls, HIREJECT)) + } else { + call rg_lsetr (ls, HIREJECT, rval) + if (rg_lstati(ls,BSALGORITHM) == LS_FIT || + rg_lstati(ls,BZALGORITHM) == LS_FIT) + newfit = YES + newavg = YES + } + + case LSCMD_GAIN: + call gargstr (Memc[cmd], SZ_LINE) + if (Memc[cmd] == EOS) { + call rg_lstats (ls, CCDGAIN, Memc[str], SZ_LINE) + call printf ("%s: %s\n") + call pargstr (KY_GAIN) + call pargstr (Memc[str]) + } else { + call rg_lsets (ls, CCDGAIN, Memc[cmd]) + if (imr != NULL) { + call rg_lgain (imr, ls) + if (!IS_INDEFR(rg_lstatr(ls,GAIN))) + call rg_lsetr (ls, RGAIN, rg_lstatr(ls,GAIN)) + } + if (im1 != NULL) { + call rg_lgain (im1, ls) + if (!IS_INDEFR(rg_lstatr(ls,GAIN))) + call rg_lsetr (ls, IGAIN, rg_lstatr(ls,GAIN)) + } + newfit = YES; newavg = YES + } + + case LSCMD_READNOISE: + call gargstr (Memc[cmd], SZ_LINE) + if (Memc[cmd] == EOS) { + call rg_lstats (ls, CCDREAD, Memc[str], SZ_LINE) + call printf ("%s: %s\n") + call pargstr (KY_READNOISE) + call pargstr (Memc[str]) + } else { + call rg_lsets (ls, CCDREAD, Memc[cmd]) + if (imr != NULL) { + call rg_lrdnoise (imr, ls) + if (!IS_INDEFR(rg_lstatr(ls,READNOISE))) + call rg_lsetr (ls, RREADNOISE, rg_lstatr(ls,READNOISE)) + } + if (im1 != NULL) { + call rg_lrdnoise (im1, ls) + if (!IS_INDEFR(rg_lstatr(ls,READNOISE))) + call rg_lsetr (ls, IREADNOISE, rg_lstatr(ls,READNOISE)) + } + newfit = YES; newavg = YES + } + + case LSCMD_SHOW: + call gdeactivate (gd, 0) + call rg_lshow (ls) + call greactivate (gd, 0) + + case LSCMD_MARKCOORDS, LSCMD_MARKSECTIONS: + call gdeactivate (gd, 0) + call gargwrd (Memc[cmd], SZ_LINE) + if (Memc[cmd] == EOS) { + fd = NULL + } else if (access (Memc[cmd], 0, 0) == YES) { + call printf ("Warning: file %s already exists\n") + call pargstr (Memc[cmd]) + fd = NULL + } else { + fd = open (Memc[cmd], NEW_FILE, TEXT_FILE) + } + call printf ("\n") + if (imr == NULL || im1 == NULL) { + call printf ("The reference or input image is undefined.\n") + } else { + if (reglist != NULL) { + call fntclsb (reglist) + reglist = NULL + } + if (ncmd == LSCMD_MARKCOORDS) { + nref = rg_lmkxy (fd, imr, ls, 1, rg_lstati (ls, + MAXNREGIONS)) + } else { + nref = rg_lmkregions (fd, imr, ls, 1, rg_lstati (ls, + MAXNREGIONS), Memc[str], SZ_LINE) + } + if (nref <= 0) { + call rg_lstats (ls, REGIONS, Memc[str], SZ_LINE) + iferr (reglist = fntopnb (Memc[str], NO)) + reglist = NULL + if (rg_lregions (reglist, imr, ls, 1, 1) > 0) + ; + call rg_lsets (ls, REGIONS, Memc[str]) + call rg_lseti (ls, CNREGION, 1) + } else { + call rg_lseti (ls, CNREGION, 1) + call rg_lsets (ls, REGIONS, Memc[str]) + newref = YES; newimage = YES + newfit = YES; newavg = YES + } + } + call printf ("\n") + if (fd != NULL) + call close (fd) + call greactivate (gd, 0) + + default: + call printf ("Unknown or ambiguous colon command\7\n") + } + + call sfree (sp) +end diff --git a/pkg/images/immatch/src/linmatch/rgldbio.x b/pkg/images/immatch/src/linmatch/rgldbio.x new file mode 100644 index 00000000..63876985 --- /dev/null +++ b/pkg/images/immatch/src/linmatch/rgldbio.x @@ -0,0 +1,225 @@ +include "linmatch.h" + +# RG_LWREC -- Procedure to write out the entire record. + +procedure rg_lwrec (db, dformat, ls) + +pointer db #I pointer to the database file +int dformat #I is the scaling file in database format +pointer ls #I pointer to the linmatch structure + +pointer sp, image +real rg_lstatr() + +begin + # Allocate working space. + call smark (sp) + call salloc (image, SZ_FNAME, TY_CHAR) + + if (dformat == YES) { + call rg_ldbparams (db, ls) + call rg_lwreg (db, ls) + call rg_ldbtscale (db, ls) + } else { + call rg_lstats (ls, IMAGE, Memc[image], SZ_FNAME) + call fprintf (db, "%s %g %g %g %g") + call pargstr (Memc[image]) + call pargr (rg_lstatr(ls, TBSCALE)) + call pargr (rg_lstatr(ls, TBZERO)) + call pargr (rg_lstatr(ls, TBSCALEERR)) + call pargr (rg_lstatr(ls, TBZEROERR)) + } + + call sfree (sp) +end + + +# RG_LWREG -- Write out the results for each region. + +procedure rg_lwreg (db, ls) + +pointer db #I pointer to the database file +pointer ls #I pointer to the intensity matching structure + +int i, nregions, rc1, rc2, rl1, rl2, c1, c2, l1, l2, del +real xshift, yshift, bscale, bzero, bserr, bzerr +int rg_lstati() +pointer rg_lstatp() +real rg_lstatr() + +begin + xshift = rg_lstatr (ls, SXSHIFT) + yshift = rg_lstatr (ls, SYSHIFT) + + nregions = rg_lstati (ls, NREGIONS) + do i = 1, nregions { + + rc1 = Memi[rg_lstatp (ls, RC1)+i-1] + rc2 = Memi[rg_lstatp (ls, RC2)+i-1] + rl1 = Memi[rg_lstatp (ls, RL1)+i-1] + rl2 = Memi[rg_lstatp (ls, RL2)+i-1] + if (IS_INDEFI(rc1)) + c1 = INDEFI + else + c1 = rc1 + xshift + if (IS_INDEFI(rc2)) + c2 = INDEFI + else + c2 = rc2 + xshift + if (IS_INDEFI(rl1)) + l1 = INDEFI + else + l1 = rl1 + yshift + if (IS_INDEFI(rl2)) + l2 = INDEFI + else + l2 = rl2 + yshift + + bscale = Memr[rg_lstatp(ls,RBSCALE)+i-1] + bzero = Memr[rg_lstatp(ls,RBZERO)+i-1] + bserr = Memr[rg_lstatp(ls,RBSCALEERR)+i-1] + bzerr = Memr[rg_lstatp(ls,RBZEROERR)+i-1] + del = Memi[rg_lstatp(ls,RDELETE)+i-1] + + call rg_ldbscaler (db, rc1, rc2, rl1, rl2, c1, c2, l1, l2, + bscale, bzero, bserr, bzerr, del) + } +end + + +# RG_LDBPARAMS -- Write the intensity matching parameters to the database file. + +procedure rg_ldbparams (db, ls) + +pointer db #I pointer to the database file +pointer ls #I pointer to the intensity matching structure + +pointer sp, str +int rg_lstati() + +begin + call smark (sp) + call salloc (str, SZ_FNAME, TY_CHAR) + + # Write out the time record was written. + call dtput (db, "\n") + call dtptime (db) + + # Write out the record name. + call rg_lstats (ls, RECORD, Memc[str], SZ_FNAME) + call dtput (db, "begin\t%s\n") + call pargstr (Memc[str]) + + # Write the image names. + call rg_lstats (ls, IMAGE, Memc[str], SZ_FNAME) + call dtput (db, "\t%s\t\t%s\n") + call pargstr (KY_IMAGE) + call pargstr (Memc[str]) + call rg_lstats (ls, REFIMAGE, Memc[str], SZ_FNAME) + call dtput (db, "\t%s\t%s\n") + call pargstr (KY_REFIMAGE) + call pargstr (Memc[str]) + + call dtput (db, "\t%s\t%d\n") + call pargstr (KY_NREGIONS) + call pargi (rg_lstati(ls, NREGIONS)) + + call sfree (sp) +end + + +# RG_LDBSCALER -- Write the scaling parameters for each region + +procedure rg_ldbscaler (db, rc1, rc2, rl1, rl2, c1, c2, l1, l2, bscale, + bzero, bserr, bzerr, del) + +pointer db # pointer to the database file +int rc1, rc2 # reference image region column limits +int rl1, rl2 # reference image region line limits +int c1, c2 # image region column limits +int l1, l2 # image region line limits +real bscale # the scaling parameter +real bzero # the offset parameter +real bserr # the error in the scaling parameter +real bzerr # the error in the offset parameter +int del # the deletions index + +begin + if (IS_INDEFI(rc1) || IS_INDEFI(c1)) { + call dtput (db,"\t[INDEF] [INDEF] %g %g %g %g %s\n") + } else { + call dtput (db,"\t[%d:%d,%d:%d] [%d:%d,%d:%d] %g %g %g %g %s\n") + call pargi (rc1) + call pargi (rc2) + call pargi (rl1) + call pargi (rl2) + call pargi (c1) + call pargi (c2) + call pargi (l1) + call pargi (l2) + } + + call pargr (bscale) + call pargr (bzero) + call pargr (bserr) + call pargr (bzerr) + if (del == NO) + call pargstr ("") + else + call pargstr ("[Rejected/Deleted]") +end + + +# RG_LDBTSCALE -- Write the final scaling parameters and their errors. + +procedure rg_ldbtscale (db, ls) + +pointer db #I pointer to the text database file +pointer ls #I pointer to the linmatch structure + +real rg_lstatr() + +begin + call dtput (db, "\tbscale\t\t%g\n") + call pargr (rg_lstatr(ls, TBSCALE)) + call dtput (db, "\tbzero\t\t%g\n") + call pargr (rg_lstatr (ls, TBZERO)) + call dtput (db, "\tbserr\t\t%g\n") + call pargr (rg_lstatr (ls, TBSCALEERR)) + call dtput (db, "\tbzerr\t\t%g\n") + call pargr (rg_lstatr (ls, TBZEROERR)) +end + + +# RG_LPWREC -- Print the computed scaling factors for the region. + +procedure rg_lpwrec (ls, i) + +pointer ls #I pointer to the linmatch structure +int i #I the current region + +pointer rg_lstatp() +real rg_lstatr() + +begin + if (i == 0) { + call printf ( + "Results: bscale = %g +/- %g bzero = %g +/- %g\n") + call pargr (rg_lstatr (ls, TBSCALE)) + call pargr (rg_lstatr (ls, TBSCALEERR)) + call pargr (rg_lstatr (ls, TBZERO)) + call pargr (rg_lstatr (ls, TBZEROERR)) + } else { + call printf ( + "Region %d: [%d:%d,%d:%d] bscale = %g +/- %g bzero = %g +/- %g\n") + call pargi (i) + call pargi (Memi[rg_lstatp(ls,RC1)+i-1]) + call pargi (Memi[rg_lstatp(ls,RC2)+i-1]) + call pargi (Memi[rg_lstatp(ls,RL1)+i-1]) + call pargi (Memi[rg_lstatp(ls,RL2)+i-1]) + call pargr (Memr[rg_lstatp(ls,RBSCALE)+i-1]) + call pargr (Memr[rg_lstatp(ls,RBSCALEERR)+i-1]) + call pargr (Memr[rg_lstatp(ls,RBZERO)+i-1]) + call pargr (Memr[rg_lstatp(ls,RBZEROERR)+i-1]) + } +end diff --git a/pkg/images/immatch/src/linmatch/rgldelete.x b/pkg/images/immatch/src/linmatch/rgldelete.x new file mode 100644 index 00000000..2e16923a --- /dev/null +++ b/pkg/images/immatch/src/linmatch/rgldelete.x @@ -0,0 +1,993 @@ +include <gset.h> +include <mach.h> +include "linmatch.h" + +# RG_LFIND -- Find the point nearest the cursor regardless of whether it +# has been deleted or not. + +int procedure rg_lfind (gd, ls, wcs, wx, wy, bscale, bzero, plot_type) + +pointer gd #I pointer to the graphics stream +pointer ls #I pointer to the linmatch structure +int wcs #I the wcs of the point +real wx #I the x coordinate of point to be deleted +real wy #I the y coordinate of point to be deleted +real bscale #I the computed bscale value +real bzero #I the computed bzero value +int plot_type #I the current plot type + +int region +int rg_mmffind(), rg_mmrfind(), rg_bzffind(), rg_bzrfind() +int rg_msffind(), rg_msrfind() + +begin + switch (plot_type) { + case LS_MMFIT: + region = rg_mmffind (gd, ls, wx, wy) + case LS_MMRESID: + region = rg_mmrfind (gd, ls, wx, wy, bscale, bzero) + case LS_BSZFIT: + region = rg_bzffind (gd, ls, wcs, wx, wy) + case LS_BSZRESID: + region = rg_bzrfind (gd, ls, wcs, wx, wy, bscale, bzero) + case LS_MAGSKYFIT: + region = rg_msffind (gd, ls, wcs, wx, wy) + case LS_MAGSKYRESID: + region = rg_msrfind (gd, ls, wcs, wx, wy, bscale, bzero) + default: + region = 0 + } + + return (region) +end + + +# RG_LDELETE -- Delete or undelete regions from the data. + +int procedure rg_ldelete (gd, ls, udelete, wcs, wx, wy, bscale, bzero, + plot_type, delete) + +pointer gd #I pointer to the graphics stream +pointer ls #I pointer to the linmatch structure +int udelete[ARB] #I/O the user deletions array +int wcs #I the wcs for multi-wcs plots +real wx #I the x coordinate of point to be deleted +real wy #I the y coordinate of point to be deleted +real bscale #I the computed bscale value +real bzero #I the computed bzero value +int plot_type #I the current plot type +int delete #I delete the point + +int region +int rg_rdelete(), rg_mmfdelete(), rg_mmrdelete(), rg_bzfdelete() +int rg_bzrdelete(), rg_msfdelete(), rg_msrdelete() + +begin + switch (plot_type) { + case LS_MMHIST: + region = rg_rdelete (gd, ls, udelete, delete) + case LS_MMFIT: + region = rg_mmfdelete (gd, ls, udelete, wx, wy, delete) + case LS_MMRESID: + region = rg_mmrdelete (gd, ls, udelete, wx, wy, bscale, + bzero, delete) + case LS_RIFIT: + region = rg_rdelete (gd, ls, udelete, delete) + case LS_RIRESID: + region = rg_rdelete (gd, ls, udelete, delete) + case LS_BSZFIT: + region = rg_bzfdelete (gd, ls, udelete, wcs, wx, wy, delete) + case LS_BSZRESID: + region = rg_bzrdelete (gd, ls, udelete, wcs, wx, wy, bscale, + bzero, delete) + case LS_MAGSKYFIT: + region = rg_msfdelete (gd, ls, udelete, wcs, wx, wy, delete) + case LS_MAGSKYRESID: + region = rg_msrdelete (gd, ls, udelete, wcs, wx, wy, bscale, + bzero, delete) + default: + region = 0 + } + + return (region) +end + + +# RG_RDELETE -- Delete or undelete a particular region from the data using +# a histogram or fit plot. + +int procedure rg_rdelete (gd, ls, udelete, delete) + +pointer gd #I pointer to the graphics stream +pointer ls #I pointer to the linmatch structure +int udelete[ARB] #I/O the user deletions array +int delete #I delete the point + +int region +int rg_lstati() +pointer rg_lstatp() + +begin + # Get the current region. + region = rg_lstati (ls, CNREGION) + if (region < 1 || region > rg_lstati (ls, NREGIONS)) + return (0) + + # Delete or undelete the region. + if (delete == YES) { + if (Memi[rg_lstatp(ls,RDELETE)+region-1] == LS_NO) { + udelete[region] = YES + return (region) + } else + return (0) + } else { + if (Memi[rg_lstatp(ls,RDELETE)+region-1] != LS_NO) { + udelete[region] = NO + return (region) + } else + return (0) + } +end + + +# RG_MMFDELETE -- Delete or undelete a point computed from the mean, median, +# or mode. + +int procedure rg_mmfdelete (gd, ls, udelete, wx, wy, delete) + +pointer gd #I pointer to the graphics stream +pointer ls #I pointer to the linmatch structure +int udelete[ARB] #I/O the user deletions array +real wx #I the input x coordinate +real wy #I the input y coordinate +int delete #I delete the input object + +int nregions, region, mtype +pointer sp, xdata, ydata +int rg_lstati(), rg_lpdelete(), rg_lpundelete() +pointer rg_lstatp() + +begin + nregions = rg_lstati (ls, NREGIONS) + if (nregions <= 1) + return (0) + + # Determine the type of data to plot. + mtype = 0 + switch (rg_lstati(ls, BSALGORITHM)) { + case LS_MEAN: + mtype = LS_MEAN + case LS_MEDIAN: + mtype = LS_MEDIAN + case LS_MODE: + mtype = LS_MODE + default: + } + switch (rg_lstati(ls, BZALGORITHM)) { + case LS_MEAN: + mtype = LS_MEAN + case LS_MEDIAN: + mtype = LS_MEDIAN + case LS_MODE: + mtype = LS_MODE + default: + } + if (mtype <= 0) + return (0) + + # Allocate working space. + call smark (sp) + call salloc (xdata, nregions, TY_REAL) + call salloc (ydata, nregions, TY_REAL) + + # Get the data. + switch (mtype) { + case LS_MEAN: + call amovr (Memr[rg_lstatp(ls,IMEAN)], Memr[xdata], nregions) + call amovr (Memr[rg_lstatp(ls,RMEAN)], Memr[ydata], nregions) + case LS_MEDIAN: + call amovr (Memr[rg_lstatp(ls,IMEDIAN)], Memr[xdata], nregions) + call amovr (Memr[rg_lstatp(ls,RMEDIAN)], Memr[ydata], nregions) + case LS_MODE: + call amovr (Memr[rg_lstatp(ls,IMODE)], Memr[xdata], nregions) + call amovr (Memr[rg_lstatp(ls,RMODE)], Memr[ydata], nregions) + } + + # Delete or undelete the point. + if (delete == YES) + region = rg_lpdelete (gd, 1, wx, wy, Memr[xdata], Memr[ydata], + Memi[rg_lstatp(ls,RDELETE)], udelete, nregions) + else + region = rg_lpundelete (gd, 1, wx, wy, Memr[xdata], Memr[ydata], + Memi[rg_lstatp(ls,RDELETE)], udelete, nregions) + + call sfree (sp) + + return (region) +end + + +# RG_MMRDELETE -- Delete or undelete a point computed from the mean, median, +# or mode residuals plots. + +int procedure rg_mmrdelete (gd, ls, udelete, wx, wy, bscale, bzero, delete) + +pointer gd #I pointer to the graphics stream +pointer ls #I pointer to the linmatch structure +int udelete[ARB] #I/O the user deletions array +real wx #I the input x coordinate +real wy #I the input y coordinate +real bscale #I the computed bscale factor +real bzero #I the computed bzero factor +int delete #I delete the input object + +int nregions, region, mtype +pointer sp, xdata, ydata +int rg_lstati(), rg_lpdelete(), rg_lpundelete() +pointer rg_lstatp() + +begin + nregions = rg_lstati (ls, NREGIONS) + if (nregions <= 1) + return (0) + + # Determine the type of data to plot. + mtype = 0 + switch (rg_lstati(ls, BSALGORITHM)) { + case LS_MEAN: + mtype = LS_MEAN + case LS_MEDIAN: + mtype = LS_MEDIAN + case LS_MODE: + mtype = LS_MODE + default: + } + switch (rg_lstati(ls, BZALGORITHM)) { + case LS_MEAN: + mtype = LS_MEAN + case LS_MEDIAN: + mtype = LS_MEDIAN + case LS_MODE: + mtype = LS_MODE + default: + } + if (mtype <= 0) + return (0) + + # Allocate working space. + call smark (sp) + call salloc (xdata, nregions, TY_REAL) + call salloc (ydata, nregions, TY_REAL) + + switch (mtype) { + case LS_MEAN: + call amovr (Memr[rg_lstatp(ls,IMEAN)], Memr[xdata], nregions) + call altmr (Memr[rg_lstatp(ls,IMEAN)], Memr[ydata], nregions, + bscale, bzero) + call asubr (Memr[rg_lstatp(ls,RMEAN)], Memr[ydata], Memr[ydata], + nregions) + case LS_MEDIAN: + call amovr (Memr[rg_lstatp(ls,IMEDIAN)], Memr[xdata], nregions) + call altmr (Memr[rg_lstatp(ls,IMEDIAN)], Memr[ydata], nregions, + bscale, bzero) + call asubr (Memr[rg_lstatp(ls,RMEDIAN)], Memr[ydata], Memr[ydata], + nregions) + case LS_MODE: + call amovr (Memr[rg_lstatp(ls,IMODE)], Memr[xdata], nregions) + call altmr (Memr[rg_lstatp(ls,IMODE)], Memr[ydata], nregions, + bscale, bzero) + call asubr (Memr[rg_lstatp(ls,RMODE)], Memr[ydata], Memr[ydata], + nregions) + } + + # Delete or undelete the point. + if (delete == YES) + region = rg_lpdelete (gd, 1, wx, wy, Memr[xdata], Memr[ydata], + Memi[rg_lstatp(ls,RDELETE)], udelete, nregions) + else + region = rg_lpundelete (gd, 1, wx, wy, Memr[xdata], Memr[ydata], + Memi[rg_lstatp(ls,RDELETE)], udelete, nregions) + + call sfree (sp) + + return (region) +end + + +# RG_BZFDELETE -- Delete or undelete a point computed from the average +# of the fitted bscale or bzeros. + +int procedure rg_bzfdelete (gd, ls, udelete, wcs, wx, wy, delete) + +pointer gd #I pointer to the graphics stream +pointer ls #I pointer to the linmatch structure +int udelete[ARB] #I/O the user deletions array +int wcs #I the wcs number +real wx #I the input x coordinate +real wy #I the input y coordinate +int delete #I delete the input object + +int i, nregions, region +pointer sp, xreg +int rg_lstati(), rg_lpdelete(), rg_lpundelete() +pointer rg_lstatp() + +begin + nregions = rg_lstati (ls, NREGIONS) + if (nregions <= 1) + return (0) + + call smark (sp) + call salloc (xreg, nregions, TY_REAL) + do i = 1, nregions + Memr[xreg+i-1] = i + + # Delete or undelete the point. + if (delete == YES) { + if (wcs == 1) + region = rg_lpdelete (gd, wcs, wx, wy, Memr[xreg], + Memr[rg_lstatp(ls,RBSCALE)], Memi[rg_lstatp(ls,RDELETE)], + udelete, nregions) + else if (wcs == 2) + region = rg_lpdelete (gd, wcs, wx, wy, Memr[xreg], + Memr[rg_lstatp(ls,RBZERO)], Memi[rg_lstatp(ls,RDELETE)], + udelete, nregions) + else + region = 0 + } else { + if (wcs == 1) + region = rg_lpundelete (gd, wcs, wx, wy, Memr[xreg], + Memr[rg_lstatp(ls,RBSCALE)], Memi[rg_lstatp(ls,RDELETE)], + udelete, nregions) + else if (wcs == 2) + region = rg_lpundelete (gd, wcs, wx, wy, Memr[xreg], + Memr[rg_lstatp(ls,RBZERO)], Memi[rg_lstatp(ls,RDELETE)], + udelete, nregions) + else + region = 0 + } + + call sfree (sp) + + return (region) +end + + +# RG_BZRDELETE -- Delete or undelete a point computed from the average +# of the fitted bscale or bzero residuals. + +int procedure rg_bzrdelete (gd, ls, udelete, wcs, wx, wy, bscale, bzero, + delete) + +pointer gd #I pointer to the graphics stream +pointer ls #I pointer to the linmatch structure +int udelete[ARB] #I/O the user deletions array +int wcs #I the wcs number +real wx #I the input x coordinate +real wy #I the input y coordinate +real bscale #I the input bscale value +real bzero #I the input bzero value +int delete #I delete the input object + +int i, nregions, region +pointer sp, xreg, yreg +int rg_lstati(), rg_lpdelete(), rg_lpundelete() +pointer rg_lstatp() + +begin + nregions = rg_lstati (ls, NREGIONS) + if (nregions <= 1) + return (0) + + call smark (sp) + call salloc (xreg, nregions, TY_REAL) + call salloc (yreg, nregions, TY_REAL) + do i = 1, nregions + Memr[xreg+i-1] = i + + # Delete or undelete the point. + if (delete == YES) { + if (wcs == 1) { + call asubkr (Memr[rg_lstatp(ls,RBSCALE)], bscale, Memr[yreg], + nregions) + region = rg_lpdelete (gd, wcs, wx, wy, Memr[xreg], Memr[yreg], + Memi[rg_lstatp(ls,RDELETE)], udelete, nregions) + } else if (wcs == 2) { + call asubkr (Memr[rg_lstatp(ls,RBZERO)], bzero, Memr[yreg], + nregions) + region = rg_lpdelete (gd, wcs, wx, wy, Memr[xreg], + Memr[yreg], Memi[rg_lstatp(ls,RDELETE)], udelete, nregions) + } else + region = 0 + } else { + if (wcs == 1) { + call asubkr (Memr[rg_lstatp(ls,RBSCALE)], bscale, Memr[yreg], + nregions) + region = rg_lpundelete (gd, wcs, wx, wy, Memr[xreg], + Memr[yreg], Memi[rg_lstatp(ls,RDELETE)], udelete, nregions) + } else if (wcs == 2) { + call asubkr (Memr[rg_lstatp(ls,RBZERO)], bzero, Memr[yreg], + nregions) + region = rg_lpundelete (gd, wcs, wx, wy, Memr[xreg], + Memr[yreg], Memi[rg_lstatp(ls,RDELETE)], udelete, nregions) + } else + region = 0 + } + + call sfree (sp) + + return (region) +end + + +# RG_MSFDELETE -- Delete or undelete a point computed from the average +# of the fitted bscale or bzeros. + +int procedure rg_msfdelete (gd, ls, udelete, wcs, wx, wy, delete) + +pointer gd #I pointer to the graphics stream +pointer ls #I pointer to the linmatch structure +int udelete[ARB] #I/O the user deletions array +int wcs #I the wcs number +real wx #I the input x coordinate +real wy #I the input y coordinate +int delete #I delete the input object + +int nregions, region +int rg_lstati(), rg_lpdelete(), rg_lpundelete() +pointer rg_lstatp() + +begin + nregions = rg_lstati (ls, NREGIONS) + if (nregions <= 1) + return (0) + + # Delete or undelete the point. + if (delete == YES) { + if (wcs == 1) + region = rg_lpdelete (gd, wcs, wx, wy, Memr[rg_lstatp(ls, + IMAG)], Memr[rg_lstatp(ls,RMAG)], Memi[rg_lstatp(ls, + RDELETE)], udelete, nregions) + else if (wcs == 2) + region = rg_lpdelete (gd, wcs, wx, wy, Memr[rg_lstatp(ls, + ISKY)], Memr[rg_lstatp(ls,RSKY)], Memi[rg_lstatp(ls, + RDELETE)], udelete, nregions) + else + region = 0 + } else { + if (wcs == 1) + region = rg_lpundelete (gd, wcs, wx, wy, Memr[rg_lstatp(ls, + IMAG)], Memr[rg_lstatp(ls,RMAG)], Memi[rg_lstatp(ls, + RDELETE)], udelete, nregions) + else if (wcs == 2) + region = rg_lpundelete (gd, wcs, wx, wy, Memr[rg_lstatp(ls, + ISKY)], Memr[rg_lstatp(ls,RSKY)], Memi[rg_lstatp(ls, + RDELETE)], udelete, nregions) + else + region = 0 + } + + return (region) +end + + +# RG_MSRDELETE -- Delete or undelete a point computed from the average +# of the fitted bscale or bzeros. + +int procedure rg_msrdelete (gd, ls, udelete, wcs, wx, wy, bscale, bzero, delete) + +pointer gd #I pointer to the graphics stream +pointer ls #I pointer to the linmatch structure +int udelete[ARB] #I/O the user deletions array +int wcs #I the wcs number +real wx #I the input x coordinate +real wy #I the input y coordinate +real bscale #I the input bscale value +real bzero #I the input bzero value +int delete #I delete the input object + +int nregions, region +pointer sp, resid +int rg_lstati(), rg_lpdelete(), rg_lpundelete() +pointer rg_lstatp() + +begin + nregions = rg_lstati (ls, NREGIONS) + if (nregions <= 1) + return (0) + + call smark (sp) + call salloc (resid, nregions, TY_REAL) + + if (wcs == 1) { + if (bscale > 0.0) { + call aaddkr (Memr[rg_lstatp(ls,IMAG)], -2.5*log10(bscale), + Memr[resid], nregions) + call asubr (Memr[rg_lstatp(ls,RMAG)], Memr[resid], + Memr[resid], nregions) + } else + call asubr (Memr[rg_lstatp(ls,RMAG)], Memr[rg_lstatp(ls, + IMAG)], Memr[resid], nregions) + } else { + call altmr (Memr[rg_lstatp(ls,ISKY)], Memr[resid], nregions, + bscale, bzero) + call asubr (Memr[rg_lstatp(ls,RSKY)], Memr[resid], Memr[resid], + nregions) + } + + # Delete or undelete the point. + if (delete == YES) { + if (wcs == 1) + region = rg_lpdelete (gd, wcs, wx, wy, Memr[rg_lstatp(ls, + IMAG)], Memr[resid], Memi[rg_lstatp(ls,RDELETE)], + udelete, nregions) + else if (wcs == 2) + region = rg_lpdelete (gd, wcs, wx, wy, Memr[rg_lstatp(ls, + ISKY)], Memr[resid], Memi[rg_lstatp(ls,RDELETE)], + udelete, nregions) + else + region = 0 + } else { + if (wcs == 1) + region = rg_lpundelete (gd, wcs, wx, wy, Memr[rg_lstatp(ls, + IMAG)], Memr[resid], Memi[rg_lstatp(ls,RDELETE)], + udelete, nregions) + else if (wcs == 2) + region = rg_lpundelete (gd, wcs, wx, wy, Memr[rg_lstatp(ls, + ISKY)], Memr[resid], Memi[rg_lstatp(ls,RDELETE)], + udelete, nregions) + else + region = 0 + } + + call sfree (sp) + + return (region) +end + +# RG_MMFFIND -- Find a point computed from the mean, median, or mode. + +int procedure rg_mmffind (gd, ls, wx, wy) + +pointer gd #I pointer to the graphics stream +pointer ls #I pointer to the linmatch structure +real wx #I the input x coordinate +real wy #I the input y coordinate + +int nregions, mtype, region +pointer sp, xdata, ydata +int rg_lstati(), rg_lpfind() +pointer rg_lstatp() + +begin + nregions = rg_lstati (ls, NREGIONS) + if (nregions <= 1) + return (0) + + # Determine the type of data to plot. + mtype = 0 + switch (rg_lstati(ls, BSALGORITHM)) { + case LS_MEAN: + mtype = LS_MEAN + case LS_MEDIAN: + mtype = LS_MEDIAN + case LS_MODE: + mtype = LS_MODE + default: + } + switch (rg_lstati(ls, BZALGORITHM)) { + case LS_MEAN: + mtype = LS_MEAN + case LS_MEDIAN: + mtype = LS_MEDIAN + case LS_MODE: + mtype = LS_MODE + default: + } + if (mtype <= 0) + return (0) + + # Allocate working space. + call smark (sp) + call salloc (xdata, nregions, TY_REAL) + call salloc (ydata, nregions, TY_REAL) + + # Get the data. + switch (mtype) { + case LS_MEAN: + call amovr (Memr[rg_lstatp(ls,IMEAN)], Memr[xdata], nregions) + call amovr (Memr[rg_lstatp(ls,RMEAN)], Memr[ydata], nregions) + case LS_MEDIAN: + call amovr (Memr[rg_lstatp(ls,IMEDIAN)], Memr[xdata], nregions) + call amovr (Memr[rg_lstatp(ls,RMEDIAN)], Memr[ydata], nregions) + case LS_MODE: + call amovr (Memr[rg_lstatp(ls,IMODE)], Memr[xdata], nregions) + call amovr (Memr[rg_lstatp(ls,RMODE)], Memr[ydata], nregions) + } + + region = rg_lpfind (gd, 1, wx, wy, Memr[xdata], Memr[ydata], nregions) + + call sfree (sp) + + return (region) +end + + +# RG_MMRFIND -- Find a point computed from the mean, median, or mode. + +int procedure rg_mmrfind (gd, ls, wx, wy, bscale, bzero) + +pointer gd #I pointer to the graphics stream +pointer ls #I pointer to the linmatch structure +real wx #I the input x coordinate +real wy #I the input y coordinate +real bscale #I the input bscale factor +real bzero #I the input bzero factor + +int nregions, mtype, region +pointer sp, xdata, ydata +int rg_lstati(), rg_lpfind() +pointer rg_lstatp() + +begin + nregions = rg_lstati (ls, NREGIONS) + if (nregions <= 1) + return (0) + + # Determine the type of data to plot. + mtype = 0 + switch (rg_lstati(ls, BSALGORITHM)) { + case LS_MEAN: + mtype = LS_MEAN + case LS_MEDIAN: + mtype = LS_MEDIAN + case LS_MODE: + mtype = LS_MODE + default: + } + switch (rg_lstati(ls, BZALGORITHM)) { + case LS_MEAN: + mtype = LS_MEAN + case LS_MEDIAN: + mtype = LS_MEDIAN + case LS_MODE: + mtype = LS_MODE + default: + } + if (mtype <= 0) + return (0) + + # Allocate working space. + call smark (sp) + call salloc (xdata, nregions, TY_REAL) + call salloc (ydata, nregions, TY_REAL) + + switch (mtype) { + case LS_MEAN: + call amovr (Memr[rg_lstatp(ls,IMEAN)], Memr[xdata], nregions) + call altmr (Memr[rg_lstatp(ls,IMEAN)], Memr[ydata], nregions, + bscale, bzero) + call asubr (Memr[rg_lstatp(ls,RMEAN)], Memr[ydata], Memr[ydata], + nregions) + case LS_MEDIAN: + call amovr (Memr[rg_lstatp(ls,IMEDIAN)], Memr[xdata], nregions) + call altmr (Memr[rg_lstatp(ls,IMEDIAN)], Memr[ydata], nregions, + bscale, bzero) + call asubr (Memr[rg_lstatp(ls,RMEDIAN)], Memr[ydata], Memr[ydata], + nregions) + case LS_MODE: + call amovr (Memr[rg_lstatp(ls,IMODE)], Memr[xdata], nregions) + call altmr (Memr[rg_lstatp(ls,IMODE)], Memr[ydata], nregions, + bscale, bzero) + call asubr (Memr[rg_lstatp(ls,RMODE)], Memr[ydata], Memr[ydata], + nregions) + } + + region = rg_lpfind (gd, 1, wx, wy, Memr[xdata], Memr[ydata], nregions) + + call sfree (sp) + + return (region) +end + + +# RG_BZFFIND -- Find a point computed from the bscale and bzero fits +# to all the regions. + +int procedure rg_bzffind (gd, ls, wcs, wx, wy) + +pointer gd #I pointer to the graphics stream +pointer ls #I pointer to the linmatch structure +int wcs #I the input wcs +real wx #I the input x coordinate +real wy #I the input y coordinate + +int i, nregions, region +pointer sp, xreg +int rg_lstati(), rg_lpfind() +pointer rg_lstatp() + +begin + nregions = rg_lstati (ls, NREGIONS) + if (nregions <= 1) + return (0) + + call smark (sp) + call salloc (xreg, nregions, TY_REAL) + do i = 1, nregions + Memr[xreg+i-1] = i + + if (wcs == 1) + region = rg_lpfind (gd, 1, wx, wy, Memr[xreg], Memr[rg_lstatp(ls, + RBSCALE)], nregions) + else if (wcs == 2) + region = rg_lpfind (gd, 2, wx, wy, Memr[xreg], Memr[rg_lstatp(ls, + RBZERO)], nregions) + else + region = 0 + + call sfree (sp) + + return (region) +end + + +# RG_BZRFIND -- Find a point computed from the bscale and bzero fit +# residuals to all the regions. + +int procedure rg_bzrfind (gd, ls, wcs, wx, wy, bscale, bzero) + +pointer gd #I pointer to the graphics stream +pointer ls #I pointer to the linmatch structure +int wcs #I the input wcs +real wx #I the input x coordinate +real wy #I the input y coordinate +real bscale #I the input bscale value +real bzero #I the input bscale value + +int i, nregions, region +pointer sp, xreg, yreg +int rg_lstati(), rg_lpfind() +pointer rg_lstatp() + +begin + nregions = rg_lstati (ls, NREGIONS) + if (nregions <= 1) + return (0) + + call smark (sp) + call salloc (xreg, nregions, TY_REAL) + call salloc (yreg, nregions, TY_REAL) + + do i = 1, nregions + Memr[xreg+i-1] = i + + if (wcs == 1) { + call asubkr (Memr[rg_lstatp(ls,RBSCALE)], bscale, Memr[yreg], + nregions) + region = rg_lpfind (gd, 1, wx, wy, Memr[xreg], Memr[yreg], + nregions) + } else if (wcs == 2) { + call asubkr (Memr[rg_lstatp(ls,RBZERO)], bzero, Memr[yreg], + nregions) + region = rg_lpfind (gd, 2, wx, wy, Memr[xreg], Memr[yreg], + nregions) + } else + region = 0 + + call sfree (sp) + + return (region) +end + + +# RG_MSFFIND -- Find a point computed from the bscale and bzero fits +# to all the regions. + +int procedure rg_msffind (gd, ls, wcs, wx, wy) + +pointer gd #I pointer to the graphics stream +pointer ls #I pointer to the linmatch structure +int wcs #I the input wcs +real wx #I the input x coordinate +real wy #I the input y coordinate + +int nregions, region +int rg_lstati(), rg_lpfind() +pointer rg_lstatp() + +begin + nregions = rg_lstati (ls, NREGIONS) + if (nregions <= 1) + return (0) + + if (wcs == 1) + region = rg_lpfind (gd, 1, wx, wy, Memr[rg_lstatp(ls,IMAG)], + Memr[rg_lstatp(ls,RMAG)], nregions) + else if (wcs == 2) + region = rg_lpfind (gd, 2, wx, wy, Memr[rg_lstatp(ls,ISKY)], + Memr[rg_lstatp(ls,RSKY)], nregions) + else + region = 0 + + return (region) +end + + +# RG_MSRFIND -- Find a point computed from the bscale and bzero fits +# to all the regions. + +int procedure rg_msrfind (gd, ls, wcs, wx, wy, bscale, bzero) + +pointer gd #I pointer to the graphics stream +pointer ls #I pointer to the linmatch structure +int wcs #I the input wcs +real wx #I the input x coordinate +real wy #I the input y coordinate +real bscale #I the input bscale value +real bzero #I the input bzero value + +int nregions, region +pointer sp, resid +int rg_lstati(), rg_lpfind() +pointer rg_lstatp() + +begin + nregions = rg_lstati (ls, NREGIONS) + if (nregions <= 1) + return (0) + + call smark (sp) + call salloc (resid, nregions, TY_REAL) + + if (wcs == 1) { + if (bscale > 0.0) { + call aaddkr (Memr[rg_lstatp(ls,IMAG)], -2.5*log10(bscale), + Memr[resid], nregions) + call asubr (Memr[rg_lstatp(ls,RMAG)], Memr[resid], Memr[resid], + nregions) + } else + call asubr (Memr[rg_lstatp(ls,RMAG)], Memr[rg_lstatp(ls,IMAG)], + Memr[resid], nregions) + region = rg_lpfind (gd, 1, wx, wy, Memr[rg_lstatp(ls,IMAG)], + Memr[resid], nregions) + } else if (wcs == 2) { + call altmr (Memr[rg_lstatp(ls,ISKY)], Memr[resid], nregions, + bscale, bzero) + call asubr (Memr[rg_lstatp(ls,RSKY)], Memr[resid], Memr[resid], + nregions) + region = rg_lpfind (gd, 2, wx, wy, Memr[rg_lstatp(ls,ISKY)], + Memr[resid], nregions) + } else + region = 0 + + call sfree (sp) + + return (region) +end + + +# RG_LPDELETE -- Delete a point from the plot. + +int procedure rg_lpdelete (gd, wcs, wx, wy, xdata, ydata, delete, udelete, npts) + +pointer gd #I the graphics stream descriptor +int wcs #I the input wcs +real wx, wy #I the point to be deleted. +real xdata[ARB] #I the input x data array +real ydata[ARB] #I the input y data array +int delete[ARB] #I the deletions array +int udelete[ARB] #I/O the user deletions array +int npts #I the number of points + +int i, region +real wx0, wy0, r2min, r2, x0, y0 + +begin + call gctran (gd, wx, wy, wx0, wy0, wcs, 0) + r2min = MAX_REAL + region = 0 + + # Find the point to be deleted. + do i = 1, npts { + if (delete[i] != LS_NO) + next + call gctran (gd, xdata[i], ydata[i], x0, y0, wcs, 0) + r2 = (x0 - wx0) ** 2 + (y0 - wy0) ** 2 + if (r2 < r2min) { + r2min = r2 + region = i + } + } + + if (region > 0) { + call gseti (gd, G_WCS, wcs) + call gscur (gd, xdata[region], ydata[region]) + call gmark (gd, xdata[region], ydata[region], GM_CROSS, 2.0, 2.0) + udelete[region] = YES + } + + return (region) +end + + +# RG_LPUNDELETE -- Undelete a point from the plot. + +int procedure rg_lpundelete (gd, wcs, wx, wy, xdata, ydata, delete, + udelete, npts) + +pointer gd #I the graphics stream descriptor +int wcs #I the input wcs +real wx, wy #I the point to be deleted. +real xdata[ARB] #I the input x data array +real ydata[ARB] #I the input y data array +int delete[ARB] #I the deletions array +int udelete[ARB] #I/O the user deletions array +int npts #I the number of points + +int i, region +real wx0, wy0, r2min, r2, x0, y0 + +begin + call gctran (gd, wx, wy, wx0, wy0, wcs, 0) + r2min = MAX_REAL + region = 0 + + # Find the point to be deleted. + do i = 1, npts { + if (udelete[i] == NO) + next + call gctran (gd, xdata[i], ydata[i], x0, y0, wcs, 0) + r2 = (x0 - wx0) ** 2 + (y0 - wy0) ** 2 + if (r2 < r2min) { + r2min = r2 + region = i + } + } + + if (region > 0) { + call gseti (gd, G_WCS, wcs) + call gscur (gd, xdata[region], ydata[region]) + call gseti (gd, G_PMLTYPE, GL_CLEAR) + call gmark (gd, xdata[region], ydata[region], GM_CROSS, 2.0, 2.0) + call gseti (gd, G_PMLTYPE, GL_SOLID) + call gmark (gd, xdata[region], ydata[region], GM_BOX, 2.0, 2.0) + udelete[region] = NO + } + + return (region) +end + + +# RG_LPFIND -- Find a point in the plot. + +int procedure rg_lpfind (gd, wcs, wx, wy, xdata, ydata, npts) + +pointer gd #I the graphics stream descriptor +int wcs #I the input wcs +real wx, wy #I the point to be deleted. +real xdata[ARB] #I the input x data array +real ydata[ARB] #I the input y data array +int npts #I the number of points + +int i, region +real wx0, wy0, r2min, x0, y0, r2 + +begin + call gctran (gd, wx, wy, wx0, wy0, wcs, 0) + r2min = MAX_REAL + region = 0 + + # Find the point to be deleted. + do i = 1, npts { + call gctran (gd, xdata[i], ydata[i], x0, y0, wcs, 0) + r2 = (x0 - wx0) ** 2 + (y0 - wy0) ** 2 + if (r2 < r2min) { + r2min = r2 + region = i + } + } + + return (region) +end + diff --git a/pkg/images/immatch/src/linmatch/rgliscale.x b/pkg/images/immatch/src/linmatch/rgliscale.x new file mode 100644 index 00000000..e760c7f8 --- /dev/null +++ b/pkg/images/immatch/src/linmatch/rgliscale.x @@ -0,0 +1,593 @@ +include <gset.h> +include <imhdr.h> +include <ctype.h> +include "linmatch.h" + +# Define the help files. +define HELPFILE "immatch$src/linmatch/linmatch.key" + +# RG_LISCALE -- Scale the output image interactively. + +int procedure rg_liscale (imr, im1, im2, db, dformat, reglist, rpfd, ipfd, sfd, + ls, gd, id) + +pointer imr #I/O pointer to the reference image +pointer im1 #I/O pointer to the input image +pointer im2 #I/O pointer to the output image +pointer db #I/O pointer to the database file +int dformat #I is the scale file in database format +pointer reglist #I/O the regions list descriptor +int rpfd #I/O the reference photometry file descriptor +int ipfd #I/O the input photometry file descriptor +int sfd #I/O the shifts file descriptor +pointer ls #I pointer to the linmatch structure +pointer gd #I the graphics stream pointer +pointer id #I display stream pointer + +int i, newref, newimage, newfit, newavg, newplot, plottype, wcs, key, reg +int hplot, lplot, lplot_type +pointer sp, cmd, udelete, stat +real bscale, bzero, bserr, bzerr, wx, wy +int rg_lstati(), rg_lplot(), clgcur(), rg_lgqverify(), rg_lgtverify() +int rg_ldelete(), rg_lfind(), rg_mmhplot(), rg_rifplot(), rg_rirplot() +int rg_lregions() +pointer rg_lstatp() + +begin + call gdeactivate (gd, 0) + + call smark (sp) + call salloc (cmd, SZ_LINE, TY_CHAR) + call salloc (udelete, rg_lstati(ls, MAXNREGIONS), TY_INT) + + # Initialize the fitting. + newref = YES + newimage = YES + newfit = YES + newavg = YES + + # Initialize the plotting. + switch (rg_lstati(ls, BZALGORITHM)) { + case LS_MEAN, LS_MEDIAN, LS_MODE: + if (rg_lstati (ls, NREGIONS) > 1) + plottype = LS_MMFIT + else + plottype = LS_MMHIST + case LS_FIT: + if (rg_lstati (ls, NREGIONS) > 1) + plottype = LS_BSZFIT + else + plottype = LS_RIFIT + case LS_PHOTOMETRY: + plottype = LS_BSZFIT + default: + } + switch (rg_lstati(ls, BSALGORITHM)) { + case LS_MEAN, LS_MEDIAN, LS_MODE: + if (rg_lstati (ls, NREGIONS) > 1) + plottype = LS_MMFIT + else + plottype = LS_MMHIST + case LS_FIT: + if (rg_lstati (ls, NREGIONS) > 1) + plottype = LS_BSZFIT + else + plottype = LS_RIFIT + case LS_PHOTOMETRY: + plottype = LS_BSZFIT + default: + } + + # Do the initial fit. + if (rg_lstati (ls, NREGIONS) <= 0) { + call gclear (gd) + call gflush (gd) + bscale = 1.0; bzero = 0.0 + bserr = INDEFR; bzerr = INDEFR + call printf ("The regions/photometry list is empty\n") + } else { + call amovki (LS_NO, Memi[rg_lstatp(ls,RDELETE)], rg_lstati(ls, + NREGIONS)) + call rg_scale (imr, im1, ls, bscale, bzero, bserr, bzerr, YES) + call amovki (NO, Memi[udelete], rg_lstati(ls,NREGIONS)) + if (rg_lplot (gd, imr, im1, ls, Memi[udelete], 1, bscale, bzero, + plottype) == OK) { + newref = NO + newimage = NO + newfit = NO + newavg = NO + call rg_lpwrec (ls, 0) + } else { + call gclear (gd) + call gflush (gd) + call rg_lstats (ls, IMAGE, Memc[cmd], SZ_FNAME) + call printf ("Error computing scale factors for image %s\n") + call pargstr (Memc[cmd]) + } + } + newplot = NO + + # Loop over the cursor commands. + while (clgcur ("gcommands", wx, wy, wcs, key, Memc[cmd], SZ_LINE) != + EOF) { + + switch (key) { + + # Print the help page. + case '?': + call gpagefile (gd, HELPFILE, "") + + # Quit the task gracefully. + case 'q': + if (rg_lgqverify ("linmatch", db, dformat, ls, + key) == YES) { + call sfree (sp) + return (rg_lgtverify (key)) + } + + # Refit the data. + case 'f': + if (newref == YES || newimage == YES || newfit == YES || + newavg == YES) { + if (rg_lstati(ls, BSALGORITHM) != LS_PHOTOMETRY && + rg_lstati(ls, BZALGORITHM) != LS_PHOTOMETRY) { + if (newref == YES) { + if (rg_lregions (reglist, imr, ls, 1, YES) > 0) + ; + } else if (newimage == YES) { + call rg_lindefr (ls) + } + } + if (newfit == YES) + call amovki (LS_NO, Memi[rg_lstatp(ls,RDELETE)], + rg_lstati(ls,NREGIONS)) + else if (newavg == YES) { + do i = 1, rg_lstati(ls,NREGIONS) { + if (Memi[rg_lstatp(ls,RDELETE)+i-1] == + LS_DELETED || Memi[rg_lstatp(ls, + RDELETE)+i-1] == LS_BADSIGMA) + Memi[rg_lstatp(ls,RDELETE)+i-1] = LS_NO + } + + } + do i = 1, rg_lstati(ls,NREGIONS) { + if (Memi[udelete+i-1] == YES) + Memi[rg_lstatp(ls,RDELETE)+i-1] = LS_DELETED + } + if (newfit == YES) + call rg_scale (imr, im1, ls, bscale, bzero, bserr, + bzerr, YES) + else if (newavg == YES) + call rg_scale (imr, im1, ls, bscale, bzero, bserr, + bzerr, NO) + newref = NO + newimage = NO + newfit = NO + newavg = NO + newplot = YES + } + + # Plot the default graph. + case 'g': + switch (rg_lstati(ls, BZALGORITHM)) { + case LS_MEAN, LS_MEDIAN, LS_MODE: + if (rg_lstati (ls, NREGIONS) > 1) { + if (plottype != LS_MMFIT) + newplot = YES + plottype = LS_MMFIT + } else { + if (plottype != LS_MMHIST) + newplot = YES + plottype = LS_MMHIST + } + case LS_FIT: + if (rg_lstati (ls, NREGIONS) > 1) { + if (plottype != LS_BSZFIT) + newplot = YES + plottype = LS_BSZFIT + } else { + if (plottype != LS_RIFIT) + newplot = YES + plottype = LS_RIFIT + } + case LS_PHOTOMETRY: + if (plottype != LS_BSZFIT) + newplot = YES + plottype = LS_BSZFIT + default: + } + switch (rg_lstati(ls, BSALGORITHM)) { + case LS_MEAN, LS_MEDIAN, LS_MODE: + if (rg_lstati (ls, NREGIONS) > 1) { + if (plottype != LS_MMFIT) + newplot = YES + plottype = LS_MMFIT + } else { + if (plottype != LS_MMHIST) + newplot = YES + plottype = LS_MMHIST + } + case LS_FIT: + if (rg_lstati (ls, NREGIONS) > 1) { + if (plottype != LS_BSZFIT) + plottype = LS_BSZFIT + } else { + if (plottype != LS_RIFIT) + plottype = LS_RIFIT + } + case LS_PHOTOMETRY: + if (plottype != LS_BSZFIT) + newplot = YES + plottype = LS_BSZFIT + default: + } + + # Graph the residuals from the current fit. + case 'i': + switch (rg_lstati(ls, BZALGORITHM)) { + case LS_MEAN, LS_MEDIAN, LS_MODE: + if (rg_lstati (ls, NREGIONS) > 1) { + if (plottype != LS_MMRESID) + newplot = YES + plottype = LS_MMRESID + } else { + call printf ( + "There are too few regions for a residuals plot\n") + } + case LS_FIT: + if (rg_lstati (ls, NREGIONS) > 1) { + if (plottype != LS_BSZRESID) + newplot = YES + plottype = LS_BSZRESID + } else { + if (plottype != LS_RIRESID) + newplot = YES + plottype = LS_RIRESID + } + case LS_PHOTOMETRY: + if (plottype == LS_BSZFIT) { + newplot = YES + plottype = LS_BSZRESID + } else if (plottype == LS_MAGSKYFIT) { + newplot = YES + plottype = LS_MAGSKYRESID + } + default: + } + switch (rg_lstati(ls, BSALGORITHM)) { + case LS_MEAN, LS_MEDIAN, LS_MODE: + if (rg_lstati (ls, NREGIONS) > 1) { + if (plottype != LS_MMRESID) + newplot = YES + plottype = LS_MMRESID + } else { + call printf ( + "There are too few regions for a residuals plot\n") + } + case LS_FIT: + if (rg_lstati (ls, NREGIONS) > 1) { + if (plottype != LS_BSZRESID) + newplot = YES + plottype = LS_BSZRESID + } else { + if (plottype != LS_RIRESID) + newplot = YES + plottype = LS_RIRESID + } + case LS_PHOTOMETRY: + if (plottype == LS_BSZFIT) { + newplot = YES + plottype = LS_BSZRESID + } else if (plottype == LS_MAGSKYFIT) { + newplot = YES + plottype = LS_MAGSKYRESID + } + default: + } + + # Plot the histogram and show the statistics of a given region. + # selected from a plot. + case 's': + if (imr != NULL && im1 != NULL) { + reg = rg_lfind (gd, ls, wcs, wx, wy, bscale, bzero, + plottype) + if (reg > 0) { + if (rg_mmhplot (gd, imr, im1, ls, Memi[udelete], + reg) == OK) { + call rg_lpwrec (ls, reg) + } else { + call printf ( + "Unable to plot statistics for region %d\n") + call pargi (reg) + } + } else + call printf ("Unable to plot region statistics\n") + } else + call printf ( + "The reference or input image is undefined\n") + + # Trace the fit of a given region selected from a plot. + case 't': + if (imr != NULL && im1 != NULL && (rg_lstati(ls, + BSALGORITHM) == LS_FIT || rg_lstati(ls,BZALGORITHM) == + LS_FIT)) { + reg = rg_lfind (gd, ls, wcs, wx, wy, bscale, bzero, + plottype) + if (reg > 0) { + if (plottype == LS_BSZFIT) + stat = rg_rifplot (gd, imr, im1, ls, + Memi[udelete], reg) + else if (plottype == LS_BSZRESID) + stat = rg_rirplot (gd, imr, im1, ls, + Memi[udelete], reg) + else + stat = ERR + if (stat == OK) + call rg_lpwrec (ls, reg) + else { + call printf ( + "Unable to plot statistics for region %d\n") + call pargi (reg) + } + } else + call printf ( + "Unable to plot region statistics\n") + } else + call printf ( + "The least squares fit is undefined\n") + + # Plot the statistics and show the histograms for each + # region in turn. + case 'h': + if (imr != NULL && im1 != NULL) { + reg = 1 + if (rg_mmhplot (gd, imr, im1, ls, Memi[udelete], + reg) == ERR) { + call printf ( + "Unable to plot statistics for region 1\n") + next + } + hplot = NO + call printf ( + "Hit [spbar=next,-=prev,s=stats,?=help,q=quit]:") + while (clgcur ("gcommands", wx, wy, wcs, key, Memc[cmd], + SZ_LINE) != EOF) { + switch (key) { + case '?': + call printf ( + "Hit [spbar=next,-=prev,s=stats,?=help,q=quit]:") + case 'q': + call printf ("\n") + break + case ' ': + if (reg < rg_lstati (ls, NREGIONS)) { + reg = reg + 1 + hplot = YES + } + case '-': + if (reg > 1) { + reg = reg - 1 + hplot = YES + } + case 's': + call rg_lpwrec (ls, reg) + } + if (hplot == YES) { + if (rg_mmhplot (gd, imr, im1, ls, + Memi[udelete], reg) == ERR) + ; + call printf ( + "Hit [spbar=next,-=prev,s=stats,?=help,q=quit]:") + hplot = NO + } + } + newplot = YES + } else + call printf ( + "The reference or input image is undefined\n") + + # Step through the least sqares fits one at a time. + case 'l': + if (imr != NULL && im1 != NULL && (rg_lstati(ls, + BSALGORITHM) == LS_FIT || rg_lstati(ls,BZALGORITHM) == + LS_FIT)) { + reg = 1 + lplot = NO + if (plottype == LS_BSZFIT || plottype == LS_RIFIT) + lplot_type = LS_RIFIT + else if (plottype == LS_BSZRESID || plottype == + LS_RIRESID) + lplot_type = LS_RIRESID + if (lplot_type == LS_RIFIT) + stat = rg_rifplot (gd, imr, im1, ls, Memi[udelete], + reg) + else if (lplot_type == LS_RIRESID) + stat = rg_rirplot (gd, imr, im1, ls, Memi[udelete], + reg) + else + stat = ERR + if (stat == ERR) { + call printf ("Unable to plot fits for region 1\n") + next + } + call printf ( + "Hit [spbar=next,-=prev,l=fit,i=resid,s=stats,?=help,q=quit]:") + while (clgcur ("gcommands", wx, wy, wcs, key, Memc[cmd], + SZ_LINE) != EOF) { + switch (key) { + case '?': + call printf ( + "Hit [spbar=next,-=prev,l=fit,i=resid,s=stats,?=help,q=quit]:") + case 'q': + call printf ("\n") + break + case ' ': + if (reg < rg_lstati (ls, NREGIONS)) { + reg = reg + 1 + lplot = YES + } + case '-': + if (reg > 1) { + reg = reg - 1 + lplot = YES + } + case 'l': + if (lplot_type == LS_RIRESID) + lplot = YES + lplot_type = LS_RIFIT + case 'i': + if (lplot_type == LS_RIFIT) + lplot = YES + lplot_type = LS_RIRESID + case 's': + call rg_lpwrec (ls, reg) + } + if (lplot == YES) { + if (lplot_type == LS_RIFIT) + stat = rg_rifplot (gd, imr, im1, ls, + Memi[udelete], reg) + else if (lplot_type == LS_RIRESID) + stat = rg_rirplot (gd, imr, im1, ls, + Memi[udelete], reg) + call printf ( + "Hit [spbar=next,-=prev,l=fit,i=resid,s=stats,?=help,q=quit]:") + lplot = NO + } + } + newplot = YES + } else + call printf ( + "The least squares fit is undefined\n") + + # Plot the photometry + case 'p': + if (rg_lstati(ls,BSALGORITHM) == LS_PHOTOMETRY || + rg_lstati(ls,BZALGORITHM) == LS_PHOTOMETRY) { + plottype = LS_MAGSKYFIT + newplot = YES + } else + call printf ("The input photometry is undefined\n") + + # Replot the current graph. + case 'r': + newplot = YES + + # Delete or undelete a region. + case 'd', 'u': + if (key == 'd') + reg = rg_ldelete (gd, ls, Memi[udelete], wcs, wx, wy, + bscale, bzero, plottype, YES) + else + reg = rg_ldelete (gd, ls, Memi[udelete], wcs, wx, wy, + bscale, bzero, plottype, NO) + if (reg > 0) + newavg = YES + + + # Process colon commands. + case ':': + call rg_lcolon (gd, ls, imr, im1, im2, db, dformat, + reglist, rpfd, ipfd, sfd, Memc[cmd], newref, + newimage, newfit, newavg) + + # Write the parameters to the parameter file. + case 'w': + call rg_plpars (ls) + + # Do nothing gracefully. + default: + } + + if (newplot == YES) { + if (rg_lstati(ls,NREGIONS) <= 0) { + call gclear (gd) + call gflush (gd) + bscale = 1.0; bzero = 0.0 + bserr = INDEFR; bzerr = INDEFR + call printf ("The regions/photometry list is empty\n") + } else if (newref == YES || newimage == YES) { + call printf ("Bscale and bzero must be recomputed\n") + } else if (rg_lplot (gd, imr, im1, ls, Memi[udelete], 1, + bscale, bzero, plottype) == OK) { + if (newfit == YES || newavg == YES) + call printf ("Bscale and bzero should be recomputed\n") + else + call rg_lpwrec (ls, 0) + newplot = NO + } else + call printf ("Unable to plot image data for region 1\n") + } + + } + + call sfree (sp) +end + +define QUERY "Hit [return=continue, n=next image, q=quit, w=quit and update parameters]: " + +# RG_LGQVERIFY -- Print a message on the status line asking the user if they +# really want to quit, returning YES if they really want to quit, NO otherwise. + +int procedure rg_lgqverify (task, db, dformat, rg, ch) + +char task[ARB] #I the calling task name +pointer db #I pointer to the shifts database file +int dformat #I is the shifts file in database format +pointer rg #I pointer to the task structure +int ch #I the input keystroke command + +int wcs, stat +pointer sp, cmd +real wx, wy +bool streq() +int clgcur() + +begin + call smark (sp) + call salloc (cmd, SZ_LINE, TY_CHAR) + + # Print the status line query in reverse video and get the keystroke. + call printf (QUERY) + #call flush (STDOUT) + if (clgcur ("gcommands", wx, wy, wcs, ch, Memc[cmd], SZ_LINE) == EOF) + ; + + # Process the command. + if (ch == 'q') { + call rg_lwrec (db, dformat, rg) + stat = YES + } else if (ch == 'w') { + call rg_lwrec (db, dformat, rg) + if (streq ("linmatch", task)) + call rg_plpars (rg) + stat = YES + } else if (ch == 'n') { + call rg_lwrec (db, dformat, rg) + stat = YES + } else { + stat = NO + } + + call sfree (sp) + return (stat) +end + + +# RG_LGTVERIFY -- Verify whether or not the user truly wishes to quit the +# task. + +int procedure rg_lgtverify (ch) + +int ch #I the input keystroke command + +begin + if (ch == 'q') { + return (YES) + } else if (ch == 'w') { + return (YES) + } else if (ch == 'n') { + return (NO) + } else { + return (NO) + } +end diff --git a/pkg/images/immatch/src/linmatch/rglpars.x b/pkg/images/immatch/src/linmatch/rglpars.x new file mode 100644 index 00000000..d5f66320 --- /dev/null +++ b/pkg/images/immatch/src/linmatch/rglpars.x @@ -0,0 +1,104 @@ +include <lexnum.h> +include "linmatch.h" + + +# RG_GLPARS -- Fetch the algorithm parameters required by the intensity scaling +# task. + +procedure rg_glpars (ls) + +pointer ls #I pointer to iscale structure + +int ip, nchars +pointer sp, str1, str2 +int clgeti(), nscan(), lexnum() +real clgetr() + +begin + # Allocate working space. + call smark (sp) + call salloc (str1, SZ_LINE, TY_CHAR) + call salloc (str2, SZ_LINE, TY_CHAR) + + # Initialize the linscale structure. + call rg_linit (ls, clgeti ("maxnregions")) + + # Get the x and y shifts. + call rg_lsetr (ls, XSHIFT, clgetr("xshift")) + call rg_lsetr (ls, YSHIFT, clgetr("yshift")) + + # Get the scaling algorithm parameters. + call clgstr ("scaling", Memc[str1], SZ_LINE) + call sscan (Memc[str1]) + call gargwrd (Memc[str1], SZ_LINE) + call gargwrd (Memc[str2], SZ_LINE) + call rg_lsets (ls, BSSTRING, Memc[str1]) + ip = 1 + if (nscan() == 2) + call rg_lsets (ls, BZSTRING, Memc[str2]) + else if (lexnum(Memc[str1], ip, nchars) == LEX_NONNUM) + call rg_lsets (ls, BZSTRING, Memc[str1]) + else + call rg_lsets (ls, BZSTRING, "0.0") + + call rg_lseti (ls, DNX, clgeti ("dnx")) + call rg_lseti (ls, DNY, clgeti ("dny")) + call rg_lseti (ls, MAXITER, clgeti ("maxiter")) + call rg_lsetr (ls, DATAMIN, clgetr ("datamin")) + call rg_lsetr (ls, DATAMAX, clgetr ("datamax")) + call rg_lseti (ls, NREJECT, clgeti ("nreject")) + call rg_lsetr (ls, LOREJECT, clgetr ("loreject")) + call rg_lsetr (ls, HIREJECT, clgetr ("hireject")) + + call clgstr ("gain", Memc[str1], SZ_LINE) + call rg_lsets (ls, CCDGAIN, Memc[str1]) + call clgstr ("readnoise", Memc[str1], SZ_LINE) + call rg_lsets (ls, CCDREAD, Memc[str1]) + + call sfree (sp) +end + + +# RG_PLPARS -- Save the intensity scaling parameters in the .par file. + +procedure rg_plpars (ls) + +pointer ls # pointer to the linscale structure + +pointer sp, str1, str2, str +int rg_lstati() +real rg_lstatr() + +begin + # Allocate working space. + call smark (sp) + call salloc (str1, SZ_LINE, TY_CHAR) + call salloc (str2, SZ_LINE, TY_CHAR) + call salloc (str, SZ_LINE, TY_CHAR) + + # Set the x and y shifts parameters. + call clputr ("xshift", rg_lstatr (ls, XSHIFT)) + call clputr ("yshift", rg_lstatr (ls, YSHIFT)) + + # Scaling algorithm parameters. + call rg_lstats (ls, BSSTRING, Memc[str1], SZ_LINE) + call rg_lstats (ls, BZSTRING, Memc[str2], SZ_LINE) + call sprintf (Memc[str], SZ_FNAME, "%s %s") + call pargstr (Memc[str1]) + call pargstr (Memc[str2]) + call clpstr ("scaling", Memc[str]) + call clputi ("dnx", rg_lstati (ls, DNX)) + call clputi ("dny", rg_lstati (ls, DNY)) + call clputi ("maxiter", rg_lstati (ls, MAXITER)) + call clputr ("datamin", rg_lstatr (ls, DATAMIN)) + call clputr ("datamax", rg_lstatr (ls, DATAMAX)) + call clputi ("nreject", rg_lstati (ls, NREJECT)) + call clputr ("loreject", rg_lstatr (ls, LOREJECT)) + call clputr ("hireject", rg_lstatr (ls, HIREJECT)) + call rg_lstats (ls, CCDGAIN, Memc[str], SZ_FNAME) + call clpstr ("gain", Memc[str]) + call rg_lstats (ls, CCDREAD, Memc[str], SZ_FNAME) + call clpstr ("readnoise", Memc[str]) + + call sfree (sp) +end diff --git a/pkg/images/immatch/src/linmatch/rglplot.x b/pkg/images/immatch/src/linmatch/rglplot.x new file mode 100644 index 00000000..e46f3bcd --- /dev/null +++ b/pkg/images/immatch/src/linmatch/rglplot.x @@ -0,0 +1,1592 @@ +include <mach.h> +include <gset.h> +include "linmatch.h" + +define MINFRACTION 0.01 +define FRACTION 0.05 + +# XP_LPLOT -- Plot the data. + +int procedure rg_lplot (gd, imr, im1, ls, udelete, region, bscale, bzero, + plot_type) + +pointer gd #I pointer to the graphics stream +pointer imr #I pointer to the reference image +pointer im1 #I pointer to the input image +pointer ls #I pointer to the linmatch structure +int udelete[ARB] #I the user deletions array +int region #I the current region if applicable +real bscale #I the computed bscale value +real bzero #I the computed bzero value +int plot_type #I the current plot type + +int stat +int rg_mmhplot(), rg_mmfplot(), rg_mmrplot(), rg_rifplot(), rg_rirplot() +int rg_bzfplot(), rg_bzrplot(), rg_msfplot(), rg_msrplot() + +begin + stat = OK + + switch (plot_type) { + case LS_MMHIST: + stat = rg_mmhplot (gd, imr, im1, ls, udelete, region) + case LS_MMFIT: + stat = rg_mmfplot (gd, ls, udelete, bscale, bzero) + case LS_MMRESID: + stat = rg_mmrplot (gd, ls, udelete, bscale, bzero) + case LS_RIFIT: + stat = rg_rifplot (gd, imr, im1, ls, udelete, region) + case LS_RIRESID: + stat = rg_rirplot (gd, imr, imr, ls, udelete, region) + case LS_BSZFIT: + stat = rg_bzfplot (gd, ls, udelete, bscale, bzero) + case LS_BSZRESID: + stat = rg_bzrplot (gd, ls, udelete, bscale, bzero) + case LS_MAGSKYFIT: + stat = rg_msfplot (gd, ls, udelete, bscale, bzero) + case LS_MAGSKYRESID: + stat = rg_msrplot (gd, ls, udelete, bscale, bzero) + default: + stat = ERR + } + + return (stat) +end + + +# RG_MMHPLOT -- Plot the histogram of the data used to compute the mean, median,# and mode. + +int procedure rg_mmhplot (gd, imr, im1, ls, udelete, region) + +pointer gd #I pointer to the graphics stream +pointer imr #I pointer to the reference image +pointer im1 #I pointer to the input image +pointer ls #I pointer to the linmatch structure +int udelete[ARB] #I the user deleteions array +int region #I the current region if applicable + +int nbinsr, nbins1 +pointer rbuf, ibuf, sp, hgmi, hgmr, image, title, str +real rsigma, hminr, hmaxr, dhr, isigma, hmin1, hmax1, dh1, ymin, ymax +int rg_lstati(), rg_limget() +pointer rg_lstatp() + +begin + # Get the data. + if (imr == NULL || im1 == NULL) { + return (ERR) + } else if (region == rg_lstati (ls,CNREGION) && + rg_lstatp (ls,RBUF) != NULL && rg_lstatp(ls, IBUF) != NULL) { + rbuf = rg_lstatp (ls, RBUF) + ibuf = rg_lstatp (ls, IBUF) + } else if (rg_limget (ls, imr, im1, region) == OK) { + rbuf = rg_lstatp (ls, RBUF) + ibuf = rg_lstatp (ls, IBUF) + } else { + return (ERR) + } + + # Get the reference image binning parameters. + rsigma = sqrt (real(Memi[rg_lstatp(ls,RNPTS)+region-1])) * + Memr[rg_lstatp(ls,RSIGMA)+region-1] + hminr = Memr[rg_lstatp(ls,RMEDIAN)+region-1] - LMODE_HWIDTH * rsigma + hmaxr = Memr[rg_lstatp(ls,RMEDIAN)+region-1] + LMODE_HWIDTH * rsigma + dhr = LMODE_ZBIN * rsigma + if (dhr <= 0.0) + return (ERR) + nbinsr = (hmaxr - hminr) / dhr + 1 + if (nbinsr <= 0) + return (ERR) + + # Get the input image binning parameters. + isigma = sqrt (real(Memi[rg_lstatp(ls,INPTS)+region-1])) * + Memr[rg_lstatp(ls,ISIGMA)+region-1] + hmin1 = Memr[rg_lstatp(ls,IMEDIAN)+region-1] - LMODE_HWIDTH * isigma + hmax1 = Memr[rg_lstatp(ls,IMEDIAN)+region-1] + LMODE_HWIDTH * isigma + dh1 = LMODE_ZBIN * isigma + if (dh1 <= 0.0) + return (ERR) + nbins1 = (hmax1 - hmin1) / dh1 + 1 + if (nbins1 <= 0.0) + return (ERR) + + # Allocate working space. + call smark (sp) + call salloc (hgmi, max (nbinsr, nbins1), TY_INT) + call salloc (hgmr, max (nbinsr, nbins1), TY_REAL) + call salloc (image, SZ_FNAME, TY_CHAR) + call salloc (title, 2 * SZ_LINE, TY_CHAR) + call salloc (str, SZ_LINE, TY_CHAR) + + call gclear (gd) + + # Create the reference histogram. + call aclri (Memi[hgmi], nbinsr) + call ahgmr (Memr[rbuf], Memi[rg_lstatp(ls,RNPTS)+region-1], + Memi[hgmi], nbinsr, hminr, hmaxr) + call achtir (Memi[hgmi], Memr[hgmr], nbinsr) + call alimr (Memr[hgmr], nbinsr, ymin, ymax) + + # Compute the limits for the reference histogram. + call gseti (gd, G_WCS, 1) + call gsview (gd, 0.1, 0.9, 0.6, 0.9) + call gswind (gd, hminr, hmaxr, ymin, ymax) + call rg_pfill (gd, hminr, hmaxr, ymin, ymax, GF_SOLID, 0) + call rg_lstats (ls, REFIMAGE, Memc[image], SZ_FNAME) + call sprintf (Memc[str], SZ_LINE, + "Mean = %g Median = %g Mode = %g Sigma = %g") + call pargr (Memr[rg_lstatp(ls,RMEAN)+region-1]) + call pargr (Memr[rg_lstatp(ls,RMEDIAN)+region-1]) + call pargr (Memr[rg_lstatp(ls,RMODE)+region-1]) + call pargr (rsigma) + + # Create the title for the reference histogram. + call sprintf (Memc[title], 2 * SZ_LINE, + "Ref Image: %s Region: %d%s\nNbins = %d Hmin = %g Hmax = %g Dh = %g\n%s\n") + call pargstr (Memc[image]) + call pargi (region) + if (udelete[region] == YES) + call pargstr (" [deleted]") + else if (Memi[rg_lstatp(ls,RDELETE)+region-1] != LS_NO) + call pargstr (" [rejected]") + else + call pargstr ("") + call pargi (nbinsr) + call pargr (hminr) + call pargr (hmaxr) + call pargr (dhr) + call pargstr (Memc[str]) + call gseti (gd, G_YNMINOR, 0) + call glabax (gd, Memc[title], "", "") + + # Plot the reference histogram. + call rg_lhbox (gd, Memr[hgmr], nbinsr, hminr - dhr / 2.0, + hmaxr + dhr / 2.0) + + # Create the input histogram. + call aclri (Memi[hgmi], nbins1) + call ahgmr (Memr[ibuf], Memi[rg_lstatp(ls,INPTS)+region-1], + Memi[hgmi], nbins1, hmin1, hmax1) + call achtir (Memi[hgmi], Memr[hgmr], nbins1) + call alimr (Memr[hgmr], nbins1, ymin, ymax) + + # Compute the limits for the input histogram. + call gseti (gd, G_WCS, 2) + call gsview (gd, 0.1, 0.9, 0.1, 0.4) + call gswind (gd, hmin1, hmax1, ymin, ymax) + call rg_pfill (gd, hmin1, hmax1, ymin, ymax, GF_SOLID, 0) + + # Create the title for the input histogram. + call rg_lstats (ls, IMAGE, Memc[image], SZ_FNAME) + call sprintf (Memc[str], SZ_LINE, + "Mean = %g Median = %g Mode = %g Sigma = %g") + call pargr (Memr[rg_lstatp(ls,IMEAN)+region-1]) + call pargr (Memr[rg_lstatp(ls,IMEDIAN)+region-1]) + call pargr (Memr[rg_lstatp(ls,IMODE)+region-1]) + call pargr (isigma) + call sprintf (Memc[title], 2 * SZ_LINE, + "Input Image: %s Region: %d%s\nNbins = %d Hmin = %g Hmax = %g Dh = %g\n%s\n") + call pargstr (Memc[image]) + call pargi (region) + if (udelete[region] == YES) + call pargstr (" [deleted]") + else if (Memi[rg_lstatp(ls,RDELETE)+region-1] != NO) + call pargstr (" [rejected]") + else + call pargstr ("") + call pargi (nbins1) + call pargr (hmin1) + call pargr (hmax1) + call pargr (dh1) + call pargstr (Memc[str]) + call gseti (gd, G_YNMINOR, 0) + call glabax (gd, Memc[title], "", "") + + # Plot the input histogram. + call rg_lhbox (gd, Memr[hgmr], nbins1, hmin1 - dh1 / 2.0, + hmax1 + dh1 / 2.0) + + call sfree (sp) + + return (OK) +end + + +# RG_MMFPLOT -- Plot the fit computed from the mean, median, or mode. + +int procedure rg_mmfplot (gd, ls, udelete, bscale, bzero) + +pointer gd #I pointer to the graphics stream +pointer ls #I pointer to the linmatch structure +int udelete[ARB] #I the user deletions array +real bscale #I the fitted bscale value +real bzero #I the fitted bzero value + +bool start, finish +int nregions, mtype +pointer sp, title, str, imager, image1 +real xmin, xmax, ymin, ymax, diff, dxmin, dxmax, dymin, dymax, x, y +int rg_lstati() +pointer rg_lstatp() + +begin + nregions = rg_lstati (ls, NREGIONS) + if (nregions <= 1) + return (ERR) + + # Determine the type of data to plot. + mtype = 0 + switch (rg_lstati(ls, BSALGORITHM)) { + case LS_MEAN: + mtype = LS_MEAN + case LS_MEDIAN: + mtype = LS_MEDIAN + case LS_MODE: + mtype = LS_MODE + default: + } + switch (rg_lstati(ls, BZALGORITHM)) { + case LS_MEAN: + mtype = LS_MEAN + case LS_MEDIAN: + mtype = LS_MEDIAN + case LS_MODE: + mtype = LS_MODE + default: + } + if (mtype <= 0) + return (ERR) + + # Allocate working space. + call smark (sp) + call salloc (title, 2 * SZ_LINE, TY_CHAR) + call salloc (str, SZ_LINE, TY_CHAR) + call salloc (imager, SZ_LINE, TY_CHAR) + call salloc (image1, SZ_LINE, TY_CHAR) + + # Clear the plot space. + call gclear (gd) + + # Compute the limits of the plot. + switch (mtype) { + case LS_MEAN: + call rg_galimr (Memr[rg_lstatp(ls,IMEAN)], + Memi[rg_lstatp(ls,RDELETE)], nregions, xmin, xmax) + call rg_galimr (Memr[rg_lstatp(ls,RMEAN)], + Memi[rg_lstatp(ls,RDELETE)], nregions, ymin, ymax) + case LS_MEDIAN: + call rg_galimr (Memr[rg_lstatp(ls,IMEDIAN)], + Memi[rg_lstatp(ls,RDELETE)], nregions, xmin, xmax) + call rg_galimr (Memr[rg_lstatp(ls,RMEDIAN)], + Memi[rg_lstatp(ls,RDELETE)], nregions, ymin, ymax) + case LS_MODE: + call rg_galimr (Memr[rg_lstatp(ls,IMODE)], + Memi[rg_lstatp(ls,RDELETE)], nregions, xmin, xmax) + call rg_galimr (Memr[rg_lstatp(ls,RMODE)], + Memi[rg_lstatp(ls,RDELETE)], nregions, ymin, ymax) + } + dxmin = xmin + dxmax = xmax + dymin = ymin + dymax = ymax + + diff = xmax - xmin + if (diff <= 0) + diff = MINFRACTION + else + diff = max (diff, MINFRACTION * abs (xmax + xmin) / 2.0) + xmin = xmin - diff * FRACTION + xmax = xmax + diff * FRACTION + diff = ymax - ymin + if (diff <= 0.0) + diff = MINFRACTION + else + diff = max (diff, MINFRACTION * abs (ymax + ymin) / 2.0) + ymin = ymin - diff * FRACTION + ymax = ymax + diff * FRACTION + call gswind (gd, xmin, xmax, ymin, ymax) + + # Construct the titles and axis labels. + call rg_lstats (ls, REFIMAGE, Memc[imager], SZ_FNAME) + call rg_lstats (ls, IMAGE, Memc[image1], SZ_FNAME) + call sprintf (Memc[str], SZ_LINE, + "Nregions = %d Ref Image = %g * Input Image + %g") + call pargi (nregions) + call pargr (bscale) + call pargr (bzero) + call sprintf (Memc[title], 2 * SZ_LINE, + "Counts for %s versus Counts for %s\n%s\n") + call pargstr (Memc[imager]) + call pargstr (Memc[image1]) + call pargstr (Memc[str]) + call glabax (gd, Memc[title], "Input Image Counts", + "Ref Image Counts") + + # Plot the data. + switch (mtype) { + case LS_MEAN: + call rg_lxyplot (gd, Memr[rg_lstatp(ls,IMEAN)], + Memr[rg_lstatp(ls,RMEAN)], Memi[rg_lstatp(ls,RDELETE)], + udelete, nregions, GM_BOX, GM_CROSS) + case LS_MEDIAN: + call rg_lxyplot (gd, Memr[rg_lstatp(ls,IMEDIAN)], + Memr[rg_lstatp(ls,RMEDIAN)], Memi[rg_lstatp(ls,RDELETE)], + udelete, nregions, GM_BOX, GM_CROSS) + case LS_MODE: + call rg_lxyplot (gd, Memr[rg_lstatp(ls,IMODE)], + Memr[rg_lstatp(ls,RMODE)], Memi[rg_lstatp(ls,RDELETE)], + udelete, nregions, GM_BOX, GM_CROSS) + } + + # Plot the fit. + start = false + finish = false + if (! IS_INDEFR(bscale) && ! IS_INDEFR(bzero)) { + y = bscale * dxmin + bzero + if (y >= ymin && y <= ymax) { + call gamove (gd, dxmin, y) + start = true + } + y = bscale * dxmax + bzero + if (y >= ymin && y <= ymax) { + if (start) { + call gadraw (gd, dxmax, y) + finish = true + } else { + call gamove (gd, dxmax, y) + start = true + } + } + x = (dymin - bzero) / bscale + if (x >= xmin && x <= xmax) { + if (! start) { + call gamove (gd, x, dymin) + start = true + } else if (! finish) { + call gadraw (gd, x, dymin) + finish = true + } + } + x = (dymax - bzero) / bscale + if (x >= xmin && x <= xmax) { + if (! start) { + call gamove (gd, x, dymax) + start = true + } else if (! finish) { + call gadraw (gd, x, dymax) + finish = true + } + } + } + + call sfree (sp) + + return (OK) +end + + +# RG_MMRPLOT -- Plot the residuals from the fit computed from the mean, +# median, or mode. + +int procedure rg_mmrplot (gd, ls, udelete, bscale, bzero) + +pointer gd #I pointer to the graphics stream +pointer ls #I pointer to the linmatch structure +int udelete[ARB] #I the user deletions array +real bscale #I the fitted bscale value +real bzero #I the fitted bzero value + +int nregions, mtype +pointer sp, resid, title, imager, image1, str +real xmin, xmax, ymin, ymax, diff +int rg_lstati() +pointer rg_lstatp() + +begin + nregions = rg_lstati (ls, NREGIONS) + if (nregions <= 1) + return (ERR) + + # Determine the type of data to plot. + mtype = 0 + switch (rg_lstati(ls, BSALGORITHM)) { + case LS_MEAN: + mtype = LS_MEAN + case LS_MEDIAN: + mtype = LS_MEDIAN + case LS_MODE: + mtype = LS_MODE + default: + } + switch (rg_lstati(ls, BZALGORITHM)) { + case LS_MEAN: + mtype = LS_MEAN + case LS_MEDIAN: + mtype = LS_MEDIAN + case LS_MODE: + mtype = LS_MODE + default: + } + if (mtype <= 0) + return (ERR) + + # Allocate working space. + call smark (sp) + + call gclear (gd) + + # Compute the data. + call salloc (resid, nregions, TY_REAL) + switch (mtype) { + case LS_MEAN: + call altmr (Memr[rg_lstatp(ls,IMEAN)], Memr[resid], nregions, + bscale, bzero) + call asubr (Memr[rg_lstatp(ls,RMEAN)], Memr[resid], Memr[resid], + nregions) + call rg_galimr (Memr[rg_lstatp(ls,IMEAN)], + Memi[rg_lstatp(ls,RDELETE)], nregions, xmin, xmax) + call rg_galimr (Memr[resid], Memi[rg_lstatp(ls,RDELETE)], nregions, + ymin, ymax) + case LS_MEDIAN: + call altmr (Memr[rg_lstatp(ls,IMEDIAN)], Memr[resid], nregions, + bscale, bzero) + call asubr (Memr[rg_lstatp(ls,RMEDIAN)], Memr[resid], Memr[resid], + nregions) + call rg_galimr (Memr[rg_lstatp(ls,IMEDIAN)], + Memi[rg_lstatp(ls,RDELETE)], nregions, xmin, xmax) + call rg_galimr (Memr[resid], Memi[rg_lstatp(ls,RDELETE)], nregions, + ymin, ymax) + case LS_MODE: + call altmr (Memr[rg_lstatp(ls,IMODE)], Memr[resid], nregions, + bscale, bzero) + call asubr (Memr[rg_lstatp(ls,RMODE)], Memr[resid], Memr[resid], + nregions) + call rg_galimr (Memr[rg_lstatp(ls,IMODE)], + Memi[rg_lstatp(ls,RDELETE)], nregions, xmin, xmax) + call rg_galimr (Memr[resid], Memi[rg_lstatp(ls,RDELETE)], nregions, + ymin, ymax) + } + + # Compute the data limits. + diff = xmax - xmin + if (diff <= 0.0) + diff = MINFRACTION + else + diff = max (diff, MINFRACTION * abs (xmax + xmin) / 2.0) + xmin = xmin - diff * FRACTION + xmax = xmax + diff * FRACTION + diff = ymax - ymin + if (diff <= 0.0) + diff = MINFRACTION + else + diff = max (diff, MINFRACTION * abs (ymax + ymin) / 2.0) + ymin = ymin - diff * FRACTION + ymax = ymax + diff * FRACTION + call gswind (gd, xmin, xmax, ymin, ymax) + + call salloc (title, 2 * SZ_LINE, TY_CHAR) + call salloc (imager, SZ_FNAME, TY_CHAR) + call salloc (image1, SZ_FNAME, TY_CHAR) + call salloc (str, SZ_LINE, TY_CHAR) + call rg_lstats (ls, REFIMAGE, Memc[imager], SZ_FNAME) + call rg_lstats (ls, IMAGE, Memc[image1], SZ_FNAME) + call sprintf (Memc[str], SZ_LINE, + "Nregions = %d Ref Image = %g * Input Image + %g") + call pargi (nregions) + call pargr (bscale) + call pargr (bzero) + call sprintf (Memc[title], 2 * SZ_LINE, + "Residuals for %s versus Counts for %s\n%s\n") + call pargstr (Memc[imager]) + call pargstr (Memc[image1]) + call pargstr (Memc[str]) + call glabax (gd, Memc[title], "Input Image Counts", + "Residual Counts") + + # Plot the data. + switch (mtype) { + case LS_MEAN: + call rg_lxyplot (gd, Memr[rg_lstatp(ls,IMEAN)], Memr[resid], + Memi[rg_lstatp(ls,RDELETE)], udelete, nregions, + GM_BOX, GM_CROSS) + case LS_MEDIAN: + call rg_lxyplot (gd, Memr[rg_lstatp(ls,IMEDIAN)], Memr[resid], + Memi[rg_lstatp(ls,RDELETE)], udelete, nregions, + GM_BOX, GM_CROSS) + case LS_MODE: + call rg_lxyplot (gd, Memr[rg_lstatp(ls,IMODE)], Memr[resid], + Memi[rg_lstatp(ls,RDELETE)], udelete, nregions, + GM_BOX, GM_CROSS) + } + + # Plot the residuals 0 line. + call gamove (gd, xmin, 0.0) + call gadraw (gd, xmax, 0.0) + + call sfree (sp) + + return (OK) +end + + +# RG_RIFPLOT -- Plot the pixel to pixel fit for a region. + +int procedure rg_rifplot (gd, imr, im1, ls, udelete, region) + +pointer gd #I pointer to the graphics stream +pointer imr #I pointer to the reference image +pointer im1 #I pointer to the input image +pointer ls #I pointer to the linmatch structure +int udelete[ARB] #I pointer to the user deletions array +int region #I the current region + +bool start, finish +int npts +pointer rbuf, ibuf, sp, title, str, imager, image1, resid +real xmin, xmax, ymin, ymax, diff, bscale, bzero, datamin, datamax +real loreject, hireject, chi, dxmin, dxmax, dymin, dymax, x, y +int rg_lstati(), rg_limget() +pointer rg_lstatp() +real rg_lstatr() + +begin + # Get the data. + if (imr == NULL || im1 == NULL) { + return (ERR) + } else if (region == rg_lstati (ls,CNREGION) && + rg_lstatp (ls,RBUF) != NULL && rg_lstatp(ls, IBUF) != NULL) { + rbuf = rg_lstatp (ls, RBUF) + ibuf = rg_lstatp (ls, IBUF) + } else if (rg_limget (ls, imr, im1, region) == OK) { + rbuf = rg_lstatp (ls, RBUF) + ibuf = rg_lstatp (ls, IBUF) + } else { + return (ERR) + } + + # Initialize. + call gclear (gd) + + # Get some constants + npts = Memi[rg_lstatp(ls,RNPTS)+region-1] + bscale = Memr[rg_lstatp(ls,RBSCALE)+region-1] + bzero = Memr[rg_lstatp(ls,RBZERO)+region-1] + chi = Memr[rg_lstatp(ls,RCHI)+region-1] + if (IS_INDEFR(rg_lstatr(ls,DATAMIN))) + datamin = -MAX_REAL + else + datamin = rg_lstatr (ls,DATAMIN) + if (IS_INDEFR(rg_lstatr(ls,DATAMAX))) + datamax = MAX_REAL + else + datamax = rg_lstatr (ls,DATAMAX) + if (rg_lstati(ls,NREJECT) <= 0 || IS_INDEFR(rg_lstatr(ls,LOREJECT)) || + IS_INDEFR(chi)) + loreject = -MAX_REAL + else + loreject = -rg_lstatr (ls,LOREJECT) * chi + if (rg_lstati(ls,NREJECT) <= 0 || IS_INDEFR(rg_lstatr(ls,HIREJECT)) || + IS_INDEFR(chi)) + hireject = MAX_REAL + else + hireject = rg_lstatr (ls,HIREJECT) * chi + + # Compute the plot limits. + call alimr (Memr[ibuf], npts, xmin, xmax) + call alimr (Memr[rbuf], npts, ymin, ymax) + dxmin = xmin + dxmax = xmax + dymin = ymin + dymax = ymax + + diff = xmax - xmin + if (diff <= 0.0) + diff = MINFRACTION + else + diff = max (diff, MINFRACTION * abs (xmax + xmin) / 2.0) + xmin = xmin - diff * FRACTION + xmax = xmax + diff * FRACTION + diff = ymax - ymin + if (diff <= 0.0) + diff = MINFRACTION + else + diff = max (diff, MINFRACTION * abs (ymax + ymin) / 2.0) + ymin = ymin - diff * FRACTION + ymax = ymax + diff * FRACTION + call gswind (gd, xmin, xmax, ymin, ymax) + + # Allocate working space. + call smark (sp) + + # Create the plot title. + call salloc (title, 2 * SZ_LINE, TY_CHAR) + call salloc (str, SZ_LINE, TY_CHAR) + call salloc (imager, SZ_FNAME, TY_CHAR) + call salloc (image1, SZ_FNAME, TY_CHAR) + call rg_lstats (ls, REFIMAGE, Memc[imager], SZ_FNAME) + call rg_lstats (ls, IMAGE, Memc[image1], SZ_FNAME) + call sprintf (Memc[str], SZ_LINE, + "Region %d%s: Ref Image = %g * Input Image + %g") + call pargi (region) + if (udelete[region] == YES) + call pargstr (" [deleted]") + else if (Memi[rg_lstatp(ls,RDELETE)+region-1] != LS_NO) + call pargstr (" [rejected]") + else + call pargstr ("") + call pargr (bscale) + call pargr (bzero) + call sprintf (Memc[title], 2 * SZ_LINE, + "Counts for Image %s versus Counts for Image %s\n%s\n\n") + call pargstr (Memc[imager]) + call pargstr (Memc[image1]) + call pargstr (Memc[str]) + call glabax (gd, Memc[title], "Input Image Counts", + "Ref image Counts") + + # Compute the residuals. + call salloc (resid, npts, TY_REAL) + if (IS_INDEFR(bscale) || IS_INDEFR(bzero)) + call amovkr (0.0, Memr[resid], npts) + else { + call altmr (Memr[ibuf], Memr[resid], npts, bscale, bzero) + call asubr (Memr[rbuf], Memr[resid], Memr[resid], npts) + } + + # Plot the data. + call rg_riplot (gd, Memr[ibuf], Memr[rbuf], Memr[resid], npts, + datamin, datamax, loreject, hireject, GM_BOX, GM_CROSS) + + # Plot the fit if bscale and bzero are defined. + start = false + finish = false + if (! IS_INDEFR(bscale) && ! IS_INDEFR(bzero)) { + y = bscale * dxmin + bzero + if (y >= ymin && y <= ymax) { + call gamove (gd, dxmin, y) + start = true + } + y = bscale * dxmax + bzero + if (y >= ymin && y <= ymax) { + if (start) { + call gadraw (gd, dxmax, y) + finish = true + } else { + call gamove (gd, dxmax, y) + start = true + } + } + x = (dymin - bzero) / bscale + if (x >= xmin && x <= xmax) { + if (! start) { + call gamove (gd, x, dymin) + start = true + } else if (! finish) { + call gadraw (gd, x, dymin) + finish = true + } + } + x = (dymax - bzero) / bscale + if (x >= xmin && x <= xmax) { + if (! start) { + call gamove (gd, x, dymax) + start = true + } else if (! finish) { + call gadraw (gd, x, dymax) + finish = true + } + } + } + + call sfree (sp) + + return (OK) +end + + +# RG_RIRPLOT -- Plot the pixel to pixel fit residuals for a region. + +int procedure rg_rirplot (gd, imr, im1, ls, udelete, region) + +pointer gd #I pointer to the graphics stream +pointer imr #I pointer to the reference image +pointer im1 #I pointer to the input image +pointer ls #I pointer to the linmatch structure +int udelete[ARB] #I pointer to the user deletions array +int region #I the current region + +int npts +pointer rbuf, ibuf, sp, title, str, imager, image1, resid +real xmin, xmax, ymin, ymax, diff, bscale, bzero, datamin, datamax +real loreject, hireject, chi +int rg_lstati(), rg_limget() +pointer rg_lstatp() +real rg_lstatr() + +begin + # Get the data. + if (imr == NULL || im1 == NULL) { + return (ERR) + } else if (region == rg_lstati (ls,CNREGION) && + rg_lstatp (ls,RBUF) != NULL && rg_lstatp(ls, IBUF) != NULL) { + rbuf = rg_lstatp (ls, RBUF) + ibuf = rg_lstatp (ls, IBUF) + } else if (rg_limget (ls, imr, im1, region) == OK) { + rbuf = rg_lstatp (ls, RBUF) + ibuf = rg_lstatp (ls, IBUF) + } else { + return (ERR) + } + + # Initialize. + call gclear (gd) + + # Get some constants + npts = Memi[rg_lstatp(ls,RNPTS)+region-1] + bscale = Memr[rg_lstatp(ls,RBSCALE)+region-1] + bzero = Memr[rg_lstatp(ls,RBZERO)+region-1] + chi = Memr[rg_lstatp(ls,RCHI)+region-1] + if (IS_INDEFR(rg_lstatr(ls,DATAMIN))) + datamin = -MAX_REAL + else + datamin = rg_lstatr (ls,DATAMIN) + if (IS_INDEFR(rg_lstatr(ls,DATAMAX))) + datamax = MAX_REAL + else + datamax = rg_lstatr (ls,DATAMAX) + if (rg_lstati(ls,NREJECT) <= 0 || IS_INDEFR(rg_lstatr(ls,LOREJECT)) || + IS_INDEFR(chi)) + loreject = -MAX_REAL + else + loreject = -rg_lstatr (ls,LOREJECT) * chi + if (rg_lstati(ls,NREJECT) <= 0 || IS_INDEFR(rg_lstatr(ls,HIREJECT)) || + IS_INDEFR(chi)) + hireject = MAX_REAL + else + hireject = rg_lstatr (ls,HIREJECT) * chi + + # Allocate working space. + call smark (sp) + + # Compute the residuals. + call salloc (resid, npts, TY_REAL) + if (IS_INDEFR(bscale) || IS_INDEFR(bzero)) + call amovkr (INDEFR, Memr[resid], npts) + else { + call altmr (Memr[ibuf], Memr[resid], npts, bscale, bzero) + call asubr (Memr[rbuf], Memr[resid], Memr[resid], npts) + } + + # Compute the plot limits. + call alimr (Memr[ibuf], npts, xmin, xmax) + call alimr (Memr[resid], npts, ymin, ymax) + diff = xmax - xmin + if (diff <= 0.0) + diff = MINFRACTION + else + diff = max (diff, MINFRACTION * abs (xmin + xmax) / 2.0) + xmin = xmin - diff * FRACTION + xmax = xmax + diff * FRACTION + diff = ymax - ymin + if (diff <= 0.0) + diff = MINFRACTION + else + diff = max (diff, MINFRACTION * abs (ymin + ymax) / 2.0) + ymin = ymin - diff * FRACTION + ymax = ymax + diff * FRACTION + call gswind (gd, xmin, xmax, ymin, ymax) + + # Create the plot title. + call salloc (title, 2 * SZ_LINE, TY_CHAR) + call salloc (str, SZ_LINE, TY_CHAR) + call salloc (imager, SZ_FNAME, TY_CHAR) + call salloc (image1, SZ_FNAME, TY_CHAR) + + # Create the plot title. + call rg_lstats (ls, REFIMAGE, Memc[imager], SZ_FNAME) + call rg_lstats (ls, IMAGE, Memc[image1], SZ_FNAME) + call sprintf (Memc[str], SZ_LINE, + "Region %d%s: Ref Image = %g * Input Image + %g") + call pargi (region) + if (udelete[region] == YES) + call pargstr (" [deleted]") + else if (Memi[rg_lstatp(ls,RDELETE)+region-1] != LS_NO) + call pargstr (" [rejected]") + else + call pargstr ("") + call pargr (bscale) + call pargr (bzero) + call sprintf (Memc[title], 2 * SZ_LINE, + "Residuals for Image %s versus Counts for Image %s\n%s\n\n") + call pargstr (Memc[imager]) + call pargstr (Memc[image1]) + call pargstr (Memc[str]) + call glabax (gd, Memc[title], "Input Image Counts", + "Ref image Counts") + + # Plot the data. + call rg_rriplot (gd, Memr[ibuf], Memr[rbuf], Memr[resid], npts, + datamin, datamax, loreject, hireject, GM_BOX, GM_CROSS) + + # Plot the 0 line if bscale and bzero are defined. + if ( ! IS_INDEFR(bscale) && ! IS_INDEFR(bzero)) { + call gamove (gd, xmin, 0.0) + call gadraw (gd, xmax, 0.0) + } + + call sfree (sp) + + return (OK) +end + + +# RG_BZFPLOT -- Plot the bscale and bzero values computed from the +# fit algorithm. + +int procedure rg_bzfplot (gd, ls, udelete, bscale, bzero) + +pointer gd #I pointer to the graphics stream +pointer ls #I pointer to the linmatch structure +int udelete[ARB] #I the user deletions array +real bscale #I the fitted bscale value +real bzero #I the fitted bzero value + +int i, nregions +pointer sp, xreg, title, str, imager, image1 +real xmin, xmax, ymin, ymax, diff +int rg_lstati() +pointer rg_lstatp() + +begin + nregions = rg_lstati (ls, NREGIONS) + if (nregions <= 1) + return (ERR) + + # Allocate working space. + call smark (sp) + + # Set up space and info the plot title. + call salloc (title, 2 * SZ_LINE, TY_CHAR) + call salloc (str, SZ_LINE, TY_CHAR) + call salloc (imager, SZ_FNAME, TY_CHAR) + call salloc (image1, SZ_FNAME, TY_CHAR) + call rg_lstats (ls, REFIMAGE, Memc[imager], SZ_FNAME) + if (rg_lstati(ls,BSALGORITHM) == LS_PHOTOMETRY || + rg_lstati(ls,BZALGORITHM) == LS_PHOTOMETRY) + call rg_lstats (ls, PHOTFILE, Memc[image1], SZ_FNAME) + else + call rg_lstats (ls, IMAGE, Memc[image1], SZ_FNAME) + + # Set the x array. + call salloc (xreg, nregions, TY_REAL) + do i = 1, nregions + Memr[xreg+i-1] = i + xmin = 1.0 - FRACTION * (nregions - 1) + xmax = nregions + FRACTION * (nregions - 1) + + call gclear (gd) + + # Determine the limits of bscale versus region. + call alimr (Memr[rg_lstatp(ls,RBSCALE)], nregions, ymin, ymax) + diff = ymax - ymin + if (diff <= 0.0) + diff = MINFRACTION + else + diff = max (diff, MINFRACTION * (ymax + ymin) / 2.0) + ymin = ymin - FRACTION * diff + ymax = ymax + FRACTION * diff + call gseti (gd, G_WCS, 1) + call gsview (gd, 0.15, 0.9, 0.6, 0.9) + call gswind (gd, xmin, xmax, ymin, ymax) + call rg_pfill (gd, xmin, xmax, ymin, ymax, GF_SOLID, 0) + + # Create the title for bscale versus region. + call sprintf (Memc[str], SZ_LINE, + "Reference: %s Input: %s Bscale: %g") + call pargstr (Memc[imager]) + call pargstr (Memc[image1]) + call pargr (bscale) + call sprintf (Memc[title], 2 * SZ_LINE, + "Bscale vs. Region\n%s\n") + call pargstr (Memc[str]) + call glabax (gd, Memc[title], "Region", "Bscale") + + # Plot the points. + call rg_lxyplot (gd, Memr[xreg], Memr[rg_lstatp(ls,RBSCALE)], + Memi[rg_lstatp(ls,RDELETE)], udelete, nregions, GM_BOX, GM_CROSS) + + # Plot the fit. + call gamove (gd, xmin, bscale) + call gadraw (gd, xmax, bscale) + + # Determine the limits of bzero versus region. + call alimr (Memr[rg_lstatp(ls,RBZERO)], nregions, ymin, ymax) + diff = ymax - ymin + if (diff <= 0.0) + diff = MINFRACTION + else + diff = max (diff, MINFRACTION * abs (ymin + ymax) / 2.0) + ymin = ymin - FRACTION * diff + ymax = ymax + FRACTION * diff + call gseti (gd, G_WCS, 2) + call gsview (gd, 0.15, 0.9, 0.1, 0.4) + call gswind (gd, xmin, xmax, ymin, ymax) + call rg_pfill (gd, xmin, xmax, ymin, ymax, GF_SOLID, 0) + + # Create the title for bzero versus region. + call sprintf (Memc[str], SZ_LINE, + "Reference: %s Input: %s Bzero: %g") + call pargstr (Memc[imager]) + call pargstr (Memc[image1]) + call pargr (bzero) + call sprintf (Memc[title], 2 * SZ_LINE, "Bzero vs. Region\n%s\n") + call pargstr (Memc[str]) + call glabax (gd, Memc[title], "Region", "Bzero") + + # Plot the points. + call rg_lxyplot (gd, Memr[xreg], Memr[rg_lstatp(ls,RBZERO)], + Memi[rg_lstatp(ls,RDELETE)], udelete, nregions, GM_BOX, GM_CROSS) + + # Plot the fit. + call gamove (gd, xmin, bzero) + call gadraw (gd, xmax, bzero) + + call sfree (sp) + + return (OK) +end + + +# RG_BZRPLOT -- Plot the bscale and bzero values computed from the +# fit algorithm. + +int procedure rg_bzrplot (gd, ls, udelete, bscale, bzero) + +pointer gd #I pointer to the graphics stream +pointer ls #I pointer to the linmatch structure +int udelete[ARB] #I the user deletions array +real bscale #I the fitted bscale value +real bzero #I the fitted bzero value + +int i, nregions +pointer sp, xreg, yreg, title, str, imager, image1 +real xmin, xmax, ymin, ymax, diff +int rg_lstati() +pointer rg_lstatp() + +begin + nregions = rg_lstati (ls, NREGIONS) + if (nregions <= 1) + return (ERR) + + # Allocate working space. + call smark (sp) + call salloc (xreg, nregions, TY_REAL) + call salloc (yreg, nregions, TY_REAL) + + # Set up space and info the plot title. + call salloc (title, 2 * SZ_LINE, TY_CHAR) + call salloc (str, SZ_LINE, TY_CHAR) + call salloc (imager, SZ_FNAME, TY_CHAR) + call salloc (image1, SZ_FNAME, TY_CHAR) + call rg_lstats (ls, REFIMAGE, Memc[imager], SZ_FNAME) + if (rg_lstati(ls,BSALGORITHM) == LS_PHOTOMETRY || + rg_lstati(ls,BZALGORITHM) == LS_PHOTOMETRY) + call rg_lstats (ls, PHOTFILE, Memc[image1], SZ_FNAME) + else + call rg_lstats (ls, IMAGE, Memc[image1], SZ_FNAME) + + # Set the x array. + do i = 1, nregions + Memr[xreg+i-1] = i + xmin = 1.0 - FRACTION * (nregions - 1) + xmax = nregions + FRACTION * (nregions - 1) + + call gclear (gd) + + # Determine the limits of the bscale value versus region. + call asubkr (Memr[rg_lstatp(ls,RBSCALE)], bscale, Memr[yreg], nregions) + call alimr (Memr[yreg], nregions, ymin, ymax) + diff = ymax - ymin + if (diff <= 0.0) + diff = MINFRACTION + else + diff = max (diff, MINFRACTION * (ymax + ymin) / 2.0) + ymin = ymin - FRACTION * diff + ymax = ymax + FRACTION * diff + call gseti (gd, G_WCS, 1) + call gsview (gd, 0.15, 0.9, 0.6, 0.9) + call gswind (gd, xmin, xmax, ymin, ymax) + call rg_pfill (gd, xmin, xmax, ymin, ymax, GF_SOLID, 0) + + # Create the title for bscale versus region. + call sprintf (Memc[str], SZ_LINE, + "Reference: %s Input: %s Bscale: %g") + call pargstr (Memc[imager]) + call pargstr (Memc[image1]) + call pargr (bscale) + call sprintf (Memc[title], 2 * SZ_LINE, + "Bscale Residuals vs. Region\n%s\n") + call pargstr (Memc[str]) + call glabax (gd, Memc[title], "Region", "Bscale Residuals") + + # Plot the points. + call rg_lxyplot (gd, Memr[xreg], Memr[yreg], Memi[rg_lstatp(ls, + RDELETE)], udelete, nregions, GM_BOX, GM_CROSS) + + # Plot the fit. + call gamove (gd, xmin, 0.0) + call gadraw (gd, xmax, 0.0) + + # Determine the limits of the bscale value versus region. + call asubkr (Memr[rg_lstatp(ls,RBZERO)], bzero, Memr[yreg], nregions) + call alimr (Memr[yreg], nregions, ymin, ymax) + diff = ymax - ymin + if (diff <= 0.0) + diff = MINFRACTION + else + diff = max (diff, MINFRACTION * (ymax + ymin) / 2.0) + ymin = ymin - FRACTION * diff + ymax = ymax + FRACTION * diff + call gseti (gd, G_WCS, 2) + call gsview (gd, 0.15, 0.9, 0.1, 0.4) + call gswind (gd, xmin, xmax, ymin, ymax) + call rg_pfill (gd, xmin, xmax, ymin, ymax, GF_SOLID, 0) + + # Create the title for bzero versus region. + call sprintf (Memc[str], SZ_LINE, + "Reference: %s Input: %s Bzero: %g") + call pargstr (Memc[imager]) + call pargstr (Memc[image1]) + call pargr (bzero) + call sprintf (Memc[title], 2 * SZ_LINE, + "Bzero Residuals vs. Region\n%s\n") + call pargstr (Memc[str]) + call glabax (gd, Memc[title], "Region", "Bzero Residuals") + + # Plot the points. + call rg_lxyplot (gd, Memr[xreg], Memr[yreg], Memi[rg_lstatp(ls, + RDELETE)], udelete, nregions, GM_BOX, GM_CROSS) + + # Plot the fit. + call gamove (gd, xmin, 0.0) + call gadraw (gd, xmax, 0.0) + + call sfree (sp) + + return (OK) +end + + +# RG_MSFPLOT -- Plot the magnitude and sky values of the regions. + +int procedure rg_msfplot (gd, ls, udelete, bscale, bzero) + +pointer gd #I pointer to the graphics stream +pointer ls #I pointer to the linmatch structure +int udelete[ARB] #I the user deletions array +real bscale #I the fitted bscale value +real bzero #I the fitted bzero value + +bool start, finish +int nregions +pointer sp, title, str, imager, image1 +real xmin, xmax, ymin, ymax, diff, dxmin, dxmax, dymin, dymax, x, y +int rg_lstati() +pointer rg_lstatp() + +begin + nregions = rg_lstati (ls, NREGIONS) + if (nregions <= 0) + return (ERR) + + # Allocate working space. + call smark (sp) + call salloc (title, 2 * SZ_LINE, TY_CHAR) + call salloc (str, SZ_LINE, TY_CHAR) + call salloc (imager, SZ_FNAME, TY_CHAR) + call salloc (image1, SZ_FNAME, TY_CHAR) + call rg_lstats (ls, REFIMAGE, Memc[imager], SZ_FNAME) + call rg_lstats (ls, PHOTFILE, Memc[image1], SZ_FNAME) + + call gclear (gd) + + # Determine the limits of the bscale value versus region. + call alimr (Memr[rg_lstatp(ls,IMAG)], nregions, xmin, xmax) + dxmin = xmin + dxmax = xmax + diff = xmax - xmin + if (diff <= 0.0) + diff = MINFRACTION + else + diff = max (diff, MINFRACTION * (xmax + xmin) / 2.0) + xmin = xmin - FRACTION * diff + xmax = xmax + FRACTION * diff + call alimr (Memr[rg_lstatp(ls,RMAG)], nregions, ymin, ymax) + dymin = ymin + dymax = ymax + diff = ymax - ymin + if (diff <= 0.0) + diff = MINFRACTION + else + diff = max (diff, MINFRACTION * (ymax + ymin) / 2.0) + ymin = ymin - FRACTION * diff + ymax = ymax + FRACTION * diff + call gseti (gd, G_WCS, 1) + call gsview (gd, 0.15, 0.9, 0.6, 0.9) + call gswind (gd, xmin, xmax, ymin, ymax) + call rg_pfill (gd, xmin, xmax, ymin, ymax, GF_SOLID, 0) + + # Create the title for bscale versus region. + call sprintf (Memc[str], SZ_LINE, + "Reference magnitudes = Input magnitudes + %0.3f") + call pargr (-2.5 * log10 (bscale)) + call sprintf (Memc[title], 2 * SZ_LINE, + "Magnitudes for %s vs. Magnitudes for %s\n%s\n") + call pargstr (Memc[imager]) + call pargstr (Memc[image1]) + call pargstr (Memc[str]) + call glabax (gd, Memc[title], "Input Magnitudes", + "Ref Magnitudes") + + # Plot the points. + call rg_lxyplot (gd, Memr[rg_lstatp(ls,IMAG)], Memr[rg_lstatp(ls,RMAG)], + Memi[rg_lstatp(ls, RDELETE)], udelete, nregions, GM_BOX, GM_CROSS) + + # Plot the fit. + if (bscale > 0.0) { + call gamove (gd, dxmin, dxmin - 2.5 * log10(bscale)) + call gadraw (gd, dxmax, dxmax - 2.5 * log10(bscale)) + } + + # Determine the limits of the bscale value versus region. + call alimr (Memr[rg_lstatp(ls,ISKY)], nregions, xmin, xmax) + dxmin = xmin + dxmax = xmax + diff = xmax - xmin + if (diff <= 0.0) + diff = MINFRACTION + else + diff = max (diff, MINFRACTION * (xmax + xmin) / 2.0) + xmin = xmin - FRACTION * diff + xmax = xmax + FRACTION * diff + call alimr (Memr[rg_lstatp(ls,RSKY)], nregions, ymin, ymax) + dymin = ymin + dymax = ymax + diff = ymax - ymin + if (diff <= 0.0) + diff = 0.0 + else + diff = max (diff, MINFRACTION * (ymax + ymin) / 2.0) + ymin = ymin - FRACTION * diff + ymax = ymax + FRACTION * diff + call gseti (gd, G_WCS, 2) + call gsview (gd, 0.15, 0.9, 0.1, 0.4) + call gswind (gd, xmin, xmax, ymin, ymax) + call rg_pfill (gd, xmin, xmax, ymin, ymax, GF_SOLID, 0) + + # Create the title for bscale versus region. + call sprintf (Memc[str], SZ_LINE, + "Reference skies = %g * Input skies + %g") + call pargr (bscale) + call pargr (bzero) + call sprintf (Memc[title], 2 * SZ_LINE, + "Sky Values for %s vs. Sky Values for %s\n%s\n") + call pargstr (Memc[imager]) + call pargstr (Memc[image1]) + call pargstr (Memc[str]) + call glabax (gd, Memc[title], "Input Sky Values", + "Ref Sky Values") + + # Plot the points. + call rg_lxyplot (gd, Memr[rg_lstatp(ls,ISKY)], Memr[rg_lstatp(ls,RSKY)], + Memi[rg_lstatp(ls, RDELETE)], udelete, nregions, GM_BOX, GM_CROSS) + + # Plot the fit. + start = false + finish = false + if (! IS_INDEFR(bscale) && ! IS_INDEFR(bzero)) { + y = bscale * dxmin + bzero + if (y >= ymin && y <= ymax) { + call gamove (gd, dxmin, y) + start = true + } + y = bscale * dxmax + bzero + if (y >= ymin && y <= ymax) { + if (start) { + call gadraw (gd, dxmax, y) + finish = true + } else { + call gamove (gd, dxmax, y) + start = true + } + } + x = (dymin - bzero) / bscale + if (x >= xmin && x <= xmax) { + if (! start) { + call gamove (gd, x, dymin) + start = true + } else if (! finish) { + call gadraw (gd, x, dymin) + finish = true + } + } + x = (dymax - bzero) / bscale + if (x >= xmin && x <= xmax) { + if (! start) { + call gamove (gd, x, dymax) + start = true + } else if (! finish) { + call gadraw (gd, x, dymax) + finish = true + } + } + } + + call sfree (sp) + + return (OK) +end + + +# RG_MSRPLOT -- Plot the magnitude and sky values of the regions. + +int procedure rg_msrplot (gd, ls, udelete, bscale, bzero) + +pointer gd #I pointer to the graphics stream +pointer ls #I pointer to the linmatch structure +int udelete[ARB] #I the user deletions array +real bscale #I the fitted bscale value +real bzero #I the fitted bzero value + +int nregions +pointer sp, yreg, title, str, imager, image1 +real xmin, xmax, ymin, ymax, diff, dmin, dmax +int rg_lstati() +pointer rg_lstatp() + +begin + nregions = rg_lstati (ls, NREGIONS) + if (nregions <= 0) + return (ERR) + + # Allocate working space. + call smark (sp) + call salloc (yreg, nregions, TY_REAL) + call salloc (title, 2 * SZ_LINE, TY_CHAR) + call salloc (str, SZ_LINE, TY_CHAR) + call salloc (imager, SZ_FNAME, TY_CHAR) + call salloc (image1, SZ_FNAME, TY_CHAR) + call rg_lstats (ls, REFIMAGE, Memc[imager], SZ_FNAME) + call rg_lstats (ls, PHOTFILE, Memc[image1], SZ_FNAME) + + call gclear (gd) + + # Determine the limits of the bscale value versus region. + call alimr (Memr[rg_lstatp(ls,IMAG)], nregions, xmin, xmax) + diff = xmax - xmin + if (diff <= 0.0) + diff = MINFRACTION + else + diff = max (diff, MINFRACTION * (xmax + xmin) / 2.0) + dmin = xmin + dmax = xmax + xmin = xmin - FRACTION * diff + xmax = xmax + FRACTION * diff + if (bscale > 0) { + call aaddkr (Memr[rg_lstatp(ls,IMAG)], -2.5*log10(bscale), + Memr[yreg], nregions) + call asubr (Memr[rg_lstatp(ls,RMAG)], Memr[yreg], Memr[yreg], + nregions) + } else + call asubr (Memr[rg_lstatp(ls,RMAG)], Memr[rg_lstatp(ls,IMAG)], + Memr[yreg], nregions) + call alimr (Memr[yreg], nregions, ymin, ymax) + diff = ymax - ymin + if (diff <= 0.0) + diff = MINFRACTION + else + diff = max (diff, MINFRACTION * (ymax + ymin) / 2.0) + ymin = ymin - FRACTION * diff + ymax = ymax + FRACTION * diff + call gseti (gd, G_WCS, 1) + call gsview (gd, 0.15, 0.9, 0.6, 0.9) + call gswind (gd, xmin, xmax, ymin, ymax) + call rg_pfill (gd, xmin, xmax, ymin, ymax, GF_SOLID, 0) + + # Create the title for bscale versus region. + call sprintf (Memc[str], SZ_LINE, + "Reference: %s Input: %s Bscale: %g") + call pargstr (Memc[imager]) + call pargstr (Memc[image1]) + call pargr (bscale) + call sprintf (Memc[title], 2 * SZ_LINE, + "Residuals for %s vs. Magnitudes for %s\n%s\n") + call pargstr (Memc[imager]) + call pargstr (Memc[image1]) + call pargstr (Memc[str]) + call glabax (gd, Memc[title], "Input Magnitudes", + "Mag Residuals") + + # Plot the points. + call rg_lxyplot (gd, Memr[rg_lstatp(ls,IMAG)], Memr[yreg], + Memi[rg_lstatp(ls, RDELETE)], udelete, nregions, GM_BOX, GM_CROSS) + + # Plot the fit. + if (bscale > 0.0) { + call gamove (gd, xmin, 0.0) + call gadraw (gd, xmax, 0.0) + } + + # Determine the limits of the bscale value versus region. + call alimr (Memr[rg_lstatp(ls,ISKY)], nregions, xmin, xmax) + diff = xmax - xmin + if (diff <= 0.0) + diff = MINFRACTION + else + diff = max (diff, MINFRACTION * (xmax + xmin) / 2.0) + dmin = xmin + dmax = xmax + xmin = xmin - FRACTION * diff + xmax = xmax + FRACTION * diff + call altmr (Memr[rg_lstatp(ls,ISKY)], Memr[yreg], nregions, + bscale, bzero) + call asubr (Memr[rg_lstatp(ls,RSKY)], Memr[yreg], Memr[yreg], + nregions) + call alimr (Memr[yreg], nregions, ymin, ymax) + diff = ymax - ymin + if (diff <= 0.0) + diff = MINFRACTION + else + diff = max (diff, MINFRACTION * (ymax + ymin) / 2.0) + ymin = ymin - FRACTION * diff + ymax = ymax + FRACTION * diff + call gseti (gd, G_WCS, 2) + call gsview (gd, 0.15, 0.9, 0.1, 0.4) + call gswind (gd, xmin, xmax, ymin, ymax) + call rg_pfill (gd, xmin, xmax, ymin, ymax, GF_SOLID, 0) + + # Create the title for bscale versus region. + call sprintf (Memc[str], SZ_LINE, + "Reference: %s Input: %s Bscale: %g Bzero: %g") + call pargstr (Memc[imager]) + call pargstr (Memc[image1]) + call pargr (bscale) + call pargr (bzero) + call sprintf (Memc[title], 2 * SZ_LINE, + "Residuals for %s vs. Sky Values for %s\n%s\n") + call pargstr (Memc[imager]) + call pargstr (Memc[image1]) + call pargstr (Memc[str]) + call glabax (gd, Memc[title], "Input Sky Values", + "Sky Residuals") + + # Plot the points. + call rg_lxyplot (gd, Memr[rg_lstatp(ls,ISKY)], Memr[yreg], + Memi[rg_lstatp(ls, RDELETE)], udelete, nregions, GM_BOX, GM_CROSS) + + # Plot the fit. + call gamove (gd, xmin, 0.0) + call gadraw (gd, xmax, 0.0) + + call sfree (sp) + + return (OK) +end + + +# RG_LHBOX -- Draw a stepped curve of the histogram data. + +procedure rg_lhbox (gp, ydata, npts, x1, x2) + +pointer gp #I the graphics descriptor +real ydata[ARB] #I the y coordinates of the line endpoints +int npts #I the number of line endpoints +real x1, x2 #I starting and ending x coordinates + +int pixel +real left, right, top, bottom, x, y, dx + +begin + call ggwind (gp, left, right, bottom, top) + dx = (x2 - x1) / npts + + # Do the first vertical line. + call gamove (gp, x1, bottom) + call gadraw (gp, x1, ydata[1]) + + # Do the first horizontal line. + call gadraw (gp, x1 + dx, ydata[1]) + + # Draw the remaining horizontal lines. + do pixel = 2, npts { + x = x1 + dx * (pixel - 1) + y = ydata[pixel] + call gadraw (gp, x, y) + call gadraw (gp, x + dx, y) + } + + # Draw the last vertical line. + call gadraw (gp, x + dx, bottom) +end + + +# RG_PFILL -- Fill a rectangular area with a given style and color. + +procedure rg_pfill (gd, xmin, xmax, ymin, ymax, fstyle, fcolor) + +pointer gd #I pointer to the graphics stream +real xmin, xmax #I the x coordinate limits +real ymin, ymax #I the y coordinate limits +int fstyle #I the fill style +int fcolor #I the fill color + +real x[4], y[4] + +begin + call gseti (gd, G_FACOLOR, fcolor) + x[1] = xmin; y[1] = ymin + x[2] = xmax; y[2] = ymin + x[3] = xmax; y[3] = ymax + x[4] = xmin; y[4] = ymax + call gfill (gd, x, y, 4, fstyle) +end + + +# XP_LXYPLOT -- Plot the x and y points. + +procedure rg_lxyplot (gd, x, y, del, udel, npts, gmarker, dmarker) + +pointer gd # pointer to the graphics stream +real x[ARB] # the x coordinates +real y[ARB] # the y coordinates +int del[ARB] # the deletions array +int udel[ARB] # the user deletions array +int npts # the number of points to be marked +int gmarker # the good point marker type +int dmarker # the deleted point marker type + +int i + +begin + # Plot the points. + do i = 1, npts { + if (udel[i] == YES) { + call gmark (gd, x[i], y[i], gmarker, 2.0, 2.0) + call gmark (gd, x[i], y[i], dmarker, 2.0, 2.0) + } else if (del[i] != LS_NO) + call gmark (gd, x[i], y[i], dmarker, 2.0, 2.0) + else + call gmark (gd, x[i], y[i], gmarker, 2.0, 2.0) + } +end + + +# XP_RIPLOT -- Plot the reference image intensity versus the input image +# intensity. + +procedure rg_riplot (gd, x, y, resid, npts, datamin, datamax, loreject, + hireject, gmarker, dmarker) + +pointer gd #I pointer to the graphics stream +real x[ARB] #I the x coordinates +real y[ARB] #I the y coordinates +real resid[ARB] #I the residuals array +int npts #I the number of points to be marked +real datamin #I the good data minimum +real datamax #I the good data maximum +real loreject #I the low side rejection limit +real hireject #I the high side rejection limit +int gmarker #I the good point marker type +int dmarker #I the deleted point marker type + +int i + +begin + do i = 1, npts { + if (x[i] < datamin || x[i] > datamax) + call gmark (gd, x[i], y[i], dmarker, 2.0, 2.0) + else if (y[i] < datamin || y[i] > datamax) + call gmark (gd, x[i], y[i], dmarker, 2.0, 2.0) + else if (resid[i] < loreject || resid[i] > hireject) + call gmark (gd, x[i], y[i], dmarker, 2.0, 2.0) + else + call gmark (gd, x[i], y[i], gmarker, 2.0, 2.0) + } +end + + +# XP_RRIPLOT -- Plot the reference image intensity versus the input image +# intensity. + +procedure rg_rriplot (gd, x, y, resid, npts, datamin, datamax, loreject, + hireject, gmarker, dmarker) + +pointer gd #I pointer to the graphics stream +real x[ARB] #I the x coordinates +real y[ARB] #I the y coordinates +real resid[ARB] #I the residuals array +int npts #I the number of points to be marked +real datamin #I the good data minimum +real datamax #I the good data maximum +real loreject #I the low side rejection limit +real hireject #I the high side rejection limit +int gmarker #I the good point marker type +int dmarker #I the deleted point marker type + +int i + +begin + do i = 1, npts { + if (x[i] < datamin || x[i] > datamax) + call gmark (gd, x[i], resid[i], dmarker, 2.0, 2.0) + else if (y[i] < datamin || y[i] > datamax) + call gmark (gd, x[i], resid[i], dmarker, 2.0, 2.0) + else if (IS_INDEFR(resid[i])) + call gmark (gd, x[i], resid[i], dmarker, 2.0, 2.0) + else if (resid[i] < loreject || resid[i] > hireject) + call gmark (gd, x[i], resid[i], dmarker, 2.0, 2.0) + else + call gmark (gd, x[i], resid[i], gmarker, 2.0, 2.0) + } +end + + +# RG_GALIMR -- Compute the good data limits for the plot. + +procedure rg_galimr (a, index, npts, amin, amax) + +real a[ARB] #I the input array +int index[ARB] #I the index array +int npts #I the size of the array +real amin, amax #O the output min and max values + +int i +real dmin, dmax, gmin, gmax + +begin + dmin = a[1]; dmax = a[1] + gmin = MAX_REAL; gmax = -MAX_REAL + + do i = 1, npts { + if (a[i] < dmin) + dmin = a[i] + else if (a[i] > dmax) + dmax = a[i] + if (index[i] == LS_NO) { + if (a[i] < gmin) + gmin = a[i] + if (a[i] > gmax) + gmax = a[i] + } + } + + if (gmin == MAX_REAL) + amin = dmin + else + amin = gmin + if (gmax == -MAX_REAL) + amax = dmax + else + amax = gmax +end diff --git a/pkg/images/immatch/src/linmatch/rglregions.x b/pkg/images/immatch/src/linmatch/rglregions.x new file mode 100644 index 00000000..16f01b15 --- /dev/null +++ b/pkg/images/immatch/src/linmatch/rglregions.x @@ -0,0 +1,1084 @@ +include <ctype.h> +include <fset.h> +include <imhdr.h> +include "linmatch.h" + +# RG_LREGIONS -- Decode the input regions description. If the regions string +# is NULL then the regions list is empty. The regions are specified in section +# notation, grid notation, coordinate notation or are read +# from a file. + +int procedure rg_lregions (list, im, ls, rp, reread) + +int list #I pointer to the regions file list +pointer im #I pointer to the reference image +pointer ls #I pointer to the linscale structure +int rp #I region pointer +int reread #I reread the current file + +char fname[SZ_FNAME] +int max_nregions, nregions, fd +pointer sp, regions +int rg_lstati(), rg_lgrid(), rg_lgregions(), rg_lsregions() +int rg_lrsections(), rg_lrcoords(), fntgfnb(), open() +data fname[1] /EOS/ +errchk fntgfnb(), seek(), open(), close() + +begin + call smark (sp) + call salloc (regions, SZ_LINE, TY_CHAR) + + call rg_lstats (ls, REGIONS, Memc[regions], SZ_LINE) + max_nregions = rg_lstati (ls, MAXNREGIONS) + + if (rp < 1 || rp > max_nregions || Memc[regions] == EOS) { + nregions = 0 + } else if (rg_lgrid (im, ls, rp, max_nregions) > 0) { + nregions = rg_lstati (ls, NREGIONS) + } else if (rg_lgregions (im, ls, rp, max_nregions) > 0) { + nregions = rg_lstati (ls, NREGIONS) + } else if (rg_lsregions (im, ls, rp, max_nregions) > 0) { + nregions = rg_lstati (ls, NREGIONS) + } else if (list != NULL) { + if (reread == NO) { + iferr { + if (fntgfnb (list, fname, SZ_FNAME) != EOF) { + fd = open (fname, READ_ONLY, TEXT_FILE) + nregions= rg_lrsections (fd, im, ls, rp, max_nregions) + if (nregions <= 0) { + call seek (fd, BOF) + nregions= rg_lrcoords (fd, im, ls, rp, max_nregions) + } + call close (fd) + } else + nregions = 0 + } then + nregions = 0 + } else if (fname[1] != EOS) { + iferr { + fd = open (fname, READ_ONLY, TEXT_FILE) + nregions= rg_lrsections (fd, im, ls, rp, max_nregions) + if (nregions <= 0) { + call seek (fd, BOF) + nregions= rg_lrcoords (fd, im, ls, rp, max_nregions) + } + call close (fd) + } then + nregions = 0 + } + } else + nregions = 0 + + call sfree (sp) + + return (nregions) +end + + +# RG_LGRID - Decode the regions from a grid specification. + +int procedure rg_lgrid (im, ls, rp, max_nregions) + +pointer im #I pointer to the reference image +pointer ls #I pointer to the linscale structure +int rp #I index of the current region +int max_nregions #I the maximum number of regions + +int i, istart, iend, j, jstart, jend, ncols, nlines, nxsample, nysample +int nxcols, nylines, nregions +pointer sp, region, section +int rg_lstati(), nscan(), strcmp() +pointer rg_lstatp() + +begin + # Allocate working space. + call smark (sp) + call salloc (region, SZ_LINE, TY_CHAR) + call salloc (section, SZ_LINE, TY_CHAR) + + # Allocate the arrays to hold the regions information, + call rg_lrealloc (ls, max_nregions) + + # Initialize. + call rg_lstats (ls, REGIONS, Memc[region], SZ_LINE) + ncols = IM_LEN(im,1) + nlines = IM_LEN(im,2) + nregions = min (rp - 1, rg_lstati (ls, NREGIONS)) + + # Decode the grid specification. + call sscan (Memc[region]) + call gargwrd (Memc[section], SZ_LINE) + call gargi (nxsample) + call gargi (nysample) + if ((nscan() != 3) || (strcmp (Memc[section], "grid") != 0)) { + call sfree (sp) + return (nregions) + } + + # Decode the regions. + if ((nxsample * nysample) > max_nregions) { + nxsample = nint (sqrt (real (max_nregions) * real (ncols) / + real (nlines))) + nysample = real (max_nregions) / real (nxsample) + } + nxcols = ncols / nxsample + nylines = nlines / nysample + jstart = 1 + (nlines - nysample * nylines) / 2 + jend = jstart + (nysample - 1) * nylines + do j = jstart, jend, nylines { + istart = 1 + (ncols - nxsample * nxcols) / 2 + iend = istart + (nxsample - 1) * nxcols + do i = istart, iend, nxcols { + Memi[rg_lstatp(ls,RC1)+nregions] = i + Memi[rg_lstatp(ls,RC2)+nregions] = i + nxcols - 1 + Memi[rg_lstatp(ls,RL1)+nregions] = j + Memi[rg_lstatp(ls,RL2)+nregions] = j + nylines - 1 + Memi[rg_lstatp(ls,RXSTEP)+nregions] = 1 + Memi[rg_lstatp(ls,RYSTEP)+nregions] = 1 + Memr[rg_lstatp(ls,RMEAN)+nregions] = INDEFR + Memr[rg_lstatp(ls,RMEDIAN)+nregions] = INDEFR + Memr[rg_lstatp(ls,RMODE)+nregions] = INDEFR + Memr[rg_lstatp(ls,RSIGMA)+nregions] = INDEFR + Memr[rg_lstatp(ls,RSKY)+nregions] = INDEFR + Memr[rg_lstatp(ls,RSKYERR)+nregions] = INDEFR + Memr[rg_lstatp(ls,RMAG)+nregions] = INDEFR + Memr[rg_lstatp(ls,RMAGERR)+nregions] = INDEFR + Memi[rg_lstatp(ls,RNPTS)+nregions] = INDEFI + Memr[rg_lstatp(ls,IMEAN)+nregions] = INDEFR + Memr[rg_lstatp(ls,IMEDIAN)+nregions] = INDEFR + Memr[rg_lstatp(ls,IMODE)+nregions] = INDEFR + Memr[rg_lstatp(ls,ISIGMA)+nregions] = INDEFR + Memr[rg_lstatp(ls,ISKY)+nregions] = INDEFR + Memr[rg_lstatp(ls,ISKYERR)+nregions] = INDEFR + Memr[rg_lstatp(ls,IMAG)+nregions] = INDEFR + Memr[rg_lstatp(ls,IMAGERR)+nregions] = INDEFR + Memi[rg_lstatp(ls,INPTS)+nregions] = INDEFI + Memr[rg_lstatp(ls,RBSCALE)+nregions] = INDEFR + Memr[rg_lstatp(ls,RBSCALEERR)+nregions] = INDEFR + Memr[rg_lstatp(ls,RBZERO)+nregions] = INDEFR + Memr[rg_lstatp(ls,RBZEROERR)+nregions] = INDEFR + Memi[rg_lstatp(ls,RDELETE)+nregions] = LS_NO + Memr[rg_lstatp(ls,RCHI)+nregions] = INDEFR + nregions = nregions + 1 + } + } + + call rg_lseti (ls, NREGIONS, nregions) + if (nregions > 0) + call rg_lrealloc (ls, nregions) + else + call rg_lrfree (ls) + call sfree (sp) + + return (nregions) +end + + +# RG_LGREGIONS -- Compute the column and line limits givenan x and y +# coordinate and a default size. + +int procedure rg_lgregions (im, ls, rp, max_nregions) + +pointer im #I pointer to the image +pointer ls #I pointer to the linscale structure +int rp #I pointer to the current region +int max_nregions #I maximum number of regions + +char comma +int ncols, nlines, nregions, onscan() +int x1, x2, y1, y2 +pointer sp, region +real x, y, xc, yc +int rg_lstati(), nscan() +pointer rg_lstatp() + +begin + # Allocate working space. + call smark (sp) + call salloc (region, SZ_LINE, TY_CHAR) + + # Allocate the arrays to hold the regions information. + call rg_lrealloc (ls, max_nregions) + + # Get the constants. + ncols = IM_LEN(im,1) + nlines = IM_LEN(im,2) + + # Decode the center. + call rg_lstats (ls, REGIONS, Memc[region], SZ_LINE) + nregions = min (rp - 1, rg_lstati (ls, NREGIONS)) + onscan = 0 + call sscan (Memc[region]) + call gargr (x) + call gargr (y) + call gargc (comma) + + # Compute the data region. + while ((nscan() == onscan + 3) && (nregions < max_nregions)) { + + # Check for the comma. + if (comma != ',') + break + + # Compute a more accurate center. + #if (rg_lstati (ls, CENTER) == YES) { + #call rg_lcntr (im, x, y, DEF_CRADIUS, xc, yc) + #} else { + xc = x + yc = y + #} + + # Compute the data section. + x1 = xc - rg_lstati (ls, DNX) / 2 + x2 = x1 + rg_lstati (ls, DNX) - 1 + if (IM_NDIM(im) == 1) { + y1 = 1 + y2 = 1 + } else { + y1 = yc - rg_lstati (ls, DNY) / 2 + y2 = y1 + rg_lstati (ls, DNY) - 1 + } + + # Make sure that the region is on the image. + if (x1 >= 1 && x2 <= IM_LEN(im,1) && y1 >= 1 && + y2 <= IM_LEN(im,2)) { + Memi[rg_lstatp(ls,RC1)+nregions] = x1 + Memi[rg_lstatp(ls,RC2)+nregions] = x2 + Memi[rg_lstatp(ls,RL1)+nregions] = y1 + Memi[rg_lstatp(ls,RL2)+nregions] = y2 + Memi[rg_lstatp(ls,RXSTEP)+nregions] = 1 + Memi[rg_lstatp(ls,RYSTEP)+nregions] = 1 + Memr[rg_lstatp(ls,RMEAN)+nregions] = INDEFR + Memr[rg_lstatp(ls,RMEDIAN)+nregions] = INDEFR + Memr[rg_lstatp(ls,RMODE)+nregions] = INDEFR + Memr[rg_lstatp(ls,RSIGMA)+nregions] = INDEFR + Memr[rg_lstatp(ls,RSKY)+nregions] = INDEFR + Memr[rg_lstatp(ls,RSKYERR)+nregions] = INDEFR + Memr[rg_lstatp(ls,RMAG)+nregions] = INDEFR + Memr[rg_lstatp(ls,RMAGERR)+nregions] = INDEFR + Memi[rg_lstatp(ls,RNPTS)+nregions] = INDEFI + Memr[rg_lstatp(ls,IMEAN)+nregions] = INDEFR + Memr[rg_lstatp(ls,IMEDIAN)+nregions] = INDEFR + Memr[rg_lstatp(ls,IMODE)+nregions] = INDEFR + Memr[rg_lstatp(ls,ISIGMA)+nregions] = INDEFR + Memr[rg_lstatp(ls,ISKY)+nregions] = INDEFR + Memr[rg_lstatp(ls,ISKYERR)+nregions] = INDEFR + Memr[rg_lstatp(ls,IMAG)+nregions] = INDEFR + Memr[rg_lstatp(ls,IMAGERR)+nregions] = INDEFR + Memi[rg_lstatp(ls,INPTS)+nregions] = INDEFI + Memr[rg_lstatp(ls,RBSCALE)+nregions] = INDEFR + Memr[rg_lstatp(ls,RBSCALEERR)+nregions] = INDEFR + Memr[rg_lstatp(ls,RBZERO)+nregions] = INDEFR + Memr[rg_lstatp(ls,RBZEROERR)+nregions] = INDEFR + Memi[rg_lstatp(ls,RDELETE)+nregions] = LS_NO + Memr[rg_lstatp(ls,RCHI)+nregions] = INDEFR + nregions = nregions + 1 + } + + onscan = nscan() + call gargr (x) + call gargr (y) + call gargc (comma) + } + + # Reallocate the correct amount of space. + call rg_lseti (ls, NREGIONS, nregions) + if (nregions > 0) + call rg_lrealloc (ls, nregions) + else + call rg_lrfree (ls) + + call sfree (sp) + + return (nregions) +end + + +# RG_LMKREGIONS -- Procedure to mark the sections on the image display. +# Sections are marked by pointing the image display cursor to the +# lower left and upper rights corners of the desired sections respectively. + +int procedure rg_lmkregions (fd, im, ls, rp, max_nregions, regions, maxch) + +int fd #I pointer to the output text file +pointer im #I pointer to the image +pointer ls #I pointer to the intensity scaling structure +int rp #I pointer to current region +int max_nregions #I maximum number of regions +char regions[ARB] #O the output regions string +int maxch #I the maximum size of the output string + +int nregions, op, wcs, key +pointer sp, cmd +real xll, yll, xur, yur +int rg_lstati(), clgcur(), gstrcpy() +pointer rg_lstatp() + +begin + # Allocate working space. + call smark (sp) + call salloc (cmd, SZ_LINE, TY_CHAR) + + # Allocate the arrays to hold the regions information, + call rg_lrealloc (ls, max_nregions) + + # Initialize. + nregions = min (rp-1, rg_lstati (ls, NREGIONS)) + op = 1 + regions[1] = EOS + + while (nregions < max_nregions) { + + call printf ("Mark lower left corner of region %d [q to quit].\n") + call pargi (nregions + 1) + if (clgcur ("icommands", xll, yll, wcs, key, Memc[cmd], + SZ_LINE) == EOF) + break + if (key == 'q') + break + + call printf ("Mark upper right corner of region %d [q to quit].\n") + call pargi (nregions + 1) + if (clgcur ("icommands", xur, yur, wcs, key, Memc[cmd], + SZ_LINE) == EOF) + break + if (key == 'q') + break + + # Make sure that the region is on the image. + if (xll < 1.0 || xur > IM_LEN(im,1) || yll < 1.0 || yur > + IM_LEN(im,2)) + next + + Memi[rg_lstatp(ls,RC1)+nregions] = nint(xll) + Memi[rg_lstatp(ls,RC2)+nregions] = nint(xur) + Memi[rg_lstatp(ls,RXSTEP)+nregions] = 1 + Memi[rg_lstatp(ls,RL1)+nregions] = nint(yll) + Memi[rg_lstatp(ls,RL2)+nregions] = nint(yur) + Memi[rg_lstatp(ls,RYSTEP)+nregions] = 1 + + Memr[rg_lstatp(ls,RMEAN)+nregions] = INDEFR + Memr[rg_lstatp(ls,RMEDIAN)+nregions] = INDEFR + Memr[rg_lstatp(ls,RMODE)+nregions] = INDEFR + Memr[rg_lstatp(ls,RSIGMA)+nregions] = INDEFR + Memr[rg_lstatp(ls,RSKY)+nregions] = INDEFR + Memr[rg_lstatp(ls,RSKYERR)+nregions] = INDEFR + Memr[rg_lstatp(ls,RMAG)+nregions] = INDEFR + Memr[rg_lstatp(ls,RMAGERR)+nregions] = INDEFR + Memi[rg_lstatp(ls,RNPTS)+nregions] = INDEFI + + Memr[rg_lstatp(ls,IMEAN)+nregions] = INDEFR + Memr[rg_lstatp(ls,IMEDIAN)+nregions] = INDEFR + Memr[rg_lstatp(ls,IMODE)+nregions] = INDEFR + Memr[rg_lstatp(ls,ISIGMA)+nregions] = INDEFR + Memr[rg_lstatp(ls,ISKY)+nregions] = INDEFR + Memr[rg_lstatp(ls,ISKYERR)+nregions] = INDEFR + Memr[rg_lstatp(ls,IMAG)+nregions] = INDEFR + Memr[rg_lstatp(ls,IMAGERR)+nregions] = INDEFR + Memi[rg_lstatp(ls,INPTS)+nregions] = INDEFI + + Memr[rg_lstatp(ls,RBSCALE)+nregions] = INDEFR + Memr[rg_lstatp(ls,RBSCALEERR)+nregions] = INDEFR + Memr[rg_lstatp(ls,RBZERO)+nregions] = INDEFR + Memr[rg_lstatp(ls,RBZEROERR)+nregions] = INDEFR + Memi[rg_lstatp(ls,RDELETE)+nregions] = LS_NO + Memr[rg_lstatp(ls,RCHI)+nregions] = INDEFR + nregions = nregions + 1 + + # Write the regions string. + call sprintf (Memc[cmd], SZ_LINE, "[%d:%d,%d:%d] ") + call pargi (nint(xll)) + call pargi (nint(xur)) + call pargi (nint(yll)) + call pargi (nint(yur)) + op = op + gstrcpy (Memc[cmd], regions[op], maxch - op + 1) + + # Write the output record. + if (fd != NULL) { + call fprintf (fd, "[%d:%d,%d:%d]\n") + call pargi (nint(xll)) + call pargi (nint(xur)) + call pargi (nint(yll)) + call pargi (nint(yur)) + } + } + call printf ("\n") + + # Reallocate the correct amount of space. + call rg_lsets (ls, REGIONS, regions) + call rg_lseti (ls, NREGIONS, nregions) + + if (nregions > 0) + call rg_lrealloc (ls, nregions) + else + call rg_lrfree (ls) + + call sfree (sp) + + return (nregions) +end + + +# RG_LMKXY -- Create a list of objects by selecting objects with +# the image display cursor. + +int procedure rg_lmkxy (fd, im, ls, rp, max_nregions) + +int fd #I the output coordinates file descriptor +pointer im #I pointer to the image +pointer ls #I pointer to the psf matching structure +int rp #I pointer to current region +int max_nregions #I maximum number of regions + +int nregions, wcs, key, x1, x2, y1, y2 +pointer sp, region, cmd +real xc, yc +int clgcur(), rg_lstati() +pointer rg_lstatp() + +begin + # Allocate working space. + call smark (sp) + call salloc (region, SZ_FNAME, TY_CHAR) + call salloc (cmd, SZ_LINE, TY_CHAR) + + # Allocate the arrays to hold the regions information, + call rg_lrealloc (ls, max_nregions) + + nregions = min (rp-1, rg_lstati (ls, NREGIONS)) + while (nregions < max_nregions) { + + # Identify the object. + call printf ("Mark object %d [any key=mark,q=quit]:\n") + call pargi (nregions + 1) + if (clgcur ("icommands", xc, yc, wcs, key, Memc[cmd], + SZ_LINE) == EOF) + break + if (key == 'q') + break + + # Compute the data section. + x1 = xc - rg_lstati (ls, DNX) / 2 + x2 = x1 + rg_lstati (ls, DNX) - 1 + y1 = yc - rg_lstati (ls, DNY) / 2 + y2 = y1 + rg_lstati (ls, DNY) - 1 + + # Make sure that the region is on the image. + if (x1 < 1 || x2 > IM_LEN(im,1) || y1 < 1 || y2 > + IM_LEN(im,2)) + next + + if (fd != NULL) { + call fprintf (fd, "%0.3f %0.3f\n") + call pargr (xc) + call pargr (yc) + } + + Memi[rg_lstatp(ls,RC1)+nregions] = x1 + Memi[rg_lstatp(ls,RC2)+nregions] = x2 + Memi[rg_lstatp(ls,RXSTEP)+nregions] = 1 + Memi[rg_lstatp(ls,RL1)+nregions] = y1 + Memi[rg_lstatp(ls,RL2)+nregions] = y2 + Memi[rg_lstatp(ls,RYSTEP)+nregions] = 1 + + Memr[rg_lstatp(ls,RMEAN)+nregions] = INDEFR + Memr[rg_lstatp(ls,RMEDIAN)+nregions] = INDEFR + Memr[rg_lstatp(ls,RMODE)+nregions] = INDEFR + Memr[rg_lstatp(ls,RSIGMA)+nregions] = INDEFR + Memr[rg_lstatp(ls,RSKY)+nregions] = INDEFR + Memr[rg_lstatp(ls,RSKYERR)+nregions] = INDEFR + Memr[rg_lstatp(ls,RMAG)+nregions] = INDEFR + Memr[rg_lstatp(ls,RMAGERR)+nregions] = INDEFR + Memi[rg_lstatp(ls,RNPTS)+nregions] = INDEFI + + Memr[rg_lstatp(ls,IMEAN)+nregions] = INDEFR + Memr[rg_lstatp(ls,IMEDIAN)+nregions] = INDEFR + Memr[rg_lstatp(ls,IMODE)+nregions] = INDEFR + Memr[rg_lstatp(ls,ISIGMA)+nregions] = INDEFR + Memr[rg_lstatp(ls,ISKY)+nregions] = INDEFR + Memr[rg_lstatp(ls,ISKYERR)+nregions] = INDEFR + Memr[rg_lstatp(ls,IMAG)+nregions] = INDEFR + Memr[rg_lstatp(ls,IMAGERR)+nregions] = INDEFR + Memi[rg_lstatp(ls,INPTS)+nregions] = INDEFI + + Memr[rg_lstatp(ls,RBSCALE)+nregions] = INDEFR + Memr[rg_lstatp(ls,RBSCALEERR)+nregions] = INDEFR + Memr[rg_lstatp(ls,RBZERO)+nregions] = INDEFR + Memr[rg_lstatp(ls,RBZEROERR)+nregions] = INDEFR + Memi[rg_lstatp(ls,RDELETE)+nregions] = LS_NO + Memr[rg_lstatp(ls,RCHI)+nregions] = INDEFR + + nregions = nregions + 1 + + } + + # Reallocate the correct amount of space. + call rg_lseti (ls, NREGIONS, nregions) + if (nregions > 0) { + call rg_lrealloc (ls, nregions) + if (fd != NULL) { + call fstats (fd, F_FILENAME, Memc[region], SZ_FNAME) + call rg_lsets (ls, REGIONS, Memc[region]) + } else + call rg_lsets (ls, REGIONS, "") + } else { + call rg_lrfree (ls) + call rg_lsets (ls, REGIONS, "") + } + + call sfree (sp) + return (nregions) +end + + +# RG_LRSECTIONS -- Read the sections from a file. + +int procedure rg_lrsections (fd, im, ls, rp, max_nregions) + +int fd #I the regions file descriptor +pointer im #I pointer to the image +pointer ls #I pointer to the linscale structure +int rp #I pointer to current region +int max_nregions #I the maximum number of regions + +int stat, nregions, ncols, nlines, x1, y1, x2, y2, xstep, ystep +pointer sp, section, line +int rg_lstati(), getline(), rg_lgsections() +pointer rg_lstatp() + +begin + # Allocate working space. + call smark (sp) + call salloc (line, SZ_LINE, TY_CHAR) + call salloc (section, SZ_LINE, TY_CHAR) + + # Allocate the arrays to hold the regions information, + call rg_lrealloc (ls, max_nregions) + + # Get the constants. + ncols = IM_LEN(im,1) + nlines = IM_LEN(im,2) + + # Decode the regions string. + nregions = min (rp - 1, rg_lstati (ls, NREGIONS)) + while (getline (fd, Memc[line]) != EOF && nregions < max_nregions) { + + call sscan (Memc[line]) + call gargwrd (Memc[section], SZ_LINE) + + while (Memc[section] != EOS && nregions < max_nregions) { + stat = rg_lgsections (Memc[section], x1, x2, xstep, y1, y2, + ystep, ncols, nlines) + + # Check for even dimensioned regions. + if (stat == OK) { + if (mod (x2 - x1 + 1, 2) == 2) { + x2 = x2 + 1 + if (x2 > ncols) + x2 = x2 - 2 + if (x2 < 1) + stat = ERR + } + if (mod (y2 - y1 + 1, 2) == 2) { + y2 = y2 + 1 + if (y2 > nlines) + y2 = y2 - 2 + if (y2 < 1) + stat = ERR + } + } else + stat = ERR + + # Add the new region to the list. + if (stat == OK) { + Memi[rg_lstatp(ls,RC1)+nregions] = x1 + Memi[rg_lstatp(ls,RC2)+nregions] = x2 + Memi[rg_lstatp(ls,RL1)+nregions] = y1 + Memi[rg_lstatp(ls,RL2)+nregions] = y2 + Memi[rg_lstatp(ls,RXSTEP)+nregions] = xstep + Memi[rg_lstatp(ls,RYSTEP)+nregions] = ystep + Memr[rg_lstatp(ls,RMEAN)+nregions] = INDEFR + Memr[rg_lstatp(ls,RMEDIAN)+nregions] = INDEFR + Memr[rg_lstatp(ls,RMODE)+nregions] = INDEFR + Memr[rg_lstatp(ls,RSIGMA)+nregions] = INDEFR + Memr[rg_lstatp(ls,RSKY)+nregions] = INDEFR + Memr[rg_lstatp(ls,RSKYERR)+nregions] = INDEFR + Memr[rg_lstatp(ls,RMAG)+nregions] = INDEFR + Memr[rg_lstatp(ls,RMAGERR)+nregions] = INDEFR + Memi[rg_lstatp(ls,RNPTS)+nregions] = INDEFI + Memr[rg_lstatp(ls,IMEAN)+nregions] = INDEFR + Memr[rg_lstatp(ls,IMEDIAN)+nregions] = INDEFR + Memr[rg_lstatp(ls,IMODE)+nregions] = INDEFR + Memr[rg_lstatp(ls,ISIGMA)+nregions] = INDEFR + Memr[rg_lstatp(ls,ISKY)+nregions] = INDEFR + Memr[rg_lstatp(ls,ISKYERR)+nregions] = INDEFR + Memr[rg_lstatp(ls,IMAG)+nregions] = INDEFR + Memr[rg_lstatp(ls,IMAGERR)+nregions] = INDEFR + Memi[rg_lstatp(ls,INPTS)+nregions] = INDEFI + Memr[rg_lstatp(ls,RBSCALE)+nregions] = INDEFR + Memr[rg_lstatp(ls,RBSCALEERR)+nregions] = INDEFR + Memr[rg_lstatp(ls,RBZERO)+nregions] = INDEFR + Memr[rg_lstatp(ls,RBZEROERR)+nregions] = INDEFR + Memi[rg_lstatp(ls,RDELETE)+nregions] = LS_NO + Memr[rg_lstatp(ls,RCHI)+nregions] = INDEFR + nregions = nregions + 1 + } + + call gargwrd (Memc[section], SZ_LINE) + } + } + + call rg_lseti (ls, NREGIONS, nregions) + if (nregions > 0) + call rg_lrealloc (ls, nregions) + else + call rg_lrfree (ls) + + call sfree (sp) + return (nregions) +end + + +# RG_LRCOORDS -- Read the coordinates from a file. + +int procedure rg_lrcoords (fd, im, ls, rp, max_nregions) + +int fd #I the regions file descriptor +pointer im #I pointer to the image +pointer ls #I pointer to the linscale structure +int rp #I pointer to current region +int max_nregions #I the maximum number of regions + +int ncols, nlines, nregions, x1, x2, y1, y2 +pointer sp, line +real x, y, xc, yc +int rg_lstati(), getline(), nscan() +pointer rg_lstatp() + +begin + # Allocate working space. + call smark (sp) + call salloc (line, SZ_LINE, TY_CHAR) + + # Allocate the arrays to hold the regions information, + call rg_lrealloc (ls, max_nregions) + + # Get the constants. + ncols = IM_LEN(im,1) + nlines = IM_LEN(im,2) + + # Decode the regions string. + nregions = min (rp - 1, rg_lstati (ls, NREGIONS)) + while (getline (fd, Memc[line]) != EOF && nregions < max_nregions) { + + call sscan (Memc[line]) + call gargr (x) + call gargr (y) + if (nscan() != 2) + next + + # Compute a more accurate center. + #if (rg_lstati (ls, CENTER) == YES) { + #call rg_lcntr (im, x, y, DEF_CRADIUS, xc, yc) + #} else { + xc = x + yc = y + #} + + # Compute the data section. + x1 = xc - rg_lstati (ls, DNX) / 2 + x2 = x1 + rg_lstati (ls, DNX) - 1 + if (IM_NDIM(im) == 1) { + y1 = 1 + y2 = 1 + } else { + y1 = yc - rg_lstati (ls, DNY) / 2 + y2 = y1 + rg_lstati (ls, DNY) - 1 + } + + # Make sure that the region is on the image. + if (x1 >= 1 && x2 <= IM_LEN(im,1) && y1 >= 1 && y2 <= + IM_LEN(im,2)) { + Memi[rg_lstatp(ls,RC1)+nregions] = x1 + Memi[rg_lstatp(ls,RC2)+nregions] = x2 + Memi[rg_lstatp(ls,RL1)+nregions] = y1 + Memi[rg_lstatp(ls,RL2)+nregions] = y2 + Memi[rg_lstatp(ls,RXSTEP)+nregions] = 1 + Memi[rg_lstatp(ls,RYSTEP)+nregions] = 1 + Memr[rg_lstatp(ls,RMEAN)+nregions] = INDEFR + Memr[rg_lstatp(ls,RMEDIAN)+nregions] = INDEFR + Memr[rg_lstatp(ls,RMODE)+nregions] = INDEFR + Memr[rg_lstatp(ls,RSIGMA)+nregions] = INDEFR + Memr[rg_lstatp(ls,RSKY)+nregions] = INDEFR + Memr[rg_lstatp(ls,RSKYERR)+nregions] = INDEFR + Memr[rg_lstatp(ls,RMAG)+nregions] = INDEFR + Memr[rg_lstatp(ls,RMAGERR)+nregions] = INDEFR + Memi[rg_lstatp(ls,RNPTS)+nregions] = INDEFI + Memr[rg_lstatp(ls,IMEAN)+nregions] = INDEFR + Memr[rg_lstatp(ls,IMEDIAN)+nregions] = INDEFR + Memr[rg_lstatp(ls,IMODE)+nregions] = INDEFR + Memr[rg_lstatp(ls,ISIGMA)+nregions] = INDEFR + Memr[rg_lstatp(ls,ISKY)+nregions] = INDEFR + Memr[rg_lstatp(ls,ISKYERR)+nregions] = INDEFR + Memr[rg_lstatp(ls,IMAG)+nregions] = INDEFR + Memr[rg_lstatp(ls,IMAGERR)+nregions] = INDEFR + Memi[rg_lstatp(ls,INPTS)+nregions] = INDEFI + Memr[rg_lstatp(ls,RBSCALE)+nregions] = INDEFR + Memr[rg_lstatp(ls,RBSCALEERR)+nregions] = INDEFR + Memr[rg_lstatp(ls,RBZERO)+nregions] = INDEFR + Memr[rg_lstatp(ls,RBZEROERR)+nregions] = INDEFR + Memi[rg_lstatp(ls,RDELETE)+nregions] = LS_NO + Memr[rg_lstatp(ls,RCHI)+nregions] = INDEFR + nregions = nregions + 1 + } + } + + call rg_lseti (ls, NREGIONS, nregions) + if (nregions > 0) + call rg_lrealloc (ls, nregions) + else + call rg_lrfree (ls) + + call sfree (sp) + return (nregions) +end + + +# RG_LRPHOT -- Read the photometry from a file. + +int procedure rg_lrphot (fd, ls, rp, max_nregions, refimage) + +int fd #I the regions file descriptor +pointer ls #I pointer to the linscale structure +int rp #I pointer to current region +int max_nregions #I the maximum number of regions +int refimage #I is the photometry for the reference image + +int nregions, maxnr +pointer sp, line +real sky, skyerr, mag, magerr +int rg_lstati(), getline(), nscan() +pointer rg_lstatp() + +begin + # Allocate working space. + call smark (sp) + call salloc (line, SZ_LINE, TY_CHAR) + + # Allocate the space to hold the arrays. + if (refimage == YES) { + call rg_lrealloc (ls, max_nregions) + nregions = min (rp - 1, rg_lstati (ls, NREGIONS)) + maxnr = max_nregions + } else { + nregions = 0 + maxnr = rg_lstati(ls, NREGIONS) + } + + while (getline (fd, Memc[line]) != EOF && nregions < maxnr) { + + call sscan (Memc[line]) + call gargr (sky) + call gargr (skyerr) + call gargr (mag) + call gargr (magerr) + if (nscan() != 4) + next + + Memi[rg_lstatp(ls,RC1)+nregions] = INDEFI + Memi[rg_lstatp(ls,RC2)+nregions] = INDEFI + Memi[rg_lstatp(ls,RL1)+nregions] = INDEFI + Memi[rg_lstatp(ls,RL2)+nregions] = INDEFI + Memi[rg_lstatp(ls,RXSTEP)+nregions] = INDEFI + Memi[rg_lstatp(ls,RYSTEP)+nregions] = INDEFI + + Memr[rg_lstatp(ls,RMEAN)+nregions] = INDEFR + Memr[rg_lstatp(ls,RMEDIAN)+nregions] = INDEFR + Memr[rg_lstatp(ls,RMODE)+nregions] = INDEFR + Memr[rg_lstatp(ls,RSIGMA)+nregions] = INDEFR + Memi[rg_lstatp(ls,RNPTS)+nregions] = INDEFI + if (refimage == YES) { + Memr[rg_lstatp(ls,RSKY)+nregions] = sky + Memr[rg_lstatp(ls,RSKYERR)+nregions] = skyerr + Memr[rg_lstatp(ls,RMAG)+nregions] = mag + Memr[rg_lstatp(ls,RMAGERR)+nregions] = magerr + Memr[rg_lstatp(ls,ISKY)+nregions] = INDEFR + Memr[rg_lstatp(ls,ISKYERR)+nregions] = INDEFR + Memr[rg_lstatp(ls,IMAG)+nregions] = INDEFR + Memr[rg_lstatp(ls,IMAGERR)+nregions] = INDEFR + } + + Memr[rg_lstatp(ls,IMEAN)+nregions] = INDEFR + Memr[rg_lstatp(ls,IMEDIAN)+nregions] = INDEFR + Memr[rg_lstatp(ls,IMODE)+nregions] = INDEFR + Memr[rg_lstatp(ls,ISIGMA)+nregions] = INDEFR + Memi[rg_lstatp(ls,INPTS)+nregions] = INDEFI + if (refimage == NO) { + Memr[rg_lstatp(ls,ISKY)+nregions] = sky + Memr[rg_lstatp(ls,ISKYERR)+nregions] = skyerr + Memr[rg_lstatp(ls,IMAG)+nregions] = mag + Memr[rg_lstatp(ls,IMAGERR)+nregions] = magerr + } + + Memr[rg_lstatp(ls,RBSCALE)+nregions] = INDEFR + Memr[rg_lstatp(ls,RBSCALEERR)+nregions] = INDEFR + Memr[rg_lstatp(ls,RBZERO)+nregions] = INDEFR + Memr[rg_lstatp(ls,RBZEROERR)+nregions] = INDEFR + Memi[rg_lstatp(ls,RDELETE)+nregions] = LS_NO + Memr[rg_lstatp(ls,RCHI)+nregions] = INDEFR + nregions = nregions + 1 + } + + if (refimage == YES) { + call rg_lseti (ls, NREGIONS, nregions) + if (nregions > 0) + call rg_lrealloc (ls, nregions) + else + call rg_lrfree (ls) + } else if (nregions < rg_lstati (ls,NREGIONS)) { + call rg_lseti (ls, NREGIONS, nregions) + } + + call sfree (sp) + return (nregions) +end + + +# RG_LSREGIONS -- Procedure to compute the column and line limits given +# an image section. If the section is the null string then the region list +# is empty. + +int procedure rg_lsregions (im, ls, rp, max_nregions) + +pointer im #I pointer to the image +pointer ls #I pointer to the linscale structure +int rp #I pointer to the current region +int max_nregions #I maximum number of regions + +int ncols, nlines, nregions +int x1, x2, y1, y2, xstep, ystep +pointer sp, section, region +int rg_lstati(), rg_lgsections() +pointer rg_lstatp() + +begin + # Allocate working space. + call smark (sp) + call salloc (region, SZ_LINE, TY_CHAR) + call salloc (section, SZ_LINE, TY_CHAR) + call rg_lstats (ls, REGIONS, Memc[region], SZ_LINE) + + # Allocate the arrays to hold the regions information. + call rg_lrealloc (ls, max_nregions) + + # Get the constants. + ncols = IM_LEN(im,1) + nlines = IM_LEN(im,2) + + if (Memc[region] != EOS) { + + call sscan (Memc[region]) + call gargwrd (Memc[section], SZ_LINE) + + nregions = min (rp - 1, rg_lstati (ls, NREGIONS)) + while (Memc[section] != EOS && nregions < max_nregions) { + + # Check for even dimensioned regions. + if (rg_lgsections (Memc[section], x1, x2, xstep, y1, y2, ystep, + ncols, nlines) == OK) { + Memi[rg_lstatp(ls,RC1)+nregions] = x1 + Memi[rg_lstatp(ls,RC2)+nregions] = x2 + Memi[rg_lstatp(ls,RL1)+nregions] = y1 + Memi[rg_lstatp(ls,RL2)+nregions] = y2 + Memi[rg_lstatp(ls,RXSTEP)+nregions] = xstep + Memi[rg_lstatp(ls,RYSTEP)+nregions] = ystep + Memr[rg_lstatp(ls,RMEAN)+nregions] = INDEFR + Memr[rg_lstatp(ls,RMEDIAN)+nregions] = INDEFR + Memr[rg_lstatp(ls,RMODE)+nregions] = INDEFR + Memr[rg_lstatp(ls,RSIGMA)+nregions] = INDEFR + Memr[rg_lstatp(ls,RSKY)+nregions] = INDEFR + Memr[rg_lstatp(ls,RSKYERR)+nregions] = INDEFR + Memr[rg_lstatp(ls,RMAG)+nregions] = INDEFR + Memr[rg_lstatp(ls,RMAGERR)+nregions] = INDEFR + Memi[rg_lstatp(ls,RNPTS)+nregions] = INDEFI + Memr[rg_lstatp(ls,IMEAN)+nregions] = INDEFR + Memr[rg_lstatp(ls,IMEDIAN)+nregions] = INDEFR + Memr[rg_lstatp(ls,IMODE)+nregions] = INDEFR + Memr[rg_lstatp(ls,ISIGMA)+nregions] = INDEFR + Memr[rg_lstatp(ls,ISKY)+nregions] = INDEFR + Memr[rg_lstatp(ls,ISKYERR)+nregions] = INDEFR + Memr[rg_lstatp(ls,IMAG)+nregions] = INDEFR + Memr[rg_lstatp(ls,IMAGERR)+nregions] = INDEFR + Memi[rg_lstatp(ls,INPTS)+nregions] = INDEFI + Memr[rg_lstatp(ls,RBSCALE)+nregions] = INDEFR + Memr[rg_lstatp(ls,RBSCALEERR)+nregions] = INDEFR + Memr[rg_lstatp(ls,RBZERO)+nregions] = INDEFR + Memr[rg_lstatp(ls,RBZEROERR)+nregions] = INDEFR + Memi[rg_lstatp(ls,RDELETE)+nregions] = LS_NO + Memr[rg_lstatp(ls,RCHI)+nregions] = INDEFR + nregions = nregions + 1 + } + call gargwrd (Memc[section], SZ_LINE) + } + + } else { + Memi[rg_lstatp(ls,RC1)+nregions] = 1 + Memi[rg_lstatp(ls,RC2)+nregions] = ncols + Memi[rg_lstatp(ls,RL1)+nregions] = 1 + Memi[rg_lstatp(ls,RL2)+nregions] = nlines + Memi[rg_lstatp(ls,RXSTEP)+nregions] = 1 + Memi[rg_lstatp(ls,RYSTEP)+nregions] = 1 + Memr[rg_lstatp(ls,RMEAN)+nregions] = INDEFR + Memr[rg_lstatp(ls,RMEDIAN)+nregions] = INDEFR + Memr[rg_lstatp(ls,RMODE)+nregions] = INDEFR + Memr[rg_lstatp(ls,RSIGMA)+nregions] = INDEFR + Memr[rg_lstatp(ls,RSKY)+nregions] = INDEFR + Memr[rg_lstatp(ls,RSKYERR)+nregions] = INDEFR + Memr[rg_lstatp(ls,RMAG)+nregions] = INDEFR + Memr[rg_lstatp(ls,RMAGERR)+nregions] = INDEFR + Memi[rg_lstatp(ls,RNPTS)+nregions] = INDEFI + Memr[rg_lstatp(ls,IMEAN)+nregions] = INDEFR + Memr[rg_lstatp(ls,IMEDIAN)+nregions] = INDEFR + Memr[rg_lstatp(ls,IMODE)+nregions] = INDEFR + Memr[rg_lstatp(ls,ISIGMA)+nregions] = INDEFR + Memr[rg_lstatp(ls,ISKY)+nregions] = INDEFR + Memr[rg_lstatp(ls,ISKYERR)+nregions] = INDEFR + Memr[rg_lstatp(ls,IMAG)+nregions] = INDEFR + Memr[rg_lstatp(ls,IMAGERR)+nregions] = INDEFR + Memi[rg_lstatp(ls,INPTS)+nregions] = INDEFI + Memr[rg_lstatp(ls,RBSCALE)+nregions] = INDEFR + Memr[rg_lstatp(ls,RBSCALEERR)+nregions] = INDEFR + Memr[rg_lstatp(ls,RBZERO)+nregions] = INDEFR + Memr[rg_lstatp(ls,RBZEROERR)+nregions] = INDEFR + Memi[rg_lstatp(ls,RDELETE)+nregions] = LS_NO + Memr[rg_lstatp(ls,RCHI)+nregions] = INDEFR + nregions = 1 + } + + + # Reallocate the correct amount of space. + call rg_lseti (ls, NREGIONS, nregions) + if (nregions > 0) + call rg_lrealloc (ls, nregions) + else + call rg_lrfree (ls) + + call sfree (sp) + return (nregions) +end + + +# RG_LGSECTIONS -- Decode an image section into column and line limits +# and a step size. Sections which describe the whole image are decoded into +# a block ncols * nlines long. + +int procedure rg_lgsections (section, x1, x2, xstep, y1, y2, ystep, ncols, + nlines) + +char section[ARB] #I the input section string +int x1, x2 #O the output column section limits +int xstep #O the output column step size +int y1, y2 #O the output line section limits +int ystep #O the output line step size +int ncols, nlines #I the maximum number of lines and columns + +int ip +int rg_lgdim() + +begin + ip = 1 + if (rg_lgdim (section, ip, x1, x2, xstep, ncols) == ERR) + return (ERR) + if (rg_lgdim (section, ip, y1, y2, ystep, nlines) == ERR) + return (ERR) + + return (OK) +end + + +# RG_LGDIM -- Decode a single subscript expression to produce the +# range of values for that subscript (X1:X2), and the sampling step size, STEP. +# Note that X1 may be less than, greater than, or equal to X2, and STEP may +# be a positive or negative nonzero integer. Various shorthand notations are +# permitted, as is embedded whitespace. + +int procedure rg_lgdim (section, ip, x1, x2, step, limit) + +char section[ARB] #I the input image section +int ip #I/O pointer to the position in section string +int x1 #O first limit of dimension +int x2 #O second limit of dimension +int step #O step size of dimension +int limit #I maximum size of dimension + +int temp +int ctoi() + +begin + x1 = 1 + x2 = limit + step = 1 + + while (IS_WHITE(section[ip])) + ip = ip + 1 + + if (section[ip] =='[') + ip = ip + 1 + + while (IS_WHITE(section[ip])) + ip = ip + 1 + + + # Get X1, X2. + if (ctoi (section, ip, temp) > 0) { # [x1 + x1 = max (1, min (temp, limit)) + if (section[ip] == ':') { + ip = ip + 1 + if (ctoi (section, ip, temp) == 0) # [x1:x2 + return (ERR) + x2 = max (1, min (temp, limit)) + } else + x2 = x1 + + } else if (section[ip] == '-') { + x1 = limit + x2 = 1 + ip = ip + 1 + if (section[ip] == '*') + ip = ip + 1 + + } else if (section[ip] == '*') # [* + ip = ip + 1 + + while (IS_WHITE(section[ip])) + ip = ip + 1 + + # Get sample step size, if give. + if (section[ip] == ':') { # ..:step + ip = ip + 1 + if (ctoi (section, ip, step) == 0) + return (ERR) + else if (step == 0) + return (ERR) + } + + # Allow notation such as "-*:5", (or even "-:5") where the step + # is obviously supposed to be negative. + + if (x1 > x2 && step > 0) + step = -step + + while (IS_WHITE(section[ip])) + ip = ip + 1 + + if (section[ip] == ',') { + ip = ip + 1 + return (OK) + } else if (section[ip] == ']') + return (OK) + else + return (ERR) +end + + + diff --git a/pkg/images/immatch/src/linmatch/rglscale.x b/pkg/images/immatch/src/linmatch/rglscale.x new file mode 100644 index 00000000..480455ea --- /dev/null +++ b/pkg/images/immatch/src/linmatch/rglscale.x @@ -0,0 +1,1337 @@ +include <imhdr.h> +include <mach.h> +include "linmatch.h" +include "lsqfit.h" + +# RG_LSCALE -- Compute the scaling parameters required to match the +# intensities of an image to a reference image. + +int procedure rg_lscale (imr, im1, db, dformat, ls) + +pointer imr #I pointer to the reference image +pointer im1 #I pointer to the input image +pointer db #I pointer to the database file +int dformat #I write the output file in database format +pointer ls #I pointer to the linscale structure + +pointer sp, image, imname +real bscale, bzero, bserr, bzerr +bool streq() +int rg_lstati(), fscan(), nscan() + +#int i, nregions +#int rg_isfit () +#pointer rg_istatp() + +begin + # Allocate working space. + call smark (sp) + call salloc (image, SZ_FNAME, TY_CHAR) + call salloc (imname, SZ_FNAME, TY_CHAR) + call rg_lstats (ls, IMAGE, Memc[image], SZ_FNAME) + + # Initialize. + bscale = 1.0 + bzero = 0.0 + + # Compute the average bscale and bzero for the image either by + # reading it from a file or by computing it directly from the + # data. + + if (rg_lstati(ls, BZALGORITHM) == LS_FILE && rg_lstati (ls, + BSALGORITHM) == LS_FILE) { + + # Read the results of a previous run from the database file or + # a simple text file. + if (dformat == YES) { + call rg_lfile (db, ls, bscale, bzero, bserr, bzerr) + } else { + if (fscan(db) != EOF) { + call gargwrd (Memc[imname], SZ_FNAME) + call gargr (bscale) + call gargr (bzero) + call gargr (bserr) + call gargr (bzerr) + if (! streq (Memc[image], Memc[imname]) || nscan() != 5) { + bscale = 1.0 + bzero = 0.0 + bserr = INDEFR + bzerr = INDEFR + } + } else { + bscale = 1.0 + bzero = 0.0 + bserr = INDEFR + bzerr = INDEFR + } + } + + # Store the values. + call rg_lsetr (ls, TBSCALE, bscale) + call rg_lsetr (ls, TBZERO, bzero) + call rg_lsetr (ls, TBSCALEERR, bserr) + call rg_lsetr (ls, TBZEROERR, bzerr) + + } else { + + # Write out the algorithm parameters. + if (dformat == YES) + call rg_ldbparams (db, ls) + + # Compute the individual scaling factors and their errors for + # all the regions and the average scaling factors and their + # errors. + call rg_scale (imr, im1, ls, bscale, bzero, bserr, bzerr, YES) + + # Write out the results for the individual regions. + if (dformat == YES) + call rg_lwreg (db, ls) + + # Write out the final scaling factors + if (dformat == YES) + call rg_ldbtscale (db, ls) + else { + call fprintf (db, "%s %g %g %g %g\n") + call pargstr (Memc[image]) + call pargr (bscale) + call pargr (bzero) + call pargr (bserr) + call pargr (bzerr) + } + } + + call sfree (sp) + + return (NO) +end + + +# RG_SCALE -- Compute the scaling parameters for a list of regions. + +procedure rg_scale (imr, im1, ls, tbscale, tbzero, tbserr, tbzerr, refit) + +pointer imr #I pointer to the reference image +pointer im1 #I pointer to the input image +pointer ls #I pointer to the intensity matching structure +real tbscale #O the average scaling parameter +real tbzero #O the average offset parameter +real tbserr #O the average error in the scaling parameter +real tbzerr #O the average error in the offset parameter +int refit #I recompute entire fit, otherwise recompute averages + +int i, nregions, ngood +double sumbscale, sumbzero, sumwbscale, sumbserr, sumbzerr, sumwbzero, dw +real bscale, bzero, bserr, bzerr, avbscale, avbzero, avbserr, avbzerr +int rg_lstati(), rg_limget(), rg_lbszfit() +pointer rg_lstatp() +real rg_lstatr() + +begin + # Determine the number of regions. + nregions = rg_lstati (ls, NREGIONS) + + # Initialize the statistics + sumbscale = 0.0d0 + sumbserr = 0.0d0 + sumwbscale = 0.0d0 + sumbzero = 0.0d0 + sumbzerr = 0.0d0 + sumwbzero = 0.0d0 + ngood = 0 + + # Loop over the regions. + do i = 1, nregions { + + if (refit == YES) { + + # Set the current region. + call rg_lseti (ls, CNREGION, i) + + # Fetch the data for the given region and estimate the mean, + # median, mode, standard deviation, and number of points in + # each region, if this is required by the algorithm. + if (imr != NULL) { + if (rg_limget (ls, imr, im1, i) == ERR) { + call rg_lgmmm (ls, i) + next + } else + call rg_lgmmm (ls, i) + } + + # Compute bscale and bzero and store the results in the + # internal arrays + if (rg_lbszfit (ls, i, bscale, bzero, bserr, bzerr) == ERR) + next + + } else { + bscale = Memr[rg_lstatp(ls,RBSCALE)+i-1] + bzero = Memr[rg_lstatp(ls,RBZERO)+i-1] + bserr = Memr[rg_lstatp(ls,RBSCALEERR)+i-1] + bzerr = Memr[rg_lstatp(ls,RBZEROERR)+i-1] + } + + # Accumulate the weighted sums of the scaling factors. + if (Memi[rg_lstatp(ls,RDELETE)+i-1] == LS_NO && + ! IS_INDEFR(bserr) && ! IS_INDEFR(bzerr)) { + + if (bserr <= 0.0) + dw = 1.0d0 + else + dw = 1.0d0 / bserr ** 2 + sumbscale = sumbscale + dw * bscale + sumbserr = sumbserr + dw * bscale * bscale + sumwbscale = sumwbscale + dw + + if (bzerr <= 0.0) + dw = 1.0d0 + else + dw = 1.0d0 / bzerr ** 2 + sumbzero = sumbzero + dw * bzero + sumbzerr = sumbzerr + dw * bzero * bzero + sumwbzero = sumwbzero + dw + + ngood = ngood + 1 + } + } + + # Compute the average scaling factors. + call rg_avstats (sumbscale, sumbzero, sumwbscale, sumwbzero, sumbserr, + sumbzerr, bserr, bserr, avbscale, avbzero, avbserr, avbzerr, ngood) + + # Perform the rejection cycle. + if (ngood > 2 && rg_lstati(ls, NREJECT) > 0 && + (! IS_INDEFR(rg_lstatr(ls,LOREJECT)) || ! IS_INDEFR(rg_lstatr(ls, + HIREJECT)))) { + call rg_ravstats (ls, sumbscale, sumbzero, sumwbscale, sumwbzero, + sumbserr, sumbzerr, bserr, bzerr, avbscale, avbzero, avbserr, + avbzerr, ngood) + } + + # Compute the final scaling factors. + if (ngood > 1) { + call rg_lbszavg (ls, avbscale, avbzero, avbserr, avbzerr, + tbscale, tbzero, tbserr, tbzerr) + } else { + tbscale = avbscale + tbzero = avbzero + tbserr = avbserr + tbzerr = avbzerr + } + + # Store the compute values. + call rg_lsetr (ls, TBSCALE, tbscale) + call rg_lsetr (ls, TBZERO, tbzero) + call rg_lsetr (ls, TBSCALEERR, tbserr) + call rg_lsetr (ls, TBZEROERR, tbzerr) +end + + +# RG_LIMGET -- Fetch the reference and input image data and compute the +# statistics for a given region. + +int procedure rg_limget (ls, imr, im1, i) + +pointer ls #I pointer to the intensity scaling structure +pointer imr #I pointer to reference image +pointer im1 #I pointer to image +int i #I the region id + +int stat, nrimcols, nrimlines, nimcols, nimlines, nrcols, nrlines, ncols +int nlines, rc1, rc2, rl1, rl2, c1, c2, l1, l2, xstep, ystep, npts +pointer sp, str, ibuf, rbuf, prc1, prc2, prxstep, prl1, prl2, prystep +int rg_lstati(), rg_simget() +pointer rg_lstatp() +real rg_lstatr() + +#int c1, c2, l1, l2 +#int ncols, nlines, npts + +define nextregion_ 11 + +begin + stat = OK + + # Allocate working space. + call smark (sp) + call salloc (str, SZ_LINE, TY_CHAR) + + # Delete the data of the previous region if any. + rbuf = rg_lstatp (ls, RBUF) + if (rbuf != NULL) + call mfree (rbuf, TY_REAL) + rbuf = NULL + ibuf = rg_lstatp (ls, IBUF) + if (ibuf != NULL) + call mfree (ibuf, TY_REAL) + ibuf = NULL + + # Check for number of regions. + if (i < 1 || i > rg_lstati (ls, NREGIONS)) { + stat = ERR + goto nextregion_ + } + + # Get the reference and input image sizes. + nrimcols = IM_LEN(imr,1) + if (IM_NDIM(imr) == 1) + nrimlines = 1 + else + nrimlines = IM_LEN(imr,2) + nimcols = IM_LEN(im1,1) + if (IM_NDIM(im1) == 1) + nimlines = 1 + else + nimlines = IM_LEN(im1,2) + + # Get the reference region pointers. + prc1 = rg_lstatp (ls, RC1) + prc2 = rg_lstatp (ls, RC2) + prl1 = rg_lstatp (ls, RL1) + prl2 = rg_lstatp (ls, RL2) + prxstep = rg_lstatp (ls, RXSTEP) + prystep = rg_lstatp (ls, RYSTEP) + + # Get the reference subraster regions. + rc1 = Memi[prc1+i-1] + rc2 = Memi[prc2+i-1] + rl1 = Memi[prl1+i-1] + rl2 = Memi[prl2+i-1] + xstep = Memi[prxstep+i-1] + ystep = Memi[prystep+i-1] + nrcols = (rc2 - rc1) / xstep + 1 + nrlines = (rl2 - rl1) / ystep + 1 + + # Move to the next region if current reference region is off the image. + if (rc1 < 1 || rc1 > nrimcols || rc2 < 1 || rc2 > nrimcols || + rl1 > nrimlines || rl1 < 1 || rl2 < 1 || rl2 > nrimlines) { + call rg_lstats (ls, REFIMAGE, Memc[str], SZ_LINE) + call eprintf ( + "Reference region %d: %s[%d:%d:%d,%d:%d:%d] is off image.\n") + call pargi (i) + call pargstr (Memc[str]) + call pargi (rc1) + call pargi (rc2) + call pargi (xstep) + call pargi (rl1) + call pargi (rl2) + call pargi (ystep) + stat = ERR + goto nextregion_ + } + + # Move to next region if current reference region is too small. + if (nrcols < 3 || (IM_NDIM(imr) == 2 && nrlines < 3)) { + call rg_lstats (ls, REFIMAGE, Memc[str], SZ_LINE) + call eprintf ( + "Reference region %d: %s[%d:%d:%d,%d:%d:%d] has too few points.\n") + call pargi (i) + call pargstr (Memc[str]) + call pargi (rc1) + call pargi (rc2) + call pargi (xstep) + call pargi (rl1) + call pargi (rl2) + call pargi (ystep) + stat = ERR + goto nextregion_ + } + + # Get the reference image data. + npts = rg_simget (imr, rc1, rc2, xstep, rl1, rl2, ystep, rbuf) + if (npts < 9) { + stat = ERR + go to nextregion_ + } + call rg_lsetp (ls, RBUF, rbuf) + Memi[rg_lstatp(ls,RNPTS)+i-1] = npts + + # Get the input image subraster regions. + c1 = rc1 + rg_lstatr (ls, SXSHIFT) + c2 = rc2 + rg_lstatr (ls, SXSHIFT) + l1 = rl1 + rg_lstatr (ls, SYSHIFT) + l2 = rl2 + rg_lstatr (ls, SYSHIFT) + #c1 = max (1, min (nimcols, c1)) + #c2 = min (nimcols, max (1, c2)) + #l1 = max (1, min (nimlines, l1)) + #l2 = min (nimlines, max (1, l2)) + ncols = (c2 - c1) / xstep + 1 + nlines = (l2 - l1) / ystep + 1 + + # Move to the next region if current input region is off the image. + if (c1 < 1 || c1 > nimcols || c2 > nimcols || c2 < 1 || + l1 > nimlines || l1 < 1 || l2 < 1 || l2 > nimlines) { + call rg_lstats (ls, IMAGE, Memc[str], SZ_LINE) + call eprintf ( + "Input region %d: %s[%d:%d:%d,%d:%d:%d] is off image.\n") + call pargi (i) + call pargstr (Memc[str]) + call pargi (c1) + call pargi (c2) + call pargi (xstep) + call pargi (l1) + call pargi (l2) + call pargi (ystep) + stat = ERR + goto nextregion_ + } + + # Move to the next region if current input region is too small. + if (ncols < 3 || (IM_NDIM(im1) == 2 && nlines < 3)) { + call rg_lstats (ls, IMAGE, Memc[str], SZ_LINE) + call eprintf ( + "Input regions %d: %s[%d:%d:%d,%d:%d:%d] has too few points.\n") + call pargi (i) + call pargstr (Memc[str]) + call pargi (c1) + call pargi (c2) + call pargi (xstep) + call pargi (l1) + call pargi (l2) + call pargi (ystep) + stat = ERR + goto nextregion_ + } + + # Get the image data. + npts = rg_simget (im1, c1, c2, xstep, l1, l2, ystep, ibuf) + if (npts < 9) { + stat = ERR + go to nextregion_ + } + call rg_lsetp (ls, IBUF, ibuf) + Memi[rg_lstatp(ls,INPTS)+i-1] = npts + + +nextregion_ + call sfree (sp) + if (stat == ERR) { + call rg_lsetp (ls, RBUF, rbuf) + if (ibuf != NULL) + call mfree (ibuf, TY_REAL) + call rg_lsetp (ls, IBUF, NULL) + call rg_lseti (ls, CNREGION, i) + Memi[rg_lstatp(ls,RDELETE)+i-1] = LS_BADREGION + return (ERR) + } else { + call rg_lsetp (ls, RBUF, rbuf) + call rg_lsetp (ls, IBUF, ibuf) + call rg_lseti (ls, CNREGION, i) + Memi[rg_lstatp(ls,RDELETE)+i-1] = LS_NO + return (OK) + } +end + + +# RG_LGMMM -- Compute the mean, median and mode of a data region + +procedure rg_lgmmm (ls, i) + +pointer ls #I pointer to the intensity scaling structure +int i #I the current region + +int npts +pointer rbuf, ibuf, buf +real sigma, dmin, dmax +int rg_lstati() +pointer rg_lstatp() +real rg_lmode(), rg_lstatr() + +begin + # Test that the data buffers exist and contain data. + rbuf = rg_lstatp (ls, RBUF) + ibuf = rg_lstatp (ls, IBUF) + npts = Memi[rg_lstatp (ls, RNPTS)+i-1] + if (rbuf == NULL || npts <= 0) { + Memr[rg_lstatp(ls,RMEAN)+i-1] = 0.0 + Memr[rg_lstatp(ls,RMEDIAN)+i-1] = 0.0 + Memr[rg_lstatp(ls,RMODE)+i-1] = 0.0 + Memr[rg_lstatp(ls,RSIGMA)+i-1] = 0.0 + Memr[rg_lstatp(ls,IMEAN)+i-1] = 0.0 + Memr[rg_lstatp(ls,IMEDIAN)+i-1] = 0.0 + Memr[rg_lstatp(ls,IMODE)+i-1] = 0.0 + Memr[rg_lstatp(ls,ISIGMA)+i-1] = 0.0 + Memi[rg_lstatp(ls,RDELETE)+i-1] = LS_BADREGION + return + } + call malloc (buf, npts, TY_REAL) + + # Compute the mean, median, and mode of the reference region but + # don't recompute the reference region statistics needlessly. + if ((!IS_INDEFR(rg_lstatr(ls,DATAMIN)) || !IS_INDEFR(rg_lstatr(ls, + DATAMAX))) && (rg_lstati(ls,BSALGORITHM) != LS_FIT || + rg_lstati(ls,BZALGORITHM) != LS_FIT)) { + call alimr (Memr[rbuf], npts, dmin, dmax) + if (!IS_INDEFR(rg_lstatr(ls,DATAMIN))) { + if (dmin < rg_lstatr(ls,DATAMIN)) { + Memi[rg_lstatp(ls,RDELETE)+i-1] = LS_BADREGION + call eprintf ( + "Reference region %d contains data < datamin\n") + call pargi (i) + } + } + if (!IS_INDEFR(rg_lstatr(ls,DATAMAX))) { + if (dmax > rg_lstatr(ls,DATAMAX)) { + Memi[rg_lstatp(ls,RDELETE)+i-1] = LS_BADREGION + call eprintf ( + "Reference region %d contains data > datamax\n") + call pargi (i) + } + } + } + call aavgr (Memr[rbuf], npts, Memr[rg_lstatp(ls,RMEAN)+i-1], sigma) + Memr[rg_lstatp(ls,RSIGMA)+i-1] = sigma / sqrt (real(npts)) + call asrtr (Memr[rbuf], Memr[buf], npts) + if (mod (npts,2) == 1) + Memr[rg_lstatp(ls,RMEDIAN)+i-1] = Memr[buf+npts/2] + else + Memr[rg_lstatp(ls,RMEDIAN)+i-1] = (Memr[buf+npts/2-1] + + Memr[buf+npts/2]) / 2.0 + Memr[rg_lstatp(ls,RMODE)+i-1] = rg_lmode (Memr[buf], npts, + LMODE_NMIN, LMODE_ZRANGE, LMODE_ZBIN, LMODE_ZSTEP) + sigma = sqrt ((max (Memr[rg_lstatp(ls,RMEAN)+i-1], 0.0) / + rg_lstatr(ls,RGAIN) + (rg_lstatr(ls,RREADNOISE) / + rg_lstatr (ls,RGAIN)) ** 2) / npts) + Memr[rg_lstatp(ls,RSIGMA)+i-1] = + min (Memr[rg_lstatp(ls,RSIGMA)+i-1], sigma) + + if (ibuf == NULL) { + Memr[rg_lstatp(ls,IMEAN)+i-1] = Memr[rg_lstatp(ls,RMEAN)+i-1] + Memr[rg_lstatp(ls,IMEDIAN)+i-1] = Memr[rg_lstatp(ls,RMEDIAN)+i-1] + Memr[rg_lstatp(ls,IMODE)+i-1] = Memr[rg_lstatp(ls,RMODE)+i-1] + Memr[rg_lstatp(ls,ISIGMA)+i-1] = Memr[rg_lstatp(ls,RSIGMA)+i-1] + Memi[rg_lstatp(ls,RDELETE)+i-1] = LS_BADREGION + call mfree (buf, TY_REAL) + return + } + + # Compute the mean, median, and mode of the input region. + if ((!IS_INDEFR(rg_lstatr(ls,DATAMIN)) || !IS_INDEFR(rg_lstatr(ls, + DATAMAX))) && (rg_lstati(ls,BSALGORITHM) != LS_FIT || + rg_lstati(ls,BZALGORITHM) != LS_FIT)) { + call alimr (Memr[ibuf], npts, dmin, dmax) + if (!IS_INDEFR(rg_lstatr(ls,DATAMIN))) { + if (dmin < rg_lstatr(ls,DATAMIN)) { + Memi[rg_lstatp(ls,RDELETE)+i-1] = LS_BADREGION + call eprintf ("Input region %d contains data < datamin\n") + call pargi (i) + } + } + if (!IS_INDEFR(rg_lstatr(ls,DATAMAX))) { + if (dmax > rg_lstatr(ls,DATAMAX)) { + Memi[rg_lstatp(ls,RDELETE)+i-1] = LS_BADREGION + call eprintf ("Input region %d contains data > datamax\n") + call pargi (i) + } + } + } + call aavgr (Memr[ibuf], npts, Memr[rg_lstatp(ls,IMEAN)+i-1], sigma) + Memr[rg_lstatp(ls,ISIGMA)+i-1] = sigma / sqrt (real(npts)) + call asrtr (Memr[ibuf], Memr[buf], npts) + if (mod (npts,2) == 1) + Memr[rg_lstatp(ls,IMEDIAN)+i-1] = Memr[buf+npts/2] + else + Memr[rg_lstatp(ls,IMEDIAN)+i-1] = (Memr[buf+npts/2-1] + + Memr[buf+npts/2]) / 2.0 + Memr[rg_lstatp(ls,IMODE)+i-1] = rg_lmode (Memr[buf], npts, LMODE_NMIN, + LMODE_ZRANGE, LMODE_ZBIN, LMODE_ZSTEP) + sigma = sqrt ((max (Memr[rg_lstatp(ls,IMEAN)+i-1], 0.0) / + rg_lstatr(ls,IGAIN) + (rg_lstatr(ls,IREADNOISE) / + rg_lstatr (ls,IGAIN)) ** 2) / npts) + Memr[rg_lstatp(ls,ISIGMA)+i-1] = + min (Memr[rg_lstatp(ls,ISIGMA)+i-1], sigma) + + + call mfree (buf, TY_REAL) +end + + +# RG_LBSZFIT -- Compute the bscale and bzero factor for a single region. + +int procedure rg_lbszfit (ls, i, bscale, bzero, bserr, bzerr) + +pointer ls #I pointer to the intensity scaling strucuture +int i #I the number of the current region +real bscale #O the computed bscale factor +real bzero #O the computed bzero factor +real bserr #O the computed error in bscale +real bzerr #O the computed error in bzero + +int stat +real bjunk, chi +bool fp_equalr() +int rg_lstati() +pointer rg_lstatp() +real rg_lstatr() + +begin + stat = OK + + # Compute the bscale factor. + switch (rg_lstati (ls, BSALGORITHM)) { + case LS_NUMBER: + bscale = rg_lstatr (ls, CBSCALE) + bserr = 0.0 + chi = INDEFR + case LS_MEAN: + if (fp_equalr (0.0, Memr[rg_lstatp(ls,IMEAN)+i-1])) { + bscale = 1.0 + bserr = 0.0 + } else { + bscale = Memr[rg_lstatp(ls, RMEAN)+i-1] / + Memr[rg_lstatp (ls, IMEAN)+i-1] + if (fp_equalr (0.0, Memr[rg_lstatp(ls,RMEAN)+i-1])) + bserr = 0.0 + else + bserr = abs (bscale) * sqrt ((Memr[rg_lstatp(ls, + RSIGMA)+i-1] / Memr[rg_lstatp(ls,RMEAN)+i-1]) ** 2 + + (Memr[rg_lstatp(ls, ISIGMA)+i-1] / + Memr[rg_lstatp(ls,IMEAN)+i-1]) ** 2) + } + chi = INDEFR + case LS_MEDIAN: + if (fp_equalr (0.0, Memr[rg_lstatp(ls,IMEDIAN)+i-1])) { + bscale = 1.0 + bserr= 0.0 + } else { + bscale = Memr[rg_lstatp (ls,RMEDIAN)+i-1] / + Memr[rg_lstatp(ls,IMEDIAN)+i-1] + if (fp_equalr (0.0, Memr[rg_lstatp(ls,RMEDIAN)+i-1])) + bserr = 0.0 + else + bserr = abs (bscale) * sqrt ((Memr[rg_lstatp(ls, + RSIGMA)+i-1] / Memr[rg_lstatp(ls,RMEDIAN)+i-1]) ** 2 + + (Memr[rg_lstatp(ls, ISIGMA)+i-1] / Memr[rg_lstatp(ls, + IMEDIAN)+i-1]) ** 2) + } + chi = INDEFR + case LS_MODE: + if (fp_equalr (0.0, Memr[rg_lstatp (ls,IMODE)+i-1])) { + bscale = 1.0 + bserr = 0.0 + } else { + bscale = Memr[rg_lstatp (ls, RMODE)+i-1] / + Memr[rg_lstatp (ls, IMODE)+i-1] + if (fp_equalr (0.0, Memr[rg_lstatp (ls,RMODE)+i-1])) + bserr = 0.0 + else + bserr = abs (bscale) * sqrt ((Memr[rg_lstatp(ls, + RSIGMA)+i-1] / Memr[rg_lstatp(ls,RMODE)+i-1]) ** 2 + + (Memr[rg_lstatp(ls, ISIGMA)+i-1] / Memr[rg_lstatp(ls, + IMODE)+i-1]) ** 2) + } + chi = INDEFR + case LS_FIT: + call rg_llsqfit (ls, i, bscale, bzero, bserr, bzerr, chi) + case LS_PHOTOMETRY: + if (IS_INDEFR(Memr[rg_lstatp(ls,RMAG)+i-1]) || + IS_INDEFR(Memr[rg_lstatp(ls,IMAG)+i-1])) { + bscale = 1.0 + bserr = 0.0 + } else { + bscale = 10.0 ** ((Memr[rg_lstatp(ls,IMAG)+i-1] - + Memr[rg_lstatp(ls,RMAG)+i-1]) / 2.5) + if (IS_INDEFR(Memr[rg_lstatp(ls,RMAGERR)+i-1]) || + IS_INDEFR(Memr[rg_lstatp(ls,IMAGERR)+i-1])) + bserr = 0.0 + else + bserr = 0.4 * log (10.0) * bscale * + sqrt (Memr[rg_lstatp(ls,RMAGERR)+i-1] ** 2 + + Memr[rg_lstatp(ls,IMAGERR)+i-1] ** 2) + } + chi = INDEFR + default: + bscale = 1.0 + bserr = 0.0 + chi = INDEFR + } + + # Compute the bzero factor. + switch (rg_lstati (ls, BZALGORITHM)) { + case LS_NUMBER: + bzero = rg_lstatr (ls, CBZERO) + bzerr = 0.0 + chi = INDEFR + case LS_MEAN: + if (rg_lstati(ls, BSALGORITHM) == LS_NUMBER) { + bzero = Memr[rg_lstatp(ls,RMEAN)+i-1] - Memr[rg_lstatp(ls, + IMEAN)+i-1] + bzerr = sqrt (Memr[rg_lstatp(ls,RSIGMA)+i-1] ** 2 + + Memr[rg_lstatp(ls,ISIGMA)+i-1] ** 2) + } else { + bzero = 0.0 + bzerr = 0.0 + } + chi = INDEFR + case LS_MEDIAN: + if (rg_lstati(ls, BSALGORITHM) == LS_NUMBER) { + bzero = Memr[rg_lstatp(ls,RMEDIAN)+i-1] - + Memr[rg_lstatp(ls,IMEDIAN)+i-1] + bzerr = sqrt (Memr[rg_lstatp(ls,RSIGMA)+i-1] ** 2 + + Memr[rg_lstatp(ls,ISIGMA)+i-1] ** 2) + } else { + bzero = 0.0 + bzerr = 0.0 + } + chi = INDEFR + case LS_MODE: + if (rg_lstati(ls, BSALGORITHM) == LS_NUMBER) { + bzero = Memr[rg_lstatp(ls,RMODE)+i-1] - Memr[rg_lstatp(ls, + IMODE)+i-1] + bzerr = sqrt (Memr[rg_lstatp(ls,RSIGMA)+i-1] ** 2 + + Memr[rg_lstatp(ls,ISIGMA)+i-1] ** 2) + } else { + bzero = 0.0 + bzerr = 0.0 + } + chi = INDEFR + case LS_FIT: + if (rg_lstati(ls, BSALGORITHM) == LS_NUMBER) + call rg_llsqfit (ls, i, bjunk, bzero, bjunk, bzerr, chi) + case LS_PHOTOMETRY: + if (IS_INDEFR(Memr[rg_lstatp(ls,RSKY)+i-1]) || + IS_INDEFR(Memr[rg_lstatp(ls,ISKY)+i-1])) { + bzero = 0.0 + bzerr = 0.0 + } else { + bzero = Memr[rg_lstatp(ls,RSKY)+i-1] - bscale * + Memr[rg_lstatp(ls,ISKY)+i-1] + if (IS_INDEFR(Memr[rg_lstatp(ls,RSKYERR)+i-1]) || + IS_INDEFR(Memr[rg_lstatp(ls,ISKYERR)+i-1])) + bzerr = 0.0 + else + bzerr = sqrt (Memr[rg_lstatp(ls,RSKYERR)+i-1] ** 2 + + bserr ** 2 * Memr[rg_lstatp(ls,ISKY)+i-1] ** 2 + + bscale ** 2 * Memr[rg_lstatp(ls,ISKYERR)+i-1] ** 2) + + } + chi = INDEFR + default: + bzero = 0.0 + bzerr = 0.0 + chi = INDEFR + } + + # Store the results. + Memr[rg_lstatp(ls,RBSCALE)+i-1] = bscale + Memr[rg_lstatp(ls,RBZERO)+i-1] = bzero + Memr[rg_lstatp(ls,RBSCALEERR)+i-1] = bserr + Memr[rg_lstatp(ls,RBZEROERR)+i-1] = bzerr + Memr[rg_lstatp(ls,RCHI)+i-1] = chi + + return (stat) +end + + +# RG_LBSZAVG -- Compute the final scaling parameters. + +procedure rg_lbszavg (ls, avbscale, avbzero, avbserr, avbzerr, tbscale, + tbzero, tbserr, tbzerr) + +pointer ls #I pointer to the intensity scaling strucuture +real avbscale #I the computed bscale factor +real avbzero #I the computed bzero factor +real avbserr #I the computed error in bscale +real avbzerr #I the computed error in bzero +real tbscale #O the computed bscale factor +real tbzero #O the computed bzero factor +real tbserr #O the computed error in bscale +real tbzerr #O the computed error in bzero + +int i, bsalg, bzalg, nregions +pointer sp, weight +real answers[MAX_NFITPARS] +int rg_lstati() +pointer rg_lstatp() +real rg_lstatr() + +begin + bsalg = rg_lstati (ls, BSALGORITHM) + bzalg = rg_lstati (ls, BZALGORITHM) + nregions = rg_lstati (ls, NREGIONS) + + call smark (sp) + call salloc (weight, nregions, TY_REAL) + + if (bsalg == LS_MEAN || bzalg == LS_MEAN) { + do i = 1, nregions { + if (IS_INDEFR(Memr[rg_lstatp(ls,IMEAN)+i-1]) || + IS_INDEFR(Memr[rg_lstatp(ls,RMEAN)+i-1]) || + Memi[rg_lstatp(ls,RDELETE)+i-1] != LS_NO) + Memr[weight+i-1] = 0.0 + else + Memr[weight+i-1] = 1.0 + } + call ll_lsqf1 (Memr[rg_lstatp(ls,IMEAN)], Memr[rg_lstatp(ls, + RMEAN)], Memr[rg_lstatp(ls,ISIGMA)], Memr[rg_lstatp(ls, + RSIGMA)], Memr[weight], nregions, rg_lstati(ls,MAXITER), + answers) + if (nregions > 2 && rg_lstati(ls,NREJECT) > 0 && + (! IS_INDEFR(rg_lstatr(ls,LOREJECT)) || + ! IS_INDEFR(rg_lstatr(ls,HIREJECT)))) { + call ll_rlsqf1 (Memr[rg_lstatp(ls,IMEAN)], Memr[rg_lstatp(ls, + RMEAN)], Memr[rg_lstatp(ls,ISIGMA)], Memr[rg_lstatp(ls, + RSIGMA)], Memr[weight], nregions, rg_lstati(ls,MAXITER), + answers, rg_lstati(ls,NREJECT), rg_lstatr(ls,LOREJECT), + rg_lstatr(ls,HIREJECT)) + do i = 1, nregions { + if (Memr[weight+i-1] <= 0.0 && Memi[rg_lstatp(ls, + RDELETE)+i-1] == LS_NO) + Memi[rg_lstatp(ls,RDELETE)+i-1] = LS_BADSIGMA + } + } + if (IS_INDEFR(CHI[answers])) { + tbscale = avbscale + tbserr = avbserr + tbzero = avbzero + tbzerr = avbzerr + } else if (bsalg == LS_MEAN && bzalg == LS_MEAN) { + tbscale = SLOPE[answers] + tbserr = ESLOPE[answers] + tbzero = YINCPT[answers] + tbzerr = EYINCPT[answers] + } else if (bsalg == LS_MEAN) { + tbscale = SLOPE[answers] + tbserr = ESLOPE[answers] + tbzero = avbzero + tbzerr = avbzerr + } else { + tbscale = avbscale + tbserr = avbserr + tbzero = avbzero + tbzerr = avbzerr + } + + } else if (bsalg == LS_MEDIAN || bzalg == LS_MEDIAN) { + do i = 1, nregions { + if (IS_INDEFR(Memr[rg_lstatp(ls,IMEDIAN)+i-1]) || + IS_INDEFR(Memr[rg_lstatp(ls,RMEDIAN)+i-1]) || + Memi[rg_lstatp(ls,RDELETE)+i-1] != LS_NO) + Memr[weight+i-1] = 0.0 + else + Memr[weight+i-1] = 1.0 + } + call ll_lsqf1 (Memr[rg_lstatp(ls,IMEDIAN)], Memr[rg_lstatp(ls, + RMEDIAN)], Memr[rg_lstatp(ls,ISIGMA)], Memr[rg_lstatp(ls, + RSIGMA)], Memr[weight], nregions, rg_lstati(ls,MAXITER), + answers) + if (nregions > 2 && rg_lstati(ls,NREJECT) > 0 && + (! IS_INDEFR(rg_lstatr(ls,LOREJECT)) || + ! IS_INDEFR(rg_lstatr(ls,HIREJECT)))) { + call ll_rlsqf1 (Memr[rg_lstatp(ls,IMEDIAN)], Memr[rg_lstatp(ls, + RMEDIAN)], Memr[rg_lstatp(ls,ISIGMA)], Memr[rg_lstatp(ls, + RSIGMA)], Memr[weight], nregions, rg_lstati(ls,MAXITER), + answers, rg_lstati(ls,NREJECT), rg_lstatr(ls,LOREJECT), + rg_lstatr(ls,HIREJECT)) + do i = 1, nregions { + if (Memr[weight+i-1] <= 0.0 && Memi[rg_lstatp(ls, + RDELETE)+i-1] == LS_NO) + Memi[rg_lstatp(ls,RDELETE)+i-1] = LS_BADSIGMA + } + } + if (IS_INDEFR(CHI[answers])) { + tbscale = avbscale + tbserr = avbserr + tbzero = avbzero + tbzerr = avbzerr + } else if (bsalg == LS_MEDIAN && bzalg == LS_MEDIAN) { + tbscale = SLOPE[answers] + tbserr = ESLOPE[answers] + tbzero = YINCPT[answers] + tbzerr = EYINCPT[answers] + } else if (bsalg == LS_MEDIAN) { + tbscale = SLOPE[answers] + tbserr = ESLOPE[answers] + tbzero = avbzero + tbzerr = avbzerr + } else { + tbscale = avbscale + tbserr = avbserr + tbzero = avbzero + tbzerr = avbzerr + } + } else if (bsalg == LS_MODE || bzalg == LS_MODE) { + do i = 1, nregions { + if (IS_INDEFR(Memr[rg_lstatp(ls,IMODE)+i-1]) || + IS_INDEFR(Memr[rg_lstatp(ls,RMODE)+i-1]) || + Memi[rg_lstatp(ls,RDELETE)+i-1] != LS_NO) + Memr[weight+i-1] = 0.0 + else + Memr[weight+i-1] = 1.0 + } + call ll_lsqf1 (Memr[rg_lstatp(ls,IMODE)], Memr[rg_lstatp(ls, + RMODE)], Memr[rg_lstatp(ls,ISIGMA)], Memr[rg_lstatp(ls, + RSIGMA)], Memr[weight], nregions, rg_lstati(ls,MAXITER), + answers) + if (nregions > 2 && rg_lstati(ls,NREJECT) > 0 && + (! IS_INDEFR(rg_lstatr(ls,LOREJECT)) || + ! IS_INDEFR(rg_lstatr(ls,HIREJECT)))) { + call ll_rlsqf1 (Memr[rg_lstatp(ls,IMODE)], Memr[rg_lstatp(ls, + RMODE)], Memr[rg_lstatp(ls,ISIGMA)], Memr[rg_lstatp(ls, + RSIGMA)], Memr[weight], nregions, rg_lstati(ls,MAXITER), + answers, rg_lstati(ls,NREJECT), rg_lstatr(ls,LOREJECT), + rg_lstatr(ls,HIREJECT)) + do i = 1, nregions { + if (Memr[weight+i-1] <= 0.0 && Memi[rg_lstatp(ls, + RDELETE)+i-1] == LS_NO) + Memi[rg_lstatp(ls,RDELETE)+i-1] = LS_BADSIGMA + } + } + if (IS_INDEFR(CHI[answers])) { + tbscale = avbscale + tbserr = avbserr + tbzero = avbzero + tbzerr = avbzerr + } else if (bsalg == LS_MODE && bzalg == LS_MODE) { + tbscale = SLOPE[answers] + tbserr = ESLOPE[answers] + tbzero = YINCPT[answers] + tbzerr = EYINCPT[answers] + } else if (bsalg == LS_MODE) { + tbscale = SLOPE[answers] + tbserr = ESLOPE[answers] + tbzero = avbzero + tbzerr = avbzerr + } else { + tbscale = avbscale + tbserr = avbserr + tbzero = avbzero + tbzerr = avbzerr + } + } else { + tbscale = avbscale + tbzero = avbzero + tbserr = avbserr + tbzerr = avbzerr + } + + + call sfree (sp) +end + + +# RG_LFILE -- Fetch the scaling parameters from the datafile. + +procedure rg_lfile (db, ls, bscale, bzero, bserr, bzerr) + +pointer db #I pointer to the database file +pointer ls #I pointer to the intensity scaling structure +real bscale #O the average scaling parameter +real bzero #O the average offset parameter +real bserr #O the error in bscale +real bzerr #O the error in bzero + +int rec +pointer sp, record +int dtlocate() +real dtgetr() + +begin + call smark (sp) + call salloc (record, SZ_FNAME, TY_CHAR) + + call rg_lstats (ls, RECORD, Memc[record], SZ_FNAME) + iferr { + rec = dtlocate (db, Memc[record]) + bscale = dtgetr (db, rec, "bscale") + bzero = dtgetr (db, rec, "bzero") + bserr = dtgetr (db, rec, "bserr") + bzerr = dtgetr (db, rec, "bzerr") + } then { + bscale = 1.0 + bzero = 0.0 + bserr = INDEFR + bzerr = INDEFR + } + + call sfree (sp) +end + + +# RG_SIMGET -- Fill a buffer from a specified region of the image including a +# step size in x and y. + +int procedure rg_simget (im, c1, c2, cstep, l1, l2, lstep, ptr) + +pointer im #I the pointer to the iraf image +int c1, c2 #I the column limits +int cstep #I the column step size +int l1, l2 #I the line limits +int lstep #I the line step size +pointer ptr #I the pointer to the output buffer + +int i, j, ncols, nlines, npts +pointer iptr, buf +pointer imgs2r() + +begin + ncols = (c2 - c1) / cstep + 1 + nlines = (l2 - l1) / lstep + 1 + npts = ncols * nlines + call malloc (ptr, npts, TY_REAL) + + iptr = ptr + do j = l1, l2, lstep { + buf = imgs2r (im, c1, c2, j, j) + do i = 1, ncols { + Memr[iptr+i-1] = Memr[buf] + buf = buf + cstep + } + iptr = iptr + ncols + } + + return (npts) +end + + +# RG_LMODE -- 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 rg_lmode (a, npts, nmin, zrange, fzbin, fzstep) + +real a[npts] #I the sorted input data array +int npts #I the number of points +int nmin #I the minimum number of points +real zrange #I fraction of pixels around median to use +real fzbin #I the bin size for the mode search +real fzstep #I the step size for the mode search + +int x1, x2, x3, nmax +real zstep, zbin, y1, y2, mode +bool fp_equalr() + +begin + # If there are too few points return the median. + if (npts < nmin) { + if (mod (npts,2) == 1) + return (a[1+npts/2]) + else + return ((a[npts/2] + a[1+npts/2]) / 2.0) + } + + # Compute the data range that will be used to do the mode search. + # If the data has no range then the constant value will be returned. + x1 = max (1, int (1.0 + npts * (1.0 - zrange) / 2.0)) + x3 = min (npts, int (1.0 + npts * (1.0 + zrange) / 2.0)) + if (fp_equalr (a[x1], a[x3])) + return (a[x1]) + + # Compute the bin and step size. The bin size is based on the + # data range over a fraction of the pixels around the median + # and a bin step which may be smaller than the bin size. + + zstep = fzstep * (a[x3] - a[x1]) + zbin = fzbin * (a[x3] - a[x1]) + + nmax = 0 + x2 = x1 + for (y1 = a[x1]; x2 < x3; y1 = y1 + zstep) { + for (; a[x1] < y1; x1 = x1 + 1) + ; + y2 = y1 + zbin + for (; (x2 < x3) && (a[x2] < y2); x2 = x2 + 1) + ; + if (x2 - x1 > nmax) { + nmax = x2 - x1 + if (mod (x2+x1,2) == 0) + mode = a[(x2+x1)/2] + else + mode = (a[(x2+x1)/2] + a[(x2+x1)/2+1]) / 2.0 + } + } + + return (mode) +end + + +# RG_LLSQFIT -- Compute the bscale and bzero factors by doing a least squares +# fit to the region data. For this technque to be successful the data must +# be registered and psf matched. + +procedure rg_llsqfit (ls, i, bscale, bzero, bserr, bzerr, chi) + +pointer ls #I pointer to the intensity scaling structure +int i #I the current region +real bscale #O the computed bscale factor +real bzero #O the computed bzero factor +real bserr #O the estimated error in bscale +real bzerr #O the estimated error in bzero +real chi #O the output chi at unit weight + +int j, npts +pointer rbuf, ibuf, rerr, ierr, weight +real rgain, igain, rrnoise, irnoise, answers[MAX_NFITPARS] +real datamin, datamax +int rg_lstati() +pointer rg_lstatp() +real rg_lstatr() + +begin + # Get the data pointers. + rbuf = rg_lstatp (ls, RBUF) + ibuf = rg_lstatp (ls, IBUF) + + # Allocate space for the error and weight arrays. + npts = Memi[rg_lstatp(ls,RNPTS)+i-1] + call malloc (rerr, npts, TY_REAL) + call malloc (ierr, npts, TY_REAL) + call malloc (weight, npts, TY_REAL) + + # Compute the errors. + rgain = rg_lstatr (ls, RGAIN) + igain = rg_lstatr (ls, IGAIN) + rrnoise = rg_lstatr (ls, RREADNOISE) ** 2 / rgain + irnoise = rg_lstatr (ls, IREADNOISE) ** 2 / igain + do j = 1, npts { + Memr[rerr+j-1] = (Memr[rbuf+j-1] + rrnoise) / rgain + Memr[ierr+j-1] = (Memr[ibuf+j-1] + irnoise) / igain + } + + # Compute the weights. + if (IS_INDEFR(rg_lstatr(ls,DATAMIN)) && IS_INDEFR(ls,DATAMAX)) + call amovkr (1.0, Memr[weight], npts) + else { + if (IS_INDEFR(rg_lstatr(ls,DATAMIN))) + datamin = -MAX_REAL + else + datamin = rg_lstatr (ls, DATAMIN) + if (IS_INDEFR(rg_lstatr(ls,DATAMAX))) + datamax = MAX_REAL + else + datamax = rg_lstatr (ls, DATAMAX) + do j = 1, npts { + if (Memr[rbuf+j-1] < datamin || Memr[rbuf+j-1] > datamax) + Memr[weight+j-1] = 0.0 + else if (Memr[ibuf+j-1] < datamin || Memr[ibuf+j-1] > datamax) + Memr[weight+j-1] = 0.0 + else + Memr[weight+j-1] = 1.0 + } + } + + # Compute the fit. + call ll_lsqf1 (Memr[ibuf], Memr[rbuf], Memr[ierr], Memr[rerr], + Memr[weight], npts, rg_lstati(ls, MAXITER), answers) + + # Perform the rejection cycle. + if (npts > 2 && rg_lstati(ls,NREJECT) > 0 && + (! IS_INDEFR(rg_lstatr(ls,LOREJECT)) || + ! IS_INDEFR(rg_lstatr(ls,HIREJECT)))) + call ll_rlsqf1 (Memr[ibuf], Memr[rbuf], Memr[ierr], Memr[rerr], + Memr[weight], npts, rg_lstati(ls,MAXITER), answers, + rg_lstati(ls,NREJECT), rg_lstatr(ls,LOREJECT), + rg_lstatr(ls,HIREJECT)) + bscale = SLOPE[answers] + bzero = YINCPT[answers] + bserr = ESLOPE[answers] + bzerr = EYINCPT[answers] + chi = CHI[answers] + + # Free the working space. + call mfree (rerr, TY_REAL) + call mfree (ierr, TY_REAL) + call mfree (weight, TY_REAL) +end + + +# RG_RAVSTATS -- Compute the average statistics. + +procedure rg_ravstats (ls, sumbscale, sumbzero, sumwbscale, sumwbzero, sumbserr, + sumbzerr, bserr, bzerr, avbscale, avbzero, avbserr, avbzerr, ngood) + +pointer ls #I pointer to the linmatch structure +double sumbscale #I/O sum of the bscale values +double sumbzero #I/O sum of the bzero values +double sumwbscale #I/O sum of the weighted bscale values +double sumwbzero #I/O sum of the weighted bzero values +double sumbserr #I/O sum of the bscale error +double sumbzerr #I/O sum of the bscale error +real bserr #I/O the bscale error of 1 observation +real bzerr #I/O the bzero error of 1 observation +real avbscale #I/O the average bscale factor +real avbzero #I/O the average bzero factor +real avbserr #O the average bscale error factor +real avbzerr #O the average bzero error factor +int ngood #I/O the number of good data values + +int i, nregions, nrej, nbad +real sigbscale, sigbzero, lobscale, hibscale, lobzero, hibzero +real bscale, bzero, bsresid, bzresid +double dw +int rg_lstati() +pointer rg_lstatp() +real rg_lsigma(), rg_lstatr() + +begin + nregions = rg_lstati (ls,NREGIONS) + + nrej = 0 + repeat { + + # Compute sigma. + sigbscale = rg_lsigma (Memr[rg_lstatp(ls,RBSCALE)], + Memi[rg_lstatp(ls,RDELETE)], nregions, avbscale) + if (sigbscale <= 0.0) + break + sigbzero = rg_lsigma (Memr[rg_lstatp(ls,RBZERO)], + Memi[rg_lstatp(ls,RDELETE)], nregions, avbzero) + if (sigbzero <= 0.0) + break + + if (IS_INDEFR(rg_lstatr(ls,LOREJECT))) { + lobscale = -MAX_REAL + lobzero = -MAX_REAL + } else { + lobscale = -sigbscale * rg_lstatr (ls, LOREJECT) + lobzero = -sigbzero * rg_lstatr (ls, LOREJECT) + } + if (IS_INDEFR(rg_lstatr(ls,HIREJECT))) { + hibscale = MAX_REAL + hibzero = MAX_REAL + } else { + hibscale = sigbscale * rg_lstatr (ls, HIREJECT) + hibzero = sigbzero * rg_lstatr (ls, HIREJECT) + } + + nbad = 0 + do i = 1, nregions { + if (Memi[rg_lstatp(ls,RDELETE)+i-1] != LS_NO) + next + bscale = Memr[rg_lstatp(ls,RBSCALE)+i-1] + if (IS_INDEFR(bscale)) + next + bzero = Memr[rg_lstatp(ls,RBZERO)+i-1] + if (IS_INDEFR(bzero)) + next + bserr = Memr[rg_lstatp(ls,RBSCALEERR)+i-1] + bsresid = bscale - avbscale + bzerr = Memr[rg_lstatp(ls,RBZEROERR)+i-1] + bzresid = bzero - avbzero + if (bsresid >= lobscale && bsresid <= hibscale && bzresid >= + lobzero && bzresid <= hibzero) + next + + if (bserr <= 0.0) + dw = 1.0d0 + else + dw = 1.0d0 / bserr ** 2 + sumbscale = sumbscale - dw * bscale + sumbserr = sumbserr - dw * bscale * bscale + sumwbscale = sumwbscale - dw + + if (bzerr <= 0.0) + dw = 1.0d0 + else + dw = 1.0d0 / bzerr ** 2 + sumbzero = sumbzero - dw * bzero + sumbzerr = sumbzerr - dw * bzero * bzero + sumwbzero = sumwbzero - dw + + nbad = nbad + 1 + Memi[rg_lstatp(ls,RDELETE)+i-1] = LS_BADSIGMA + ngood = ngood - 1 + } + + if (nbad <= 0) + break + + call rg_avstats (sumbscale, sumbzero, sumwbscale, sumwbzero, + sumbserr, sumbzerr, bserr, bzerr, avbscale, avbzero, + avbserr, avbzerr, ngood) + if (ngood <= 0) + break + + nrej = nrej + 1 + + } until (nrej >= rg_lstati(ls,NREJECT)) +end + + +# RG_AVSTATS -- Compute the average statistics. + +procedure rg_avstats (sumbscale, sumbzero, sumwbscale, sumwbzero, sumbserr, + sumbzerr, bserr, bzerr, avbscale, avbzero, avbserr, avbzerr, ngood) + +double sumbscale #I sum of the bscale values +double sumbzero #I sum of the bzero values +double sumwbscale #I sum of the weighted bscale values +double sumwbzero #I sum of the weighted bzero values +double sumbserr #I sum of the bscale error +double sumbzerr #I sum of the bscale error +real bserr #I the bscale error of 1 observation +real bzerr #I the bzero error of 1 observation +real avbscale #O the average bscale factor +real avbzero #O the average bzero factor +real avbserr #O the average bscale error factor +real avbzerr #O the average bzero error factor +int ngood #I the number of good data values + +begin + # Compute the average scaling factors. + if (ngood > 0) { + avbscale = sumbscale / sumwbscale + if (ngood > 1) { + avbserr = ngood * (sumbserr / sumwbscale - (sumbscale / + sumwbscale) ** 2) / + (ngood - 1) + if (avbserr >= 0.0) + avbserr = sqrt (avbserr) + else + avbserr = 0.0 + } else + avbserr = bserr + avbzero = sumbzero / sumwbzero + if (ngood > 1) { + avbzerr = ngood * (sumbzerr / sumwbzero - (sumbzero / + sumwbzero) ** 2) / + (ngood - 1) + if (avbzerr >= 0.0) + avbzerr = sqrt (avbzerr) + else + avbzerr = 0.0 + } else + avbzerr = bzerr + } else { + avbscale = 1.0 + avbzero = 0.0 + avbserr = INDEFR + avbzerr = INDEFR + } +end + + +# RG_LSIGMA -- Compute the standard deviation of an array taken into +# account any existing deletions. + +real procedure rg_lsigma (a, del, npts, mean) + +real a[ARB] #I the input array +int del[ARB] #I the deletions array +int npts #I the number of points in the array +real mean #I the mean of the array + +int i, ngood +double sumsq + +begin + sumsq = 0.0d0 + ngood = 0 + + do i = 1, npts { + if (del[i] != LS_NO) + next + if (IS_INDEFR(a[i])) + next + sumsq = sumsq + (a[i] - mean) ** 2 + ngood = ngood + 1 + } + + if (ngood <= 1) + return (0.0) + else if (sumsq <= 0.0) + return (0.0) + else + return (sqrt (real (sumsq / (ngood - 1)))) +end diff --git a/pkg/images/immatch/src/linmatch/rglshow.x b/pkg/images/immatch/src/linmatch/rglshow.x new file mode 100644 index 00000000..1bf2c65f --- /dev/null +++ b/pkg/images/immatch/src/linmatch/rglshow.x @@ -0,0 +1,107 @@ +include "linmatch.h" + +# RG_LSHOW -- Print the LINMATCH task parameters. + +procedure rg_lshow (ls) + +pointer ls #I pointer to linmatch structure + +pointer sp, str1, str2 +int rg_lstati() +real rg_lstatr() + +begin + call smark (sp) + call salloc (str1, SZ_LINE, TY_CHAR) + call salloc (str2, SZ_LINE, TY_CHAR) + + call printf ("\nIntensity Matching Parameters\n") + if (rg_lstati (ls, BSALGORITHM) != LS_PHOTOMETRY && rg_lstati(ls, + BZALGORITHM) != LS_PHOTOMETRY) { + call rg_lstats (ls, IMAGE, Memc[str1], SZ_FNAME) + call printf (" %s: %s") + call pargstr (KY_IMAGE) + call pargstr (Memc[str1]) + call rg_lstats (ls, REFIMAGE, Memc[str1], SZ_FNAME) + call printf (" %s: %s\n") + call pargstr (KY_REFIMAGE) + call pargstr (Memc[str1]) + call rg_lstats (ls, REGIONS, Memc[str1], SZ_FNAME) + call printf (" %s: %s\n") + call pargstr (KY_REGIONS) + call pargstr (Memc[str1]) + call rg_lstats (ls, CCDGAIN, Memc[str1], SZ_LINE) + call rg_lstats (ls, CCDREAD, Memc[str2], SZ_LINE) + call printf (" %s: %s %s: %s\n") + call pargstr (KY_GAIN) + call pargstr (Memc[str1]) + call pargstr (KY_READNOISE) + call pargstr (Memc[str2]) + } else { + call rg_lstats (ls, IMAGE, Memc[str1], SZ_FNAME) + call printf (" %s: %s\n") + call pargstr (KY_IMAGE) + call pargstr (Memc[str1]) + call rg_lstats (ls, PHOTFILE, Memc[str1], SZ_FNAME) + call printf (" %s: %s") + call pargstr (KY_IMAGE) + call pargstr (Memc[str1]) + call rg_lstats (ls, REFIMAGE, Memc[str1], SZ_FNAME) + call printf (" %s: %s\n") + call pargstr (KY_REFIMAGE) + call pargstr (Memc[str1]) + } + call rg_lstats (ls, SHIFTSFILE, Memc[str1], SZ_FNAME) + if (Memc[str1] != EOS) { + call printf (" %s: %s\n") + call pargstr (KY_SHIFTSFILE) + call pargstr (Memc[str1]) + } else { + call printf (" %s: %g %s: %g\n") + call pargstr (KY_XSHIFT) + call pargr (rg_lstatr(ls,XSHIFT)) + call pargstr (KY_YSHIFT) + call pargr (rg_lstatr(ls,YSHIFT)) + } + call printf (" %s: %d %s: %d\n") + call pargstr (KY_DNX) + call pargi (rg_lstati(ls,DNX)) + call pargstr (KY_DNY) + call pargi (rg_lstati(ls,DNY)) + + call rg_lstats (ls, DATABASE, Memc[str1], SZ_FNAME) + call printf (" %s: %s") + call pargstr (KY_DATABASE) + call pargstr (Memc[str1]) + call rg_lstats (ls, OUTIMAGE, Memc[str1], SZ_FNAME) + call printf (" %s: %s\n") + call pargstr (KY_OUTIMAGE) + call pargstr (Memc[str1]) + + call rg_lstats (ls, BSSTRING, Memc[str1], SZ_LINE) + call rg_lstats (ls, BZSTRING, Memc[str2], SZ_LINE) + call printf (" %s: %s %s\n") + call pargstr ("scaling") + call pargstr (Memc[str1]) + call pargstr (Memc[str2]) + call printf (" %s = %g %s = %g") + call pargstr (KY_DATAMIN) + call pargr (rg_lstatr (ls, DATAMIN)) + call pargstr (KY_DATAMAX) + call pargr (rg_lstatr (ls, DATAMAX)) + call printf (" %s: %d\n") + call pargstr (KY_MAXITER) + call pargi (rg_lstati(ls,MAXITER)) + call printf (" %s: %d") + call pargstr (KY_NREJECT) + call pargi (rg_lstati(ls,NREJECT)) + call printf (" %s = %g %s = %g\n") + call pargstr (KY_LOREJECT) + call pargr (rg_lstatr (ls, LOREJECT)) + call pargstr (KY_HIREJECT) + call pargr (rg_lstatr (ls, HIREJECT)) + + call printf ("\n") + + call sfree (sp) +end diff --git a/pkg/images/immatch/src/linmatch/rglsqfit.x b/pkg/images/immatch/src/linmatch/rglsqfit.x new file mode 100644 index 00000000..f728ecde --- /dev/null +++ b/pkg/images/immatch/src/linmatch/rglsqfit.x @@ -0,0 +1,443 @@ +include <mach.h> +include "lsqfit.h" + +# LL_RLSQF1 -- Given an initial fit reject points outside of the low and +# high cut rejections parameters. + +procedure ll_rlsqf1 (x, y, xerr, yerr, weight, npts, maxiter, answers, nreject, + locut, hicut) + +real x[ARB] #I the input vector +real y[ARB] #I the reference vector +real xerr[ARB] #I the input vector errors squared +real yerr[ARB] #I the reference vector errors squared +real weight[ARB] #I the input weight array +int npts #I the number of points +int maxiter #I the number of iterations +real answers[ARB] #I/O the answers array +int nreject #I the max number of rejection cycles +real locut #I the low side rejection parameter +real hicut #I the high side rejection parameter + +int i, niter, nrej +real loval, hival, resid + +begin + if ((IS_INDEFR(locut) && IS_INDEFR(hicut)) || npts <= 2) + return + if (RMS[answers] <= 0.0 || IS_INDEFR(CHI[answers])) + return + + niter = 0 + repeat { + if (IS_INDEFR(locut)) + loval = -MAX_REAL + else + loval = -locut * RMS[answers] + if (IS_INDEFR(hicut)) + hival = MAX_REAL + else + hival = hicut * RMS[answers] + nrej = 0 + do i = 1, npts { + if (weight[i] <= 0.0) + next + resid = y[i] - (SLOPE[answers] * x[i] + YINCPT[answers]) + if (resid >= loval && resid <= hival) + next + weight[i] = 0.0 + nrej = nrej + 1 + } + if (nrej <= 0) + break + call ll_lsqf1 (x, y, xerr, yerr, weight, npts, maxiter, answers) + if (IS_INDEFR(CHI[answers])) + break + if (RMS[answers] <= 0.0) + break + niter = niter + 1 + } until (niter >= nreject) +end + + +# LL_LSQF1 -- Compute the slope and intercept of the equation y = a * x + b +# using error arrays in both x and y. + +procedure ll_lsqf1 (x, y, xerr, yerr, weight, npts, niter, answers) + +real x[ARB] #I the input vector +real y[ARB] #I the reference vector +real xerr[ARB] #I the input vector errors squared +real yerr[ARB] #I the reference vector errors squared +real weight[ARB] #I the input weight array +int npts #I the number of points +int niter #I the number of iterations +real answers[ARB] #I/O the answers array + +int i, j +pointer bufr, bufx, bufw +real slope, yintrcpt, me1, msq, wt, dm, db + +begin + # Peform the initial fit. + call ll_0lsqf1 (x, y, weight, npts, answers) + if (IS_INDEFR(CHI[answers])) + return + + # Allocate working space. + call malloc (bufr, npts, TY_REAL) + call malloc (bufx, npts, TY_REAL) + call malloc (bufw, npts, TY_REAL) + + # Initialize the iterations. + slope = SLOPE[answers] + yintrcpt = YINCPT[answers] + me1 = CHI[answers] + + # Iterate on the fit. + do i = 1, niter { + msq = slope * slope + do j = 1, npts { + if (weight[j] <= 0.0) { + Memr[bufr+j-1] = 0.0 + Memr[bufw+j-1] = 0.0 + Memr[bufx+j-1] = 0.0 + } else { + wt = yerr[j] + msq * xerr[j] + if (wt <= 0.0) + wt = 1.0 + else + wt = 1.0 / wt + Memr[bufr+j-1] = y[j] - (slope * x[j] + yintrcpt) + Memr[bufw+j-1] = weight[j] * wt + Memr[bufx+j-1] = x[j] + Memr[bufr+j-1] * slope * xerr[j] * + wt + } + } + call ll_0lsqf1 (Memr[bufx], Memr[bufr], Memr[bufw], npts, answers) + if (IS_INDEFR(CHI[answers])) + break + if (abs ((me1 - CHI[answers]) / CHI[answers]) < 1.0e-5) + break + dm = SLOPE[answers] + db = YINCPT[answers] + me1 = CHI[answers] + slope = slope + dm + yintrcpt = yintrcpt + db + } + + # Compute the final answers. + SLOPE[answers] = slope + YINCPT[answers] = yintrcpt + + call mfree (bufr, TY_REAL) + call mfree (bufx, TY_REAL) + call mfree (bufw, TY_REAL) +end + + +# LL_0LSQF1: Compute the slope and intercept of the equation y = a * x + b +# using errors in y only. + +procedure ll_0lsqf1 (x, y, w, npts, answers) + +real x[ARB] #I the input vector +real y[ARB] #I the reference vector +real w[ARB] #I the weight vector +int npts #I the number of points +real answers[ARB] #I the answers + +int i, ngood +double sumyy, sumxx, sumxy, sumx, sumy, sumw +double a, b, det +real wressq, ressq +bool fp_equald() +double ll_dsum1(), ll_dsum2(), ll_dsum3() + +begin + # Compute the determinant. + sumyy = ll_dsum3 (y, y, w, npts) + sumxx = ll_dsum3 (x, x, w, npts) + sumxy = ll_dsum3 (x, y, w, npts) + sumy = ll_dsum2 (y, w, npts) + sumx = ll_dsum2 (x, w, npts) + sumw = ll_dsum1 (w, npts) + det = sumw * sumxx - sumx * sumx + + if (fp_equald (0.0d0, det)) { + SLOPE[answers] = INDEFR + YINCPT[answers] = INDEFR + ESLOPE[answers] = INDEFR + EYINCPT[answers] = INDEFR + CHI[answers] = INDEFR + RMS[answers] = INDEFR + } else { + a = (sumw * sumxy - sumx * sumy) / det + b = (sumxx * sumy - sumx * sumxy) / det + ngood = 0.0 + ressq = 0.0 + do i = 1, npts { + if (w[i] > 0.0) { + ngood = ngood + 1 + ressq = ressq + (y[i] - (a * x[i] + b)) ** 2 + } + } + SLOPE[answers] = a + YINCPT[answers] = b + wressq = sumyy + a * (a * sumxx + 2. * (b * sumx - sumxy)) + + b * (b * sumw - 2.0 * sumy) + if (ngood <= 2) { + CHI[answers] = 0.0 + ESLOPE[answers] = 0.0 + EYINCPT[answers] = 0.0 + RMS[answers] = 0.0 + } else if (wressq >= 0.0) { + CHI[answers] = sqrt (wressq / (ngood - 2)) + ESLOPE[answers] = CHI[answers] * sqrt (real (sumw / abs(det))) + EYINCPT[answers] = CHI[answers] * sqrt (real (sumxx / abs(det))) + RMS[answers] = sqrt (ressq / (ngood - 2)) + } else { + CHI[answers] = 0.0 + ESLOPE[answers] = 0.0 + EYINCPT[answers] = 0.0 + RMS[answers] = 0.0 + } + } +end + + +## GET_LSQF2: iterate LSq Fit to z=ax+by+c for errors in x, y and z. +## NB: xerr, yerr, zerr are errors SQUARED. +## +# +#procedure get_lsqf2 (x, y, z, xerr, yerr, zerr, weight, npts, niter, stats) +# +#real x[npts], y[npts], z[npts] # data vectors +#real xerr[npts], yerr[npts], zerr[npts] # error ** 2 vectors +#real weight[npts] # additional weight factors +#int npts # vector lengths +#int niter # no. of iterations +#real stats[NFITPAR] # returned fit params +# +#int i, j +#real a, b, c, me1 +#pointer bufr, bufx, bufy, bufw +#real asq, bsq, res, wt, da, db, dc +# +#begin +# call malloc (bufr, npts, TY_REAL) +# call malloc (bufx, npts, TY_REAL) +# call malloc (bufy, npts, TY_REAL) +# call malloc (bufw, npts, TY_REAL) +# +## initial fit; NB needs expansion +# call get_0lsqf2 (x, y, z, weight, npts, stats) +# a = SLOPE1[stats] +# b = SLOPE2[stats] +# c = OFFSET[stats] +# me1 = CHI[stats] +## call printf ("iteration: %2d a=%7.4f b=%7.4f off=%6.2f (%7.3f) \n") +## call pargi (0) +## call pargr (a) +## call pargr (b) +## call pargr (c) +## call pargr (me1) +# +## iterate +# do i = 1, niter { +# asq = a * a +# bsq = b * b +# do j = 1, npts { +# res = z[j] - (a * x[j] + b * y[j] + c) +# wt = 1. / (zerr[j] + asq * xerr[j] + bsq * yerr[j]) +# Memr[bufr+j-1] = res +# Memr[bufw+j-1] = weight[j] * wt +# Memr[bufx+j-1] = x[j] + res * a * xerr[j] * wt +# Memr[bufy+j-1] = y[j] + res * b * yerr[j] * wt +# } +# call get_0lsqf2 (Memr[bufx], Memr[bufy], Memr[bufr], Memr[bufw], npts, stats) +# da = SLOPE1[stats] +# db = SLOPE2[stats] +# dc = OFFSET[stats] +# me1 = CHI[stats] +# a = a + da +# b = b + db +# c = c + dc +## call printf ("iteration: %2d a=%7.4f b=%7.4f off=%6.2f (%7.3f) \n") +## call pargi (i) +## call pargr (a) +## call pargr (b) +## call pargr (c) +## call pargr (me1) +# } +# +# SLOPE1[stats] = a +# SLOPE2[stats] = b +# OFFSET[stats] = c +# +# call mfree (bufr, TY_REAL) +# call mfree (bufx, TY_REAL) +# call mfree (bufy, TY_REAL) +# call mfree (bufw, TY_REAL) +#end +# +## +## GET_0LSQF2 -- calculate the zeroth order LLSq Fit for 2 independent variables, +## assumming errors in z only +## +# +# procedure get_0lsqf2 (x, y, z, w, npt, stats) +# +#real x[npt], y[npt] # input coords +#real z[npt] # ref. coord. +#real w[npt] # weights +#int npt # number of points +#real stats[NFITPAR] # fit info struct +# +#real ga[4, 3] +# +#double dsum1(), dsum2(), dsum3() +# +#begin +# ga[1,1] = dsum3 (x, x, w, npt) +# ga[2,1] = dsum3 (x, y, w, npt) +# ga[2,2] = dsum3 (y, y, w, npt) +# ga[3,1] = dsum2 (x, w, npt) +# ga[3,2] = dsum2 (y, w, npt) +# ga[4,1] = dsum3 (x, z, w, npt) +# ga[4,2] = dsum3 (y, z, w, npt) +# ga[4,3] = dsum2 (z, w, npt) +# ga[3,3] = dsum1 (w, npt) +# +# ga[1,2] = ga[2,1] +# ga[1,3] = ga[3,1] +# ga[2,3] = ga[3,2] +# +# call g_elim(ga, 3) +# +# SLOPE1[stats] = ga[4,1] +# SLOPE2[stats] = ga[4,2] +# OFFSET[stats] = ga[4,3] +##need to define errors, me1 +# EOFFSET[stats] = INDEF +# ESLOPE1[stats] = INDEF +# ESLOPE2[stats] = INDEF +# CHI[stats] = INDEF +#end +# + + +# LL_LLSQF0 -- Compute the offset b in the equation y - x = b using error +# arrays in both x and y. + +#procedure ll_lsqf0 (x, y, xerr, yerr, w, npts, answers) + +#real x[ARB] #I the input vector +#real y[ARB] #I the reference vector +#real xerr[ARB] #I the input vector errors squared +#real yerr[ARB] #I the reference vector errors squared +#real w[ARB] #I the input weight vector +#int npts #I the number of points +#real answers[ARB] #I the answer vector + +#double sumxx, sumx, sumw +#pointer bufr, bufw +#double ll_dsum1(), ll_dsum2(), ll_dsum3() + +#begin +# # Allocate working space. +# call malloc (bufr, npts, TY_REAL) +# call malloc (bufw, npts, TY_REAL) +# +# call asubr (y, x, Memr[bufr], npts) +# call aaddr (yerr, xerr, Memr[bufw], npts) +# call adivr (w, Memr[bufw], Memr[bufw], npts) +# +# sumxx = ll_dsum3 (Memr[bufr], Memr[bufr], Memr[bufw], npts) +# sumx = ll_dsum2 (Memr[bufr], Memr[bufw], npts) +# sumw = ll_dsum1 (Memr[bufw], npts) +# +# if (sumw <= 0.0d0) { +# OFFSET[answers] = INDEFR +# EOFFSET[answers] = INDEFR +# CHI[answers] = INDEFR +# } else { +# OFFSET[answers] = sumx / sumw +# if (npts > 1) { +# CHI[answers] = sqrt (real ((sumxx - sumx * sumx / sumw) / +# (npts - 1))) +# EOFFSET[answers] = CHI[answers] / sqrt (real (sumw)) +# } else { +# CHI[answers] = 0.0 +# EOFFSET[answers] = 0.0 +# } +# } +# +# # Free working space. +# call mfree (bufr, TY_REAL) +# call mfree (bufw, TY_REAL) +#end + + +# LL_DSUM1 -- Compute a double precision vector sum. + +double procedure ll_dsum1 (a, n) + +real a[ARB] #I the input vector +int n #I the number of points + +double sum +int i + +begin + sum = 0.0d0 + do i = 1, n + sum = sum + a[i] + + return (sum) +end + + +# LL_DSUM2 -- Compute a double precision vector product. + +double procedure ll_dsum2 (a, b, n) + +real a[n] #I the input vector +real b[n] #I the weight vector +int n #I the number of points + +double sum +int i + +begin + sum = 0.0d0 + do i = 1, n { + if (b[i] > 0.0) + sum = sum + a[i] * b[i] + } + + return (sum) +end + + +# LL_DSUM3 -- Compute a double precision weighted dot product. + + +double procedure ll_dsum3 (a, b, c, n) + +real a[n] #I first input vector +real b[n] #I second input vector +real c[n] #I input weight vector +int n #I the number of points + +double sum +int i + +begin + sum = 0.0d0 + do i = 1, n + if (c[i] > 0.0) + sum = sum + a[i] * b[i] * c[i] + + return (sum) +end diff --git a/pkg/images/immatch/src/linmatch/rgltools.x b/pkg/images/immatch/src/linmatch/rgltools.x new file mode 100644 index 00000000..845a0ac4 --- /dev/null +++ b/pkg/images/immatch/src/linmatch/rgltools.x @@ -0,0 +1,1017 @@ +include "linmatch.h" + +# RG_LINIT -- Initialize the linscale structure. + +procedure rg_linit (ls, max_nregions) + +pointer ls #I/O pointer to the intensity scaling structure +int max_nregions #I the maximum number of regions + +begin + # Allocate the temporary space. + call malloc (ls, LEN_LSSTRUCT, TY_STRUCT) + + # Set up the regions parameters. + LS_NREGIONS(ls) = 0 + LS_CNREGION(ls) = 1 + LS_MAXNREGIONS(ls) = max_nregions + + # Initialize the pointers. + LS_RC1(ls) = NULL + LS_RC2(ls) = NULL + LS_RL1(ls) = NULL + LS_RL2(ls) = NULL + LS_RXSTEP(ls) = NULL + LS_RYSTEP(ls) = NULL + LS_XSHIFT(ls) = 0.0 + LS_YSHIFT(ls) = 0.0 + LS_SXSHIFT(ls) = 0.0 + LS_SYSHIFT(ls) = 0.0 + + LS_RBUF(ls) = NULL + LS_RGAIN(ls) = 1.0 + LS_RREADNOISE(ls) = 0.0 + LS_RMEAN(ls) = NULL + LS_RMEDIAN(ls) = NULL + LS_RMODE(ls) = NULL + LS_RSIGMA(ls) = NULL + LS_RSKY(ls) = NULL + LS_RSKYERR(ls) = NULL + LS_RMAG(ls) = NULL + LS_RMAGERR(ls) = NULL + LS_RNPTS(ls) = NULL + + LS_IBUF(ls) = NULL + LS_IGAIN(ls) = 1.0 + LS_IREADNOISE(ls) = 0.0 + LS_IMEAN(ls) = NULL + LS_IMEDIAN(ls) = NULL + LS_IMODE(ls) = NULL + LS_ISIGMA(ls) = NULL + LS_ISKY(ls) = NULL + LS_ISKYERR(ls) = NULL + LS_IMAG(ls) = NULL + LS_IMAGERR(ls) = NULL + LS_INPTS(ls) = NULL + + LS_RBSCALE(ls) = NULL + LS_RBSCALEERR(ls) = NULL + LS_RBZERO(ls) = NULL + LS_RBZEROERR(ls) = NULL + LS_RDELETE(ls) = NULL + LS_RCHI(ls) = NULL + + # Initialize the scaling algorithm parameters. + LS_BZALGORITHM(ls) = DEF_BZALGORITHM + LS_BSALGORITHM(ls) = DEF_BSALGORITHM + LS_CBZERO(ls) = DEF_CBZERO + LS_CBSCALE(ls) = DEF_CBSCALE + LS_DNX(ls) = DEF_DNX + LS_DNY(ls) = DEF_DNY + LS_MAXITER(ls) = DEF_MAXITER + LS_DATAMIN(ls) = DEF_DATAMIN + LS_DATAMAX(ls) = DEF_DATAMAX + LS_NREJECT(ls) = DEF_NREJECT + LS_LOREJECT(ls) = DEF_LOREJECT + LS_HIREJECT(ls) = DEF_HIREJECT + LS_GAIN(ls) = DEF_GAIN + LS_READNOISE(ls) = DEF_READNOISE + + # Initialize the answers + LS_TBZERO(ls) = 0.0 + LS_TBZEROERR(ls) = INDEFR + LS_TBSCALE(ls) = 1.0 + LS_TBSCALEERR(ls) = INDEFR + + # Initialize the strings. + call strcpy ("mean", LS_BSSTRING(ls), SZ_FNAME) + call strcpy ("mean", LS_BZSTRING(ls), SZ_FNAME) + LS_CCDGAIN(ls) = EOS + LS_CCDREAD(ls) = EOS + LS_IMAGE(ls) = EOS + LS_REFIMAGE(ls) = EOS + LS_REGIONS(ls) = EOS + LS_DATABASE(ls) = EOS + LS_OUTIMAGE(ls) = EOS + LS_RECORD(ls) = EOS + LS_SHIFTSFILE(ls) = EOS + LS_PHOTFILE(ls) = EOS + + # Initialize the buffers. + call rg_lrinit (ls) +end + + +# RG_LRINIT -- Initialize the region dependent part of the linscale structure. + +procedure rg_lrinit (ls) + +pointer ls #I pointer to the intensity scaling structure + +begin + # Free up previously defined region pointers. + call rg_lrfree (ls) + + # Allocate region definition pointers. + call malloc (LS_RC1(ls), LS_MAXNREGIONS(ls), TY_INT) + call malloc (LS_RC2(ls), LS_MAXNREGIONS(ls), TY_INT) + call malloc (LS_RL1(ls), LS_MAXNREGIONS(ls), TY_INT) + call malloc (LS_RL2(ls), LS_MAXNREGIONS(ls), TY_INT) + call malloc (LS_RXSTEP(ls), LS_MAXNREGIONS(ls), TY_INT) + call malloc (LS_RYSTEP(ls), LS_MAXNREGIONS(ls), TY_INT) + + # Allocate region statistics pointers. + call malloc (LS_RMEAN(ls), LS_MAXNREGIONS(ls), TY_REAL) + call malloc (LS_RMEDIAN(ls), LS_MAXNREGIONS(ls), TY_REAL) + call malloc (LS_RMODE(ls), LS_MAXNREGIONS(ls), TY_REAL) + call malloc (LS_RSIGMA(ls), LS_MAXNREGIONS(ls), TY_REAL) + call malloc (LS_RSKY(ls), LS_MAXNREGIONS(ls), TY_REAL) + call malloc (LS_RSKYERR(ls), LS_MAXNREGIONS(ls), TY_REAL) + call malloc (LS_RMAG(ls), LS_MAXNREGIONS(ls), TY_REAL) + call malloc (LS_RMAGERR(ls), LS_MAXNREGIONS(ls), TY_REAL) + call malloc (LS_RNPTS(ls), LS_MAXNREGIONS(ls), TY_INT) + + call malloc (LS_IMEAN(ls), LS_MAXNREGIONS(ls), TY_REAL) + call malloc (LS_IMEDIAN(ls), LS_MAXNREGIONS(ls), TY_REAL) + call malloc (LS_IMODE(ls), LS_MAXNREGIONS(ls), TY_REAL) + call malloc (LS_ISIGMA(ls), LS_MAXNREGIONS(ls), TY_REAL) + call malloc (LS_ISKY(ls), LS_MAXNREGIONS(ls), TY_REAL) + call malloc (LS_ISKYERR(ls), LS_MAXNREGIONS(ls), TY_REAL) + call malloc (LS_IMAG(ls), LS_MAXNREGIONS(ls), TY_REAL) + call malloc (LS_IMAGERR(ls), LS_MAXNREGIONS(ls), TY_REAL) + call malloc (LS_INPTS(ls), LS_MAXNREGIONS(ls), TY_INT) + + call malloc (LS_RBSCALE(ls), LS_MAXNREGIONS(ls), TY_REAL) + call malloc (LS_RBSCALEERR(ls), LS_MAXNREGIONS(ls), TY_REAL) + call malloc (LS_RBZERO(ls), LS_MAXNREGIONS(ls), TY_REAL) + call malloc (LS_RBZEROERR(ls), LS_MAXNREGIONS(ls), TY_REAL) + call malloc (LS_RDELETE(ls), LS_MAXNREGIONS(ls), TY_INT) + call malloc (LS_RCHI(ls), LS_MAXNREGIONS(ls), TY_REAL) + + # Initialize region definitions. + call amovki (INDEFI, Memi[LS_RC1(ls)], LS_MAXNREGIONS(ls)) + call amovki (INDEFI, Memi[LS_RC2(ls)], LS_MAXNREGIONS(ls)) + call amovki (INDEFI, Memi[LS_RL1(ls)], LS_MAXNREGIONS(ls)) + call amovki (INDEFI, Memi[LS_RL2(ls)], LS_MAXNREGIONS(ls)) + call amovki (INDEFI, Memi[LS_RXSTEP(ls)], LS_MAXNREGIONS(ls)) + call amovki (INDEFI, Memi[LS_RYSTEP(ls)], LS_MAXNREGIONS(ls)) + + # Initilaize the statistics. + call amovkr (INDEFR, Memr[LS_RMEAN(ls)], LS_MAXNREGIONS(ls)) + call amovkr (INDEFR, Memr[LS_RMEDIAN(ls)], LS_MAXNREGIONS(ls)) + call amovkr (INDEFR, Memr[LS_RMODE(ls)], LS_MAXNREGIONS(ls)) + call amovkr (INDEFR, Memr[LS_RSIGMA(ls)], LS_MAXNREGIONS(ls)) + call amovkr (INDEFR, Memr[LS_RSKY(ls)], LS_MAXNREGIONS(ls)) + call amovkr (INDEFR, Memr[LS_RSKYERR(ls)], LS_MAXNREGIONS(ls)) + call amovkr (INDEFR, Memr[LS_RMAG(ls)], LS_MAXNREGIONS(ls)) + call amovkr (INDEFR, Memr[LS_RMAGERR(ls)], LS_MAXNREGIONS(ls)) + call amovki (INDEFI, Memi[LS_RNPTS(ls)], LS_MAXNREGIONS(ls)) + call amovkr (INDEFR, Memr[LS_IMEAN(ls)], LS_MAXNREGIONS(ls)) + call amovkr (INDEFR, Memr[LS_IMEDIAN(ls)], LS_MAXNREGIONS(ls)) + call amovkr (INDEFR, Memr[LS_IMODE(ls)], LS_MAXNREGIONS(ls)) + call amovkr (INDEFR, Memr[LS_ISIGMA(ls)], LS_MAXNREGIONS(ls)) + call amovkr (INDEFR, Memr[LS_ISKY(ls)], LS_MAXNREGIONS(ls)) + call amovkr (INDEFR, Memr[LS_ISKYERR(ls)], LS_MAXNREGIONS(ls)) + call amovkr (INDEFR, Memr[LS_IMAG(ls)], LS_MAXNREGIONS(ls)) + call amovkr (INDEFR, Memr[LS_IMAGERR(ls)], LS_MAXNREGIONS(ls)) + call amovki (INDEFI, Memi[LS_INPTS(ls)], LS_MAXNREGIONS(ls)) + + # Initialize the answers. + call amovkr (INDEFR, Memr[LS_RBSCALE(ls)], LS_MAXNREGIONS(ls)) + call amovkr (INDEFR, Memr[LS_RBSCALEERR(ls)], LS_MAXNREGIONS(ls)) + call amovkr (INDEFR, Memr[LS_RBZERO(ls)], LS_MAXNREGIONS(ls)) + call amovkr (INDEFR, Memr[LS_RBZEROERR(ls)], LS_MAXNREGIONS(ls)) + call amovki (LS_NO, Memi[LS_RDELETE(ls)], LS_MAXNREGIONS(ls)) + call amovkr (INDEFR, Memr[LS_RCHI(ls)], LS_MAXNREGIONS(ls)) +end + + +# RG_LINDEFR -- Re-initialize the regions dependent buffers. + +procedure rg_lindefr (ls) + +pointer ls #I pointer to the intensity scaling structure + +int nregions +int rg_lstati() + +begin + nregions = rg_lstati (ls, NREGIONS) + if (nregions > 0) { + + # Reinitialize the region definition pointers. + call amovki (INDEFI, Memi[LS_RC1(ls)], nregions) + call amovki (INDEFI, Memi[LS_RC2(ls)], nregions) + call amovki (INDEFI, Memi[LS_RL1(ls)], nregions) + call amovki (INDEFI, Memi[LS_RL2(ls)], nregions) + call amovki (INDEFI, Memi[LS_RXSTEP(ls)], nregions) + call amovki (INDEFI, Memi[LS_RYSTEP(ls)], nregions) + + # Reinitialize the statistics pointers. + call amovkr (INDEFR, Memr[LS_RMEAN(ls)], nregions) + call amovkr (INDEFR, Memr[LS_RMEDIAN(ls)], nregions) + call amovkr (INDEFR, Memr[LS_RMODE(ls)], nregions) + call amovkr (INDEFR, Memr[LS_RSIGMA(ls)], nregions) + call amovkr (INDEFR, Memr[LS_RSKY(ls)], nregions) + call amovkr (INDEFR, Memr[LS_RSKYERR(ls)], nregions) + call amovkr (INDEFR, Memr[LS_RMAG(ls)], nregions) + call amovkr (INDEFR, Memr[LS_RMAGERR(ls)], nregions) + call amovki (INDEFI, Memi[LS_RNPTS(ls)], nregions) + + call amovkr (INDEFR, Memr[LS_IMEAN(ls)], nregions) + call amovkr (INDEFR, Memr[LS_IMEDIAN(ls)], nregions) + call amovkr (INDEFR, Memr[LS_IMODE(ls)], nregions) + call amovkr (INDEFR, Memr[LS_ISIGMA(ls)], nregions) + call amovkr (INDEFR, Memr[LS_ISKY(ls)], nregions) + call amovkr (INDEFR, Memr[LS_ISKYERR(ls)], nregions) + call amovkr (INDEFR, Memr[LS_IMAG(ls)], nregions) + call amovkr (INDEFR, Memr[LS_IMAGERR(ls)], nregions) + call amovki (INDEFI, Memi[LS_INPTS(ls)], nregions) + + # Reinitialize the answers pointers. + call amovkr (INDEFR, Memr[LS_RBSCALE(ls)], nregions) + call amovkr (INDEFR, Memr[LS_RBSCALEERR(ls)], nregions) + call amovkr (INDEFR, Memr[LS_RBZERO(ls)], nregions) + call amovkr (INDEFR, Memr[LS_RBZEROERR(ls)], nregions) + call amovki (LS_NO, Memi[LS_RDELETE(ls)], nregions) + call amovkr (INDEFR, Memr[LS_RCHI(ls)], nregions) + + } +end + + +# RG_LREALLOC -- Reallocate the regions dependent buffers. + +procedure rg_lrealloc (ls, nregions) + +pointer ls #I pointer to the intensity scaling structure +int nregions #I the number of regions + +int nr +int rg_lstati() + +begin + nr = rg_lstati (ls, NREGIONS) + + # Resize the region definition buffers. + call realloc (LS_RC1(ls), nregions, TY_INT) + call realloc (LS_RC2(ls), nregions, TY_INT) + call realloc (LS_RL1(ls), nregions, TY_INT) + call realloc (LS_RL2(ls), nregions, TY_INT) + call realloc (LS_RXSTEP(ls), nregions, TY_INT) + call realloc (LS_RYSTEP(ls), nregions, TY_INT) + + # Resize the statistics buffers. + call realloc (LS_RMEAN(ls), nregions, TY_REAL) + call realloc (LS_RMEDIAN(ls), nregions, TY_REAL) + call realloc (LS_RMODE(ls), nregions, TY_REAL) + call realloc (LS_RSIGMA(ls), nregions, TY_REAL) + call realloc (LS_RSKY(ls), nregions, TY_REAL) + call realloc (LS_RSKYERR(ls), nregions, TY_REAL) + call realloc (LS_RMAG(ls), nregions, TY_REAL) + call realloc (LS_RMAGERR(ls), nregions, TY_REAL) + call realloc (LS_RNPTS(ls), nregions, TY_INT) + + call realloc (LS_IMEAN(ls), nregions, TY_REAL) + call realloc (LS_IMEDIAN(ls), nregions, TY_REAL) + call realloc (LS_IMODE(ls), nregions, TY_REAL) + call realloc (LS_ISIGMA(ls), nregions, TY_REAL) + call realloc (LS_ISKY(ls), nregions, TY_REAL) + call realloc (LS_ISKYERR(ls), nregions, TY_REAL) + call realloc (LS_IMAG(ls), nregions, TY_REAL) + call realloc (LS_IMAGERR(ls), nregions, TY_REAL) + call realloc (LS_INPTS(ls), nregions, TY_INT) + + # Resize the answers buffers. + call realloc (LS_RBSCALE(ls), nregions, TY_REAL) + call realloc (LS_RBSCALEERR(ls), nregions, TY_REAL) + call realloc (LS_RBZERO(ls), nregions, TY_REAL) + call realloc (LS_RBZEROERR(ls), nregions, TY_REAL) + call realloc (LS_RDELETE(ls), nregions, TY_INT) + call realloc (LS_RCHI(ls), nregions, TY_REAL) + + # Reinitialize the region defintions. + call amovki (INDEFI, Memi[LS_RC1(ls)+nr], nregions - nr) + call amovki (INDEFI, Memi[LS_RC2(ls)+nr], nregions - nr) + call amovki (INDEFI, Memi[LS_RL1(ls)+nr], nregions - nr) + call amovki (INDEFI, Memi[LS_RL2(ls)+nr], nregions - nr) + call amovki (INDEFI, Memi[LS_RXSTEP(ls)+nr], nregions - nr) + call amovki (INDEFI, Memi[LS_RYSTEP(ls)+nr], nregions - nr) + + # Reinitialize the statistics buffers. + call amovkr (INDEFR, Memr[LS_RMEAN(ls)+nr], nregions - nr) + call amovkr (INDEFR, Memr[LS_RMEDIAN(ls)+nr], nregions - nr) + call amovkr (INDEFR, Memr[LS_RMODE(ls)+nr], nregions - nr) + call amovkr (INDEFR, Memr[LS_RSIGMA(ls)+nr], nregions - nr) + call amovkr (INDEFR, Memr[LS_RSKY(ls)+nr], nregions - nr) + call amovkr (INDEFR, Memr[LS_RSKYERR(ls)+nr], nregions - nr) + call amovkr (INDEFR, Memr[LS_RMAG(ls)+nr], nregions - nr) + call amovkr (INDEFR, Memr[LS_RMAGERR(ls)+nr], nregions - nr) + call amovki (INDEFI, Memi[LS_RNPTS(ls)+nr], nregions - nr) + + call amovkr (INDEFR, Memr[LS_IMEAN(ls)+nr], nregions - nr) + call amovkr (INDEFR, Memr[LS_IMEDIAN(ls)+nr], nregions - nr) + call amovkr (INDEFR, Memr[LS_IMODE(ls)+nr], nregions - nr) + call amovkr (INDEFR, Memr[LS_ISIGMA(ls)+nr], nregions - nr) + call amovkr (INDEFR, Memr[LS_ISKY(ls)+nr], nregions - nr) + call amovkr (INDEFR, Memr[LS_ISKYERR(ls)+nr], nregions - nr) + call amovkr (INDEFR, Memr[LS_IMAG(ls)+nr], nregions - nr) + call amovkr (INDEFR, Memr[LS_IMAGERR(ls)+nr], nregions - nr) + call amovki (INDEFI, Memi[LS_INPTS(ls)+nr], nregions - nr) + + # Reinitialize the answers buffers. + call amovkr (INDEFR, Memr[LS_RBSCALE(ls)+nr], nregions - nr) + call amovkr (INDEFR, Memr[LS_RBSCALEERR(ls)+nr], nregions - nr) + call amovkr (INDEFR, Memr[LS_RBZERO(ls)+nr], nregions - nr) + call amovkr (INDEFR, Memr[LS_RBZEROERR(ls)+nr], nregions - nr) + call amovki (LS_NO, Memi[LS_RDELETE(ls)+nr], nregions - nr) + call amovkr (INDEFR, Memr[LS_RCHI(ls)+nr], nregions - nr) +end + + +# RG_LRFREE -- Free the regions portion of the linscale structure. + +procedure rg_lrfree (ls) + +pointer ls #I pointer to the intensity scaling structure + +begin + LS_NREGIONS(ls) = 0 + + # Free the regions definitions buffers. + if (LS_RC1(ls) != NULL) + call mfree (LS_RC1(ls), TY_INT) + LS_RC1(ls) = NULL + if (LS_RC2(ls) != NULL) + call mfree (LS_RC2(ls), TY_INT) + LS_RC2(ls) = NULL + if (LS_RL1(ls) != NULL) + call mfree (LS_RL1(ls), TY_INT) + LS_RL1(ls) = NULL + if (LS_RL2(ls) != NULL) + call mfree (LS_RL2(ls), TY_INT) + LS_RL2(ls) = NULL + if (LS_RXSTEP(ls) != NULL) + call mfree (LS_RXSTEP(ls), TY_INT) + LS_RXSTEP(ls) = NULL + if (LS_RYSTEP(ls) != NULL) + call mfree (LS_RYSTEP(ls), TY_INT) + LS_RYSTEP(ls) = NULL + + # Free the statistics buffers. + if (LS_RBUF(ls) != NULL) + call mfree (LS_RBUF(ls), TY_REAL) + if (LS_RMEAN(ls) != NULL) + call mfree (LS_RMEAN(ls), TY_REAL) + LS_RMEAN(ls) = NULL + if (LS_RMEDIAN(ls) != NULL) + call mfree (LS_RMEDIAN(ls), TY_REAL) + LS_RMEDIAN(ls) = NULL + if (LS_RMODE(ls) != NULL) + call mfree (LS_RMODE(ls), TY_REAL) + LS_RMODE(ls) = NULL + if (LS_RSIGMA(ls) != NULL) + call mfree (LS_RSIGMA(ls), TY_REAL) + LS_RSIGMA(ls) = NULL + if (LS_RSKY(ls) != NULL) + call mfree (LS_RSKY(ls), TY_REAL) + LS_RSKY(ls) = NULL + if (LS_RSKYERR(ls) != NULL) + call mfree (LS_RSKYERR(ls), TY_REAL) + LS_RSKYERR(ls) = NULL + if (LS_RMAG(ls) != NULL) + call mfree (LS_RMAG(ls), TY_REAL) + LS_RMAG(ls) = NULL + if (LS_RMAGERR(ls) != NULL) + call mfree (LS_RMAGERR(ls), TY_REAL) + LS_RMAGERR(ls) = NULL + if (LS_RNPTS(ls) != NULL) + call mfree (LS_RNPTS(ls), TY_INT) + LS_RNPTS(ls) = NULL + + if (LS_IBUF(ls) != NULL) + call mfree (LS_IBUF(ls), TY_REAL) + if (LS_IMEAN(ls) != NULL) + call mfree (LS_IMEAN(ls), TY_REAL) + LS_IMEAN(ls) = NULL + if (LS_IMEDIAN(ls) != NULL) + call mfree (LS_IMEDIAN(ls), TY_REAL) + LS_IMEDIAN(ls) = NULL + if (LS_IMODE(ls) != NULL) + call mfree (LS_IMODE(ls), TY_REAL) + LS_IMODE(ls) = NULL + if (LS_ISIGMA(ls) != NULL) + call mfree (LS_ISIGMA(ls), TY_REAL) + LS_ISIGMA(ls) = NULL + if (LS_ISKY(ls) != NULL) + call mfree (LS_ISKY(ls), TY_REAL) + LS_ISKY(ls) = NULL + if (LS_ISKYERR(ls) != NULL) + call mfree (LS_ISKYERR(ls), TY_REAL) + LS_ISKYERR(ls) = NULL + if (LS_IMAG(ls) != NULL) + call mfree (LS_IMAG(ls), TY_REAL) + LS_IMAG(ls) = NULL + if (LS_IMAGERR(ls) != NULL) + call mfree (LS_IMAGERR(ls), TY_REAL) + LS_IMAGERR(ls) = NULL + if (LS_INPTS(ls) != NULL) + call mfree (LS_INPTS(ls), TY_INT) + LS_INPTS(ls) = NULL + + # Free the answers buffers. + if (LS_RBSCALE(ls) != NULL) + call mfree (LS_RBSCALE(ls), TY_REAL) + LS_RBSCALE(ls) = NULL + if (LS_RBSCALEERR(ls) != NULL) + call mfree (LS_RBSCALEERR(ls), TY_REAL) + LS_RBSCALEERR(ls) = NULL + if (LS_RBZERO(ls) != NULL) + call mfree (LS_RBZERO(ls), TY_REAL) + LS_RBZERO(ls) = NULL + if (LS_RBZEROERR(ls) != NULL) + call mfree (LS_RBZEROERR(ls), TY_REAL) + LS_RBZEROERR(ls) = NULL + if (LS_RDELETE(ls) != NULL) + call mfree (LS_RDELETE(ls), TY_INT) + LS_RDELETE(ls) = NULL + if (LS_RCHI(ls) != NULL) + call mfree (LS_RCHI(ls), TY_REAL) + LS_RCHI(ls) = NULL +end + + +# RG_LFREE -- Free the linscale structure. + +procedure rg_lfree (ls) + +pointer ls #I/O pointer to the intensity scaling structure + +begin + # Free the regions dependent pointers. + call rg_lrfree (ls) + + call mfree (ls, TY_STRUCT) +end + + +# RG_LSTATI -- Fetch the value of an integer parameter. + +int procedure rg_lstati (ls, param) + +pointer ls #I pointer to the intensity scaling structure +int param #I parameter to be fetched + +begin + switch (param) { + case CNREGION: + return (LS_CNREGION(ls)) + case NREGIONS: + return (LS_NREGIONS(ls)) + case MAXNREGIONS: + return (LS_MAXNREGIONS(ls)) + case BZALGORITHM: + return (LS_BZALGORITHM(ls)) + case BSALGORITHM: + return (LS_BSALGORITHM(ls)) + case DNX: + return (LS_DNX(ls)) + case DNY: + return (LS_DNY(ls)) + case MAXITER: + return (LS_MAXITER(ls)) + case NREJECT: + return (LS_NREJECT(ls)) + default: + call error (0, "RG_LSTATI: Unknown integer parameter.") + } +end + + +# RG_LSTATP -- Fetch the value of a pointer parameter. + +pointer procedure rg_lstatp (ls, param) + +pointer ls #I pointer to the intensity scaling structure +int param #I parameter to be fetched + +begin + switch (param) { + + case RC1: + return (LS_RC1(ls)) + case RC2: + return (LS_RC2(ls)) + case RL1: + return (LS_RL1(ls)) + case RL2: + return (LS_RL2(ls)) + case RXSTEP: + return (LS_RXSTEP(ls)) + case RYSTEP: + return (LS_RYSTEP(ls)) + + case RBUF: + return (LS_RBUF(ls)) + case RMEAN: + return (LS_RMEAN(ls)) + case RMEDIAN: + return (LS_RMEDIAN(ls)) + case RMODE: + return (LS_RMODE(ls)) + case RSIGMA: + return (LS_RSIGMA(ls)) + case RSKY: + return (LS_RSKY(ls)) + case RSKYERR: + return (LS_RSKYERR(ls)) + case RMAG: + return (LS_RMAG(ls)) + case RMAGERR: + return (LS_RMAGERR(ls)) + case RNPTS: + return (LS_RNPTS(ls)) + + case IBUF: + return (LS_IBUF(ls)) + case IMEAN: + return (LS_IMEAN(ls)) + case IMEDIAN: + return (LS_IMEDIAN(ls)) + case IMODE: + return (LS_IMODE(ls)) + case ISIGMA: + return (LS_ISIGMA(ls)) + case ISKY: + return (LS_ISKY(ls)) + case ISKYERR: + return (LS_ISKYERR(ls)) + case IMAG: + return (LS_IMAG(ls)) + case IMAGERR: + return (LS_IMAGERR(ls)) + case INPTS: + return (LS_INPTS(ls)) + + case RBSCALE: + return (LS_RBSCALE(ls)) + case RBSCALEERR: + return (LS_RBSCALEERR(ls)) + case RBZERO: + return (LS_RBZERO(ls)) + case RBZEROERR: + return (LS_RBZEROERR(ls)) + case RDELETE: + return (LS_RDELETE(ls)) + case RCHI: + return (LS_RCHI(ls)) + + default: + call error (0, "RG_LSTATP: Unknown pointer parameter.") + } +end + + +# RG_LSTATR -- Fetch the value of a real parameter. + +real procedure rg_lstatr (ls, param) + +pointer ls #I pointer to the intensity scaling structure +int param #I parameter to be fetched + +begin + switch (param) { + + case XSHIFT: + return (LS_XSHIFT(ls)) + case YSHIFT: + return (LS_YSHIFT(ls)) + case SXSHIFT: + return (LS_SXSHIFT(ls)) + case SYSHIFT: + return (LS_SYSHIFT(ls)) + + case CBZERO: + return (LS_CBZERO(ls)) + case CBSCALE: + return (LS_CBSCALE(ls)) + case DATAMIN: + return (LS_DATAMIN(ls)) + case DATAMAX: + return (LS_DATAMAX(ls)) + case LOREJECT: + return (LS_LOREJECT(ls)) + case HIREJECT: + return (LS_HIREJECT(ls)) + case GAIN: + return (LS_GAIN(ls)) + case RGAIN: + return (LS_RGAIN(ls)) + case IGAIN: + return (LS_IGAIN(ls)) + case READNOISE: + return (LS_READNOISE(ls)) + case RREADNOISE: + return (LS_RREADNOISE(ls)) + case IREADNOISE: + return (LS_IREADNOISE(ls)) + + case TBZERO: + return (LS_TBZERO(ls)) + case TBZEROERR: + return (LS_TBZEROERR(ls)) + case TBSCALE: + return (LS_TBSCALE(ls)) + case TBSCALEERR: + return (LS_TBSCALEERR(ls)) + + default: + call error (0, "RG_LSTATR: Unknown real parameter.") + } +end + + +# RG_LSTATS -- Fetch the value of a string parameter. + +procedure rg_lstats (ls, param, str, maxch) + +pointer ls #I pointer to the intensity scaling structure +int param #I parameter to be fetched +char str[ARB] #I the output string +int maxch #I maximum number of characters + +begin + switch (param) { + case BZSTRING: + call strcpy (LS_BZSTRING(ls), str, maxch) + case BSSTRING: + call strcpy (LS_BSSTRING(ls), str, maxch) + case CCDGAIN: + call strcpy (LS_CCDGAIN(ls), str, maxch) + case CCDREAD: + call strcpy (LS_CCDREAD(ls), str, maxch) + case IMAGE: + call strcpy (LS_IMAGE(ls), str, maxch) + case REFIMAGE: + call strcpy (LS_REFIMAGE(ls), str, maxch) + case REGIONS: + call strcpy (LS_REGIONS(ls), str, maxch) + case DATABASE: + call strcpy (LS_DATABASE(ls), str, maxch) + case OUTIMAGE: + call strcpy (LS_OUTIMAGE(ls), str, maxch) + case SHIFTSFILE: + call strcpy (LS_SHIFTSFILE(ls), str, maxch) + case PHOTFILE: + call strcpy (LS_PHOTFILE(ls), str, maxch) + case RECORD: + call strcpy (LS_RECORD(ls), str, maxch) + default: + call error (0, "RG_LSTATS: Unknown string parameter.") + } +end + + +# RG_LSETI -- Set the value of an integer parameter. + +procedure rg_lseti (ls, param, value) + +pointer ls # pointer to the intensity scaling structure +int param # parameter to be fetched +int value # value of the integer parameter + +begin + switch (param) { + + case NREGIONS: + LS_NREGIONS(ls) = value + case CNREGION: + LS_CNREGION(ls) = value + case MAXNREGIONS: + LS_MAXNREGIONS(ls) = value + + case BZALGORITHM: + LS_BZALGORITHM(ls) = value + switch (value) { + case LS_MEAN: + call strcpy ("mean", LS_BZSTRING(ls), SZ_FNAME) + case LS_MEDIAN: + call strcpy ("median", LS_BZSTRING(ls), SZ_FNAME) + case LS_MODE: + call strcpy ("mode", LS_BZSTRING(ls), SZ_FNAME) + case LS_FIT: + call strcpy ("fit", LS_BZSTRING(ls), SZ_FNAME) + case LS_PHOTOMETRY: + call strcpy ("photometry", LS_BZSTRING(ls), SZ_FNAME) + case LS_NUMBER: + ; + case LS_FILE: + call strcpy ("file", LS_BZSTRING(ls), SZ_FNAME) + LS_BSALGORITHM(ls) = value + call strcpy ("file", LS_BSSTRING(ls), SZ_FNAME) + default: + LS_BZALGORITHM(ls) = LS_NUMBER + call strcpy ("0.0", LS_BZSTRING(ls), SZ_FNAME) + LS_CBZERO(ls) = 0.0 + } + + case BSALGORITHM: + LS_BSALGORITHM(ls) = value + switch (value) { + case LS_MEAN: + call strcpy ("mean", LS_BSSTRING(ls), SZ_FNAME) + case LS_MEDIAN: + call strcpy ("median", LS_BSSTRING(ls), SZ_FNAME) + case LS_MODE: + call strcpy ("mode", LS_BSSTRING(ls), SZ_FNAME) + case LS_FIT: + call strcpy ("fit", LS_BSSTRING(ls), SZ_FNAME) + case LS_PHOTOMETRY: + call strcpy ("photometry", LS_BSSTRING(ls), SZ_FNAME) + case LS_NUMBER: + ; + case LS_FILE: + call strcpy ("file", LS_BSSTRING(ls), SZ_FNAME) + LS_BZALGORITHM(ls) = value + call strcpy ("file", LS_BZSTRING(ls), SZ_FNAME) + default: + LS_BSALGORITHM(ls) = LS_NUMBER + call strcpy ("1.0", LS_BSSTRING(ls), SZ_FNAME) + LS_CBSCALE(ls) = 1.0 + } + + case DNX: + LS_DNX(ls) = value + case DNY: + LS_DNY(ls) = value + case MAXITER: + LS_MAXITER(ls) = value + case NREJECT: + LS_NREJECT(ls) = value + + default: + call error (0, "RG_LSETI: Unknown integer parameter.") + } +end + + +# RG_LSETP -- Set the value of a pointer parameter. + +procedure rg_lsetp (ls, param, value) + +pointer ls #I pointer to the linscale structure +int param #I parameter to be fetched +pointer value #I value of the pointer parameter + +begin + switch (param) { + + case RC1: + LS_RC1(ls) = value + case RC2: + LS_RC2(ls) = value + case RL1: + LS_RL1(ls) = value + case RL2: + LS_RL2(ls) = value + case RXSTEP: + LS_RXSTEP(ls) = value + case RYSTEP: + LS_RYSTEP(ls) = value + + case RBUF: + LS_RBUF(ls) = value + case RMEAN: + LS_RMEAN(ls) = value + case RMEDIAN: + LS_RMEDIAN(ls) = value + case RMODE: + LS_RMODE(ls) = value + case RSIGMA: + LS_RSIGMA(ls) = value + case RSKY: + LS_RSKY(ls) = value + case RSKYERR: + LS_RSKYERR(ls) = value + case RMAG: + LS_RMAG(ls) = value + case RMAGERR: + LS_RMAGERR(ls) = value + case RNPTS: + LS_RNPTS(ls) = value + + case IBUF: + LS_IBUF(ls) = value + case IMEAN: + LS_IMEAN(ls) = value + case IMEDIAN: + LS_IMEDIAN(ls) = value + case IMODE: + LS_IMODE(ls) = value + case ISIGMA: + LS_ISIGMA(ls) = value + case ISKY: + LS_ISKY(ls) = value + case ISKYERR: + LS_ISKYERR(ls) = value + case IMAG: + LS_IMAG(ls) = value + case IMAGERR: + LS_IMAGERR(ls) = value + case INPTS: + LS_INPTS(ls) = value + + case RBSCALE: + LS_RBSCALE(ls) = value + case RBSCALEERR: + LS_RBSCALEERR(ls) = value + case RBZERO: + LS_RBZERO(ls) = value + case RBZEROERR: + LS_RBZEROERR(ls) = value + case RDELETE: + LS_RDELETE(ls) = value + case RCHI: + LS_RCHI(ls) = value + + default: + call error (0, "RG_LSETP: Unknown pointer parameter.") + } +end + + +# RG_LSETR -- Set the value of a real parameter. + +procedure rg_lsetr (ls, param, value) + +pointer ls #I pointer to iscale structure +int param #I parameter to be fetched +real value #I real parameter + +begin + switch (param) { + case XSHIFT: + LS_XSHIFT(ls) = value + case YSHIFT: + LS_YSHIFT(ls) = value + case SXSHIFT: + LS_SXSHIFT(ls) = value + case SYSHIFT: + LS_SYSHIFT(ls) = value + case CBZERO: + LS_CBZERO(ls) = value + case CBSCALE: + LS_CBSCALE(ls) = value + case DATAMIN: + LS_DATAMIN(ls) = value + case DATAMAX: + LS_DATAMAX(ls) = value + case LOREJECT: + LS_LOREJECT(ls) = value + case HIREJECT: + LS_HIREJECT(ls) = value + case GAIN: + LS_GAIN(ls) = value + case RGAIN: + LS_RGAIN(ls) = value + case IGAIN: + LS_IGAIN(ls) = value + case READNOISE: + LS_READNOISE(ls) = value + case RREADNOISE: + LS_RREADNOISE(ls) = value + case IREADNOISE: + LS_IREADNOISE(ls) = value + case TBSCALE: + LS_TBSCALE(ls) = value + case TBSCALEERR: + LS_TBSCALEERR(ls) = value + case TBZERO: + LS_TBZERO(ls) = value + case TBZEROERR: + LS_TBZEROERR(ls) = value + default: + call error (0, "RG_LSETR: Unknown real parameter.") + } +end + + +# RG_LSETS -- Set the value of a string parameter. + +procedure rg_lsets (ls, param, str) + +pointer ls # pointer to the intensity scaling structure +int param # parameter to be fetched +char str[ARB] # output string + +int index, ip +pointer sp, temp +real rval +int fnldir(), strdic(), ctor(), rg_lstati() + +begin + call smark (sp) + call salloc (temp, SZ_LINE, TY_CHAR) + + switch (param) { + + case BZSTRING: + ip = 1 + index = strdic (str, str, SZ_LINE, LS_SCALING) + if (index > 0) { + if (rg_lstati (ls, BSALGORITHM) == LS_NUMBER) { + call strcpy (str, LS_BZSTRING(ls), SZ_FNAME) + call rg_lseti (ls, BZALGORITHM, index) + } else { + call strcpy (LS_BSSTRING(ls), LS_BZSTRING(ls), SZ_FNAME) + call rg_lseti (ls, BZALGORITHM, rg_lstati (ls, BSALGORITHM)) + } + } else if (ctor (str, ip, rval) > 0) { + call strcpy (str, LS_BZSTRING(ls), SZ_FNAME) + call rg_lsetr (ls, CBZERO, rval) + call rg_lseti (ls, BZALGORITHM, LS_NUMBER) + } else { + call strcpy ("0.0", LS_BZSTRING(ls), SZ_FNAME) + call rg_lsetr (ls, CBZERO, 0.0) + call rg_lseti (ls, BZALGORITHM, LS_NUMBER) + } + case BSSTRING: + ip = 1 + index = strdic (str, str, SZ_LINE, LS_SCALING) + if (index > 0) { + call strcpy (str, LS_BSSTRING(ls), SZ_FNAME) + call rg_lseti (ls, BSALGORITHM, index) + } else if (ctor (str, ip, rval) > 0) { + call strcpy (str, LS_BSSTRING(ls), SZ_FNAME) + call rg_lsetr (ls, CBSCALE, rval) + call rg_lseti (ls, BSALGORITHM, LS_NUMBER) + } else { + call strcpy ("1.0", LS_BSSTRING(ls), SZ_FNAME) + call rg_lsetr (ls, CBSCALE, 1.0) + call rg_lseti (ls, BSALGORITHM, LS_NUMBER) + } + case CCDGAIN: + ip = 1 + if (ctor (str, ip, rval) > 0) { + call strcpy (str, LS_CCDGAIN(ls), SZ_FNAME) + call rg_lsetr (ls, RGAIN, rval) + if (ctor (str, ip, rval) > 0) + call rg_lsetr (ls, IGAIN, rval) + else + call rg_lsetr (ls, IGAIN, 1.0) + call rg_lsetr (ls, GAIN, INDEFR) + } else { + call sscan (str) + call gargwrd (Memc[temp], SZ_LINE) + call strcpy (Memc[temp], LS_CCDGAIN(ls), SZ_FNAME) + call rg_lsetr (ls, RGAIN, 1.0) + call rg_lsetr (ls, IGAIN, 1.0) + call rg_lsetr (ls, GAIN, INDEFR) + } + case CCDREAD: + ip = 1 + if (ctor (str, ip, rval) > 0) { + call strcpy (str, LS_CCDREAD(ls), SZ_FNAME) + call rg_lsetr (ls, RREADNOISE, rval) + if (ctor (str, ip, rval) > 0) + call rg_lsetr (ls, IREADNOISE, rval) + else + call rg_lsetr (ls, IREADNOISE, 0.0) + call rg_lsetr (ls, READNOISE, INDEFR) + } else { + call sscan (str) + call gargwrd (Memc[temp], SZ_LINE) + call strcpy (Memc[temp], LS_CCDREAD(ls), SZ_FNAME) + call rg_lsetr (ls, RREADNOISE, 0.0) + call rg_lsetr (ls, IREADNOISE, 0.0) + call rg_lsetr (ls, READNOISE, INDEFR) + } + + case IMAGE: + call imgcluster (str, Memc[temp], SZ_FNAME) + index = fnldir (Memc[temp], LS_IMAGE(ls), SZ_FNAME) + call strcpy (Memc[temp+index], LS_IMAGE(ls), SZ_FNAME) + case REFIMAGE: + call imgcluster (str, Memc[temp], SZ_FNAME) + index = fnldir (Memc[temp], LS_REFIMAGE(ls), SZ_FNAME) + call strcpy (Memc[temp+index], LS_REFIMAGE(ls), SZ_FNAME) + case REGIONS: + call strcpy (str, LS_REGIONS(ls), SZ_FNAME) + case DATABASE: + index = fnldir (str, LS_DATABASE(ls), SZ_FNAME) + call strcpy (str[index+1], LS_DATABASE(ls), SZ_FNAME) + case OUTIMAGE: + call strcpy (str, LS_OUTIMAGE(ls), SZ_FNAME) + case SHIFTSFILE: + call strcpy (str, LS_SHIFTSFILE(ls), SZ_FNAME) + case PHOTFILE: + call strcpy (str, LS_PHOTFILE(ls), SZ_FNAME) + case RECORD: + call strcpy (str, LS_RECORD(ls), SZ_FNAME) + + default: + call error (0, "RG_LSETS: Unknown string parameter.") + } + + call sfree (sp) +end diff --git a/pkg/images/immatch/src/linmatch/t_linmatch.x b/pkg/images/immatch/src/linmatch/t_linmatch.x new file mode 100644 index 00000000..d48f2c03 --- /dev/null +++ b/pkg/images/immatch/src/linmatch/t_linmatch.x @@ -0,0 +1,544 @@ +include <fset.h> +include <imhdr.h> +include <imset.h> +include <error.h> +include "linmatch.h" + +# T_LINMATCH -- Compute the parameters required to match the intensity scale +# of an image to that of a reference image using an expression of the form +# I(ref) = a + b * I(image) + +procedure t_linmatch() + +pointer freglist #I pointer to reference regions list +pointer database #I pointer to database file +int dformat #I write the output file in database format +int interactive #I interactive mode ? +int verbose #I verbose mode + +int list1, listr, list2, reglist, reclist, stat, nregions, shiftslist +int rpfd, ipfd, sfd +pointer sp, reference, imager, image1, imtemp, image2, str, str1, shifts +pointer ls, db, gd, id, imr, im1, im2 +bool clgetb() +int imtopen(), fntopnb(), imtlen(), fntlenb(), access(), btoi(), open() +int rg_lstati(), imtgetim(), fntgfnb(), rg_lregions(), rg_lscale() +int rg_lrphot(), rg_liscale() +pointer dtmap(), gopen(), immap() +real rg_lstatr() +errchk gopen() + +begin + call fseti (STDOUT, F_FLUSHNL, YES) + + # Allocate temporary space. + call smark (sp) + + call salloc (reference, SZ_FNAME, TY_CHAR) + call salloc (freglist, SZ_LINE, TY_CHAR) + call salloc (image1, SZ_FNAME, TY_CHAR) + call salloc (imager, SZ_FNAME, TY_CHAR) + call salloc (image2, SZ_FNAME, TY_CHAR) + call salloc (imtemp, SZ_FNAME, TY_CHAR) + call salloc (database, SZ_FNAME, TY_CHAR) + call salloc (shifts, SZ_FNAME, TY_CHAR) + call salloc (str, SZ_LINE, TY_CHAR) + call salloc (str1, SZ_LINE, TY_CHAR) + + # Open the input and output image lists. + call clgstr ("input", Memc[str], SZ_LINE) + list1 = imtopen (Memc[str]) + call clgstr ("reference", Memc[reference], SZ_LINE) + call clgstr ("regions", Memc[freglist], SZ_LINE) + call clgstr ("lintransform", Memc[database], SZ_LINE) + call clgstr ("output", Memc[str], SZ_LINE) + list2 = imtopen (Memc[str]) + call clgstr ("records", Memc[str], SZ_LINE) + if (Memc[str] == EOS) + reclist = NULL + else + reclist = fntopnb (Memc[str], NO) + call clgstr ("shifts", Memc[shifts], SZ_LINE) + + + # Open the cross correlation fitting structure. + call rg_glpars (ls) + + # Test the reference image list length + if ((rg_lstati (ls, BZALGORITHM) == LS_FILE || rg_lstati(ls, + BSALGORITHM) == LS_FILE) || (rg_lstati(ls, BZALGORITHM) == + LS_NUMBER && rg_lstati(ls, BSALGORITHM) == LS_NUMBER)) { + listr = NULL + reglist = NULL + shiftslist = NULL + call rg_lsets (ls, REGIONS, "") + } else if (rg_lstati(ls, BZALGORITHM) == LS_PHOTOMETRY || rg_lstati (ls, + BSALGORITHM) == LS_PHOTOMETRY) { + listr = fntopnb (Memc[reference], NO) + if (fntlenb (listr) <= 0) + call error (0, "The reference photometry list is empty.") + reglist = fntopnb (Memc[freglist], NO) + if (fntlenb (listr) > 1 && fntlenb (listr) != imtlen (list1)) { + call eprintf ("The number of reference photometry files") + call eprintf (" and input images is not the same.\n") + call erract (EA_FATAL) + } + if (fntlenb(reglist) != imtlen(list1)) { + call eprintf ("The number of input photometry files and") + call eprintf ("images are not the same.\n") + call erract (EA_FATAL) + } + shiftslist = NULL + call rg_lsets (ls, REGIONS, Memc[freglist]) + } else { + listr = imtopen (Memc[reference]) + if (imtlen (listr) <= 0) + call error (0, "The reference image list is empty.") + if (imtlen (listr) > 1 && imtlen (listr) != imtlen (list1)) + call error (0, + "The number of reference and input images is not the same.") + iferr { + reglist = fntopnb (Memc[freglist], NO) + } then + reglist = NULL + if (Memc[shifts] == EOS) + shiftslist = NULL + else { + shiftslist = fntopnb (Memc[shifts], NO) + if (imtlen(listr) != fntlenb (shiftslist)) + call error (0, + "The number of shifts files and images is not the same.") + } + call rg_lsets (ls, REGIONS, Memc[freglist]) + } + + + # Close the output image list if it is empty. + if (imtlen (list2) <= 0) { + call imtclose (list2) + list2 = NULL + } + + # Check that the output image list is the same as the input image + # list. + if (list2 != NULL) { + if (imtlen (list1) != imtlen (list2)) + call error (0, + "The number of input and output images are not the same.") + } + + # Check that the record list is the same length as the input image + # list length. + if (reclist != NULL) { + if (fntlenb (reclist) != imtlen (list1)) + call error (0, + "Input image and record lists are not the same length") + } + + # Open the database file. + dformat = btoi (clgetb ("databasefmt")) + if (rg_lstati(ls, BZALGORITHM) == LS_FILE && rg_lstati(ls, + BSALGORITHM) == LS_FILE) { + if (dformat == YES) + db = dtmap (Memc[database], READ_ONLY) + else + db = open (Memc[database], READ_ONLY, TEXT_FILE) + } else if (clgetb ("append")) { + if (dformat == YES) + db = dtmap (Memc[database], APPEND) + else + db = open (Memc[database], NEW_FILE, TEXT_FILE) + } else if (access(Memc[database], 0, 0) == YES) { + call error (0, "The shifts database file already exists") + } else { + if (dformat == YES) + db = dtmap (Memc[database], NEW_FILE) + else + db = open (Memc[database], NEW_FILE, TEXT_FILE) + } + call rg_lsets (ls, DATABASE, Memc[database]) + + if ((rg_lstati(ls, BZALGORITHM) == LS_FILE || rg_lstati(ls, + BSALGORITHM) == LS_FILE) || (rg_lstati(ls, BZALGORITHM) == + LS_NUMBER && rg_lstati(ls, BSALGORITHM) == LS_NUMBER)) + interactive = NO + else + interactive = btoi (clgetb ("interactive")) + if (interactive == YES) { + call clgstr ("graphics", Memc[str], SZ_FNAME) + iferr (gd = gopen (Memc[str], NEW_FILE, STDGRAPH)) + gd = NULL + call clgstr ("display", Memc[str], SZ_FNAME) + iferr (id = gopen (Memc[str], APPEND, STDIMAGE)) + id = NULL + verbose = YES + } else { + gd = NULL + id = NULL + verbose = btoi (clgetb ("verbose")) + } + + # Initialize the reference image pointer. + imr = NULL + sfd = NULL + rpfd = NULL + ipfd = NULL + + # Do each set of input and output images. + while ((imtgetim (list1, Memc[image1], SZ_FNAME) != EOF)) { + + # Open the reference image and associated regions files + # if the correlation function is not file. + if (rg_lstati(ls, BZALGORITHM) == LS_PHOTOMETRY || rg_lstati(ls, + BSALGORITHM) == LS_PHOTOMETRY) { + if (fntgfnb(listr, Memc[str], SZ_FNAME) != EOF) { + if (rpfd != NULL) + call close (rpfd) + rpfd = open (Memc[str], READ_ONLY, TEXT_FILE) + call rg_lsets (ls, REFIMAGE, Memc[str]) + call rg_lsetr (ls, RGAIN, rg_lstatr (ls,GAIN)) + call rg_lsetr (ls, RREADNOISE, rg_lstatr (ls,READNOISE)) + nregions = rg_lrphot (rpfd, ls, 1, rg_lstati(ls, + MAXNREGIONS), YES) + if (nregions <= 0 && interactive == NO) + call error (0, + "The reference photometry file is empty.") + } + } else if ((rg_lstati(ls, BZALGORITHM) == LS_FILE || rg_lstati(ls, + BSALGORITHM) == LS_FILE) || (rg_lstati(ls,BZALGORITHM) == + LS_NUMBER && rg_lstati(ls,BSALGORITHM) == LS_NUMBER)) { + call rg_lsets (ls, REFIMAGE, "reference") + } else { + if (imtgetim(listr, Memc[str], SZ_FNAME) != EOF) { + if (imr != NULL) + call imunmap (imr) + imr = immap (Memc[str], READ_ONLY, 0) + if (IM_NDIM(imr) > 2) + call error (0, "Referenc image must be 1D or 2D") + call rg_lgain (imr, ls) + if (!IS_INDEFR(rg_lstatr(ls,GAIN))) + call rg_lsetr (ls, RGAIN, rg_lstatr (ls,GAIN)) + call rg_lrdnoise (imr, ls) + if (!IS_INDEFR(rg_lstatr(ls,READNOISE))) + call rg_lsetr (ls, RREADNOISE, rg_lstatr (ls,READNOISE)) + call rg_lsets (ls, REFIMAGE, Memc[str]) + nregions = rg_lregions (reglist, imr, ls, 1, NO) + if (nregions <= 0 && interactive == NO) + call error (0, "The regions list is empty.") + if (shiftslist != NULL) { + if (sfd != NULL) + call close (sfd) + if (fntgfnb (shiftslist, Memc[str], SZ_FNAME) == EOF) { + call rg_lsets (ls, SHIFTSFILE, "") + sfd = NULL + } else { + call rg_lsets (ls, SHIFTSFILE, Memc[str]) + sfd = open (Memc[str], READ_ONLY, TEXT_FILE) + } + } + } + } + + # Open the input image. + if (list2 == NULL && imr == NULL) + im1 = NULL + else { + im1 = immap (Memc[image1], READ_ONLY, 0) + if (IM_NDIM(im1) > 2) { + call error (0, "Input images must be 1D or 2D") + } else if (imr != NULL) { + if (IM_NDIM(im1) != IM_NDIM(imr)) { + call eprintf ("Input images must have same") + call eprintf (" dimensionality as reference images.\n") + call erract (EA_FATAL) + } + } + call rg_lgain (im1, ls) + if (!IS_INDEFR(rg_lstatr(ls,GAIN))) + call rg_lsetr (ls, IGAIN, rg_lstatr (ls, GAIN)) + call rg_lrdnoise (im1, ls) + if (!IS_INDEFR(rg_lstatr(ls,READNOISE))) + call rg_lsetr (ls, IREADNOISE, rg_lstatr (ls, READNOISE)) + } + call rg_lsets (ls, IMAGE, Memc[image1]) + + # Open the input photometry file. + if (rpfd != NULL) { + if (fntgfnb (reglist, Memc[str], SZ_FNAME) != EOF) { + ipfd = open (Memc[str], READ_ONLY, TEXT_FILE) + call rg_lsets (ls, PHOTFILE, Memc[str]) + } + nregions = rg_lrphot (ipfd, ls, 1, rg_lstati (ls, + NREGIONS), NO) + if (nregions <= 0 && interactive == NO) + call error (0, + "The input photometry file is empty.") + if (nregions < rg_lstati (ls, NREGIONS) && interactive == NO) { + call eprintf ("The input photometry file has fewer") + call eprintf (" objects than the reference photoemtry") + call eprintf (" file.\n") + call erract (EA_FATAL) + } + } + + # Open the output image if any. + if (list2 == NULL) { + im2 = NULL + Memc[image2] = EOS + } else if (imtgetim (list2, Memc[image2], SZ_FNAME) != EOF) { + call xt_mkimtemp (Memc[image1], Memc[image2], Memc[imtemp], + SZ_FNAME) + im2 = immap (Memc[image2], NEW_COPY, im1) + } else { + im2 = NULL + Memc[image2] = EOS + } + call rg_lsets (ls, OUTIMAGE, Memc[image2]) + + # Get the record names. + if (reclist == NULL) + call strcpy (Memc[image1], Memc[str], SZ_FNAME) + else if (fntgfnb (reclist, Memc[str], SZ_FNAME) == EOF) + call strcpy (Memc[image1], Memc[str], SZ_FNAME) + call rg_lsets (ls, RECORD, Memc[str]) + + # Compute the initial shift. + if (sfd != NULL) { + call rg_lgshift (sfd, ls) + } else { + call rg_lsetr (ls, SXSHIFT, rg_lstatr (ls, XSHIFT)) + call rg_lsetr (ls, SYSHIFT, rg_lstatr (ls, YSHIFT)) + } + + # Compute the scaling factors. + if (interactive == YES) { + stat = rg_liscale (imr, im1, im2, db, dformat, reglist, + rpfd, ipfd, sfd, ls, gd, id) + } else { + stat = rg_lscale (imr, im1, db, dformat, ls) + if (verbose == YES) { + if (rg_lstati(ls,BSALGORITHM) == LS_PHOTOMETRY || + rg_lstati(ls,BZALGORITHM) == LS_PHOTOMETRY) + call rg_lstats (ls, PHOTFILE, Memc[str1], SZ_FNAME) + else + call strcpy (Memc[image1], Memc[str1], SZ_FNAME) + call rg_lstats (ls, REFIMAGE, Memc[str], SZ_LINE) + call printf ( + "Average scale factors from %s to %s are %g %g\n") + call pargstr (Memc[str1]) + call pargstr (Memc[str]) + call pargr (rg_lstatr (ls, TBSCALE)) + call pargr (rg_lstatr (ls, TBZERO)) + } + } + + # Scale the image. + if (im2 != NULL && stat == NO) { + if (verbose == YES) { + call printf ( + "\tScaling image %s to image %s ...\n") + call pargstr (Memc[image1]) + call pargstr (Memc[imtemp]) + } + call imseti (im1, IM_CANCEL, YES) + call rg_limscale (im1, im2, rg_lstatr (ls, TBSCALE), + rg_lstatr (ls, TBZERO)) + } + + # Close up the input and output images. + if (im1 != NULL) + call imunmap (im1) + if (im2 != NULL) { + call imunmap (im2) + if (stat == YES) + call imdelete (Memc[image2]) + else + call xt_delimtemp (Memc[image2], Memc[imtemp]) + } + + if (stat == YES) + break + } + + # Close up the files and images. + if (imr != NULL) + call imunmap (imr) + + # Close up the lists. + if (list1 != NULL) + call imtclose (list1) + if (listr != NULL) { + if (rg_lstati (ls, BZALGORITHM) == LS_PHOTOMETRY || rg_lstati(ls, + BSALGORITHM) == LS_PHOTOMETRY) + call fntclsb (listr) + else + call imtclose (listr) + } + if (list2 != NULL) + call imtclose (list2) + if (sfd != NULL) + call close (sfd) + if (rpfd != NULL) + call close (rpfd) + if (ipfd != NULL) + call close (ipfd) + if (shiftslist != NULL) + call fntclsb (shiftslist) + if (reglist != NULL) + call fntclsb (reglist) + if (reclist != NULL) + call fntclsb (reclist) + if (dformat == YES) + call dtunmap (db) + else + call close (db) + + # Close up the graphics and image display devices. + if (gd != NULL) + call gclose (gd) + if (id != NULL) + call gclose (id) + + # Free the matching structure. + call rg_lfree (ls) + + call sfree (sp) +end + + +# RG_LGAIN -- Fetch the gain parameter from the image header. + +procedure rg_lgain (im, ls) + +pointer im #I pointer to the input image +pointer ls #I pointer to the intensity matching structure + +int ip +pointer sp, key +real epadu +int ctor() +real imgetr() +errchk imgetr() + +begin + call smark (sp) + call salloc (key, SZ_FNAME, TY_CHAR) + + call rg_lstats (ls, CCDGAIN, Memc[key], SZ_FNAME) + ip = 1 + if (ctor (Memc[key], ip, epadu) <= 0) { + iferr { + epadu = imgetr (im, Memc[key]) + } then { + epadu = INDEFR + call eprintf ("Warning: Image %s Keyword %s not found.\n") + call pargstr (IM_HDRFILE(im)) + call pargstr (Memc[key]) + } + } else + epadu = INDEFR + if (IS_INDEFR(epadu) || epadu <= 0.0) + call rg_lsetr (ls, GAIN, INDEFR) + Else + call rg_lsetr (ls, GAIN, epadu) + + call sfree (sp) +end + + +# LG_LRDNOISE -- Fetch the readout noise from the image header. + +procedure rg_lrdnoise (im, ls) + +pointer im #I pointer to the input image +pointer ls #I pointer to the intensity matching structure + +int ip +pointer sp, key +real rdnoise +int ctor() +real imgetr() +errchk imgetr() + +begin + call smark (sp) + call salloc (key, SZ_FNAME, TY_CHAR) + + call rg_lstats (ls, CCDREAD, Memc[key], SZ_FNAME) + ip = 1 + if (ctor (Memc[key], ip, rdnoise) <= 0) { + iferr { + rdnoise = imgetr (im, Memc[key]) + } then { + rdnoise = INDEFR + call eprintf ("Warning: Image %s Keyword %s not found.\n") + call pargstr (IM_HDRFILE(im)) + call pargstr (Memc[key]) + } + } else + rdnoise = INDEFR + if (IS_INDEFR(rdnoise) || rdnoise <= 0.0) + call rg_lsetr (ls, READNOISE, INDEFR) + else + call rg_lsetr (ls, READNOISE, rdnoise) + + call sfree (sp) +end + + +# RG_LGSHIFT -- Read the x and y shifts from a file + +procedure rg_lgshift (fd, ls) + +int fd #I input shifts file descriptor +pointer ls #I pointer to the intensity matching structure + +real xshift, yshift +int fscan(), nscan() + +begin + xshift = 0.0 + yshift = 0.0 + + while (fscan(fd) != EOF) { + call gargr (xshift) + call gargr (yshift) + if (nscan() >= 2) + break + xshift = 0.0 + yshift = 0.0 + } + + call rg_lsetr (ls, SXSHIFT, xshift) + call rg_lsetr (ls, SYSHIFT, yshift) +end + + +# RG_LIMSCALE -- Linearly scale the input image. + +procedure rg_limscale (im1, im2, bscale, bzero) + +pointer im1 #I pointer to the input image +pointer im2 #I pointer to the output image +real bscale #I the bscale value +real bzero #I the bzero value + +int ncols +pointer sp, v1, v2, buf1, buf2 +int imgnlr(), impnlr() + +begin + call smark (sp) + call salloc (v1, IM_MAXDIM, TY_LONG) + call salloc (v2, IM_MAXDIM, TY_LONG) + + ncols = IM_LEN(im1,1) + call amovkl (long(1), Meml[v1], IM_MAXDIM) + call amovkl (long(1), Meml[v2], IM_MAXDIM) + while (imgnlr (im1, buf1, Meml[v1]) != EOF) { + if (impnlr (im2, buf2, Meml[v2]) != EOF) + call altmr (Memr[buf1], Memr[buf2], ncols, bscale, bzero) + } + + call sfree (sp) +end diff --git a/pkg/images/immatch/src/listmatch/mkpkg b/pkg/images/immatch/src/listmatch/mkpkg new file mode 100644 index 00000000..1d9f42c5 --- /dev/null +++ b/pkg/images/immatch/src/listmatch/mkpkg @@ -0,0 +1,12 @@ +# Make the XYXYMATCH/IMCENTROID tasks + +$checkout libpkg.a ../../../ +$update libpkg.a +$checkin libpkg.a ../../../ +$exit + + +libpkg.a: + t_imctroid.x <error.h> <mach.h> <imhdr.h> + t_xyxymatch.x <fset.h> "../../../lib/xyxymatch.h" + ; diff --git a/pkg/images/immatch/src/listmatch/t_imctroid.x b/pkg/images/immatch/src/listmatch/t_imctroid.x new file mode 100644 index 00000000..157e41ca --- /dev/null +++ b/pkg/images/immatch/src/listmatch/t_imctroid.x @@ -0,0 +1,1016 @@ +include <fset.h> +include <imhdr.h> +include <error.h> +include <mach.h> + +define LEN_CP 32 # center structure pointer + +# task parameters +define SMALLBOX Memi[($1)] +define BIGBOX Memi[($1)+1] +define VERBOSE Memi[($1)+2] +define NEGATIVE Memi[($1)+3] +define BACKGROUND Memr[P2R(($1)+4)] +define LO_THRESH Memr[P2R(($1)+5)] +define HI_THRESH Memr[P2R(($1)+6)] +define MAX_TRIES Memi[($1)+7] +define TOL Memi[($1)+8] +define MAX_SHIFT Memr[P2R(($1)+9)] + +# other scalars +define IM Memi[($1)+10] +define BOXSIZE Memi[($1)+11] +define BACK_LOCAL Memr[P2R(($1)+12)] +define LO_LOCAL Memr[P2R(($1)+13)] +define HI_LOCAL Memr[P2R(($1)+14)] +define NIMAGES Memi[($1)+15] +define NCOORDS Memi[($1)+16] + +# expensive, but the indexing isn't done excessively many times +define OFF1D (($1)-1) +define OFF2D ((($2)-1)*NCOORDS($1)+(($3)-1)) + +# vectors and matrices +define XINIT_PT Memi[($1)+20] # need space for NCOORDS of these +define YINIT_PT Memi[($1)+21] +define XINIT Memr[XINIT_PT($1)+OFF1D($2)] +define YINIT Memr[YINIT_PT($1)+OFF1D($2)] + +define XSHIFT_PT Memi[($1)+22] # space for NIMAGES of these +define YSHIFT_PT Memi[($1)+23] +define XSHIFT Memr[XSHIFT_PT($1)+OFF1D($2)] +define YSHIFT Memr[YSHIFT_PT($1)+OFF1D($2)] + +define XSIZE_PT Memi[($1)+24] # space for NIMAGES+1 +define YSIZE_PT Memi[($1)+25] +define XSIZE Memr[XSIZE_PT($1)+OFF1D($2)] +define YSIZE Memr[YSIZE_PT($1)+OFF1D($2)] + +define XCENTER_PT Memi[($1)+26] # space for (NIMAGES+1)*NCOORDS +define YCENTER_PT Memi[($1)+27] +define XCENTER Memr[XCENTER_PT($1)+OFF2D($1,$2,$3)] +define YCENTER Memr[YCENTER_PT($1)+OFF2D($1,$2,$3)] + +define XSIGMA_PT Memi[($1)+28] +define YSIGMA_PT Memi[($1)+29] +define XSIGMA Memr[XSIGMA_PT($1)+OFF2D($1,$2,$3)] +define YSIGMA Memr[YSIGMA_PT($1)+OFF2D($1,$2,$3)] + +define REJECTED_PT Memi[($1)+30] +define REJECTED Memi[REJECTED_PT($1)+OFF2D($1,$2,$3)] + + +# list "template" structure, currently just read the file +define LEN_LP 2 + +define LP_FD Memi[($1)] +define LP_LEN Memi[($1)+1] + +# T_IMCENTROID -- Find the centroids of a list of sources in a list of +# images and compute the average shifts relative to a reference image. + +procedure t_imcentroid() + +pointer imlist, coordlist, shiftlist +pointer img, ref, refer, cp, im, sp +int nimages, ncoords, nshifts, ncentered, i, j +real x, y, junk +bool error_seen, firsttime + +pointer imtopenp(), immap(), ia_openp2r(), ia_init() +int imtlen(), imtgetim(), ia_len(), ia_center(), strmatch() + +errchk imtopenp, immap, imunmap +errchk ia_init, ia_openp2r, ia_len, ia_close, ia_center + +begin + call smark (sp) + call salloc (img, SZ_FNAME, TY_CHAR) + call salloc (refer, SZ_FNAME, TY_CHAR) + + error_seen = false + imlist = NULL + coordlist = NULL + shiftlist = NULL + ref = NULL + cp = NULL + + iferr { + # Flush on new line to avoid eprint output from appear + # in the middle of regular output. + call fseti (STDOUT, F_FLUSHNL, YES) + + # Open the input image list. + imlist = imtopenp ("input") + nimages = imtlen (imlist) + if (nimages <= 0) + call error (1, "No images specified") + + # Get the reference image and check name for whitespace. + call clgstr ("reference", Memc[refer], SZ_FNAME) + if (Memc[refer] != EOS && strmatch (Memc[refer], "^#$") == 0) + iferr (ref = immap (Memc[refer], READ_ONLY, 0)) { + ref = NULL + call error (1, "Reference not found") + } + + # Open the coordinate list. + coordlist = ia_openp2r ("coords") + ncoords = ia_len (coordlist) + if (ncoords <= 0) + call error (1, "No coordinates found") + + # Open the shifts file. + shiftlist = ia_openp2r ("shifts") + nshifts = ia_len (shiftlist) + if (nshifts <= 0) + call ia_close (shiftlist) + else if (nshifts != nimages) + call error (1, "Number of shifts doesn't match images") + + # Initialize the centering structure. + cp = ia_init (shiftlist, nimages, coordlist, ncoords) + + if (ref == NULL) + VERBOSE(cp) = YES + + if (VERBOSE(cp) == YES) { + call printf ("#Coords%16tImage X-center Err") + call printf (" Y-center Err Num\n") + call flush (STDOUT) + } + + # Loop over all the images + ncentered = 0 + for (i=1; imtgetim (imlist, Memc[img], SZ_FNAME) != EOF; i=i+1) { + im = immap (Memc[img], READ_ONLY, 0) + IM(cp) = im + + if (IM_NDIM(im) != 2) { + call eprintf ("%s: ") + call pargstr (Memc[img]) + call error (1, "Image is not 2 dimensional") + } + + XSIZE(cp,i) = real (IM_LEN(im,1)) + YSIZE(cp,i) = real (IM_LEN(im,2)) + + if (nshifts == 0) { + BOXSIZE(cp) = BIGBOX(cp) + if (ia_center (cp, XINIT(cp,1), YINIT(cp,1), x, y, + junk, junk) == ERR) + call error (1, "Problem with coarse centering") + XSHIFT(cp,i) = XINIT(cp,1) - x + YSHIFT(cp,i) = YINIT(cp,1) - y + } + + firsttime = true + do j = 1, ncoords { + x = XINIT(cp,j) - XSHIFT(cp,i) + y = YINIT(cp,j) - YSHIFT(cp,i) + + if (x < 1 || x > XSIZE(cp,i) || y < 1 || y > YSIZE(cp,i)) { + REJECTED(cp,i,j) = YES + next + } + + BOXSIZE(cp) = SMALLBOX(cp) + if (ia_center (cp, x, y, XCENTER(cp,i,j), YCENTER(cp,i,j), + XSIGMA(cp,i,j), YSIGMA(cp,i,j)) == ERR) { + REJECTED(cp,i,j) = YES + next + } + + if (abs (XCENTER(cp,i,j) - x) > MAX_SHIFT(cp)) { + REJECTED(cp,i,j) = YES + next + } + if (abs (YCENTER(cp,i,j) - y) > MAX_SHIFT(cp)) { + REJECTED(cp,i,j) = YES + next + } + + if (firsttime) + firsttime = false + + if (VERBOSE(cp) == YES) { + call printf ( + "%20s %9.3f (%.3f) %9.3f (%.3f) %4d\n") + call pargstr (Memc[img]) + call pargr (XCENTER(cp,i,j)) + call pargr (XSIGMA(cp,i,j)) + call pargr (YCENTER(cp,i,j)) + call pargr (YSIGMA(cp,i,j)) + call pargi (j) + } + } + + if (firsttime) { + call eprintf ("Warning: no sources centered in %s\n") + call pargstr (Memc[img]) + call flush (STDERR) + } else + ncentered = ncentered + 1 + + if (VERBOSE(cp) == YES) { + call printf ("\n") + call flush (STDOUT) + } + + call imunmap (im) + } + + # Measure the reference coordinates if any. + if (ref != NULL) { + IM(cp) = ref + + if (IM_NDIM(ref) != 2) { + call eprintf ("%s: ") + call pargstr (Memc[refer]) + call error (1, "Reference image is not 2 dimensional") + } + + XSIZE(cp,nimages+1) = real (IM_LEN(ref,1)) + YSIZE(cp,nimages+1) = real (IM_LEN(ref,2)) + + firsttime = true + do j = 1, ncoords { + x = XINIT(cp,j) + y = YINIT(cp,j) + + if (x < 1 || x > XSIZE(cp,nimages+1) || + y < 1 || y > YSIZE(cp,nimages+1)) { + REJECTED(cp,nimages+1,j) = YES + next + } + + BOXSIZE(cp) = SMALLBOX(cp) + if (ia_center (cp, x, y, XCENTER(cp,nimages+1,j), + YCENTER(cp,nimages+1,j), XSIGMA(cp,nimages+1,j), + YSIGMA(cp,nimages+1,j)) == ERR) { + REJECTED(cp,nimages+1,j) = YES + next + } + + if (abs (XCENTER(cp,nimages+1,j) - x) > MAX_SHIFT(cp)) { + REJECTED(cp,nimages+1,j) = YES + next + } + if (abs (YCENTER(cp,nimages+1,j) - y ) > MAX_SHIFT(cp)) { + REJECTED(cp,nimages+1,j) = YES + next + } + + if (firsttime) { + if (VERBOSE(cp) == YES) { + call printf ( + "#Refcoords%12tReference X-center Err") + call printf (" Y-center Err Num\n") + } + firsttime = false + } + + if (VERBOSE(cp) == YES) { + call printf ( + "%20s %9.3f (%0.3f) %9.3f (%.3f) %4d\n") + call pargstr (Memc[refer]) + call pargr (XCENTER(cp,nimages+1,j)) + call pargr (XSIGMA(cp,nimages+1,j)) + call pargr (YCENTER(cp,nimages+1,j)) + call pargr (YSIGMA(cp,nimages+1,j)) + call pargi (j) + } + } + + if (firsttime) { + call eprintf ("Warning: no sources centered in reference\n") + call flush (STDERR) + + } else { + if (VERBOSE(cp) == YES) { + call printf ("\n") + call flush (STDOUT) + } + + call imtrew (imlist) + call ia_stats (cp, imlist) + + if (ncentered > 1) + call ia_trim (cp) + } + } + + } then + error_seen = true + + call ia_free (cp) + + if (shiftlist != NULL) + call ia_close (shiftlist) + if (ref != NULL) + call imunmap (ref) + if (coordlist != NULL) + call ia_close (coordlist) + if (imlist != NULL) + call imtclose (imlist) + + call sfree (sp) + + if (error_seen) + call erract (EA_WARN) +end + + +# IA_INIT -- Initialize the centering structure. + +pointer procedure ia_init (shiftlist, nshifts, coordlist, ncoords) + +pointer shiftlist #I shift "template" pointer +int nshifts #I number of shifts in list (or # images) +pointer coordlist #I coordinate "template" pointer +int ncoords #I number of coordinates in list + +pointer cp +int boxsize, i +real x, y + +int clgeti(), btoi(), ia_get2r() +real clgetr() +bool clgetb() + +errchk ia_get2r + +begin + call calloc (cp, LEN_CP, TY_STRUCT) + + boxsize = clgeti ("boxsize") + if (mod (boxsize, 2) == 0) { + boxsize = boxsize + 1 + call eprintf ("Warning: boxsize must be odd, using %d\n") + call pargi (boxsize) + } + SMALLBOX(cp) = (boxsize - 1) / 2 + + if (shiftlist == NULL) { + boxsize = clgeti ("bigbox") + if (mod (boxsize, 2) == 0) { + boxsize = boxsize + 1 + call eprintf ("Warning: bigbox must be odd, using %d\n") + call pargi (boxsize) + } + BIGBOX(cp) = (boxsize - 1) / 2 + } + + NEGATIVE(cp) = btoi (clgetb ("negative")) + BACKGROUND(cp) = clgetr ("background") + + x = clgetr ("lower") + y = clgetr ("upper") + + if (IS_INDEFR(x) || IS_INDEFR(y)) { + LO_THRESH(cp) = x + HI_THRESH(cp) = y + } else { + LO_THRESH(cp) = min (x, y) + HI_THRESH(cp) = max (x, y) + } + + MAX_TRIES(cp) = max (clgeti ("niterate"), 2) + TOL(cp) = abs (clgeti ("tolerance")) + MAX_SHIFT(cp) = clgetr ("maxshift") + if (IS_INDEFR(MAX_SHIFT(cp))) + MAX_SHIFT(cp) = MAX_REAL + else + MAX_SHIFT(cp) = abs (MAX_SHIFT(cp)) + VERBOSE(cp) = btoi (clgetb ("verbose")) + + IM(cp) = NULL + + NIMAGES(cp) = nshifts + NCOORDS(cp) = ncoords + + call malloc (XINIT_PT(cp), ncoords, TY_REAL) + call malloc (YINIT_PT(cp), ncoords, TY_REAL) + call malloc (XSHIFT_PT(cp), nshifts, TY_REAL) + call malloc (YSHIFT_PT(cp), nshifts, TY_REAL) + call malloc (XSIZE_PT(cp), nshifts+1, TY_REAL) + call malloc (YSIZE_PT(cp), nshifts+1, TY_REAL) + call malloc (XCENTER_PT(cp), (nshifts+1)*ncoords, TY_REAL) + call malloc (YCENTER_PT(cp), (nshifts+1)*ncoords, TY_REAL) + call malloc (XSIGMA_PT(cp), (nshifts+1)*ncoords, TY_REAL) + call malloc (YSIGMA_PT(cp), (nshifts+1)*ncoords, TY_REAL) + call calloc (REJECTED_PT(cp), (nshifts+1)*ncoords, TY_INT) + + for (i=1; ia_get2r (coordlist, x, y) != EOF; i=i+1) { + if (i > ncoords) + call error (1, "problem reading coordinate file") + XINIT(cp,i) = x + YINIT(cp,i) = y + } + + for (i=1; ia_get2r (shiftlist, x, y) != EOF; i=i+1) { + if (i > nshifts) + call error (1, "problem reading shifts file") + XSHIFT(cp,i) = x + YSHIFT(cp,i) = y + } + + return (cp) +end + + +# IA_FREE -- Free the structure pointer. + +procedure ia_free (cp) + +pointer cp #O center structure pointer + +begin + if (cp == NULL) + return + + if (REJECTED_PT(cp) != NULL) + call mfree (REJECTED_PT(cp), TY_INT) + if (XSIGMA_PT(cp) != NULL) + call mfree (XSIGMA_PT(cp), TY_REAL) + if (YSIGMA_PT(cp) != NULL) + call mfree (YSIGMA_PT(cp), TY_REAL) + if (XCENTER_PT(cp) != NULL) + call mfree (XCENTER_PT(cp), TY_REAL) + if (YCENTER_PT(cp) != NULL) + call mfree (YCENTER_PT(cp), TY_REAL) + if (XSIZE_PT(cp) != NULL) + call mfree (XSIZE_PT(cp), TY_REAL) + if (YSIZE_PT(cp) != NULL) + call mfree (YSIZE_PT(cp), TY_REAL) + if (XSHIFT_PT(cp) != NULL) + call mfree (XSHIFT_PT(cp), TY_REAL) + if (YSHIFT_PT(cp) != NULL) + call mfree (YSHIFT_PT(cp), TY_REAL) + if (XINIT_PT(cp) != NULL) + call mfree (XINIT_PT(cp), TY_REAL) + if (YINIT_PT(cp) != NULL) + call mfree (YINIT_PT(cp), TY_REAL) + + call mfree (cp, TY_STRUCT) + cp = NULL # just in case... +end + + +# IA_CENTER -- Compute star center using MPC algorithm. + +int procedure ia_center (cp, xinit, yinit, xcenter, ycenter, xsigma, ysigma) + +pointer cp #I center structure pointer +real xinit, yinit #I initial x and y coordinates +real xcenter, ycenter #O centered x and y coordinates +real xsigma, ysigma #O centering errors + +int x1, x2, y1, y2, nx, ny, try +pointer im, buf, xbuf, ybuf, sp +real xold, yold, xnew, ynew +bool converged + +pointer imgs2r() +real ia_ctr1d() + +errchk imgs2r, ia_threshold, ia_rowsum, ia_colsum, ia_ctr1d + +begin + im = IM(cp) + xold = xinit + yold = yinit + converged = false + + do try = 1, MAX_TRIES(cp) { + x1 = max (nint(xold) - BOXSIZE(cp), 1) + x2 = min (nint(xold) + BOXSIZE(cp), IM_LEN(im,1)) + y1 = max (nint(yold) - BOXSIZE(cp), 1) + y2 = min (nint(yold) + BOXSIZE(cp), IM_LEN(im,2)) + + nx = x2 - x1 + 1 + ny = y2 - y1 + 1 + + # inside the loop in case we're near an edge + call smark (sp) + call salloc (xbuf, nx, TY_REAL) + call salloc (ybuf, ny, TY_REAL) + + iferr { + buf = imgs2r (im, x1, x2, y1, y2) + + call ia_threshold (cp, Memr[buf], nx*ny) + call ia_rowsum (cp, Memr[buf], Memr[xbuf], nx, ny) + call ia_colsum (cp, Memr[buf], Memr[ybuf], nx, ny) + + xnew = x1 + ia_ctr1d (Memr[xbuf], nx, xsigma) + ynew = y1 + ia_ctr1d (Memr[ybuf], ny, ysigma) + } then { + call sfree (sp) + call erract (EA_WARN) + return (ERR) + } + + call sfree (sp) + + if (abs (nint(xnew) - nint(xold)) <= TOL(cp) && + abs (nint(ynew) - nint(yold)) <= TOL(cp)) { + + converged = true + break + } + + xold = xnew + yold = ynew + } + + if (converged) { + xcenter = xnew + ycenter = ynew + return (OK) + } else { + call eprintf ("Warning: failed to converge near (%d,%d)\n") + call pargi (nint (xinit)) + call pargi (nint (yinit)) + call flush (STDERR) + return (ERR) + } +end + + +# IA_THRESHOLD -- Find the low and high thresholds for the subraster. + +procedure ia_threshold (cp, raster, npix) + +pointer cp #I center structure pointer +real raster[ARB] #I 2-D subraster +int npix #I size of the (apparently) 1-D subraster + +real lo, hi, junk + +int awvgr() + +errchk alimr, awvgr + +begin + # use the local data min or max for thresholds that are INDEF. + if (IS_INDEFR(LO_THRESH(cp)) || IS_INDEFR(HI_THRESH(cp))) + call alimr (raster, npix, lo, hi) + if (! IS_INDEFR(LO_THRESH(cp))) + lo = LO_THRESH(cp) + if (! IS_INDEFR(HI_THRESH(cp))) + hi = HI_THRESH(cp) + + if (IS_INDEFR(BACKGROUND(cp))) { + if (awvgr (raster, npix, BACK_LOCAL(cp), junk, lo, hi) <= 0) + call error (1, "no pixels between thresholds") + } else + BACK_LOCAL(cp) = BACKGROUND(cp) + + if (NEGATIVE(cp) == YES) { + LO_LOCAL(cp) = lo + HI_LOCAL(cp) = min (hi, BACK_LOCAL(cp)) + } else { + LO_LOCAL(cp) = max (lo, BACK_LOCAL(cp)) + HI_LOCAL(cp) = hi + } +end + + +# IA_ROWSUM -- Sum all rows in a raster, subject to the thresholds, the +# background, and other parameters. + +procedure ia_rowsum (cp, raster, row, nx, ny) + +pointer cp #I center structure pointer +real raster[nx,ny] #I 2-D subraster +real row[ARB] #O 1-D squashed row vector +int nx, ny #I dimensions of the subraster + +int i, j +real lo, hi, back, pix + +begin + call aclrr (row, nx) + + back = BACK_LOCAL(cp) + lo = LO_LOCAL(cp) + hi = HI_LOCAL(cp) + + do j = 1, ny + do i = 1, nx { + pix = raster[i,j] + if (lo <= pix && pix <= hi) + row[i] = row[i] + pix - back + } + + if (NEGATIVE(cp) == YES) + call adivkr (row, -real(ny), row, nx) + else + call adivkr (row, real(ny), row, nx) + + # recycle lo (and hi) + call alimr (row, nx, lo, hi) + if (lo < 0.) + call error (1, "Negative value in marginal row\n") +end + + +# IA_COLSUM -- Sum all columns in a raster, subject to the thresholds, the +# background, and other parameters. + +procedure ia_colsum (cp, raster, col, nx, ny) + +pointer cp #I center structure pointer +real raster[nx,ny] #I 2-D subraster +real col[ARB] #O 1-D squashed col vector +int nx, ny #I dimensions of the subraster + +int i, j +real lo, hi, back, pix + +begin + call aclrr (col, ny) + + back = BACK_LOCAL(cp) + lo = LO_LOCAL(cp) + hi = HI_LOCAL(cp) + + do j = 1, ny + do i = 1, nx { + pix = raster[i,j] + if (lo <= pix && pix <= hi) + col[j] = col[j] + pix - back + } + + if (NEGATIVE(cp) == YES) + call adivkr (col, -real(nx), col, ny) + else + call adivkr (col, real(nx), col, ny) + + # recycle lo (and hi) + call alimr (col, ny, lo, hi) + if (lo < 0.) + call error (1, "Negative value in marginal column\n") +end + + +# IA_CNTR1D -- Compute the the first moment. + +real procedure ia_ctr1d (a, npix, err) + +real a[ARB] #I marginal vector +int npix #I size of the vector +real err #O error in the centroid + +real centroid, pix, sumi, sumix, sumix2 +int i + +bool fp_equalr() + +begin + sumi = 0. + sumix = 0. + sumix2 = 0. + + do i = 1, npix { + pix = a[i] + sumi = sumi + pix + sumix = sumix + pix * (i-1) + sumix2 = sumix2 + pix * (i-1) ** 2 + } + + if (fp_equalr (sumi, 0.)) + call error (1, "zero marginal vector") + + else { + centroid = sumix / sumi + err = sumix2 / sumi - centroid ** 2 + if (err > 0.) + err = sqrt (err / sumi) + else + err = 0. + } + + return (centroid) +end + + +# IA_OPENP2R -- Open a list file from which two real values per line +# are expected. + +pointer procedure ia_openp2r (param) + +char param[ARB] #I parameter name + +int fd, length +pointer lp, fname, sp +real x1, x2 + +int open(), fscan(), nscan(), strmatch() + +errchk open + +begin + call smark (sp) + call salloc (fname, SZ_FNAME, TY_CHAR) + + call clgstr (param, Memc[fname], SZ_FNAME) + + # Whitespace in the name ? + if (strmatch (Memc[fname], "^#$") != 0) { + call sfree (sp) + return (NULL) + } + + # This should be replaced by some template mechanism. + ifnoerr (fd = open (Memc[fname], READ_ONLY, TEXT_FILE)) { + length = 0 + while (fscan (fd) != EOF) { + call gargr (x1) + call gargr (x2) + + switch (nscan()) { + case 2: + length = length + 1 + case 1: + call error (1, "Reading file, only one value on line") + default: + # read another line + } + } + call seek (fd, BOF) + } else { + fd = NULL + length = 0 + } + + call sfree (sp) + + call malloc (lp, LEN_LP, TY_STRUCT) + LP_FD(lp) = fd + LP_LEN(lp) = length + + return (lp) +end + + +# IA_LEN -- Return the length of a list file, given its descriptor. + +int procedure ia_len (lp) + +pointer lp #I list file descriptor + +begin + if (lp == NULL) + return (0) + else + return (LP_LEN(lp)) +end + + +# IA_GET2R -- Get two real numbers from the next line of the list file. + +int procedure ia_get2r (lp, x1, x2) + +pointer lp #I list file descriptor +real x1, x2 #O values to read + +int fscan(), nscan() + +begin + if (lp == NULL) { + x1 = INDEFR + x2 = INDEFR + return (EOF) + } + + while (fscan (LP_FD(lp)) != EOF) { + call gargr (x1) + call gargr (x2) + + switch (nscan()) { + case 2: + return (2) + case 1: + call error (1, "only one value on line") + default: + # read another line + } + } + + x1 = INDEFR + x2 = INDEFR + return (EOF) +end + + +# IA_CLOSE -- Close a list file descriptor. + +procedure ia_close (lp) + +pointer lp #I list file descriptor + +errchk close + +begin + if (lp == NULL) + return + + if (LP_FD(lp) != NULL) + call close (LP_FD(lp)) + + call mfree (lp, TY_STRUCT) + lp = NULL # just in case... +end + + +# IA_STATS -- Compute the x and y shifts. + +procedure ia_stats (cp, imlist) + +pointer cp #I center structure pointer +pointer imlist #I image template (for labeling) + +real xshift, yshift, xsum, ysum +real xsum2, ysum2, xsig2, ysig2 +real xvar, yvar, xerr, yerr, xprop, yprop +int nim, ncoo, nsources, i, j +pointer img, sp +bool firsttime + +int imtgetim() + +begin + call smark (sp) + call salloc (img, SZ_FNAME, TY_CHAR) + + nim = NIMAGES(cp) + ncoo = NCOORDS(cp) + + firsttime = true + for (i=1; imtgetim (imlist, Memc[img], SZ_FNAME) != EOF; i=i+1) { + xsum = 0. + ysum = 0. + xsum2 = 0. + ysum2 = 0. + xsig2 = 0. + ysig2 = 0. + nsources = 0 + + do j = 1, ncoo { + if (REJECTED(cp,i,j) == YES || REJECTED(cp,nim+1,j) == YES) + next + + xshift = XCENTER(cp,nim+1,j) - XCENTER(cp,i,j) + yshift = YCENTER(cp,nim+1,j) - YCENTER(cp,i,j) + + xsum = xsum + xshift + ysum = ysum + yshift + + # internal errors + xsum2 = xsum2 + xshift*xshift + ysum2 = ysum2 + yshift*yshift + + xsig2 = xsig2 + XSIGMA(cp,nim+1,j)**2 + XSIGMA(cp,i,j)**2 + ysig2 = ysig2 + YSIGMA(cp,nim+1,j)**2 + YSIGMA(cp,i,j)**2 + + nsources = nsources + 1 + } + + if (nsources == 0) { + XSHIFT(cp,i) = INDEFR + YSHIFT(cp,i) = INDEFR + next + } + + XSHIFT(cp,i) = xsum / nsources + YSHIFT(cp,i) = ysum / nsources + + if (nsources > 1) { + xvar = (nsources*xsum2 - xsum*xsum) / (nsources * (nsources-1)) + yvar = (nsources*ysum2 - ysum*ysum) / (nsources * (nsources-1)) + xerr = sqrt (max (xvar/nsources, 0.)) + yerr = sqrt (max (yvar/nsources, 0.)) + } else { + xerr = INDEFR + yerr = INDEFR + } + + xprop = sqrt (max (xsig2, 0.)) / nsources + yprop = sqrt (max (ysig2, 0.)) / nsources + + if (firsttime) { + call printf ("#Shifts%16tImage X-shift Err ") + call printf ("Y-shift Err N Internal\n") + firsttime = false + } + + call printf ( + "%20s %8.3f (%.3f) %8.3f (%.3f) %4d (%.3f,%.3f)\n") + call pargstr (Memc[img]) + call pargr (XSHIFT(cp,i)) + call pargr (xprop) + call pargr (YSHIFT(cp,i)) + call pargr (yprop) + call pargi (nsources) + call pargr (xerr) + call pargr (yerr) + } + + call flush (STDOUT) + call sfree (sp) +end + + +# IA_TRIM -- Compute the trim section. + +procedure ia_trim (cp) + +pointer cp #I center structure pointer + +real xlo, xhi, ylo, yhi, xmin, ymin +int ixlo, ixhi, iylo, iyhi, ixlonew, ixhinew, iylonew, iyhinew, i +int vxlo, vxhi, vylo, vyhi # vignetted versions +bool firsttime + +begin + firsttime = true + do i = 1, NIMAGES(cp) { + + if (IS_INDEFR(XSHIFT(cp,i)) || IS_INDEFR(YSHIFT(cp,i))) + next + + # Compute limits. + xlo = 1. + XSHIFT(cp,i) + ylo = 1. + YSHIFT(cp,i) + xhi = XSIZE(cp,i) + XSHIFT(cp,i) + yhi = YSIZE(cp,i) + YSHIFT(cp,i) + + ixlonew = int (xlo) + if (xlo > ixlonew) # round up + ixlonew = ixlonew + 1 + + ixhinew = int (xhi) + if (xhi < ixhinew) # round down + ixhinew = ixhinew - 1 + + iylonew = int (ylo) # round up + if (ylo > iylonew) + iylonew = iylonew + 1 + + iyhinew = int (yhi) # round down + if (yhi < iyhinew) + iyhinew = iyhinew - 1 + + if (firsttime) { + ixlo = ixlonew + ixhi = ixhinew + iylo = iylonew + iyhi = iyhinew + + xmin = XSIZE(cp,i) + ymin = YSIZE(cp,i) + + firsttime = false + } else { + ixlo = max (ixlo, ixlonew) + ixhi = min (ixhi, ixhinew) + iylo = max (iylo, iylonew) + iyhi = min (iyhi, iyhinew) + + xmin = min (XSIZE(cp,i), xmin) + ymin = min (YSIZE(cp,i), ymin) + } + } + + # Don't bother to complain. + if (firsttime) + return + + call printf ("\n") + + # Vignetting is possible downstream since imshift and other tasks + # preserve the size of the input image. + + vxlo = max (1, min (ixlo, int(xmin))) + vxhi = max (1, min (ixhi, int(xmin))) + vylo = max (1, min (iylo, int(ymin))) + vyhi = max (1, min (iyhi, int(ymin))) + if (vxlo != ixlo || vxhi != ixhi || vylo != iylo || vyhi != iyhi) { + call eprintf ("#Vignette_Section = [%d:%d,%d:%d]\n") + call pargi (vxlo) + call pargi (vxhi) + call pargi (vylo) + call pargi (vyhi) + } + + # Output the trim section. + call printf ("#Trim_Section = [%d:%d,%d:%d]\n") + call pargi (ixlo) + call pargi (ixhi) + call pargi (iylo) + call pargi (iyhi) + + call flush (STDOUT) +end diff --git a/pkg/images/immatch/src/listmatch/t_xyxymatch.x b/pkg/images/immatch/src/listmatch/t_xyxymatch.x new file mode 100644 index 00000000..1c8a16c5 --- /dev/null +++ b/pkg/images/immatch/src/listmatch/t_xyxymatch.x @@ -0,0 +1,406 @@ +include <fset.h> +include "../../../lib/xyxymatch.h" + +# T_XYXYMATCH -- This task computes the intersection of a set of +# of coordinate lists with a reference coordinate list. The output is +# the set of objects common to both lists. In its simplest form LINXYMATCH +# uses a matching tolerance to generate the common list. Alternatively +# XYXYMATCH can use coordinate transformation information derived from the +# positions of one to three stars common to both lists, a sorting algorithm, +# and a matching tolerance to generate the common list. A more sophisticated +# pattern matching algorithm is also available which requires no coordinate +# transformation input from the user but is expensive computationally. + +procedure t_xyxymatch() + +bool interactive, verbose +int ilist, rlist, olist, rfd, rpfd, ifd, ofd +int xcol, ycol, xrefcol, yrefcol, maxntriangles, nreftie, nintie +int ntie, match, nrefstars, nliststars, ninter, nrmaxtri, nreftri +int ninmaxtri, nintri, ntrefstars, ntliststars, nreject +pointer sp, inname, refname, outname, refpoints, str, xreftie, yreftie +pointer xintie, yintie, coeff, xref, yref, rlineno, rsindex, reftri, reftrirat +pointer xlist, ylist, listindex, ilineno, xtrans, ytrans, intri, intrirat +pointer xformat, yformat +real tolerance, separation, xin, yin, xmag, ymag, xrot, yrot, xout, yout +real ratio + +bool clgetb() +int clpopnu(), clplen(), clgeti(), clgfil(), open(), clgwrd() +int rg_getreftie(), rg_lincoeff(), fstati(), rg_rdxyi(), rg_sort() +int rg_intersection(), rg_factorial(), rg_triangle(), rg_match() +int rg_mlincoeff() +real clgetr() + +begin + if (fstati (STDOUT, F_REDIR) == NO) + call fseti (STDOUT, F_FLUSHNL, YES) + + # Allocate working space. + call smark (sp) + call salloc (inname, SZ_FNAME, TY_CHAR) + call salloc (refname, SZ_FNAME, TY_CHAR) + call salloc (outname, SZ_FNAME, TY_CHAR) + call salloc (refpoints, SZ_FNAME, TY_CHAR) + call salloc (xreftie, MAX_NTIE, TY_REAL) + call salloc (yreftie, MAX_NTIE, TY_REAL) + call salloc (xintie, MAX_NTIE, TY_REAL) + call salloc (yintie, MAX_NTIE, TY_REAL) + call salloc (coeff, MAX_NCOEFF, TY_REAL) + call salloc (xformat, SZ_FNAME, TY_CHAR) + call salloc (yformat, SZ_FNAME, TY_CHAR) + call salloc (str, SZ_FNAME, TY_CHAR) + + # Get the input, output, and reference lists. + ilist = clpopnu ("input") + rlist = clpopnu ("reference") + olist = clpopnu ("output") + tolerance = clgetr ("tolerance") + call clgstr ("refpoints", Memc[refpoints], SZ_FNAME) + + # Check the input and output file lengths. + if (clplen (rlist) > 1 && clplen (rlist) != clplen (ilist)) + call error (0, + "The number of input and reference lists are not the same") + if (clplen (ilist) != clplen (olist)) + call error (0, + "The number of input and output lists are not the same") + + xcol = clgeti ("xcolumn") + ycol = clgeti ("ycolumn") + xrefcol = clgeti ("xrcolumn") + yrefcol = clgeti ("yrcolumn") + + # Get the matching parameters. + match = clgwrd ("matching", Memc[str], SZ_LINE, RG_MATCHSTR) + xin = clgetr ("xin") + if (IS_INDEFR(xin)) + xin = 0.0 + yin = clgetr ("yin") + if (IS_INDEFR(yin)) + yin = 0.0 + xmag = clgetr ("xmag") + if (IS_INDEFR(xmag)) + xmag = 1.0 + ymag = clgetr ("ymag") + if (IS_INDEFR(ymag)) + ymag = 1.0 + xrot = clgetr ("xrotation") + if (IS_INDEFR(xrot)) + xrot = 0.0 + yrot = clgetr ("yrotation") + if (IS_INDEFR(yrot)) + yrot = 0.0 + xout = clgetr ("xref") + if (IS_INDEFR(xout)) + xout = 0.0 + yout = clgetr ("yref") + if (IS_INDEFR(yout)) + yout = 0.0 + + # Get the algorithm parameters. + separation = clgetr ("separation") + maxntriangles = clgeti ("nmatch") + ratio = clgetr ("ratio") + nreject = clgeti ("nreject") + + # Get the output formatting parameters. + call clgstr ("xformat", Memc[xformat], SZ_FNAME) + call clgstr ("yformat", Memc[yformat], SZ_FNAME) + + interactive = clgetb ("interactive") + verbose = clgetb ("verbose") + + # Open the reference list file if any. + rfd = NULL + if (Memc[refpoints] == EOS) + rpfd = NULL + else + rpfd = open (Memc[refpoints], READ_ONLY, TEXT_FILE) + + # Initialize. + xref = NULL + yref = NULL + rsindex = NULL + rlineno = NULL + + # Loop over the input lists. + while (clgfil (ilist, Memc[inname], SZ_FNAME) != EOF && + clgfil (olist, Memc[outname], SZ_FNAME) != EOF) { + + # Open the input list. + ifd = open (Memc[inname], READ_ONLY, TEXT_FILE) + + # Open the output list. + ofd = open (Memc[outname], NEW_FILE, TEXT_FILE) + + # Open the reference list and get the coordinates. + while (clgfil (rlist, Memc[refname], SZ_FNAME) != EOF) { + + # Open the reference file. + if (rfd != NULL) + call close (rfd) + rfd = open (Memc[refname], READ_ONLY, TEXT_FILE) + + # Fetch the reference tie points. + if (interactive || rpfd != NULL) + nreftie = rg_getreftie (rpfd, Memr[xreftie], + Memr[yreftie], 3, RG_REFFILE, interactive) + else + nreftie = 0 + + # Read the reference data. + if (xref != NULL) + call mfree (xref, TY_REAL) + if (yref != NULL) + call mfree (yref, TY_REAL) + if (rlineno != NULL) + call mfree (rlineno, TY_INT) + if (rsindex != NULL) + call mfree (rsindex, TY_INT) + ntrefstars = rg_rdxyi (rfd, xref, yref, rlineno, xrefcol, + yrefcol) + call malloc (rsindex, ntrefstars, TY_INT) + + # Prepare the reference list for the merge algorithm. If a tie + # point matching algorithm is selected, sort the list in the + # y and then the x coordinate and remove coincident points. + # If the pattern matching algorithm is used then construct the + # triangles used for matching and sort them in order of + # increasing ratio. + + nrefstars = rg_sort (Memr[xref], Memr[yref], Memi[rsindex], + ntrefstars, separation, YES, YES) + if (match != RG_TRIANGLES) { + reftri = NULL + reftrirat = NULL + nreftri = nrefstars + } else if (nrefstars > 2) { + nrmaxtri = rg_factorial (min (nrefstars, maxntriangles), 3) + call calloc (reftri, SZ_TRIINDEX * nrmaxtri, TY_INT) + call calloc (reftrirat, SZ_TRIPAR * nrmaxtri, TY_REAL) + nreftri = rg_triangle (Memr[xref], Memr[yref], + Memi[rsindex], nrefstars, Memi[reftri], + Memr[reftrirat], nrmaxtri, maxntriangles, + tolerance, ratio) + } else { + nreftri = 0 + reftri = NULL + reftrirat = NULL + } + + break + } + + # Fetch the input tie points and compute the coefficients. + if (interactive || rpfd != NULL) + nintie = rg_getreftie (rpfd, Memr[xintie], + Memr[yintie], nreftie, RG_INFILE, interactive) + else + nintie = 0 + ntie = min (nreftie, nintie) + if (ntie <= 0) + call rg_lmkcoeff (xin, yin, xmag, ymag, xrot, yrot, + xout, yout, Memr[coeff], MAX_NCOEFF) + else if (rg_lincoeff (Memr[xreftie], Memr[yreftie], + Memr[xintie], Memr[yintie], ntie, Memr[coeff], + MAX_NCOEFF) == ERR) + call rg_lmkcoeff (xin, yin, xmag, ymag, xrot, yrot, + xout, yout, Memr[coeff], MAX_NCOEFF) + + # Print the header. + if (verbose) { + call printf ("\nInput: %s Reference: %s ") + call pargstr (Memc[inname]) + call pargstr (Memc[refname]) + call printf ("Number of tie points: %d\n") + call pargi (ntie) + } + call fprintf (ofd, "\n# Input: %s Reference: %s ") + call pargstr (Memc[inname]) + call pargstr (Memc[refname]) + call fprintf (ofd, "Number of tie points: %d\n") + call pargi (ntie) + + # Print the coordinate transformation information. + if (verbose) + call rg_plincoeff ("xref", "yref", Memr[xreftie], + Memr[yreftie], Memr[xintie], Memr[yintie], ntie, + Memr[coeff], MAX_NCOEFF) + call rg_wlincoeff (ofd, "xref", "yref", Memr[xreftie], + Memr[yreftie], Memr[xintie], Memr[yintie], ntie, + Memr[coeff], MAX_NCOEFF) + + # Read in the input list. + xtrans = NULL + ytrans = NULL + listindex = NULL + ntliststars = rg_rdxyi (ifd, xlist, ylist, ilineno, xcol, ycol) + + # Compute the intersection of the two lists using either an + # algorithm depending on common tie points or on a more + # sophisticated pattern matching algorithm. + + if (ntrefstars <= 0) { + if (verbose) + call printf (" The reference coordinate list is empty\n") + ninter = 0 + } else if (ntliststars <= 0) { + if (verbose) + call printf (" The input coordinate list is empty\n") + ninter = 0 + } else if (nreftri <= 0) { + if (verbose) + call printf ( + " No valid reference triangles can be defined\n") + } else { + call malloc (xtrans, ntliststars, TY_REAL) + call malloc (ytrans, ntliststars, TY_REAL) + call malloc (listindex, ntliststars, TY_INT) + call rg_compute (Memr[xlist], Memr[ylist], Memr[xtrans], + Memr[ytrans], ntliststars, Memr[coeff], MAX_NCOEFF) + nliststars = rg_sort (Memr[xtrans], Memr[ytrans], + Memi[listindex], ntliststars, separation, YES, YES) + if (match != RG_TRIANGLES) { + intri = NULL + intrirat = NULL + nintri = nliststars + call rg_pxycolumns (ofd) + ninter = rg_intersection (ofd, Memr[xref], Memr[yref], + Memi[rsindex], Memi[rlineno], nrefstars, Memr[xlist], + Memr[ylist], Memr[xtrans], Memr[ytrans], + Memi[listindex], Memi[ilineno], nliststars, tolerance, + Memc[xformat], Memc[yformat]) + } else if (nliststars > 2) { + ninmaxtri = rg_factorial (min (max(nliststars,nrefstars), + maxntriangles), 3) + call calloc (intri, SZ_TRIINDEX * ninmaxtri, TY_INT) + call calloc (intrirat, SZ_TRIPAR * ninmaxtri, TY_REAL) + nintri = rg_triangle (Memr[xtrans], Memr[ytrans], + Memi[listindex], nliststars, Memi[intri], + Memr[intrirat], ninmaxtri, maxntriangles, + tolerance, ratio) + if (nintri <= 0) { + if (verbose) + call printf ( + " No valid input triangles can be defined\n") + } else { + ninter = rg_match (Memr[xref], Memr[yref], nrefstars, + Memr[xtrans], Memr[ytrans], nliststars, + Memi[reftri], Memr[reftrirat], nreftri, nrmaxtri, + ntrefstars, Memi[intri], Memr[intrirat], nintri, + ninmaxtri, ntliststars, tolerance, tolerance, + ratio, nreject) + } + if (nrefstars <= maxntriangles && nliststars <= + maxntriangles) { + call rg_pxycolumns (ofd) + call rg_mwrite (ofd, Memr[xref], Memr[yref], + Memi[rlineno], Memr[xlist], Memr[ylist], + Memi[ilineno], Memi[reftri], nrmaxtri, + Memi[intri], ninmaxtri, ninter, Memc[xformat], + Memc[yformat]) + } else { + if (rg_mlincoeff (Memr[xref], Memr[yref], Memr[xlist], + Memr[ylist], Memi[reftri], nrmaxtri, + Memi[intri], ninmaxtri, ninter, Memr[coeff], + MAX_NCOEFF) == ERR) + call rg_lmkcoeff (xin, yin, xmag, ymag, xrot, yrot, + xout, yout, Memr[coeff], MAX_NCOEFF) + call rg_compute (Memr[xlist], Memr[ylist], + Memr[xtrans], Memr[ytrans], ntliststars, + Memr[coeff], MAX_NCOEFF) + nliststars = rg_sort (Memr[xtrans], Memr[ytrans], + Memi[listindex], ntliststars, separation, + YES, YES) + if (verbose) + call rg_pmlincoeff ("xref", "yref", Memr[coeff], + MAX_NCOEFF) + call rg_wmlincoeff (ofd, "xref", "yref", Memr[coeff], + MAX_NCOEFF) + call rg_pxycolumns (ofd) + ninter = rg_intersection (ofd, Memr[xref], Memr[yref], + Memi[rsindex], Memi[rlineno], nrefstars, + Memr[xlist], Memr[ylist], Memr[xtrans], + Memr[ytrans], Memi[listindex], Memi[ilineno], + nliststars, tolerance, Memc[xformat], Memc[yformat]) + } + } else { + if (verbose) + call printf ( + "\tThe input coordinate list has < 3 stars\n") + intri = NULL + intrirat = NULL + nintri = 0 + ninter = 0 + } + } + + # Print out the number of stars matched in the two lists. + if (verbose) { + call printf ("%d reference coordinates matched\n") + call pargi (ninter) + } + + # Free space used by input list. + call mfree (xlist, TY_REAL) + call mfree (ylist, TY_REAL) + call mfree (ilineno, TY_INT) + call mfree (listindex, TY_INT) + if (xtrans != NULL) + call mfree (xtrans, TY_REAL) + if (ytrans != NULL) + call mfree (ytrans, TY_REAL) + if (intri != NULL) + call mfree (intri, TY_INT) + if (intrirat != NULL) + call mfree (intrirat, TY_REAL) + + # Close the input and output lists. + call close (ifd) + call close (ofd) + } + + # Release the memory used to store the reference list. + call mfree (xref, TY_REAL) + call mfree (yref, TY_REAL) + call mfree (rlineno, TY_INT) + call mfree (rsindex, TY_INT) + if (reftri != NULL) + call mfree (reftri, TY_INT) + if (reftrirat != NULL) + call mfree (reftrirat, TY_REAL) + + # Close the reference file. + if (rfd != NULL) + call close (rfd) + + # Close the reference points file. + if (rpfd != NULL) + call close (rpfd) + + # Close the file lists. + call clpcls (ilist) + call clpcls (rlist) + call clpcls (olist) + + call sfree (sp) +end + + +# RG_PXYCOLUMNS -- Print the column descriptions in the output file. + +procedure rg_pxycolumns (ofd) + +int ofd #I the output file descriptor + +begin + call fprintf (ofd, "# Column definitions\n") + call fprintf (ofd, "# Column 1: X reference coordinate\n") + call fprintf (ofd, "# Column 2: Y reference coordinate\n") + call fprintf (ofd, "# Column 3: X input coordinate\n") + call fprintf (ofd, "# Column 4: Y input coordinate\n") + call fprintf (ofd, "# Column 5: Reference line number\n") + call fprintf (ofd, "# Column 6: Input line number\n") + call fprintf (ofd, "\n") +end diff --git a/pkg/images/immatch/src/mkpkg b/pkg/images/immatch/src/mkpkg new file mode 100644 index 00000000..ec8accec --- /dev/null +++ b/pkg/images/immatch/src/mkpkg @@ -0,0 +1,11 @@ +# Library for the IMMATCH Package. + +libpkg.a: + @geometry + @imcombine + @linmatch + @listmatch + @psfmatch + @wcsmatch + @xregister + ; diff --git a/pkg/images/immatch/src/psfmatch/mkpkg b/pkg/images/immatch/src/psfmatch/mkpkg new file mode 100644 index 00000000..da3951dc --- /dev/null +++ b/pkg/images/immatch/src/psfmatch/mkpkg @@ -0,0 +1,21 @@ +# Make the PSFMATCH task + +$checkout libpkg.a ../../../ +$update libpkg.a +$checkin libpkg.a ../../../ +$exit + +libpkg.a: + rgpbckgrd.x <math.h> <math/gsurfit.h> "psfmatch.h" + rgpcolon.x <imhdr.h> <imset.h> <error.h> "psfmatch.h" + rgpconvolve.x <error.h> <imhdr.h> <imset.h> + rgpisfm.x <imhdr.h> <gset.h> <ctype.h> "psfmatch.h" + rgpfft.x + rgpfilter.x <math.h> + rgppars.x "psfmatch.h" + rgpregions.x <imhdr.h> <fset.h> "psfmatch.h" + rgpsfm.x <imhdr.h> <math/gsurfit.h> "psfmatch.h" + rgpshow.x "psfmatch.h" + rgptools.x "psfmatch.h" + t_psfmatch.x <fset.h> <imhdr.h> "psfmatch.h" + ; diff --git a/pkg/images/immatch/src/psfmatch/psfmatch.h b/pkg/images/immatch/src/psfmatch/psfmatch.h new file mode 100644 index 00000000..c6b7d563 --- /dev/null +++ b/pkg/images/immatch/src/psfmatch/psfmatch.h @@ -0,0 +1,274 @@ +# Header file for PSFMATCH + +define LEN_PSFSTRUCT (45 + 12 * SZ_FNAME + 12) + +# Define the psf fitting structure + +define PM_RC1 Memi[$1] # pointer to first column of region +define PM_RC2 Memi[$1+1] # pointer to last column of region +define PM_RL1 Memi[$1+2] # pointer to first line of region +define PM_RL2 Memi[$1+3] # pointer to last line of region +define PM_RZERO Memi[$1+4] # pointer to zero point of ref regions +define PM_RXSLOPE Memi[$1+5] # pointer to x slopes of ref regions +define PM_RYSLOPE Memi[$1+6] # pointer to y slopes of ref regions +define PM_NREGIONS Memi[$1+7] # total number of regions +define PM_CNREGION Memi[$1+8] # the current region + +define PM_CENTER Memi[$1+9] # the the psf objects +define PM_BACKGRD Memi[$1+10] # type of background subtraction +define PM_BVALUER Memr[P2R($1+11)] # reference background value +define PM_BVALUE Memr[P2R($1+12)] # image background value +define PM_LOREJECT Memr[P2R($1+13)] # low side rejection +define PM_HIREJECT Memr[P2R($1+14)] # high side rejection +define PM_APODIZE Memr[P2R($1+15)] # fraction of region to be apodized + +define PM_CONVOLUTION Memi[$1+16] # the convolution type +define PM_DNX Memi[$1+17] # x dimension of kernel +define PM_DNY Memi[$1+18] # y dimension of kernel +define PM_PNX Memi[$1+19] # x dimension of user kernel +define PM_PNY Memi[$1+20] # y dimension of user kernel +define PM_KNX Memi[$1+21] # x size of kernel +define PM_KNY Memi[$1+22] # x size of kernel + +define PM_POWER Memi[$1+23] # save power spectrum of kernel ? + +define PM_UFLUXRATIO Memr[P2R($1+24)] # the user ref / input flux ratio +define PM_FLUXRATIO Memr[P2R($1+25)] # ref / input flux ratio +define PM_FILTER Memi[$1+26] # background filtering +define PM_SXINNER Memr[P2R($1+27)] # inner radius for cosine bell +define PM_SXOUTER Memr[P2R($1+28)] # outer radius for cosine bell +define PM_SYINNER Memr[P2R($1+29)] # inner radius for cosine bell +define PM_SYOUTER Memr[P2R($1+30)] # outer radius for cosine bell +define PM_RADSYM Memi[$1+31] # radial symmetry in convolution +define PM_THRESHOLD Memr[P2R($1+32)] # threshold in divisor for model + +define PM_NORMFACTOR Memr[P2R($1+34)] # the normalization factor + +#define PM_PRATIO Memr[P2R($1+24)] # power ration threshold +#define PM_XSHIFTS Memi[$1+26] # pointer to x shifts +#define PM_YSHIFTS Memi[$1+27] # pointer to y shifts + +define PM_REFFFT Memi[$1+35] # pointer to reference fft +define PM_IMFFT Memi[$1+36] # pointer to image fft +define PM_FFT Memi[$1+37] # pointer to unfiltered fft +define PM_CONV Memi[$1+38] # pointer to kernel +define PM_ASFFT Memi[$1+39] # pointer to power spectrum +define PM_NXFFT Memi[$1+40] # x dimension of FFT +define PM_NYFFT Memi[$1+41] # y dimension of FFT + +define PM_BSTRING Memc[P2C($1+42)] # background string +define PM_CSTRING Memc[P2C($1+42+SZ_FNAME+1)] # convolution string +define PM_FSTRING Memc[P2C($1+42+2*SZ_FNAME+2)] # convolution string + +define PM_IMAGE Memc[P2C($1+42+4*SZ_FNAME+4)] # input image +define PM_REFIMAGE Memc[P2C($1+42+5*SZ_FNAME+5)] # reference image +define PM_PSFDATA Memc[P2C($1+42+6*SZ_FNAME+6)] # psf data +define PM_PSFIMAGE Memc[P2C($1+42+7*SZ_FNAME+7)] # psf image if any +define PM_OBJLIST Memc[P2C($1+42+8*SZ_FNAME+8)] # object list if any +define PM_KERNEL Memc[P2C($1+42+9*SZ_FNAME+9)] # kernel image +define PM_OUTIMAGE Memc[P2C($1+42+10*SZ_FNAME+10)] # output convolved image + +# Define the paramerter ids + +define RC1 1 +define RC2 2 +define RL1 3 +define RL2 4 +define RZERO 5 +define RXSLOPE 6 +define RYSLOPE 7 +define NREGIONS 8 +define CNREGION 9 + +define CENTER 10 +define BACKGRD 11 +define BVALUER 12 +define BVALUE 13 +define LOREJECT 15 +define HIREJECT 16 +define APODIZE 17 + +define CONVOLUTION 18 +define DNX 19 +define DNY 20 +define PNX 21 +define PNY 22 +define KNX 23 +define KNY 24 +define POWER 25 + +#define XSHIFTS 20 +#define YSHIFTS 21 + +define REFFFT 26 +define IMFFT 27 +define FFT 28 +define CONV 29 +define ASFFT 30 +define NXFFT 31 +define NYFFT 32 + +define UFLUXRATIO 33 +define FLUXRATIO 34 +define FILTER 35 +define SXINNER 36 +define SXOUTER 37 +define SYINNER 38 +define SYOUTER 39 +define RADSYM 40 +define THRESHOLD 41 + +define NORMFACTOR 43 + +#define PRATIO 34 + +define BSTRING 44 +define CSTRING 45 +define FSTRING 46 + +define REFIMAGE 48 +define IMAGE 49 +define PSFDATA 50 +define PSFIMAGE 51 +define OBJLIST 52 +define KERNEL 53 +define OUTIMAGE 54 + +# Define the default parameter values + +define DEF_CENTER YES +define DEF_BACKGRD PM_BMEDIAN +define DEF_LOREJECT INDEFR +define DEF_HIREJECT INDEFR + +define DEF_CONVOLUTION PM_CONIMAGE +define DEF_DNX 63 +define DEF_DNY 63 +define DEF_PNX 31 +define DEF_PNY 31 +define DEF_POWER NO + +define DEF_FILTER PM_FREPLACE +define DEF_SXINNER INDEFR +define DEF_SXOUTER INDEFR +define DEF_SYINNER INDEFR +define DEF_SYOUTER INDEFR +define DEF_RADSYM NO +define DEF_THRESHOLD 0.0 + +#define DEF_PRATIO 0.0 + +define DEF_NORMFACTOR 1.0 +define DEF_UFLUXRATIO INDEFR + +# Define the background fitting techniques + +define PM_BNONE 1 +define PM_BMEAN 2 +define PM_BMEDIAN 3 +define PM_BSLOPE 4 +define PM_BNUMBER 5 + +define PM_BTYPES "|none|mean|median|plane|" + +# Define the convolution computation options + +define PM_CONIMAGE 1 +define PM_CONPSF 2 +define PM_CONKERNEL 3 + +define PM_CTYPES "|image|psf|kernel|" + +# Define the filtering options + +define PM_FNONE 1 +define PM_FCOSBELL 2 +define PM_FREPLACE 3 +define PM_FMODEL 4 + +define PM_FTYPES "|none|cosbell|replace|model|" + +# Define the normalization options + +define PM_UNIT 1 +define PM_RATIO 2 +define PM_NUMBER 3 + +define PM_NTYPES "|unit|ratio|" + +# Miscellaneous + +define MAX_NREGIONS 100 + +# Commands + +define PMCMDS "|input|reference|psfdata|psfimage|kernel|output|dnx|dny|\ +pnx|pny|center|background|loreject|hireject|apodize|convolution|fluxratio|\ +filter|sx1|sx2|sy1|sy2|radsym|threshold|normfactor|show|mark|" + +define PMCMD_IMAGE 1 +define PMCMD_REFIMAGE 2 +define PMCMD_PSFDATA 3 +define PMCMD_PSFIMAGE 4 +define PMCMD_KERNEL 5 +define PMCMD_OUTIMAGE 6 + +define PMCMD_DNX 7 +define PMCMD_DNY 8 +define PMCMD_PNX 9 +define PMCMD_PNY 10 + +define PMCMD_CENTER 11 +define PMCMD_BACKGRD 12 +define PMCMD_LOREJECT 13 +define PMCMD_HIREJECT 14 +define PMCMD_APODIZE 15 + +define PMCMD_CONVOLUTION 16 +define PMCMD_UFLUXRATIO 17 +define PMCMD_FILTER 18 +define PMCMD_SXINNER 19 +define PMCMD_SXOUTER 20 +define PMCMD_SYINNER 21 +define PMCMD_SYOUTER 22 +define PMCMD_RADSYM 23 +define PMCMD_THRESHOLD 24 + +define PMCMD_NORMFACTOR 25 + +define PMCMD_SHOW 26 +define PMCMD_MARK 27 + +# Keywords + +define KY_IMAGE "input" +define KY_REFIMAGE "reference" +define KY_PSFDATA "psfdata" +define KY_PSFIMAGE "psfimage" +define KY_KERNEL "kernel" +define KY_OUTIMAGE "output" + +define KY_DNX "dnx" +define KY_DNY "dny" +define KY_PNX "pnx" +define KY_PNY "pny" + +define KY_CENTER "center" +define KY_BACKGRD "background" +define KY_LOREJECT "loreject" +define KY_HIREJECT "hireject" +define KY_APODIZE "apodize" + +define KY_CONVOLUTION "convolution" + +define KY_UFLUXRATIO "fluxratio" +define KY_FILTER "filter" +define KY_SXINNER "sx1" +define KY_SXOUTER "sx2" +define KY_SYINNER "sy1" +define KY_SYOUTER "sy2" +define KY_RADSYM "radsym" +define KY_THRESHOLD "threshold" + +define KY_NORMFACTOR "normfactor" + diff --git a/pkg/images/immatch/src/psfmatch/psfmatch.key b/pkg/images/immatch/src/psfmatch/psfmatch.key new file mode 100644 index 00000000..57ef3b2e --- /dev/null +++ b/pkg/images/immatch/src/psfmatch/psfmatch.key @@ -0,0 +1,50 @@ + Interactive Keystroke Commands + + +? Print help +: Colon commands +k Draw a contour plot of the psf matching kernel +p Draw a contour plot of the psf matching kernel power spectrum +x Draw a column plot of the psf matching kernel / power spectrum +y Draw a line plot of the psf matching kernel / power spectrum +r Redraw the current plot +f Recompute the psf matching kernel +w Update the task parameters +q Exit + + + Colon Commands + + +:mark [file] Mark objects on the display +:show Show current values of the parameters + + + Show/Set Parameters + +:input [string] Show/set the current input image name +:reference [string] Show/set the current reference image/psf name +:psf [file/string] Show/set the objects/input psf list +:psfimage [string] Show/set the current input psf name +:kernel [string] Show/set the current psf matching kernel name +:output [string] Show/set the current output image name + +:dnx [value] Show/set x width of data region(s) to extract +:dny [value] Show/set y width of data region(s) to extract +:pnx [value] Show/set x width of psf matching kernel +:pny [value] Show/set y width of psf matching kernel +:center [yes/no] Show/set the centering switch +:background [string] Show/set the background fitting function +:loreject [value] Show/set low side k-sigma rejection parameter +:hireject [value] Show/set high side k-sigma rejection parameter +:apodize [value] Show/set percent of endpoints to apodize + +:filter [string] Show/set the filtering algorithm +:fluxratio [value] Show/set the reference/input psf flux ratio +:sx1 [value] Show/set inner x frequency for cosbell filter +:sx2 [value] Show/set outer x frequency for cosbell filter +:sy1 [value] Show/set inner y frequency for cosbell filter +:sy2 [value] Show/set outer y frequency for cosbell filter +:radsym [yes/no] Show/set radial symmetry for cosbell filter +:threshold [value] Show/set %threshold for replace/modeling filter +:normfactor [value] Show/set the kernel normalization factor diff --git a/pkg/images/immatch/src/psfmatch/rgpbckgrd.x b/pkg/images/immatch/src/psfmatch/rgpbckgrd.x new file mode 100644 index 00000000..1670b943 --- /dev/null +++ b/pkg/images/immatch/src/psfmatch/rgpbckgrd.x @@ -0,0 +1,70 @@ +include <math.h> +include <math/gsurfit.h> +include "psfmatch.h" + +# RG_PSCALE -- Compute the background offset and x and y slope. + +procedure rg_pscale (pm, data, npts, nx, ny, pnx, pny, offset, coeff) + +pointer pm #I pointer to the psfmatch structure +real data[ARB] #I the input data +int npts #I the number of points +int nx, ny #I the dimensions of the original subraster +int pnx, pny #I the dimensions of the data region +real offset #I the input offset +real coeff[ARB] #O the output coefficients + +int wxborder, wyborder +pointer gs +real loreject, hireject, zero +int rg_pstati(), rg_znsum(), rg_znmedian(), rg_slope() +real rg_pstatr() + +begin + loreject = rg_pstatr (pm, LOREJECT) + hireject = rg_pstatr (pm, HIREJECT) + + switch (rg_pstati (pm, BACKGRD)) { + case PM_BNONE: + coeff[1] = 0.0 + coeff[2] = 0.0 + coeff[3] = 0.0 + case PM_BNUMBER: + coeff[1] = offset + coeff[2] = 0.0 + coeff[3] = 0.0 + case PM_BMEAN: + if (rg_znsum (data, npts, zero, loreject, hireject) <= 0) + zero = 0.0 + coeff[1] = zero + coeff[2] = 0.0 + coeff[3] = 0.0 + case PM_BMEDIAN: + if (rg_znmedian (data, npts, zero, loreject, hireject) <= 0) + zero = 0.0 + coeff[1] = zero + coeff[2] = 0.0 + coeff[3] = 0.0 + case PM_BSLOPE: + call gsinit (gs, GS_POLYNOMIAL, 2, 2, GS_XNONE, 1.0, real (nx), 1.0, + real (ny)) + wxborder = (nx - pnx) / 2 + wyborder = (ny - pny) / 2 + if (rg_slope (gs, data, npts, nx, ny, wxborder, wyborder, loreject, + hireject) == ERR) { + coeff[1] = 0.0 + coeff[2] = 0.0 + coeff[3] = 0.0 + } else { + call gssave (gs, coeff) + coeff[1] = coeff[GS_SAVECOEFF+1] + coeff[2] = coeff[GS_SAVECOEFF+2] + coeff[3] = coeff[GS_SAVECOEFF+3] + } + call gsfree (gs) + default: + coeff[1] = 0.0 + coeff[2] = 0.0 + coeff[3] = 0.0 + } +end diff --git a/pkg/images/immatch/src/psfmatch/rgpcolon.x b/pkg/images/immatch/src/psfmatch/rgpcolon.x new file mode 100644 index 00000000..8eefb22d --- /dev/null +++ b/pkg/images/immatch/src/psfmatch/rgpcolon.x @@ -0,0 +1,501 @@ +include <imhdr.h> +include <imset.h> +include <error.h> +include "psfmatch.h" + +# RG_PCOLON -- Show/set the psfmatch task algorithm parameters. + +procedure rg_pcolon (gd, pm, imr, reglist, impsf, im1, imk, imfourier, im2, + cmdstr, newref, newdata, newfourier, newfilter) + +pointer gd #I pointer to the graphics stream +pointer pm #I pointer to psfmatch structure +pointer imr #I pointer to the reference image +int reglist #I the regions / psf list descriptor +pointer impsf #I pointer to the regions list +pointer im1 #I pointer to the input image +pointer imk #I pointer to kernel image +pointer imfourier #I pointer to fourier spectrum image +pointer im2 #I pointer to the output image +char cmdstr[ARB] #I command string +int newref #I/O new reference image +int newdata #I/O new input image +int newfourier #I/O new FFT +int newfilter #I/O new filter + +bool bval +int ncmd, ival, stat, fd, ip +pointer sp, cmd, str +real rval +bool itob() +bool streq() +int strdic(), nscan(), rg_pstati(), btoi(), rg_pregions(), fntopnb() +int access(), rg_pmkregions(), open(), ctor() +pointer immap() +real rg_pstatr() +errchk immap(), fntopnb() + +begin + call smark (sp) + call salloc (cmd, SZ_LINE, TY_CHAR) + call salloc (str, SZ_LINE, TY_CHAR) + + # Get the command. + call sscan (cmdstr) + call gargwrd (Memc[cmd], SZ_LINE) + if (Memc[cmd] == EOS) { + call sfree (sp) + return + } + + # Process the command. + ncmd = strdic (Memc[cmd], Memc[cmd], SZ_LINE, PMCMDS) + switch (ncmd) { + case PMCMD_REFIMAGE: + call gargwrd (Memc[cmd], SZ_LINE) + call rg_pstats (pm, REFIMAGE, Memc[str], SZ_FNAME) + if (imr == NULL || Memc[cmd] == EOS || streq (Memc[cmd], + Memc[str])) { + call printf ("%s: %s\n") + call pargstr (KY_REFIMAGE) + call pargstr (Memc[str]) + } else { + if (imr != NULL) { + call imunmap (imr) + imr = NULL + } + iferr { + imr = immap (Memc[cmd], READ_ONLY, 0) + } then { + call erract (EA_WARN) + imr = immap (Memc[str], READ_ONLY, 0) + } else if (IM_NDIM(imr) > 2 || IM_NDIM(imr) != IM_NDIM(im1)) { + call printf ( + "Reference image has the wrong number of dimensions\n") + call imunmap (imr) + imr = immap (Memc[str], READ_ONLY, 0) + } else { + call rg_psets (pm, REFIMAGE, Memc[cmd]) + newref = YES; newdata = YES + newfourier = YES; newfilter = YES + } + } + + case PMCMD_IMAGE: + + call gargwrd (Memc[cmd], SZ_LINE) + call rg_pstats (pm, IMAGE, Memc[str], SZ_FNAME) + if (Memc[cmd] == EOS || streq (Memc[cmd], Memc[str])) { + call printf ("%s: %s\n") + call pargstr (KY_IMAGE) + call pargstr (Memc[str]) + } else { + if (im1 != NULL) { + call imunmap (im1) + im1 = NULL + } + iferr { + im1 = immap (Memc[cmd], READ_ONLY, 0) + call imseti (im1, IM_TYBNDRY, BT_NEAREST) + if (IM_NDIM(im1) == 1) + call imseti (im1, IM_NBNDRYPIX, IM_LEN(im1,1)) + else + call imseti (im1, IM_NBNDRYPIX, + max (IM_LEN(im1,1), IM_LEN(im1,2))) + } then { + call erract (EA_WARN) + im1 = immap (Memc[str], READ_ONLY, 0) + call imseti (im1, IM_TYBNDRY, BT_NEAREST) + if (IM_NDIM(im1) == 1) + call imseti (im1, IM_NBNDRYPIX, IM_LEN(im1,1)) + else + call imseti (im1, IM_NBNDRYPIX, + max (IM_LEN(im1,1), IM_LEN(im1,2))) + } else if (IM_NDIM(im1) > 2 || IM_NDIM(im1) != IM_NDIM(imr)) { + call printf ( + "Reference image has the wrong number of dimensions\n") + call imunmap (im1) + im1 = immap (Memc[str], READ_ONLY, 0) + call imseti (im1, IM_TYBNDRY, BT_NEAREST) + if (IM_NDIM(im1) == 1) + call imseti (im1, IM_NBNDRYPIX, IM_LEN(im1,1)) + else + call imseti (im1, IM_NBNDRYPIX, + max (IM_LEN(im1,1), IM_LEN(im1,2))) + } else { + call rg_psets (pm, IMAGE, Memc[cmd]) + newdata = YES; newref = YES + newfourier = YES; newfilter = YES + } + } + + case PMCMD_PSFDATA: + + call gargwrd (Memc[cmd], SZ_LINE) + call rg_pstats (pm, PSFDATA, Memc[str], SZ_FNAME) + if (reglist == NULL || nscan() == 1 || (streq (Memc[cmd], + Memc[str]) && Memc[cmd] != EOS)) { + call printf ("%s [string/file]: %s\n") + call pargstr (KY_PSFDATA) + call pargstr (Memc[str]) + } else if (rg_pstati(pm, CONVOLUTION) == PM_CONIMAGE) { + call fntclsb (reglist) + iferr { + reglist = fntopnb (Memc[cmd], NO) + } then { + reglist = fntopnb (Memc[str], NO) + } else { + if (rg_pregions (reglist, imr, pm, 1, NO) > 0) + ; + call rg_psets (pm, PSFDATA, Memc[cmd]) + newdata = YES; newref = YES + newfourier = YES; newfilter = YES + } + } + + case PMCMD_PSFIMAGE: + call gargwrd (Memc[cmd], SZ_LINE) + call rg_pstats (pm, PSFIMAGE, Memc[str], SZ_FNAME) + if (impsf == NULL || Memc[cmd] == EOS || streq (Memc[cmd], + Memc[str])) { + call printf ("%s: %s\n") + call pargstr (KY_PSFIMAGE) + call pargstr (Memc[str]) + } else { + if (impsf != NULL) { + call imunmap (impsf) + impsf = NULL + } + iferr { + impsf = immap (Memc[cmd], READ_ONLY, 0) + } then { + call erract (EA_WARN) + impsf = immap (Memc[str], READ_ONLY, 0) + } else if (IM_NDIM(impsf) > 2 || IM_NDIM(impsf) != + IM_NDIM(imr)) { + call printf ( + "PSF image has the wrong number of dimensions\n") + call imunmap (impsf) + impsf = immap (Memc[str], READ_ONLY, 0) + } else { + call rg_psets (pm, PSFIMAGE, Memc[cmd]) + newref = YES; newdata = YES + newfourier = YES; newfilter = YES + } + } + + case PMCMD_KERNEL: + call gargwrd (Memc[cmd], SZ_LINE) + call rg_pstats (pm, KERNEL, Memc[str], SZ_FNAME) + if (Memc[cmd] == EOS || streq (Memc[cmd], Memc[str])) { + call printf ("%s: %s\n") + call pargstr (KY_KERNEL) + call pargstr (Memc[str]) + } else { + if (imk != NULL) { + call imunmap (imk) + call imdelete (Memc[str]) + imk = NULL + } + iferr { + imk = immap (Memc[cmd], NEW_IMAGE, 0) + } then { + call erract (EA_WARN) + imk = NULL + call rg_psets (pm, KERNEL, "") + } else + call rg_psets (pm, KERNEL, Memc[cmd]) + } + + + case PMCMD_OUTIMAGE: + call gargwrd (Memc[cmd], SZ_LINE) + call rg_pstats (pm, OUTIMAGE, Memc[str], SZ_FNAME) + if (im2 == NULL || Memc[cmd] == EOS || streq (Memc[cmd], + Memc[str])) { + call printf ("%s: %s\n") + call pargstr (KY_OUTIMAGE) + call pargstr (Memc[str]) + } else { + if (im2 != NULL) { + call imunmap (im2) + im2 = NULL + } + iferr { + im2 = immap (Memc[cmd], NEW_COPY, im1) + } then { + call erract (EA_WARN) + im2 = immap (Memc[str], NEW_COPY, im1) + } else { + call rg_psets (pm, OUTIMAGE, Memc[cmd]) + } + } + + case PMCMD_DNX: + call gargi (ival) + if (nscan() == 1) { + call printf ("%s = %g\n") + call pargstr (KY_DNX) + call pargi (rg_pstati (pm, DNX)) + } else { + if (mod (ival, 2) == 0) + ival = ival + 1 + call rg_pseti (pm, DNX, ival) + newref = YES; newdata = YES; newfourier = YES; newfilter = YES + } + + case PMCMD_DNY: + call gargi (ival) + if (nscan() == 1) { + call printf ("%s = %g\n") + call pargstr (KY_DNY) + call pargi (rg_pstati (pm, DNY)) + } else { + if (mod (ival, 2) == 0) + ival = ival + 1 + call rg_pseti (pm, DNY, ival) + newref = YES; newdata = YES; newfourier = YES; newfilter = YES + } + + case PMCMD_PNX: + call gargi (ival) + if (nscan() == 1) { + call printf ("%s = %g\n") + call pargstr (KY_PNX) + call pargi (rg_pstati (pm, PNX)) + } else { + if (mod (ival, 2) == 0) + ival = ival + 1 + call rg_pseti (pm, PNX, min (ival, rg_pstati (pm, DNX))) + newref = YES; newdata = YES; newfourier = YES; newfilter = YES + } + + case PMCMD_PNY: + call gargi (ival) + if (nscan() == 1) { + call printf ("%s = %g\n") + call pargstr (KY_PNY) + call pargi (rg_pstati (pm, PNY)) + } else { + if (mod (ival, 2) == 0) + ival = ival + 1 + call rg_pseti (pm, PNY, min (ival, rg_pstati(pm, DNY))) + newref = YES; newdata = YES; newfourier = YES; newfilter = YES + } + + case PMCMD_CENTER: + call gargb (bval) + if (nscan() == 1) { + call printf ("%s = %b\n") + call pargstr (KY_CENTER) + call pargb (itob (rg_pstati (pm, CENTER))) + } else { + call rg_pseti (pm, CENTER, btoi (bval)) + newfourier = YES; newfilter = YES + } + + case PMCMD_BACKGRD: + call gargwrd (Memc[cmd], SZ_LINE) + if (Memc[cmd] == EOS) { + call rg_pstats (pm, BSTRING, Memc[str], SZ_FNAME) + call printf ("%s: %s\n") + call pargstr (KY_BACKGRD) + call pargstr (Memc[str]) + } else { + stat = strdic (Memc[cmd], Memc[cmd], SZ_LINE, PM_BTYPES) + ip = 1 + if (stat > 0) { + call rg_pseti (pm, BACKGRD, stat) + call rg_psets (pm, BSTRING, Memc[cmd]) + newfourier = YES; newfilter = YES + } else if (ctor (str, ip, rval) > 0) { + call rg_psetr (pm, BVALUE, rval) + if (ctor (str, ip, rval) > 0) { + call rg_psetr (pm, BVALUER, rval) + call strcpy (str, PM_BSTRING(pm), SZ_FNAME) + call rg_pseti (pm, BACKGRD, PM_NUMBER) + } else { + call rg_psetr (pm, BVALUE, 0.0) + call rg_psetr (pm, BVALUER, 0.0) + } + } + } + + case PMCMD_LOREJECT: + call gargr (rval) + if (nscan() == 1) { + call printf ("%s = %g\n") + call pargstr (KY_LOREJECT) + call pargr (rg_pstatr (pm, LOREJECT)) + } else { + call rg_psetr (pm, LOREJECT, rval) + newfourier = YES; newfilter = YES + } + + case PMCMD_HIREJECT: + call gargr (rval) + if (nscan() == 1) { + call printf ("%s = %g\n") + call pargstr (KY_HIREJECT) + call pargr (rg_pstatr (pm, HIREJECT)) + } else { + call rg_psetr (pm, HIREJECT, rval) + newfourier = YES; newfilter = YES + } + + case PMCMD_APODIZE: + call gargr (rval) + if (nscan() == 1) { + call printf ("%s = %g\n") + call pargstr (KY_APODIZE) + call pargr (rg_pstatr (pm, APODIZE)) + } else { + call rg_psetr (pm, APODIZE, rval) + newfourier = YES; newfilter = YES + } + + case PMCMD_CONVOLUTION: + if (Memc[cmd] == EOS) { + call rg_pstats (pm, CSTRING, Memc[str], SZ_LINE) + call printf ("%s: %s\n") + call pargstr (KY_CONVOLUTION) + call pargstr (Memc[str]) + } + + case PMCMD_UFLUXRATIO: + call gargr (rval) + if (nscan() == 1) { + call printf ("%s = %g\n") + call pargstr (KY_UFLUXRATIO) + call pargr (rg_pstatr (pm, UFLUXRATIO)) + } else { + call rg_psetr (pm, UFLUXRATIO, rval) + newfourier = YES; newfilter = YES + } + + case PMCMD_FILTER: + call gargwrd (Memc[cmd], SZ_LINE) + if (Memc[cmd] == EOS) { + call rg_pstats (pm, FSTRING, Memc[str], SZ_LINE) + call printf ("%s: %s\n") + call pargstr (KY_FILTER) + call pargstr (Memc[str]) + } else { + stat = strdic (Memc[cmd], Memc[cmd], SZ_LINE, PM_FTYPES) + if (stat > 0) { + call rg_pseti (pm, FILTER, stat) + call rg_psets (pm, FSTRING, Memc[cmd]) + } + newfilter = YES + } + + case PMCMD_SXINNER: + call gargr (rval) + if (nscan() == 1) { + call printf ("%s = %g\n") + call pargstr (KY_SXINNER) + call pargr (rg_pstatr (pm, SXINNER)) + } else { + call rg_psetr (pm, SXINNER, rval) + newfilter = YES + } + + case PMCMD_SXOUTER: + call gargr (rval) + if (nscan() == 1) { + call printf ("%s = %g\n") + call pargstr (KY_SXOUTER) + call pargr (rg_pstatr (pm, SXOUTER)) + } else { + call rg_psetr (pm, SXOUTER, rval) + newfilter = YES + } + + case PMCMD_SYINNER: + call gargr (rval) + if (nscan() == 1) { + call printf ("%s = %g\n") + call pargstr (KY_SYINNER) + call pargr (rg_pstatr (pm, SYINNER)) + } else { + call rg_psetr (pm, SYINNER, rval) + newfilter = YES + } + + case PMCMD_SYOUTER: + call gargr (rval) + if (nscan() == 1) { + call printf ("%s = %g\n") + call pargstr (KY_SYOUTER) + call pargr (rg_pstatr (pm, SYOUTER)) + } else { + call rg_psetr (pm, SYOUTER, rval) + newfilter = YES + } + + case PMCMD_RADSYM: + call gargb (bval) + if (nscan() == 1) { + call printf ("%s = %b\n") + call pargstr (KY_RADSYM) + call pargb (itob (rg_pstati (pm, RADSYM))) + } else { + call rg_pseti (pm, RADSYM, btoi (bval)) + newfilter = YES + } + + case PMCMD_THRESHOLD: + call gargr (rval) + if (nscan() == 1) { + call printf ("%s = %g\n") + call pargstr (KY_THRESHOLD) + call pargr (rg_pstatr (pm, THRESHOLD)) + } else { + call rg_psetr (pm, THRESHOLD, rval) + newfilter = YES + } + + case PMCMD_NORMFACTOR: + call gargr (rval) + if (nscan() == 1) { + call printf ("%s = %g\n") + call pargstr (KY_NORMFACTOR) + call pargr (rg_pstatr (pm, NORMFACTOR)) + } else { + call rg_psetr (pm, NORMFACTOR, rval) + newfilter = YES + } + + case PMCMD_SHOW: + call gdeactivate (gd, 0) + call rg_pshow (pm) + call greactivate (gd, 0) + + case PMCMD_MARK: + call gdeactivate (gd, 0) + call gargwrd (Memc[cmd], SZ_LINE) + if (Memc[cmd] == EOS) { + fd = NULL + } else if (access (Memc[cmd], 0, 0) == YES) { + call printf ("Warning: file %s already exists\n") + call pargstr (Memc[cmd]) + fd = NULL + } else { + fd = open (Memc[cmd], NEW_FILE, TEXT_FILE) + } + call printf ("\n") + if (rg_pmkregions (fd, imr, pm, 1, MAX_NREGIONS) <= 0) + call printf ("The regions list is empty\n") + newdata = YES; newref = YES + newfourier = YES; newfilter = YES + call printf ("\n") + if (fd != NULL) + call close (fd) + call greactivate (gd, 0) + + default: + call printf ("Unknown or ambiguous colon command\7\n") + } + + call sfree (sp) +end diff --git a/pkg/images/immatch/src/psfmatch/rgpconvolve.x b/pkg/images/immatch/src/psfmatch/rgpconvolve.x new file mode 100644 index 00000000..6b516a95 --- /dev/null +++ b/pkg/images/immatch/src/psfmatch/rgpconvolve.x @@ -0,0 +1,106 @@ +include <error.h> +include <imhdr.h> +include <imset.h> + +# RG_PCONVOLVE -- Convolve an image with an nxk by nyk kernel. The kernel +# dimensions are assumed to be odd. + +procedure rg_pconvolve (im1, im2, kernel, nxk, nyk, boundary, constant) + +pointer im1 # pointer to the input image +pointer im2 # pointer to the output image +real kernel[nxk,nyk] # the convolution kernel +int nxk, nyk # dimensions of the kernel +int boundary # type of boundary extension +real constant # constant for constant boundary extension + +int i, ncols, nlines, col1, col2, nincols, inline, outline +pointer sp, lineptrs, linebuf, outbuf, nkern +pointer imgs2r(), impl2r() +errchk imgs2r, impl2r + +begin + # Set up an array of line pointers. + call smark (sp) + call salloc (lineptrs, nyk, TY_POINTER) + call salloc (nkern, nxk * nyk, TY_REAL) + + # Set the number of image buffers. + call imseti (im1, IM_NBUFS, nyk) + + # Set the input image boundary conditions. + call imseti (im1, IM_TYBNDRY, boundary) + call imseti (im1, IM_NBNDRYPIX, max (nxk / 2 + 1, nyk / 2 + 1)) + if (boundary == BT_CONSTANT) + call imsetr (im1, IM_BNDRYPIXVAL, constant) + + # Define the number of output image lines and columns. + ncols = IM_LEN(im2,1) + if (IM_NDIM(im2) == 1) + nlines = 1 + else + nlines = IM_LEN(im2,2) + + # Set the input image column limits. + col1 = 1 - nxk / 2 + col2 = IM_LEN(im1,1) + nxk / 2 + nincols = col2 - col1 + 1 + + # Flip the kernel + call rg_pflip (kernel, Memr[nkern], nxk, nyk) + + # Initialise the line buffers. + inline = 1 - nyk / 2 + do i = 1 , nyk - 1 { + Memi[lineptrs+i] = imgs2r (im1, col1, col2, inline, inline) + inline = inline + 1 + } + + # Generate the output image line by line + call salloc (linebuf, nincols, TY_REAL) + do outline = 1, nlines { + + # Scroll the input buffers + do i = 1, nyk - 1 + Memi[lineptrs+i-1] = Memi[lineptrs+i] + + # Read in new image line + Memi[lineptrs+nyk-1] = imgs2r (im1, col1, col2, inline, + inline) + + # Get output image line + outbuf = impl2r (im2, outline) + if (outbuf == EOF) + call error (0, "Error writing output image.") + + # Generate output image line + call aclrr (Memr[outbuf], ncols) + do i = 1, nyk + call acnvr (Memr[Memi[lineptrs+i-1]], Memr[outbuf], ncols, + Memr[nkern+(i-1)*nxk], nxk) + + inline = inline + 1 + } + + # Free the image buffer pointers + call sfree (sp) +end + + +# RG_PFLIP -- Flip the kernel in preparation for convolution. + +procedure rg_pflip (inkern, outkern, nxk, nyk) + +real inkern[nxk,nyk] # the input kernel +real outkern[nxk,nyk] # the output kernel +int nxk, nyk # the kernel dimensions + +int i, j + +begin + do j = 1, nyk { + do i = 1, nxk { + outkern[i,j] = inkern[nxk+1-i,nyk+1-j] + } + } +end diff --git a/pkg/images/immatch/src/psfmatch/rgpfft.x b/pkg/images/immatch/src/psfmatch/rgpfft.x new file mode 100644 index 00000000..b5f36375 --- /dev/null +++ b/pkg/images/immatch/src/psfmatch/rgpfft.x @@ -0,0 +1,443 @@ + +# RG_PG10F -- Fetch the 0 component of the fft. + +real procedure rg_pg10f (fft, nxfft, nyfft) + +real fft[nxfft,nyfft] #I array containing 2 real ffts +int nxfft #I x dimension of complex array +int nyfft #I y dimension of complex array + +int xcen, ycen + +begin + xcen = nxfft / 2 + 1 + ycen = nyfft / 2 + 1 + + return (fft[xcen,ycen]) +end + + +# RG_PG1NORM -- Estimate the normalization factor by computing the amplitude +# of the best fitting Gaussian. This routine may eventually be replaced by +# on which does a complete Gaussian fit. The Gaussian is assumed to be +# of the form g = a * exp (b * r * r). The input array is a 2D real array +# storing 1 fft of dimension nxfft by nyfft in complex order with the +# zero frequency in the center. + +real procedure rg_pg1norm (fft, nxfft, nyfft) + +real fft[nxfft,nyfft] #I array containing 2 real ffts +int nxfft #I x dimension of complex array +int nyfft #I y dimension of complex array + +int xcen, ycen +real ln1, ln2, cx, cy + +begin + xcen = nxfft / 2 + 1 + ycen = nyfft / 2 + 1 + + if (nxfft >= 8) { + ln1 = log (sqrt (fft[xcen-2,ycen] ** 2 + fft[xcen-1,ycen] ** 2)) + ln2 = log (sqrt (fft[xcen-4,ycen] ** 2 + fft[xcen-3,ycen] ** 2)) + cx = exp ((4.0 * ln1 - ln2) / 3.0) + } else + cx = 0.0 + + if (nyfft >= 4) { + ln1 = log (sqrt (fft[xcen,ycen-1] ** 2 + fft[xcen+1,ycen-1] ** 2)) + ln2 = log (sqrt (fft[xcen,ycen-2] ** 2 + fft[xcen+1,ycen-2] ** 2)) + cy = exp ((4.0 * ln1 - ln2) / 3.0) + } else + cy = 0.0 + + if (cx <= 0.0) + return (cy) + else if (cy <= 0.0) + return (cx) + else + return (0.5 * (cx + cy)) +end + + +# RG_PG20F -- Fetch the 0 component of the fft. + +real procedure rg_pg20f (fft, nxfft, nyfft) + +real fft[nxfft,nyfft] #I array containing 2 real ffts +int nxfft #I x dimension of complex array +int nyfft #I y dimension of complex array + +int xcen, ycen + +begin + xcen = nxfft / 2 + 1 + ycen = nyfft / 2 + 1 + + return (fft[xcen,ycen] / fft[xcen+1,ycen]) +end + + +# RG_PG2NORM -- Estimate the normalization factor by computing the amplitude +# of the best fitting Gaussian. This routine may eventually be replaced by +# on which does a complete Gaussian fit. The Gaussian is assumed to be +# of the form g = a * exp (b * r * r). The input array is a 2D real array +# storing 2 2D ffts of dimension nxfft by nyfft in complex order with the +# zero frequency in the center. + +real procedure rg_pg2norm (fft, nxfft, nyfft) + +real fft[nxfft,nyfft] #I array containing 2 real ffts +int nxfft #I x dimension of complex array +int nyfft #I y dimension of complex array + +int xcen, ycen +real fftr, ffti, ln1r, ln2r, ln1i, ln2i, cxr, cyr, cxi, cyi, ampr, ampi + +begin + + xcen = nxfft / 2 + 1 + ycen = nyfft / 2 + 1 + + # Compute the x amplitude for the first fft. + if (nxfft >= 8) { + + fftr = 0.5 * (fft[xcen+2,ycen] + fft[xcen-2,ycen]) + ffti = 0.5 * (fft[xcen+3,ycen] - fft[xcen-1,ycen]) + ln1r = log (sqrt (fftr ** 2 + ffti ** 2)) + fftr = 0.5 * (fft[xcen+4,ycen] + fft[xcen-4,ycen]) + ffti = 0.5 * (fft[xcen+5,ycen] - fft[xcen-3,ycen]) + ln2r = log (sqrt (fftr ** 2 + ffti ** 2)) + + fftr = 0.5 * (fft[xcen+3,ycen] + fft[xcen-1,ycen]) + ffti = -0.5 * (fft[xcen+2,ycen] - fft[xcen-2,ycen]) + ln1i = log (sqrt (fftr ** 2 + ffti ** 2)) + fftr = 0.5 * (fft[xcen+5,ycen] + fft[xcen-3,ycen]) + ffti = -0.5 * (fft[xcen+4,ycen] - fft[xcen-4,ycen]) + ln2i = log (sqrt (fftr ** 2 + ffti ** 2)) + + cxr = exp ((4.0 * ln1r - ln2r) / 3.0) + cxi = exp ((4.0 * ln1i - ln2i) / 3.0) + + } else { + + cxr = 0.0 + cxi = 0.0 + + } + + # Compute the y ratio. + if (nyfft >= 4) { + + fftr = 0.5 * (fft[xcen,ycen+1] + fft[xcen,ycen-1]) + ffti = 0.5 * (fft[xcen+1,ycen+1] - fft[xcen+1,ycen-1]) + ln1r = log (sqrt (fftr ** 2 + ffti ** 2)) + fftr = 0.5 * (fft[xcen,ycen+2] + fft[xcen,ycen-2]) + ffti = 0.5 * (fft[xcen+1,ycen+2] - fft[xcen+1,ycen-2]) + ln2r = log (sqrt (fftr ** 2 + ffti ** 2)) + + fftr = 0.5 * (fft[xcen+1,ycen+1] + fft[xcen+1,ycen-1]) + ffti = -0.5 * (fft[xcen,ycen+1] - fft[xcen,ycen-1]) + ln1i = log (sqrt (fftr ** 2 + ffti ** 2)) + fftr = 0.5 * (fft[xcen+1,ycen+2] + fft[xcen+1,ycen-2]) + ffti = -0.5 * (fft[xcen,ycen+2] - fft[xcen,ycen-2]) + ln2i = log (sqrt (fftr ** 2 + ffti ** 2)) + + cyr = exp ((4.0 * ln1r - ln2r) / 3.0) + cyi = exp ((4.0 * ln1i - ln2i) / 3.0) + + } else { + + cyr = 0.0 + cyi = 0.0 + + } + + if (cxr <= 0.0) + ampr = cyr + else if (cyr <= 0.0) + ampr = cxr + else + ampr = 0.5 * (cxr + cyr) + + if (cxi <= 0.0) + ampi = cyi + else if (cyi <= 0.0) + ampi = cxi + else + ampi = 0.5 * (cxi + cyi) + + if (ampi <= 0.0) + return (INDEFR) + else + return (ampr /ampi) +end + + +# RG_PDIVFFT -- Unpack the two fft's, save the first fft, and compute the +# quotient of the two ffts. + +procedure rg_pdivfft (fft1, fftnum, fftdenom, fft2, nxfft, nyfft) + +real fft1[nxfft,nyfft] # array containing 2 ffts of 2 real functions +real fftnum[nxfft,nyfft] # the numerator fft +real fftdenom[nxfft,nyfft] # the denominator fft +real fft2[nxfft,nyfft] # fft of psf matching function +int nxfft, nyfft # dimensions of fft + +int i, j, xcen, ycen, nxp2, nxp3, nyp2 +real c1, c2, h1r, h1i, h2r, h2i, denom + +begin + c1 = 0.5 + c2 = -0.5 + xcen = nxfft / 2 + 1 + ycen = nyfft / 2 + 1 + nxp2 = nxfft + 2 + nxp3 = nxfft + 3 + nyp2 = nyfft + 2 + + # Compute the 0 frequency point. + h1r = fft1[xcen,ycen] + h1i = 0.0 + h2r = fft1[xcen+1,ycen] + h2i = 0.0 + fftnum[xcen,ycen] = h1r + fftnum[xcen+1,ycen] = 0.0 + fftdenom[xcen,ycen] = h2r + fftdenom[xcen+1,ycen] = 0.0 + fft2[xcen,ycen] = h1r / h2r + fft2[xcen+1,ycen] = 0.0 + + #call eprintf ("fft11=%g fft21=%g\n") + #call pargr (fft1[1,1]) + #call pargr (fft1[2,1]) + + # Compute the first point. + h1r = c1 * (fft1[1,1] + fft1[1,1]) + h1i = 0.0 + h2r = -c2 * (fft1[2,1] + fft1[2,1]) + h2i = 0.0 + + fftnum[1,1] = h1r + fftnum[2,1] = h1i + fftdenom[1,1] = h2r + fftdenom[2,1] = h2i + denom = h2r * h2r + h2i * h2i + if (denom == 0.0) { + fft2[1,1] = 1.0 + fft2[2,1] = 0.0 + } else { + fft2[1,1] = (h1r * h2r + h1i * h2i) / denom + fft2[2,1] = (h1i * h2r - h2i * h1r) / denom + } + + # Compute the x symmetry axis points. + do i = 3, xcen - 1, 2 { + + h1r = c1 * (fft1[i,ycen] + fft1[nxp2-i,ycen]) + h1i = c1 * (fft1[i+1,ycen] - fft1[nxp3-i,ycen]) + h2r = -c2 * (fft1[i+1,ycen] + fft1[nxp3-i,ycen]) + h2i = c2 * (fft1[i,ycen] - fft1[nxp2-i,ycen]) + + fftnum[i,ycen] = h1r + fftnum[i+1,ycen] = h1i + fftnum[nxp2-i,ycen] = h1r + fftnum[nxp3-i,ycen] = -h1i + + fftdenom[i,ycen] = h2r + fftdenom[i+1,ycen] = h2i + fftdenom[nxp2-i,ycen] = h2r + fftdenom[nxp3-i,ycen] = -h2i + + denom = h2r * h2r + h2i * h2i + if (denom == 0.0) { + fft2[i,ycen] = 1.0 + fft2[i+1,ycen] = 0.0 + } else { + fft2[i,ycen] = (h1r * h2r + h1i * h2i) / denom + fft2[i+1,ycen] = (h1i * h2r - h2i * h1r) / denom + } + fft2[nxp2-i,ycen] = fft2[i,ycen] + fft2[nxp3-i,ycen] = -fft2[i+1,ycen] + + } + + # Quit if the transform is 1D. + if (nyfft < 2) + return + + # Compute the x axis points. + do i = 3, xcen + 1, 2 { + + h1r = c1 * (fft1[i,1] + fft1[nxp2-i,1]) + h1i = c1 * (fft1[i+1,1] - fft1[nxp3-i,1]) + h2r = -c2 * (fft1[i+1,1] + fft1[nxp3-i,1]) + h2i = c2 * (fft1[i,1] - fft1[nxp2-i,1]) + + fftnum[i,1] = h1r + fftnum[i+1,1] = h1i + fftnum[nxp2-i,1] = h1r + fftnum[nxp3-i,1] = -h1i + + fftdenom[i,1] = h2r + fftdenom[i+1,1] = h2i + fftdenom[nxp2-i,1] = h2r + fftdenom[nxp3-i,1] = -h2i + + denom = h2r * h2r + h2i * h2i + if (denom == 0) { + fft2[i,1] = 1.0 + fft2[i+1,1] = 0.0 + } else { + fft2[i,1] = (h1r * h2r + h1i * h2i) / denom + fft2[i+1,1] = (h1i * h2r - h2i * h1r) / denom + } + fft2[nxp2-i,1] = fft2[i,1] + fft2[nxp3-i,1] = -fft2[i+1,1] + } + + # Compute the y symmetry axis points. + do i = 2, ycen - 1 { + + h1r = c1 * (fft1[xcen,i] + fft1[xcen, nyp2-i]) + h1i = c1 * (fft1[xcen+1,i] - fft1[xcen+1,nyp2-i]) + h2r = -c2 * (fft1[xcen+1,i] + fft1[xcen+1,nyp2-i]) + h2i = c2 * (fft1[xcen,i] - fft1[xcen,nyp2-i]) + + fftnum[xcen,i] = h1r + fftnum[xcen+1,i] = h1i + fftnum[xcen,nyp2-i] = h1r + fftnum[xcen+1,nyp2-i] = -h1i + + fftdenom[xcen,i] = h2r + fftdenom[xcen+1,i] = h2i + fftdenom[xcen,nyp2-i] = h2r + fftdenom[xcen+1,nyp2-i] = -h2i + + denom = h2r * h2r + h2i * h2i + if (denom == 0.0) { + fft2[xcen,i] = 1.0 + fft2[xcen+1,i] = 0.0 + } else { + fft2[xcen,i] = (h1r * h2r + h1i * h2i) / denom + fft2[xcen+1,i] = (h1i * h2r - h2i * h1r) / denom + } + fft2[xcen,nyp2-i] = fft2[xcen,i] + fft2[xcen+1,nyp2-i] = -fft2[xcen+1,i] + + } + + # Compute the y axis points. + do i = 2, ycen { + + h1r = c1 * (fft1[1,i] + fft1[1,nyp2-i]) + h1i = c1 * (fft1[2,i] - fft1[2,nyp2-i]) + h2r = -c2 * (fft1[2,i] + fft1[2,nyp2-i]) + h2i = c2 * (fft1[1,i] - fft1[1,nyp2-i]) + + fftnum[1,i] = h1r + fftnum[2,i] = h1i + fftnum[1,nyp2-i] = h1r + fftnum[2,nyp2-i] = -h1i + + fftdenom[1,i] = h2r + fftdenom[2,i] = h2i + fftdenom[1,nyp2-i] = h2r + fftdenom[2,nyp2-i] = -h2i + + denom = h2r * h2r + h2i * h2i + if (denom == 0.0) { + fft2[1,i] = 1.0 + fft2[2,i] = 0.0 + } else { + fft2[1,i] = (h1r * h2r + h1i * h2i) / denom + fft2[2,i] = (h1i * h2r - h2i * h1r) / denom + } + fft2[1,nyp2-i] = fft2[1,i] + fft2[2,nyp2-i] = -fft2[2,i] + } + + # Compute the remainder of the transform. + do j = 2, ycen - 1 { + + do i = 3, xcen - 1, 2 { + + h1r = c1 * (fft1[i,j] + fft1[nxp2-i, nyp2-j]) + h1i = c1 * (fft1[i+1,j] - fft1[nxp3-i,nyp2-j]) + h2r = -c2 * (fft1[i+1,j] + fft1[nxp3-i,nyp2-j]) + h2i = c2 * (fft1[i,j] - fft1[nxp2-i,nyp2-j]) + + fftnum[i,j] = h1r + fftnum[i+1,j] = h1i + fftnum[nxp2-i,nyp2-j] = h1r + fftnum[nxp3-i,nyp2-j] = -h1i + + fftdenom[i,j] = h2r + fftdenom[i+1,j] = h2i + fftdenom[nxp2-i,nyp2-j] = h2r + fftdenom[nxp3-i,nyp2-j] = -h2i + + denom = h2r * h2r + h2i * h2i + if (denom == 0.0) { + fft2[i,j] = 1.0 + fft2[i+1,j] = 0.0 + } else { + fft2[i,j] = (h1r * h2r + h1i * h2i) / denom + fft2[i+1,j] = (h1i * h2r - h2i * h1r) / denom + } + fft2[nxp2-i,nyp2-j] = fft2[i,j] + fft2[nxp3-i,nyp2-j] = - fft2[i+1,j] + } + + do i = xcen + 2, nxfft, 2 { + + h1r = c1 * (fft1[i,j] + fft1[nxp2-i, nyp2-j]) + h1i = c1 * (fft1[i+1,j] - fft1[nxp3-i,nyp2-j]) + h2r = -c2 * (fft1[i+1,j] + fft1[nxp3-i,nyp2-j]) + h2i = c2 * (fft1[i,j] - fft1[nxp2-i,nyp2-j]) + + fftnum[i,j] = h1r + fftnum[i+1,j] = h1i + fftnum[nxp2-i,nyp2-j] = h1r + fftnum[nxp3-i,nyp2-j] = -h1i + + fftdenom[i,j] = h2r + fftdenom[i+1,j] = h2i + fftdenom[nxp2-i,nyp2-j] = h2r + fftdenom[nxp3-i,nyp2-j] = -h2i + + denom = h2r * h2r + h2i * h2i + if (denom == 0.0) { + fft2[i,j] = 1.0 + fft2[i+1,j] = 0.0 + } else { + fft2[i,j] = (h1r * h2r + h1i * h2i) / denom + fft2[i+1,j] = (h1i * h2r - h2i * h1r) / denom + } + fft2[nxp2-i,nyp2-j] = fft2[i,j] + fft2[nxp3-i,nyp2-j] = - fft2[i+1,j] + + } + } +end + + +# RG_PNORM -- Insert the normalization value into the 0 frequency of the +# fft. The fft is a 2D fft stored in a real array in complex order. +# The fft is assumed to be centered. + +procedure rg_pnorm (fft, nxfft, nyfft, norm) + +real fft[ARB] #I the input fft +int nxfft #I the x dimension of fft (complex storage) +int nyfft #I the y dimension of the fft +real norm #I the flux ratio + +int index + +begin + index = nxfft + 1 + 2 * (nyfft / 2) * nxfft + fft[index] = norm + fft[index+1] = 0.0 +end diff --git a/pkg/images/immatch/src/psfmatch/rgpfilter.x b/pkg/images/immatch/src/psfmatch/rgpfilter.x new file mode 100644 index 00000000..63040b63 --- /dev/null +++ b/pkg/images/immatch/src/psfmatch/rgpfilter.x @@ -0,0 +1,502 @@ +include <math.h> + +# RG_PCOSBELL -- Apply a cosine bell function to the data. + +procedure rg_pcosbell (fft, nxfft, nyfft, sx1, sx2, sy1, sy2, radsym) + +real fft[ARB] #I/O the ifft to be filtered +int nxfft #I the x dimension of the fft +int nyfft #I the y dimension of the fft +real sx1 #I inner x radius of the cosine bell filter +real sx2 #I outer x radius of the cosine bell filter +real sy1 #I inner y radius of the cosine bell filter +real sy2 #I outer y radius of the cosine bell filter +int radsym #I radial symmetry ? + +int i, j, index, xcen, ycen +real factorx, factory, r1, r2, r, rj, cos2 + +begin + # Compute the center of the fft. + xcen = (nxfft / 2) + 1 + ycen = (nyfft / 2) + 1 + + if (radsym == NO) { + + # Filter in the y direction independently. + if (IS_INDEFR(sy1)) + r1 = 0.0 + else + r1 = sy1 + if (IS_INDEFR(sy2)) + r2 = nyfft - ycen + 1 + else + r2 = sy2 + factory = HALFPI / (r2 - r1) + index = 1 + do j = 1, nyfft { + r = abs (ycen - j) + if (r >= r2) + cos2 = 0.0 + else if (r <= r1) + cos2 = 1.0 + else + cos2 = cos ((r - r1) * factory) ** 2 + call amulkr (fft[index], cos2, fft[index], 2 * nxfft) + index = index + 2 * nxfft + } + + # Filter in the x direction independently. + if (IS_INDEFR(sx1)) + r1 = 0.0 + else + r1 = sx1 + if (IS_INDEFR(sx2)) + r2 = nxfft - xcen + 1 + else + r2 = sx2 + factorx = HALFPI / (r2 - r1) + + do i = 1, nxfft { + r = abs (xcen - i) + if (r >= r2) + cos2 = 0.0 + else if (r <= r1) + cos2 = 1.0 + else + cos2 = cos ((r - r1) * factorx) ** 2 + do j = 2 * i - 1, 2 * nxfft * nyfft, 2 * nxfft { + fft[j] = fft[j] * cos2 + fft[j+1] = fft[j+1] * cos2 + } + } + + } else { + + if (IS_INDEFR(sx1) && IS_INDEFR(sy1)) + r1 = 0.0 + else if (IS_INDEFR(sx1)) + r1 = sy1 + else if (IS_INDEFR(sy1)) + r1 = sx1 + else + r1 = (sx1 + sy1) / 2.0 + if (IS_INDEFR(sx2) && IS_INDEFR(sy2)) + r2 = (nxfft - xcen + 1 + nyfft - ycen + 1) / 2.0 + else if (IS_INDEFR(sx2)) + r2 = sy2 + else if (IS_INDEFR(sy2)) + r2 = sx2 + else + r2 = (sx2 + sy2) / 2.0 + factorx = HALFPI / (r2 - r1) + + index = 0 + do j = 1, nyfft { + rj = (ycen - j) ** 2 + do i = 1, nxfft { + r = sqrt ((i - xcen) ** 2 + rj) + if (r >= r2) { + fft[index+2*i-1] = 0.0 + fft[index+2*i] = 0.0 + } else if (r > r1) { + fft[index+2*i-1] = fft[index+2*i-1] * cos ((r - r1) * + factorx) ** 2 + fft[index+2*i] = fft[index+2*i] * cos ((r - r1) * + factorx) ** 2 + } + } + index = index + 2 * nxfft + } + } +end + + +# RG_PREPLACE -- Replace low valued regions in the kernel fft with a Gaussian +# extension. + +procedure rg_preplace (fft, fftdiv, nxfft, nyfft, pthreshold, norm) + +real fft[ARB] #I/O the fft of the kernel +real fftdiv[ARB] #I the divisor fft +int nxfft #I x dimension of the fft (complex storage) +int nyfft #I y dimension of the fft +real pthreshold #I the minimum percent amplitude in the divisor +real norm #I the normalization value + +pointer sp, params +int xcen, ycen, i, j, ri, rj, index +real divpeak, a1, a2, a3, u, v, divisor, absv, phi + +begin + call smark (sp) + call salloc (params, 5, TY_REAL) + + # Compute the central amplitude peak. + xcen = nxfft / 2 + 1 + ycen = nyfft / 2 + 1 + divpeak = pthreshold * fftdiv[1+nxfft+2*(ycen-1)*nxfft] + + # Fit the parameters. + call rg_pgaussfit (fft, fftdiv, nxfft, nyfft, divpeak, norm, + Memr[params]) + + # Store the parameters in temporary variables. + a1 = Memr[params] + a2 = Memr[params+1] + a3 = Memr[params+2] + u = Memr[params+3] + v = Memr[params+4] + + # Perform the extension. + index = 0 + do j = 1, nyfft { + rj = j - ycen + do i = 1, nxfft { + ri = i - xcen + divisor = sqrt (fftdiv[index+2*i-1] ** 2 + + fftdiv[index+2*i] ** 2) + if (divisor < divpeak) { + absv = norm * exp (a1 * ri * ri + a2 * ri * rj + a3 * + rj * rj) + phi = u * ri + v * rj + fft[index+2*i-1] = absv * cos (phi) + fft[index+2*i] = absv * sin (phi) + } + } + index = index + 2 * nxfft + } + + # Correct the first row. + do i = 1, 2 * nxfft, 2 { + fft[i] = sqrt (fft[i] ** 2 + fft[i+1] ** 2) + fft[i+1] = 0.0 + } + + # Correct the first column. + index = 1 + do j = 2, nyfft { + fft[index] = sqrt (fft[index] ** 2 + fft[index+1] ** 2) + fft[index+1] = 0.0 + index = index + 2 * nxfft + } + + call sfree (sp) +end + + +# RG_PGMODEL -- Replace low values with a Gaussian mode. + +procedure rg_pgmodel (fft, fftdiv, nxfft, nyfft, pthreshold, norm) + +real fft[ARB] #I/O the fft of the kernel +real fftdiv[ARB] #I the divisor fft +int nxfft #I the x dimension of the fft +int nyfft #I the y dimension of the fft +real pthreshold #I the minimum percent amplitude in the divisor +real norm #I the normalization factor + +pointer sp, params +int xcen, ycen, i, j, index +real divpeak, a1, a2, a3, u, v, absv, phi, ri, rj + +begin + call smark (sp) + call salloc (params, 5, TY_REAL) + + # Compute the central amplitude peak. + xcen = nxfft / 2 + 1 + ycen = nyfft / 2 + 1 + divpeak = pthreshold * fftdiv[1+nxfft+2*(ycen-1)*nxfft] + + # Fit the parameters. + call rg_pgaussfit (fft, fftdiv, nxfft, nyfft, divpeak, norm, + Memr[params]) + + # Store the parameters in temporary variables + a1 = Memr[params] + a2 = Memr[params+1] + a3 = Memr[params+2] + u = Memr[params+3] + v = Memr[params+4] + + # Perform the extension. + index = 0 + do j = 1, nyfft { + rj = j - ycen + do i = 1, nxfft { + ri = i - xcen + absv = norm * exp (a1 * ri * ri + a2 * ri * rj + a3 * rj * rj) + phi = u * ri + v * rj + fft[index+2*i-1] = absv * cos (phi) + fft[index+2*i] = absv * sin (phi) + } + index = index + 2 * nxfft + } + + # Correct the first row. + do i = 1, 2 * nxfft, 2 { + fft[i] = sqrt (fft[i] ** 2 + fft[i+1] ** 2) + fft[i+1] = 0.0 + } + + # Correct the first column. + index = 1 + do j = 2, nyfft { + fft[index] = sqrt (fft[index] ** 2 + fft[index+1] ** 2) + fft[index+1] = 0.0 + index = index + 2 * nxfft + } + + call sfree (sp) +end + + +# RG_PGAUSSFIT -- Procedure to compute the Gaussian parameters + +procedure rg_pgaussfit (fft, fftdiv, nxfft, nyfft, divpeak, norm, param) + +real fft[ARB] #I the fft of the kernel +real fftdiv[ARB] #I the divisor fft +int nxfft #I the x dimension of the fft +int nyfft #I the y dimension of the fft +real divpeak #I the minimum value in the divisor +real norm #I the normalization value norm value +real param[ARB] #O the output fitted parameters + +int i, j, yj, xcen, ycen +double x, y, x2, xy, y2, z, wt, x2w, y2w, xyw, zw, xzw, yzw +double sxxxx, sxxxy, sxxyy, sxyyy, syyyy, sxxz, sxyz, syyz, sxx, sxy +double syy, sxz, syz +pointer sp, mat +real divisor + +begin + # Allocate temporary space. + call smark (sp) + call salloc (mat, 12, TY_DOUBLE) + + # Define the center of the fft. + xcen = nxfft / 2 + 1 + ycen = nyfft / 2 + 1 + + # Initialize. + sxxxx = 0.0d0 + sxxxy = 0.0d0 + sxxyy = 0.0d0 + sxyyy = 0.0d0 + syyyy = 0.0d0 + sxxz = 0.0d0 + sxyz = 0.0d0 + syyz = 0.0d0 + sxx = 0.0d0 + sxy = 0.0d0 + syy = 0.0d0 + sxz = 0.0d0 + syz = 0.0d0 + + do i = 1, nxfft { + x = i - xcen + yj = - ycen + do j = 2 * i - 1, 2 * nxfft * nyfft, 2 * nxfft { + yj = yj + 1 + y = yj + + # Skip low points in the fit. + divisor = sqrt (fftdiv[j] ** 2 + fftdiv[j+1] ** 2) + if (divisor < divpeak) + next + if (i == xcen || yj == ycen) + next + + # Accumulate the intermediate products. + divisor = sqrt (fft[j] ** 2 + fft[j+1] ** 2) + if (divisor <= 0.0) + next + z = log (divisor / norm) + x2 = x * x + y2 = y * y + wt = 1.0 / sqrt (x2 + y2) + xy = x * y + x2w = x2 * wt + y2w = y2 * wt + xyw = xy * wt + zw = z * wt + xzw = x * zw + yzw = y * zw + + # Accumulate the sums for the Gaussian. + sxxxx = sxxxx + x2 * x2w + sxxxy = sxxxy + x2 * xyw + sxxyy = sxxyy + x2 * y2w + sxyyy = sxyyy + xy * y2w + syyyy = syyyy + y2 * y2w + sxxz = sxxz + x * xzw + sxyz = sxyz + x * yzw + syyz = syyz + y * yzw + + # New weight and z point. + wt = sqrt (fft[j] ** 2 + fft[j+1] ** 2) / norm + z = atan2 (fft[j+1], fft[j]) + + # Accumulate the sums for the shift determinantion. + sxx = sxx + x2 * wt + sxy = sxy + xy * wt + syy = syy + y2 * wt + sxz = sxz + x * z * wt + syz = syz + y * z * wt + } + } + + # Solve for the gaussian. + Memd[mat] = sxxxx + Memd[mat+1] = sxxxy + Memd[mat+2] = sxxyy + Memd[mat+3] = sxxz + Memd[mat+4] = sxxxy + Memd[mat+5] = sxxyy + Memd[mat+6] = sxyyy + Memd[mat+7] = sxyz + Memd[mat+8] = sxxyy + Memd[mat+9] = sxyyy + Memd[mat+10] = syyyy + Memd[mat+11] = syyz + call rg_pgelim (Memd[mat], 3) + param[1] = Memd[mat+3] + param[2] = Memd[mat+7] + param[3] = Memd[mat+11] + + # Solve for the shift. + Memd[mat] = sxx + Memd[mat+1] = sxy + Memd[mat+2] = sxz + Memd[mat+3] = sxy + Memd[mat+4] = syy + Memd[mat+5] = syz + call rg_pgelim (Memd[mat], 2) + param[4] = Memd[mat+2] + param[5] = Memd[mat+5] + + call sfree (sp) +end + + +# RG_PGELIM -- Solve a matrix using Gaussian elimination. + +procedure rg_pgelim (a, n) + +double a[n+1,n] #I/O matrix to be solved +int n #I number of variables + +int i, j, k +double den, hold + +begin + do k = 1, n { + + den = a[k,k] + if (den == 0.0d0) { # look for non-zero switch + do j = k + 1, n { + if (a[k,k] != 0.0d0) { + do i = k, n + 1 { + hold = a[i,j] + a[i,j] = a[i,k] + a[i,k] = hold + } + den = a[k,k] + } + } + if (den == 0.0d0) # if still zero, skip + next + } + + do i = k, n + 1 + a[i,k] = a[i,k] / den + do j = 1, n { + if (j != k) { + den = a[k,j] + do i = k, n + 1 + a[i,j] = a[i,j] - a[i,k] * den + } + } + } +end + + +# RG_PNORMFILT -- Filter out any values greater than the normalization +# from the kernel fft. + +procedure rg_pnormfilt (fft, nxfft, nyfft, norm) + +real fft[ARB] #I/O the input fft +int nxfft #I the x length of the fft +int nyfft #I the y length of the fft +real norm #I the normalization factor + +int j, i_index + +begin + do j = 1, nyfft { + i_index = 1 + 2 * (j - 1) * nxfft + call rg_pnreplace (fft[i_index], nxfft, norm) + } +end + + +# RG_PFOURIER -- Compute the fourier spectrum of the convolution kernel. + +procedure rg_pfourier (fft, psfft, nxfft, nyfft) + +real fft[ARB] # the input fft +real psfft[ARB] # fourier spectrum of the fft +int nxfft # the x dimension of the fft +int nyfft # the y dimension of the fft + +int j, i_index, o_index + +begin + do j = 1, nyfft { + i_index = 1 + 2 * (j - 1) * nxfft + o_index = 1 + (j - 1) * nxfft + call rg_pvfourier (fft[i_index], psfft[o_index], nxfft) + } +end + + +# RG_PVFOURIER -- Procedure to compute the fourier spectrum of a vector. + +procedure rg_pvfourier (a, b, nxfft) + +real a[ARB] # input vector in complex storage order +real b[ARB] # output vector in real storage order +int nxfft # length of vector + +int i + +begin + do i = 1, nxfft + b[i] = sqrt (a[2*i-1] ** 2 + a[2*i] ** 2) +end + + +# RG_PNREPLACE -- Replace values whose absolute value is greater than the +# flux ratio. + +procedure rg_pnreplace (a, nxfft, norm) + +real a[ARB] #I/O ithe nput vector in complex storage order +int nxfft #I the length of the vector +real norm #I the flux ratio + +int i +real val + +begin + do i = 1, 2 * nxfft, 2 { + val = sqrt (a[i] ** 2 + a[i+1] ** 2) + if (val > norm) { + a[i] = a[i] / val * norm + a[i+1] = a[i+1] / val * norm + } + } +end diff --git a/pkg/images/immatch/src/psfmatch/rgpisfm.x b/pkg/images/immatch/src/psfmatch/rgpisfm.x new file mode 100644 index 00000000..24df8fd7 --- /dev/null +++ b/pkg/images/immatch/src/psfmatch/rgpisfm.x @@ -0,0 +1,556 @@ +include <imhdr.h> +include <ctype.h> +include <gset.h> +include "psfmatch.h" + +define HELPFILE "immatch$src/psfmatch/psfmatch.key" + +# Define the plot functions + +define PM_PPOWER 1 +define PM_PKERNEL 2 + +# Define the plot types + +define PM_PCONTOUR 1 +define PM_PLINE 2 +define PM_PCOL 3 + +# RG_PISFM -- Procedure to compute the shifts interactively. + +int procedure rg_pisfm (pm, imr, reglist, impsf, im1, imk, imp, im2, gd, id) + +pointer pm #I pointer to the psfmatch structure +pointer imr #I/O pointer to the reference image/psf +pointer reglist #I/O pointer to the regions list +pointer impsf #I/O pointer to the input psf +pointer im1 #I/O pointer to the input image +pointer imp #I/O pointer to the fourier spectrum image +pointer imk #I/O pointer to the kernel image +pointer im2 #I/O pointer to the output image +pointer gd #I graphics stream pointer +pointer id #I display stream pointer + +int newref, newimage, newfourier, newfilter, plotfunc, plottype, wcs, key +int newplot, ncolr, nliner, ip +pointer sp, cmd +real wx, wy +int rg_pstati(), rg_psfm(), clgcur(), rg_pgqverify(), rg_pgtverify() +int ctoi(), rg_pregions() +pointer rg_pstatp() + +begin + call smark (sp) + call salloc (cmd, SZ_LINE, TY_CHAR) + + newref = YES + newimage = YES + newfourier = YES + newfilter = YES + ncolr = INDEFI + nliner = INDEFI + plotfunc = PM_PKERNEL + plottype = PM_PCONTOUR + + # Compute the convolution kernel for the current image. + if (rg_pstati (pm, CONVOLUTION) == PM_CONIMAGE && rg_pstati (pm, + NREGIONS) <= 0) { + call gclear (gd) + call gflush (gd) + call printf ("The objects list is empty\n") + } else { + if (rg_psfm (pm, imr, im1, impsf, imk, newref) == OK) { + call rg_pplot (gd, pm, ncolr, nliner, plotfunc, plottype) + newref = NO + newimage = NO + newfourier = NO + newfilter = NO + } else { + call gclear (gd) + call gflush (gd) + call rg_pstats (pm, IMAGE, Memc[cmd], SZ_FNAME) + call printf ("Error computing kernel for image %s\n") + call pargstr (Memc[cmd]) + } + } + newplot = NO + + # Loop over the cursor commands. + while (clgcur ("gcommands", wx, wy, wcs, key, Memc[cmd], SZ_LINE) != + EOF) { + + switch (key) { + + # Print the help page. + case '?': + call gpagefile (gd, HELPFILE, "") + + # Quit the task gracefully. + case 'q': + if (rg_pgqverify ("psfmatch", pm, imk, key) == YES) { + call sfree (sp) + return (rg_pgtverify (key)) + } + + # Process colon commands. + case ':': + for (ip = 1; IS_WHITE(Memc[cmd+ip-1]); ip = ip + 1) + ; + switch (Memc[cmd+ip-1]) { + + case 'x': + if (Memc[cmd+ip] != EOS && Memc[cmd+ip] != ' ') { + call rg_pcolon (gd, pm, imr, reglist, impsf, im1, imk, + NULL, im2, Memc[cmd], newref, newimage, + newfourier, newfilter) + } else { + ip = ip + 1 + if (ctoi (Memc[cmd], ip, ncolr) <= 0) { + switch (plotfunc) { + case PM_PPOWER: + ncolr = rg_pstati (pm, NXFFT) / 2 + 1 + case PM_PKERNEL: + ncolr = rg_pstati (pm, KNX) / 2 + 1 + default: + ncolr = rg_pstati (pm, KNX) / 2 + 1 + } + } + plottype = PM_PCOL + newplot = YES + } + + case 'y': + if (Memc[cmd+ip] != EOS && Memc[cmd+ip] != ' ') { + call rg_pcolon (gd, pm, imr, reglist, impsf, im1, imk, + NULL, im2, Memc[cmd], newref, newimage, + newfourier, newfilter) + } else { + ip = ip + 1 + if (ctoi (Memc[cmd], ip, nliner) <= 0) { + switch (plotfunc) { + case PM_PPOWER: + nliner = rg_pstati (pm, NYFFT) / 2 + 1 + case PM_PKERNEL: + nliner = rg_pstati (pm, KNY) / 2 + 1 + default: + nliner = rg_pstati (pm, KNY) / 2 + 1 + } + } + plottype = PM_PLINE + newplot = YES + } + + + default: + call rg_pcolon (gd, pm, imr, reglist, impsf, im1, imk, NULL, + im2, Memc[cmd], newref, newimage, newfourier, + newfilter) + } + + # Write the parameters to the parameter file. + case 'w': + call rg_pppars (pm) + + # Recompute the convolution kernel function. + case 'f': + + if (rg_pstati(pm,CONVOLUTION) == PM_CONIMAGE) { + if (newref == YES) + if (rg_pregions (reglist, imr, pm, 1, YES) > 0) + ; + else if (newimage == YES) + call rg_pindefr (pm) + } + + if (rg_pstati (pm, NREGIONS) > 0 || rg_pstati (pm, + CONVOLUTION) != PM_CONIMAGE) { + + if (newfourier == YES) { + call printf ( + "\nRecomputing convolution kernel ...\n") + if (rg_psfm (pm, imr, im1, impsf, imk, + newref) == OK) { + ncolr = INDEFI + nliner = INDEFI + call rg_pplot (gd, pm, ncolr, nliner, plotfunc, + plottype) + newref = NO + newimage = NO + newfourier = NO + newfilter = NO + newplot = NO + } else + call printf ( + "\nError computing new kernel ...\n") + } + + if (newfilter == YES) { + if (Memr[rg_pstatp(pm,FFT)] != NULL) { + call rg_pfilter (pm) + ncolr = INDEFI + nliner = INDEFI + call rg_pplot (gd, pm, ncolr, nliner, plotfunc, + plottype) + newfilter = NO + newplot = NO + } else + call printf ( + "The kernel fourier spectrum is undefined\n") + } + + } else + call printf ("The objects list is empty\n") + + # Draw a contour plot of the kernel. + case 'k': + if (plotfunc != PM_PKERNEL) + newplot = YES + if (plottype != PM_PCONTOUR) + newplot = YES + plotfunc = PM_PKERNEL + plottype = PM_PCONTOUR + ncolr = (1 + rg_pstati (pm, KNX)) / 2 + nliner = (1 + rg_pstati (pm, KNY)) / 2 + + # Draw a contour plot of the fourier spectrum. + case 'p': + if (plotfunc != PM_PPOWER) + newplot = YES + if (plottype != PM_PCONTOUR) + newplot = YES + plotfunc = PM_PPOWER + plottype = PM_PCONTOUR + ncolr = (1 + rg_pstati (pm, NXFFT)) / 2 + nliner = (1 + rg_pstati (pm, NYFFT)) / 2 + + # Plot a line of the current plot. + case 'x': + if (plottype != PM_PCOL) + newplot = YES + if (plottype == PM_PCONTOUR) { + ncolr = nint (wx) + nliner = nint (wy) + } else if (plottype == PM_PLINE) { + ncolr = nint (wx) + } + plottype = PM_PCOL + + # Plot a line of the current plot. + case 'y': + if (plottype != PM_PLINE) + newplot = YES + if (plottype == PM_PCONTOUR) { + ncolr = nint (wx) + nliner = nint (wy) + } else if (plottype == PM_PCOL) { + ncolr = nint (wx) + } + plottype = PM_PLINE + + # Redraw the current plot. + case 'r': + newplot = YES + + # Do nothing gracefully. + default: + ; + + } + + if (newplot == YES) { + if (rg_pstati (pm, CONVOLUTION) == PM_CONIMAGE && + rg_pstati (pm, NREGIONS) <= 0) { + call printf ("Warning: The objects list is empty\n") + } else if (newref == YES || newimage == YES || + newfourier == YES || newfilter == YES) { + call printf ( + "Warning: Convolution kernel should be refit\n") + } else if (rg_pstatp (pm, CONV) != NULL) { + call rg_pplot (gd, pm, ncolr, nliner, plotfunc, plottype) + newplot = NO + } else { + call printf ( + "Warning: The convolution kernel is undefined\n") + } + } + + } + + call sfree (sp) +end + + +define QUERY "[Hit return to continue, n next image, q quit, w quit and update parameters]" + +# RG_PGQVERIFY -- Print a message in the status line asking the user if they +# really want to quit, returning YES if they really want to quit, NO otherwise. + +int procedure rg_pgqverify (task, pm, imk, ch) + +char task[ARB] # task name +pointer pm # pointer to psfmatch structure +pointer imk # pointer to kernel image +int ch # character keystroke command + +int wcs, stat +pointer sp, cmd +real wx, wy +bool streq() +int clgcur(), rg_pstati() + +begin + call smark (sp) + call salloc (cmd, SZ_LINE, TY_CHAR) + + # Print the status line query in reverse video and get the keystroke. + call printf (QUERY) + if (clgcur ("gcommands", wx, wy, wcs, ch, Memc[cmd], SZ_LINE) == EOF) + ; + + # Process the command. + if (ch == 'q') { + if (rg_pstati (pm, CONVOLUTION) != PM_CONKERNEL) + call rg_pwrite (pm, imk, NULL) + stat = YES + } else if (ch == 'w') { + if (rg_pstati (pm, CONVOLUTION) != PM_CONKERNEL) + call rg_pwrite (pm, imk, NULL) + if (streq ("psfmatch", task)) + call rg_pppars (pm) + stat = YES + } else if (ch == 'n') { + if (rg_pstati (pm, CONVOLUTION) != PM_CONKERNEL) + call rg_pwrite (pm, imk, NULL) + stat = YES + } else { + stat = NO + } + + call sfree (sp) + + return (stat) +end + + +# RG_PGTVERIFY -- Verify whether or not the user truly wishes to quit the +# task. + +int procedure rg_pgtverify (ch) + +int ch #I the input keystroke command + +begin + if (ch == 'q') { + return (YES) + } else if (ch == 'w') { + return (YES) + } else if (ch == 'n') { + return (NO) + } else { + return (NO) + } +end + + +# RG_PPLOT -- Draw the default plot of the kernel fourier spectrum or the +# kernel itself. + +procedure rg_pplot (gd, pm, col, line, plotfunc, plottype) + +pointer gd #I pointer to the graphics stream +pointer pm #I pointer to the psfmatch structure +int col #I column of cross-correlation function to plot +int line #I line of cross-correlation function to plot +int plotfunc #I the default plot function type +int plottype #I the default plot type + +int nx, ny +pointer sp, title, str, data +int rg_pstati(), strlen() +pointer rg_pstatp() + +begin + if (gd == NULL) + return + + # Allocate working space. + call smark (sp) + call salloc (title, SZ_LINE, TY_CHAR) + call salloc (str, SZ_LINE, TY_CHAR) + + # Initialize the plot title and data. + switch (plotfunc) { + case PM_PPOWER: + call sprintf (Memc[title], SZ_LINE, + "Fourier Spectrum for Reference: %s Image: %s") + call rg_pstats (pm, REFIMAGE, Memc[str], SZ_FNAME) + call pargstr (Memc[str]) + call rg_pstats (pm, IMAGE, Memc[str], SZ_FNAME) + call pargstr (Memc[str]) + data = rg_pstatp (pm, ASFFT) + nx = rg_pstati (pm, NXFFT) + ny = rg_pstati (pm, NYFFT) + case PM_PKERNEL: + call sprintf (Memc[title], SZ_LINE, + "Convolution Kernel for Reference: %s Image: %s") + call rg_pstats (pm, REFIMAGE, Memc[str], SZ_FNAME) + call pargstr (Memc[str]) + call rg_pstats (pm, IMAGE, Memc[str], SZ_FNAME) + call pargstr (Memc[str]) + data = rg_pstatp (pm, CONV) + nx = rg_pstati (pm, KNX) + ny = rg_pstati (pm, KNY) + default: + call sprintf (Memc[title], SZ_LINE, + "Convolution Kernel for Reference: %s Image: %s") + call rg_pstats (pm, REFIMAGE, Memc[str], SZ_FNAME) + call pargstr (Memc[str]) + call rg_pstats (pm, IMAGE, Memc[str], SZ_FNAME) + call pargstr (Memc[str]) + data = rg_pstatp (pm, CONV) + nx = rg_pstati (pm, KNX) + nx = rg_pstati (pm, KNY) + } + if (IS_INDEFI(col)) + col = 1 + nx / 2 + if (IS_INDEFI(line)) + line = 1 + ny / 2 + + # Draw the plot. + if (ny == 1) { + switch (plotfunc) { + case PM_PPOWER: + call sprintf (Memc[title+strlen(Memc[title])], SZ_LINE, + "\nLine %d") + call pargi (1) + call rg_pcpline (gd, Memc[title], Memr[rg_pstatp(pm,ASFFT)], + nx, ny, 1) + case PM_PKERNEL: + call sprintf (Memc[title+strlen(Memc[title])], SZ_LINE, + "\nLine %d") + call pargi (1) + call rg_pcpline (gd, Memc[title], Memr[rg_pstatp(pm,CONV)], + nx, ny, 1) + default: + call sprintf (Memc[title+strlen(Memc[title])], SZ_LINE, + "\nLine %d") + call pargi (1) + call rg_pcpline (gd, Memc[title], Memr[rg_pstatp(pm,CONV)], + nx, ny, 1) + } + } else { + switch (plottype) { + case PM_PCONTOUR: + call rg_contour (gd, Memc[title], "", Memr[data], nx, ny) + case PM_PLINE: + call sprintf (Memc[title+strlen(Memc[title])], SZ_LINE, + "\nLine %d") + call pargi (line) + call rg_pcpline (gd, Memc[title], Memr[data], nx, ny, line) + case PM_PCOL: + call sprintf (Memc[title+strlen(Memc[title])], SZ_LINE, + "\nColumn %d") + call pargi (col) + call rg_pcpcol (gd, Memc[title], Memr[data], nx, ny, col) + default: + call rg_contour (gd, Memc[title], "", Memr[data], nx, ny) + } + } + + call sfree (sp) +end + + +# RG_PCPLINE -- Plot a line of a 2D function. + +procedure rg_pcpline (gd, title, data, nx, ny, nline) + +pointer gd #I pointer to the graphics stream +char title[ARB] #I title for the plot +real data[nx,ARB] #I the input data array +int nx, ny #I dimensions of the input data array +int nline #I the line number + +int i +pointer sp, str, x +real ymin, ymax + +begin + # Return if no graphics stream. + if (gd == NULL) + return + + # Check for valid line number. + if (nline < 1 || nline > ny) + return + + # Allocate some working space. + call smark (sp) + call salloc (str, SZ_LINE, TY_CHAR) + call salloc (x, nx, TY_REAL) + + # Initialize the data. + do i = 1, nx + Memr[x+i-1] = i + call alimr (data[1,nline], nx, ymin, ymax) + + # Set up the labels and the axes. + call gclear (gd) + call gswind (gd, 1.0, real (nx), ymin, ymax) + call glabax (gd, title, "X Lag", "X-Correlation Function") + + # Plot the line profile. + call gseti (gd, G_PLTYPE, GL_SOLID) + call gpline (gd, Memr[x], data[1,nline], nx) + call gflush (gd) + + call sfree (sp) +end + + +# RG_PCPCOL -- Plot a column of the cross-correlation function. + +procedure rg_pcpcol (gd, title, data, nx, ny, ncol) + +pointer gd #I pointer to the graphics stream +char title[ARB] #I title of the column plot +real data[nx,ARB] #I the input data array +int nx, ny #I the dimensions of the input data array +int ncol #I line number + +int i +pointer sp, x, y +real ymin, ymax + +begin + # Return if no graphics stream. + if (gd == NULL) + return + + # Check for valid column number. + if (ncol < 1 || ncol > nx) + return + + # Initialize. + call smark (sp) + call salloc (x, ny, TY_REAL) + call salloc (y, ny, TY_REAL) + + # Get the data to be plotted. + do i = 1, ny { + Memr[x+i-1] = i + Memr[y+i-1] = data[ncol,i] + } + call alimr (Memr[y], ny, ymin, ymax) + + # Set up the labels and the axes. + call gclear (gd) + call gswind (gd, 1.0, real (ny), ymin, ymax) + call glabax (gd, title, "Y Lag", "X-Correlation Function") + + # Plot the profile. + call gseti (gd, G_PLTYPE, GL_SOLID) + call gpline (gd, Memr[x], Memr[y], ny) + + call sfree (sp) +end diff --git a/pkg/images/immatch/src/psfmatch/rgppars.x b/pkg/images/immatch/src/psfmatch/rgppars.x new file mode 100644 index 00000000..c8d49baa --- /dev/null +++ b/pkg/images/immatch/src/psfmatch/rgppars.x @@ -0,0 +1,124 @@ +include "psfmatch.h" + +# RG_PGPARS -- Read in the psf matching algorithm parameters. + +procedure rg_pgpars (pm) + +pointer pm #I pointer to psfmatch structure + +int ival +pointer sp, str +bool clgetb() +int clgwrd(), clgeti(), btoi() +real clgetr() + +begin + # Allocate working space. + call smark (sp) + call salloc (str, SZ_LINE, TY_CHAR) + + # Initialize the psf matching structure. + call rg_pinit (pm, clgwrd ("convolution", Memc[str], SZ_LINE, + PM_CTYPES)) + + # Define the data and kernel sizes. + ival = clgeti ("dnx") + if (mod (ival, 2) == 0) + ival = ival + 1 + call rg_pseti (pm, DNX, ival) + ival = clgeti ("dny") + if (mod (ival, 2) == 0) + ival = ival + 1 + call rg_pseti (pm, DNY, ival) + ival = clgeti ("pnx") + if (mod (ival, 2) == 0) + ival = ival + 1 + call rg_pseti (pm, PNX, ival) + ival = clgeti ("pny") + if (mod (ival, 2) == 0) + ival = ival + 1 + call rg_pseti (pm, PNY, ival) + + # Centering parameters. + call rg_pseti (pm, CENTER, btoi (clgetb ("center"))) + + # Background value computation. + call clgstr ("background", Memc[str], SZ_LINE) + call rg_psets (pm, BSTRING, Memc[str]) + call rg_psetr (pm, LOREJECT, clgetr ("loreject")) + call rg_psetr (pm, HIREJECT, clgetr ("hireject")) + call rg_psetr (pm, APODIZE, clgetr ("apodize")) + + # Filtering parameters. + call rg_psetr (pm, UFLUXRATIO, clgetr ("fluxratio")) + call clgstr ("filter", Memc[str], SZ_LINE) + call rg_psets (pm, FSTRING, Memc[str]) + call rg_psetr (pm, SXINNER, clgetr ("sx1")) + call rg_psetr (pm, SXOUTER, clgetr ("sx2")) + call rg_psetr (pm, SYINNER, clgetr ("sy1")) + call rg_psetr (pm, SYOUTER, clgetr ("sy2")) + call rg_pseti (pm, RADSYM, btoi (clgetb ("radsym"))) + call rg_psetr (pm, THRESHOLD, (clgetr ("threshold"))) + + # Normalization parameter. + call rg_psetr (pm, NORMFACTOR, clgetr ("normfactor")) + + #call rg_psetr (pm, PRATIO, clgetr ("pratio")) + + call sfree (sp) +end + + +# RG_PPPARS -- Put the parameters required for the psf matching from +# the cl to the parameter file. + +procedure rg_pppars (pm) + +pointer pm #I pointer to the psf matching structure + +pointer sp, str +bool itob() +int rg_pstati() +real rg_pstatr() + +begin + # Allocate working space. + call smark (sp) + call salloc (str, SZ_LINE, TY_CHAR) + + # Store the psf data string. + call rg_pstats (pm, PSFDATA, Memc[str], SZ_LINE) + call clpstr ("psf", Memc[str]) + + # Store the size parameters. + call clputi ("dnx", rg_pstati (pm, DNX)) + call clputi ("dny", rg_pstati (pm, DNY)) + call clputi ("pnx", rg_pstati (pm, PNX)) + call clputi ("pny", rg_pstati (pm, PNY)) + + # Store the centering parameters. + call clputb ("center", itob (rg_pstati (pm, CENTER))) + + # Store the background fitting parameters. + call rg_pstats (pm, BSTRING, Memc[str], SZ_LINE) + call clpstr ("background", Memc[str]) + call clputr ("loreject", rg_pstatr (pm, LOREJECT)) + call clputr ("hireject", rg_pstatr (pm, HIREJECT)) + call clputr ("apodize", rg_pstatr (pm, APODIZE)) + + # Store the filtering parameters. + call clputr ("fluxratio", rg_pstatr(pm, UFLUXRATIO)) + call rg_pstats (pm, FSTRING, Memc[str], SZ_LINE) + call clpstr ("filter", Memc[str]) + call clputr ("sx1", rg_pstatr (pm, SXINNER)) + call clputr ("sx2", rg_pstatr (pm, SXOUTER)) + call clputr ("sy1", rg_pstatr (pm, SYINNER)) + call clputr ("sy2", rg_pstatr (pm, SYOUTER)) + call clputb ("radsym", itob (rg_pstati (pm, RADSYM))) + call clputr ("threshold", rg_pstatr (pm, THRESHOLD)) + + # Store the normalization parameters. + call clputr ("normfactor", rg_pstatr (pm, NORMFACTOR)) + + call sfree (sp) +end diff --git a/pkg/images/immatch/src/psfmatch/rgpregions.x b/pkg/images/immatch/src/psfmatch/rgpregions.x new file mode 100644 index 00000000..c04dcf97 --- /dev/null +++ b/pkg/images/immatch/src/psfmatch/rgpregions.x @@ -0,0 +1,464 @@ +include <fset.h> +include <imhdr.h> +include "psfmatch.h" + +# RG_PREGIONS -- Decoode the regions specification. If the sections +# string is NULL then a default region dnx by dny pixels wide centered +# on the reference image is used. Otherwise the section centers are +# read from the regions string or from the objects list. + +int procedure rg_pregions (list, im, pm, rp, reread) + +int list #I pointer to regions file list +pointer im #I pointer to the image +pointer pm #I pointer to the psfmatch structure +int rp #I region pointer +int reread #I reread the current file + +char fname[SZ_FNAME] +int nregions, fd +int open(), rg_prregions(), rg_pgregions(), fntgfnb() +int rg_pstati() +data fname[1] /EOS/ +errchk open(), fntgfnb(), close() + +begin + if (rp < 1 || rp > MAX_NREGIONS) { + nregions = 0 + } else if (rg_pgregions (im, pm, rp, MAX_NREGIONS) > 0) { + nregions = rg_pstati (pm, NREGIONS) + } else if (list != NULL) { + if (reread == NO) { + iferr { + if (fntgfnb (list, fname, SZ_FNAME) != EOF) { + fd = open (fname, READ_ONLY, TEXT_FILE) + nregions= rg_prregions (fd, im, pm, rp, MAX_NREGIONS) + call close (fd) + } + } then + nregions = 0 + } else if (fname[1] != EOS) { + iferr { + fd = open (fname, READ_ONLY, TEXT_FILE) + nregions= rg_prregions (fd, im, pm, rp, MAX_NREGIONS) + call close (fd) + } then + nregions = 0 + } + } else + nregions = 0 + + return (nregions) +end + + +# RG_PMKREGIONS -- Create a list of psf objects by selecting objects with +# the image display cursor. + +int procedure rg_pmkregions (fd, im, pm, rp, max_nregions) + +int fd #I the output coordinates file descriptor +pointer im #I pointer to the image +pointer pm #I pointer to the psf matching structure +int rp #I pointer to current region +int max_nregions #I maximum number of regions + +int nregions, wcs, key, x1, x2, y1, y2 +pointer sp, region, cmd +real x, y, xc, yc +int clgcur(), rg_pstati() +pointer rg_pstatp() + +begin + # Allocate working space. + call smark (sp) + call salloc (region, SZ_FNAME, TY_CHAR) + call salloc (cmd, SZ_LINE, TY_CHAR) + + # Allocate the arrays to hold the regions information, + call rg_prealloc (pm, max_nregions) + + nregions = min (rp-1, rg_pstati (pm, NREGIONS)) + while (nregions < max_nregions) { + + # Identify the object. + call printf ("Mark object %d [any key=mark,q=quit]:\n") + call pargi (nregions + 1) + if (clgcur ("icommands", x, y, wcs, key, Memc[cmd], SZ_LINE) == EOF) + break + if (key == 'q') + break + + # Center the object. + if (rg_pstati (pm, CENTER) == YES) { + call rg_pcntr (im, x, y, max (rg_pstati(pm, PNX), + rg_pstati(pm, PNY)), xc, yc) + } else { + xc = x + yc = y + } + + # Compute the data section. + x1 = xc - rg_pstati (pm, DNX) / 2 + x2 = x1 + rg_pstati (pm, DNX) - 1 + y1 = yc - rg_pstati (pm, DNY) / 2 + y2 = y1 + rg_pstati (pm, DNY) - 1 + + # Make sure that the region is on the image. + if (x1 < 1 || x2 > IM_LEN(im,1) || y1 < 1 || y2 > + IM_LEN(im,2)) + next + + if (fd != NULL) { + call fprintf (fd, "%0.3f %0.3f\n") + call pargr (xc) + call pargr (yc) + } + + Memi[rg_pstatp(pm,RC1)+nregions] = x1 + Memi[rg_pstatp(pm,RC2)+nregions] = x2 + Memi[rg_pstatp(pm,RL1)+nregions] = y1 + Memi[rg_pstatp(pm,RL2)+nregions] = y2 + Memr[rg_pstatp(pm,RZERO)+nregions] = INDEFR + Memr[rg_pstatp(pm,RXSLOPE)+nregions] = INDEFR + Memr[rg_pstatp(pm,RYSLOPE)+nregions] = INDEFR + nregions = nregions + 1 + + } + + # Reallocate the correct amount of space. + call rg_pseti (pm, NREGIONS, nregions) + if (nregions > 0) { + call rg_prealloc (pm, nregions) + if (fd != NULL) { + call fstats (fd, F_FILENAME, Memc[region], SZ_FNAME) + call rg_psets (pm, PSFDATA, Memc[region]) + } else + call rg_psets (pm, PSFDATA, "") + } else { + call rg_prfree (pm) + call rg_psets (pm, PSFDATA, "") + } + + call sfree (sp) + return (nregions) +end + + +# RG_PRREGIONS -- Procedure to read the regions from a file. + +int procedure rg_prregions (fd, im, pm, rp, max_nregions) + +int fd #I regions file descriptor +pointer im #I pointer to the image +pointer pm #I pointer to psf matching structure +int rp #I pointer to current region +int max_nregions #I maximum number of regions + +int nregions, x1, y1, x2, y2 +pointer sp, line +real x, y, xc, yc +int rg_pstati(), getline() +pointer rg_pstatp() + +begin + # Allocate working space. + call smark (sp) + call salloc (line, SZ_LINE, TY_CHAR) + + # Allocate the arrays to hold the regions information, + call rg_prealloc (pm, max_nregions) + + # Decode the regions string. + nregions = min (rp - 1, rg_pstati (pm, NREGIONS)) + while (getline (fd, Memc[line]) != EOF) { + + if (nregions >= max_nregions) + break + + call sscan (Memc[line]) + call gargr (x) + call gargr (y) + if (rg_pstati (pm, CENTER) == YES) { + call rg_pcntr (im, x, y, max (rg_pstati(pm, PNX), + rg_pstati(pm, PNY)), xc, yc) + } else { + xc = x + yc = y + } + + # Compute the data section. + x1 = xc - rg_pstati (pm, DNX) / 2 + x2 = x1 + rg_pstati (pm, DNX) - 1 + if (IM_NDIM(im) == 1) { + y1 = 1 + y2 = 1 + } else { + y1 = yc - rg_pstati (pm, DNY) / 2 + y2 = y1 + rg_pstati (pm, DNY) - 1 + } + + # Make sure that the region is on the image. + if (x1 < 1 || x2 > IM_LEN(im,1) || y1 < 1 || y2 > + IM_LEN(im,2)) + next + + # Add the new region to the list. + Memi[rg_pstatp(pm,RC1)+nregions] = x1 + Memi[rg_pstatp(pm,RC2)+nregions] = x2 + Memi[rg_pstatp(pm,RL1)+nregions] = y1 + Memi[rg_pstatp(pm,RL2)+nregions] = y2 + Memr[rg_pstatp(pm,RZERO)+nregions] = INDEFR + Memr[rg_pstatp(pm,RXSLOPE)+nregions] = INDEFR + Memr[rg_pstatp(pm,RYSLOPE)+nregions] = INDEFR + nregions = nregions + 1 + } + + call rg_pseti (pm, NREGIONS, nregions) + if (nregions > 0) + call rg_prealloc (pm, nregions) + else + call rg_prfree (pm) + + call sfree (sp) + return (nregions) +end + + +# RG_PGREGIONS -- Procedure to compute the column and line limits given +# an x and y position and a default size. + +int procedure rg_pgregions (im, pm, rp, max_nregions) + +pointer im #I pointer to the image +pointer pm #I pointer to psf matching structure +int rp #I pointer to the current region +int max_nregions #I maximum number of regions + +int ncols, nlines, nregions +int x1, x2, y1, y2 +pointer sp, region +real x, y, xc, yc +int rg_pstati(), nscan() +pointer rg_pstatp() + +begin + # Allocate working space. + call smark (sp) + call salloc (region, SZ_LINE, TY_CHAR) + + # Allocate the arrays to hold the regions information. + call rg_prealloc (pm, max_nregions) + + # Get the constants. + ncols = IM_LEN(im,1) + nlines = IM_LEN(im,2) + + # Decode the center. + call rg_pstats (pm, PSFDATA, Memc[region], SZ_LINE) + nregions = min (rp - 1, rg_pstati (pm, NREGIONS)) + call sscan (Memc[region]) + call gargr (x) + call gargr (y) + + # Compute the data region. + if (nscan() >= 2) { + + # Compute a more accurate center. + if (rg_pstati (pm, CENTER) == YES) { + call rg_pcntr (im, x, y, max (rg_pstati(pm, PNX), + rg_pstati(pm, PNY)), xc, yc) + } else { + xc = x + yc = y + } + + # Compute the data section. + x1 = xc - rg_pstati (pm, DNX) / 2 + x2 = x1 + rg_pstati (pm, DNX) - 1 + if (IM_NDIM(im) == 1) { + y1 = 1 + y2 = 1 + } else { + y1 = yc - rg_pstati (pm, DNY) / 2 + y2 = y1 + rg_pstati (pm, DNY) - 1 + } + + # Make sure that the region is on the image. + if (x1 >= 1 && x2 <= IM_LEN(im,1) && y1 >= 1 && + y2 <= IM_LEN(im,2)) { + Memi[rg_pstatp(pm,RC1)+nregions] = x1 + Memi[rg_pstatp(pm,RC2)+nregions] = x2 + Memi[rg_pstatp(pm,RL1)+nregions] = y1 + Memi[rg_pstatp(pm,RL2)+nregions] = y2 + Memr[rg_pstatp(pm,RZERO)+nregions] = INDEFR + Memr[rg_pstatp(pm,RXSLOPE)+nregions] = INDEFR + Memr[rg_pstatp(pm,RYSLOPE)+nregions] = INDEFR + nregions = nregions + 1 + } + } + + + # Reallocate the correct amount of space. + call rg_pseti (pm, NREGIONS, nregions) + if (nregions > 0) + call rg_prealloc (pm, nregions) + else + call rg_prfree (pm) + + call sfree (sp) + + return (nregions) +end + + +# RG_PCNTR -- Compute star center using MPC algorithm. + +procedure rg_pcntr (im, xstart, ystart, boxsize, xcntr, ycntr) + +pointer im #I pointer to the input image +real xstart, ystart #I initial position +int boxsize #I width of the centering box +real xcntr, ycntr #O computed center + +int x1, x2, y1, y2, half_box +int ncols, nrows, nx, ny, try +real xinit, yinit +pointer bufptr, sp, x_vect, y_vect +int imgs2r() + +begin + # Inialize. + half_box = (boxsize - 1) / 2 + xinit = xstart + ncols = IM_LEN (im, 1) + if (IM_NDIM(im) == 1) { + yinit = 1 + nrows = 1 + } else { + yinit = ystart + nrows = IM_LEN (im, 2) + } + try = 0 + + # Iterate until pixel shifts are less than one. + repeat { + + # Define region to extract. + x1 = max (xinit - half_box, 1.0) +0.5 + x2 = min (xinit + half_box, real(ncols)) +0.5 + y1 = max (yinit - half_box, 1.0) +0.5 + y2 = min (yinit + half_box, real(nrows)) +0.5 + nx = x2 - x1 + 1 + ny = y2 - y1 + 1 + + # Extract region around center + bufptr = imgs2r (im, x1, x2, y1, y2) + + # Compute the new center. + call smark (sp) + if (IM_NDIM(im) == 1) { + call salloc (x_vect, nx, TY_REAL) + call aclrr (Memr[x_vect], nx) + call rg_prowsum (Memr[bufptr], Memr[x_vect], nx, ny) + call rg_pcenter (Memr[x_vect], nx, xcntr) + ycntr = 1 + } else { + call salloc (x_vect, nx, TY_REAL) + call salloc (y_vect, ny, TY_REAL) + call aclrr (Memr[x_vect], nx) + call aclrr (Memr[y_vect], ny) + call rg_prowsum (Memr[bufptr], Memr[x_vect], nx, ny) + call rg_pcolsum (Memr[bufptr], Memr[y_vect], nx, ny) + call rg_pcenter (Memr[x_vect], nx, xcntr) + call rg_pcenter (Memr[y_vect], ny, ycntr) + } + call sfree (sp) + + # Check for INDEF centers. + if (IS_INDEFR(xcntr) || IS_INDEFR(ycntr)) { + xcntr = xinit + ycntr = yinit + break + } + + # Add in offsets + xcntr = xcntr + x1 + ycntr = ycntr + y1 + + try = try + 1 + if (try == 1) { + if ((abs(xcntr-xinit) > 1.0) || (abs(ycntr-yinit) > 1.0)) { + xinit = xcntr + yinit = ycntr + } + } else + break + } +end + + +# RG_PROWSUM -- Sum all rows in a raster. + +procedure rg_prowsum (v, row, nx, ny) + +real v[nx,ny] #I the input subraster +real row[ARB] #O the output row sum +int nx, ny #I the dimensions of the subraster + +int i, j + +begin + do i = 1, ny + do j = 1, nx + row[j] = row[j] + v[j,i] +end + + +# RG_PCOLSUM -- Sum all columns in a raster. + +procedure rg_pcolsum (v, col, nx, ny) + +real v[nx,ny] #I the input subraster +real col[ARB] #O the output column sum +int nx, ny #I the dimensions of the subraster + +int i, j + +begin + do i = 1, ny + do j = 1, nx + col[j] = col[j] + v[i,j] +end + + +# RG_PCENTER -- Compute center of gravity of array. + +procedure rg_pcenter (v, nv, vc) + +real v[ARB] #I the input vector +int nv #I the length of the vector +real vc #O the output center + +int i +real sum1, sum2, sigma, cont + +begin + # Compute first moment + sum1 = 0.0 + sum2 = 0.0 + + call aavgr (v, nv, cont, sigma) + + do i = 1, nv + if (v[i] > cont) { + sum1 = sum1 + (i-1) * (v[i] - cont) + sum2 = sum2 + (v[i] - cont) + } + + # Determine center + if (sum2 == 0.0) + vc = INDEFR + else + vc = sum1 / sum2 +end diff --git a/pkg/images/immatch/src/psfmatch/rgpsfm.x b/pkg/images/immatch/src/psfmatch/rgpsfm.x new file mode 100644 index 00000000..493d48c9 --- /dev/null +++ b/pkg/images/immatch/src/psfmatch/rgpsfm.x @@ -0,0 +1,815 @@ +include <imhdr.h> +include <math/gsurfit.h> +include "psfmatch.h" + +# RG_PSFM -- Procedure to match the psf functions of two images. + +int procedure rg_psfm (pm, imr, im1, impsf, imk, newref) + +pointer pm #I pointer to psf matching structure +pointer imr #I pointer to reference image +pointer im1 #I pointer to input image +pointer impsf #I pointer to the psf image +pointer imk #I pointer to kernel image +int newref #I new reference image ? + +int stat +int rg_pstati(), rg_pfget(), rg_psfget(), rg_kget() +pointer rg_pstatp() + +begin + # Compute the convolution kernel. + if (rg_pstati (pm, CONVOLUTION) != PM_CONKERNEL) { + + # Compute the kernel using raw image data or the psf image. + if (rg_pstati (pm,CONVOLUTION) == PM_CONIMAGE) { + + # Set the kernel size to the user specified kernel size. + call rg_pseti (pm, KNX, rg_pstati (pm, PNX)) + if (IM_NDIM(imr) == 1) + call rg_pseti (pm, KNY, 1) + else + call rg_pseti (pm, KNY, rg_pstati (pm, PNY)) + + # Compute the FFTS of the input and reference image. + stat = rg_pfget (pm, imr, im1, newref) + + } else { + + # Set the kernel size to the psf image size + call rg_pseti (pm, KNX, IM_LEN (impsf,1)) + if (IM_NDIM(imr) == 1) + call rg_pseti (pm, KNY, 1) + else + call rg_pseti (pm, KNY, IM_LEN(impsf,2)) + + # Compute the FFTS of the input and reference psf images. + stat = rg_psfget (pm, imr, impsf, newref) + } + + # Delete working arrays if an error occurs. + if (stat == ERR) { + if (rg_pstatp (pm, REFFFT) != NULL) + call mfree (rg_pstatp (pm, REFFFT), TY_REAL) + call rg_psetp (pm, REFFFT, NULL) + if (rg_pstatp (pm, IMFFT) != NULL) + call mfree (rg_pstatp (pm, IMFFT), TY_REAL) + call rg_psetp (pm, IMFFT, NULL) + if (rg_pstatp (pm, FFT) != NULL) + call mfree (rg_pstatp (pm, FFT), TY_REAL) + call rg_psetp (pm, FFT, NULL) + if (rg_pstatp (pm, CONV) != NULL) + call mfree (rg_pstatp (pm, CONV), TY_REAL) + call rg_psetp (pm, CONV, NULL) + if (rg_pstatp (pm, ASFFT) != NULL) + call mfree (rg_pstatp (pm, ASFFT), TY_REAL) + call rg_psetp (pm, ASFFT, NULL) + } + + # Do the filtering in frequency space. + if (rg_pstatp (pm, FFT) != NULL) + call rg_pfilter (pm) + + } else { + + # Set the kernel size. + call rg_pseti (pm, KNX, IM_LEN(imk,1)) + if (IM_NDIM(im1) == 1) + call rg_pseti (pm, KNY, 1) + else + call rg_pseti (pm, KNY, IM_LEN(imk,2)) + + # Read in the convolution kernel. + stat = rg_kget (pm, imk) + + # Delete working arrays if an error occurs. + if (stat == ERR) { + if (rg_pstatp (pm, REFFFT) != NULL) + call mfree (rg_pstatp (pm, REFFFT), TY_REAL) + call rg_psetp (pm, REFFFT, NULL) + if (rg_pstatp (pm, IMFFT) != NULL) + call mfree (rg_pstatp (pm, IMFFT), TY_REAL) + call rg_psetp (pm, IMFFT, NULL) + if (rg_pstatp (pm, FFT) != NULL) + call mfree (rg_pstatp (pm, FFT), TY_REAL) + call rg_psetp (pm, FFT, NULL) + if (rg_pstatp (pm, CONV) != NULL) + call mfree (rg_pstatp (pm, CONV), TY_REAL) + call rg_psetp (pm, CONV, NULL) + if (rg_pstatp (pm, ASFFT) != NULL) + call mfree (rg_pstatp (pm, ASFFT), TY_REAL) + call rg_psetp (pm, ASFFT, NULL) + } + } + + return (stat) +end + + +# RG_PFGET -- Compute the psfmatching function using Fourier techniques. + +int procedure rg_pfget (pm, imr, im1, newref) + +pointer pm #I pointer to psfmatch structure +pointer imr #I pointer to reference image +pointer im1 #I pointer to input image +int newref #I new reference image ? + +int i, nregions, nrimcols, nrimlines, nrcols, nrlines, nrpcols, nrplines +int nborder, stat, rc1, rc2, rl1, rl2, nxfft, nyfft +pointer sp, str, coeff, dim, rbuf, ibuf, rsum, isum, border +pointer prc1, prc2, prl1, prl2, przero, prxslope, pryslope, reffft, imfft, fft +real rwtsum, iwtsum, rscale, iscale, rnscale, inscale +bool fp_equalr() +int rg_pstati(), rg_border(), rg_szfft() +pointer rg_pstatp(), rg_pgdata() +real rg_pstatr(), rg_pnsum(), rg_pg1norm(), rg_pg2norm() +real rg_pg10f(), rg_pg20f() + +define nextimage_ 11 + +begin + # Assemble the PSF data by looping over the regions list. + nregions = rg_pstati (pm, NREGIONS) + if (nregions <= 0) + return (ERR) + + call smark (sp) + call salloc (str, SZ_LINE, TY_CHAR) + call salloc (coeff, max (GS_SAVECOEFF+6, 9), TY_REAL) + call salloc (dim, 2, TY_INT) + + # Get the reference region pointers. + prc1 = rg_pstatp (pm, RC1) + prc2 = rg_pstatp (pm, RC2) + prl1 = rg_pstatp (pm, RL1) + prl2 = rg_pstatp (pm, RL2) + przero = rg_pstatp (pm, RZERO) + prxslope = rg_pstatp (pm, RXSLOPE) + pryslope = rg_pstatp (pm, RYSLOPE) + + # Check to see if the reference / input images are 1D. + nrimcols = IM_LEN(imr,1) + nrpcols = rg_pstati (pm, PNX) + if (IM_NDIM(imr) == 1) { + nrimlines = 1 + nrplines = 1 + } else { + nrimlines = IM_LEN(imr,2) + nrplines = rg_pstati (pm, PNY) + } + + # Initialize + rwtsum = 0.0 + iwtsum = 0.0 + rnscale = INDEFR + inscale = INDEFR + rbuf = NULL + ibuf = NULL + stat = OK + if (newref == YES) + call calloc (rsum, rg_pstati (pm, DNX) * rg_pstati (pm, DNY), + TY_REAL) + call calloc (isum, rg_pstati (pm, DNX) * rg_pstati (pm, DNY), + TY_REAL) + + do i = 1, nregions { + + # Get the reference subraster regions. + rc1 = max (1, min (nrimcols, Memi[prc1+i-1])) + rc2 = min (nrimcols, max (1, Memi[prc2+i-1])) + rl1 = max (1, min (nrimlines, Memi[prl1+i-1])) + rl2 = min (nrimlines, max (1, Memi[prl2+i-1])) + nrcols = rc2 - rc1 + 1 + nrlines = rl2 - rl1 + 1 + + # Go to next object if reference region is off the image. + if (nrcols < rg_pstati (pm, DNX) || (IM_NDIM(imr) == 2 && + nrlines < rg_pstati(pm, DNY))) { + call rg_pstats (pm, REFIMAGE, Memc[str], SZ_LINE) + call eprintf ( + "Reference object %d: %s[%d:%d,%d:%d] is off image.\n") + call pargi (i) + call pargstr (Memc[str]) + call pargi (rc1) + call pargi (rc2) + call pargi (rl1) + call pargi (rl2) + next + } + + if (newref == YES) { + + # Get the reference data. + rbuf = rg_pgdata (imr, rc1, rc2, rl1, rl2) + + # Do the reference image background subtraction. + border = NULL + nborder = rg_border (Memr[rbuf], nrcols, nrlines, nrpcols, + nrplines, border) + call rg_pscale (pm, Memr[border], nborder, nrcols, + nrlines, nrpcols, nrplines, rg_pstatr (pm, BVALUER), + Memr[coeff]) + if (border != NULL) + call mfree (border, TY_REAL) + + # Save the coefficients. + Memr[przero+i-1] = Memr[coeff] + Memr[prxslope+i-1] = Memr[coeff+1] + Memr[pryslope+i-1] = Memr[coeff+2] + + # Subtract the reference background. + call rg_subtract (Memr[rbuf], nrcols, nrlines, + Memr[przero+i-1], Memr[prxslope+i-1], Memr[pryslope+i-1]) + + # Apodize the reference image data. + if (rg_pstatr (pm, APODIZE) > 0.0) + call rg_apodize (Memr[rbuf], nrcols, nrlines, + rg_pstatr (pm, APODIZE), YES) + + # Compute the scale factors and accumulate the weighted sums. + rscale = rg_pnsum (Memr[rbuf], nrcols, nrlines, nrpcols, + nrplines) + if (! IS_INDEFR(rscale)) { + if (IS_INDEFR(rnscale)) + rnscale = 1.0 / rscale + } + if (IS_INDEFR(rscale)) + rscale = 1.0 + else + rscale = rscale / rnscale + + call amulkr (Memr[rbuf], rscale, Memr[rbuf], nrcols * + nrlines) + rwtsum = rwtsum + rscale + call aaddr (Memr[rsum], Memr[rbuf], Memr[rsum], nrcols * + nrlines) + + call mfree (rbuf, TY_REAL) + } + + # Get the input image data + ibuf = rg_pgdata (im1, rc1, rc2, rl1, rl2) + + # Compute the zero point, and the x and y slopes of input image. + border = NULL + nborder = rg_border (Memr[ibuf], nrcols, nrlines, nrpcols, + nrplines, border) + call rg_pscale (pm, Memr[border], nborder, nrcols, nrlines, + nrpcols, nrplines, rg_pstatr (pm, BVALUE), Memr[coeff]) + if (border != NULL) + call mfree (border, TY_REAL) + + # Subtract the background from the input image. + call rg_subtract (Memr[ibuf], nrcols, nrlines, Memr[coeff], + Memr[coeff+1], Memr[coeff+2]) + + # Apodize the data. + if (rg_pstatr (pm, APODIZE) > 0.0) + call rg_apodize (Memr[ibuf], nrcols, nrlines, rg_pstatr (pm, + APODIZE), YES) + + # Compute the scale factors and accumulate the weighted sums for + # input image. + iscale = rg_pnsum (Memr[ibuf], nrcols, nrlines, nrpcols, nrplines) + if (! IS_INDEFR(iscale)) { + if (IS_INDEFR(inscale)) + inscale = 1.0 / iscale + } + if (IS_INDEFR(iscale)) + iscale = 1.0 + else + iscale = iscale / inscale + + call amulkr (Memr[ibuf], iscale, Memr[ibuf], nrcols * nrlines) + iwtsum = iwtsum + iscale + call aaddr (Memr[isum], Memr[ibuf], Memr[isum], nrcols * nrlines) + + # Free the individual image buffers. + call mfree (ibuf, TY_REAL) + } + + # Check to see if any data was read. + if (iwtsum <= 0.0) { + stat = ERR + goto nextimage_ + } + + # Normalize the summed buffers by the weights. + if (newref == YES) { + if (! fp_equalr (rwtsum, 0.0)) + call adivkr (Memr[rsum], rwtsum, Memr[rsum], nrcols * nrlines) + } + if (! fp_equalr (iwtsum, 0.0)) + call adivkr (Memr[isum], iwtsum, Memr[isum], nrcols * nrlines) + + # Figure out how big the Fourier transform has to be, given + # the size of the reference subraster, the window size and + # the fact that the FFT must be a power of 2. + + nxfft = rg_szfft (nrcols, 0) + if (nrlines == 1) + nyfft = 1 + else + nyfft = rg_szfft (nrlines, 0) + call rg_pseti (pm, NXFFT, nxfft) + call rg_pseti (pm, NYFFT, nyfft) + + imfft = rg_pstatp (pm, IMFFT) + if (imfft != NULL) + call mfree (imfft, TY_REAL) + call calloc (imfft, 2 * nxfft * nyfft, TY_REAL) + call rg_psetp (pm, IMFFT, imfft) + + # Allocate space for the fft. + fft = rg_pstatp (pm, FFT) + if (fft != NULL) + call mfree (fft, TY_REAL) + call calloc (fft, 2 * nxfft * nyfft, TY_REAL) + call rg_psetp (pm, FFT, fft) + + # Allocate space for the reference and input image ffts + if (newref == YES) { + + reffft = rg_pstatp (pm, REFFFT) + if (reffft != NULL) + call mfree (reffft, TY_REAL) + call calloc (reffft, 2 * nxfft * nyfft, TY_REAL) + call rg_psetp (pm, REFFFT, reffft) + + # Load the reference image FFT. + call rg_rload (Memr[rsum], nrcols, nrlines, Memr[fft], nxfft, + nyfft) + call mfree (rsum, TY_REAL) + rsum = NULL + + # Load the input image FFT. + call rg_iload (Memr[isum], nrcols, nrlines, Memr[fft], nxfft, + nyfft) + call mfree (isum, TY_REAL) + isum = NULL + + # Shift the data for easy of filtering. + call rg_fshift (Memr[fft], Memr[fft], 2 * nxfft, nyfft) + + # Compute the Fourier Transform of the reference and input image + # data. + Memi[dim] = nxfft + Memi[dim+1] = nyfft + if (Memi[dim+1] == 1) + call rg_fourn (Memr[fft], Memi[dim], 1, 1) + else + call rg_fourn (Memr[fft], Memi[dim], 2, 1) + + # Compute the flux ratio between the two data sets. + if (IS_INDEFR(rg_pstatr(pm, UFLUXRATIO))) { + if (rg_pstati (pm, BACKGRD) == PM_BNONE) + call rg_psetr (pm, FLUXRATIO, rg_pg2norm (Memr[fft], + 2 * nxfft, nyfft)) + else + call rg_psetr (pm, FLUXRATIO, rg_pg20f (Memr[fft], + 2 * nxfft, nyfft)) + } else + call rg_psetr (pm, FLUXRATIO, rg_pstatr (pm, UFLUXRATIO)) + + # Separate the two transforms and compute the division. + call rg_pdivfft (Memr[fft], Memr[reffft], Memr[imfft], Memr[fft], + 2 * nxfft, nyfft) + + } else { + + + # Get the reference image FFT. + reffft = rg_pstatp (pm, REFFFT) + + # Load the input image FFT. + call rg_rload (Memr[isum], nrcols, nrlines, Memr[imfft], nxfft, + nyfft) + call mfree (isum, TY_REAL) + isum = NULL + + # Shift the data for easy of filtering. + call rg_fshift (Memr[imfft], Memr[imfft], 2 * nxfft, nyfft) + + # Compute the Fourier Transform of the input image data. + Memi[dim] = nxfft + Memi[dim+1] = nyfft + if (Memi[dim+1] == 1) + call rg_fourn (Memr[imfft], Memi[dim], 1, 1) + else + call rg_fourn (Memr[imfft], Memi[dim], 2, 1) + + # Compute the flux ratio between the two data sets. + if (IS_INDEFR(rg_pstatr(pm, UFLUXRATIO))) { + if (rg_pstati (pm, BACKGRD) == PM_BNONE) + call rg_psetr (pm, FLUXRATIO, rg_pg1norm (Memr[reffft], + 2 * nxfft, nyfft) / rg_pg1norm (Memr[imfft], 2 * nxfft, + nyfft)) + else + call rg_psetr (pm, FLUXRATIO, rg_pg10f (Memr[reffft], + 2 * nxfft, nyfft) / rg_pg10f (Memr[imfft], 2 * nxfft, + nyfft)) + } else + call rg_psetr (pm, FLUXRATIO, rg_pstatr (pm, UFLUXRATIO)) + + # Divide the two functions. + call adivx (Memr[reffft], Memr[imfft], Memr[fft], nxfft * nyfft) + } + + # Normalize the FFT. + call rg_pnorm (Memr[fft], nxfft, nyfft, rg_pstatr (pm, FLUXRATIO)) + + +nextimage_ + + if (rsum != NULL) + call mfree (rsum, TY_REAL) + if (isum != NULL) + call mfree (isum, TY_REAL) + call sfree (sp) + if (stat == ERR) + return (ERR) + else + return (OK) +end + + +# RG_PSFGET -- Compute the psfmatching function using Fourier techniques. + +int procedure rg_psfget (pm, imr, impsf, newref) + +pointer pm #I pointer to the psfmatch structure +pointer imr #I pointer to the reference psf +pointer impsf #I pointer to the input image psf +int newref #I new reference image + +int nrcols, nrlines, nxfft, nyfft +pointer sp, dim, rbuf, ibuf, imfft, fft, reffft +int rg_szfft() +pointer rg_pgdata(), rg_pstatp() +real rg_pstatr(), rg_pg2norm(), rg_pg1norm() + +begin + call smark (sp) + call salloc (dim, 2, TY_INT) + + nrcols = IM_LEN(imr,1) + if (IM_NDIM(imr) == 1) + nrlines = 1 + else + nrlines = IM_LEN(imr,2) + + # Get the psf data. + rbuf = NULL + ibuf = NULL + if (newref == YES) { + call calloc (rbuf, nrcols * nrlines, TY_REAL) + rbuf = rg_pgdata (imr, 1, nrcols, 1, nrlines) + } + call calloc (ibuf, nrcols * nrlines, TY_REAL) + ibuf = rg_pgdata (impsf, 1, nrcols, 1, nrlines) + + # Compute the size for the FFT buffers. + nxfft = rg_szfft (nrcols, 0) + if (nrlines == 1) + nyfft = 1 + else + nyfft = rg_szfft (nrlines, 0) + call rg_pseti (pm, NXFFT, nxfft) + call rg_pseti (pm, NYFFT, nyfft) + + imfft = rg_pstatp (pm, IMFFT) + if (imfft != NULL) + call mfree (imfft, TY_REAL) + call calloc (imfft, 2 * nxfft * nyfft, TY_REAL) + call rg_psetp (pm, IMFFT, imfft) + + # Allocate space for the fft. + fft = rg_pstatp (pm, FFT) + if (fft != NULL) + call mfree (fft, TY_REAL) + call calloc (fft, 2 * nxfft * nyfft, TY_REAL) + call rg_psetp (pm, FFT, fft) + + if (newref == YES) { + + reffft = rg_pstatp (pm, REFFFT) + if (reffft != NULL) + call mfree (reffft, TY_REAL) + call calloc (reffft, 2 * nxfft * nyfft, TY_REAL) + call rg_psetp (pm, REFFFT, reffft) + + # Load the reference image FFT. + call rg_rload (Memr[rbuf], nrcols, nrlines, Memr[fft], nxfft, + nyfft) + + # Load the input image FFT. + call rg_iload (Memr[ibuf], nrcols, nrlines, Memr[fft], nxfft, + nyfft) + + # Shift the data for easy of filtering. + call rg_fshift (Memr[fft], Memr[fft], 2 * nxfft, nyfft) + + # Compute the Fourier Transform of the reference and input image + # data. + Memi[dim] = nxfft + Memi[dim+1] = nyfft + if (Memi[dim+1] == 1) + call rg_fourn (Memr[fft], Memi[dim], 1, 1) + else + call rg_fourn (Memr[fft], Memi[dim], 2, 1) + + # Compute the flux ratio between the two data sets. + if (IS_INDEFR(rg_pstatr(pm, UFLUXRATIO))) + call rg_psetr (pm, FLUXRATIO, rg_pg2norm (Memr[fft], + 2 * nxfft, nyfft)) + else + call rg_psetr (pm, FLUXRATIO, rg_pstatr(pm, UFLUXRATIO)) + + # Separate the two transforms and compute the division. + call rg_pdivfft (Memr[fft], Memr[reffft], Memr[imfft], Memr[fft], + 2 * nxfft, nyfft) + + } else { + + # Get the reference image FFT. + reffft = rg_pstatp (pm, REFFFT) + + # Load the input image FFT. + call rg_rload (Memr[ibuf], nrcols, nrlines, Memr[imfft], nxfft, + nyfft) + + # Shift the data for easy of filtering. + call rg_fshift (Memr[imfft], Memr[imfft], 2 * nxfft, nyfft) + + # Compute the Fourier Transform of the input image data. + Memi[dim] = nxfft + Memi[dim+1] = nyfft + if (Memi[dim+1] == 1) + call rg_fourn (Memr[imfft], Memi[dim], 1, 1) + else + call rg_fourn (Memr[imfft], Memi[dim], 2, 1) + + # Compute the flux ratio between the two data sets. + if (IS_INDEFR(rg_pstatr(pm, UFLUXRATIO))) + call rg_psetr (pm, FLUXRATIO, rg_pg1norm (Memr[reffft], + 2 * nxfft, nyfft) / rg_pg1norm (Memr[imfft], 2 * nxfft, + nyfft)) + else + call rg_psetr (pm, FLUXRATIO, rg_pstatr(pm, UFLUXRATIO)) + + # Divide the two functions. + call adivx (Memr[reffft], Memr[imfft], Memr[fft], nxfft * nyfft) + + } + + # Normalize the FFT. + call rg_pnorm (Memr[fft], nxfft, nyfft, rg_pstatr (pm, FLUXRATIO)) + + # Free the data buffers. + if (rbuf != NULL) + call mfree (rbuf, TY_REAL) + if (ibuf != NULL) + call mfree (ibuf, TY_REAL) + + call sfree (sp) + + return (OK) +end + + +# RG_KGET -- Read in the convolution kernel. + +int procedure rg_kget (pm, imk) + +pointer pm #I pointer to the psfmatch structure +pointer imk #I pointer to the kernel image + +int nrlines +pointer conv +pointer rg_pstatp(), rg_pgdata() + +begin + if (IM_NDIM(imk) == 1) + nrlines = 1 + else + nrlines = IM_LEN(imk,2) + conv = rg_pstatp (pm, CONV) + if (conv != NULL) + call mfree (conv, TY_REAL) + conv = rg_pgdata (imk, 1, int(IM_LEN(imk,1)), 1, nrlines) + call rg_psetp (pm, CONV, conv) + + return (OK) +end + + +# RG_PFILTER -- Procedure to filter the FFT in frequency space. + +procedure rg_pfilter (pm) + +pointer pm #I pointer to the psf matching structure + +pointer sp, dim, psfft, conv +real nfactor +int rg_pstati() +pointer rg_pstatp() +real rg_pstatr(), asumr() + +begin + call smark (sp) + call salloc (dim, 2, TY_INT) + + # Allocate space for the fourier spectrum. + if (rg_pstatp (pm, ASFFT) != NULL) + call mfree (rg_pstatp (pm, ASFFT), TY_REAL) + call calloc (psfft, rg_pstati (pm, NXFFT) * rg_pstati (pm, NYFFT), + TY_REAL) + call rg_psetp (pm, ASFFT, psfft) + + # Allocate space for the convolution kernel. + if (rg_pstatp (pm, CONV) != NULL) + call mfree (rg_pstatp (pm, CONV), TY_REAL) + call malloc (conv, 2 * rg_pstati (pm, NXFFT) * rg_pstati (pm, NYFFT), + TY_REAL) + call rg_psetp (pm, CONV, conv) + call amovr (Memr[rg_pstatp(pm,FFT)], Memr[rg_pstatp(pm,CONV)], + 2 * rg_pstati (pm, NXFFT) * rg_pstati (pm, NYFFT)) + +# # Compute the zextend parameter. +# call rg_psetr (pm, THRESHOLD, rg_pstatr (pm, PRATIO) * +# rg_gnorm (Memr[rg_pstatp(pm,IMFFT)], rg_pstati(pm,NXFFT), +# rg_pstati(pm,NYFFT))) + + # Filter the frequency spectrum. + switch (rg_pstati(pm,FILTER)) { + case PM_FCOSBELL: + call rg_pcosbell (Memr[rg_pstatp(pm,CONV)], rg_pstati (pm, NXFFT), + rg_pstati (pm, NYFFT), rg_pstatr (pm, SXINNER), rg_pstatr (pm, + SXOUTER), rg_pstatr (pm, SYINNER), rg_pstatr (pm, SYOUTER), + rg_pstati (pm, RADSYM)) + case PM_FREPLACE: + call rg_preplace (Memr[rg_pstatp(pm,CONV)], Memr[rg_pstatp(pm, + IMFFT)], rg_pstati (pm, NXFFT), rg_pstati (pm, NYFFT), + rg_pstatr (pm,THRESHOLD), rg_pstatr (pm,FLUXRATIO)) + case PM_FMODEL: + call rg_pgmodel (Memr[rg_pstatp(pm,CONV)], Memr[rg_pstatp(pm, + IMFFT)], rg_pstati (pm, NXFFT), rg_pstati (pm, NYFFT), + rg_pstatr (pm, THRESHOLD), rg_pstatr (pm, FLUXRATIO)) + default: + ; + } + + # Filter out any values greater than the normalization. + call rg_pnormfilt (Memr[rg_pstatp(pm,CONV)], rg_pstati(pm,NXFFT), + rg_pstati(pm,NYFFT), rg_pstatr (pm, FLUXRATIO)) + + # Compute the fourier spectrum. + call rg_pfourier (Memr[rg_pstatp(pm,CONV)], Memr[rg_pstatp(pm,ASFFT)], + rg_pstati(pm,NXFFT), rg_pstati(pm,NYFFT)) + + Memi[dim] = rg_pstati (pm, NXFFT) + Memi[dim+1] = rg_pstati (pm, NYFFT) + call rg_fshift (Memr[rg_pstatp(pm,CONV)], Memr[rg_pstatp(pm,CONV)], + 2 * rg_pstati(pm, NXFFT), rg_pstati(pm, NYFFT)) + call rg_fourn (Memr[rg_pstatp(pm,CONV)], Memi[dim], 2, -1) + call rg_fshift (Memr[rg_pstatp(pm,CONV)], Memr[rg_pstatp(pm,CONV)], + 2 * rg_pstati(pm, NXFFT), rg_pstati(pm, NYFFT)) + call adivkr (Memr[rg_pstatp(pm,CONV)], real (rg_pstati(pm,NXFFT) * + rg_pstati(pm,NYFFT)), Memr[rg_pstatp(pm,CONV)], 2 * rg_pstati(pm, + NXFFT) * rg_pstati(pm,NYFFT)) + + # Unpack the convolution kernel. + call rg_movexr (Memr[rg_pstatp(pm,CONV)], rg_pstati(pm,NXFFT), + rg_pstati(pm,NYFFT), Memr[rg_pstatp(pm,CONV)], rg_pstati(pm,KNX), + rg_pstati(pm,KNY)) + + # Normalize the kernel. + if (! IS_INDEFR(rg_pstatr (pm, NORMFACTOR))) { + nfactor = rg_pstatr (pm, NORMFACTOR) / asumr (Memr[rg_pstatp(pm, + CONV)], rg_pstati (pm, KNX) * rg_pstati(pm,KNY)) + call amulkr (Memr[rg_pstatp (pm,CONV)], nfactor, + Memr[rg_pstatp(pm, CONV)], rg_pstati (pm, KNX) * + rg_pstati (pm, KNY)) + } + + # Reallocate the convolution kernel array + #conv = rg_pstatp (pm, CONV) + #if (conv != NULL) { + #call realloc (conv, rg_pstati(pm, KNX) * rg_pstati(pm, KNY), + #TY_REAL) + #call rg_psetp (pm, CONV, conv) + #} + + call sfree (sp) +end + + +# RG_PGDATA -- Fill a buffer from a specified region of the image. + +pointer procedure rg_pgdata (im, c1, c2, l1, l2) + +pointer im #I pointer to the iraf image +int c1, c2 #I column limits in the input image +int l1, l2 #I line limits in the input image + +int i, ncols, nlines, npts +pointer ptr, index, buf +pointer imgs1r(), imgs2r() + +begin + ncols = c2 - c1 + 1 + nlines = l2 - l1 + 1 + npts = ncols * nlines + call malloc (ptr, npts, TY_REAL) + + index = ptr + do i = l1, l2 { + if (IM_NDIM(im) == 1) + buf = imgs1r (im, c1, c2) + else + buf = imgs2r (im, c1, c2, i, i) + call amovr (Memr[buf], Memr[index], ncols) + index = index + ncols + } + + return (ptr) +end + + +# RG_PNSUM -- Compute the total intensity in the subtracted subraster. + +real procedure rg_pnsum (data, ncols, nlines, nxdata, nydata) + +real data[ncols,nlines] #I the input data subraster +int ncols, nlines #I the size of the input subraster +int nxdata, nydata #I the size of the data region + +int j, wxborder, wyborder, npts +real sum +bool fp_equalr() +real asumr() + +begin + wxborder = (ncols - nxdata) / 2 + wyborder = (nlines - nydata) / 2 + + sum = 0.0 + npts = 0 + do j = 1 + wyborder, nlines - wyborder { + sum = sum + asumr (data[1+wxborder,j], nxdata) + npts = npts + nxdata + } + if (npts <= 0 || fp_equalr (sum, 0.0)) + return (INDEFR) + else + return (sum) +end + + +# RG_PWRITE -- Save the convolution kernel and the fourier spectrum of the +# convolution kernel in an image. + +procedure rg_pwrite (pm, imk, imf) + +pointer pm #I pointer to psf matching structure +pointer imk #I pointer to kernel image +pointer imf #I pointer to fourier spectrum image + +int nx, ny +pointer buf +int rg_pstati() +pointer rg_pstatp(), imps2r() + +begin + # Write out the kernel image. + if (imk != NULL && rg_pstatp(pm, CONV) != NULL) { + nx = rg_pstati (pm, KNX) + ny = rg_pstati (pm, KNY) + IM_NDIM(imk) = 2 + IM_LEN(imk,1) = nx + IM_LEN(imk,2) = ny + IM_PIXTYPE(imk) = TY_REAL + buf = imps2r (imk, 1, nx, 1, ny) + if (rg_pstatp (pm, CONV) != NULL) + call amovr (Memr[rg_pstatp(pm,CONV)], Memr[buf], nx * ny) + else + call amovkr (0.0, Memr[buf], nx * ny) + } + + # Write out the fourier spectrum. + if (imf != NULL && rg_pstatp(pm,ASFFT) != NULL) { + nx = rg_pstati (pm, NXFFT) + ny = rg_pstati (pm, NYFFT) + IM_NDIM(imf) = 2 + IM_LEN(imf,1) = nx + IM_LEN(imf,2) = ny + IM_PIXTYPE(imf) = TY_REAL + buf = imps2r (imf, 1, nx, 1, ny) + if (rg_pstatp (pm, CONV) != NULL) + call amovr (Memr[rg_pstatp(pm,ASFFT)], Memr[buf], nx * ny) + else + call amovkr (0.0, Memr[buf], nx * ny) + } +end + diff --git a/pkg/images/immatch/src/psfmatch/rgpshow.x b/pkg/images/immatch/src/psfmatch/rgpshow.x new file mode 100644 index 00000000..c94349a6 --- /dev/null +++ b/pkg/images/immatch/src/psfmatch/rgpshow.x @@ -0,0 +1,116 @@ +include "psfmatch.h" + +# RG_PSHOW -- Print the PSFMATCH task parameters. + +procedure rg_pshow (pm) + +pointer pm #I pointer to psfmatch structure + +pointer sp, str +bool itob() +int rg_pstati() +real rg_pstatr() + +begin + call smark (sp) + call salloc (str, SZ_LINE, TY_CHAR) + + call rg_pstats (pm, CSTRING, Memc[str], SZ_FNAME) + call printf ("\nConvolution: %s\n") + call pargstr (Memc[str]) + if (rg_pstati (pm, CONVOLUTION) == PM_CONIMAGE) { + call rg_pstats (pm, IMAGE, Memc[str], SZ_FNAME) + call printf (" %s: %s\n") + call pargstr (KY_IMAGE) + call pargstr (Memc[str]) + call rg_pstats (pm, REFIMAGE, Memc[str], SZ_FNAME) + call printf (" %s: %s\n") + call pargstr (KY_REFIMAGE) + call pargstr (Memc[str]) + call rg_pstats (pm, PSFDATA, Memc[str], SZ_FNAME) + call printf (" %s: %s\n") + call pargstr (KY_PSFDATA) + call pargstr (Memc[str]) + } else if (rg_pstati (pm, CONVOLUTION) == PM_CONPSF) { + call rg_pstats (pm, IMAGE, Memc[str], SZ_FNAME) + call printf (" %s: %s\n") + call pargstr (KY_IMAGE) + call pargstr (Memc[str]) + call rg_pstats (pm, PSFIMAGE, Memc[str], SZ_FNAME) + call printf (" input psf: %s\n") + call pargstr (Memc[str]) + call rg_pstats (pm, REFIMAGE, Memc[str], SZ_FNAME) + call printf (" reference psf: %s\n") + call pargstr (Memc[str]) + } else { + call rg_pstats (pm, IMAGE, Memc[str], SZ_FNAME) + call printf (" %s: %s\n") + call pargstr (KY_IMAGE) + call pargstr (Memc[str]) + } + + call rg_pstats (pm, KERNEL, Memc[str], SZ_FNAME) + call printf (" %s: %s\n") + call pargstr (KY_KERNEL) + call pargstr (Memc[str]) + call rg_pstats (pm, OUTIMAGE, Memc[str], SZ_FNAME) + if (Memc[str] != EOS) { + call printf (" %s: %s\n") + call pargstr (KY_OUTIMAGE) + call pargstr (Memc[str]) + } + + call printf ("Centering and background fitting\n") + call printf (" %s: %b\n") + call pargstr (KY_CENTER) + call pargb (itob(rg_pstati(pm,CENTER))) + call rg_pstats (pm, BSTRING, Memc[str], SZ_LINE) + call printf (" %s: %s\n") + call pargstr (KY_BACKGRD) + call pargstr (Memc[str]) + call printf (" %s = %g %s = %g\n") + call pargstr (KY_LOREJECT) + call pargr (rg_pstatr (pm, LOREJECT)) + call pargstr (KY_HIREJECT) + call pargr (rg_pstatr (pm, HIREJECT)) + call printf (" %s = %g\n") + call pargstr (KY_APODIZE) + call pargr (rg_pstatr (pm, APODIZE)) + + call printf ("Filtering:\n") + call rg_pstats (pm, FSTRING, Memc[str], SZ_LINE) + call printf (" %s: %s\n") + call pargstr (KY_FILTER) + call pargstr (Memc[str]) + if (rg_pstati(pm,FILTER) == PM_FCOSBELL) { + call printf (" %s: %g %s: %g\n") + call pargstr (KY_SXINNER) + call pargr (rg_pstatr (pm, SXINNER)) + call pargstr (KY_SXOUTER) + call pargr (rg_pstatr (pm, SXOUTER)) + call printf (" %s: %g %s: %g\n") + call pargstr (KY_SYINNER) + call pargr (rg_pstatr (pm, SYINNER)) + call pargstr (KY_SYOUTER) + call pargr (rg_pstatr (pm, SYOUTER)) + call printf (" %s: %b\n") + call pargstr (KY_RADSYM) + call pargb (itob(rg_pstati(pm,RADSYM))) + } else { + call printf (" %s: %g\n") + call pargstr (KY_UFLUXRATIO) + call pargr (rg_pstatr (pm, UFLUXRATIO)) + call printf (" %s: %g\n") + call pargstr (KY_THRESHOLD) + call pargr (rg_pstatr(pm,THRESHOLD)) + } + + call printf ("Normalization\n") + call printf (" %s: %g\n") + call pargstr (KY_NORMFACTOR) + call pargr (rg_pstatr (pm, NORMFACTOR)) + + call printf ("\n") + + call sfree (sp) +end diff --git a/pkg/images/immatch/src/psfmatch/rgptools.x b/pkg/images/immatch/src/psfmatch/rgptools.x new file mode 100644 index 00000000..df36c166 --- /dev/null +++ b/pkg/images/immatch/src/psfmatch/rgptools.x @@ -0,0 +1,641 @@ +include "psfmatch.h" + +# RG_PINIT -- Initialize the main psfmatch data structure. + +procedure rg_pinit (pm, cfunc) + +pointer pm #O pointer to psfmatch structure +int cfunc #I mode of computing the convolution function + +begin + call malloc (pm, LEN_PSFSTRUCT, TY_STRUCT) + + # Initialize the pointers. + PM_RC1(pm) = NULL + PM_RC2(pm) = NULL + PM_RL1(pm) = NULL + PM_RL2(pm) = NULL + PM_RZERO(pm) = NULL + PM_RXSLOPE(pm) = NULL + PM_RYSLOPE(pm) = NULL + PM_NREGIONS(pm) = 0 + PM_CNREGION(pm) = 1 + + # Define the background fitting parameters. + PM_CENTER(pm) = DEF_CENTER + PM_BACKGRD(pm) = DEF_BACKGRD + PM_BVALUER(pm) = 0.0 + PM_BVALUE(pm) = 0.0 + call strcpy ("median", PM_BSTRING(pm), SZ_FNAME) + PM_LOREJECT(pm) = DEF_LOREJECT + PM_HIREJECT(pm) = DEF_HIREJECT + PM_APODIZE(pm) = 0.0 + + PM_UFLUXRATIO(pm) = DEF_UFLUXRATIO + PM_FILTER(pm) = DEF_FILTER + call strcpy ("replace", PM_FSTRING(pm), SZ_FNAME) + PM_SXINNER(pm) = DEF_SXINNER + PM_SXOUTER(pm) = DEF_SXOUTER + PM_SYINNER(pm) = DEF_SYINNER + PM_SYOUTER(pm) = DEF_SYOUTER + PM_RADSYM(pm) = DEF_RADSYM + PM_THRESHOLD(pm) = DEF_THRESHOLD + + PM_NORMFACTOR(pm) = DEF_NORMFACTOR + + PM_CONVOLUTION(pm) = cfunc + switch (cfunc) { + case PM_CONIMAGE: + PM_CONVOLUTION(pm) = PM_CONIMAGE + call strcpy ("image", PM_CSTRING(pm), SZ_FNAME) + case PM_CONPSF: + PM_CONVOLUTION(pm) = PM_CONPSF + call strcpy ("psf", PM_CSTRING(pm), SZ_FNAME) + case PM_CONKERNEL: + PM_CONVOLUTION(pm) = PM_CONKERNEL + call strcpy ("kernel", PM_CSTRING(pm), SZ_FNAME) + default: + PM_CONVOLUTION(pm) = PM_CONIMAGE + call strcpy ("image", PM_CSTRING(pm), SZ_FNAME) + } + PM_DNX(pm) = DEF_DNX + PM_DNY(pm) = DEF_DNY + PM_PNX(pm) = DEF_PNX + PM_PNY(pm) = DEF_PNY + PM_KNX(pm) = 0 + PM_KNY(pm) = 0 + PM_POWER(pm) = DEF_POWER + + PM_REFFFT(pm) = NULL + PM_IMFFT(pm) = NULL + PM_FFT(pm) = NULL + PM_CONV(pm) = NULL + PM_ASFFT(pm) = NULL + PM_NXFFT(pm) = 0 + PM_NYFFT(pm) = 0 + + # Initialize the strings. + PM_IMAGE(pm) = EOS + PM_REFIMAGE(pm) = EOS + PM_PSFDATA(pm) = EOS + PM_PSFIMAGE(pm) = EOS + PM_OBJLIST(pm) = EOS + PM_KERNEL(pm) = EOS + PM_OUTIMAGE(pm) = EOS + + # Initialize the buffers. + call rg_prinit (pm) +end + + +# RG_PRINIT -- Initialize the regions definition portion of the psf matching +# code fitting structure. + +procedure rg_prinit (pm) + +pointer pm #I pointer to psfmatch structure + +begin + call rg_prfree (pm) + + PM_NREGIONS(pm) = 0 + PM_CNREGION(pm) = 1 + + call malloc (PM_RC1(pm), MAX_NREGIONS, TY_INT) + call malloc (PM_RC2(pm), MAX_NREGIONS, TY_INT) + call malloc (PM_RL1(pm), MAX_NREGIONS, TY_INT) + call malloc (PM_RL2(pm), MAX_NREGIONS, TY_INT) + call malloc (PM_RZERO(pm), MAX_NREGIONS, TY_REAL) + call malloc (PM_RXSLOPE(pm), MAX_NREGIONS, TY_REAL) + call malloc (PM_RYSLOPE(pm), MAX_NREGIONS, TY_REAL) + + call amovki (INDEFI, Memi[PM_RC1(pm)], MAX_NREGIONS) + call amovki (INDEFI, Memi[PM_RC2(pm)], MAX_NREGIONS) + call amovki (INDEFI, Memi[PM_RL1(pm)], MAX_NREGIONS) + call amovki (INDEFI, Memi[PM_RL2(pm)], MAX_NREGIONS) + call amovkr (INDEFR, Memr[PM_RZERO(pm)], MAX_NREGIONS) + call amovkr (INDEFR, Memr[PM_RXSLOPE(pm)], MAX_NREGIONS) + call amovkr (INDEFR, Memr[PM_RYSLOPE(pm)], MAX_NREGIONS) +end + + +# RG_PINDEFR -- Re-initialize the background and answers regions portion of +# the psf-matching structure. + +procedure rg_pindefr (pm) + +pointer pm #I pointer to the psfmatch structure + +int nregions +int rg_pstati () + +begin + nregions = rg_pstati (pm, NREGIONS) + + if (nregions > 0) { + call amovkr (INDEFR, Memr[PM_RZERO(pm)], nregions) + call amovkr (INDEFR, Memr[PM_RXSLOPE(pm)], nregions) + call amovkr (INDEFR, Memr[PM_RYSLOPE(pm)], nregions) + } +end + + +# RG_PREALLOC -- Reallocate the regions buffers and initialize if necessary. + +procedure rg_prealloc (pm, nregions) + +pointer pm #I pointer to psfmatch structure +int nregions #I number of regions + +int nr +int rg_pstati() + +begin + nr = rg_pstati (pm, NREGIONS) + + call realloc (PM_RC1(pm), nregions, TY_INT) + call realloc (PM_RC2(pm), nregions, TY_INT) + call realloc (PM_RL1(pm), nregions, TY_INT) + call realloc (PM_RL2(pm), nregions, TY_INT) + call realloc (PM_RZERO(pm), nregions, TY_REAL) + call realloc (PM_RXSLOPE(pm), nregions, TY_REAL) + call realloc (PM_RYSLOPE(pm), nregions, TY_REAL) + + call amovki (INDEFI, Memi[PM_RC1(pm)+nr], nregions - nr) + call amovki (INDEFI, Memi[PM_RC2(pm)+nr], nregions - nr) + call amovki (INDEFI, Memi[PM_RL1(pm)+nr], nregions - nr) + call amovki (INDEFI, Memi[PM_RL2(pm)+nr], nregions - nr) + call amovkr (INDEFR, Memr[PM_RZERO(pm)+nr], nregions - nr) + call amovkr (INDEFR, Memr[PM_RXSLOPE(pm)+nr], nregions - nr) + call amovkr (INDEFR, Memr[PM_RYSLOPE(pm)+nr], nregions - nr) + #call amovkr (INDEFR, Memr[PM_XSHIFTS(pm)+nr], nregions - nr) + #call amovkr (INDEFR, Memr[PM_YSHIFTS(pm)+nr], nregions - nr) +end + + +# RG_PRFREE -- Free the regions portion of the psfmatch structure. + +procedure rg_prfree (pm) + +pointer pm #I/O pointer to psfmatch structure + +begin + call rg_pseti (pm, NREGIONS, 0) + if (PM_RC1(pm) != NULL) + call mfree (PM_RC1(pm), TY_INT) + PM_RC1(pm) = NULL + if (PM_RC2(pm) != NULL) + call mfree (PM_RC2(pm), TY_INT) + PM_RC2(pm) = NULL + if (PM_RL1(pm) != NULL) + call mfree (PM_RL1(pm), TY_INT) + PM_RL1(pm) = NULL + if (PM_RL2(pm) != NULL) + call mfree (PM_RL2(pm), TY_INT) + PM_RL2(pm) = NULL + if (PM_RZERO(pm) != NULL) + call mfree (PM_RZERO(pm), TY_REAL) + PM_RZERO(pm) = NULL + if (PM_RXSLOPE(pm) != NULL) + call mfree (PM_RXSLOPE(pm), TY_REAL) + PM_RXSLOPE(pm) = NULL + if (PM_RYSLOPE(pm) != NULL) + call mfree (PM_RYSLOPE(pm), TY_REAL) + PM_RYSLOPE(pm) = NULL +end + + +# RG_PFREE -- Free the psfmatch structure. + +procedure rg_pfree (pm) + +pointer pm #I pointer to psfmatch structure + +begin + # Free the region descriptors + call rg_prfree (pm) + + if (PM_REFFFT(pm) != NULL) + call mfree (PM_REFFFT(pm), TY_REAL) + if (PM_IMFFT(pm) != NULL) + call mfree (PM_IMFFT(pm), TY_REAL) + if (PM_FFT(pm) != NULL) + call mfree (PM_FFT(pm), TY_REAL) + if (PM_CONV(pm) != NULL) + call mfree (PM_CONV(pm), TY_REAL) + if (PM_ASFFT(pm) != NULL) + call mfree (PM_ASFFT(pm), TY_REAL) + + call mfree (pm, TY_STRUCT) +end + + +# RG_PSTATI -- Fetch the value of a psfmatch task integer parameter. + +int procedure rg_pstati (pm, param) + +pointer pm # pointer to psfmatch structure +int param # parameter to be fetched + +begin + switch (param) { + case NREGIONS: + return (PM_NREGIONS(pm)) + case CNREGION: + return (PM_CNREGION(pm)) + case CENTER: + return (PM_CENTER(pm)) + case BACKGRD: + return (PM_BACKGRD(pm)) + case CONVOLUTION: + return (PM_CONVOLUTION(pm)) + case DNX: + return (PM_DNX(pm)) + case DNY: + return (PM_DNY(pm)) + case PNX: + return (PM_PNX(pm)) + case PNY: + return (PM_PNY(pm)) + case KNX: + return (PM_KNX(pm)) + case KNY: + return (PM_KNY(pm)) + case POWER: + return (PM_POWER(pm)) + + case FILTER: + return (PM_FILTER(pm)) + case RADSYM: + return (PM_RADSYM(pm)) + + case NXFFT: + return (PM_NXFFT(pm)) + case NYFFT: + return (PM_NYFFT(pm)) + + default: + call error (0, "RG_PSTATI: Unknown integer parameter.") + } +end + + +# RG_PSTATP -- Fetch the value of a psfmatch task pointer parameter. + +pointer procedure rg_pstatp (pm, param) + +pointer pm # pointer to psfmatch structure +int param # parameter to be fetched + +begin + switch (param) { + case RC1: + return (PM_RC1(pm)) + case RC2: + return (PM_RC2(pm)) + case RL1: + return (PM_RL1(pm)) + case RL2: + return (PM_RL2(pm)) + case RZERO: + return (PM_RZERO(pm)) + case RXSLOPE: + return (PM_RXSLOPE(pm)) + case RYSLOPE: + return (PM_RYSLOPE(pm)) + case REFFFT: + return (PM_REFFFT(pm)) + case IMFFT: + return (PM_IMFFT(pm)) + case FFT: + return (PM_FFT(pm)) + case CONV: + return (PM_CONV(pm)) + case ASFFT: + return (PM_ASFFT(pm)) + default: + call error (0, "RG_PSTATP: Unknown pointer parameter.") + } +end + + +# RG_PSTATR -- Fetch the value of a psfmath task real parameter. + +real procedure rg_pstatr (pm, param) + +pointer pm # pointer to psfmatch structure +int param # parameter to be fetched + +begin + switch (param) { + case BVALUER: + return (PM_BVALUER(pm)) + case BVALUE: + return (PM_BVALUE(pm)) + case APODIZE: + return (PM_APODIZE(pm)) + case LOREJECT: + return (PM_LOREJECT(pm)) + case HIREJECT: + return (PM_HIREJECT(pm)) + case UFLUXRATIO: + return (PM_UFLUXRATIO(pm)) + case FLUXRATIO: + return (PM_FLUXRATIO(pm)) + case SXINNER: + return (PM_SXINNER(pm)) + case SXOUTER: + return (PM_SXOUTER(pm)) + case SYINNER: + return (PM_SYINNER(pm)) + case SYOUTER: + return (PM_SYOUTER(pm)) + case THRESHOLD: + return (PM_THRESHOLD(pm)) + case NORMFACTOR: + return (PM_NORMFACTOR(pm)) + default: + call error (0, "RG_PSTATR: Unknown real parameter.") + } +end + + +# RG_PSTATS -- Fetch the value of a psfmatch string string parameter. + +procedure rg_pstats (pm, param, str, maxch) + +pointer pm # pointer to psfmatch structure +int param # parameter to be fetched +char str[ARB] # output string +int maxch # maximum number of characters + +begin + switch (param) { + case BSTRING: + call strcpy (PM_BSTRING(pm), str, maxch) + case CSTRING: + call strcpy (PM_CSTRING(pm), str, maxch) + case FSTRING: + call strcpy (PM_FSTRING(pm), str, maxch) + case IMAGE: + call strcpy (PM_IMAGE(pm), str, maxch) + case REFIMAGE: + call strcpy (PM_REFIMAGE(pm), str, maxch) + case PSFDATA: + call strcpy (PM_PSFDATA(pm), str, maxch) + case PSFIMAGE: + call strcpy (PM_PSFIMAGE(pm), str, maxch) + case OBJLIST: + call strcpy (PM_OBJLIST(pm), str, maxch) + case KERNEL: + call strcpy (PM_KERNEL(pm), str, maxch) + case OUTIMAGE: + call strcpy (PM_OUTIMAGE(pm), str, maxch) + default: + call error (0, "RG_PSTATS: Unknown string parameter.") + } +end + + +# RG_PSETI -- Set the value of a psfmatch task integer parameter. + +procedure rg_pseti (pm, param, value) + +pointer pm # pointer to psfmatch structure +int param # parameter to be fetched +int value # value of the integer parameter + +begin + switch (param) { + case NREGIONS: + PM_NREGIONS(pm) = value + case CNREGION: + PM_CNREGION(pm) = value + case CENTER: + PM_CENTER(pm) = value + case BACKGRD: + PM_BACKGRD(pm) = value + switch (value) { + case PM_BNONE: + call strcpy ("none", PM_BSTRING(pm), SZ_FNAME) + case PM_BMEAN: + call strcpy ("mean", PM_BSTRING(pm), SZ_FNAME) + case PM_BMEDIAN: + call strcpy ("median", PM_BSTRING(pm), SZ_FNAME) + case PM_BSLOPE: + call strcpy ("plane", PM_BSTRING(pm), SZ_FNAME) + case PM_BNUMBER: + ; + default: + call strcpy ("none", PM_BSTRING(pm), SZ_FNAME) + } + case CONVOLUTION: + PM_CONVOLUTION(pm) = value + switch (value) { + case PM_CONIMAGE: + call strcpy ("image", PM_CSTRING(pm), SZ_FNAME) + case PM_CONPSF: + call strcpy ("psf", PM_CSTRING(pm), SZ_FNAME) + case PM_CONKERNEL: + call strcpy ("kernel", PM_CSTRING(pm), SZ_FNAME) + default: + call strcpy ("image", PM_CSTRING(pm), SZ_FNAME) + } + case DNX: + PM_DNX(pm) = value + case DNY: + PM_DNY(pm) = value + case PNX: + PM_PNX(pm) = value + case PNY: + PM_PNY(pm) = value + case KNX: + PM_KNX(pm) = value + case KNY: + PM_KNY(pm) = value + case POWER: + PM_POWER(pm) = value + case RADSYM: + PM_RADSYM(pm) = value + case NXFFT: + PM_NXFFT(pm) = value + case NYFFT: + PM_NYFFT(pm) = value + case FILTER: + PM_FILTER(pm) = value + switch (value) { + case PM_FNONE: + call strcpy ("none", PM_FSTRING(pm), SZ_FNAME) + case PM_FCOSBELL: + call strcpy ("cosbell", PM_FSTRING(pm), SZ_FNAME) + case PM_FREPLACE: + call strcpy ("replace", PM_FSTRING(pm), SZ_FNAME) + case PM_FMODEL: + call strcpy ("model", PM_FSTRING(pm), SZ_FNAME) + default: + call strcpy ("none", PM_FSTRING(pm), SZ_FNAME) + } + default: + call error (0, "RG_PSETI: Unknown integer parameter.") + } +end + + +# RG_PSETP -- Set the value of a psfmatch task pointer parameter. + +procedure rg_psetp (pm, param, value) + +pointer pm # pointer to psfmatch structure +int param # parameter to be fetched +pointer value # value of the pointer parameter + +begin + switch (param) { + case RC1: + PM_RC1(pm) = value + case RC2: + PM_RC2(pm) = value + case RL1: + PM_RL1(pm) = value + case RL2: + PM_RL2(pm) = value + case RZERO: + PM_RZERO(pm) = value + case RXSLOPE: + PM_RXSLOPE(pm) = value + case RYSLOPE: + PM_RYSLOPE(pm) = value + case REFFFT: + PM_REFFFT(pm) = value + case IMFFT: + PM_IMFFT(pm) = value + case FFT: + PM_FFT(pm) = value + case CONV: + PM_CONV(pm) = value + case ASFFT: + PM_ASFFT(pm) = value + + default: + call error (0, "RG_PSETP: Unknown pointer parameter.") + } +end + + +# RG_PSETR -- Set the value of a psfmatch task real parameter. + +procedure rg_psetr (pm, param, value) + +pointer pm # pointer to psfmatch structure +int param # parameter to be fetched +real value # real parameter + +begin + switch (param) { + case BVALUER: + PM_BVALUER(pm) = value + case BVALUE: + PM_BVALUE(pm) = value + case LOREJECT: + PM_LOREJECT(pm) = value + case HIREJECT: + PM_HIREJECT(pm) = value + case APODIZE: + PM_APODIZE(pm) = value + case UFLUXRATIO: + PM_UFLUXRATIO(pm) = value + case FLUXRATIO: + PM_FLUXRATIO(pm) = value + case SXINNER: + PM_SXINNER(pm) = value + case SXOUTER: + PM_SXOUTER(pm) = value + case SYINNER: + PM_SYINNER(pm) = value + case SYOUTER: + PM_SYOUTER(pm) = value + case THRESHOLD: + PM_THRESHOLD(pm) = value + case NORMFACTOR: + PM_NORMFACTOR(pm) = value + default: + call error (0, "RG_PSETR: Unknown real parameter.") + } +end + + +# RG_PSETS -- Procedure to set the value of a string parameter. + +procedure rg_psets (pm, param, str) + +pointer pm # pointer to psfmatch structure +int param # parameter to be fetched +char str[ARB] # output string + +int index, ip +pointer sp, temp +real rval +int strdic(), fnldir(), ctor() + +begin + call smark (sp) + call salloc (temp, SZ_LINE, TY_CHAR) + + switch (param) { + case BSTRING: + ip = 1 + index = strdic (str, str, SZ_LINE, PM_BTYPES) + if (index > 0) { + call strcpy (str, PM_BSTRING(pm), SZ_FNAME) + call rg_pseti (pm, BACKGRD, index) + } else if (ctor (str, ip, rval) > 0) { + call rg_psetr (pm, BVALUE, rval) + if (ctor (str, ip, rval) > 0) { + call rg_psetr (pm, BVALUER, rval) + call strcpy (str, PM_BSTRING(pm), SZ_FNAME) + call rg_pseti (pm, BACKGRD, PM_NUMBER) + } else { + call rg_psetr (pm, BVALUE, 0.0) + call rg_psetr (pm, BVALUER, 0.0) + } + } + case CSTRING: + index = strdic (str, str, SZ_LINE, PM_CTYPES) + if (index > 0) { + call strcpy (str, PM_CSTRING(pm), SZ_FNAME) + call rg_pseti (pm, CONVOLUTION, index) + } + case FSTRING: + index = strdic (str, str, SZ_LINE, PM_FTYPES) + if (index > 0) { + call strcpy (str, PM_FSTRING(pm), SZ_FNAME) + call rg_pseti (pm, FILTER, index) + } + case IMAGE: + call imgcluster (str, Memc[temp], SZ_FNAME) + index = fnldir (Memc[temp], PM_IMAGE(pm), SZ_FNAME) + call strcpy (Memc[temp+index], PM_IMAGE(pm), SZ_FNAME) + case REFIMAGE: + call imgcluster (str, Memc[temp], SZ_FNAME) + index = fnldir (Memc[temp], PM_REFIMAGE(pm), SZ_FNAME) + call strcpy (Memc[temp+index], PM_REFIMAGE(pm), SZ_FNAME) + case PSFDATA: + call strcpy (str, PM_PSFDATA(pm), SZ_FNAME) + case PSFIMAGE: + call imgcluster (str, Memc[temp], SZ_FNAME) + index = fnldir (Memc[temp], PM_PSFIMAGE(pm), SZ_FNAME) + call strcpy (Memc[temp+index], PM_PSFIMAGE(pm), SZ_FNAME) + case OBJLIST: + call strcpy (str, PM_OBJLIST(pm), SZ_FNAME) + case KERNEL: + call imgcluster (str, Memc[temp], SZ_FNAME) + index = fnldir (Memc[temp], PM_KERNEL(pm), SZ_FNAME) + call strcpy (Memc[temp+index], PM_KERNEL(pm), SZ_FNAME) + case OUTIMAGE: + call strcpy (str, PM_OUTIMAGE(pm), SZ_FNAME) + default: + call error (0, "RG_PSETS: Unknown string parameter.") + } + + call sfree (sp) +end diff --git a/pkg/images/immatch/src/psfmatch/t_psfmatch.x b/pkg/images/immatch/src/psfmatch/t_psfmatch.x new file mode 100644 index 00000000..182ac286 --- /dev/null +++ b/pkg/images/immatch/src/psfmatch/t_psfmatch.x @@ -0,0 +1,365 @@ +include <fset.h> +include <imhdr.h> +include "psfmatch.h" + +# T_PSFMATCH -- Match the resolution of an image to that of a reference +# image. + +procedure t_psfmatch () + +pointer image1 # pointer to the input image name +pointer imager # pointer to the reference image name +pointer fpsflist # pointer to the regions list +pointer image2 # pointer to the output image name +pointer kernel # pointer to the kernel image name +pointer pspectra # pointer to the fourier spectra image name +int interactive # interactive mode ? +int verbose # verbose mode ? +int boundary # boundary extension type +real constant # constant for boundary extension + +int list1, listr, psflist, listk, list2 +int nregions, newref, stat +pointer sp, imtemp, str, pm, gd, id, imr, im1, impsf, imk, im2 +bool clgetb() +int imtopen(), imtlen(), imtgetim(), fntopnb(), fntlenb(), clgwrd(), btoi() +int rg_pstati(), rg_ptmpimage(), rg_pregions(), rg_psfm(), rg_pisfm() +pointer gopen(), immap(), rg_pstatp() +real clgetr() +errchk fntopnb(), fntclsb() + +begin + call fseti (STDOUT, F_FLUSHNL, YES) + + # Allocate temporary space. + call smark (sp) + call salloc (image1, SZ_FNAME, TY_CHAR) + call salloc (imager, SZ_FNAME, TY_CHAR) + call salloc (fpsflist, SZ_LINE, TY_CHAR) + call salloc (kernel, SZ_FNAME, TY_CHAR) + call salloc (image2, SZ_FNAME, TY_CHAR) + call salloc (pspectra, SZ_FNAME, TY_CHAR) + call salloc (imtemp, SZ_FNAME, TY_CHAR) + call salloc (str, SZ_LINE, TY_CHAR) + + # Get task parameters. + call clgstr ("input", Memc[str], SZ_LINE) + list1 = imtopen (Memc[str]) + call clgstr ("reference", Memc[str], SZ_LINE) + listr = imtopen (Memc[str]) + call clgstr ("psfdata", Memc[fpsflist], SZ_LINE) + call clgstr ("kernel", Memc[str], SZ_LINE) + listk = imtopen (Memc[str]) + call clgstr ("output", Memc[str], SZ_LINE) + list2 = imtopen (Memc[str]) + + # Open the psf matching fitting structure. + call rg_pgpars (pm) + + # Will the task run in interactive mode? + if (rg_pstati (pm, CONVOLUTION) == PM_CONKERNEL) + interactive = NO + else + interactive = btoi (clgetb ("interactive")) + + if (rg_pstati (pm, CONVOLUTION) != PM_CONKERNEL) { + if (imtlen (listr) <= 0) + call error (0, "The reference image list is empty.") + if (imtlen (listr) > 1 && imtlen (listr) != imtlen (list1)) + call error (0, + "The number of reference and input images is not the same.") + if (interactive == NO && Memc[fpsflist] == EOS) { + call error (0, "The objects list is empty.") + } else if (rg_pstati (pm, CONVOLUTION) == PM_CONIMAGE) { + psflist = fntopnb (Memc[fpsflist], NO) + if (fntlenb(psflist) > 0 && imtlen (listr) != fntlenb (psflist)) + call error (0, + "The number of reference images and objects lists is not the same") + } else { + psflist = imtopen (Memc[fpsflist]) + if (imtlen (list1) != imtlen (psflist)) + call error (0, + "The number of input and psf images is not the same") + } + call rg_psets (pm, PSFDATA, Memc[fpsflist]) + } else { + call imtclose (listr) + listr = NULL + psflist = NULL + call rg_psets (pm, PSFDATA, "") + } + + # Compare the lengths of the input and output lists. + if (imtlen(listk) <= 0) { + call imtclose (listk) + listk = NULL + } else if (imtlen (list1) != imtlen (listk)) + call error (0, + "The number of input and kernel images is not the same.") + + if (imtlen (list2) <= 0) { + call imtclose (list2) + list2 = NULL + } else if (imtlen (list1) != imtlen (list2)) + call error (0, + "The number of input and output images are not the same.") + + # Get the boundary extension parameters for the image convolution. + boundary = clgwrd ("boundary", Memc[str], SZ_LINE, + "|constant|nearest|reflect|wrap|") + constant = clgetr ("constant") + + if (interactive == YES) { + call clgstr ("graphics", Memc[str], SZ_FNAME) + iferr (gd = gopen (Memc[str], NEW_FILE, STDGRAPH)) + gd = NULL + call clgstr ("display", Memc[str], SZ_FNAME) + iferr (id = gopen (Memc[str], APPEND, STDIMAGE)) + id = NULL + verbose = YES + } else { + gd = NULL + id = NULL + verbose = btoi (clgetb ("verbose")) + } + + imr = NULL + impsf = NULL + + # Do each set of input and output images. + while ((imtgetim (list1, Memc[image1], SZ_FNAME) != EOF)) { + + # Open reference image and the associated objects file + if (rg_pstati (pm, CONVOLUTION) != PM_CONKERNEL) { + if (imtgetim (listr, Memc[imager], SZ_FNAME) != EOF) { + if (imr != NULL) + call imunmap (imr) + imr = immap (Memc[imager], READ_ONLY, 0) + if (IM_NDIM(imr) > 2) + call error (0, "Reference psf/image must be 1D or 2D") + call rg_psets (pm, REFIMAGE, Memc[imager]) + if (rg_pstati (pm, CONVOLUTION) == PM_CONIMAGE) { + nregions = rg_pregions (psflist, imr, pm, 1, NO) + if (nregions <= 0 && interactive == NO) + call error (0, "The objects list is empty.") + call rg_psets (pm, PSFIMAGE, "") + } + newref = YES + } + if (rg_pstati (pm, CONVOLUTION) == PM_CONPSF) { + if (imtgetim (psflist, Memc[str], SZ_FNAME) != EOF) { + impsf = immap (Memc[str], READ_ONLY, 0) + if (IM_NDIM(impsf) != IM_NDIM(imr)) + call error (0, + "Image and reference psf must have same dimensionality") + if (IM_LEN(impsf,1) != IM_LEN(imr,1)) + call error (0, + "Image and reference psf are not the same size") + if (IM_NDIM(impsf) == 2 && (IM_LEN(impsf,2) != + IM_LEN(imr,2))) + call error (0, + "Image and reference psf are not the same size") + call rg_psets (pm, PSFIMAGE, Memc[str]) + newref = YES + } + } + } else { + imr = NULL + impsf = NULL + call rg_psets (pm, REFIMAGE, "") + call rg_psets (pm, PSFIMAGE, "") + call rg_psets (pm, OBJLIST, "") + newref = NO + } + + # Open the input image. + im1 = immap (Memc[image1], READ_ONLY, 0) + if (IM_NDIM(im1) > 2) { + call error (0, "Input image must be 1D or 2D") + } else if (imr != NULL) { + if (IM_NDIM(im1) != IM_NDIM(imr)) + call error (0, + "Input and reference images must have same dimensionality") + } + call rg_psets (pm, IMAGE, Memc[image1]) + + # Open the kernel image name. + if (listk != NULL) { + if (imtgetim (listk, Memc[kernel], SZ_FNAME) != EOF) + ; + } else { + if (rg_ptmpimage (Memc[image1], "ker", "ker", Memc[kernel], + SZ_FNAME) == NO) + ; + } + if (rg_pstati (pm, CONVOLUTION) != PM_CONKERNEL) + imk = immap (Memc[kernel], NEW_IMAGE, 0) + else + imk = immap (Memc[kernel], READ_ONLY, 0) + call rg_psets (pm, KERNEL, Memc[kernel]) + + + # Construct the output image name. + if (list2 == NULL) { + im2 = NULL + Memc[image2] = NULL + } else if (imtgetim (list2, Memc[image2], SZ_FNAME) != EOF) { + call xt_mkimtemp (Memc[image1], Memc[image2], Memc[imtemp], + SZ_FNAME) + im2 = immap (Memc[image2], NEW_COPY, im1) + } else { + im2 = NULL + Memc[image2] = NULL + } + call rg_psets (pm, OUTIMAGE, Memc[image2]) + + # Compute the the psf matching kernel. + if (interactive == YES) { + stat = rg_pisfm (pm, imr, psflist, impsf, im1, imk, NULL, im2, + gd, id) + } else { + if (rg_psfm (pm, imr, im1, impsf, imk, newref) == OK) { + if (verbose == YES) { + call printf ( + "Completed computing/reading kernel %s for image %s\n") + call pargstr (Memc[kernel]) + call pargstr (Memc[image1]) + if (rg_pstati(pm, CONVOLUTION) != PM_CONKERNEL) + call rg_pwrite (pm, imk, NULL) + } + } else { + if (verbose == YES) { + call printf ( + "Error computing/reading kernel %s for image %s\n") + call pargstr (Memc[kernel]) + call pargstr (Memc[image1]) + } + } + stat = NO + } + + # Convolve the image. + if (im2 != NULL && stat == NO) { + if (verbose == YES) { + if (rg_pstatp(pm, CONV) != NULL) + call printf ( + "\tComputing matched image %s ...\n") + else + call printf ( + "\tComputing matched image %s ...\n") + call pargstr (Memc[imtemp]) + call pargstr (Memc[kernel]) + } + if (rg_pstatp(pm, CONV) != NULL) + call rg_pconvolve (im1, im2, Memr[rg_pstatp(pm,CONV)], + rg_pstati(pm,KNX), rg_pstati(pm,KNY), boundary, + constant) + } + + # Close up the images. + if (im2 != NULL) { + call imunmap (im2) + if (rg_pstatp(pm, CONV) == NULL) + call imdelete (Memc[image2]) + else + call xt_delimtemp (Memc[image2], Memc[imtemp]) + } + if (impsf != NULL) + call imunmap (impsf) + if (imk != NULL) { + call imunmap (imk) + if (rg_pstati (pm, CONVOLUTION) != PM_CONKERNEL && + rg_pstatp(pm, CONV) == NULL) + call imdelete (Memc[kernel]) + } + call imunmap (im1) + + if (stat == YES) + break + newref = NO + } + + # Close up the lists. + if (imr != NULL) + call imunmap (imr) + + if (list2 != NULL) + call imtclose (list2) + if (listk != NULL) + call imtclose (listk) + if (psflist != NULL) { + if (rg_pstati (pm, CONVOLUTION) == PM_CONIMAGE) + call fntclsb (psflist) + else + call imtclose (psflist) + } + if (listr != NULL) + call imtclose (listr) + call imtclose (list1) + + call rg_pfree (pm) + + # Close up te graphics and the display. + if (gd != NULL) + call gclose (gd) + if (id != NULL) + call gclose (id) + + call sfree (sp) +end + + +# RG_PTMPIMAGE -- Generate either a permanent image name using a user specified +# prefix or temporary image name using a default prefix. Return NO if the +# image is temporary or YES if it is permanent. + +int procedure rg_ptmpimage (image, prefix, tmp, name, maxch) + +char image[ARB] #I image name +char prefix[ARB] #I user supplied prefix +char tmp[ARB] #I user supplied temporary root +char name[ARB] #O output name +int maxch #I max number of chars + +int npref, ndir +int fnldir(), rg_pimroot(), strlen() + +begin + npref = strlen (prefix) + ndir = fnldir (prefix, name, maxch) + if (npref == ndir) { + call mktemp (tmp, name[ndir+1], maxch) + return (NO) + } else { + call strcpy (prefix, name, npref) + if (rg_pimroot (image, name[npref+1], maxch) <= 0) + ; + return (YES) + } +end + + +# RG_PIMROOT -- Fetch the root image name minus the directory specification +# and the section notation. The length of the root name is returned. + +int procedure rg_pimroot (image, root, maxch) + +char image[ARB] #I image specification +char root[ARB] #O rootname +int maxch #I maximum number of characters + +int nchars +pointer sp, str +int fnldir(), strlen() + +begin + call smark (sp) + call salloc (str, SZ_FNAME, TY_CHAR) + + call imgimage (image, root, maxch) + nchars = fnldir (root, Memc[str], maxch) + call strcpy (root[nchars+1], root, maxch) + + call sfree (sp) + return (strlen (root)) +end diff --git a/pkg/images/immatch/src/wcsmatch/mkpkg b/pkg/images/immatch/src/wcsmatch/mkpkg new file mode 100644 index 00000000..638ee1e8 --- /dev/null +++ b/pkg/images/immatch/src/wcsmatch/mkpkg @@ -0,0 +1,14 @@ +# Make the SKYXYMATCH / WCSXYMATCH / WCSCOPY tasks + +$checkout libpkg.a ../../../ +$update libpkg.a +$checkin libpkg.a ../../../ +$exit + +libpkg.a: + rgmatchio.x wcsxymatch.h + t_skyxymatch.x <fset.h> <imhdr.h> <mwset.h> <math.h> \ + <pkg/skywcs.h> wcsxymatch.h + t_wcscopy.x <imhdr.h> <mwset.h> + t_wcsxymatch.x <fset.h> <imhdr.h> <mwset.h> wcsxymatch.h + ; diff --git a/pkg/images/immatch/src/wcsmatch/rgmatchio.x b/pkg/images/immatch/src/wcsmatch/rgmatchio.x new file mode 100644 index 00000000..1a0de167 --- /dev/null +++ b/pkg/images/immatch/src/wcsmatch/rgmatchio.x @@ -0,0 +1,77 @@ +include "wcsxymatch.h" + +define DEF_BUFSIZE 200 + +# RG_RDXY -- Read in the x and y coordinates from a file. + +int procedure rg_rdxy (fd, x, y, wcs, xcolumn, ycolumn, xunits, yunits) + +int fd #I the input file descriptor +pointer x #U pointer to the x coordinates +pointer y #U pointer to the y coordinates +int wcs #I the world coordinate system +int xcolumn #I column containing the x coordinate +int ycolumn #I column containing the y coordinate +int xunits #I the x coordinate units +int yunits #I the y coordinate units + +double xval, yval +int i, ip, bufsize, maxcols, npts +pointer sp, str +int fscan(), nscan(), ctod() + +begin + call smark (sp) + call salloc (str, SZ_FNAME, TY_CHAR) + + bufsize = DEF_BUFSIZE + call malloc (x, bufsize, TY_DOUBLE) + call malloc (y, bufsize, TY_DOUBLE) + maxcols = max (xcolumn, ycolumn) + + npts = 0 + while (fscan(fd) != EOF) { + + xval = INDEFD + yval = INDEFD + do i = 1, maxcols { + call gargwrd (Memc[str], SZ_FNAME) + if (i != nscan()) + break + ip = 1 + if (i == xcolumn) { + if (ctod (Memc[str], ip, xval) <= 0) + xval = INDEFD + } else if (i == ycolumn) { + if (ctod (Memc[str], ip, yval) <= 0) + yval = INDEFD + } + } + if (IS_INDEFD(xval) || IS_INDEFD(yval)) + next + + Memd[x+npts] = xval + Memd[y+npts] = yval + npts = npts + 1 + if (npts >= bufsize) { + bufsize = bufsize + DEF_BUFSIZE + call realloc (x, bufsize, TY_DOUBLE) + call realloc (y, bufsize, TY_DOUBLE) + } + } + + # Convert the coordinates if necessary. + switch (wcs) { + case RG_WORLD: + if (xunits == RG_UHOURS) + call amulkd (Memd[x], 15.0d0, Memd[x], npts) + if (yunits == RG_UHOURS) + call amulkd (Memd[y], 15.0d0, Memd[y], npts) + default: + ; + } + + call sfree (sp) + + return (npts) +end diff --git a/pkg/images/immatch/src/wcsmatch/t_skyxymatch.x b/pkg/images/immatch/src/wcsmatch/t_skyxymatch.x new file mode 100644 index 00000000..533d36a8 --- /dev/null +++ b/pkg/images/immatch/src/wcsmatch/t_skyxymatch.x @@ -0,0 +1,690 @@ +include <fset.h> +include <imhdr.h> +include <mwset.h> +include <math.h> +include <pkg/skywcs.h> +include "wcsxymatch.h" + +# T_SKYXYMATCH -- Compute a list of the tie points required to register an +# image to a reference image using WCS information in the image headers and +# the celestial coordinate transformation routines. + +procedure t_skyxymatch() + +bool verbose +double xmin, xmax, ymin, ymax, x1, x2, y1, y2 +int ilist, rlist, olist, clist, cfd, ofd +int nx, ny, wcs, min_sigdigits, xcolumn, ycolumn, xunits, yunits +int rstat, stat, npts +pointer sp, refimage, image, xformat, yformat, rxformat, ryformat +pointer rwxformat, rwyformat, txformat, tyformat, twxformat, twyformat, str +pointer imr, im, mwr, mw, coor, coo, ctr, ct +pointer rxl, ryl, rxw, ryw, trxw, tryw, ixl, iyl + +bool clgetb(), streq() +double clgetd() +int imtopen(), fntopnb(), clgeti(), clgwrd(), strdic(), imtlen() +int fntlenb(), imtgetim(), fntgfnb(), open(), mw_stati(), sk_decim() +int rg_rdxy(), rg_xytoxy(), sk_stati() +pointer immap() +errchk mw_gwattrs() + +begin + # Get some temporary working space. + call smark (sp) + call salloc (refimage, SZ_FNAME, TY_CHAR) + call salloc (image, SZ_FNAME, TY_CHAR) + call salloc (xformat, SZ_FNAME, TY_CHAR) + call salloc (yformat, SZ_FNAME, TY_CHAR) + call salloc (rwxformat, SZ_FNAME, TY_CHAR) + call salloc (rwyformat, SZ_FNAME, TY_CHAR) + call salloc (rxformat, SZ_FNAME, TY_CHAR) + call salloc (ryformat, SZ_FNAME, TY_CHAR) + call salloc (twxformat, SZ_FNAME, TY_CHAR) + call salloc (twyformat, SZ_FNAME, TY_CHAR) + call salloc (txformat, SZ_FNAME, TY_CHAR) + call salloc (tyformat, SZ_FNAME, TY_CHAR) + call salloc (str, SZ_LINE, TY_CHAR) + + # Get the input image and output file lists. + call clgstr ("input", Memc[str], SZ_FNAME) + ilist = imtopen (Memc[str]) + call clgstr ("reference", Memc[str], SZ_FNAME) + rlist = imtopen (Memc[str]) + call clgstr ("output", Memc[str], SZ_FNAME) + if (Memc[str] == EOS) + call strcpy ("STDOUT", Memc[str], SZ_FNAME) + olist = fntopnb (Memc[str], NO) + + # Determine the source of the input coordinates. + call clgstr ("coords", Memc[str], SZ_FNAME) + if (streq (Memc[str], "grid")) { + clist = NULL + xmin = clgetd ("xmin") + xmax = clgetd ("xmax") + ymin = clgetd ("ymin") + ymax = clgetd ("ymax") + nx = clgeti ("nx") + ny = clgeti ("ny") + wcs = clgwrd ("wcs", Memc[str], SZ_FNAME, RG_WCSLIST) + } else { + clist = fntopnb (Memc[str], NO) + xmin = INDEFD + xmax = INDEFD + ymin = INDEFD + ymax = INDEFD + nx = clgeti ("nx") + ny = clgeti ("ny") + wcs = clgwrd ("wcs", Memc[str], SZ_FNAME, RG_WCSLIST) + xcolumn = clgeti ("xcolumn") + ycolumn = clgeti ("ycolumn") + call clgstr ("xunits", Memc[str], SZ_FNAME) + xunits = strdic (Memc[str], Memc[str], SZ_FNAME, RG_UNITLIST) + if (xunits <= 0) + xunits = RG_UNATIVE + call clgstr ("yunits", Memc[str], SZ_FNAME) + yunits = strdic (Memc[str], Memc[str], SZ_FNAME, RG_UNITLIST) + if (yunits <= 0) + yunits = RG_UNATIVE + } + + # Get the output coordinate formatting information. + call clgstr ("xformat", Memc[xformat], SZ_FNAME) + call clgstr ("yformat", Memc[yformat], SZ_FNAME) + call clgstr ("rwxformat", Memc[rxformat], SZ_FNAME) + call clgstr ("rwyformat", Memc[ryformat], SZ_FNAME) + call clgstr ("wxformat", Memc[txformat], SZ_FNAME) + call clgstr ("wyformat", Memc[tyformat], SZ_FNAME) + min_sigdigits = clgeti ("min_sigdigits") + + # Get remaining parameters. + verbose = clgetb ("verbose") + + # Check the formatting of the reference and input logical coordinates. + if (Memc[xformat] == EOS) { + call sprintf (Memc[xformat], SZ_FNAME, "%%%d.%dg") + call pargi (min_sigdigits + 3) + call pargi (min_sigdigits) + } + if (Memc[yformat] == EOS) { + call sprintf (Memc[yformat], SZ_FNAME, "%%%d.%dg") + call pargi (min_sigdigits + 3) + call pargi (min_sigdigits) + } + + # Check the reference image list length. + if (imtlen (rlist) <= 0) + call error (0, "The reference image list is empty.") + if (imtlen(rlist) > 1 && imtlen(rlist) != imtlen(ilist)) + call error (0, + "The number of reference and input images is not the same.") + + # Check the output coordinate file length. + if (fntlenb(olist) > 1 && fntlenb(olist) != imtlen(ilist)) + call error (0, + "The number of output coords files and input images is not the same.") + + # Check the reference coordinate list length. + if (clist != NULL) { + if (fntlenb (clist) != imtlen (rlist)) + call error (0, + "The number of reference coords files and images are not the same") + } + + # Initialize the reference image and coordinate list pointers. + imr = NULL + cfd = NULL + + # Loop over the input images. + while (imtgetim (ilist, Memc[image], SZ_FNAME) != EOF) { + + # Open the reference image and reference coordinate file and + # compute the logical and world reference coordinates. + if (imtgetim (rlist, Memc[refimage], SZ_FNAME) != EOF) { + + # Open the reference image. + if (imr != NULL) { + call mfree (rxl, TY_DOUBLE) + call mfree (ryl, TY_DOUBLE) + call mfree (rxw, TY_DOUBLE) + call mfree (ryw, TY_DOUBLE) + call mfree (trxw, TY_DOUBLE) + call mfree (tryw, TY_DOUBLE) + call mfree (ixl, TY_DOUBLE) + call mfree (iyl, TY_DOUBLE) + if (mwr != NULL) + call mw_close (mwr) + if (coor != NULL) + #call mfree (coor, TY_STRUCT) + call sk_close (coor) + call imunmap (imr) + } + imr = immap (Memc[refimage], READ_ONLY, 0) + if (IM_NDIM(imr) > 2) + call error (0, "The reference image must be 1D or 2D") + + # Open the reference image wcs. + rstat = sk_decim (imr, "logical", mwr, coor) + + # Check that the wcs dimensions are rational. + if (mwr != NULL) { + if (mw_stati(mwr, MW_NPHYSDIM) < IM_NDIM(imr) || + mw_stati (mwr, MW_NDIM) != IM_NDIM(imr)) { + call mw_close (mwr) + mwr = NULL + } + } + + # Compute the x limits of the logical reference coordinates. + if (IS_INDEFD(xmin)) + x1 = 1.0d0 + else + x1 = max (1.0d0, min (xmin, double(IM_LEN(imr,1)))) + if (IS_INDEFD(xmax)) + x2 = double(IM_LEN(imr,1)) + else + x2 = max (1.0d0, min (xmax, double(IM_LEN(imr,1)))) + + # Compute the y limits of the logical reference coordinates. + if (IM_NDIM(imr) == 1) + y1 = 1.0d0 + else if (IS_INDEFD(ymin)) + y1 = 1.0d0 + else + y1 = max (1.0d0, min (ymin, double(IM_LEN(imr,2)))) + if (IM_NDIM(imr) == 1) + y2 = 1.0d0 + else if (IS_INDEFD(ymax)) + y2 = double(IM_LEN(imr,2)) + else + y2 = max (1.0d0, min (ymax, double(IM_LEN(imr,2)))) + + # Compute the reference logical and world coordinates. + if (clist != NULL) { + + if (cfd != NULL) + call close (cfd) + + if (fntgfnb (clist, Memc[str], SZ_FNAME) != EOF) { + cfd = open (Memc[str], READ_ONLY, TEXT_FILE) + npts = rg_rdxy (cfd, rxw, ryw, wcs, xcolumn, ycolumn, + xunits, yunits) + call malloc (trxw, npts, TY_DOUBLE) + call malloc (tryw, npts, TY_DOUBLE) + call malloc (rxl, npts, TY_DOUBLE) + call malloc (ryl, npts, TY_DOUBLE) + call malloc (ixl, npts, TY_DOUBLE) + call malloc (iyl, npts, TY_DOUBLE) + if (wcs == RG_WORLD) + ctr = rg_xytoxy (mwr, Memd[rxw], Memd[ryw], + Memd[rxl], Memd[ryl], npts, "world", "logical", + 1, 2) + else + ctr = rg_xytoxy (mwr, Memd[rxw], Memd[ryw], + Memd[rxl], Memd[ryl], npts, "physical", + "logical", 1, 2) + } + + } else { + + if (IM_NDIM(imr) == 1) + npts = nx + else + npts = nx * ny + call malloc (rxl, npts, TY_DOUBLE) + call malloc (ryl, npts, TY_DOUBLE) + call malloc (rxw, npts, TY_DOUBLE) + call malloc (ryw, npts, TY_DOUBLE) + call malloc (trxw, npts, TY_DOUBLE) + call malloc (tryw, npts, TY_DOUBLE) + call malloc (ixl, npts, TY_DOUBLE) + call malloc (iyl, npts, TY_DOUBLE) + if (IM_NDIM(imr) == 1) + call rg_rxyl (Memd[rxl], Memd[ryl], nx, 1, x1, x2, + y1, y2) + else + call rg_rxyl (Memd[rxl], Memd[ryl], nx, ny, x1, x2, + y1, y2) + if (wcs == RG_WORLD) + ctr = rg_xytoxy (mwr, Memd[rxl], Memd[ryl], Memd[rxw], + Memd[ryw], npts, "logical", "world", 1, 2) + else + ctr = rg_xytoxy (mwr, Memd[rxl], Memd[ryl], Memd[rxw], + Memd[ryw], npts, "logical", "physical", 1, 2) + + } + } + + # Open the input image. + im = immap (Memc[image], READ_ONLY, 0) + if (IM_NDIM(im) > 2) + call error (0, "The input image must be 1D or 2D") + if (IM_NDIM(im) != IM_NDIM(imr)) + call error (0, + "The input image must have same dimensionality as reference image") + + # Open the input wcs. + stat = sk_decim (im, "logical", mw, coo) + if (mw != NULL) { + if (mw_stati(mw, MW_NPHYSDIM) < IM_NDIM(im) || + mw_stati (mw, MW_NDIM) != IM_NDIM(im)) { + call mw_close (mw) + mw = NULL + } + } + + # Open the output file. + if (fntgfnb (olist, Memc[str], SZ_FNAME) != EOF) + ofd = open (Memc[str], NEW_FILE, TEXT_FILE) + + # Print information about the reference and input coordinate + # systems and the reference and input files to the output + # file + if (ofd == STDOUT) + call fseti (ofd, F_FLUSHNL, YES) + if (streq (Memc[str], "STDOUT") || ofd == STDOUT) + call fseti (ofd, F_FLUSHNL, YES) + call fprintf (ofd, "\n") + call fprintf (ofd, + "# Reference image: %s Input image: %s\n# Coords: %s") + call pargstr (Memc[refimage]) + call pargstr (Memc[image]) + if (clist == NULL) { + call pargstr ("grid") + call fprintf (ofd, " Wcs: logical\n") + } else { + call fstats (cfd, F_FILENAME, Memc[str], SZ_FNAME) + call pargstr (Memc[str]) + call fprintf (ofd, " Wcs: %s\n") + switch (wcs) { + case RG_PHYSICAL: + call pargstr ("physical") + case RG_WORLD: + call pargstr ("world") + default: + call pargstr ("world") + } + } + if (rstat == ERR) + call fprintf (ofd, + "# Error decoding the reference coordinate system\n") + call sk_iiwrite (ofd, "Refsystem", Memc[refimage], mwr, coor) + if (stat == ERR) + call fprintf (ofd, + "# Error decoding the input coordinate system\n") + call sk_iiwrite (ofd, "Insystem", Memc[image], mw, coo) + + # Print information about the reference and input coordinate + # systems and the reference and input files to the standard + # output. + if (verbose && ofd != STDOUT) { + call printf ("\n") + call printf ( + "Reference image: %s Input image: %s\n Coords: %s") + call pargstr (Memc[refimage]) + call pargstr (Memc[image]) + if (clist == NULL) { + call pargstr ("grid") + call printf (" Wcs: logical\n") + } else { + call fstats (cfd, F_FILENAME, Memc[str], SZ_FNAME) + call pargstr (Memc[str]) + call printf (" Wcs: %s\n") + switch (wcs) { + case RG_PHYSICAL: + call pargstr ("physical") + case RG_WORLD: + call pargstr ("world") + default: + call pargstr ("world") + } + } + if (rstat == ERR) + call printf ( + "Error decoding the rference coordinate system\n") + call sk_iiprint ("Refsystem", Memc[refimage], mwr, coor) + if (stat == ERR) + call printf ( + "Error decoding the input coordinate system\n") + call sk_iiprint ("Insystem", Memc[image], mw, coo) + call printf ("\n") + } + + # Set the reference and input coordinate formats. + if (Memc[rxformat] == EOS) + call rg_ssetfmt (mwr, wcs, sk_stati(coor, S_XLAX), + min_sigdigits, Memc[rwxformat], SZ_FNAME) + else + call strcpy (Memc[rxformat], Memc[rwxformat], SZ_FNAME) + + if (Memc[txformat] == EOS) + call rg_ssetfmt (mw, wcs, sk_stati(coo, S_XLAX), + min_sigdigits, Memc[twxformat], SZ_FNAME) + else + call strcpy (Memc[txformat], Memc[twxformat], SZ_FNAME) + if (Memc[ryformat] == EOS) + call rg_ssetfmt (mwr, wcs, sk_stati(coor, S_YLAX), + min_sigdigits, Memc[rwyformat], SZ_FNAME) + else + call strcpy (Memc[ryformat], Memc[rwyformat], SZ_FNAME) + if (Memc[tyformat] == EOS) + call rg_ssetfmt (mw, wcs, sk_stati(coo, S_YLAX), + min_sigdigits, Memc[twyformat], SZ_FNAME) + else + call strcpy (Memc[tyformat], Memc[twyformat], SZ_FNAME) + + + # Compute the output coordinates issuing a warning if the + # axes types are not compatable. + if (mwr == NULL || rstat == ERR) { + call fprintf (ofd, + "# \tWarning: error decoding reference image wcs\n") + if (verbose && ofd != STDOUT) + call printf ( + "\tWarning: error decoding reference image wcs\n") + if (IM_NDIM(imr) == 1) + call rg_rxyl (Memd[rxl], Memd[ryl], nx, 1, 1.0d0, + double(IM_LEN(im,1)), 1.0d0, 1.0d0) + else + call rg_rxyl (Memd[rxl], Memd[ryl], nx, ny, 1.0d0, + double(IM_LEN(im,1)), 1.0d0, double(IM_LEN(im,2))) + call amovd (Memd[rxl], Memd[ixl], npts) + call amovd (Memd[ryl], Memd[iyl], npts) + if (clist == NULL) { + call amovd (Memd[rxl], Memd[rxw], npts) + call amovd (Memd[ryl], Memd[ryw], npts) + call amovd (Memd[rxl], Memd[trxw], npts) + call amovd (Memd[ryl], Memd[tryw], npts) + } + ct = NULL + } else if (ctr == NULL) { + call fprintf (ofd, "# \tWarning: Unable to compute reference \ +logical <-> world transform\n") + if (verbose && ofd != STDOUT) + call printf ("\tWarning: Unable to compute reference \ +logical <-> world transform\n") + if (IM_NDIM(imr) == 1) + call rg_rxyl (Memd[rxl], Memd[ryl], nx, 1, 1.0d0, + double(IM_LEN(im,1)), 1.0d0, 1.0d0) + else + call rg_rxyl (Memd[rxl], Memd[ryl], nx, ny, 1.0d0, + double(IM_LEN(im,1)), 1.0d0, double(IM_LEN(im,2))) + call amovd (Memd[rxl], Memd[ixl], npts) + call amovd (Memd[ryl], Memd[iyl], npts) + if (clist == NULL) { + call amovd (Memd[rxl], Memd[rxw], npts) + call amovd (Memd[ryl], Memd[ryw], npts) + call amovd (Memd[rxl], Memd[trxw], npts) + call amovd (Memd[ryl], Memd[tryw], npts) + } + ct = NULL + } else if (mw == NULL || stat == ERR) { + call fprintf (ofd, + "# \tWarning: error decoding input image wcs\n") + if (verbose && ofd != STDOUT) + call printf ("\tWarning: error decoding input image wcs\n") + call amovd (Memd[rxl], Memd[ixl], npts) + call amovd (Memd[ryl], Memd[iyl], npts) + call amovd (Memd[rxw], Memd[trxw], npts) + call amovd (Memd[ryw], Memd[tryw], npts) + ct = NULL + } else { + # Check axis status. + if (wcs == RG_PHYSICAL) { + ct = rg_xytoxy (mw, Memd[rxw], Memd[ryw], Memd[ixl], + Memd[iyl], npts, "physical", "logical", 1, 2) + call amovd (Memd[rxw], Memd[trxw], npts) + call amovd (Memd[ryw], Memd[tryw], npts) + if (ct == NULL) { + call fprintf (ofd, + "# \tWarning: Unable to compute image physical -> \ +logical transform\n") + if (verbose && ofd != STDOUT) + call printf ( + "\tWarning: Unable to compute image physical \ +-> logical transform\n") + if (IM_NDIM(imr) == 1) + call rg_rxyl (Memd[rxl], Memd[ryl], nx, 1, 1.0d0, + double(IM_LEN(im,1)), 1.0d0, 1.0d0) + else + call rg_rxyl (Memd[rxl], Memd[ryl], nx, ny, 1.0d0, + double(IM_LEN(im,1)), 1.0d0, + double(IM_LEN(im,2))) + call amovd (Memd[rxl], Memd[ixl], npts) + call amovd (Memd[ryl], Memd[iyl], npts) + } + } else { + call rg_lltransform (coor, coo, Memd[rxw], Memd[ryw], + Memd[trxw], Memd[tryw], npts) + if ((sk_stati (coor, S_PLNGAX) < sk_stati(coor, + S_PLATAX)) && (sk_stati (coo,S_PLNGAX) < + sk_stati(coo, S_PLATAX))) + ct = rg_xytoxy (mw, Memd[trxw], Memd[tryw], Memd[ixl], + Memd[iyl], npts, "world", "logical", 1, 2) + else if ((sk_stati (coor, S_PLNGAX) > sk_stati(coor, + S_PLATAX)) && (sk_stati (coo,S_PLNGAX) > + sk_stati(coo, S_PLATAX))) + ct = rg_xytoxy (mw, Memd[trxw], Memd[tryw], Memd[ixl], + Memd[iyl], npts, "world", "logical", 1, 2) + else + ct = rg_xytoxy (mw, Memd[tryw], Memd[trxw], Memd[ixl], + Memd[iyl], npts, "world", "logical", 1, 2) + if (ct == NULL) { + call fprintf (ofd, + "# \tWarning: Unable to compute image world -> \ +logical transform\n") + if (verbose && ofd != STDOUT) + call printf ( + "\tWarning: Unable to compute image world -> \ +logical transform\n") + if (IM_NDIM(imr) == 1) + call rg_rxyl (Memd[rxl], Memd[ryl], nx, 1, 1.0d0, + double(IM_LEN(im,1)), 1.0d0, 1.0d0) + else + call rg_rxyl (Memd[rxl], Memd[ryl], nx, ny, 1.0d0, + double(IM_LEN(im,1)), 1.0d0, + double(IM_LEN(im,2))) + call amovd (Memd[rxl], Memd[ixl], npts) + call amovd (Memd[ryl], Memd[iyl], npts) + } + } + } + + # Write out the results. + if ((sk_stati (coor, S_PLNGAX) < sk_stati(coor, S_PLATAX)) && + (sk_stati (coo,S_PLNGAX) < sk_stati(coo, S_PLATAX))) + call rg_swcoords (ofd, Memd[rxl], Memd[ryl], Memd[ixl], + Memd[iyl], Memd[rxw], Memd[ryw], Memd[trxw], Memd[tryw], + npts, Memc[xformat], Memc[yformat], Memc[rwxformat], + Memc[rwyformat], Memc[twxformat], Memc[twyformat]) + else if ((sk_stati (coor, S_PLNGAX) > sk_stati(coor, + S_PLATAX)) && (sk_stati (coo,S_PLNGAX) > sk_stati(coo, + S_PLATAX))) + call rg_swcoords (ofd, Memd[rxl], Memd[ryl], Memd[ixl], + Memd[iyl], Memd[rxw], Memd[ryw], Memd[trxw], Memd[tryw], + npts, Memc[xformat], Memc[yformat], Memc[rwxformat], + Memc[rwyformat], Memc[twxformat], Memc[twyformat]) + else + call rg_swcoords (ofd, Memd[rxl], Memd[ryl], Memd[ixl], + Memd[iyl], Memd[rxw], Memd[ryw], Memd[tryw], Memd[trxw], + npts, Memc[xformat], Memc[yformat], Memc[rwxformat], + Memc[rwyformat], Memc[twxformat], Memc[twyformat]) + + # Close the input image and its wcs. + if (mw != NULL) + call mw_close (mw) + if (coo != NULL) + #call mfree (coo, TY_STRUCT) + call sk_close (coo) + call imunmap (im) + + # Close the output coordinate file if it is not going to + # be appended to. + if (fntlenb(olist) == imtlen(ilist)) + call close (ofd) + } + + if (imr != NULL) { + call mfree (rxl, TY_DOUBLE) + call mfree (ryl, TY_DOUBLE) + call mfree (rxw, TY_DOUBLE) + call mfree (ryw, TY_DOUBLE) + call mfree (trxw, TY_DOUBLE) + call mfree (tryw, TY_DOUBLE) + call mfree (ixl, TY_DOUBLE) + call mfree (iyl, TY_DOUBLE) + if (mwr != NULL) + call mw_close (mwr) + if (coor != NULL) + #call mfree (coor, TY_STRUCT) + call sk_close (coor) + call imunmap (imr) + } + if (cfd != NULL) + call close (cfd) + if (fntlenb(olist) < imtlen(ilist)) + call close (ofd) + if (ilist != NULL) + call imtclose (ilist) + if (rlist != NULL) + call imtclose (rlist) + if (olist != NULL) + call fntclsb (olist) + if (clist != NULL) + call fntclsb (clist) + + call sfree (sp) +end + + +# RG_SSETFMT -- Procedure to set the appropriate default format. + +procedure rg_ssetfmt (mw, wcs, laxno, min_sigdigits, wformat, maxch) + +pointer mw #I pointer to the image wcs +int wcs #I the input wcs type +int laxno #I the physical axis number +int min_sigdigits #I the minmum number of significant digits +char wformat[ARB] #O the output format string +int maxch #I the maximum size of the output format string + +pointer sp, str +bool streq() + +begin + call smark (sp) + call salloc (str, SZ_FNAME, TY_CHAR) + + if (mw == NULL) { + call sprintf (wformat, maxch, "%%%d.%dg") + call pargi (min_sigdigits + 3) + call pargi (min_sigdigits) + } else if (wcs == RG_PHYSICAL) { + call strcpy ("%10.3f", wformat, maxch) + } else { + iferr { + call mw_gwattrs (mw, laxno, "format", wformat, maxch) + } then { + iferr { + call mw_gwattrs (mw, laxno, "axtype", Memc[str], SZ_FNAME) + } then { + call sprintf (wformat, maxch, "%%%d.%dg") + call pargi (min_sigdigits + 3) + call pargi (min_sigdigits) + } else { + if (streq (Memc[str], "ra")) + call strcpy ("%12.2H", wformat, maxch) + else if (streq (Memc[str], "dec")) + call strcpy ("%11.1h", wformat, maxch) + else if (streq (Memc[str+1], "lon")) + call strcpy ("%11.1h", wformat, maxch) + else if (streq (Memc[str+1], "lat")) + call strcpy ("%11.1h", wformat, maxch) + else { + call sprintf (wformat, maxch, "%%%d.%dg") + call pargi (min_sigdigits + 3) + call pargi (min_sigdigits) + } + } + } + } + + call sfree (sp) +end + + +# RG_SWCOORDS -- Write out the reference and input logical coordinates of the +# tie points and the reference world coordinates. + +procedure rg_swcoords (ofd, xref, yref, xin, yin, wxref, wyref, twxref, twyref, + npts, xformat, yformat, wxformat, wyformat, twxformat, twyformat) + +int ofd #I the output file descriptor +double xref[ARB] #I the reference logical x coordinates +double yref[ARB] #I the reference logical y coordinates +double xin[ARB] #I the input logical x coordinates +double yin[ARB] #I the input logical y coordinates +double wxref[ARB] #I the reference world x coordinates +double wyref[ARB] #I the reference world y coordinates +double twxref[ARB] #I the input world x coordinates +double twyref[ARB] #I the input world y coordinates +int npts #I the number of input points +char xformat[ARB] #I the logical x coordinates format +char yformat[ARB] #I the logical y coordinates format +char wxformat[ARB] #I the reference world x coordinates format +char wyformat[ARB] #I the reference world y coordinates format +char twxformat[ARB] #I the input world x coordinates format +char twyformat[ARB] #I the input world y coordinates format + +int i +pointer sp, fmtstr + +begin + call smark (sp) + call salloc (fmtstr, SZ_LINE, TY_CHAR) + + # Write the column descriptions. + call fprintf (ofd, + "# \tColumn 1: reference logical x coordinate\n") + call fprintf (ofd, + "# \tColumn 2: reference logical y coordinate\n") + call fprintf (ofd, + "# \tColumn 3: input logical x coordinate\n") + call fprintf (ofd, + "# \tColumn 4: input logical y coordinate\n") + call fprintf (ofd, + "# \tColumn 5: reference world x coordinate\n") + call fprintf (ofd, + "# \tColumn 6: reference world y coordinate\n") + call fprintf (ofd, + "# \tColumn 7: input world x coordinate\n") + call fprintf (ofd, + "# \tColumn 8: input world y coordinate\n") + call fprintf (ofd, "\n") + + call sprintf (Memc[fmtstr], SZ_LINE, + "%s %s %s %s %s %s %s %s\n") + call pargstr (xformat) + call pargstr (yformat) + call pargstr (xformat) + call pargstr (yformat) + call pargstr (wxformat) + call pargstr (wyformat) + call pargstr (twxformat) + call pargstr (twyformat) + + do i = 1, npts { + call fprintf (ofd, Memc[fmtstr]) + call pargd (xref[i]) + call pargd (yref[i]) + call pargd (xin[i]) + call pargd (yin[i]) + call pargd (wxref[i]) + call pargd (wyref[i]) + call pargd (twxref[i]) + call pargd (twyref[i]) + } + + call sfree (sp) +end + diff --git a/pkg/images/immatch/src/wcsmatch/t_wcscopy.x b/pkg/images/immatch/src/wcsmatch/t_wcscopy.x new file mode 100644 index 00000000..6d15e5c8 --- /dev/null +++ b/pkg/images/immatch/src/wcsmatch/t_wcscopy.x @@ -0,0 +1,199 @@ +include <imhdr.h> +include <mwset.h> + +# T_WCSCOPY -- Copy the world coordinate system of a reference image to +# the world coordinate system of an input image. + +procedure t_wcscopy() + +bool verbose +int ilist, rlist +pointer sp, image, refimage, value, str, imr, mwr, im +real rval +double dval +bool clgetb() +int imtopen(), imtlen(), imtgetim() +#int mw_stati(), rg_samesize() +pointer immap(), mw_openim() +real imgetr() +double imgetd() +errchk mw_openim(), imgstr(), imgetr(), imgetd(), imdelf() + +begin + # Get some temporary working space. + call smark (sp) + call salloc (refimage, SZ_FNAME, TY_CHAR) + call salloc (image, SZ_FNAME, TY_CHAR) + call salloc (value, SZ_FNAME, TY_CHAR) + call salloc (str, SZ_LINE, TY_CHAR) + + # Get the input image and reference image lists. + call clgstr ("images", Memc[str], SZ_FNAME) + ilist = imtopen (Memc[str]) + call clgstr ("refimages", Memc[str], SZ_FNAME) + rlist = imtopen (Memc[str]) + verbose = clgetb ("verbose") + + # Check the reference image list length. + if (imtlen (rlist) <= 0) + call error (0, "The reference image list is empty.") + if (imtlen(rlist) > 1 && imtlen(rlist) != imtlen(ilist)) + call error (0, + "The number of reference and input images is not the same.") + + # Initialize the reference image and coordinate list pointers. + imr = NULL + + # Loop over the input images. + while (imtgetim (ilist, Memc[image], SZ_FNAME) != EOF) { + + # Open the reference image and reference coordinate file and + # compute the logical and world reference coordinates. + if (imtgetim (rlist, Memc[refimage], SZ_FNAME) != EOF) { + + # Open the reference image. + if (imr != NULL) { + if (mwr != NULL) + call mw_close (mwr) + call imunmap (imr) + } + imr = immap (Memc[refimage], READ_ONLY, 0) + + # Open the reference image wcs. + iferr (mwr = mw_openim (imr)) + mwr = NULL + + # Check that the wcs dimensions are rational. +# if (mwr != NULL) { +# if (mw_stati(mwr, MW_NPHYSDIM) < IM_NDIM(imr)) { +# call mw_close (mwr) +# mwr = NULL +# } +# } + } + + # Print message about progress of task + if (verbose) { + call printf ("Copying wcs from image %s to image %s\n") + call pargstr (Memc[refimage]) + call pargstr (Memc[image]) + } + + # Remove any image section and open the input image. + call imgimage (Memc[image], Memc[image], SZ_FNAME) + iferr (im = immap (Memc[image], READ_WRITE, 0)) { + im = immap (Memc[image], NEW_IMAGE, 0) + IM_NDIM(im) = 0 + } + + # Test for valid wcs. + if (mwr == NULL) { + if (verbose) { + call printf ( + "\tError: cannot read wcs for reference image %s\n") + call pargstr (Memc[refimage]) + } +# } else if (IM_NDIM(im) != IM_NDIM(imr)) { +# if (verbose) { +# call printf ( +# "\tError: %s and %s have different number of dimensions\n") +# call pargstr (Memc[image]) +# call pargstr (Memc[refimage]) +# } + } else { +# if (rg_samesize (imr, im) == NO) { +# if (verbose) { +# call printf ( +# "\tWarning: images %s and %s have different sizes\n") +# call pargstr (Memc[image]) +# call pargstr (Memc[refimage]) +# } +# } + #mw = mw_open (NULL, mw_stati (mwr,MW_NPHYSDIM)) + #call mw_loadim (mw, imr) + #call mw_saveim (mw, im) + #call mw_close (mw) + call mw_saveim (mwr, im) + + # Copy the RADECSYS keyword to the input image header. + ifnoerr { + call imgstr (imr, "RADECSYS", Memc[value], SZ_FNAME) + } then { + call imastr (im, "RADECSYS", Memc[value]) + } else { + iferr (call imdelf (im, "RADECSYS")) + ; + } + + # Copy the EQUINOX or EPOCH keyword to the input image header + # EQUINOX keyword. + ifnoerr { + rval = imgetr (imr, "EQUINOX") + } then { + call imaddr (im, "EQUINOX", rval) + iferr (call imdelf (im, "EPOCH")) + ; + } else { + ifnoerr { + rval = imgetr (imr, "EPOCH") + } then { + call imaddr (im, "EQUINOX", rval) + iferr (call imdelf (im, "EPOCH")) + ; + } else { + iferr (call imdelf (im, "EQUINOX")) + ; + iferr (call imdelf (im, "EPOCH")) + ; + } + } + + # Copy the MJD-WCSkeyword to the input image header. + ifnoerr { + dval = imgetd (imr, "MJD-WCS") + } then { + call imaddd (im, "MJD-WCS", dval) + } else { + iferr (call imdelf (im, "MJD-WCS")) + ; + } + } + + # Close the input image. + call imunmap (im) + + } + + if (imr != NULL) { + if (mwr != NULL) + call mw_close (mwr) + call imunmap (imr) + } + + if (ilist != NULL) + call imtclose (ilist) + if (rlist != NULL) + call imtclose (rlist) + + call sfree (sp) +end + + +# RG_SAMESIZE -- Determine whether two images of the same dimension are +# the same size. + +int procedure rg_samesize (im1, im2) + +pointer im1 #I the first image descriptor +pointer im2 #I the second image descriptor + +int i, stat + +begin + stat = YES + do i = 1, IM_NDIM(im1) { + if (IM_LEN(im1,i) != IM_LEN(im2,i)) + return (NO) + } + return (stat) +end diff --git a/pkg/images/immatch/src/wcsmatch/t_wcsxymatch.x b/pkg/images/immatch/src/wcsmatch/t_wcsxymatch.x new file mode 100644 index 00000000..503bc7f3 --- /dev/null +++ b/pkg/images/immatch/src/wcsmatch/t_wcsxymatch.x @@ -0,0 +1,787 @@ +include <fset.h> +include <imhdr.h> +include <mwset.h> +include "wcsxymatch.h" + +# T_WCSXYMATCH -- Compute a list of the tie points required to register an +# image to a reference image using WCS information in the image headers. + +procedure t_wcsxymatch() + +bool verbose, transpose +double xmin, xmax, ymin, ymax, x1, x2, y1, y2 +int ilist, rlist, olist, clist, cfd, ofd +int nx, ny, npts, wcs, xcolumn, ycolumn +int xunits, yunits, min_sigdigits, axstat, projstat +pointer sp, refimage, image, xformat, yformat, rxformat, ryformat +pointer wxformat, wyformat, str, paxno, rlaxno, laxno +pointer im, imr, mw, mwr, rxl, ryl, rxw, ryw, ixl, iyl, ctr, ct + +bool clgetb(), streq() +double clgetd() +int imtopen(), fntopnb(), imtlen(), fntlenb(), imtgetim(), open(), clgeti() +int clgwrd(), rg_rdxy(), fntgfnb(), rg_axstat(), rg_projstat(), mw_stati() +int strdic() +pointer immap(), mw_openim(), rg_xytoxy() +errchk mw_openim(), mw_gwattrs() + +begin + # Get some temporary working space. + call smark (sp) + call salloc (refimage, SZ_FNAME, TY_CHAR) + call salloc (image, SZ_FNAME, TY_CHAR) + call salloc (xformat, SZ_FNAME, TY_CHAR) + call salloc (yformat, SZ_FNAME, TY_CHAR) + call salloc (wxformat, SZ_FNAME, TY_CHAR) + call salloc (wyformat, SZ_FNAME, TY_CHAR) + call salloc (rxformat, SZ_FNAME, TY_CHAR) + call salloc (ryformat, SZ_FNAME, TY_CHAR) + call salloc (str, SZ_LINE, TY_CHAR) + + call salloc (paxno, IM_MAXDIM, TY_INT) + call salloc (rlaxno, IM_MAXDIM, TY_INT) + call salloc (laxno, IM_MAXDIM, TY_INT) + + # Get the input image and output file lists. + call clgstr ("input", Memc[str], SZ_FNAME) + ilist = imtopen (Memc[str]) + call clgstr ("reference", Memc[str], SZ_FNAME) + rlist = imtopen (Memc[str]) + call clgstr ("output", Memc[str], SZ_FNAME) + if (Memc[str] == EOS) + call strcpy ("STDOUT", Memc[str], SZ_FNAME) + olist = fntopnb (Memc[str], NO) + + # Determine the source of the input coordinates. + call clgstr ("coords", Memc[str], SZ_FNAME) + if (streq (Memc[str], "grid")) { + clist = NULL + xmin = clgetd ("xmin") + xmax = clgetd ("xmax") + ymin = clgetd ("ymin") + ymax = clgetd ("ymax") + nx = clgeti ("nx") + ny = clgeti ("ny") + wcs = clgwrd ("wcs", Memc[str], SZ_FNAME, RG_WCSLIST) + } else { + clist = fntopnb (Memc[str], NO) + xmin = INDEFD + xmax = INDEFD + ymin = INDEFD + ymax = INDEFD + nx = clgeti ("nx") + ny = clgeti ("ny") + wcs = clgwrd ("wcs", Memc[str], SZ_FNAME, RG_WCSLIST) + xcolumn = clgeti ("xcolumn") + ycolumn = clgeti ("ycolumn") + call clgstr ("xunits", Memc[str], SZ_FNAME) + xunits = strdic (Memc[str], Memc[str], SZ_FNAME, RG_UNITLIST) + if (xunits <= 0) + xunits = RG_UNATIVE + call clgstr ("yunits", Memc[str], SZ_FNAME) + yunits = strdic (Memc[str], Memc[str], SZ_FNAME, RG_UNITLIST) + if (yunits <= 0) + yunits = RG_UNATIVE + } + transpose = clgetb ("transpose") + + # Get the output coordinate formatting information. + call clgstr ("xformat", Memc[xformat], SZ_FNAME) + call clgstr ("yformat", Memc[yformat], SZ_FNAME) + call clgstr ("wxformat", Memc[rxformat], SZ_FNAME) + call clgstr ("wyformat", Memc[ryformat], SZ_FNAME) + min_sigdigits = clgeti ("min_sigdigits") + + # Get remaining parameters. + verbose = clgetb ("verbose") + + # Check the formatting of the reference and input logical coordinates. + if (Memc[xformat] == EOS) { + call sprintf (Memc[xformat], SZ_FNAME, "%%%d.%dg") + call pargi (min_sigdigits + 3) + call pargi (min_sigdigits) + } + if (Memc[yformat] == EOS) { + call sprintf (Memc[yformat], SZ_FNAME, "%%%d.%dg") + call pargi (min_sigdigits + 3) + call pargi (min_sigdigits) + } + + # Check the reference image list length. + if (imtlen (rlist) <= 0) + call error (0, "The reference image list is empty.") + if (imtlen(rlist) > 1 && imtlen(rlist) != imtlen(ilist)) + call error (0, + "The number of reference and input images is not the same.") + + # Check the output coordinate file length. + if (fntlenb(olist) > 1 && fntlenb(olist) != imtlen(ilist)) + call error (0, + "The number of output coords files and input images is not the same.") + + # Check the reference coordinate list length. + if (clist != NULL) { + if (fntlenb (clist) != imtlen (rlist)) + call error (0, + "The number of reference coords files and images are not the same") + } + + # Initialize the reference image and coordinate list pointers. + imr = NULL + cfd = NULL + + # Loop over the input images. + while (imtgetim (ilist, Memc[image], SZ_FNAME) != EOF) { + + # Open the output file. + if (fntgfnb (olist, Memc[str], SZ_FNAME) != EOF) { + ofd = open (Memc[str], NEW_FILE, TEXT_FILE) + if (ofd == STDOUT) + call fseti (ofd, F_FLUSHNL, YES) + else if (fntlenb (olist) != imtlen (ilist)) + call error (0, + "The number of output coords files and input images is not the same.") + } + + # Open the reference image and reference coordinate file and + # compute the logical and world reference coordinates. + if (imtgetim (rlist, Memc[refimage], SZ_FNAME) != EOF) { + + # Open the reference image. + if (imr != NULL) { + call mfree (rxl, TY_DOUBLE) + call mfree (ryl, TY_DOUBLE) + call mfree (rxw, TY_DOUBLE) + call mfree (ryw, TY_DOUBLE) + call mfree (ixl, TY_DOUBLE) + call mfree (iyl, TY_DOUBLE) + if (mwr != NULL) + call mw_close (mwr) + call imunmap (imr) + } + imr = immap (Memc[refimage], READ_ONLY, 0) + if (IM_NDIM(imr) > 2) + call error (0, "The reference image must be 1D or 2D") + + # Open the reference image wcs. + iferr (mwr = mw_openim (imr)) + mwr = NULL + + # Check that the wcs dimensions are rational. + if (mwr != NULL) { + if (mw_stati(mwr, MW_NPHYSDIM) < IM_NDIM(imr) || + mw_stati (mwr, MW_NDIM) != IM_NDIM(imr)) { + call mw_close (mwr) + mwr = NULL + } + } + + # Get the reference image physical and logical axis maps. + if (mwr != NULL) { + call mw_gaxmap (mwr, Memi[paxno], Memi[rlaxno], + mw_stati(mwr, MW_NPHYSDIM)) + call rg_laxmap (Memi[paxno], mw_stati(mwr, MW_NPHYSDIM), + Memi[rlaxno], mw_stati(mwr, MW_NDIM)) + } else { + Memi[rlaxno] = 1 + Memi[rlaxno+1] = 2 + } + + # Compute the x limits of the logical reference coordinates. + if (IS_INDEFD(xmin)) + x1 = 1.0d0 + else + x1 = max (1.0d0, min (xmin, double(IM_LEN(imr,1)))) + if (IS_INDEFD(xmax)) + x2 = double(IM_LEN(imr,1)) + else + x2 = max (1.0d0, min (xmax, double(IM_LEN(imr,1)))) + + # Compute the y limits of the logical reference coordinates. + if (IM_NDIM(imr) == 1) + y1 = 1.0d0 + else if (IS_INDEFD(ymin)) + y1 = 1.0d0 + else + y1 = max (1.0d0, min (ymin, double(IM_LEN(imr,2)))) + if (IM_NDIM(imr) == 1) + y2 = 1.0d0 + else if (IS_INDEFD(ymax)) + y2 = double(IM_LEN(imr,2)) + else + y2 = max (1.0d0, min (ymax, double(IM_LEN(imr,2)))) + + # Compute the reference logical and world coordinates. + if (clist != NULL) { + + if (cfd != NULL) + call close (cfd) + + if (fntgfnb (clist, Memc[str], SZ_FNAME) != EOF) { + cfd = open (Memc[str], READ_ONLY, TEXT_FILE) + npts = rg_rdxy (cfd, rxw, ryw, wcs, xcolumn, ycolumn, + xunits, yunits) + call malloc (rxl, npts, TY_DOUBLE) + call malloc (ryl, npts, TY_DOUBLE) + call malloc (ixl, npts, TY_DOUBLE) + call malloc (iyl, npts, TY_DOUBLE) + if (wcs == RG_WORLD) + ctr = rg_xytoxy (mwr, Memd[rxw], Memd[ryw], + Memd[rxl], Memd[ryl], npts, "world", + "logical", 1, 2) + else + ctr = rg_xytoxy (mwr, Memd[rxw], Memd[ryw], + Memd[rxl], Memd[ryl], npts, "physical", + "logical", 1, 2) + } + + } else { + + if (IM_NDIM(imr) == 1) + npts = nx + else + npts = nx * ny + call malloc (rxl, npts, TY_DOUBLE) + call malloc (ryl, npts, TY_DOUBLE) + call malloc (rxw, npts, TY_DOUBLE) + call malloc (ryw, npts, TY_DOUBLE) + call malloc (ixl, npts, TY_DOUBLE) + call malloc (iyl, npts, TY_DOUBLE) + if (IM_NDIM(imr) == 1) + call rg_rxyl (Memd[rxl], Memd[ryl], nx, 1, x1, x2, + y1, y2) + else + call rg_rxyl (Memd[rxl], Memd[ryl], nx, ny, x1, x2, + y1, y2) + if (wcs == RG_WORLD) + ctr = rg_xytoxy (mwr, Memd[rxl], Memd[ryl], Memd[rxw], + Memd[ryw], npts, "logical", "world", 1, 2) + else + ctr = rg_xytoxy (mwr, Memd[rxl], Memd[ryl], Memd[rxw], + Memd[ryw], npts, "logical", "physical", 1, 2) + + } + } + + # Open the input image. + im = immap (Memc[image], READ_ONLY, 0) + if (IM_NDIM(im) > 2) + call error (0, "The input image must be 1D or 2D") + if (IM_NDIM(im) != IM_NDIM(imr)) + call error (0, + "The input image must have same dimensionality as reference image") + + # Open the input wcs. + iferr (mw = mw_openim (im)) + mw = NULL + if (mw != NULL) { + if (mw_stati(mw, MW_NPHYSDIM) < IM_NDIM(im) || + mw_stati (mw, MW_NDIM) != IM_NDIM(im)) { + call mw_close (mw) + mw = NULL + } + } + + # Get the input image wcs physical and logical axis maps. + if (mw != NULL) { + call mw_gaxmap (mw, Memi[paxno], Memi[laxno], mw_stati(mw, + MW_NPHYSDIM)) + call rg_laxmap (Memi[paxno], mw_stati(mw, MW_NPHYSDIM), + Memi[laxno], mw_stati(mw, MW_NDIM)) + } else { + Memi[laxno] = 1 + Memi[laxno+1] = 2 + } + + # Write the banner string. + call fprintf (ofd, + "\n# Reference image: %s Input image: %s\n# \tCoords: %s") + call pargstr (Memc[refimage]) + call pargstr (Memc[image]) + if (clist == NULL) { + call pargstr ("grid") + call fprintf (ofd, "\n") + } else { + call fstats (cfd, F_FILENAME, Memc[str], SZ_FNAME) + call pargstr (Memc[str]) + call fprintf (ofd, " Wcs: %s\n") + switch (wcs) { + case RG_PHYSICAL: + call pargstr ("physical") + case RG_WORLD: + call pargstr ("world") + default: + call pargstr ("world") + } + } + + # Printe message on the terminal. + if (verbose && ofd != STDOUT) { + call printf ( + "\nReference image: %s Input image: %s\n\tCoords: %s") + call pargstr (Memc[refimage]) + call pargstr (Memc[image]) + if (clist == NULL) { + call pargstr ("grid") + call printf ("\n") + } else { + call fstats (cfd, F_FILENAME, Memc[str], SZ_FNAME) + call pargstr (Memc[str]) + call printf (" Wcs: %s\n") + switch (wcs) { + case RG_PHYSICAL: + call pargstr ("physical") + case RG_WORLD: + call pargstr ("world") + default: + call pargstr ("world") + } + } + } + + # Set the reference coordinate formats. + if (Memc[rxformat] == EOS) + call rg_wsetfmt (mwr, mw, wcs, Memi[rlaxno], Memi[laxno], + min_sigdigits, Memc[wxformat], SZ_FNAME) + else + call strcpy (Memc[rxformat], Memc[wxformat], SZ_FNAME) + + if (Memc[ryformat] == EOS) + call rg_wsetfmt (mwr, mw, wcs, Memi[rlaxno+1], Memi[laxno+1], + min_sigdigits, Memc[wyformat], SZ_FNAME) + else + call strcpy (Memc[ryformat], Memc[wyformat], SZ_FNAME) + + # Compute the output coordinates issuing a warning if the + # axes types are not compatable. + if (mwr == NULL) { + call fprintf (ofd, + "# \tWarning: reference image wcs is undefined\n") + if (verbose && ofd != STDOUT) + call printf ( + "\tWarning: reference image wcs is undefined\n") + if (IM_NDIM(imr) == 1) + call rg_rxyl (Memd[rxl], Memd[ryl], nx, 1, 1.0d0, + double(IM_LEN(im,1)), 1.0d0, 1.0d0) + else + call rg_rxyl (Memd[rxl], Memd[ryl], nx, ny, 1.0d0, + double(IM_LEN(im,1)), 1.0d0, double(IM_LEN(im,2))) + call amovd (Memd[rxl], Memd[ixl], npts) + call amovd (Memd[ryl], Memd[iyl], npts) + if (clist == NULL) { + call amovd (Memd[rxl], Memd[rxw], npts) + call amovd (Memd[ryl], Memd[ryw], npts) + } + ct = NULL + } else if (ctr == NULL) { + call fprintf (ofd, "# \tWarning: Unable to compute reference \ +logical <-> world transform\n") + if (verbose && ofd != STDOUT) { + call printf ("\tWarning: Unable to compute reference \ +logical <-> world transform\n") + } + if (IM_NDIM(imr) == 1) + call rg_rxyl (Memd[rxl], Memd[ryl], nx, 1, 1.0d0, + double(IM_LEN(im,1)), 1.0d0, 1.0d0) + else + call rg_rxyl (Memd[rxl], Memd[ryl], nx, ny, 1.0d0, + double(IM_LEN(im,1)), 1.0d0, double(IM_LEN(im,2))) + call amovd (Memd[rxl], Memd[ixl], npts) + call amovd (Memd[ryl], Memd[iyl], npts) + if (clist == NULL) { + call amovd (Memd[rxl], Memd[rxw], npts) + call amovd (Memd[ryl], Memd[ryw], npts) + } + ct = NULL + } else if (mw == NULL) { + call fprintf (ofd, + "# \tWarning: input image wcs is undefined\n") + if (verbose && ofd != STDOUT) + call printf ("\tWarning: input image wcs is undefined\n") + call amovd (Memd[rxl], Memd[ixl], npts) + call amovd (Memd[ryl], Memd[iyl], npts) + ct = NULL + } else { + # Check axis status. + if (wcs == RG_PHYSICAL) { + axstat = RG_AXEQUAL + projstat = RG_AXEQUAL + ct = rg_xytoxy (mw, Memd[rxw], Memd[ryw], Memd[ixl], + Memd[iyl], npts, "physical", "logical", 1, 2) + if (ct == NULL) { + call fprintf (ofd, + "# \tWarning: Unable to compute image physical -> \ +logical transform\n") + if (verbose && ofd != STDOUT) { + call printf ( + "\tWarning: Unable to compute image physical \ +-> logical transform\n") + } + if (IM_NDIM(imr) == 1) + call rg_rxyl (Memd[rxl], Memd[ryl], nx, 1, 1.0d0, + double(IM_LEN(im,1)), 1.0d0, 1.0d0) + else + call rg_rxyl (Memd[rxl], Memd[ryl], nx, ny, 1.0d0, + double(IM_LEN(im,1)), 1.0d0, + double(IM_LEN(im,2))) + call amovd (Memd[rxl], Memd[ixl], npts) + call amovd (Memd[ryl], Memd[iyl], npts) + } + } else { + axstat = rg_axstat (mwr, Memi[rlaxno], Memi[rlaxno+1], + mw, Memi[laxno], Memi[laxno+1], transpose) + projstat = rg_projstat (mwr, Memi[rlaxno], Memi[rlaxno+1], + mw, Memi[laxno], Memi[laxno+1]) + switch (axstat) { + case RG_AXEQUAL, RG_AXNOTEQUAL: + ct = rg_xytoxy (mw, Memd[rxw], Memd[ryw], Memd[ixl], + Memd[iyl], npts, "world", "logical", 1, 2) + case RG_AXSWITCHED: + ct = rg_xytoxy (mw, Memd[ryw], Memd[rxw], Memd[ixl], + Memd[iyl], npts, "world", "logical", 1, 2) + } + if (ct == NULL) { + call fprintf (ofd, + "# \tWarning: Unable to compute image \ + world -> logical transform\n") + if (verbose && ofd != STDOUT) { + call printf ( + "\tWarning: Unable to compute image world -> \ +logical transform\n") + } + if (IM_NDIM(imr) == 1) + call rg_rxyl (Memd[rxl], Memd[ryl], nx, 1, 1.0d0, + double(IM_LEN(im,1)), 1.0d0, 1.0d0) + else + call rg_rxyl (Memd[rxl], Memd[ryl], nx, ny, 1.0d0, + double(IM_LEN(im,1)), 1.0d0, + double(IM_LEN(im,2))) + call amovd (Memd[rxl], Memd[ixl], npts) + call amovd (Memd[ryl], Memd[iyl], npts) + } else if (axstat == RG_AXNOTEQUAL) { + call fprintf (ofd, + "# \tWarning: Reference and image axtype \ +attributes are different\n") + if (verbose && ofd != STDOUT) { + call printf ( + "\tWarning: Reference and image axtype \ +attributes are different\n") + } + if (IM_NDIM(imr) == 1) + call rg_rxyl (Memd[rxl], Memd[ryl], nx, 1, 1.0d0, + double(IM_LEN(im,1)), 1.0d0, 1.0d0) + else + call rg_rxyl (Memd[rxl], Memd[ryl], nx, ny, 1.0d0, + double(IM_LEN(im,1)), 1.0d0, + double(IM_LEN(im,2))) + call amovd (Memd[rxl], Memd[ixl], npts) + call amovd (Memd[ryl], Memd[iyl], npts) + } else if (projstat == RG_AXNOTEQUAL) { + call fprintf (ofd, + "# \tWarning: Reference and image wtype \ +attributes are different\n") + if (verbose && ofd != STDOUT) { + call printf ( + "\tWarning: Reference and image wtype \ +attributes are different\n") + } + } + } + } + + # Write out the results. + call rg_wcoords (ofd, Memd[rxl], Memd[ryl], Memd[ixl], + Memd[iyl], Memd[rxw], Memd[ryw], npts, Memc[xformat], + Memc[yformat], Memc[wxformat], Memc[wyformat]) + + # Close the input image and its wcs. + if (mw != NULL) + call mw_close (mw) + call imunmap (im) + + # Close the output coordinate file if it is not going to + # be appended to. + if (fntlenb(olist) == imtlen(ilist)) + call close (ofd) + } + + if (imr != NULL) { + call mfree (rxl, TY_DOUBLE) + call mfree (ryl, TY_DOUBLE) + call mfree (rxw, TY_DOUBLE) + call mfree (ryw, TY_DOUBLE) + call mfree (ixl, TY_DOUBLE) + call mfree (iyl, TY_DOUBLE) + if (mwr != NULL) + call mw_close (mwr) + call imunmap (imr) + } + if (cfd != NULL) + call close (cfd) + if (fntlenb(olist) < imtlen(ilist)) + call close (ofd) + if (ilist != NULL) + call imtclose (ilist) + if (rlist != NULL) + call imtclose (rlist) + if (olist != NULL) + call fntclsb (olist) + if (clist != NULL) + call fntclsb (clist) + + call sfree (sp) +end + + +# RG_WSETFMT -- Set the world coordinate format. + +procedure rg_wsetfmt (mwr, mw, wcs, rlaxno, laxno, min_sigdigits, + wformat, maxch) + +pointer mwr #I pointer to the reference image wcs +pointer mw #I pointer to the input image wcs +int wcs #I the input wcs type +int rlaxno #I the reference physical axis number +int laxno #I the input physical axis number +int min_sigdigits #I the minimum number of significant digits +char wformat[ARB] #O the output world coordinate format +int maxch #I the maximum size of the format string + +pointer sp, str +bool streq() + +begin + call smark (sp) + call salloc (str, SZ_FNAME, TY_CHAR) + + if (mwr == NULL || mw == NULL) { + call sprintf (wformat, maxch, "%%%d.%dg") + call pargi (min_sigdigits + 3) + call pargi (min_sigdigits) + + } else if (wcs == RG_PHYSICAL) { + call strcpy ("%10.3f", wformat, maxch) + + } else { + iferr { + call mw_gwattrs (mwr, rlaxno, "format", wformat, maxch) + } then { + iferr { + call mw_gwattrs (mw, laxno, "format", wformat, maxch) + } then { + iferr { + call mw_gwattrs (mwr, rlaxno, "axtype", Memc[str], + SZ_FNAME) + } then { + call sprintf (wformat, maxch, "%%%d.%dg") + call pargi (min_sigdigits + 3) + call pargi (min_sigdigits) + } else { + if (streq (Memc[str], "ra")) + call strcpy ("%11.1H", wformat, maxch) + else if (streq (Memc[str], "dec")) + call strcpy ("%11.1h", wformat, maxch) + else if (streq (Memc[str+1], "lon")) + call strcpy ("%11.1h", wformat, maxch) + else if (streq (Memc[str+1], "lat")) + call strcpy ("%11.1h", wformat, maxch) + else { + call sprintf (wformat, maxch, "%%%d.%dg") + call pargi (min_sigdigits + 3) + call pargi (min_sigdigits) + } + } + } + } + } + + call sfree (sp) +end + + +# RG_AXSTAT -- Determine whether or not the two axes are equal. + +int procedure rg_axstat (mw1, ax11, ax12, mw2, ax21, ax22, transpose) + +pointer mw1 #I pointer to the first wcs +int ax11, ax12 #I the logical reference axes +pointer mw2 #I pointer to the second wcs +int ax21, ax22 #I the logical input axes +bool transpose #I transpose the world coordinates + +int stat +pointer sp, xax1, yax1, xax2, yax2 +bool streq() +errchk mw_gwattrs() + +begin + call smark (sp) + call salloc (xax1, SZ_FNAME, TY_CHAR) + call salloc (yax1, SZ_FNAME, TY_CHAR) + call salloc (xax2, SZ_FNAME, TY_CHAR) + call salloc (yax2, SZ_FNAME, TY_CHAR) + + iferr (call mw_gwattrs (mw1, ax11, "axtype", Memc[xax1], SZ_FNAME)) + Memc[xax1] = EOS + iferr (call mw_gwattrs (mw1, ax12, "axtype", Memc[yax1], SZ_FNAME)) + Memc[yax1] = EOS + iferr (call mw_gwattrs (mw2, ax21, "axtype", Memc[xax2], SZ_FNAME)) + Memc[xax2] = EOS + iferr (call mw_gwattrs (mw2, ax22, "axtype", Memc[yax2], SZ_FNAME)) + Memc[yax2] = EOS + + if (transpose) + stat = RG_AXSWITCHED + else if (streq (Memc[xax1], Memc[xax2]) && streq(Memc[yax1], + Memc[yax2])) + stat = RG_AXEQUAL + else if (streq (Memc[xax1], Memc[yax2]) && streq(Memc[yax1], + Memc[xax2])) + stat = RG_AXSWITCHED + else + stat = RG_AXNOTEQUAL + + call sfree (sp) + + return (stat) +end + + +# RG_PROJSTAT -- Determine whether or not the projections of two axes are equal. + +int procedure rg_projstat (mw1, ax11, ax12, mw2, ax21, ax22) + +pointer mw1 #I pointer to the first wcs +int ax11, ax12 #I the logical reference axes +pointer mw2 #I pointer to the second wcs +int ax21, ax22 #I the logical reference axes + +int stat +pointer sp, xproj1, yproj1, xproj2, yproj2 +bool streq() +errchk mw_gwattrs() + +begin + call smark (sp) + call salloc (xproj1, SZ_FNAME, TY_CHAR) + call salloc (yproj1, SZ_FNAME, TY_CHAR) + call salloc (xproj2, SZ_FNAME, TY_CHAR) + call salloc (yproj2, SZ_FNAME, TY_CHAR) + + iferr (call mw_gwattrs (mw1, ax11, "wtype", Memc[xproj1], SZ_FNAME)) + Memc[xproj1] = EOS + iferr (call mw_gwattrs (mw1, ax12, "wtype", Memc[yproj1], SZ_FNAME)) + Memc[yproj1] = EOS + iferr (call mw_gwattrs (mw2, ax21, "wtype", Memc[xproj2], SZ_FNAME)) + Memc[xproj2] = EOS + iferr (call mw_gwattrs (mw2, ax22, "wtype", Memc[yproj2], SZ_FNAME)) + Memc[yproj2] = EOS + + if (streq (Memc[xproj1], Memc[xproj2]) && streq(Memc[yproj1], + Memc[yproj2])) + stat = RG_AXEQUAL + else if (streq (Memc[xproj1], Memc[yproj2]) && streq(Memc[yproj1], + Memc[xproj2])) + stat = RG_AXSWITCHED + else + stat = RG_AXNOTEQUAL + + call sfree (sp) + + return (stat) +end + + +# RG_WCOORDS -- Write out the reference and input logical coordinates of the +# tie points and the reference world coordinates. + +procedure rg_wcoords (ofd, xref, yref, xin, yin, wxref, wyref, npts, + xformat, yformat, wxformat, wyformat) + +int ofd #I the output file descriptor +double xref[ARB] #I the reference logical x coordinates +double yref[ARB] #I the reference logical y coordinates +double xin[ARB] #I the input logical x coordinates +double yin[ARB] #I the input logical y coordinates +double wxref[ARB] #I the input reference world x coordinates +double wyref[ARB] #I the input reference world y coordinates +int npts #I the number of input points +char xformat[ARB] #I the logical x coordinates format +char yformat[ARB] #I the logical y coordinates format +char wxformat[ARB] #I the world x coordinates format +char wyformat[ARB] #I the world y coordinates format + +int i +pointer sp, fmtstr + +begin + call smark (sp) + call salloc (fmtstr, SZ_LINE, TY_CHAR) + + # Write the column descriptions. + call fprintf (ofd, + "# \tColumn 1: reference logical x coordinate\n") + call fprintf (ofd, + "# \tColumn 2: reference logical y coordinate\n") + call fprintf (ofd, + "# \tColumn 3: input logical x coordinate\n") + call fprintf (ofd, + "# \tColumn 4: input logical y coordinate\n") + call fprintf (ofd, + "# \tColumn 5: reference world x coordinate\n") + call fprintf (ofd, + "# \tColumn 6: reference world y coordinate\n") + call fprintf (ofd, "\n") + + # Create the format string. + call sprintf (Memc[fmtstr], SZ_LINE, "%s %s %s %s %s %s\n") + call pargstr (xformat) + call pargstr (yformat) + call pargstr (xformat) + call pargstr (yformat) + call pargstr (wxformat) + call pargstr (wyformat) + + do i = 1, npts { + call fprintf (ofd, Memc[fmtstr]) + call pargd (xref[i]) + call pargd (yref[i]) + call pargd (xin[i]) + call pargd (yin[i]) + call pargd (wxref[i]) + call pargd (wyref[i]) + } + + call sfree (sp) +end + + +# RG_LAXMAP (paxno, wcsndim, laxno, ndim) + +procedure rg_laxmap (paxno, wcsndim, laxno, ndim) + +int paxno[ARB] #I the physical axis map +int wcsndim #I the number of physical axis dimensions +int laxno[ARB] #O the physical axis map +int ndim #I the number of logical axis dimensions + +int i, j + +begin + if (ndim < wcsndim) { + do i = 1, ndim { + laxno[i] = 0 + do j = 1, wcsndim { + if (paxno[j] != i) + next + laxno[i] = j + break + } + } + do i = ndim + 1, wcsndim + laxno[i] = 0 + } else { + do i = 1, wcsndim + laxno[i] = i + } +end diff --git a/pkg/images/immatch/src/wcsmatch/wcsxymatch.h b/pkg/images/immatch/src/wcsmatch/wcsxymatch.h new file mode 100644 index 00000000..b92673a6 --- /dev/null +++ b/pkg/images/immatch/src/wcsmatch/wcsxymatch.h @@ -0,0 +1,15 @@ +# Define the permitted input wcs types +define RG_WCSLIST "|physical|world|" + +define RG_PHYSICAL 1 +define RG_WORLD 2 + +# Define the permitted units +define RG_UNITLIST "|hours|native|" +define RG_UHOURS 1 +define RG_UNATIVE 2 + +# Define the relationship between the two axes +define RG_AXEQUAL 1 +define RG_AXSWITCHED 2 +define RG_AXNOTEQUAL 3 diff --git a/pkg/images/immatch/src/xregister/mkpkg b/pkg/images/immatch/src/xregister/mkpkg new file mode 100644 index 00000000..262b721d --- /dev/null +++ b/pkg/images/immatch/src/xregister/mkpkg @@ -0,0 +1,25 @@ +# Make the XREGISTER task + +$checkout libpkg.a ../../../ +$update libpkg.a +$checkin libpkg.a ../../../ +$exit + +libpkg.a: + rgxbckgrd.x "xregister.h" <math/gsurfit.h> + rgxcolon.x "xregister.h" <imhdr.h> <imset.h> <error.h> + rgxcorr.x "xregister.h" <imhdr.h> <math/gsurfit.h> <math.h> + rgxdbio.x "xregister.h" + rgxfft.x + rgxfit.x "xregister.h" <math/iminterp.h> <mach.h> <math/nlfit.h> + rgxgpars.x "xregister.h" + rgxicorr.x "xregister.h" <ctype.h> <imhdr.h> <fset.h> + rgximshift.x <imhdr.h> <imset.h> <math/iminterp.h> + rgxplot.x <imhdr.h> <gset.h> + rgxppars.x "xregister.h" + rgxregions.x "xregister.h" <fset.h> <imhdr.h> <ctype.h> + rgxshow.x "xregister.h" + rgxtools.x "xregister.h" + rgxtransform.x "xregister.h" <imhdr.h> <math.h> + t_xregister.x "xregister.h" <fset.h> <gset.h> <imhdr.h> <imset.h> + ; diff --git a/pkg/images/immatch/src/xregister/oxregister.key b/pkg/images/immatch/src/xregister/oxregister.key new file mode 100644 index 00000000..91064ff8 --- /dev/null +++ b/pkg/images/immatch/src/xregister/oxregister.key @@ -0,0 +1,33 @@ + Xregister Image Overlay Sub-menu + + +? Print help +c Overlay the marked column of the reference image + with the same column of the input image +l Overlay the marked line of the reference image + with the sname line of the input image +x Overlay the marked column of the reference image + with the x and y lagged column of the input image +y Overlay the marked line of the reference image + with the x and y lagged line of the input image +v Overlay the marked column of the reference image + with the x and y shifted column of the input image +h Overlay the marked line of the reference image + with the x and y shifted line of the input image +q Quit + + + Image Overlay Sub-menu Colon Commands + +:c [m] [n] Overlay the middle [mth] column of the reference image + with the mth [nth] column of the input image +:l [m] [n] Overlay the middle [mth] line of the reference image + with the mth [nth] line of the input image +:x [m] Overlay the middle [mth] column of the reference image + with the x and y lagged column of the input image +:y [m] Overlay the middle [mth] line of the reference image + with the x and y lagged line of the input image +:v [m] Overlay the middle [mth] column of the reference image + with the x and y shifted column of the input image +:h [m] Overlay the middle [mth] line of the reference image + with the x and y shifted line of the input image diff --git a/pkg/images/immatch/src/xregister/rgxbckgrd.x b/pkg/images/immatch/src/xregister/rgxbckgrd.x new file mode 100644 index 00000000..c9747ee6 --- /dev/null +++ b/pkg/images/immatch/src/xregister/rgxbckgrd.x @@ -0,0 +1,63 @@ +include <math/gsurfit.h> +include "xregister.h" + +# RG_XSCALE -- Compute the background offset and x and y slope. + +procedure rg_xscale (xc, data, npts, nx, ny, offset, coeff) + +pointer xc #I pointer to the cross-correlation function +real data[ARB] #I the input data +int npts #I the number of points +int nx, ny #I the dimensions of the original subraster +real offset #I the input offset +real coeff[ARB] #O the output coefficients + +int wborder +pointer gs +real loreject, hireject, zero +int rg_xstati(), rg_znsum(), rg_znmedian(), rg_slope() +real rg_xstatr() + +begin + loreject = rg_xstatr (xc, LOREJECT) + hireject = rg_xstatr (xc, HIREJECT) + wborder = rg_xstati (xc, BORDER) + + switch (rg_xstati (xc, BACKGRD)) { + case XC_BNONE: + coeff[1] = offset + coeff[2] = 0.0 + coeff[3] = 0.0 + case XC_MEAN: + if (rg_znsum (data, npts, zero, loreject, hireject) <= 0) + zero = 0.0 + coeff[1] = zero + coeff[2] = 0.0 + coeff[3] = 0.0 + case XC_MEDIAN: + if (rg_znmedian (data, npts, zero, loreject, hireject) <= 0) + zero = 0.0 + coeff[1] = zero + coeff[2] = 0.0 + coeff[3] = 0.0 + case XC_SLOPE: + call gsinit (gs, GS_POLYNOMIAL, 2, 2, GS_XNONE, 1.0, real (nx), 1.0, + real (ny)) + if (rg_slope (gs, data, npts, nx, ny, wborder, wborder, loreject, + hireject) == ERR) { + coeff[1] = 0.0 + coeff[2] = 0.0 + coeff[3] = 0.0 + } else { + call gssave (gs, coeff) + coeff[1] = coeff[GS_SAVECOEFF+1] + coeff[2] = coeff[GS_SAVECOEFF+2] + coeff[3] = coeff[GS_SAVECOEFF+3] + } + call gsfree (gs) + default: + coeff[1] = offset + coeff[2] = 0.0 + coeff[3] = 0.0 + } +end diff --git a/pkg/images/immatch/src/xregister/rgxcolon.x b/pkg/images/immatch/src/xregister/rgxcolon.x new file mode 100644 index 00000000..cb007473 --- /dev/null +++ b/pkg/images/immatch/src/xregister/rgxcolon.x @@ -0,0 +1,508 @@ +include <error.h> +include <imhdr.h> +include <imset.h> +include "xregister.h" + +# RG_XCOLON-- Procedure to process colon commands for setting the cross- +# correlation parameters. + +procedure rg_xcolon (gd, xc, imr, im1, im2, db, dformat, tfd, reglist, cmdstr, + newdata, newcross, newcenter) + +pointer gd #I pointer to the graphics stream +pointer xc #I pointer to cross-correlation structure +pointer imr #I/O pointer to the reference image +pointer im1 #I/O pointer to the input image +pointer im2 #I/O pointer to the output image +pointer db #I/O pointer to the shifts database file +int dformat #I is the shifts file in database format +int tfd #I/O the transformations file descriptor +pointer reglist #I/O pointer to the regions list +char cmdstr[ARB] #I input command string +int newdata #I/O new input data +int newcross #I/O new cross-correlation function flag +int newcenter #I/O new cross-correlation peak flag + +bool streq() +int ncmd, creg, nreg, ival, stat +pointer sp, cmd, str +real rval +int strdic(), open(), nscan(), rg_xstati(), fntopnb() +int rg_xregions(), rg_xmkregions(), strlen() +pointer immap(), dtmap(), rg_xstatp() +real rg_xstatr() +errchk immap(), dtmap(), open(), fntopnb() + +begin + call smark (sp) + call salloc (cmd, SZ_LINE, TY_CHAR) + call salloc (str, SZ_LINE, TY_CHAR) + + # Get the command. + call sscan (cmdstr) + call gargwrd (Memc[cmd], SZ_LINE) + if (Memc[cmd] == EOS) { + call sfree (sp) + return + } + + # Process the command. + ncmd = strdic (Memc[cmd], Memc[cmd], SZ_LINE, XCMDS) + switch (ncmd) { + case XCMD_REFIMAGE: + call gargwrd (Memc[cmd], SZ_LINE) + call rg_xstats (xc, REFIMAGE, Memc[str], SZ_FNAME) + if (Memc[cmd] == EOS || streq (Memc[cmd], Memc[str])) { + call printf ("%s: %s\n") + call pargstr (KY_REFIMAGE) + call pargstr (Memc[str]) + } else { + if (imr != NULL) { + call imunmap (imr) + imr = NULL + } + iferr { + imr = immap (Memc[cmd], READ_ONLY, 0) + } then { + call erract (EA_WARN) + imr = immap (Memc[str], READ_ONLY, 0) + } else if (IM_NDIM(imr) > 2 || IM_NDIM(imr) != IM_NDIM(im1)) { + call printf ( + "Image has the wrong number of dimensions\n") + call imunmap (imr) + imr = immap (Memc[str], READ_ONLY, 0) + } else { + call rg_xsets (xc, REFIMAGE, Memc[cmd]) + newdata = YES; newcross = YES; newcenter = YES + } + } + + case XCMD_IMAGE: + call gargwrd (Memc[cmd], SZ_LINE) + call rg_xstats (xc, IMAGE, Memc[str], SZ_FNAME) + if (Memc[cmd] == EOS || streq (Memc[cmd], Memc[str])) { + call printf ("%s: %s\n") + call pargstr (KY_IMAGE) + call pargstr (Memc[str]) + } else { + if (im1 != NULL) { + call imunmap (im1) + im1 = NULL + } + iferr { + im1 = immap (Memc[cmd], READ_ONLY, 0) + call imseti (im1, IM_TYBNDRY, BT_NEAREST) + if (IM_NDIM(im1) == 1) + call imseti (im1, IM_NBNDRYPIX, IM_LEN(im1,1)) + else + call imseti (im1, IM_NBNDRYPIX, + max (IM_LEN(im1,1), IM_LEN(im1,2))) + } then { + call erract (EA_WARN) + im1 = immap (Memc[str], READ_ONLY, 0) + call imseti (im1, IM_TYBNDRY, BT_NEAREST) + if (IM_NDIM(im1) == 1) + call imseti (im1, IM_NBNDRYPIX, IM_LEN(im1,1)) + else + call imseti (im1, IM_NBNDRYPIX, + max (IM_LEN(im1,1), IM_LEN(im1,2))) + } else if (IM_NDIM(im1) > 2 || IM_NDIM(im1) != IM_NDIM(imr)) { + call printf ( + "Image has the wrong number of dimensions\n") + call imunmap (im1) + im1 = immap (Memc[str], READ_ONLY, 0) + call imseti (im1, IM_TYBNDRY, BT_NEAREST) + if (IM_NDIM(im1) == 1) + call imseti (im1, IM_NBNDRYPIX, IM_LEN(im1,1)) + else + call imseti (im1, IM_NBNDRYPIX, + max (IM_LEN(im1,1), IM_LEN(im1,2))) + } else { + call rg_xsets (xc, IMAGE, Memc[cmd]) + newdata = YES; newcross = YES; newcenter = YES + } + } + + case XCMD_OUTIMAGE: + call gargwrd (Memc[cmd], SZ_LINE) + call rg_xstats (xc, OUTIMAGE, Memc[str], SZ_FNAME) + if (im2 == NULL || Memc[cmd] == EOS || streq (Memc[cmd], + Memc[str])) { + call printf ("%s: %s\n") + call pargstr (KY_OUTIMAGE) + call pargstr (Memc[str]) + } else { + if (im2 != NULL) { + call imunmap (im2) + im2 = NULL + } + iferr { + im2 = immap (Memc[cmd], NEW_COPY, im1) + } then { + call erract (EA_WARN) + im2 = immap (Memc[str], NEW_COPY, im1) + } else { + call rg_xsets (xc, OUTIMAGE, Memc[cmd]) + } + } + + case XCMD_DATABASE: + call gargwrd (Memc[cmd], SZ_LINE) + call rg_xstats (xc, DATABASE, Memc[str], SZ_FNAME) + if (Memc[cmd] == EOS || streq (Memc[cmd], Memc[str])) { + call printf ("%s: %s\n") + call pargstr (KY_DATABASE) + call pargstr (Memc[str]) + } else { + if (db != NULL) { + if (dformat == YES) + call dtunmap (db) + else + call close (db) + db = NULL + } + iferr { + if (dformat == YES) + db = dtmap (Memc[cmd], APPEND) + else + db = open (Memc[cmd], NEW_FILE, TEXT_FILE) + } then { + call erract (EA_WARN) + if (dformat == YES) + db = dtmap (Memc[str], APPEND) + else + db = open (Memc[str], APPEND, TEXT_FILE) + } else { + call rg_xsets (xc, DATABASE, Memc[cmd]) + } + } + + CASE XCMD_RECORD: + call gargstr (Memc[cmd], SZ_LINE) + if (Memc[cmd] == EOS) { + call rg_xstats (xc, RECORD, Memc[str], SZ_FNAME) + call printf ("%s: %s\n") + call pargstr (KY_RECORD) + call pargstr (Memc[str]) + } else + call rg_xsets (xc, RECORD, Memc[cmd]) + + case XCMD_CREGION: + + call gargi (nreg) + creg = rg_xstati (xc, CREGION) + + if (nscan() == 1 || (nreg == creg)) { + call printf ("%s: %d/%d") + call pargstr (KY_CREGION) + call pargi (creg) + call pargi (rg_xstati (xc, NREGIONS)) + call printf (" [%d:%d,%d:%d]\n") + call pargi (Memi[rg_xstatp (xc,RC1)+creg-1]) + call pargi (Memi[rg_xstatp (xc,RC2)+creg-1]) + call pargi (Memi[rg_xstatp (xc,RL1)+creg-1]) + call pargi (Memi[rg_xstatp (xc,RL2)+creg-1]) + + } else { + if (nreg < 1 || nreg > rg_xstati (xc,NREGIONS)) { + call printf ("Region %d is out of range\n") + call pargi (nreg) + } else { + call printf ( + "Setting current region to %d: [%d:%d,%d:%d]\n") + call pargi (nreg) + call pargi (Memi[rg_xstatp (xc,RC1)+nreg-1]) + call pargi (Memi[rg_xstatp (xc,RC2)+nreg-1]) + call pargi (Memi[rg_xstatp (xc,RL1)+nreg-1]) + call pargi (Memi[rg_xstatp (xc,RL2)+nreg-1]) + call rg_xseti (xc, CREGION, nreg) + newdata = YES; newcross = YES; newcenter = YES + } + + } + + case XCMD_REGIONS: + + call gargwrd (Memc[cmd], SZ_LINE) + call rg_xstats (xc, REGIONS, Memc[str], SZ_FNAME) + if (nscan() == 1 || streq (Memc[cmd], Memc[str]) || Memc[cmd] == + EOS) { + call printf ("%s [string/file]: %s\n") + call pargstr (KY_REGIONS) + call pargstr (Memc[str]) + } else { + if (reglist != NULL) { + call fntclsb (reglist) + reglist = NULL + } + iferr (reglist = fntopnb (Memc[cmd], NO)) + reglist = NULL + if (rg_xregions (reglist, imr, xc, 1) > 0) { + call rg_xseti (xc, CREGION, 1) + call rg_xsets (xc, REGIONS, Memc[cmd]) + newdata = YES; newcross = YES; newcenter = YES + } else { + if (reglist != NULL) { + call fntclsb (reglist) + reglist = NULL + } + iferr (reglist = fntopnb (Memc[str], NO)) + reglist = NULL + if (rg_xregions (reglist, imr, xc, 1) > 0) + ; + call rg_xsets (xc, REGIONS, Memc[str]) + call rg_xseti (xc, CREGION, 1) + } + } + + case XCMD_REFFILE: + + call gargwrd (Memc[cmd], SZ_LINE) + call rg_xstats (xc, REFFILE, Memc[str], SZ_FNAME) + if (Memc[cmd] == EOS || streq (Memc[cmd], Memc[str])) { + call printf ("%s: %s\n") + call pargstr (KY_REFFILE) + call pargstr (Memc[str]) + } else { + if (tfd != NULL) { + call close (tfd) + tfd = NULL + } + iferr { + tfd = open (Memc[cmd], READ_ONLY, TEXT_FILE) + } then { + tfd = NULL + call erract (EA_WARN) + call rg_xsets (xc, REFFILE, "") + call printf ("Coords file is undefined.\n") + } else + call rg_xsets (xc, REFFILE, Memc[cmd]) + newdata = YES; newcross = YES; newcenter = YES + } + + case XCMD_XLAG: + call gargi (ival) + if (nscan () == 1) { + call printf ("%s = %d\n") + call pargstr (KY_XLAG) + call pargi (rg_xstati (xc, XLAG)) + } else { + call rg_xseti (xc, XLAG, ival) + newdata = YES; newcross = YES; newcenter = YES + } + + case XCMD_YLAG: + call gargi (ival) + if (nscan() == 1) { + call printf ("%s = %d\n") + call pargstr (KY_YLAG) + call pargi (rg_xstati (xc, YLAG)) + } else { + call rg_xseti (xc, YLAG, ival) + newdata = YES; newcross = YES; newcenter = YES + } + + case XCMD_DXLAG: + call gargi (ival) + if (nscan() == 1) { + call printf ("%s = %d\n") + call pargstr (KY_DXLAG) + call pargi (rg_xstati (xc, DXLAG)) + } else { + call rg_xseti (xc, DXLAG, ival) + } + + case XCMD_DYLAG: + call gargi (ival) + if (nscan() == 1) { + call printf ("%s = %d\n") + call pargstr (KY_DYLAG) + call pargi (rg_xstati (xc, DYLAG)) + } else { + call rg_xseti (xc, DYLAG, ival) + } + + case XCMD_BACKGROUND: + call gargwrd (Memc[cmd], SZ_LINE) + if (Memc[cmd] != EOS) + call strcat (" ", Memc[cmd], SZ_LINE) + call gargwrd (Memc[cmd+strlen(Memc[cmd])], SZ_LINE) + if (Memc[cmd] == EOS) { + call rg_xstats (xc, BSTRING, Memc[str], SZ_FNAME) + call printf ("%s: %s\n") + call pargstr (KY_BACKGROUND) + call pargstr (Memc[str]) + } else { + call rg_xsets (xc, BSTRING, Memc[cmd]) + newdata = YES; newcross = YES; newcenter = YES + } + + case XCMD_BORDER: + call gargi (ival) + if (nscan() == 1) { + call printf ("%s = %d\n") + call pargstr (KY_BORDER) + call pargi (rg_xstati (xc, BORDER)) + } else { + call rg_xseti (xc, BORDER, ival) + newdata = YES; newcross = YES; newcenter = YES + } + + case XCMD_LOREJECT: + call gargr (rval) + if (nscan() == 1) { + call printf ("%s = %g\n") + call pargstr (KY_LOREJECT) + call pargr (rg_xstatr (xc, LOREJECT)) + } else { + call rg_xsetr (xc, LOREJECT, rval) + newdata = YES; newcross = YES; newcenter = YES + } + + case XCMD_HIREJECT: + call gargr (rval) + if (nscan() == 1) { + call printf ("%s = %g\n") + call pargstr (KY_HIREJECT) + call pargr (rg_xstatr (xc, HIREJECT)) + } else { + call rg_xsetr (xc, HIREJECT, rval) + newdata = YES; newcross = YES; newcenter = YES + } + + case XCMD_APODIZE: + call gargr (rval) + if (nscan() == 1) { + call printf ("%s = %g\n") + call pargstr (KY_APODIZE) + call pargr (rg_xstatr (xc, APODIZE)) + } else { + call rg_xsetr (xc, APODIZE, max (0.0, min (rval, 0.50))) + newdata = YES; newcross = YES; newcenter = YES + } + + case XCMD_CORRELATION: + call gargwrd (Memc[cmd], SZ_LINE) + if (Memc[cmd] == EOS) { + call rg_xstats (xc, CSTRING, Memc[str], SZ_FNAME) + call printf ("%s = %s\n") + call pargstr (KY_CORRELATION) + call pargstr (Memc[str]) + } else { + stat = strdic (Memc[cmd], Memc[cmd], SZ_LINE, XC_CTYPES) + if (stat > 0) { + call rg_xseti (xc, CFUNC, stat) + call rg_xsets (xc, CSTRING, Memc[cmd]) + newcross = YES; newcenter = YES + } + } + + case XCMD_XWINDOW: + call gargi (ival) + if (nscan() == 1) { + call printf ("%s = %d\n") + call pargstr (KY_XWINDOW) + call pargi (rg_xstati (xc, XWINDOW)) + } else { + call rg_xseti (xc, XWINDOW, ival) + newdata = YES; newcross = YES; newcenter = YES + } + + case XCMD_YWINDOW: + call gargi (ival) + if (nscan() == 1) { + call printf ("%s = %d\n") + call pargstr (KY_YWINDOW) + call pargi (rg_xstati (xc, YWINDOW)) + } else { + call rg_xseti (xc, YWINDOW, ival) + newdata = YES; newcross = YES; newcenter = YES + } + + case XCMD_PEAKCENTER: + call gargwrd (Memc[cmd], SZ_LINE) + if (Memc[cmd] == EOS) { + call rg_xstats (xc, PSTRING, Memc[str], SZ_FNAME) + call printf ("%s: %s\n") + call pargstr (KY_PEAKCENTER) + call pargstr (Memc[str]) + } else { + stat = strdic (Memc[cmd], Memc[cmd], SZ_LINE, XC_PTYPES) + if (stat > 0) { + call rg_xseti (xc, PFUNC, stat) + call rg_xsets (xc, PSTRING, Memc[cmd]) + newcenter = YES + } + } + + case XCMD_XCBOX: + call gargi (ival) + if (nscan() == 1) { + call printf ("%s = %d\n") + call pargstr (KY_XCBOX) + call pargi (rg_xstati (xc, XCBOX)) + } else { + if (mod (ival, 2) == 0) + ival = ival + 1 + call rg_xseti (xc, XCBOX, ival) + newcenter = YES + } + + case XCMD_YCBOX: + call gargi (ival) + if (nscan() == 1) { + call printf ("%s = %g\n") + call pargstr (KY_YCBOX) + call pargi (rg_xstati (xc, YCBOX)) + } else { + if (mod (ival, 2) == 0) + ival = ival + 1 + call rg_xseti (xc, YCBOX, ival) + newcenter = YES + } + + case XCMD_SHOW: + call gdeactivate (gd, 0) + call gargwrd (Memc[cmd], SZ_LINE) + ncmd = strdic (Memc[cmd], Memc[cmd], SZ_LINE, XSHOW) + switch (ncmd) { + case XSHOW_DATA: + call rg_xnshow (xc) + case XSHOW_BACKGROUND: + call rg_xbshow (xc) + case XSHOW_CORRELATION: + call rg_xxshow (xc) + case XSHOW_PEAKCENTER: + call rg_xpshow (xc) + default: + call rg_xshow (xc) + } + call greactivate (gd, 0) + + case XCMD_MARK: + call gdeactivate (gd, 0) + if (reglist != NULL) { + call fntclsb (reglist) + reglist = NULL + } + if (rg_xmkregions (imr, xc, 1, MAX_NREGIONS, Memc[str], + SZ_LINE) <= 0) { + call rg_xstats (xc, REGIONS, Memc[str], SZ_LINE) + iferr (reglist = fntopnb (Memc[str], NO)) + reglist = NULL + if (rg_xregions (reglist, imr, xc, 1) > 0) + ; + call rg_xsets (xc, REGIONS, Memc[str]) + call rg_xseti (xc, CREGION, 1) + } else { + call rg_xseti (xc, CREGION, 1) + call rg_xsets (xc, REGIONS, Memc[str]) + newdata = YES; newcross = YES; newcenter = YES + } + call greactivate (gd, 0) + default: + call printf ("Unknown or ambiguous colon command\7\n") + } + + call sfree (sp) +end diff --git a/pkg/images/immatch/src/xregister/rgxcorr.x b/pkg/images/immatch/src/xregister/rgxcorr.x new file mode 100644 index 00000000..a708bf7a --- /dev/null +++ b/pkg/images/immatch/src/xregister/rgxcorr.x @@ -0,0 +1,1034 @@ +include <imhdr.h> +include <math.h> +include <math/gsurfit.h> +include "xregister.h" + +# RG_XCORR -- Compute the shift shift for an image relative to a reference +# image using cross-correlation techniques. + +int procedure rg_xcorr (imr, im1, db, dformat, xc) + +pointer imr #I pointer to the reference image +pointer im1 #I pointer to the input image +pointer db #I pointer to the shifts database +int dformat #I write shifts file in database format ? +pointer xc #I pointer to the cross-correlation structure + +pointer sp, image, imname +real xshift, yshift +bool streq() +int rg_xstati(), fscan(), nscan() +errchk rg_cross(), rg_xfile() + +begin + # Allocate working space. + call smark (sp) + call salloc (image, SZ_FNAME, TY_CHAR) + call salloc (imname, SZ_FNAME, TY_CHAR) + call rg_xstats (xc, IMAGE, Memc[image], SZ_FNAME) + + # Initialize. + xshift = 0.0 + yshift = 0.0 + + # Compute the average shift for the image. + switch (rg_xstati (xc, CFUNC)) { + case XC_DISCRETE, XC_DIFFERENCE, XC_FOURIER: + + # Write out the parameters. + if (dformat == YES) + call rg_xdbparams (db, xc) + + # Compute the cross-correlation function. + call rg_cross (imr, im1, xc, NULL, xshift, yshift) + call rg_xsetr (xc, TXSHIFT, xshift) + call rg_xsetr (xc, TYSHIFT, yshift) + + # Write out the results for the individual regions. + if (dformat == YES) + call rg_xwreg (db, xc) + + # Write out the total shifts. + if (dformat == YES) + call rg_xdbshift (db, xc) + else { + call fprintf (db, "%s %g %g\n") + call pargstr (Memc[image]) + call pargr (xshift) + call pargr (yshift) + } + + # Set the x and y lags for the next picture. + if (rg_xstati (xc, NREFPTS) > 0) { + call rg_xseti (xc, XLAG, 0) + call rg_xseti (xc, YLAG, 0) + } else if (IS_INDEFI (rg_xstati (xc, DXLAG)) || + IS_INDEFI (rg_xstati (xc, DYLAG))) { + call rg_xseti (xc, XLAG, nint (-xshift)) + call rg_xseti (xc, YLAG, nint (-yshift)) + } else { + call rg_xseti (xc, XLAG, rg_xstati (xc, XLAG) + rg_xstati (xc, + DXLAG)) + call rg_xseti (xc, YLAG, rg_xstati (xc, YLAG) + rg_xstati (xc, + DYLAG)) + } + + case XC_FILE: + if (dformat == YES) + call rg_xfile (db, xc, xshift, yshift) + else { + if (fscan (db) != EOF) { + call gargwrd (Memc[imname], SZ_FNAME) + call gargr (xshift) + call gargr (yshift) + if (! streq (Memc[imname], Memc[image]) || nscan() != 3) { + xshift = 0.0 + yshift = 0.0 + } + } else { + xshift = 0.0 + yshift = 0.0 + } + } + call rg_xsetr (xc, TXSHIFT, xshift) + call rg_xsetr (xc, TYSHIFT, yshift) + + default: + call error (0, "The correlation function is undefined.") + } + + call sfree (sp) + + return (NO) +end + + +# RG_CROSS -- Compute the cross-correlation function for all the regions +# using discrete, fourier, or difference techniques and compute the position +# of its peak using one of several centering algorithms. + +procedure rg_cross (imr, im1, xc, gd, xavshift, yavshift) + +pointer imr #I pointer to the reference image +pointer im1 #I pointer to the input image +pointer xc #I pointer to the cross correlation structure +pointer gd #I pointer to graphics stream +real xavshift #O x coord shift +real yavshift #O y coord shift + +int i, nregions, ngood +pointer pxshift, pyshift +real xshift, yshift +int rg_xstati(), rg_xcget(), rg_xfget() +pointer rg_xstatp() + +begin + # Get the pointers. + pxshift = rg_xstatp (xc, XSHIFTS) + pyshift = rg_xstatp (xc, YSHIFTS) + nregions = rg_xstati (xc, NREGIONS) + + # Loop over the regions. + xavshift = 0.0 + yavshift = 0.0 + ngood = 0 + do i = 1, nregions { + + # Compute the cross_correlation function. + switch (rg_xstati (xc, CFUNC)) { + case XC_DISCRETE, XC_DIFFERENCE: + if (rg_xcget (xc, imr, im1, i) == ERR) { + Memr[pxshift+i-1] = INDEFR + Memr[pyshift+i-1] = INDEFR + if (rg_xstatp (xc, XCOR) != NULL) + call mfree (rg_xstatp (xc, XCOR), TY_REAL) + call rg_xsetp (xc, XCOR, NULL) + next + } + case XC_FOURIER: + if (rg_xfget (xc, imr, im1, i) == ERR) { + Memr[pxshift+i-1] = INDEFR + Memr[pyshift+i-1] = INDEFR + if (rg_xstatp (xc, XCOR) != NULL) + call mfree (rg_xstatp (xc, XCOR), TY_REAL) + call rg_xsetp (xc, XCOR, NULL) + next + } + default: + call error (0, "The correlation function is undefined") + } + + # Find the peak of the cross-correlation function. + call rg_fit (xc, i, gd, xshift, yshift) + + # Accumulate the shifts. + xavshift = xavshift + xshift + yavshift = yavshift + yshift + ngood = ngood + 1 + } + + # Compute the average shift. + if (ngood > 0) { + xavshift = xavshift / ngood + yavshift = yavshift / ngood + } +end + + +# RG_XFILE -- Read the average x and y shifts from the shifts database. + +procedure rg_xfile (db, xc, xshift, yshift) + +pointer db #I pointer to the database +pointer xc #I pointer to the cross correlation structure +real xshift #O shift in x +real yshift #O shift in y + +int rec +pointer sp, str +int dtlocate() +real dtgetr() +errchk dtlocate(), dtgetr() + +begin + call smark (sp) + call salloc (str, SZ_LINE, TY_CHAR) + + call rg_xstats (xc, RECORD, Memc[str], SZ_LINE) + iferr { + rec = dtlocate (db, Memc[str]) + xshift = dtgetr (db, rec, "xshift") + yshift = dtgetr (db, rec, "yshift") + } then { + xshift = 0.0 + yshift = 0.0 + } + + call sfree (sp) +end + + +# RG_ICROSS -- Compute the cross-correlation function for a given region. + +int procedure rg_icross (xc, imr, im1, nreg) + +pointer xc #I pointer to the cross-correlation structure +pointer imr #I pointer to the reference image +pointer im1 #I pointer to the input image +int nreg #I the index of the current region + +int stat +pointer pxshift, pyshift +int rg_xstati(), rg_xcget(), rg_xfget() +pointer rg_xstatp() + +begin + pxshift = rg_xstatp (xc, XSHIFTS) + pyshift = rg_xstatp (xc, YSHIFTS) + + switch (rg_xstati (xc, CFUNC)) { + case XC_DISCRETE, XC_DIFFERENCE: + stat = rg_xcget (xc, imr, im1, nreg) + if (stat == ERR) { + Memr[pxshift+nreg-1] = INDEFR + Memr[pyshift+nreg-1] = INDEFR + if (rg_xstatp (xc, XCOR) != NULL) + call mfree (rg_xstatp (xc, XCOR), TY_REAL) + call rg_xsetp (xc, XCOR, NULL) + } + case XC_FOURIER: + stat = rg_xfget (xc, imr, im1, nreg) + if (stat == ERR) { + Memr[pxshift+nreg-1] = INDEFR + Memr[pyshift+nreg-1] = INDEFR + if (rg_xstatp (xc, XCOR) != NULL) + call mfree (rg_xstatp (xc, XCOR), TY_REAL) + call rg_xsetp (xc, XCOR, NULL) + } + case XC_FILE: + stat = OK + } + + return (stat) +end + + +# RG_XCGET -- Compute the convolution using the discrete or difference +# correlation functions. + +int procedure rg_xcget (xc, imr, im1, i) + +pointer xc #I pointer to the cross-correlation structure +pointer imr #I pointer to the reference image +pointer im1 #I pointer to input image image +int i #I index of region + +int stat, xwindow, ywindow, nrimcols, nrimlines, nimcols, nimlines +int nrcols, nrlines, ncols, nlines +int xlag, ylag, nborder, rc1, rc2, rl1, rl2, c1, c2, l1, l2 +pointer sp, str, coeff, rbuf, ibuf, xcor +pointer prc1, prc2, prl1, prl2, przero, prxslope, pryslope, border +real rxlag, rylag +int rg_xstati(), rg_border() +pointer rg_xstatp(), rg_ximget() +real rg_xstatr() + +define nextregion_ 10 + +begin + call smark (sp) + call salloc (str, SZ_LINE, TY_CHAR) + call salloc (coeff, max (GS_SAVECOEFF + 6, 9), TY_REAL) + rbuf = NULL + ibuf = NULL + + # Check for regions. + if (i > rg_xstati (xc, NREGIONS)) { + stat = ERR + goto nextregion_ + } + + # Get the image sizes. + nrimcols = IM_LEN(imr,1) + if (IM_NDIM(imr) == 1) + nrimlines = 1 + else + nrimlines = IM_LEN(imr,2) + nimcols = IM_LEN(im1,1) + if (IM_NDIM(im1) == 1) + nimlines = 1 + else + nimlines = IM_LEN(im1,2) + + # Get the reference region pointers. + prc1 = rg_xstatp (xc, RC1) + prc2 = rg_xstatp (xc, RC2) + prl1 = rg_xstatp (xc, RL1) + prl2 = rg_xstatp (xc, RL2) + przero = rg_xstatp (xc, RZERO) + prxslope = rg_xstatp (xc, RXSLOPE) + pryslope = rg_xstatp (xc, RYSLOPE) + + # Compute the reference region limits. + rc1 = max (1, min (int (nrimcols), Memi[prc1+i-1])) + rc2 = min (int (nrimcols), max (1, Memi[prc2+i-1])) + rl1 = max (1, min (int (nrimlines), Memi[prl1+i-1])) + rl2 = min (int (nrimlines), max (1, Memi[prl2+i-1])) + nrcols = rc2 - rc1 + 1 + nrlines = rl2 - rl1 + 1 + + # Move to the next reference region if current region is off the image. + if (rc1 > nrimcols || rc2 < 1 || rl1 > nrimlines || rl2 < 1) { + call rg_xstats (xc, REFIMAGE, Memc[str], SZ_LINE) + call eprintf ( + "Reference section: %s[%d:%d,%d:%d] is off image.\n") + call pargstr (Memc[str]) + call pargi (rc1) + call pargi (rc2) + call pargi (rl1) + call pargi (rl2) + stat = ERR + goto nextregion_ + } + + # Check the window sizes. + xwindow = rg_xstati (xc, XWINDOW) + if (nrlines == 1) + ywindow = 1 + else + ywindow = rg_xstati (xc, YWINDOW) + + # Move to next ref regions if current region is too small. + if (nrcols < xwindow || (IM_NDIM(imr) == 2 && nrlines < ywindow)) { + call rg_xstats (xc, REFIMAGE, Memc[str], SZ_LINE) + call eprintf ( + "Reference section: %s[%d:%d,%d:%d] has too few points.\n") + call pargstr (Memc[str]) + call pargi (rc1) + call pargi (rc2) + call pargi (rl1) + call pargi (rl2) + stat = ERR + goto nextregion_ + } + + # Apply the transformation if defined or lag to the ref regions. + if (rg_xstati (xc, NREFPTS) > 0) { + call rg_etransform (xc, (rc1 + rc2) / 2.0, (rl1 + rl2) / 2.0, + rxlag, rylag) + xlag = rxlag - (rc1 + rc2) / 2.0 + if (ywindow == 1) + ylag = 0 + else + ylag = rylag - (rl1 + rl2) / 2.0 + } else { + xlag = rg_xstati (xc, XLAG) + if (ywindow == 1) + ylag = 0 + else + ylag = rg_xstati (xc, YLAG) + } + + # Get the input image limits. + c1 = rc1 + xlag - xwindow / 2 + c2 = rc2 + xlag + xwindow / 2 + l1 = rl1 + ylag - ywindow / 2 + l2 = rl2 + ylag + ywindow / 2 + ncols = c2 - c1 + 1 + nlines = l2 - l1 + 1 + + # Move to the next ref region if input region is off image. + if (c1 > nimcols || c2 < 1 || l1 > nimlines || l2 < 1) { + call rg_xstats (xc, IMAGE, Memc[str], SZ_LINE) + call eprintf ( + "Image section: %s[%d:%d,%d:%d] is off image.\n") + call pargstr (Memc[str]) + call pargi (c1) + call pargi (c2) + call pargi (l1) + call pargi (l2) + stat = ERR + goto nextregion_ + } + + # Move to the next ref region if input region is less than 3 by 3. + if ((ncols < xwindow) || (IM_NDIM(im1) == 2 && nlines < ywindow)) { + call rg_xstats (xc, IMAGE, Memc[str], SZ_LINE) + call eprintf ( + "Image section: %s[%d:%d,%d:%d] has too few points.\n") + call pargstr (Memc[str]) + call pargi (c1) + call pargi (c2) + call pargi (l1) + call pargi (l2) + stat = ERR + goto nextregion_ + } + + # Get the input reference and input image data. + rbuf = rg_ximget (imr, rc1, rc2, rl1, rl2) + if (rbuf == NULL) { + stat = ERR + goto nextregion_ + } + ibuf = rg_ximget (im1, c1, c2, l1, l2) + if (ibuf == NULL) { + stat = ERR + goto nextregion_ + } + + # Do the background subtraction. + + # Compute the zero point, x slope and y slope of ref image. + if (IS_INDEFR(Memr[przero+i-1]) || IS_INDEFR(Memr[prxslope+i- 1]) || + IS_INDEFR(Memr[pryslope+i-1])) { + if (IS_INDEFI(rg_xstati (xc, BORDER))) { + call rg_xscale (xc, Memr[rbuf], nrcols * nrlines, nrcols, + nrlines, rg_xstatr (xc, BVALUER), Memr[coeff]) + } else { + border = NULL + nborder = rg_border (Memr[rbuf], nrcols, nrlines, + max (0, nrcols - 2 * rg_xstati (xc, BORDER)), + max (0, nrlines - 2 * rg_xstati (xc, BORDER)), + border) + call rg_xscale (xc, Memr[border], nborder, nrcols, + nrlines, rg_xstatr (xc, BVALUER), Memr[coeff]) + if (border != NULL) + call mfree (border, TY_REAL) + } + + # Save the coefficients. + Memr[przero+i-1] = Memr[coeff] + Memr[prxslope+i-1] = Memr[coeff+1] + Memr[pryslope+i-1] = Memr[coeff+2] + } + + call rg_subtract (Memr[rbuf], nrcols, nrlines, Memr[przero+i-1], + Memr[prxslope+i-1], Memr[pryslope+i-1]) + + # Compute the zero point, and the x and y slopes of input image. + if (IS_INDEFI(rg_xstati (xc, BORDER))) { + call rg_xscale (xc, Memr[ibuf], ncols * nlines, ncols, + nlines, rg_xstatr (xc, BVALUE), Memr[coeff]) + } else { + border = NULL + nborder = rg_border (Memr[ibuf], ncols, nlines, + max (0, ncols - 2 * rg_xstati (xc, BORDER)), + max (0, nlines - 2 * rg_xstati (xc, BORDER)), + border) + call rg_xscale (xc, Memr[border], nborder, ncols, nlines, + rg_xstatr (xc, BVALUE), Memr[coeff]) + if (border != NULL) + call mfree (border, TY_REAL) + } + + # Subtract the baseline. + call rg_subtract (Memr[ibuf], ncols, nlines, Memr[coeff], + Memr[coeff+1], Memr[coeff+2]) + + # Apodize the data. + if (rg_xstatr (xc, APODIZE) > 0.0) { + call rg_apodize (Memr[rbuf], nrcols, nrlines, rg_xstatr (xc, + APODIZE), YES) + call rg_apodize (Memr[ibuf], ncols, nlines, rg_xstatr (xc, + APODIZE), YES) + } + + # Spatially filter the data with a Laplacian. + switch (rg_xstati (xc, FILTER)) { + case XC_LAPLACE: + call rg_xlaplace (Memr[rbuf], nrcols, nrlines, 1.0) + call rg_xlaplace (Memr[ibuf], ncols, nlines, 1.0) + default: + ; + } + + # Allocate space for the cross-correlation function. + if (rg_xstatp (xc, XCOR) == NULL) { + call malloc (xcor, xwindow * ywindow, TY_REAL) + call rg_xsetp (xc, XCOR, xcor) + } else { + xcor = rg_xstatp (xc, XCOR) + call realloc (xcor, xwindow * ywindow, TY_REAL) + call rg_xsetp (xc, XCOR, xcor) + } + + # Clear the correlation function. + call aclrr (Memr[xcor], xwindow * ywindow) + + # Compute the cross-correlation function. + if (rg_xstati (xc, CFUNC) == XC_DISCRETE) { + call rg_xconv (Memr[rbuf], nrcols, nrlines, Memr[ibuf], ncols, + nlines, Memr[xcor], xwindow, ywindow) + } else { + call rg_xdiff (Memr[rbuf], nrcols, nrlines, Memr[ibuf], ncols, + nlines, Memr[xcor], xwindow, ywindow) + } + + stat = OK + +nextregion_ + + # Free memory. + call sfree (sp) + if (rbuf != NULL) + call mfree (rbuf, TY_REAL) + if (ibuf != NULL) + call mfree (ibuf, TY_REAL) + if (stat == ERR) + return (ERR) + else + return (OK) +end + + +# RG_XFGET -- Compute the cross-correlation function using Fourier techniques. + +int procedure rg_xfget (xc, imr, im1, i) + +pointer xc #I pointer to the cross-correlation structure +pointer imr #I pointer to the reference image +pointer im1 #I pointer to the input image +int i #I index of the current region + +int rc1, rc2, rl1, rl2, nrcols, nrlines, c1, c2, l1, l2, ncols, nlines +int nrimcols, nrimlines, nimcols, nimlines +int xwindow, ywindow, xlag, nxfft, nyfft, ylag, stat, nborder +pointer sp, str, coeff, xcor, rbuf, ibuf, fft, border +pointer prc1, prc2, prl1, prl2, przero, prxslope, pryslope +real rxlag, rylag +int rg_xstati(), rg_border(), rg_szfft() +pointer rg_xstatp(), rg_ximget() +real rg_xstatr() + +define nextregion_ 11 + +begin + call smark (sp) + call salloc (str, SZ_LINE, TY_CHAR) + call salloc (coeff, max (GS_SAVECOEFF+6, 9), TY_REAL) + + # Check for number of regions. + if (i > rg_xstati (xc, NREGIONS)) { + stat = ERR + goto nextregion_ + } + + # Allocate space for the cross-correlation function. + nrimcols = IM_LEN(imr,1) + if (IM_NDIM(imr) == 1) + nrimlines = 1 + else + nrimlines = IM_LEN(imr,2) + nimcols = IM_LEN(im1,1) + if (IM_NDIM(im1) == 1) + nimlines = 1 + else + nimlines = IM_LEN(im1,2) + + # Get the regions pointers. + prc1 = rg_xstatp (xc, RC1) + prc2 = rg_xstatp (xc, RC2) + prl1 = rg_xstatp (xc, RL1) + prl2 = rg_xstatp (xc, RL2) + przero = rg_xstatp (xc, RZERO) + prxslope = rg_xstatp (xc, RXSLOPE) + pryslope = rg_xstatp (xc, RYSLOPE) + + # Get the reference subraster region. + rc1 = max (1, min (int (nrimcols), Memi[prc1+i-1])) + rc2 = min (int (nrimcols), max (1, Memi[prc2+i-1])) + rl1 = max (1, min (int (nrimlines), Memi[prl1+i-1])) + rl2 = min (int (nrimlines), max (1, Memi[prl2+i-1])) + nrcols = rc2 - rc1 + 1 + nrlines = rl2 - rl1 + 1 + + # Go to next region if the reference region is off the image. + if (rc1 > nrimcols || rc2 < 1 || rl1 > nrimlines || rl2 < 1) { + call rg_xstats (xc, REFIMAGE, Memc[str], SZ_LINE) + call eprintf ( + "Reference section: %s[%d:%d,%d:%d] is off image.\n") + call pargstr (Memc[str]) + call pargi (rc1) + call pargi (rc2) + call pargi (rl1) + call pargi (rl2) + stat = ERR + goto nextregion_ + } + + # Check the window sizes. + xwindow = rg_xstati (xc, XWINDOW) + if (nrlines == 1) + ywindow = 1 + else + ywindow = rg_xstati (xc, YWINDOW) + + # Go to the next region if the reference region has too few points. + if ((nrcols < xwindow) || (IM_NDIM(im1) == 2 && nrlines < ywindow)) { + call rg_xstats (xc, REFIMAGE, Memc[str], SZ_LINE) + call eprintf ( + "Reference section: %s[%d:%d,%d:%d] has too few points.\n") + call pargstr (Memc[str]) + call pargi (rc1) + call pargi (rc2) + call pargi (rl1) + call pargi (rl2) + stat = ERR + goto nextregion_ + } + + # Apply the transformation if defined or the lag. + if (rg_xstati (xc, NREFPTS) > 0) { + call rg_etransform (xc, (rc1 + rc2) / 2.0, (rl1 + rl2) / 2.0, + rxlag, rylag) + xlag = rxlag - (rc1 + rc2) / 2.0 + if (ywindow == 1) + ylag = 0 + else + ylag = rylag - (rl1 + rl2) / 2.0 + } else { + xlag = rg_xstati (xc, XLAG) + if (ywindow == 1) + ylag = 0 + else + ylag = rg_xstati (xc, YLAG) + } + + # Get the input image subraster regions. + c1 = rc1 + xlag + c2 = rc2 + xlag + l1 = rl1 + ylag + l2 = rl2 + ylag + ncols = c2 - c1 + 1 + nlines = l2 - l1 + 1 + + # Go to next region if region is off the image. + if (c1 > nimcols || c2 < 1 || l1 > nimlines || l2 < 1) { + call rg_xstats (xc, IMAGE, Memc[str], SZ_LINE) + call eprintf ( + "Image section: %s[%d:%d,%d:%d] is off image.\n") + call pargstr (Memc[str]) + call pargi (c1) + call pargi (c2) + call pargi (l1) + call pargi (l2) + stat = ERR + goto nextregion_ + } + + # Go to next region if region has too few points. + if ((ncols < xwindow) || (IM_NDIM(im1) == 2 && nlines < ywindow)) { + call rg_xstats (xc, IMAGE, Memc[str], SZ_LINE) + call eprintf ( + "Image section: %s[%d:%d,%d:%d] has too few points.\n") + call pargstr (Memc[str]) + call pargi (c1) + call pargi (c2) + call pargi (l1) + call pargi (l2) + stat = ERR + goto nextregion_ + } + + # Figure out how big the Fourier transform has to be, given + # the size of the reference subraster, the window size and + # the fact that the FFT must be a power of 2. + + nxfft = rg_szfft (nrcols, xwindow) + if (ywindow == 1) + nyfft = 1 + else + nyfft = rg_szfft (nrlines, ywindow) + call calloc (fft, 2 * nxfft * nyfft, TY_REAL) + + # Get the input reference and input image data. + rbuf = NULL + rbuf = rg_ximget (imr, rc1, rc2, rl1, rl2) + if (rbuf == NULL) { + stat = ERR + goto nextregion_ + } + + # Do the background subtraction. + + # Compute the zero point, x slope and y slope of ref image. + if (IS_INDEFR(Memr[przero+i-1]) || IS_INDEFR(Memr[prxslope+i- 1]) || + IS_INDEFR(Memr[pryslope+i-1])) { + if (IS_INDEFI(rg_xstati (xc, BORDER))) { + call rg_xscale (xc, Memr[rbuf], nrcols * nrlines, nrcols, + nrlines, rg_xstatr (xc, BVALUER), Memr[coeff]) + } else { + border = NULL + nborder = rg_border (Memr[rbuf], nrcols, nrlines, + max (0, nrcols - 2 * rg_xstati (xc, BORDER)), + max (0, nrlines - 2 * rg_xstati (xc, BORDER)), + border) + call rg_xscale (xc, Memr[border], nborder, nrcols, + nrlines, rg_xstatr (xc, BVALUER), Memr[coeff]) + if (border != NULL) + call mfree (border, TY_REAL) + } + + # Save the coefficients. + Memr[przero+i-1] = Memr[coeff] + Memr[prxslope+i-1] = Memr[coeff+1] + Memr[pryslope+i-1] = Memr[coeff+2] + } + + call rg_subtract (Memr[rbuf], nrcols, nrlines, Memr[przero+i-1], + Memr[prxslope+i-1], Memr[pryslope+i-1]) + + # Apodize the data. + if (rg_xstatr (xc, APODIZE) > 0.0) + call rg_apodize (Memr[rbuf], nrcols, nrlines, rg_xstatr (xc, + APODIZE), YES) + + # Spatially filter the data with a Laplacian. + switch (rg_xstati (xc, FILTER)) { + case XC_LAPLACE: + call rg_xlaplace (Memr[rbuf], nrcols, nrlines, 1.0) + default: + ; + } + + # Load the reference data into the FFT. + call rg_rload (Memr[rbuf], nrcols, nrlines, Memr[fft], nxfft, nyfft) + call mfree (rbuf, TY_REAL) + + ibuf = NULL + ibuf = rg_ximget (im1, c1, c2, l1, l2) + if (ibuf == NULL) { + stat = ERR + goto nextregion_ + } + + # Compute the zero point, and the x and y slopes of input image. + if (IS_INDEFI(rg_xstati (xc, BORDER))) { + call rg_xscale (xc, Memr[ibuf], ncols * nlines, ncols, + nlines, rg_xstatr (xc, BVALUE), Memr[coeff]) + } else { + border = NULL + nborder = rg_border (Memr[ibuf], ncols, nlines, + max (0, ncols - 2 * rg_xstati (xc, BORDER)), + max (0, nlines - 2 * rg_xstati (xc, BORDER)), + border) + call rg_xscale (xc, Memr[border], nborder, ncols, nlines, + rg_xstatr (xc, BVALUE), Memr[coeff]) + if (border != NULL) + call mfree (border, TY_REAL) + } + + # Subtract the baseline. + call rg_subtract (Memr[ibuf], ncols, nlines, Memr[coeff], + Memr[coeff+1], Memr[coeff+2]) + + # Apodize the data. + if (rg_xstatr (xc, APODIZE) > 0.0) + call rg_apodize (Memr[ibuf], ncols, nlines, rg_xstatr (xc, + APODIZE), YES) + + # Spatially filter the data with a Laplacian. + switch (rg_xstati (xc, FILTER)) { + case XC_LAPLACE: + call rg_xlaplace (Memr[ibuf], ncols, nlines, 1.0) + default: + ; + } + + # Load the image data into the FFT. + call rg_iload (Memr[ibuf], ncols, nlines, Memr[fft], nxfft, nyfft) + call mfree (ibuf, TY_REAL) + + # Normalize the data. + call rg_fnorm (Memr[fft], nrcols, nrlines, nxfft, nyfft) + + # Compute the cross-correlation function. + call rg_fftcor (Memr[fft], nxfft, nyfft) + + # Allocate space for the correlation function. + if (rg_xstatp (xc, XCOR) == NULL) { + call malloc (xcor, xwindow * ywindow, TY_REAL) + call rg_xsetp (xc, XCOR, xcor) + } else { + xcor = rg_xstatp (xc, XCOR) + call realloc (xcor, xwindow * ywindow, TY_REAL) + call rg_xsetp (xc, XCOR, xcor) + } + + # Move the valid lags into the crosscorrelation array + call rg_movexr (Memr[fft], nxfft, nyfft, Memr[xcor], xwindow, ywindow) + + # Free space. + call mfree (fft, TY_REAL) + + stat = OK + +nextregion_ + + call sfree (sp) + if (stat == ERR) + return (ERR) + else + return (OK) +end + + +# RG_XIMGET -- Fill a buffer from a specified region of the image. + +pointer procedure rg_ximget (im, c1, c2, l1, l2) + +pointer im #I pointer to the iraf image +int c1, c2 #I column limits in the input image +int l1, l2 #I line limits in the input image + +int i, ncols, nlines, npts +pointer ptr, index, buf +pointer imgs1r(), imgs2r() + +begin + ncols = c2 - c1 + 1 + nlines = l2 - l1 + 1 + npts = ncols * nlines + call malloc (ptr, npts, TY_REAL) + + index = ptr + do i = l1, l2 { + if (IM_NDIM(im) == 1) + buf = imgs1r (im, c1, c2) + else + buf = imgs2r (im, c1, c2, i, i) + call amovr (Memr[buf], Memr[index], ncols) + index = index + ncols + } + + return (ptr) +end + + +# RG_XLAPLACE -- Compute the Laplacian of an image subraster in place. + +procedure rg_xlaplace (data, nx, ny, rho) + +real data[nx,ARB] #I the input array +int nx, ny #I the size of the input/output data array +real rho #I the pixel to pixel correlation factor + +int i, inline, outline, nxk, nyk, nxc +pointer sp, lineptrs, ptr +real rhosq, kernel[3,3] +data nxk /3/, nyk /3/ + +begin + # Define the kernel. + rhosq = rho * rho + kernel[1,1] = rhosq + kernel[2,1] = -rho * (1.0 + rhosq) + kernel[3,1] = rhosq + kernel[1,2] = -rho * (1.0 + rhosq) + kernel[2,2] = (1.0 + rhosq) * (1 + rhosq) + kernel[3,2] = -rho * (1.0 + rhosq) + kernel[1,3] = rhosq + kernel[2,3] = -rho * (1.0 + rhosq) + kernel[3,3] = rhosq + + # Set up an array of line pointers. + call smark (sp) + call salloc (lineptrs, nyk, TY_POINTER) + + # Allocate working space. + nxc = nx + 2 * (nxk / 2) + do i = 1, nyk + call salloc (Memi[lineptrs+i-1], nxc, TY_REAL) + + inline = 1 - nyk / 2 + do i = 1, nyk - 1 { + if (inline < 1) { + call amovr (data[1,1], Memr[Memi[lineptrs+i]+nxk/2], nx) + Memr[Memi[lineptrs+i]] = data[1,1] + Memr[Memi[lineptrs+i]+nxc-1] = data[nx,1] + } else { + call amovr (data[1,i-1], Memr[Memi[lineptrs+i]+nxk/2], nx) + Memr[Memi[lineptrs+i]] = data[1,i-1] + Memr[Memi[lineptrs+i]+nxc-1] = data[nx,i-1] + } + inline = inline + 1 + } + + # Generate the output image line by line + do outline = 1, ny { + + # Scroll the input buffers + ptr = Memi[lineptrs] + do i = 1, nyk - 1 + Memi[lineptrs+i-1] = Memi[lineptrs+i] + Memi[lineptrs+nyk-1] = ptr + + # Read in new image line + if (inline > ny) { + call amovr (data[1,ny], Memr[Memi[lineptrs+nyk-1]+nxk/2], + nx) + Memr[Memi[lineptrs+nyk-1]] = data[1,ny] + Memr[Memi[lineptrs+nyk-1]+nxc-1] = data[nx,ny] + } else { + call amovr (data[1,inline], Memr[Memi[lineptrs+nyk-1]+nxk/2], + nx) + Memr[Memi[lineptrs+nyk-1]] = data[1,inline] + Memr[Memi[lineptrs+nyk-1]+nxc-1] = data[nx,inline] + } + + # Generate output image line + call aclrr (data[1,outline], nx) + do i = 1, nyk + call acnvr (Memr[Memi[lineptrs+i-1]], data[1,outline], nx, + kernel[1,i], nxk) + + inline = inline + 1 + } + + # Free the image buffer pointers + call sfree (sp) +end + + +# RG_XCONV -- Compute the cross-correlation function directly in the spatial +# domain. + +procedure rg_xconv (ref, nrcols, nrlines, image, ncols, nlines, xcor, xwindow, + ywindow) + +real ref[nrcols,nrlines] #I the input reference subraster +int nrcols, nrlines #I size of the reference subraster +real image[ncols,nlines] #I the input image subraster +int ncols, nlines #I size of the image subraster +real xcor[xwindow,ywindow] #O the output cross-correlation function +int xwindow, ywindow #I size of the cross-correlation function + +int lagx, lagy, i, j +real meanr, facr, meani, faci, sum +real asumr() +#real cxmin, cxmax + +begin + meanr = asumr (ref, nrcols * nrlines) / (nrcols * nrlines) + facr = 0.0 + do j = 1, nrlines { + do i = 1, nrcols + facr = facr + (ref[i,j] - meanr) ** 2 + } + if (facr <= 0.0) + facr = 1.0 + else + facr = sqrt (facr) + + do lagy = 1, ywindow { + do lagx = 1, xwindow { + meani = 0.0 + do j = 1, nrlines { + do i = 1, nrcols + meani = meani + image[i+lagx-1,j+lagy-1] + } + meani = meani / (nrcols * nrlines) + faci = 0.0 + sum = 0.0 + do j = 1, nrlines { + do i = 1, nrcols { + faci = faci + (image[i+lagx-1,j+lagy-1] - meani) ** 2 + sum = sum + (ref[i,j] - meanr) * + (image[i+lagx-1,j+lagy-1] - meani) + } + } + if (faci <= 0.0) + faci = 1.0 + else + faci = sqrt (faci) + xcor[lagx,lagy] = sum / facr / faci + } + } +end + + +# RG_XDIFF -- Compute the error function at each of several templates. + +procedure rg_xdiff (ref, nrcols, nrlines, image, ncols, nlines, xcor, xwindow, + ywindow) + +real ref[nrcols,nrlines] #I reference subraste +int nrcols, nrlines #I size of the reference subraster +real image[ncols,nlines] #I image subraster +int ncols, nlines #I size of image subraster +real xcor[xwindow,ywindow] #O crosscorrelation function +int xwindow, ywindow #I size of correlation function + +int lagx, lagy, i, j +real meanr, meani, sum, cormin, cormax +real asumr() + + +begin + meanr = asumr (ref, nrcols * nrlines) / (nrcols * nrlines) + do lagy = 1, ywindow { + do lagx = 1, xwindow { + meani = 0.0 + do j = 1, nrlines { + do i = 1, nrcols + meani = meani + image[i+lagx-1,j+lagy-1] + } + meani = meani / (nrcols * nrlines) + sum = 0.0 + do j = 1, nrlines { + do i = 1, nrcols { + sum = sum + abs ((ref[i,j] - meanr) - + (image[i+lagx-1,j+lagy-1] - meani)) + } + } + xcor[lagx,lagy] = sum + } + } + + call alimr (xcor, xwindow * ywindow, cormin, cormax) + call adivkr (xcor, cormax, xcor, xwindow * ywindow) + call asubkr (xcor, 1.0, xcor, xwindow * ywindow) + call anegr (xcor, xcor, xwindow * ywindow) +end + diff --git a/pkg/images/immatch/src/xregister/rgxdbio.x b/pkg/images/immatch/src/xregister/rgxdbio.x new file mode 100644 index 00000000..3e197636 --- /dev/null +++ b/pkg/images/immatch/src/xregister/rgxdbio.x @@ -0,0 +1,290 @@ +include "xregister.h" + +# RG_XWREC -- Procedure to write out the whole record. + +procedure rg_xwrec (db, dformat, xc) + +pointer db #I pointer to the database file +int dformat #I is the shifts file in database format +pointer xc #I pointer to the cross correlation structure + +int i, nregions, ngood, c1, c2, l1, l2, xlag, ylag +pointer sp, image, prc1, prc2, prl1, prl2, pxshift, pyshift +real xin, yin, xout, yout, xavshift, yavshift +int rg_xstati() +pointer rg_xstatp() + +begin + # Allocate working space. + call smark (sp) + call salloc (image, SZ_FNAME, TY_CHAR) + + # Write the header record. + if (dformat == YES) + call rg_xdbparams (db, xc) + + # Fetch the pointers to the columns. + prc1 = rg_xstatp (xc, RC1) + prc2 = rg_xstatp (xc, RC2) + prl1 = rg_xstatp (xc, RL1) + prl2 = rg_xstatp (xc, RL2) + pxshift = rg_xstatp (xc, XSHIFTS) + pyshift = rg_xstatp (xc, YSHIFTS) + nregions = rg_xstati (xc, NREGIONS) + + xavshift = 0.0 + yavshift = 0.0 + ngood = 0 + do i = 1, nregions { + + xin = (Memi[prc1+i-1] + Memi[prc2+i-1]) / 2.0 + yin = (Memi[prl1+i-1] + Memi[prl2+i-1]) / 2.0 + if (rg_xstati (xc, NREFPTS) > 0) { + call rg_etransform (xc, xin, yin, xout, yout) + xlag = xout - xin + ylag = yout - yin + } else { + xlag = rg_xstati (xc, XLAG) + ylag = rg_xstati (xc, YLAG) + } + c1 = Memi[prc1+i-1] + xlag + c2 = Memi[prc2+i-1] + xlag + l1 = Memi[prl1+i-1] + ylag + l2 = Memi[prl2+i-1] + ylag + + if (IS_INDEFR(Memr[pxshift+i-1]) || IS_INDEFR(Memr[pyshift+i-1])) { + if (dformat == YES) + call rg_xdbshiftr (db, Memi[prc1+i-1], Memi[prc2+i-1], + Memi[prl1+i-1], Memi[prl2+i-1], c1, c2, l1, l2, + INDEFR, INDEFR) + } else { + if (dformat == YES) + call rg_xdbshiftr (db, Memi[prc1+i-1], Memi[prc2+i-1], + Memi[prl1+i-1], Memi[prl2+i-1], c1, c2, l1, l2, + Memr[pxshift+i-1], Memr[pyshift+i-1]) + ngood = ngood + 1 + xavshift = xavshift + Memr[pxshift+i-1] + yavshift = yavshift + Memr[pyshift+i-1] + } + } + + # Compute the average shift. + if (ngood <= 0) { + xavshift = 0.0 + yavshift = 0.0 + } else { + xavshift = xavshift / ngood + yavshift = yavshift / ngood + } + call rg_xsetr (xc, TXSHIFT, xavshift) + call rg_xsetr (xc, TYSHIFT, yavshift) + + if (dformat == YES) + call rg_xdbshift (db, xc) + else { + call rg_xstats (xc, IMAGE, Memc[image], SZ_FNAME) + call fprintf (db, "%s %g %g\n") + call pargstr (Memc[image]) + call pargr (xavshift) + call pargr (yavshift) + } + + call sfree (sp) +end + + +# RG_XDBPARAMS -- Write the cross-correlation parameters to the database file. + +procedure rg_xdbparams (db, xc) + +pointer db #I pointer to the database file +pointer xc #I pointer to the cross-correlation structure + +pointer sp, str +int rg_xstati() +#real rg_xstatr() + +begin + call smark (sp) + call salloc (str, SZ_FNAME, TY_CHAR) + + # Write out the time record was written. + call dtput (db, "\n") + call dtptime (db) + + # Write out the record name. + call rg_xstats (xc, RECORD, Memc[str], SZ_FNAME) + call dtput (db, "begin\t%s\n") + call pargstr (Memc[str]) + + # Write the image names. + call rg_xstats (xc, IMAGE, Memc[str], SZ_FNAME) + call dtput (db, "\t%s\t\t%s\n") + call pargstr (KY_IMAGE) + call pargstr (Memc[str]) + call rg_xstats (xc, REFIMAGE, Memc[str], SZ_FNAME) + call dtput (db, "\t%s\t%s\n") + call pargstr (KY_REFIMAGE) + call pargstr (Memc[str]) + + call dtput (db, "\t%s\t%d\n") + call pargstr (KY_NREGIONS) + call pargi (rg_xstati (xc, NREGIONS)) + + call sfree (sp) +end + + +# RG_XWREG -- Write out the results for each region individually into +# the shifts file. + +procedure rg_xwreg (db, xc) + +pointer db #I pointer to the database file +pointer xc #I pointer to the cross-correlation structure + +int i, nregions, c1, c2, l1, l2, xlag, ylag +pointer prc1, prc2, prl1, prl2, pxshift, pyshift +real xin, yin, xout, yout +int rg_xstati() +pointer rg_xstatp() + +begin + # Fetch the regions pointers. + prc1 = rg_xstatp (xc, RC1) + prc2 = rg_xstatp (xc, RC2) + prl1 = rg_xstatp (xc, RL1) + prl2 = rg_xstatp (xc, RL2) + pxshift = rg_xstatp (xc, XSHIFTS) + pyshift = rg_xstatp (xc, YSHIFTS) + nregions = rg_xstati (xc, NREGIONS) + + # Write out the reference image region(s) and the equivalent + # input image regions. + do i = 1, nregions { + + xin = (Memi[prc1+i-1] + Memi[prc2+i-1]) / 2.0 + yin = (Memi[prl1+i-1] + Memi[prl2+i-1]) / 2.0 + if (rg_xstati (xc, NREFPTS) > 0) { + call rg_etransform (xc, xin, yin, xout, yout) + xlag = xout - xin + ylag = yout - yin + } else { + xlag = rg_xstati (xc, XLAG) + ylag = rg_xstati (xc, YLAG) + } + c1 = Memi[prc1+i-1] + xlag + c2 = Memi[prc2+i-1] + xlag + l1 = Memi[prl1+i-1] + ylag + l2 = Memi[prl2+i-1] + ylag + + if (IS_INDEFR(Memr[pxshift+i-1]) || IS_INDEFR(Memr[pyshift+i-1])) + call rg_xdbshiftr (db, Memi[prc1+i-1], Memi[prc2+i-1], + Memi[prl1+i-1], Memi[prl2+i-1], c1, c2, l1, l2, + INDEFR, INDEFR) + else + call rg_xdbshiftr (db, Memi[prc1+i-1], Memi[prc2+i-1], + Memi[prl1+i-1], Memi[prl2+i-1], c1, c2, l1, l2, + Memr[pxshift+i-1], Memr[pyshift+i-1]) + } +end + + +# RG_XDBSHIFTR -- Write out the reference image section, input image +# section and x and y shifts for each region. + +procedure rg_xdbshiftr (db, rc1, rc2, rl1, rl2, c1, c2, l1, l2, xshift, yshift) + +pointer db #I pointer to the database file +int rc1, rc2 #I reference region column limits +int rl1, rl2 #I reference region line limits +int c1, c2 #I image region column limits +int l1, l2 #I image region line limits +real xshift #I x shift +real yshift #I y shift + +begin + call dtput (db,"\t[%d:%d,%d:%d]\t[%d:%d,%d:%d]\t%g\t%g\n") + call pargi (rc1) + call pargi (rc2) + call pargi (rl1) + call pargi (rl2) + call pargi (c1) + call pargi (c2) + call pargi (l1) + call pargi (l2) + call pargr (xshift) + call pargr (yshift) +end + + +# RG_XDBSHIFT -- Write the average shifts to the shifts database. + +procedure rg_xdbshift (db, xc) + +pointer db #I pointer to text database file +pointer xc #I pointer to the cross-correlation structure + +real rg_xstatr() + +begin + call dtput (db, "\t%s\t\t%g\n") + call pargstr (KY_TXSHIFT) + call pargr (rg_xstatr (xc, TXSHIFT)) + call dtput (db, "\t%s\t\t%g\n") + call pargstr (KY_TYSHIFT) + call pargr (rg_xstatr (xc, TYSHIFT)) +end + + +# RG_XPWREC -- Print the computed shift for a region. + +procedure rg_xpwrec (xc, i) + +pointer xc #I pointer to the cross-correlation structure +int i #I the current region + +int xlag, ylag, c1, c2, l1, l2 +pointer prc1, prc2, prl1, prl2 +real xin, yin, rxlag, rylag +int rg_xstati() +pointer rg_xstatp() + +begin + # Fetch the pointers to the reference regions. + prc1 = rg_xstatp (xc, RC1) + prc2 = rg_xstatp (xc, RC2) + prl1 = rg_xstatp (xc, RL1) + prl2 = rg_xstatp (xc, RL2) + + # Transform the reference region to the input region. + xin = (Memi[prc1+i-1] + Memi[prc2+i-1]) / 2.0 + yin = (Memi[prl1+i-1] + Memi[prl2+i-1]) / 2.0 + if (rg_xstati (xc, NREFPTS) > 0) { + call rg_etransform (xc, xin, yin, rxlag, rylag) + xlag = rxlag - xin + ylag = rylag - yin + } else { + xlag = rg_xstati (xc, XLAG) + ylag = rg_xstati (xc, YLAG) + } + + c1 = Memi[prc1+i-1] + xlag + c2 = Memi[prc2+i-1] + xlag + l1 = Memi[prl1+i-1] + ylag + l2 = Memi[prl2+i-1] + ylag + + # Print the results. + call printf ("Region %d: [%d:%d,%d:%d] [%d:%d,%d:%d] %g %g\n") + call pargi (i) + call pargi (Memi[prc1+i-1]) + call pargi (Memi[prc2+i-1]) + call pargi (Memi[prl1+i-1]) + call pargi (Memi[prl2+i-1]) + call pargi (c1) + call pargi (c2) + call pargi (l1) + call pargi (l2) + call pargr (Memr[rg_xstatp(xc,XSHIFTS)+i-1]) + call pargr (Memr[rg_xstatp(xc,YSHIFTS)+i-1]) +end diff --git a/pkg/images/immatch/src/xregister/rgxfft.x b/pkg/images/immatch/src/xregister/rgxfft.x new file mode 100644 index 00000000..8847cf56 --- /dev/null +++ b/pkg/images/immatch/src/xregister/rgxfft.x @@ -0,0 +1,179 @@ +# RG_FFTCOR -- Compute the FFT of the reference and image data, take their +# product, and compute the inverse transform to get the cross-correlation +# function. The reference and input image are loaded into alternate memory +# locations. + +procedure rg_fftcor (fft, nxfft nyfft) + +real fft[ARB] #I/O array to be fft'd +int nxfft, nyfft #I dimensions of the fft + +pointer sp, dim + +begin + call smark (sp) + call salloc (dim, 2, TY_INT) + + # Fourier transform the two arrays. + Memi[dim] = nxfft + Memi[dim+1] = nyfft + if (Memi[dim+1] == 1) + call rg_fourn (fft, Memi[dim], 1, 1) + else + call rg_fourn (fft, Memi[dim], 2, 1) + + # Compute the product of the two transforms. + call rg_mulfft (fft, fft, 2 * nxfft, nyfft) + + # Shift the array to center the transform. + call rg_fshift (fft, fft, 2 * nxfft, nyfft) + + # Normalize the transform. + call adivkr (fft, real (nxfft * nyfft), fft, 2 * nxfft * nyfft) + + # Compute the inverse transform. + if (Memi[dim+1] == 1) + call rg_fourn (fft, Memi[dim], 1, -1) + else + call rg_fourn (fft, Memi[dim], 2, -1) + + call sfree (sp) +end + + +# RG_MULFFT -- Unpack the two individual ffts and compute their product. + +procedure rg_mulfft (fft1, fft2, nxfft, nyfft) + +real fft1[nxfft,nyfft] #I array containing 2 ffts of 2 real functions +real fft2[nxfft,nyfft] #O fft of correlation function +int nxfft, nyfft #I dimensions of fft + +int i,j, nxd2p2, nxp2, nxp3, nyd2p1, nyp2 +real c1, c2, h1r, h1i, h2r, h2i + +begin + c1 = 0.5 + c2 = -0.5 + + nxd2p2 = nxfft / 2 + 2 + nxp2 = nxfft + 2 + nxp3 = nxfft + 3 + nyd2p1 = nyfft / 2 + 1 + nyp2 = nyfft + 2 + + # Compute the 0 frequency point. + h1r = fft1[1,1] + h1i = 0.0 + h2r = fft1[2,1] + h2i = 0.0 + fft2[1,1] = h1r * h2r + fft2[2,1] = 0.0 + + # Compute the x axis points. + do i = 3, nxd2p2, 2 { + h2r = c1 * (fft1[i,1] + fft1[nxp2-i,1]) + h2i = c1 * (fft1[i+1,1] - fft1[nxp3-i,1]) + h1r = -c2 * (fft1[i+1,1] + fft1[nxp3-i,1]) + h1i = c2 * (fft1[i,1] - fft1[nxp2-i,1]) + fft2[i,1] = (h1r * h2r + h1i * h2i) + fft2[i+1,1] = (h1i * h2r - h2i * h1r) + fft2[nxp2-i,1] = fft2[i,1] + fft2[nxp3-i,1] = - fft2[i+1,1] + } + + # Quit if the transform is 1D. + if (nyfft < 2) + return + + # Compute the y axis points. + do i = 2, nyd2p1 { + h2r = c1 * (fft1[1,i] + fft1[1, nyp2-i]) + h2i = c1 * (fft1[2,i] - fft1[2,nyp2-i]) + h1r = -c2 * (fft1[2,i] + fft1[2,nyp2-i]) + h1i = c2 * (fft1[1,i] - fft1[1,nyp2-i]) + fft2[1,i] = (h1r * h2r + h1i * h2i) + fft2[2,i] = (h1i * h2r - h2i * h1r) + fft2[1,nyp2-i] = fft2[1,i] + fft2[2,nyp2-i] = - fft2[2,i] + } + + # Compute along the axis of symmetry. + do i = 3, nxd2p2, 2 { + h2r = c1 * (fft1[i,nyd2p1] + fft1[nxp2-i, nyd2p1]) + h2i = c1 * (fft1[i+1,nyd2p1] - fft1[nxp3-i,nyd2p1]) + h1r = -c2 * (fft1[i+1,nyd2p1] + fft1[nxp3-i,nyd2p1]) + h1i = c2 * (fft1[i,nyd2p1] - fft1[nxp2-i,nyd2p1]) + fft2[i,nyd2p1] = (h1r * h2r + h1i * h2i) + fft2[i+1,nyd2p1] = (h1i * h2r - h2i * h1r) + fft2[nxp2-i,nyd2p1] = fft2[i,nyd2p1] + fft2[nxp3-i,nyd2p1] = - fft2[i+1,nyd2p1] + } + + # Compute the remainder of the transform. + do j = 2, nyd2p1 - 1 { + do i = 3, nxfft, 2 { + h2r = c1 * (fft1[i,j] + fft1[nxp2-i, nyp2-j]) + h2i = c1 * (fft1[i+1,j] - fft1[nxp3-i,nyp2-j]) + h1r = -c2 * (fft1[i+1,j] + fft1[nxp3-i,nyp2-j]) + h1i = c2 * (fft1[i,j] - fft1[nxp2-i,nyp2-j]) + fft2[i,j] = (h1r * h2r + h1i * h2i) + fft2[i+1,j] = (h1i * h2r - h2i * h1r) + fft2[nxp2-i,nyp2-j] = fft2[i,j] + fft2[nxp3-i,nyp2-j] = - fft2[i+1,j] + } + } +end + + +# RG_FNORM -- Normalize the reference and image data before computing +# the fft's. + +procedure rg_fnorm (array, ncols, nlines, nxfft, nyfft) + +real array[ARB] #I/O the input/output data array +int ncols, nlines #I dimensions of the input data array +int nxfft, nyfft #I dimensions of the fft + +int i, j, index +real sumr, sumi, meanr, meani + +begin + # Compute the mean. + sumr = 0.0 + sumi = 0.0 + index = 0 + do j = 1, nlines { + do i = 1, ncols { + sumr = sumr + array[index+2*i-1] + sumi = sumi + array[index+2*i] + } + index = index + 2 * nxfft + } + meanr = sumr / (ncols * nlines) + meani = sumi / (ncols * nlines) + + # Compute the sigma. + sumr = 0.0 + sumi = 0.0 + index = 0 + do j = 1, nlines { + do i = 1, ncols { + sumr = sumr + (array[index+2*i-1] - meanr) ** 2 + sumi = sumi + (array[index+2*i] - meani) ** 2 + } + index = index + 2 * nxfft + } + sumr = sqrt (sumr) + sumi = sqrt (sumi) + + # Normalize the data. + index = 0 + do j = 1, nlines { + do i = 1, ncols { + array[index+2*i-1] = (array[index+2*i-1] - meanr) / sumr + array[index+2*i] = (array[index+2*i] - meani) / sumi + } + index = index + 2 * nxfft + } +end diff --git a/pkg/images/immatch/src/xregister/rgxfit.x b/pkg/images/immatch/src/xregister/rgxfit.x new file mode 100644 index 00000000..34e6398c --- /dev/null +++ b/pkg/images/immatch/src/xregister/rgxfit.x @@ -0,0 +1,814 @@ +include <mach.h> +include <math/iminterp.h> +include <math/nlfit.h> +include "xregister.h" + +define NL_MAXITER 10 +define NL_TOL 0.001 + +# RG_FIT -- Fit the peak of the cross-correlation function using one of the +# fitting functions. + +procedure rg_fit (xc, nreg, gd, xshift, yshift) + +pointer xc #I the pointer to the cross-corrrelation structure +int nreg #I the current region +pointer gd #I the pointer to the graphics stream +real xshift, yshift #O the computed shifts + +int nrlines, xwindow, ywindow, xcbox, ycbox, xlag, ylag +real xin, yin, xout, yout +int rg_xstati() +pointer rg_xstatp() + +begin + # Check the window and centering box sizes. + nrlines = Memi[rg_xstatp(xc,RL2)+nreg-1] - + Memi[rg_xstatp(xc,RL1)+nreg-1] + 1 + xwindow = rg_xstati (xc, XWINDOW) + if (nrlines == 1) + ywindow = 1 + else + ywindow = rg_xstati (xc, YWINDOW) + xcbox = rg_xstati (xc, XCBOX) + if (nrlines == 1) + ycbox = 1 + else + ycbox = rg_xstati (xc, YCBOX) + + # Do the centering. + switch (rg_xstati (xc, PFUNC)) { + case XC_PNONE: + call rg_maxmin (Memr[rg_xstatp(xc,XCOR)], xwindow, ywindow, + xshift, yshift) + case XC_CENTROID: + call rg_imean (Memr[rg_xstatp(xc,XCOR)], xwindow, + ywindow, xcbox, ycbox, xshift, yshift) + case XC_SAWTOOTH: + call rg_sawtooth (Memr[rg_xstatp(xc,XCOR)], xwindow, + ywindow, xcbox, ycbox, xshift, yshift) + case XC_PARABOLA: + call rg_iparabolic (Memr[rg_xstatp(xc,XCOR)], xwindow, ywindow, + xcbox, ycbox, xshift, yshift) + case XC_MARK: + if (gd == NULL) + call rg_imean (Memr[rg_xstatp(xc,XCOR)], xwindow, + ywindow, xcbox, ycbox, xshift, yshift) + else + call rg_xmkpeak (gd, xwindow, ywindow, xshift, yshift) + default: + call rg_imean (Memr[rg_xstatp(xc,XCOR)], xwindow, ywindow, + xcbox, ycbox, xshift, yshift) + } + + # Store the shifts. + if (rg_xstati (xc, NREFPTS) > 0) { + xin = (Memi[rg_xstatp(xc,RC1)+nreg-1] + + Memi[rg_xstatp(xc,RC2)+nreg-1]) / 2.0 + yin = (Memi[rg_xstatp(xc,RL1)+nreg-1] + + Memi[rg_xstatp(xc,RL2)+nreg-1]) / 2.0 + call rg_etransform (xc, xin, yin, xout, yout) + xlag = xout - xin + ylag = yout - yin + } else { + xlag = rg_xstati (xc, XLAG) + ylag = rg_xstati (xc, YLAG) + } + xshift = - (xshift + xlag) + yshift = - (yshift + ylag) + Memr[rg_xstatp(xc,XSHIFTS)+nreg-1] = xshift + Memr[rg_xstatp(xc,YSHIFTS)+nreg-1] = yshift +end + + +# RG_MAXMIN -- Procedure to compute the peak of the cross-correlation function +# by determining the maximum point. + +procedure rg_maxmin (xcor, xwindow, ywindow, xshift, yshift) + +real xcor[xwindow,ywindow] #I the cross-correlation function +int xwindow, ywindow #I dimensions of cross-correlation function +real xshift, yshift #O x and shift of the peak + +int xindex, yindex + +begin + # Locate the maximum point. + call rg_alim2r (xcor, xwindow, ywindow, xindex, yindex) + xshift = xindex - (1.0 + xwindow) / 2.0 + yshift = yindex - (1.0 + ywindow) / 2.0 +end + + +# RG_IMEAN -- Compute the peak of the cross-correlation function using the +# intensity weighted mean of the marginal distributions in x and y. + +procedure rg_imean (xcor, xwindow, ywindow, xcbox, ycbox, xshift, yshift) + +real xcor[xwindow,ARB] #I the cross-correlation function +int xwindow, ywindow #I dimensions of the cross-correlation function +int xcbox, ycbox #I dimensions of the centering box +real xshift, yshift #O x and y shift of cross-correlation function + +int xindex, yindex, xlo, xhi, ylo, yhi, nx, ny +pointer sp, xmarg, ymarg + +begin + call smark (sp) + call salloc (xmarg, xcbox, TY_REAL) + call salloc (ymarg, ycbox, TY_REAL) + + # Locate the maximum point and normalize. + call rg_alim2r (xcor, xwindow, ywindow, xindex, yindex) + + # Compute the limits of the centering box. + xlo = max (1, xindex - xcbox / 2) + xhi = min (xwindow, xindex + xcbox / 2) + nx = xhi - xlo + 1 + ylo = max (1, yindex - ycbox / 2) + yhi = min (ywindow, yindex + ycbox / 2) + ny = yhi - ylo + 1 + + # Accumulate the marginals. + call rg_xmkmarg (xcor, xwindow, ywindow, xlo, xhi, ylo, yhi, + Memr[xmarg], Memr[ymarg]) + + # Compute the shifts. + call rg_centroid (Memr[xmarg], nx, xshift) + xshift = xshift + xlo - 1 - (1.0 + xwindow) / 2.0 + call rg_centroid (Memr[ymarg], ny, yshift) + yshift = yshift + ylo - 1 - (1.0 + ywindow) / 2.0 + + call sfree (sp) +end + + +# RG_IPARABOLIC -- Computer the peak of the cross-correlation function by +# doing parabolic interpolation around the peak. + +procedure rg_iparabolic (xcor, xwindow, ywindow, xcbox, ycbox, xshift, yshift) + +real xcor[xwindow,ARB] #I the cross-correlation function +int xwindow, ywindow #I dimensions of the cross-correlation fucntion +int xcbox, ycbox #I the dimensions of the centering box +real xshift, yshift #O the x and y shift of the peak + +int i, j, xindex, yindex, xlo, xhi, nx, ylo, yhi, ny +pointer sp, x, y, c, xfit, yfit + +begin + # Allocate working space. + call smark (sp) + call salloc (x, 3, TY_REAL) + call salloc (y, 3, TY_REAL) + call salloc (c, 3, TY_REAL) + call salloc (xfit, 3, TY_REAL) + call salloc (yfit, 3, TY_REAL) + + # Locate the maximum point. + call rg_alim2r (xcor, xwindow, ywindow, xindex, yindex) + + xlo = max (1, xindex - 1) + xhi = min (xwindow, xindex + 1) + nx = xhi - xlo + 1 + ylo = max (1, yindex - 1) + yhi = min (ywindow, yindex + 1) + ny = yhi - ylo + 1 + + # Initialize. + do i = 1, 3 + Memr[x+i-1] = i + + # Fit the x shift. + if (nx >= 3) { + do j = ylo, yhi { + do i = xlo, xhi + Memr[y+i-xlo] = xcor[i,j] + call rg_iparab (Memr[x], Memr[y], Memr[c]) + Memr[xfit+j-ylo] = - Memr[c+1] / (2.0 * Memr[c+2]) + Memr[yfit+j-ylo] = Memr[c] + Memr[c+1] * Memr[xfit+j-ylo] + + Memr[c+2] * Memr[xfit+j-ylo] ** 2 + } + if (ny >= 3) + call rg_iparab (Memr[xfit], Memr[yfit], Memr[c]) + xshift = - Memr[c+1] / (2.0 * Memr[c+2]) + } else + xshift = xindex - xlo + 1 + + # Fit the y shift. + if (ny >= 3) { + do i = xlo, xhi { + do j = ylo, yhi + Memr[y+j-ylo] = xcor[i,j] + call rg_iparab (Memr[x], Memr[y], Memr[c]) + Memr[xfit+i-xlo] = - Memr[c+1] / (2.0 * Memr[c+2]) + Memr[yfit+i-xlo] = Memr[c] + Memr[c+1] * Memr[xfit+i-xlo] + + Memr[c+2] * Memr[xfit+i-xlo] ** 2 + } + call rg_iparab (Memr[xfit], Memr[yfit], Memr[c]) + yshift = - Memr[c+1] / (2.0 * Memr[c+2]) + } else + yshift = yindex - ylo + 1 + + xshift = xshift + xlo - 1 - (1.0 + xwindow) / 2.0 + yshift = yshift + ylo - 1 - (1.0 + ywindow) / 2.0 + + call sfree (sp) +end + + +define NPARS_PARABOLA 3 + +# RG_PARABOLIC -- Compute the peak of the cross-correlation function by fitting +# a parabola to the peak. + +procedure rg_parabolic (xcor, xwindow, ywindow, xcbox, ycbox, xshift, yshift) + +real xcor[xwindow,ARB] #I the cross-correlation function +int xwindow, ywindow #I dimensions of the cross-correlation fucntion +int xcbox, ycbox #I the dimensions of the centering box +real xshift, yshift #O the x and y shift of the peak + +extern rg_polyfit, rg_dpolyfit +int i, xindex, yindex, xlo, xhi, ylo, yhi, nx, ny, npar, ier +pointer sp, x, w, xmarg, ymarg, params, eparams, list, nl +int locpr() + +begin + call smark (sp) + call salloc (x, max (xwindow, ywindow), TY_REAL) + call salloc (w, max (xwindow, ywindow), TY_REAL) + call salloc (xmarg, max (xwindow, ywindow), TY_REAL) + call salloc (ymarg, max (xwindow, ywindow), TY_REAL) + call salloc (params, NPARS_PARABOLA, TY_REAL) + call salloc (eparams, NPARS_PARABOLA, TY_REAL) + call salloc (list, NPARS_PARABOLA, TY_INT) + + # Locate the maximum point. + call rg_alim2r (xcor, xwindow, ywindow, xindex, yindex) + + xlo = max (1, xindex - xcbox / 2) + xhi = min (xwindow, xindex + xcbox / 2) + nx = xhi - xlo + 1 + ylo = max (1, yindex - ycbox / 2) + yhi = min (ywindow, yindex + ycbox / 2) + ny = yhi - ylo + 1 + + # Accumulate the marginals. + call rg_xmkmarg (xcor, xwindow, ywindow, xlo, xhi, ylo, yhi, + Memr[xmarg], Memr[ymarg]) + + # Compute the x shift. + if (nx >= 3) { + do i = 1, nx + Memr[x+i-1] = i + do i = 1, nx + Memr[w+i-1] = Memr[xmarg+i-1] + call rg_iparab (Memr[x+xindex-xlo-1], Memr[xmarg+xindex-xlo-1], + Memr[params]) + xshift = - Memr[params+1] / (2.0 * Memr[params+2]) + call eprintf ("\txshift=%g\n") + call pargr (xshift) + call aclrr (Memr[eparams], NPARS_PARABOLA) + do i = 1, NPARS_PARABOLA + Memi[list+i-1] = i + call nlinitr (nl, locpr (rg_polyfit), locpr (rg_dpolyfit), + Memr[params], Memr[eparams], NPARS_PARABOLA, Memi[list], + NPARS_PARABOLA, .0001, NL_MAXITER) + call nlfitr (nl, Memr[x], Memr[xmarg], Memr[w], nx, 1, WTS_USER, + ier) + call nlvectorr (nl, Memr[x], Memr[w], nx, 1) + do i = 1, nx { + call eprintf ("x=%g y=%g yfit=%g\n") + call pargr (Memr[x+i-1]) + call pargr (Memr[xmarg+i-1]) + call pargr (Memr[w+i-1]) + } + if (ier != NO_DEG_FREEDOM) { + call nlpgetr (nl, Memr[params], npar) + if (Memr[params+2] != 0) + xshift = - Memr[params+1] / (2.0 * Memr[params+2]) + else + xshift = xindex - xlo + 1 + } else + xshift = xindex - xlo + 1 + call nlfreer (nl) + } else + xshift = xindex - xlo + 1 + + # Compute the y shift. + if (ny >= 3) { + do i = 1, ny + Memr[x+i-1] = i + do i = 1, ny + Memr[w+i-1] = Memr[ymarg+i-1] + call rg_iparab (Memr[x+yindex-ylo-1], Memr[ymarg+yindex-ylo-1], + Memr[params]) + yshift = - Memr[params+1] / (2.0 * Memr[params+2]) + call eprintf ("\tyshift=%g\n") + call pargr (yshift) + call aclrr (Memr[eparams], NPARS_PARABOLA) + do i = 1, NPARS_PARABOLA + Memi[list+i-1] = i + call nlinitr (nl, locpr (rg_polyfit), locpr (rg_dpolyfit), + Memr[params], Memr[eparams], NPARS_PARABOLA, Memi[list], + NPARS_PARABOLA, 0.0001, NL_MAXITER) + call nlfitr (nl, Memr[x], Memr[ymarg], Memr[w], ny, 1, WTS_USER, + ier) + call nlvectorr (nl, Memr[x], Memr[w], ny, 1) + do i = 1, ny { + call eprintf ("x=%g y=%g yfit=%g\n") + call pargr (Memr[x+i-1]) + call pargr (Memr[ymarg+i-1]) + call pargr (Memr[w+i-1]) + } + if (ier != NO_DEG_FREEDOM) { + call nlpgetr (nl, Memr[params], npar) + if (Memr[params+2] != 0) + yshift = -Memr[params+1] / (2.0 * Memr[params+2]) + else + yshift = yindex - ylo + 1 + } else + yshift = yindex - ylo + 1 + call nlfreer (nl) + } else + yshift = yindex - ylo + 1 + + xshift = xshift + xlo - 1 - (1.0 + xwindow) / 2.0 + yshift = yshift + ylo - 1 - (1.0 + ywindow) / 2.0 + + call sfree (sp) +end + +define EMISSION 1 # emission features +define ABSORPTION 2 # emission features + +# RG_SAWTOOTH -- Compute the the x and y centers using a sawtooth +# convolution function. + +procedure rg_sawtooth (xcor, xwindow, ywindow, xcbox, ycbox, xshift, yshift) + +real xcor[xwindow,ARB] #I the cross-correlation function +int xwindow, ywindow #I the dimensions of the cross-correlation +int xcbox, ycbox #I the dimensions of the centering box +real xshift, yshift #O the x and y shifts + +int i, j, xindex, yindex, xlo, xhi, ylo, yhi, nx, ny +pointer sp, data, xfit, yfit, yclean +real ic + +begin + call smark (sp) + call salloc (data, max (xwindow, ywindow), TY_REAL) + call salloc (xfit, max (xwindow, ywindow), TY_REAL) + call salloc (yfit, max (xwindow, ywindow), TY_REAL) + call salloc (yclean, max (xwindow, ywindow), TY_REAL) + + # Locate the maximum point and normalize. + call rg_alim2r (xcor, xwindow, ywindow, xindex, yindex) + + xlo = max (1, xindex - xcbox) + xhi = min (xwindow, xindex + xcbox) + nx = xhi - xlo + 1 + ylo = max (1, yindex - ycbox) + yhi = min (ywindow, yindex + ycbox) + ny = yhi - ylo + 1 + + # Compute the y shift. + if (ny >= 3) { + do j = ylo, yhi { + do i = xlo, xhi + Memr[data+i-xlo] = xcor[i,j] + call rg_x1dcenter (real (xindex - xlo + 1), Memr[data], nx, + Memr[xfit+j-ylo], Memr[yfit+j-ylo], real (nx / 2.0), + EMISSION, real (nx / 2.0), 0.0) + } + call arbpix (Memr[yfit], Memr[yclean], ny, II_SPLINE3, + II_BOUNDARYEXT) + call rg_x1dcenter (real (yindex - ylo + 1), Memr[yclean], ny, + yshift, ic, real (ny / 2.0), EMISSION, real (ny / 2.0), 0.0) + if (IS_INDEFR(yshift)) + yshift = yindex - ylo + 1 + } else + yshift = yindex - ylo + 1 + yshift = yshift + ylo - 1 - (1.0 + ywindow) / 2.0 + + # Compute the x shift. + if (nx >= 3) { + if (ny >= 3) { + do i = xlo, xhi { + do j = ylo, yhi + Memr[data+j-ylo] = xcor[i,j] + call rg_x1dcenter (real (yindex - ylo + 1), Memr[data], ny, + Memr[xfit+i-xlo], Memr[yfit+i-xlo], real (ny / 2.0), + EMISSION, real (ny / 2.0), 0.0) + } + call arbpix (Memr[yfit], Memr[yclean], nx, II_SPLINE3, + II_BOUNDARYEXT) + call rg_x1dcenter (real (xindex - xlo + 1), Memr[yclean], nx, + xshift, ic, real (nx / 2.0), EMISSION, real (nx / 2.0), 0.0) + } else { + call rg_x1dcenter (real (xindex - xlo + 1), xcor[xlo,1], nx, + xshift, ic, real (nx / 2.0), EMISSION, real (nx / 2.0), 0.0) + } + if (IS_INDEFR(xshift)) + xshift = xindex - xlo + 1 + } else + xshift = xindex - xlo + 1 + xshift = xshift + xlo - 1 - (1.0 + xwindow) / 2.0 + + call sfree (sp) +end + + +# RG_ALIM2R -- Determine the pixel position of the data maximum. + +procedure rg_alim2r (data, nx, ny, i, j) + +real data[nx,ARB] #I the input data +int nx, ny #I the dimensions of the input array +int i, j #O the indices of the maximum pixel + +int ii, jj +real datamax + +begin + datamax = -MAX_REAL + do jj = 1, ny { + do ii = 1, nx { + if (data[ii,jj] > datamax) { + datamax = data[ii,jj] + i = ii + j = jj + } + } + } +end + + +# RG_XMKMARG -- Acumulate the marginal arrays in x and y. + +procedure rg_xmkmarg (xcor, xwindow, ywindow, xlo, xhi, ylo, yhi, xmarg, + ymarg) + +real xcor[xwindow,ARB] #I the cross-correlation function +int xwindow, ywindow #I dimensions of cross-correlation function +int xlo, xhi #I the x limits for centering +int ylo, yhi #I the y limits for centering +real xmarg[ARB] #O the output x marginal array +real ymarg[ARB] #O the output y marginal array + +int i, j, index, nx, ny + +begin + nx = xhi - xlo + 1 + ny = yhi - ylo + 1 + + # Compute the x marginal. + index = 1 - xlo + do i = xlo, xhi { + xmarg[index+i] = 0.0 + do j = ylo, yhi + xmarg[index+i] = xmarg[index+i] + xcor[i,j] + } + + # Normalize the x marginal. + call adivkr (xmarg, real (ny), xmarg, nx) + + # Compute the y marginal. + index = 1 - ylo + do j = ylo, yhi { + ymarg[index+j] = 0.0 + do i = xlo, xhi + ymarg[index+j] = ymarg[index+j] + xcor[i,j] + } + + # Normalize the ymarginal. + call adivkr (ymarg, real (nx), ymarg, ny) +end + + +# RG_CENTROID -- Compute the intensity weighted maximum of an array. + +procedure rg_centroid (a, npts, shift) + +real a[ARB] #I the input array +int npts #I the number of points +real shift #O the position of the maximum + +int i +real mean, dif, sumi, sumix +bool fp_equalr() +real asumr() + +begin + sumi = 0.0 + sumix = 0.0 + mean = asumr (a, npts) / npts + + do i = 1, npts { + dif = a[i] + dif = a[i] - mean + if (dif < 0.0) + next + sumi = sumi + dif + sumix = sumix + i * dif + } + + if (fp_equalr (sumi, 0.0)) + shift = (1.0 + npts) / 2.0 + else + shift = sumix / sumi +end + + +define MIN_WIDTH 3. # minimum centering width +define EPSILON 0.001 # accuracy of centering +define EPSILON1 0.005 # tolerance for convergence check +define ITERATIONS 100 # maximum number of iterations +define MAX_DXCHECK 3 # look back for failed convergence +define INTERPTYPE II_SPLINE3 # image interpolation type + + +# RG_X1DCENTER -- Locate the center of a one dimensional feature. +# A value of INDEF is returned in the centering fails for any reason. +# This procedure just sets up the data and adjusts for emission or +# absorption features. The actual centering is done by C1D_CENTER. + +procedure rg_x1dcenter (x, data, npts, xc, ic, width, type, radius, threshold) + +real x #I initial guess +real data[npts] #I data points +int npts #I number of data points +real xc #O computed center +real ic #O intensity at computed center +real width #I feature width +int type #I feature type +real radius #I centering radius +real threshold #I minimum range in feature + +int x1, x2, nx +real a, b, rad, wid +pointer sp, data1 + +begin + # Check starting value. + if (IS_INDEF(x) || (x < 1) || (x > npts)) { + xc = INDEF + ic = INDEF + return + } + + # Set minimum width and error radius. The minimum in the error radius + # is for defining the data window. The user error radius is used to + # check for an error in the derived center at the end of the centering. + + wid = max (width, MIN_WIDTH) + rad = max (2., radius) + + # Determine the pixel value range around the initial center, including + # the width and error radius buffer. Check for a minimum range. + + x1 = max (1., x - wid / 2 - rad - wid) + x2 = min (real (npts), x + wid / 2 + rad + wid + 1) + nx = x2 - x1 + 1 + call alimr (data[x1], nx, a, b) + if (b - a < threshold) { + xc = INDEF + ic = INDEF + return + } + + # Allocate memory for the continuum subtracted data vector. The X + # range is just large enough to include the error radius and the + # half width. + + x1 = max (1., x - wid / 2 - rad) + x2 = min (real (npts), x + wid / 2 + rad + 1) + nx = x2 - x1 + 1 + + call smark (sp) + call salloc (data1, nx, TY_REAL) + call amovr (data[x1], Memr[data1], nx) + + # Make the centering data positive, subtract the continuum, and + # apply a threshold to eliminate noise spikes. + + switch (type) { + case EMISSION: + a = 0. + call asubkr (data[x1], a + threshold, Memr[data1], nx) + call amaxkr (Memr[data1], 0., Memr[data1], nx) + case ABSORPTION: + call anegr (data[x1], Memr[data1], nx) + call asubkr (Memr[data1], threshold - b, Memr[data1], nx) + call amaxkr (Memr[data1], 0., Memr[data1], nx) + default: + call error (0, "Unknown feature type") + } + + # Determine the center. + call rg_xcenter (x - x1 + 1, Memr[data1], nx, xc, ic, wid) + + # Check user centering error radius. + if (!IS_INDEF(xc)) { + xc = xc + x1 - 1 + if (abs (x - xc) > radius) { + xc = INDEF + ic = INDEF + } + } + + # Free memory and return the center position. + call sfree (sp) +end + + +# RG_XCENTER -- One dimensional centering algorithm. + +procedure rg_xcenter (x, data, npts, xc, ic, width) + +real x #I starting guess +int npts #I number of points in data vector +real data[npts] #I data vector +real xc #O computed xc +real ic #O computed intensity at xc +real width #I centering width + +int i, j, iteration, dxcheck +real hwidth, dx, dxabs, dxlast +real a, b, sum1, sum2, intgrl1, intgrl2 +pointer asi1, asi2, sp, data1 + +real asigrl(), asieval() + +define done_ 99 + +begin + # Find the nearest local maxima as the starting point. + # This is required because the threshold limit may have set + # large regions of the data to zero and without a gradient + # the centering will fail. + + i = x + for (i=x+.5; (i<npts) && (data[i]<=data[i+1]); i=i+1) + ; + for (j=x+.5; (j>1) && (data[j]<=data[j-1]); j=j-1) + ; + + if (i-x < x-j) + xc = i + else + xc = j + + # Check data range. + hwidth = width / 2 + if ((xc - hwidth < 1) || (xc + hwidth > npts)) { + xc = INDEF + ic = INDEF + return + } + + # Set interpolation functions. + call asiinit (asi1, INTERPTYPE) + call asiinit (asi2, INTERPTYPE) + call asifit (asi1, data, npts) + + # Allocate, compute, and interpolate the x*y values. + call smark (sp) + call salloc (data1, npts, TY_REAL) + do i = 1, npts + Memr[data1+i-1] = data[i] * i + call asifit (asi2, Memr[data1], npts) + call sfree (sp) + + # Iterate to find center. This loop exits when 1) the maximum + # number of iterations is reached, 2) the delta is less than + # the required accuracy (criterion for finding a center), 3) + # there is a problem in the computation, 4) successive steps + # continue to exceed the minimum delta. + + dxlast = 1. + do iteration = 1, ITERATIONS { + + # Triangle centering function. + a = xc - hwidth + b = xc - hwidth / 2 + intgrl1 = asigrl (asi1, a, b) + intgrl2 = asigrl (asi2, a, b) + sum1 = (xc - hwidth) * intgrl1 - intgrl2 + sum2 = -intgrl1 + a = b + b = xc + hwidth / 2 + intgrl1 = asigrl (asi1, a, b) + intgrl2 = asigrl (asi2, a, b) + sum1 = sum1 - xc * intgrl1 + intgrl2 + sum2 = sum2 + intgrl1 + a = b + b = xc + hwidth + intgrl1 = asigrl (asi1, a, b) + intgrl2 = asigrl (asi2, a, b) + sum1 = sum1 + (xc + hwidth) * intgrl1 - intgrl2 + sum2 = sum2 - intgrl1 + + # Return no center if sum2 is zero. + if (sum2 == 0.) + break + + # Limit dx change in one iteration to 1 pixel. + dx = max (-1., min (1., sum1 / abs (sum2))) + dxabs = abs (dx) + xc = xc + dx + ic = asieval (asi1, xc) + + # Check data range. Return no center if at edge of data. + if ((xc - hwidth < 1) || (xc + hwidth > npts)) + break + + # Convergence tests. + if (dxabs < EPSILON) + goto done_ + if (dxabs > dxlast + EPSILON1) { + dxcheck = dxcheck + 1 + if (dxcheck > MAX_DXCHECK) + break + } else { + dxcheck = 0 + dxlast = dxabs + } + } + + # If we get here then no center was found. + xc = INDEF + ic = INDEF + +done_ call asifree (asi1) + call asifree (asi2) +end + + +# RG_IPARAB -- Compute the coefficients of the parabola through three +# evenly spaced points. + +procedure rg_iparab (x, y, c) + +real x[NPARS_PARABOLA] #I input x values +real y[NPARS_PARABOLA] #I input y values +real c[NPARS_PARABOLA] #O computed coefficients + +begin + c[3] = (y[1]-y[2]) * (x[2]-x[3]) / (x[1]-x[2]) - (y[2]-y[3]) + c[3] = c[3] / ((x[1]**2-x[2]**2) * (x[2]-x[3]) / (x[1]-x[2]) - + (x[2]**2-x[3]**2)) + + c[2] = (y[1] - y[2]) - c[3] * (x[1]**2 - x[2]**2) + c[2] = c[2] / (x[1] - x[2]) + + c[1] = y[1] - c[2] * x[1] - c[3] * x[1]**2 +end + + +# RG_POLYFIT -- Evaluate an nth order polynomial. + +procedure rg_polyfit (x, nvars, p, np, z) + +real x #I position coordinate +int nvars #I number of variables +real p[ARB] #I coefficients of polynomial +int np #I number of parameters +real z #O function return + +int i +real r + +begin + r = 0.0 + do i = 2, np + r = r + x**(i-1) * p[i] + z = p[1] + r +end + + +# RG_DPOLYFIT -- Evaluate an nth order polynomial and its derivatives. + +procedure rg_dpolyfit (x, nvars, p, dp, np, z, der) + +real x #I position coordinate +int nvars #I number of variables +real p[ARB] #I coefficients of polynomial +real dp[ARB] #I parameter derivative increments +int np #I number of parameters +real z #O function value +real der[ARB] #O derivatives + +int i + +begin + der[1] = 1.0 + z = 0.0 + do i = 2, np { + der[i] = x ** (i-1) + z = z + x**(i-1) * p[i] + } + z = p[1] + z +end diff --git a/pkg/images/immatch/src/xregister/rgxgpars.x b/pkg/images/immatch/src/xregister/rgxgpars.x new file mode 100644 index 00000000..82943730 --- /dev/null +++ b/pkg/images/immatch/src/xregister/rgxgpars.x @@ -0,0 +1,68 @@ +include "xregister.h" + +# RG_XGPARS -- Read in the XREGISTER task algorithm parameters. + +procedure rg_xgpars (xc) + +pointer xc #I pointer to the main structure + +int xlag, ylag, xwindow, ywindow, xcbox, ycbox +pointer sp, str +int clgwrd(), clgeti() +real clgetr() + +begin + # Allocate working space. + call smark (sp) + call salloc (str, SZ_LINE, TY_CHAR) + + # Initialize the correlation structure. + call rg_xinit (xc, clgwrd ("correlation", Memc[str], SZ_LINE, + XC_CTYPES)) + + # Fetch the initial shift information. + xlag = clgeti ("xlag") + ylag = clgeti ("ylag") + call rg_xseti (xc, IXLAG, xlag) + call rg_xseti (xc, IYLAG, ylag) + call rg_xseti (xc, XLAG, xlag) + call rg_xseti (xc, YLAG, ylag) + call rg_xseti (xc, DXLAG, clgeti ("dxlag")) + call rg_xseti (xc, DYLAG, clgeti ("dylag")) + + # Get the background value computation parameters. + call rg_xseti (xc, BACKGRD, clgwrd ("background", Memc[str], SZ_LINE, + XC_BTYPES)) + call rg_xsets (xc, BSTRING, Memc[str]) + call rg_xseti (xc, BORDER, clgeti ("border")) + call rg_xsetr (xc, LOREJECT, clgetr ("loreject")) + call rg_xsetr (xc, HIREJECT, clgetr ("hireject")) + call rg_xsetr (xc, APODIZE, clgetr ("apodize")) + call rg_xseti (xc, FILTER, clgwrd ("filter", Memc[str], SZ_LINE, + XC_FTYPES)) + call rg_xsets (xc, FSTRING, Memc[str]) + + # Get the window parameters and force the window size to be odd. + xwindow = clgeti ("xwindow") + if (mod (xwindow,2) == 0) + xwindow = xwindow + 1 + call rg_xseti (xc, XWINDOW, xwindow) + ywindow = clgeti ("ywindow") + if (mod (ywindow,2) == 0) + ywindow = ywindow + 1 + call rg_xseti (xc, YWINDOW, ywindow) + + # Get the peak fitting parameters. + call rg_xseti (xc, PFUNC, clgwrd ("function", Memc[str], SZ_LINE, + XC_PTYPES)) + xcbox = clgeti ("xcbox") + if (mod (xcbox,2) == 0) + xcbox = xcbox + 1 + call rg_xseti (xc, XCBOX, xcbox) + ycbox = clgeti ("ycbox") + if (mod (ycbox,2) == 0) + ycbox = ycbox + 1 + call rg_xseti (xc, YCBOX, ycbox) + + call sfree (sp) +end diff --git a/pkg/images/immatch/src/xregister/rgxicorr.x b/pkg/images/immatch/src/xregister/rgxicorr.x new file mode 100644 index 00000000..e96c6dec --- /dev/null +++ b/pkg/images/immatch/src/xregister/rgxicorr.x @@ -0,0 +1,583 @@ +include <imhdr.h> +include <fset.h> +include <ctype.h> +include "xregister.h" + +define HELPFILE "immatch$src/xregister/xregister.key" +define OHELPFILE "immatch$src/xregister/oxregister.key" + +define XC_PCONTOUR 1 +define XC_PLINE 2 +define XC_PCOL 3 + + +# RG_XICORR -- Compute the shifts for each image interactively using +# cross-correlation techniques. + +int procedure rg_xicorr (imr, im1, im2, db, dformat, reglist, tfd, xc, gd, id) + +pointer imr #I/O pointer to the reference image +pointer im1 #I/O pointer to the input image +pointer im2 #I/O pointer to the output image +pointer db #I/O pointer to the shifts database file +int dformat #I is the shifts file in database format +int reglist #I/O the regions list descriptor +int tfd #I/O the transform file descriptor +pointer xc #I pointer to the cross-corrrelation structure +pointer gd #I the graphics stream pointer +pointer id #I the display stream pointer + +int newdata, newcross, newcenter, wcs, key, cplottype, newplot +int ip, ncolr, nliner +pointer sp, cmd +real xshift, yshift, wx, wy +int rg_xstati(), rg_icross(), clgcur(), rg_xgtverify(), rg_xgqverify() +int ctoi() +pointer rg_xstatp() + +begin + # Allocate working space. + call smark (sp) + call salloc (cmd, SZ_LINE, TY_CHAR) + + # Initialize. + newdata = YES + newcross = YES + newcenter = YES + ncolr = (1 + rg_xstati (xc, XWINDOW)) / 2 + nliner = (1 + rg_xstati (xc, YWINDOW)) / 2 + cplottype = XC_PCONTOUR + newplot = YES + xshift = 0.0 + yshift = 0.0 + + # Compute the cross-correlation function for the first region + # and print the results. + if (rg_xstati (xc, NREGIONS) <= 0) { + call gclear (gd) + call printf ("The regions list is empty\n") + } else if (rg_icross (xc, imr, im1, rg_xstati (xc, CREGION)) != ERR) { + call rg_xcplot (xc, gd, ncolr, nliner, cplottype) + call rg_fit (xc, rg_xstati (xc, CREGION), gd, xshift, yshift) + call rg_xpwrec (xc, rg_xstati (xc, CREGION)) + newdata = NO + newcross = NO + newcenter = NO + newplot = NO + } else { + call gclear (gd) + call printf ( + "Error computing X-correlation function for region %d\n") + call pargi (rg_xstati (xc, CREGION)) + } + + + # Loop over the cursor commands. + while (clgcur ("gcommands", wx, wy, wcs, key, Memc[cmd], SZ_LINE) != + EOF) { + + switch (key) { + + # Print the help page. + case '?': + call gpagefile (gd, HELPFILE, "") + + # Redraw the current plot. + case 'r': + newplot = YES + + # Draw a contour plot of the cross-correlation function. + case 'c': + if (cplottype != XC_PCONTOUR) + newplot = YES + ncolr = (rg_xstati (xc, XWINDOW) + 1) / 2 + nliner = (rg_xstati (xc, YWINDOW) + 1) / 2 + cplottype = XC_PCONTOUR + + # Plot a column of the cross-correlation function. + case 'x': + if (cplottype != XC_PCOL) + newplot = YES + if (cplottype == XC_PCONTOUR) { + ncolr = nint (wx) + nliner = nint (wy) + } else if (cplottype == XC_PLINE) { + ncolr = nint (wx) + } + cplottype = XC_PCOL + + # Plot a line of the cross-correlation function. + case 'y': + if (cplottype != XC_PLINE) + newplot = YES + if (cplottype == XC_PCONTOUR) { + ncolr = nint (wx) + nliner = nint (wy) + } else if (cplottype == XC_PCOL) { + ncolr = nint (wx) + } + cplottype = XC_PLINE + + # Quit the task gracefully. + case 'q': + if (rg_xgqverify ("xregister", db, dformat, xc, key) == YES) { + call sfree (sp) + return (rg_xgtverify (key)) + } + + # The Data overlay menu. + case 'o': + #call gdeactivate (gd, 0) + call rg_xoverlay (gd, xc, rg_xstati (xc, CREGION), imr, im1) + #call greactivate (gd, 0) + newplot = YES + + # Process colon commands. + case ':': + for (ip = 1; IS_WHITE(Memc[cmd+ip-1]); ip = ip + 1) + ; + switch (Memc[cmd+ip-1]) { + case 'x': + if (Memc[cmd+ip] != EOS && Memc[cmd+ip] != ' ') { + call rg_xcolon (gd, xc, imr, im1, im2, db, dformat, + tfd, reglist, Memc[cmd], newdata, newcross, + newcenter) + } else { + ip = ip + 1 + if (ctoi (Memc[cmd], ip, ncolr) <= 0) + ncolr = (1 + rg_xstati (xc, XWINDOW)) / 2 + cplottype = XC_PCOL + newplot = YES + } + case 'y': + if (Memc[cmd+ip] != EOS && Memc[cmd+ip] != ' ') { + call rg_xcolon (gd, xc, imr, im1, im2, db, dformat, + tfd, reglist, Memc[cmd], newdata, newcross, + newcenter) + } else { + ip = ip + 1 + if (ctoi (Memc[cmd], ip, nliner) <= 0) + nliner = (1 + rg_xstati (xc, YWINDOW)) / 2 + cplottype = XC_PLINE + newplot = YES + } + default: + call rg_xcolon (gd, xc, imr, im1, im2, db, dformat, tfd, + reglist, Memc[cmd], newdata, newcross, newcenter) + } + + # Compute an image lag interactively. + case 't': + call gdeactivate (gd, 0) + call rg_itransform (xc, imr, im1, id) + newdata = YES; newcross = YES; newcenter = YES + call greactivate (gd, 0) + + # Write the parameters to the parameter file. + case 'w': + call rg_pxpars (xc) + + case 'f': + + if (rg_xstati (xc, NREGIONS) > 0) { + + if (newdata == YES) { + call rg_xcindefr (xc, rg_xstati(xc,CREGION)) + newdata = NO + } + + if (newcross == YES) { + call printf ( + "Recomputing X-correlation function ...\n") + if (rg_icross (xc, imr, im1, rg_xstati (xc, + CREGION)) != ERR) { + ncolr = (1 + rg_xstati (xc, XWINDOW)) / 2 + if (IM_NDIM(imr) == 1) + nliner = 1 + else + nliner = (1 + rg_xstati (xc, YWINDOW)) / 2 + call rg_xcplot (xc, gd, ncolr, nliner, cplottype) + call rg_fit (xc, rg_xstati (xc, CREGION), gd, + xshift, yshift) + call rg_xpwrec (xc, rg_xstati (xc, CREGION)) + newcross = NO + newcenter = NO + newplot = NO + } else { + call printf ( + "Error computing X-correlation function for region %d\n") + call pargi (rg_xstati (xc, CREGION)) + } + } + + if (newcenter == YES) { + call rg_fit (xc, rg_xstati (xc, CREGION), gd, + xshift, yshift) + call rg_xpwrec (xc, rg_xstati (xc, CREGION)) + newcenter = NO + } + + } else + call printf ("The regions list is empty\n") + + + + # Do nothing gracefully. + default: + call printf ("Unknown or ambiguous keystroke command\n") + } + + # Replot the correlation function. + if (newplot == YES) { + if (newdata == YES) { + call printf ( + "Warning: X-correlation function should be refit\n") + } else if (newcross == YES) { + call printf ( + "Warning: X-correlation function should be refit\n") + } else if (newcenter == YES) { + call printf ( + "Warning: X-correlation function should be refit\n") + } else if (rg_xstatp (xc, XCOR) != NULL) { + call rg_xcplot (xc, gd, ncolr, nliner, cplottype) + call rg_xpwrec (xc, rg_xstati (xc, CREGION)) + newplot = NO + } else { + call printf ( + "Warning: X-correlation function is undefined\n") + } + } + } + + call sfree (sp) +end + + +# RG_XOVERLAY -- The image overlay plot menu. + +procedure rg_xoverlay (gd, xc, nreg, imr, im1) + +pointer gd #I graphics stream pointer +pointer xc #I pointer to the crosscor structure +int nreg #I the current region number +pointer imr #I pointer to the reference image +pointer im1 #I pointer to the input image + +int ip, wcs, key, ixlag, iylag, ixshift, iyshift +int nrimcols, nrimlines, nimcols, nimlines, ncolr, ncoli, nliner, nlinei +pointer sp, cmd +real wx, wy, rxlag, rylag, xshift, yshift +int clgcur(), ctoi(), rg_xstati() +pointer rg_xstatp() + +begin + if (gd == NULL) + return + + nrimcols = IM_LEN(imr,1) + if (IM_NDIM(imr) == 1) + nrimlines = 1 + else + nrimlines = IM_LEN(imr,2) + nimcols = IM_LEN(im1,1) + if (IM_NDIM(im1) == 1) + nimlines = 1 + else + nimlines = IM_LEN(im1,2) + if (rg_xstati (xc, NREFPTS) > 0) { + wx = (1. + nrimcols) / 2.0 + wy = (1. + nrimlines) / 2.0 + call rg_etransform (xc, wx, wy, rxlag, rylag) + ixlag = rxlag - wx + iylag = rylag - wy + } else { + ixlag = rg_xstati (xc, XLAG) + iylag = rg_xstati (xc, YLAG) + } + xshift = -Memr[rg_xstatp(xc,XSHIFTS)+nreg-1] + yshift = -Memr[rg_xstatp(xc,YSHIFTS)+nreg-1] + + call smark (sp) + call salloc (cmd, SZ_LINE, TY_CHAR) + + while (clgcur ("icommands", wx, wy, wcs, key, Memc[cmd], + SZ_LINE) != EOF) { + + switch (key) { + + # Print the help menu. + case '?': + call gdeactivate (gd, 0) + call pagefile (OHELPFILE, "") + call greactivate (gd, 0) + + # Quit. + case 'q': + break + + # Plot the same line of the reference and input image. + case 'l': + call rg_xpline (gd, imr, im1, nint (wy), 0, 0) + + # Plot the same column of the reference and input image + case 'c': + call rg_xpcol (gd, imr, im1, nint (wx), 0, 0) + + case 'y': + call rg_xpline (gd, imr, im1, nint (wy), ixlag, iylag) + + case 'x': + call rg_xpcol (gd, imr, im1, nint (wx), ixlag, iylag) + + case 'h': + call rg_xpline (gd, imr, im1, nint (wy), nint (xshift), + nint (yshift)) + + case 'v': + call rg_xpcol (gd, imr, im1, nint (wx), nint (xshift), + nint (yshift)) + + case ':': + ip = 1 + call rg_cokeys (Memc[cmd], ip, SZ_LINE, key) + switch (key) { + case 'l': + ixshift = 0 + if (ctoi (Memc[cmd], ip, nliner) <= 0) + nliner = (1 + nrimlines) / 2 + nliner = max (1, min (nliner, nrimlines)) + if (ctoi (Memc[cmd], ip, nlinei) <= 0) + nlinei = nliner + iyshift = nlinei - nliner + call rg_xpline (gd, imr, im1, nliner, ixshift, iyshift) + + case 'c': + if (ctoi (Memc[cmd], ip, ncolr) <= 0) + ncolr = (1 + nrimcols) / 2 + ncolr = max (1, min (ncolr, nrimcols)) + if (ctoi (Memc[cmd], ip, ncoli) <= 0) + ncoli = ncolr + ncoli = max (1, min (ncoli, nimcols)) + ixshift = ncoli - ncolr + iyshift = 0 + call rg_xpcol (gd, imr, im1, ncolr, ixshift, iyshift) + + case 'y': + if (ctoi (Memc[cmd], ip, nliner) <= 0) + nliner = (1 + nrimlines) / 2 + nliner = max (1, min (nliner, nrimlines)) + call rg_xpline (gd, imr, im1, nliner, ixlag, iylag) + + case 'x': + if (ctoi (Memc[cmd], ip, ncolr) <= 0) + ncolr = (1 + nrimcols) / 2 + ncolr = max (1, min (ncolr, nrimcols)) + call rg_xpcol (gd, imr, im1, ncolr, ixlag, iylag) + + case 'h': + if (ctoi (Memc[cmd], ip, nliner) <= 0) + nliner = (1 + nrimlines) / 2 + nliner = max (1, min (nliner, nrimlines)) + call rg_xpline (gd, imr, im1, nliner, nint (xshift), + nint (yshift)) + + case 'v': + if (ctoi (Memc[cmd], ip, ncolr) <= 0) + ncolr = (1 + nrimcols) / 2 + ncolr = max (1, min (ncolr, nrimcols)) + call rg_xpcol (gd, imr, im1, ncolr, nint (xshift), + nint (yshift)) + default: + call printf ("Ambiguous or unknown overlay menu command\n") + } + case 'g': + while (clgcur ("gcommands", wx, wy, wcs, key, Memc[cmd], + SZ_LINE) != EOF) { + if (key == 'q') + break + } + default: + call printf ("Ambiguous or unknown overlay menu command\n") + } + + } + + call sfree (sp) +end + + +# RG_XCPLOT -- Draw the default plot of the cross-correlation function. + +procedure rg_xcplot (xc, gd, col, line, plottype) + +pointer xc #I pointer to cross-correlation structure +pointer gd #I pointer to the graphics stream +int col #I column of cross-correlation function to plot +int line #I line of cross-correlation function to plot +int plottype #I the default plot type + +int nreg, xwindow, ywindow +pointer sp, title, str, prc1, prc2, prl1, prl2 +int rg_xstati(), strlen() +pointer rg_xstatp() + +begin + if (gd == NULL) + return + + # Allocate working space. + call smark (sp) + call salloc (title, SZ_LINE, TY_CHAR) + call salloc (str, SZ_LINE, TY_CHAR) + + # Get the regions. + nreg = rg_xstati (xc, CREGION) + prc1 = rg_xstatp (xc, RC1) + prc2 = rg_xstatp (xc, RC2) + prl1 = rg_xstatp (xc, RL1) + prl2 = rg_xstatp (xc, RL2) + + # Initialize the window size. + xwindow = rg_xstati (xc, XWINDOW) + if ((Memi[prl2+nreg-1] - Memi[prl1+nreg-1] + 1) == 1) + ywindow = 1 + else + ywindow = rg_xstati (xc, YWINDOW) + + # Construct a title. + call sprintf (Memc[title], SZ_LINE, + "Reference: %s Image: %s Region: [%d:%d,%d:%d]") + call rg_xstats (xc, REFIMAGE, Memc[str], SZ_FNAME) + call pargstr (Memc[str]) + call rg_xstats (xc, IMAGE, Memc[str], SZ_FNAME) + call pargstr (Memc[str]) + call pargi (Memi[prc1+nreg-1]) + call pargi (Memi[prc2+nreg-1]) + call pargi (Memi[prl1+nreg-1]) + call pargi (Memi[prl2+nreg-1]) + + # Draw the plot. + if (ywindow == 1) { + call sprintf (Memc[title+strlen(Memc[title])], SZ_LINE, + "\nX-Correlation Function: line %d") + call pargi (1) + call rg_xcpline (gd, Memc[title], Memr[rg_xstatp(xc,XCOR)], + xwindow, ywindow, 1) + } else { + switch (plottype) { + case XC_PCONTOUR: + call rg_contour (gd, "X-Correlation Function", Memc[title], + Memr[rg_xstatp (xc, XCOR)], xwindow, ywindow) + case XC_PLINE: + call sprintf (Memc[title+strlen(Memc[title])], SZ_LINE, + "\nX-Correlation Function: line %d") + call pargi (line) + call rg_xcpline (gd, Memc[title], Memr[rg_xstatp(xc,XCOR)], + xwindow, ywindow, line) + case XC_PCOL: + call sprintf (Memc[title+strlen(Memc[title])], SZ_LINE, + "\nX-Correlation Function: column %d") + call pargi (col) + call rg_xcpcol (gd, Memc[title], Memr[rg_xstatp(xc,XCOR)], + xwindow, ywindow, col) + default: + call rg_contour (gd, "X-Correlation Function", Memc[title], + Memr[rg_xstatp (xc, XCOR)], xwindow, ywindow) + } + } + + call sfree (sp) +end + + +# RG_COKEYS -- Fetch the first keystroke of a colon command. + +procedure rg_cokeys (cmd, ip, maxch, key) + +char cmd[ARB] #I the command string +int ip #I/O pointer into the command string +int maxch #I maximum number of characters +int key #O the keystroke + +begin + ip = 1 + while (IS_WHITE(cmd[ip]) && cmd[ip] != EOS && ip <= maxch) + ip = ip + 1 + + if (cmd[ip] == EOS && ip > maxch) + key = EOS + else { + key = cmd[ip] + ip = ip + 1 + } +end + + +define QUERY "Hit [return=continue, n=next image, q=quit, w=quit and update parameters]: " + +# RG_XGQVERIFY -- Print a message on the status line asking the user if they +# really want to quit, returning YES if they really want to quit, NO otherwise. + +int procedure rg_xgqverify (task, db, dformat, rg, ch) + +char task[ARB] #I the calling task name +pointer db #I pointer to the shifts database file +int dformat #I is the shifts file in database format +pointer rg #I pointer to the task structure +int ch #I the input keystroke command + +int wcs, stat +pointer sp, cmd +real wx, wy +bool streq() +int clgcur() + +begin + call smark (sp) + call salloc (cmd, SZ_LINE, TY_CHAR) + + # Print the status line query in reverse video and get the keystroke. + call printf (QUERY) + #call flush (STDOUT) + if (clgcur ("gcommands", wx, wy, wcs, ch, Memc[cmd], SZ_LINE) == EOF) + ; + + # Process the command. + if (ch == 'q') { + call rg_xwrec (db, dformat, rg) + stat = YES + } else if (ch == 'w') { + call rg_xwrec (db, dformat, rg) + if (streq ("xregister", task)) + call rg_pxpars (rg) + stat = YES + } else if (ch == 'n') { + call rg_xwrec (db, dformat, rg) + stat = YES + } else { + stat = NO + } + + call sfree (sp) + return (stat) +end + + +# RG_XGTVERIFY -- Verify whether or not the user truly wishes to quit the +# task. + +int procedure rg_xgtverify (ch) + +int ch #I the input keystroke command + +begin + if (ch == 'q') { + return (YES) + } else if (ch == 'w') { + return (YES) + } else if (ch == 'n') { + return (NO) + } else { + return (NO) + } +end diff --git a/pkg/images/immatch/src/xregister/rgximshift.x b/pkg/images/immatch/src/xregister/rgximshift.x new file mode 100644 index 00000000..08cb3f62 --- /dev/null +++ b/pkg/images/immatch/src/xregister/rgximshift.x @@ -0,0 +1,391 @@ +include <imhdr.h> +include <imset.h> +include <math/iminterp.h> + +define NYOUT 16 # number of lines output at once +define NMARGIN 3 # number of boundary pixels required +define NMARGIN_SPLINE3 16 # number of spline boundary pixels required + + +# RG_XSHIFTIM - Shift a 1 or 2D image by a fractional pixel amount +# x and y + +procedure rg_xshiftim (im1, im2, xshift, yshift, interpstr, boundary_type, + constant) + +pointer im1 #I pointer to input image +pointer im2 #I pointer to output image +real xshift #I shift in x direction +real yshift #I shift in y direction +char interpstr[ARB] #I type of interpolant +int boundary_type #I type of boundary extension +real constant #I value of constant for boundary extension + +int interp_type +pointer sp, str +bool fp_equalr() +int strdic() + +begin + call smark (sp) + call salloc (str, SZ_FNAME, TY_CHAR) + interp_type = strdic (interpstr, Memc[str], SZ_FNAME, II_BFUNCTIONS) + + if (interp_type == II_NEAREST) + call rg_xishiftim (im1, im2, nint (xshift), nint (yshift), + interp_type, boundary_type, constant) + else if (fp_equalr (xshift, real (int (xshift))) && fp_equalr (yshift, + real (int (xshift)))) + call rg_xishiftim (im1, im2, int (xshift), int (yshift), + interp_type, boundary_type, constant) + else + call rg_xfshiftim (im1, im2, xshift, yshift, interpstr, + boundary_type, constant) + call sfree (sp) +end + + +# RG_XISHIFTIM -- Shift a 2-D image by integral pixels in x and y. + +procedure rg_xishiftim (im1, im2, nxshift, nyshift, interp_type, boundary_type, + constant) + +pointer im1 #I pointer to the input image +pointer im2 #I pointer to the output image +int nxshift, nyshift #I shift in x and y +int interp_type #I type of interpolant +int boundary_type #I type of boundary extension +real constant #I constant for boundary extension + +int ixshift, iyshift +pointer buf1, buf2 +long v[IM_MAXDIM] +int ncols, nlines, nbpix +int i, x1col, x2col, yline + +int impnls(), impnli(), impnll(), impnlr(), impnld(), impnlx() +pointer imgs2s(), imgs2i(), imgs2l(), imgs2r(), imgs2d(), imgs2x() +errchk impnls, impnli, impnll, impnlr, impnld, impnlx +errchk imgs2s, imgs2i, imgs2l, imgs2r, imgs2d, imgs2x +string wrerr "ISHIFTXY: Error writing in image." + +begin + ixshift = nxshift + iyshift = nyshift + + ncols = IM_LEN(im1,1) + nlines = IM_LEN(im1,2) + + # Cannot shift off image. + if (ixshift < -ncols || ixshift > ncols) + call error (3, "ISHIFTXY: X shift out of bounds.") + if (iyshift < -nlines || iyshift > nlines) + call error (4, "ISHIFTXY: Y shift out of bounds.") + + # Calculate the shift. + switch (boundary_type) { + case BT_CONSTANT,BT_REFLECT,BT_NEAREST: + ixshift = min (ncols, max (-ncols, ixshift)) + iyshift = min (nlines, max (-nlines, iyshift)) + case BT_WRAP: + ixshift = mod (ixshift, ncols) + iyshift = mod (iyshift, nlines) + } + + # Set the boundary extension values. + nbpix = max (abs (ixshift), abs (iyshift)) + call imseti (im1, IM_NBNDRYPIX, nbpix) + call imseti (im1, IM_TYBNDRY, boundary_type) + if (boundary_type == BT_CONSTANT) + call imsetr (im1, IM_BNDRYPIXVAL, constant) + + # Get column boundaries in the input image. + x1col = max (-ncols + 1, - ixshift + 1) + x2col = min (2 * ncols, ncols - ixshift) + + call amovkl (long (1), v, IM_MAXDIM) + + # Shift the image using the appropriate data type operators. + switch (IM_PIXTYPE(im1)) { + case TY_SHORT: + do i = 1, nlines { + if (impnls (im2, buf2, v) == EOF) + call error (5, wrerr) + yline = i - iyshift + buf1 = imgs2s (im1, x1col, x2col, yline, yline) + if (buf1 == EOF) + call error (5, wrerr) + call amovs (Mems[buf1], Mems[buf2], ncols) + } + case TY_INT: + do i = 1, nlines { + if (impnli (im2, buf2, v) == EOF) + call error (5, wrerr) + yline = i - iyshift + buf1 = imgs2i (im1, x1col, x2col, yline, yline) + if (buf1 == EOF) + call error (5, wrerr) + call amovi (Memi[buf1], Memi[buf2], ncols) + } + case TY_USHORT, TY_LONG: + do i = 1, nlines { + if (impnll (im2, buf2, v) == EOF) + call error (5, wrerr) + yline = i - iyshift + buf1 = imgs2l (im1, x1col, x2col, yline, yline) + if (buf1 == EOF) + call error (5, wrerr) + call amovl (Meml[buf1], Meml[buf2], ncols) + } + case TY_REAL: + do i = 1, nlines { + if (impnlr (im2, buf2, v) == EOF) + call error (5, wrerr) + yline = i - iyshift + buf1 = imgs2r (im1, x1col, x2col, yline, yline) + if (buf1 == EOF) + call error (5, wrerr) + call amovr (Memr[buf1], Memr[buf2], ncols) + } + case TY_DOUBLE: + do i = 1, nlines { + if (impnld (im2, buf2, v) == EOF) + call error (0, wrerr) + yline = i - iyshift + buf1 = imgs2d (im1, x1col, x2col, yline, yline) + if (buf1 == EOF) + call error (0, wrerr) + call amovd (Memd[buf1], Memd[buf2], ncols) + } + case TY_COMPLEX: + do i = 1, nlines { + if (impnlx (im2, buf2, v) == EOF) + call error (0, wrerr) + yline = i - iyshift + buf1 = imgs2x (im1, x1col, x2col, yline, yline) + if (buf1 == EOF) + call error (0, wrerr) + call amovx (Memx[buf1], Memx[buf2], ncols) + } + default: + call error (6, "ISHIFTXY: Unknown IRAF type.") + } +end + + + +# RG_XFSHIFTIM -- Shift a 1 or 2D image by a fractional pixel amount +# in x and y. + +procedure rg_xfshiftim (im1, im2, xshift, yshift, interpstr, boundary_type, + constant) + +pointer im1 #I pointer to input image +pointer im2 #I pointer to output image +real xshift #I shift in x direction +real yshift #I shift in y direction +char interpstr[ARB] #I type of interpolant +int boundary_type #I type of boundary extension +real constant #I value of constant for boundary extension + +int i, interp_type, nsinc, nincr +int ncols, nlines, nbpix, fstline, lstline, nxymargin +int cin1, cin2, nxin, lin1, lin2, nyin +int lout1, lout2, nyout +real xshft, yshft, deltax, deltay, dx, dy, cx, ly +pointer sp, x, y, msi, sinbuf, soutbuf +bool fp_equalr() +int msigeti() +pointer imps2r() + +errchk imgs2r, imps2r +errchk msiinit, msifree, msifit, msigrid +errchk smark, salloc, sfree + +begin + ncols = IM_LEN(im1,1) + nlines = IM_LEN(im1,2) + + # Check for out of bounds shift. + if (xshift < -ncols || xshift > ncols) + call error (0, "XC_SHIFTIM: X shift out of bounds.") + if (yshift < -nlines || yshift > nlines) + call error (0, "XC_SHIFTIM: Y shift out of bounds.") + + # Get the real shift. + if (boundary_type == BT_WRAP) { + xshft = mod (xshift, real (ncols)) + yshft = mod (yshift, real (nlines)) + } else { + xshft = xshift + yshft = yshift + } + + # Allocate temporary space. + call smark (sp) + call salloc (x, 2 * ncols, TY_REAL) + call salloc (y, 2 * nlines, TY_REAL) + sinbuf = NULL + + # Define the x and y interpolation coordinates. + dx = abs (xshft - int (xshft)) + if (fp_equalr (dx, 0.0)) + deltax = 0.0 + else if (xshft > 0.) + deltax = 1. - dx + else + deltax = dx + dy = abs (yshft - int (yshft)) + if (fp_equalr (dy, 0.0)) + deltay = 0.0 + else if (yshft > 0.) + deltay = 1. - dy + else + deltay = dy + + # Initialize the 2-D interpolation routines. + call msitype (interpstr, interp_type, nsinc, nincr, cx) + if (interp_type == II_BILSINC || interp_type == II_BISINC) + call msisinit (msi, interp_type, nsinc, 1, 1, + deltax - nint (deltax), deltay - nint (deltay), 0.0) + else + call msisinit (msi, interp_type, nsinc, 1, 1, cx, cx, 0.0) + + # Set boundary extension parameters. + if (interp_type == II_BISPLINE3) + nxymargin = NMARGIN_SPLINE3 + else if (interp_type == II_BISINC || interp_type == II_BILSINC) + nxymargin = msigeti (msi, II_MSINSINC) + else + nxymargin = NMARGIN + nbpix = max (int (abs(xshft)+1.0), int (abs(yshft)+1.0)) + nxymargin + call imseti (im1, IM_NBNDRYPIX, nbpix) + call imseti (im1, IM_TYBNDRY, boundary_type) + if (boundary_type == BT_CONSTANT) + call imsetr (im1, IM_BNDRYPIXVAL, constant) + + # Define the x interpolation coordinates. + deltax = deltax + nxymargin + if (interp_type == II_BIDRIZZLE) { + do i = 1, ncols { + Memr[x+2*i-2] = i + deltax - 0.5 + Memr[x+2*i-1] = i + deltax + 0.5 + } + } else { + do i = 1, ncols + Memr[x+i-1] = i + deltax + } + + # Define the y interpolation coordinates. + deltay = deltay + nxymargin + if (interp_type == II_BIDRIZZLE) { + do i = 1, NYOUT { + Memr[y+2*i-2] = i + deltay - 0.5 + Memr[y+2*i-1] = i + deltay + 0.5 + } + } else { + do i = 1, NYOUT + Memr[y+i-1] = i + deltay + } + + # Define column range in the input image. + cx = 1. - nxymargin - xshft + if ((cx <= 0.) && (! fp_equalr (dx, 0.0))) + cin1 = int (cx) - 1 + else + cin1 = int (cx) + cin2 = ncols - xshft + nxymargin + 1 + nxin = cin2 - cin1 + 1 + + # Loop over output sections. + for (lout1 = 1; lout1 <= nlines; lout1 = lout1 + NYOUT) { + + # Define range of output lines. + lout2 = min (lout1 + NYOUT - 1, nlines) + nyout = lout2 - lout1 + 1 + + # Define correspoding range of input lines. + ly = lout1 - nxymargin - yshft + if ((ly <= 0) && (! fp_equalr (dy, 0.0))) + lin1 = int (ly) - 1 + else + lin1 = int (ly) + lin2 = lout2 - yshft + nxymargin + 1 + nyin = lin2 - lin1 + 1 + + # Get appropriate input image section and compute the coefficients. + if ((sinbuf == NULL) || (lin1 < fstline) || (lin2 > lstline)) { + fstline = lin1 + lstline = lin2 + call rg_buf (im1, cin1, cin2, lin1, lin2, sinbuf) + call msifit (msi, Memr[sinbuf], nxin, nyin, nxin) + } + + # Output the image section. + soutbuf = imps2r (im2, 1, ncols, lout1, lout2) + if (soutbuf == EOF) + call error (0, "GSHIFTXY: Error writing output image.") + + # Evaluate the interpolant. + call msigrid (msi, Memr[x], Memr[y], Memr[soutbuf], ncols, nyout, + ncols) + } + + call msifree (msi) + call sfree (sp) +end + + +# RG_BUF -- Procedure to provide a buffer of image lines with minimum reads + +procedure rg_buf (im, col1, col2, line1, line2, buf) + +pointer im #I pointer to input image +int col1, col2 #I column range of input buffer +int line1, line2 #I line range of input buffer +pointer buf #I buffer + +int i, ncols, nlines, nclast, llast1, llast2, nllast +pointer buf1, buf2 + +pointer imgs2r() + +begin + ncols = col2 - col1 + 1 + nlines = line2 - line1 + 1 + + if (buf == NULL) { + call malloc (buf, ncols * nlines, TY_REAL) + llast1 = line1 - nlines + llast2 = line2 - nlines + } else if ((nlines != nllast) || (ncols != nclast)) { + call realloc (buf, ncols * nlines, TY_REAL) + llast1 = line1 - nlines + llast2 = line2 - nlines + } + + if (line1 < llast1) { + do i = line2, line1, -1 { + if (i > llast1) + buf1 = buf + (i - llast1) * ncols + else + buf1 = imgs2r (im, col1, col2, i, i) + buf2 = buf + (i - line1) * ncols + call amovr (Memr[buf1], Memr[buf2], ncols) + } + } else if (line2 > llast2) { + do i = line1, line2 { + if (i < llast2) + buf1 = buf + (i - llast1) * ncols + else + buf1 = imgs2r (im, col1, col2, i, i) + buf2 = buf + (i - line1) * ncols + call amovr (Memr[buf1], Memr[buf2], ncols) + } + } + + llast1 = line1 + llast2 = line2 + nclast = ncols + nllast = nlines +end diff --git a/pkg/images/immatch/src/xregister/rgxplot.x b/pkg/images/immatch/src/xregister/rgxplot.x new file mode 100644 index 00000000..8b347ab5 --- /dev/null +++ b/pkg/images/immatch/src/xregister/rgxplot.x @@ -0,0 +1,317 @@ +include <imhdr.h> +include <gset.h> + +# RG_XPLINE -- Plot a line of reference and input image. + +procedure rg_xpline (gd, imr, im, nliner, xshift, yshift) + +pointer gd #I pointer to the graphics stream +pointer imr #I pointer to the reference image +pointer im #I pointer to the image +int nliner #I the reference line +int xshift #I x shift +int yshift #I y shift + +int i, rncols, rnlines, incols, inlines +pointer sp, title, xr, xi, ptrr, ptri +real ymin, ymax, tymin, tymax +int strlen() +pointer imgl1r(), imgl2r() + +begin + # Return if no graphics stream. + if (gd == NULL) + return + + # Check for valid line number. + rncols = IM_LEN(imr,1) + if (IM_NDIM(imr) == 1) + rnlines = 1 + else + rnlines = IM_LEN(imr,2) + incols = IM_LEN(im,1) + if (IM_NDIM(im) == 1) + inlines = 1 + else + inlines = IM_LEN(im,2) + if ((nliner < 1) || (nliner > rnlines)) + return + if (((nliner + yshift) < 1) || ((nliner + yshift) > inlines)) + return + + # Allocate working space. + call smark (sp) + call salloc (title, SZ_LINE, TY_CHAR) + call salloc (xr, rncols, TY_REAL) + call salloc (xi, rncols, TY_REAL) + + # Initialize the x data data. + do i = 1, rncols { + Memr[xr+i-1] = i + Memr[xi+i-1] = i - xshift + } + + # Initalize the y data. + if (IM_NDIM(imr) == 1) + ptrr = imgl1r (imr) + else + ptrr = imgl2r (imr, nliner) + if (IM_NDIM(im) == 1) + ptri = imgl1r (im) + else + ptri = imgl2r (im, nliner + yshift) + call alimr (Memr[ptrr], rncols, ymin, ymax) + call alimr (Memr[ptri], incols, tymin, tymax) + ymin = min (ymin, tymin) + ymax = max (ymax, tymax) + + # Construct the title. + call sprintf (Memc[title], SZ_LINE, + "Refimage: %s Image: %s\n") + call pargstr (IM_HDRFILE(imr)) + call pargstr (IM_HDRFILE(im)) + call sprintf (Memc[title+strlen(Memc[title])], SZ_LINE, + "Refline (solid): %d Inline (dashed): %d Xlag: %d Ylag: %d") + call pargi (nliner) + call pargi (nliner + yshift) + call pargi (xshift) + call pargi (yshift) + + # Set up the axes labels and window. + call gclear (gd) + call gswind (gd, 1.0, real(rncols), ymin, ymax) + call glabax (gd, Memc[title], "Column Number", "Counts") + + # Plot the two lines. + call gseti (gd, G_PLTYPE, GL_SOLID) + call gpline (gd, Memr[xr], Memr[ptrr], rncols) + call gseti (gd, G_PLTYPE, GL_DASHED) + call gpline (gd, Memr[xi], Memr[ptri], incols) + call gflush (gd) + + call sfree (sp) +end + + +# RG_XPCOL -- Plot a column in the reference and input image. + +procedure rg_xpcol (gd, imr, im, ncolr, xshift, yshift) + +pointer gd #I pointer to the graphics stream +pointer imr #I pointer to the reference image +pointer im #I pointer to the image +int ncolr #I the line number +int xshift #I xshift to be applied +int yshift #I yshift to be applied + +int i, rncols, rnlines, incols, inlines +pointer sp, title, xr, xi, ptrr, ptri +real ymin, ymax, tymin, tymax +int strlen() +pointer imgs1r(), imgs2r() + +begin + # Return if no graphics stream. + if (gd == NULL) + return + + # Check for valid column number. + rncols = IM_LEN(imr,1) + if (IM_NDIM(imr) == 1) + rnlines = 1 + else + rnlines = IM_LEN(imr,2) + incols = IM_LEN(im,1) + if (IM_NDIM(im) == 1) + inlines = 1 + else + inlines = IM_LEN(im,2) + if ((ncolr < 1) || (ncolr > rncols)) + return + if (((ncolr - xshift) < 1) || ((ncolr - xshift) > incols)) + return + + # Allocate valid working space. + call smark (sp) + call salloc (title, SZ_LINE, TY_CHAR) + call salloc (xr, rnlines, TY_REAL) + call salloc (xi, inlines, TY_REAL) + + # Initialize the data. + do i = 1, rnlines { + Memr[xr+i-1] = i + Memr[xi+i-1] = i - yshift + } + if (IM_NDIM(imr) == 1) + ptrr = imgs1r (imr, ncolr, ncolr) + else + ptrr = imgs2r (imr, ncolr, ncolr, 1, rnlines) + if (IM_NDIM(im) == 1) + ptri = imgs1r (im, ncolr + xshift, ncolr + xshift) + else + ptri = imgs2r (im, ncolr + xshift, ncolr + xshift, 1, inlines) + call alimr (Memr[ptrr], rnlines, ymin, ymax) + call alimr (Memr[ptri], inlines, tymin, tymax) + ymin = min (ymin, tymin) + ymax = max (ymax, tymax) + + # Construct the title. + call sprintf (Memc[title], SZ_LINE, "Refimage: %s Image: %s\n") + call pargstr (IM_HDRFILE(imr)) + call pargstr (IM_HDRFILE(im)) + call sprintf (Memc[title+strlen(Memc[title])], SZ_LINE, + "Refcol (solid): %d Imcol (dashed): %d Xlag: %d Ylag: %d") + call pargi (ncolr) + call pargi (ncolr + xshift) + call pargi (xshift) + call pargi (yshift) + + # Set up the labels and the axes. + call gclear (gd) + call gswind (gd, 1.0, real (rnlines), ymin, ymax) + call glabax (gd, Memc[title], "Line Number", "Counts") + + # Plot the profile. + call gseti (gd, G_PLTYPE, GL_SOLID) + call gpline (gd, Memr[xr], Memr[ptrr], rnlines) + call gseti (gd, G_PLTYPE, GL_DASHED) + call gpline (gd, Memr[xi], Memr[ptri], rnlines) + call gflush (gd) + + call sfree (sp) +end + + +# RG_XCPLINE -- Plot a line of the 2D correlation function. + +procedure rg_xcpline (gd, title, data, nx, ny, nline) + +pointer gd #I pointer to the graphics stream +char title[ARB] #I title for the plot +real data[nx,ARB] #I the input data array +int nx, ny #I dimensions of the input data array +int nline #I the line number + +int i +pointer sp, str, x +real ymin, ymax + +begin + # Return if no graphics stream. + if (gd == NULL) + return + + # Check for valid line number. + if (nline < 1 || nline > ny) + return + + # Allocate some working space. + call smark (sp) + call salloc (str, SZ_LINE, TY_CHAR) + call salloc (x, nx, TY_REAL) + + # Initialize the data. + do i = 1, nx + Memr[x+i-1] = i + call alimr (data[1,nline], nx, ymin, ymax) + + # Set up the labels and the axes. + call gclear (gd) + call gswind (gd, 1.0, real (nx), ymin, ymax) + call glabax (gd, title, "X Lag", "X-Correlation Function") + + # Plot the line profile. + call gseti (gd, G_PLTYPE, GL_SOLID) + call gpline (gd, Memr[x], data[1,nline], nx) + call gflush (gd) + + call sfree (sp) +end + + +# RG_XCPCOL -- Plot a column of the cross-correlation function. + +procedure rg_xcpcol (gd, title, data, nx, ny, ncol) + +pointer gd #I pointer to the graphics stream +char title[ARB] #I title of the column plot +real data[nx,ARB] #I the input data array +int nx, ny #I the dimensions of the input data array +int ncol #I line number + +int i +pointer sp, x, y +real ymin, ymax + +begin + # Return if no graphics stream. + if (gd == NULL) + return + + # Check for valid column number. + if (ncol < 1 || ncol > nx) + return + + # Initialize. + call smark (sp) + call salloc (x, ny, TY_REAL) + call salloc (y, ny, TY_REAL) + + # Get the data to be plotted. + do i = 1, ny { + Memr[x+i-1] = i + Memr[y+i-1] = data[ncol,i] + } + call alimr (Memr[y], ny, ymin, ymax) + + # Set up the labels and the axes. + call gclear (gd) + call gswind (gd, 1.0, real (ny), ymin, ymax) + call glabax (gd, title, "Y Lag", "X-Correlation Function") + + # Plot the profile. + call gseti (gd, G_PLTYPE, GL_SOLID) + call gpline (gd, Memr[x], Memr[y], ny) + call gflush (gd) + + call sfree (sp) +end + + +# RG_XMKPEAK -- Procedure to mark the peak from a correlation function +# contour plot. + +procedure rg_xmkpeak (gd, xwindow, ywindow, xshift, yshift) + +pointer gd #I pointer to the graphics stream +int xwindow #I x dimension of correlation function +int ywindow #I y dimension of correlation function +real xshift #O x shift +real yshift #O y shift + +int wcs, key +pointer sp, cmd +real wx, wy +int clgcur() + +begin + if (gd == NULL) + return + + call smark (sp) + call salloc (cmd, SZ_LINE, TY_CHAR) + + call printf ("Mark peak of the cross correlation function\n") + if (clgcur ("gcommands", wx, wy, wcs, key, Memc[cmd], SZ_LINE) == EOF) + ; + if (wx < 1.0 || wx > real (xwindow) || wy < 1.0 || wy > + real (ywindow)) { + xshift = 0.0 + yshift = 0.0 + } else { + xshift = wx - (1 + xwindow) / 2 + yshift = wy - (1 + ywindow) / 2 + } + + call sfree (sp) +end diff --git a/pkg/images/immatch/src/xregister/rgxppars.x b/pkg/images/immatch/src/xregister/rgxppars.x new file mode 100644 index 00000000..2dc6aafd --- /dev/null +++ b/pkg/images/immatch/src/xregister/rgxppars.x @@ -0,0 +1,49 @@ +include "xregister.h" + +# RG_PXPARS -- Update the cross-correlation algorithm parameters. + +procedure rg_pxpars (xc) + +pointer xc #I pointer to the cross-correlation structure + +pointer sp, str +int rg_xstati() +real rg_xstatr() + +begin + # Allocate working space. + call smark (sp) + call salloc (str, SZ_LINE, TY_CHAR) + + # Define the regions. + call rg_xstats (xc, REGIONS, Memc[str], SZ_LINE) + call clpstr ("regions", Memc[str]) + call clputi ("xlag", rg_xstati (xc, XLAG)) + call clputi ("ylag", rg_xstati (xc, YLAG)) + call clputi ("dxlag", rg_xstati (xc, DXLAG)) + call clputi ("dylag", rg_xstati (xc, DYLAG)) + + # Store the background fitting parameters. + call rg_xstats (xc, BSTRING, Memc[str], SZ_LINE) + call clpstr ("background", Memc[str]) + call clputi ("border", rg_xstati (xc, BORDER)) + call clputr ("loreject", rg_xstatr (xc, LOREJECT)) + call clputr ("hireject", rg_xstatr (xc, HIREJECT)) + call clputr ("apodize", rg_xstatr (xc, APODIZE)) + call rg_xstats (xc, FSTRING, Memc[str], SZ_LINE) + call clpstr ("filter", Memc[str]) + + # Store the cross-correlation parameters. + call rg_xstats (xc, CSTRING, Memc[str], SZ_LINE) + call clpstr ("correlation", Memc[str]) + call clputi ("xwindow", rg_xstati (xc, XWINDOW)) + call clputi ("ywindow", rg_xstati (xc, YWINDOW)) + + # Store the peak centering parameters. + call rg_xstats (xc, PSTRING, Memc[str], SZ_LINE) + call clpstr ("function", Memc[str]) + call clputi ("xcbox", rg_xstati (xc, XCBOX)) + call clputi ("ycbox", rg_xstati (xc, YCBOX)) + + call sfree (sp) +end diff --git a/pkg/images/immatch/src/xregister/rgxregions.x b/pkg/images/immatch/src/xregister/rgxregions.x new file mode 100644 index 00000000..ed682f61 --- /dev/null +++ b/pkg/images/immatch/src/xregister/rgxregions.x @@ -0,0 +1,459 @@ +include <fset.h> +include <ctype.h> +include <imhdr.h> +include "xregister.h" + +# RG_XREGIONS -- Decode the image sections into regions. If the sections string +# is NULL then the regions list is initially empty and depending on the mode +# of the task, XREGISTER will or will not complain.Otherwise the image +# sections specified in the sections string or file are decoded into a +# regions list. + +int procedure rg_xregions (list, im, xc, rp) + +int list #I pointer to the regions list +pointer im #I pointer to the reference image +pointer xc #I pointer to the cross-correlation structure +int rp #I index of the current region + +int fd, nregions +pointer sp, fname, regions +int rg_xgrid(), rg_xgregions(), rg_xrregions(), rg_xstati(), fntgfnb() +int open() +errchk fntgfnb(), open(), close() + +begin + call smark (sp) + call salloc (fname, SZ_FNAME, TY_CHAR) + call salloc (regions, SZ_LINE, TY_CHAR) + + call rg_xstats (xc, REGIONS, Memc[regions], SZ_LINE) + if (rp < 1 || rp > MAX_NREGIONS || Memc[regions] == EOS) { + nregions = 0 + } else if (rg_xgrid (im, xc, rp, MAX_NREGIONS) > 0) { + nregions = rg_xstati (xc, NREGIONS) + } else if (rg_xgregions (im, xc, rp, MAX_NREGIONS) > 0) { + nregions = rg_xstati (xc, NREGIONS) + } else if (list != NULL) { + iferr { + if (fntgfnb (list, Memc[fname], SZ_FNAME) != EOF) { + fd = open (Memc[fname], READ_ONLY, TEXT_FILE) + nregions= rg_xrregions (fd, im, xc, rp, MAX_NREGIONS) + call close (fd) + } + } then + nregions = 0 + } else + nregions = 0 + + call sfree (sp) + + return (nregions) +end + + +# RG_XMKREGIONS -- Create a list of regions by marking image sections +# on the image display. + +int procedure rg_xmkregions (im, xc, rp, max_nregions, regions, maxch) + +pointer im #I pointer to the reference image +pointer xc #I pointer to the cross-correlation structure +int rp #I index of the current region +int max_nregions #I the maximum number of regions +char regions[ARB] #O the output regions string +int maxch #I maximum size of the output regions string + +int op, nregions, wcs, key +pointer sp, region, section, cmd +real xll, yll, xur, yur +int rg_xstati(), clgcur(), gstrcpy() +pointer rg_xstatp() + +begin + # Allocate working space. + call smark (sp) + call salloc (region, SZ_LINE, TY_CHAR) + call salloc (section, SZ_LINE, TY_CHAR) + call salloc (cmd, SZ_LINE, TY_CHAR) + + # Allocate the arrays to hold the regions information, + call rg_xrealloc (xc, max_nregions) + + # Initialize. + nregions = min (rp-1, rg_xstati (xc, NREGIONS)) + op = 1 + + # Mark the sections on the display. + while (nregions < max_nregions) { + + call printf ("Mark lower left corner of region %d [q to quit].\n") + call pargi (nregions + 1) + if (clgcur ("icommands", xll, yll, wcs, key, Memc[cmd], + SZ_LINE) == EOF) + break + if (key == 'q') + break + + call printf ("Mark upper right corner of region %d [q to quit].\n") + call pargi (nregions + 1) + if (clgcur ("icommands", xur, yur, wcs, key, Memc[cmd], + SZ_LINE) == EOF) + break + if (key == 'q') + break + + if (xll < 1.0 || xur > IM_LEN(im,1) || yll < 1.0 || yur > + IM_LEN(im,2)) + break + + Memi[rg_xstatp(xc,RC1)+nregions] = nint (xll) + Memi[rg_xstatp(xc,RC2)+nregions] = nint (xur) + Memi[rg_xstatp(xc,RL1)+nregions] = nint (yll) + Memi[rg_xstatp(xc,RL2)+nregions] = nint (yur) + Memr[rg_xstatp(xc,RZERO)+nregions] = INDEFR + Memr[rg_xstatp(xc,RXSLOPE)+nregions] = INDEFR + Memr[rg_xstatp(xc,RYSLOPE)+nregions] = INDEFR + Memr[rg_xstatp(xc,XSHIFTS)+nregions] = INDEFR + Memr[rg_xstatp(xc,YSHIFTS)+nregions] = INDEFR + nregions = nregions + 1 + + # Write the first 9 regions into the regions string. + call sprintf (Memc[cmd], SZ_LINE, "[%d:%d,%d:%d] ") + call pargi (nint (xll)) + call pargi (nint (xur)) + call pargi (nint (yll)) + call pargi (nint (yur)) + op = op + gstrcpy (Memc[cmd], regions[op], maxch - op + 1) + } + call printf ("\n") + + # Reallocate the correct amount of space. + call rg_xseti (xc, NREGIONS, nregions) + if (nregions > 0) + call rg_xrealloc (xc, nregions) + else + call rg_xrfree (xc) + + call sfree (sp) + + return (nregions) +end + + +# RG_XGRID - Decode the regions from a grid specification. + +int procedure rg_xgrid (im, xc, rp, max_nregions) + +pointer im #I pointer to the reference image +pointer xc #I pointer to the cross-correlation structure +int rp #I index of the current region +int max_nregions #I the maximum number of regions + +int i, istart, iend, j, jstart, jend, ncols, nlines, nxsample, nysample +int nxcols, nylines, nregions +pointer sp, region, section +int rg_xstati(), nscan(), strcmp() +pointer rg_xstatp() + +begin + # Allocate working space. + call smark (sp) + call salloc (region, SZ_LINE, TY_CHAR) + call salloc (section, SZ_LINE, TY_CHAR) + + # Allocate the arrays to hold the regions information, + call rg_xrealloc (xc, max_nregions) + + # Initialize. + call rg_xstats (xc, REGIONS, Memc[region], SZ_LINE) + ncols = IM_LEN(im,1) + nlines = IM_LEN(im,2) + nregions = min (rp - 1, rg_xstati (xc, NREGIONS)) + + # Decode the grid specification. + call sscan (Memc[region]) + call gargwrd (Memc[section], SZ_LINE) + call gargi (nxsample) + call gargi (nysample) + if ((nscan() != 3) || (strcmp (Memc[section], "grid") != 0)) { + call sfree (sp) + return (nregions) + } + + # Decode the regions. + if ((nxsample * nysample) > max_nregions) { + nxsample = nint (sqrt (real (max_nregions) * real (ncols) / + real (nlines))) + nysample = real (max_nregions) / real (nxsample) + } + nxcols = ncols / nxsample + nylines = nlines / nysample + jstart = 1 + (nlines - nysample * nylines) / 2 + jend = jstart + (nysample - 1) * nylines + do j = jstart, jend, nylines { + istart = 1 + (ncols - nxsample * nxcols) / 2 + iend = istart + (nxsample - 1) * nxcols + do i = istart, iend, nxcols { + Memi[rg_xstatp(xc,RC1)+nregions] = i + Memi[rg_xstatp(xc,RC2)+nregions] = i + nxcols - 1 + Memi[rg_xstatp(xc,RL1)+nregions] = j + Memi[rg_xstatp(xc,RL2)+nregions] = j + nylines - 1 + Memr[rg_xstatp(xc,RZERO)+nregions] = INDEFR + Memr[rg_xstatp(xc,RXSLOPE)+nregions] = INDEFR + Memr[rg_xstatp(xc,RYSLOPE)+nregions] = INDEFR + Memr[rg_xstatp(xc,XSHIFTS)+nregions] = INDEFR + Memr[rg_xstatp(xc,YSHIFTS)+nregions] = INDEFR + nregions = nregions + 1 + } + } + + call rg_xseti (xc, NREGIONS, nregions) + if (nregions > 0) + call rg_xrealloc (xc, nregions) + else + call rg_xrfree (xc) + call sfree (sp) + + return (nregions) +end + + +# RG_XRREGIONS -- Read and decode the regions from a file. + +int procedure rg_xrregions (fd, im, xc, rp, max_nregions) + +int fd #I regions file descriptor +pointer im #I pointer to the reference image +pointer xc #I pointer to the cross-correlation structure +int rp #I index of the current region +int max_nregions #I the maximum number of regions + +int ncols, nlines, nregions, x1, y1, x2, y2, step +pointer sp, line, section +int rg_xstati(), getline(), rg_xgsections() +pointer rg_xstatp() + +begin + # Allocate working space. + call smark (sp) + call salloc (line, SZ_LINE, TY_CHAR) + call salloc (section, SZ_LINE, TY_CHAR) + + # Allocate the arrays to hold the regions information, + call rg_xrealloc (xc, max_nregions) + + # Initialize. + ncols = IM_LEN(im,1) + nlines = IM_LEN(im,2) + nregions = min (rp - 1, rg_xstati (xc, NREGIONS)) + + # Decode the regions string. + while ((getline (fd, Memc[line]) != EOF) && nregions < max_nregions) { + call sscan (Memc[line]) + call gargwrd (Memc[section], SZ_LINE) + while ((Memc[section] != EOS) && (nregions < max_nregions)) { + if (rg_xgsections (Memc[section], x1, x2, step, y1, y2, step, + ncols, nlines) == OK) { + Memi[rg_xstatp(xc,RC1)+nregions] = x1 + Memi[rg_xstatp(xc,RC2)+nregions] = x2 + Memi[rg_xstatp(xc,RL1)+nregions] = y1 + Memi[rg_xstatp(xc,RL2)+nregions] = y2 + Memr[rg_xstatp(xc,RZERO)+nregions] = INDEFR + Memr[rg_xstatp(xc,RXSLOPE)+nregions] = INDEFR + Memr[rg_xstatp(xc,RYSLOPE)+nregions] = INDEFR + Memr[rg_xstatp(xc,XSHIFTS)+nregions] = INDEFR + Memr[rg_xstatp(xc,YSHIFTS)+nregions] = INDEFR + nregions = nregions + 1 + } + call gargwrd (Memc[section], SZ_LINE) + } + } + + # Reallocate the correct amount of space. + call rg_xseti (xc, NREGIONS, nregions) + if (nregions > 0) + call rg_xrealloc (xc, nregions) + else + call rg_xrfree (xc) + + call sfree (sp) + + return (nregions) +end + + +# RG_XGREGIONS -- Decode a list of regions from a string containing +# a list of sections. + +int procedure rg_xgregions (im, xc, rp, max_nregions) + +pointer im #I pointer to the reference image +pointer xc #I pointer to cross-correlation structure +int rp #I the index of the current region +int max_nregions #I the maximum number of regions + +int ncols, nlines, nregions, x1, x2, y1, y2, step +pointer sp, section, region +int rg_xstati(), rg_xgsections() +pointer rg_xstatp() + +begin + # Allocate working space. + call smark (sp) + call salloc (region, SZ_LINE, TY_CHAR) + call salloc (section, SZ_LINE, TY_CHAR) + + # Allocate the arrays to hold the regions information. + call rg_xrealloc (xc, max_nregions) + + # Initialize. + call rg_xstats (xc, REGIONS, Memc[region], SZ_LINE) + ncols = IM_LEN(im,1) + nlines = IM_LEN(im,2) + nregions = min (rp - 1, rg_xstati (xc, NREGIONS)) + + # Decode the sections + call sscan (Memc[region]) + call gargwrd (Memc[section], SZ_LINE) + while ((Memc[section] != EOS) && (nregions < max_nregions)) { + if (rg_xgsections (Memc[section], x1, x2, step, y1, y2, step, + ncols, nlines) == OK) { + Memi[rg_xstatp(xc,RC1)+nregions] = x1 + Memi[rg_xstatp(xc,RC2)+nregions] = x2 + Memi[rg_xstatp(xc,RL1)+nregions] = y1 + Memi[rg_xstatp(xc,RL2)+nregions] = y2 + Memr[rg_xstatp(xc,RZERO)+nregions] = INDEFR + Memr[rg_xstatp(xc,RXSLOPE)+nregions] = INDEFR + Memr[rg_xstatp(xc,RYSLOPE)+nregions] = INDEFR + Memr[rg_xstatp(xc,XSHIFTS)+nregions] = INDEFR + Memr[rg_xstatp(xc,YSHIFTS)+nregions] = INDEFR + nregions = nregions + 1 + } + call gargwrd (Memc[section], SZ_LINE) + } + + + # Reallocate the correct amount of space. + call rg_xseti (xc, NREGIONS, nregions) + if (nregions > 0) + call rg_xrealloc (xc, nregions) + else + call rg_xrfree (xc) + + call sfree (sp) + + return (nregions) +end + + +# RG_XGSECTIONS -- Decode an image section into column and line limits +# and a step size. Sections which describe the whole image are decoded into +# a block ncols * nlines long. + +int procedure rg_xgsections (section, x1, x2, xstep, y1, y2, ystep, ncols, + nlines) + +char section[ARB] #I the input section string +int x1, x2 #O the output column section limits +int xstep #O the output column step size +int y1, y2 #O the output line section limits +int ystep #O the output line step size +int ncols, nlines #I the maximum number of lines and columns + +int ip +int rg_xgdim() + +begin + ip = 1 + if (rg_xgdim (section, ip, x1, x2, xstep, ncols) == ERR) + return (ERR) + if (rg_xgdim (section, ip, y1, y2, ystep, nlines) == ERR) + return (ERR) + + return (OK) +end + + +# RG_XGDIM -- Decode a single subscript expression to produce the +# range of values for that subscript (X1:X2), and the sampling step size, STEP. +# Note that X1 may be less than, greater than, or equal to X2, and STEP may +# be a positive or negative nonzero integer. Various shorthand notations are +# permitted, as is embedded whitespace. + +int procedure rg_xgdim (section, ip, x1, x2, step, limit) + +char section[ARB] #I the input image section +int ip #I/O pointer to the position in section string +int x1 #O first limit of dimension +int x2 #O second limit of dimension +int step #O step size of dimension +int limit #I maximum size of dimension + +int temp +int ctoi() + +begin + x1 = 1 + x2 = limit + step = 1 + + while (IS_WHITE(section[ip])) + ip = ip + 1 + + if (section[ip] =='[') + ip = ip + 1 + + while (IS_WHITE(section[ip])) + ip = ip + 1 + + # Get X1, X2. + if (ctoi (section, ip, temp) > 0) { # [x1 + x1 = max (1, min (temp, limit)) + if (section[ip] == ':') { + ip = ip + 1 + if (ctoi (section, ip, temp) == 0) # [x1:x2 + return (ERR) + x2 = max (1, min (temp, limit)) + } else + x2 = x1 + + } else if (section[ip] == '-') { + x1 = limit + x2 = 1 + ip = ip + 1 + if (section[ip] == '*') + ip = ip + 1 + + } else if (section[ip] == '*') # [* + ip = ip + 1 + + while (IS_WHITE(section[ip])) + ip = ip + 1 + + # Get sample step size, if give. + if (section[ip] == ':') { # ..:step + ip = ip + 1 + if (ctoi (section, ip, step) == 0) + return (ERR) + else if (step == 0) + return (ERR) + } + + # Allow notation such as "-*:5", (or even "-:5") where the step + # is obviously supposed to be negative. + + if (x1 > x2 && step > 0) + step = -step + + while (IS_WHITE(section[ip])) + ip = ip + 1 + + if (section[ip] == ',') { + ip = ip + 1 + return (OK) + } else if (section[ip] == ']') + return (OK) + else + return (ERR) +end diff --git a/pkg/images/immatch/src/xregister/rgxshow.x b/pkg/images/immatch/src/xregister/rgxshow.x new file mode 100644 index 00000000..3a746d9c --- /dev/null +++ b/pkg/images/immatch/src/xregister/rgxshow.x @@ -0,0 +1,172 @@ +include "xregister.h" + +# RG_XSHOW -- Show the XREGISTER parameters. + +procedure rg_xshow (xc) + +pointer xc #I pointer to the main xregister structure + +begin + call rg_xnshow (xc) + call printf ("\n") + call rg_xbshow (xc) + call printf ("\n") + call rg_xxshow (xc) + call printf ("\n") + call rg_xpshow (xc) +end + + +# RG_XNSHOW -- Show the input/output data XREGISTER parameters. + +procedure rg_xnshow (xc) + +pointer xc #I pointer to the main xregister structure + +pointer sp, str +int rg_xstati() + +begin + call smark (sp) + call salloc (str, SZ_LINE, TY_CHAR) + + # Set the object characteristics. + call printf ("\nInput/output data\n") + call rg_xstats (xc, IMAGE, Memc[str], SZ_FNAME) + call printf (" %s: %s\n") + call pargstr (KY_IMAGE) + call pargstr (Memc[str]) + call rg_xstats (xc, REFIMAGE, Memc[str], SZ_FNAME) + call printf (" %s: %s\n") + call pargstr (KY_REFIMAGE) + call pargstr (Memc[str]) + call rg_xstats (xc, REGIONS, Memc[str], SZ_FNAME) + call printf (" %s: %s\n") + call pargstr (KY_REGIONS) + call pargstr (Memc[str]) + call printf (" %s = %d %s = %d\n") + call pargstr (KY_XLAG) + call pargi (rg_xstati (xc, XLAG)) + call pargstr (KY_YLAG) + call pargi (rg_xstati (xc, YLAG)) + call printf (" %s = %d %s = %d\n") + call pargstr (KY_DXLAG) + call pargi (rg_xstati (xc, DXLAG)) + call pargstr (KY_DYLAG) + call pargi (rg_xstati (xc, DYLAG)) + call rg_xstats (xc, DATABASE, Memc[str], SZ_FNAME) + call printf (" %s: %s\n") + call pargstr (KY_DATABASE) + call pargstr (Memc[str]) + call rg_xstats (xc, RECORD, Memc[str], SZ_FNAME) + call printf (" %s: %s\n") + call pargstr (KY_RECORD) + call pargstr (Memc[str]) + call rg_xstats (xc, REFFILE, Memc[str], SZ_FNAME) + call printf (" %s: %s\n") + call pargstr (KY_REFFILE) + call pargstr (Memc[str]) + call rg_xstats (xc, OUTIMAGE, Memc[str], SZ_FNAME) + call printf (" %s: %s\n") + call pargstr (KY_OUTIMAGE) + call pargstr (Memc[str]) + + call sfree (sp) +end + + +# RG_XBSHOW -- Show the background fitting parameters. + +procedure rg_xbshow (xc) + +pointer xc #I pointer to the main xregister structure + +int back +pointer sp, str +int rg_xstati() +real rg_xstatr() + +begin + call smark (sp) + call salloc (str, SZ_LINE, TY_CHAR) + + back = rg_xstati (xc, BACKGRD) + call printf ("Background fitting parameters:\n") + call rg_xstats (xc, BSTRING, Memc[str], SZ_LINE) + call printf (" %s: %s\n") + call pargstr (KY_BACKGROUND) + call pargstr (Memc[str]) + call printf (" %s = %d\n") + call pargstr (KY_BORDER) + call pargi (rg_xstati (xc, BORDER)) + call printf (" %s = %g %s = %g\n") + call pargstr (KY_LOREJECT) + call pargr (rg_xstatr (xc, LOREJECT)) + call pargstr (KY_HIREJECT) + call pargr (rg_xstatr (xc, HIREJECT)) + call printf (" %s = %g\n") + call pargstr (KY_APODIZE) + call pargr (rg_xstatr (xc, APODIZE)) + call rg_xstats (xc, FSTRING, Memc[str], SZ_LINE) + call printf (" %s: %s\n") + call pargstr (KY_FILTER) + call pargstr (Memc[str]) + + call sfree (sp) +end + + +# RG_XXSHOW -- Show the cross-correlation function parameters. + +procedure rg_xxshow (xc) + +pointer xc #I pointer to the main xregister structure + +pointer sp, str +int rg_xstati() + +begin + call smark (sp) + call salloc (str, SZ_LINE, TY_CHAR) + + call printf ("Cross correlation function:\n") + call rg_xstats (xc, CSTRING, Memc[str], SZ_LINE) + call printf (" %s: %s\n") + call pargstr (KY_CORRELATION) + call pargstr (Memc[str]) + call printf (" %s = %d %s = %d\n") + call pargstr (KY_XWINDOW) + call pargi (rg_xstati (xc, XWINDOW)) + call pargstr (KY_YWINDOW) + call pargi (rg_xstati (xc, YWINDOW)) + + call sfree (sp) +end + + +# RG_XPSHOW -- Show the peak centering parameters. + +procedure rg_xpshow (xc) + +pointer xc #I pointer to the main xregister structure + +pointer sp, str +int rg_xstati() + +begin + call smark (sp) + call salloc (str, SZ_LINE, TY_CHAR) + + call printf ("Peak centering parameters:\n") + call rg_xstats (xc, PSTRING, Memc[str], SZ_LINE) + call printf (" %s: %s\n") + call pargstr (KY_PEAKCENTER) + call pargstr (Memc[str]) + call printf (" %s = %d %s = %d\n") + call pargstr (KY_XCBOX) + call pargi (rg_xstati (xc, XCBOX)) + call pargstr (KY_YCBOX) + call pargi (rg_xstati (xc, YCBOX)) + + call sfree (sp) +end diff --git a/pkg/images/immatch/src/xregister/rgxtools.x b/pkg/images/immatch/src/xregister/rgxtools.x new file mode 100644 index 00000000..e1fb921e --- /dev/null +++ b/pkg/images/immatch/src/xregister/rgxtools.x @@ -0,0 +1,685 @@ +include "xregister.h" + +# RG_XINIT -- Initialize the cross-correlation code fitting structure. + +procedure rg_xinit (xc, cfunc) + +pointer xc #O pointer to the cross-correlation structure +int cfunc #I the input cross-correlation function + +begin + call malloc (xc, LEN_XCSTRUCT, TY_STRUCT) + + # Initialize the regions pointers. + XC_RC1(xc) = NULL + XC_RC2(xc) = NULL + XC_RL1(xc) = NULL + XC_RL2(xc) = NULL + XC_RZERO(xc) = NULL + XC_RXSLOPE(xc) = NULL + XC_RYSLOPE(xc) = NULL + XC_XSHIFTS(xc) = NULL + XC_YSHIFTS(xc) = NULL + XC_TXSHIFT(xc) = 0.0 + XC_TYSHIFT(xc) = 0.0 + XC_NREGIONS(xc) = 0 + XC_CREGION(xc) = 1 + + # Set up transformation parameters. + XC_NREFPTS(xc) = 0 + call malloc (XC_XREF(xc), MAX_NREF, TY_REAL) + call malloc (XC_YREF(xc), MAX_NREF, TY_REAL) + call malloc (XC_TRANSFORM(xc), MAX_NTRANSFORM, TY_REAL) + + # Initialize the region offsets + XC_IXLAG(xc) = DEF_IXLAG + XC_IYLAG(xc) = DEF_IYLAG + XC_XLAG(xc) = DEF_IXLAG + XC_YLAG(xc) = DEF_IYLAG + XC_DXLAG(xc) = DEF_DXLAG + XC_DYLAG(xc) = DEF_DYLAG + + # Define the background fitting parameters. + XC_BACKGRD(xc) = XC_BNONE + call strcpy ("none", XC_BSTRING(xc), SZ_FNAME) + XC_BVALUER(xc) = 0.0 + XC_BVALUE(xc) = 0.0 + XC_BORDER(xc) = DEF_BORDER + XC_LOREJECT(xc) = DEF_LOREJECT + XC_HIREJECT(xc) = DEF_HIREJECT + XC_APODIZE(xc) = 0.0 + XC_FILTER(xc) = XC_FNONE + call strcpy ("none", XC_FSTRING(xc), SZ_FNAME) + + # Get the correlation parameters. + XC_CFUNC(xc) = cfunc + switch (cfunc) { + case XC_DISCRETE: + call strcpy ("discrete", XC_CSTRING(xc), SZ_FNAME) + case XC_FOURIER: + call strcpy ("fourier", XC_CSTRING(xc), SZ_FNAME) + case XC_FILE: + call strcpy ("file", XC_CSTRING(xc), SZ_FNAME) + case XC_DIFFERENCE: + call strcpy ("difference", XC_CSTRING(xc), SZ_FNAME) + default: + call strcpy ("unknown", XC_CSTRING(xc), SZ_FNAME) + } + XC_XWINDOW(xc) = DEF_XWINDOW + XC_YWINDOW(xc) = DEF_YWINDOW + XC_XCOR(xc) = NULL + + # Define the peak fitting function. + XC_PFUNC(xc) = DEF_PFUNC + call sprintf (XC_PSTRING(xc), SZ_FNAME, "%s") + call pargstr ("centroid") + XC_XCBOX(xc) = DEF_XCBOX + XC_YCBOX(xc) = DEF_YCBOX + + # Initialize the strings. + XC_IMAGE(xc) = EOS + XC_REFIMAGE(xc) = EOS + XC_REGIONS(xc) = EOS + XC_DATABASE(xc) = EOS + XC_OUTIMAGE(xc) = EOS + XC_REFFILE(xc) = EOS + XC_RECORD(xc) = EOS + + # Initialize the buffers. + call rg_xrinit (xc) + +end + + +# RG_XRINIT -- Initialize the regions definition portion of the +# cross correlation code fitting structure. + +procedure rg_xrinit (xc) + +pointer xc #I pointer to crosscor structure + +begin + call rg_xrfree (xc) + + XC_NREGIONS(xc) = 0 + XC_CREGION(xc) = 1 + + call malloc (XC_RC1(xc), MAX_NREGIONS, TY_INT) + call malloc (XC_RC2(xc), MAX_NREGIONS, TY_INT) + call malloc (XC_RL1(xc), MAX_NREGIONS, TY_INT) + call malloc (XC_RL2(xc), MAX_NREGIONS, TY_INT) + call malloc (XC_RZERO(xc), MAX_NREGIONS, TY_REAL) + call malloc (XC_RXSLOPE(xc), MAX_NREGIONS, TY_REAL) + call malloc (XC_RYSLOPE(xc), MAX_NREGIONS, TY_REAL) + call malloc (XC_XSHIFTS(xc), MAX_NREGIONS, TY_REAL) + call malloc (XC_YSHIFTS(xc), MAX_NREGIONS, TY_REAL) + + call amovki (INDEFI, Memi[XC_RC1(xc)], MAX_NREGIONS) + call amovki (INDEFI, Memi[XC_RC2(xc)], MAX_NREGIONS) + call amovki (INDEFI, Memi[XC_RL1(xc)], MAX_NREGIONS) + call amovki (INDEFI, Memi[XC_RL2(xc)], MAX_NREGIONS) + call amovkr (INDEFR, Memr[XC_RZERO(xc)], MAX_NREGIONS) + call amovkr (INDEFR, Memr[XC_RXSLOPE(xc)], MAX_NREGIONS) + call amovkr (INDEFR, Memr[XC_RYSLOPE(xc)], MAX_NREGIONS) + call amovkr (INDEFR, Memr[XC_XSHIFTS(xc)], MAX_NREGIONS) + call amovkr (INDEFR, Memr[XC_YSHIFTS(xc)], MAX_NREGIONS) + + XC_TXSHIFT(xc) = 0.0 + XC_TYSHIFT(xc) = 0.0 +end + + +# RG_XCINDEFR -- Re-initialize the background and answers regions portion of +# the cross-correlation fitting structure + +procedure rg_xcindefr (xc, creg) + +pointer xc #I pointer to the cross-correlation structure +int creg #I the current region + +int nregions +int rg_xstati() + +begin + nregions = rg_xstati (xc, NREGIONS) + if (creg < 1 || creg > nregions) + return + + if (nregions > 0) { + Memr[XC_RZERO(xc)+creg-1] = INDEFR + Memr[XC_RXSLOPE(xc)+creg-1] = INDEFR + Memr[XC_RYSLOPE(xc)+creg-1] = INDEFR + Memr[XC_XSHIFTS(xc)+creg-1] = INDEFR + Memr[XC_YSHIFTS(xc)+creg-1] = INDEFR + } + + XC_TXSHIFT(xc) = 0.0 + XC_TYSHIFT(xc) = 0.0 +end + + +# RG_XINDEFR -- Re-initialize the background and answers regions portion of +# the cross-correlation fitting structure for all regions and reset the +# current region to 1. + +procedure rg_xindefr (xc) + +pointer xc #I pointer to the cross-correlation structure + +int nregions +int rg_xstati() + +begin + nregions = rg_xstati (xc, NREGIONS) + + if (nregions > 0) { + call amovkr (INDEFR, Memr[XC_RZERO(xc)], nregions) + call amovkr (INDEFR, Memr[XC_RXSLOPE(xc)], nregions) + call amovkr (INDEFR, Memr[XC_RYSLOPE(xc)], nregions) + call amovkr (INDEFR, Memr[XC_XSHIFTS(xc)], nregions) + call amovkr (INDEFR, Memr[XC_YSHIFTS(xc)], nregions) + } + + XC_CREGION(xc) = 1 + XC_TXSHIFT(xc) = 0.0 + XC_TYSHIFT(xc) = 0.0 +end + + +# RG_XREALLOC -- Reallocate the regions bufffers and initialize if necessary. + +procedure rg_xrealloc (xc, nregions) + +pointer xc #I pointer to crosscor structure +int nregions #I number of regions + +int nr +int rg_xstati() + +begin + nr = rg_xstati (xc, NREGIONS) + + call realloc (XC_RC1(xc), nregions, TY_INT) + call realloc (XC_RC2(xc), nregions, TY_INT) + call realloc (XC_RL1(xc), nregions, TY_INT) + call realloc (XC_RL2(xc), nregions, TY_INT) + call realloc (XC_RZERO(xc), nregions, TY_REAL) + call realloc (XC_RXSLOPE(xc), nregions, TY_REAL) + call realloc (XC_RYSLOPE(xc), nregions, TY_REAL) + call realloc (XC_XSHIFTS(xc), nregions, TY_REAL) + call realloc (XC_YSHIFTS(xc), nregions, TY_REAL) + + call amovki (INDEFI, Memi[XC_RC1(xc)+nr], nregions - nr) + call amovki (INDEFI, Memi[XC_RC2(xc)+nr], nregions - nr) + call amovki (INDEFI, Memi[XC_RL1(xc)+nr], nregions - nr) + call amovki (INDEFI, Memi[XC_RL2(xc)+nr], nregions - nr) + call amovkr (INDEFR, Memr[XC_RZERO(xc)+nr], nregions - nr) + call amovkr (INDEFR, Memr[XC_RXSLOPE(xc)+nr], nregions - nr) + call amovkr (INDEFR, Memr[XC_RYSLOPE(xc)+nr], nregions - nr) + call amovkr (INDEFR, Memr[XC_XSHIFTS(xc)+nr], nregions - nr) + call amovkr (INDEFR, Memr[XC_YSHIFTS(xc)+nr], nregions - nr) +end + + +# RG_XFREE -- Free the cross-correlation fitting structure. + +procedure rg_xfree (xc) + +pointer xc #I pointer to the cross-correlation structure + +begin + # Free the region descriptors. + call rg_xrfree (xc) + + # Free the transformation descriptors. + if (XC_XREF(xc) != NULL) + call mfree (XC_XREF(xc), TY_REAL) + if (XC_YREF(xc) != NULL) + call mfree (XC_YREF(xc), TY_REAL) + if (XC_TRANSFORM(xc) != NULL) + call mfree (XC_TRANSFORM(xc), TY_REAL) + + # Free the correlation function. + if (XC_XCOR(xc) != NULL) + call mfree (XC_XCOR(xc), TY_REAL) + + call mfree (xc, TY_STRUCT) +end + + +# RG_XRFREE -- Free the regions portion of the cross-correlation structure. + +procedure rg_xrfree (xc) + +pointer xc #I pointer to the cross-correlation structure + +begin + call rg_xseti (xc, NREGIONS, 0) + if (XC_RC1(xc) != NULL) + call mfree (XC_RC1(xc), TY_INT) + XC_RC1(xc) = NULL + if (XC_RC2(xc) != NULL) + call mfree (XC_RC2(xc), TY_INT) + XC_RC2(xc) = NULL + if (XC_RL1(xc) != NULL) + call mfree (XC_RL1(xc), TY_INT) + XC_RL1(xc) = NULL + if (XC_RL2(xc) != NULL) + call mfree (XC_RL2(xc), TY_INT) + XC_RL2(xc) = NULL + if (XC_RZERO(xc) != NULL) + call mfree (XC_RZERO(xc), TY_REAL) + XC_RZERO(xc) = NULL + if (XC_RXSLOPE(xc) != NULL) + call mfree (XC_RXSLOPE(xc), TY_REAL) + XC_RXSLOPE(xc) = NULL + if (XC_RYSLOPE(xc) != NULL) + call mfree (XC_RYSLOPE(xc), TY_REAL) + XC_RYSLOPE(xc) = NULL + if (XC_XSHIFTS(xc) != NULL) + call mfree (XC_XSHIFTS(xc), TY_REAL) + XC_XSHIFTS(xc) = NULL + if (XC_YSHIFTS(xc) != NULL) + call mfree (XC_YSHIFTS(xc), TY_REAL) + XC_YSHIFTS(xc) = NULL +end + + +# RG_XSTATI -- Fetch the value of a cross-correlation fitting structure +# integer parameter. + +int procedure rg_xstati (xc, param) + +pointer xc #I pointer to the cross-correlation fitting structure +int param #I parameter to be fetched + +begin + switch (param) { + case CFUNC: + return (XC_CFUNC(xc)) + case IXLAG: + return (XC_IXLAG(xc)) + case IYLAG: + return (XC_IYLAG(xc)) + case XLAG: + return (XC_XLAG(xc)) + case YLAG: + return (XC_YLAG(xc)) + case DXLAG: + return (XC_DXLAG(xc)) + case DYLAG: + return (XC_DYLAG(xc)) + case XWINDOW: + return (XC_XWINDOW(xc)) + case YWINDOW: + return (XC_YWINDOW(xc)) + case CREGION: + return (XC_CREGION(xc)) + case NREGIONS: + return (XC_NREGIONS(xc)) + case BACKGRD: + return (XC_BACKGRD(xc)) + case BORDER: + return (XC_BORDER(xc)) + case FILTER: + return (XC_FILTER(xc)) + case XCBOX: + return (XC_XCBOX(xc)) + case YCBOX: + return (XC_YCBOX(xc)) + case PFUNC: + return (XC_PFUNC(xc)) + case NREFPTS: + return (XC_NREFPTS(xc)) + default: + call error (0, "RG_XSTATI: Undefined integer parameter.") + } +end + + +# RG_XSTATP -- Fetch the value of a pointer parameter. + +pointer procedure rg_xstatp (xc, param) + +pointer xc #I pointer to the cross-correlation structure +int param #I parameter to be fetched + +begin + switch (param) { + case RC1: + return (XC_RC1(xc)) + case RC2: + return (XC_RC2(xc)) + case RL1: + return (XC_RL1(xc)) + case RL2: + return (XC_RL2(xc)) + case RZERO: + return (XC_RZERO(xc)) + case RXSLOPE: + return (XC_RXSLOPE(xc)) + case RYSLOPE: + return (XC_RYSLOPE(xc)) + case XSHIFTS: + return (XC_XSHIFTS(xc)) + case YSHIFTS: + return (XC_YSHIFTS(xc)) + case XCOR: + return (XC_XCOR(xc)) + case XREF: + return (XC_XREF(xc)) + case YREF: + return (XC_YREF(xc)) +# case CORAPODIZE: +# return (XC_CORAPODIZE(xc)) + case TRANSFORM: + return (XC_TRANSFORM(xc)) + default: + call error (0, "RG_XSTATP: Undefined pointer parameter.") + } +end + + +# RG_XSTATR -- Fetch the value of a real parameter. + +real procedure rg_xstatr (xc, param) + +pointer xc #I pointer to the cross-correlation structure +int param #I parameter to be fetched + +begin + switch (param) { + case BVALUER: + return (XC_BVALUER(xc)) + case BVALUE: + return (XC_BVALUE(xc)) + case LOREJECT: + return (XC_LOREJECT(xc)) + case HIREJECT: + return (XC_HIREJECT(xc)) + case APODIZE: + return (XC_APODIZE(xc)) + case TXSHIFT: + return (XC_TXSHIFT(xc)) + case TYSHIFT: + return (XC_TYSHIFT(xc)) + default: + call error (0, "RG_XSTATR: Undefined real parameter.") + } +end + + +# RG_XSTATS -- Fetch the value of a string parameter. + +procedure rg_xstats (xc, param, str, maxch) + +pointer xc #I pointer to the cross-correlation structure +int param #I parameter to be fetched +char str[ARB] #O output value of string parameter +int maxch #I maximum number of characters in output string + +begin + switch (param) { + case BSTRING: + call strcpy (XC_BSTRING(xc), str, maxch) + case FSTRING: + call strcpy (XC_FSTRING(xc), str, maxch) + case CSTRING: + call strcpy (XC_CSTRING(xc), str, maxch) + case PSTRING: + call strcpy (XC_PSTRING(xc), str, maxch) + case REFIMAGE: + call strcpy (XC_REFIMAGE(xc), str, maxch) + case IMAGE: + call strcpy (XC_IMAGE(xc), str, maxch) + case OUTIMAGE: + call strcpy (XC_OUTIMAGE(xc), str, maxch) + case REGIONS: + call strcpy (XC_REGIONS(xc), str, maxch) + case DATABASE: + call strcpy (XC_DATABASE(xc), str, maxch) + case RECORD: + call strcpy (XC_RECORD(xc), str, maxch) + case REFFILE: + call strcpy (XC_REFFILE(xc), str, maxch) + default: + call error (0, "RG_XSTATS: Undefined string parameter.") + } +end + + +# RG_XSETI -- Set the value of an integer parameter. + +procedure rg_xseti (xc, param, value) + +pointer xc #I pointer to the cross-correlation structure +int param #I parameter to be set +int value #O value of the integer parameter + +begin + switch (param) { + case CFUNC: + XC_CFUNC(xc) = value + switch (value) { + case XC_DISCRETE: + call strcpy ("discrete", XC_CSTRING(xc), SZ_FNAME) + case XC_FOURIER: + call strcpy ("fourier", XC_CSTRING(xc), SZ_FNAME) + case XC_FILE: + call strcpy ("file", XC_CSTRING(xc), SZ_FNAME) + case XC_DIFFERENCE: + call strcpy ("difference", XC_CSTRING(xc), SZ_FNAME) + default: + call strcpy ("unknown", XC_CSTRING(xc), SZ_FNAME) + } + case IXLAG: + XC_IXLAG(xc) = value + case IYLAG: + XC_IYLAG(xc) = value + case XLAG: + XC_XLAG(xc) = value + case YLAG: + XC_YLAG(xc) = value + case DXLAG: + XC_DXLAG(xc) = value + case DYLAG: + XC_DYLAG(xc) = value + case XWINDOW: + XC_XWINDOW(xc) = value + case YWINDOW: + XC_YWINDOW(xc) = value + case BACKGRD: + XC_BACKGRD(xc) = value + switch (value) { + case XC_BNONE: + call strcpy ("none", XC_BSTRING(xc), SZ_FNAME) + case XC_MEAN: + call strcpy ("mean", XC_BSTRING(xc), SZ_FNAME) + case XC_MEDIAN: + call strcpy ("median", XC_BSTRING(xc), SZ_FNAME) + case XC_SLOPE: + call strcpy ("plane", XC_BSTRING(xc), SZ_FNAME) + default: + call strcpy ("none", XC_BSTRING(xc), SZ_FNAME) + } + case BORDER: + XC_BORDER(xc) = value + case FILTER: + XC_FILTER(xc) = value + switch (value) { + case XC_FNONE: + call strcpy ("none", XC_FSTRING(xc), SZ_FNAME) + case XC_LAPLACE: + call strcpy ("laplace", XC_FSTRING(xc), SZ_FNAME) + default: + call strcpy ("none", XC_FSTRING(xc), SZ_FNAME) + } + case XCBOX: + XC_XCBOX(xc) = value + case YCBOX: + XC_YCBOX(xc) = value + case PFUNC: + XC_PFUNC(xc) = value + switch (value) { + case XC_PNONE: + call strcpy ("none", XC_PSTRING(xc), SZ_FNAME) + case XC_CENTROID: + call strcpy ("centroid", XC_PSTRING(xc), SZ_FNAME) + case XC_PARABOLA: + call strcpy ("parabolic", XC_PSTRING(xc), SZ_FNAME) + case XC_SAWTOOTH: + call strcpy ("sawtooth", XC_PSTRING(xc), SZ_FNAME) +# case XC_MARK: +# call strcpy ("mark", XC_PSTRING(xc), SZ_FNAME) + default: + ; + } + case NREFPTS: + XC_NREFPTS(xc) = value + case CREGION: + XC_CREGION(xc) = value + case NREGIONS: + XC_NREGIONS(xc) = value + default: + call error (0, "RG_XSETI: Undefined integer parameter.") + } +end + + +# RG_XSETP -- Set the value of a pointer parameter. + +procedure rg_xsetp (xc, param, value) + +pointer xc #I pointer to the cross-correlation structure +int param #I parameter to be set +pointer value #O value of the pointer parameter + +begin + switch (param) { + case RC1: + XC_RC1(xc) = value + case RC2: + XC_RC2(xc) = value + case RL1: + XC_RL1(xc) = value + case RL2: + XC_RL2(xc) = value + case RZERO: + XC_RZERO(xc) = value + case RXSLOPE: + XC_RXSLOPE(xc) = value + case RYSLOPE: + XC_RYSLOPE(xc) = value + case XSHIFTS: + XC_XSHIFTS(xc) = value + case YSHIFTS: + XC_YSHIFTS(xc) = value + case XCOR: + XC_XCOR(xc) = value + case XREF: + XC_XREF(xc) = value + case YREF: + XC_YREF(xc) = value + case TRANSFORM: + XC_TRANSFORM(xc) = value +# case CORAPODIZE: +# XC_CORAPODIZE(xc) = value + default: + call error (0, "RG_XSETP: Undefined pointer parameter.") + } +end + + +# RG_XSETR -- Set the value of a real parameter. + +procedure rg_xsetr (xc, param, value) + +pointer xc #I pointer to the cross-correlation structure +int param #I parameter to be set +real value #O value of real parameter + +begin + switch (param) { + case BVALUER: + XC_BVALUER(xc) = value + case BVALUE: + XC_BVALUE(xc) = value + case LOREJECT: + XC_LOREJECT(xc) = value + case HIREJECT: + XC_HIREJECT(xc) = value + case APODIZE: + XC_APODIZE(xc) = value + case TXSHIFT: + XC_TXSHIFT(xc) = value + case TYSHIFT: + XC_TYSHIFT(xc) = value + default: + call error (0, "RG_XSETR: Undefined real parameter.") + } +end + + +# RG_XSETS -- Set the value of a string parameter. + +procedure rg_xsets (xc, param, str) + +pointer xc #I pointer to the cross-correlation structure +int param #I parameter to be set +char str[ARB] #O value of string parameter + +int index +pointer sp, temp +int strdic(), fnldir() + +begin + call smark (sp) + call salloc (temp, SZ_FNAME, TY_CHAR) + + switch (param) { + case BSTRING: + index = strdic (str, str, SZ_LINE, XC_BTYPES) + if (index > 0) { + call strcpy (str, XC_BSTRING(xc), SZ_FNAME) + call rg_xseti (xc, BACKGRD, index) + } + case FSTRING: + index = strdic (str, str, SZ_LINE, XC_FTYPES) + if (index > 0) { + call strcpy (str, XC_FSTRING(xc), SZ_FNAME) + call rg_xseti (xc, FILTER, index) + } + case CSTRING: + index = strdic (str, str, SZ_LINE, XC_CTYPES) + if (index > 0) { + call strcpy (str, XC_CSTRING(xc), SZ_FNAME) + call rg_xseti (xc, CFUNC, index) + } + case PSTRING: + call strcpy (str, XC_PSTRING(xc), SZ_FNAME) + case REFIMAGE: + call imgcluster (str, Memc[temp], SZ_FNAME) + index = fnldir (Memc[temp], XC_REFIMAGE(xc), SZ_FNAME) + call strcpy (Memc[temp+index], XC_REFIMAGE(xc), SZ_FNAME) + case IMAGE: + call imgcluster (str, Memc[temp], SZ_FNAME) + index = fnldir (Memc[temp], XC_IMAGE(xc), SZ_FNAME) + call strcpy (Memc[temp+index], XC_IMAGE(xc), SZ_FNAME) + case OUTIMAGE: + call strcpy (str, XC_OUTIMAGE(xc), SZ_FNAME) + case REGIONS: + call strcpy (str, XC_REGIONS(xc), SZ_FNAME) + case DATABASE: + index = fnldir (str, XC_DATABASE(xc), SZ_FNAME) + call strcpy (str[index+1], XC_DATABASE(xc), SZ_FNAME) + case RECORD: + call strcpy (str, XC_RECORD(xc), SZ_FNAME) + case REFFILE: + index = fnldir (str, XC_REFFILE(xc), SZ_FNAME) + call strcpy (str[index+1], XC_REFFILE(xc), SZ_FNAME) + default: + call error (0, "RG_XSETS: Undefined string parameter.") + } + + call sfree (sp) +end diff --git a/pkg/images/immatch/src/xregister/rgxtransform.x b/pkg/images/immatch/src/xregister/rgxtransform.x new file mode 100644 index 00000000..63ee5f24 --- /dev/null +++ b/pkg/images/immatch/src/xregister/rgxtransform.x @@ -0,0 +1,446 @@ +include <imhdr.h> +include <math.h> +include "xregister.h" + +# RG_GXTRANSFORM -- Open the reference points file and the read the +# coordinates of the reference points in the reference image. Return +# the reference points file name and descriptor. + +int procedure rg_gxtransform (list, xc, reffile) + +int list #I list of reference points files +pointer xc #I pointer to the cross-correlation structure +char reffile[ARB] #O the output reference points file name + +int tdf +pointer sp, line, pxref, pyref +real x1, y1, x2, y2, x3, y3 +int fntgfnb(), open(), getline(), nscan() +pointer rg_xstatp() + +begin + # Get some working memory. + call smark (sp) + call salloc (line, SZ_LINE, TY_CHAR) + + # Get the points to the reference point lists. + pxref = rg_xstatp (xc, XREF) + pyref = rg_xstatp (xc, YREF) + call aclrr (Memr[rg_xstatp(xc, XREF)], MAX_NREF) + call aclrr (Memr[rg_xstatp(xc, YREF)], MAX_NREF) + + # Open the reference points file and read the coordinates. + while (fntgfnb (list, reffile, SZ_FNAME) != EOF) { + + iferr { + + # Open the reference file. + tdf = open (reffile, READ_ONLY, TEXT_FILE) + call aclrr (Memr[pxref], MAX_NREF) + call aclrr (Memr[pyref], MAX_NREF) + + # Read up to three valid reference points from the list. + while (getline (tdf, Memc[line]) != EOF) { + call sscan (Memc[line]) + call gargr (x1) + call gargr (y1) + call gargr (x2) + call gargr (y2) + call gargr (x3) + call gargr (y3) + if (nscan () >= 2) + break + } + + # Store the reference points. + if (nscan () == 2) { + Memr[pxref] = x1 + Memr[pyref] = y1 + call rg_xseti (xc, NREFPTS, 1) + } else if (nscan () == 4) { + Memr[pxref] = x1 + Memr[pyref] = y1 + Memr[pxref+1] = x2 + Memr[pyref+1] = y2 + call rg_xseti (xc, NREFPTS, 2) + } else if (nscan () == 6) { + Memr[pxref] = x1 + Memr[pyref] = y1 + Memr[pxref+1] = x2 + Memr[pyref+1] = y2 + Memr[pxref+2] = x3 + Memr[pyref+2] = y3 + call rg_xseti (xc, NREFPTS, 2) + } else + call rg_xseti (xc, NREFPTS, 0) + + } then { + call rg_xseti (xc, NREFPTS, 0) + } + } + + call sfree (sp) + + return (tdf) +end + + +# RG_ITRANSFORM -- Compute the transformation from the input image to the +# reference image interactively. + +procedure rg_itransform (xc, imr, im, id) + +pointer xc #I pointer to the cross-correlation stucture +pointer imr #I pointer to the reference image +pointer im #I pointer to the input image +pointer id #I pointer to the display device + +int nref, nstar, wcs, key +pointer sp, cmd, x, y, pxref, pyref, ptrans +real wx, wy +int clgcur() +pointer rg_xstatp() + +begin + # Allocate working space. + call smark (sp) + call salloc (cmd, SZ_LINE, TY_CHAR) + call salloc (x, MAX_NREF, TY_REAL) + call salloc (y, MAX_NREF, TY_REAL) + call aclrr (Memr[x], MAX_NREF) + call aclrr (Memr[y], MAX_NREF) + + # Get the pointers. + pxref = rg_xstatp (xc, XREF) + pyref = rg_xstatp (xc, YREF) + ptrans = rg_xstatp (xc, TRANSFORM) + + # Mark up to three reference stars. + nref = 0 + call printf ("Mark reference star %d with the image cursor [q=quit]: ") + call pargi (nref + 1) + while ((nref < MAX_NREF) && clgcur ("icommands", wx, wy, wcs, key, + Memc[cmd], SZ_LINE) != EOF) { + if (key == 'q') { + call printf ("\n") + break + } + if (wx < 0.5 || wx > IM_LEN(imr,1) + 0.5) { + call printf ("\n") + next + } + if (wy < 0.5 || wy > IM_LEN(imr,2) + 0.5) { + call printf ("\n") + next + } + call printf ("%g %g\n") + call pargr (wx) + call pargr (wy) + Memr[pxref+nref] = wx + Memr[pyref+nref] = wy + nref = nref + 1 + call rg_xseti (xc, NREFPTS, nref) + if (nref >= MAX_NREF) + break + call printf ( + "Mark reference star %d with the image cursor [q=quit]: ") + call pargi (nref + 1) + } + + # Mark the corresponding input image stars. + if (nref > 0) { + + nstar = 0 + call printf ("Mark image star %d with the image cursor [q=quit]: ") + call pargi (nstar + 1) + while ((nstar < nref) && clgcur ("icommands", wx, wy, wcs, key, + Memc[cmd], SZ_LINE) != EOF) { + if (key == 'q') { + call printf ("\n") + break + } + if (wx < 0.5 || wx > IM_LEN(im,1) + 0.5) { + call printf ("\n") + next + } + if (wy < 0.5 || wy > IM_LEN(im,2) + 0.5) { + call printf ("\n") + next + } + call printf ("%g %g\n") + call pargr (wx) + call pargr (wy) + Memr[x+nstar] = wx + Memr[y+nstar] = wy + nstar = nstar + 1 + if (nstar >= MAX_NREF) + break + call printf ( + "Mark image star %d with the image cursor [q=quit]: ") + call pargi (nstar + 1) + } + + # Compute the transformation. + if (nstar > 0) { + switch (nstar) { + case 0: + call rg_xshift (Memr[pxref], Memr[pyref], Memr[pxref], + Memr[pyref], Memr[ptrans]) + case 1: + call rg_xshift (Memr[x], Memr[y], Memr[pxref], Memr[pyref], + Memr[ptrans]) + #case 2: + #call rg_xtwostar (Memr[x], Memr[y], Memr[pxref], + #Memr[pyref], Memr[ptrans]) + #case 3: + #call rg_xthreestar (Memr[x], Memr[y], Memr[pxref], + #Memr[pyref], Memr[ptrans]) + + default: + call rg_xshift (Memr[pxref], Memr[pyref], Memr[pxref], + Memr[pyref], Memr[ptrans]) + } + } + } + + call sfree (sp) +end + + +# RG_XTRANSFORM -- Compute the transformation from the input image to +# the reference image + +procedure rg_xtransform (tfd, xc) + +int tfd #I the reference points file descriptor +pointer xc #I the cross-correlation file descriptor + +int nref +pointer sp, line, x, y, pxref, pyref, ptrans +int getline(), rg_xstati(), nscan() +pointer rg_xstatp() + +begin + # Allocate working space. + call smark (sp) + call salloc (line, SZ_LINE, TY_CHAR) + call salloc (x, MAX_NREF, TY_REAL) + call salloc (y, MAX_NREF, TY_REAL) + call aclrr (Memr[x], MAX_NREF) + call aclrr (Memr[y], MAX_NREF) + + # Get the pointers to the reference image data. + nref = rg_xstati (xc, NREFPTS) + pxref = rg_xstatp (xc, XREF) + pyref = rg_xstatp (xc, YREF) + ptrans = rg_xstatp (xc, TRANSFORM) + + # Read the input image reference points. + while ((nref > 0) && getline (tfd, Memc[line]) != EOF) { + call sscan (Memc[line]) + call gargr (Memr[x]) + call gargr (Memr[y]) + call gargr (Memr[x+1]) + call gargr (Memr[y+1]) + call gargr (Memr[x+2]) + call gargr (Memr[y+2]) + if (nscan() >= 2 * nref) + break + } + + # Compute the transform. + if (nscan () < 2 * nref) { + call rg_xshift (Memr[pxref], Memr[pyref], Memr[pxref], Memr[pyref], + Memr[ptrans]) + } else { + switch (nref) { + case 0: + call rg_xshift (Memr[pxref], Memr[pyref], Memr[pxref], + Memr[pyref], Memr[ptrans]) + case 1: + call rg_xshift (Memr[x], Memr[y], Memr[pxref], Memr[pyref], + Memr[ptrans]) + case 2: + call rg_xtwostar (Memr[x], Memr[y], Memr[pxref], Memr[pyref], + Memr[ptrans]) + case 3: + call rg_xthreestar (Memr[x], Memr[y], Memr[pxref], Memr[pyref], + Memr[ptrans]) + } + } + + call sfree (sp) +end + + +# RG_ETRANSFORM -- Evaulate the current transform at a single point. + +procedure rg_etransform (xc, xin, yin, xout, yout) + +pointer xc #I pointer to the cross-correlation structure +real xin, yin #I the input x and y values +real xout, yout #O the output x and y values + +pointer ptrans +pointer rg_xstatp + +begin + ptrans = rg_xstatp (xc, TRANSFORM) + xout = Memr[ptrans] * xin + Memr[ptrans+1] * yin + Memr[ptrans+2] + yout = Memr[ptrans+3] * xin + Memr[ptrans+4] * yin + Memr[ptrans+5] +end + + +# RG_XSHIFT -- Compute the transformation coefficients required to define a +# simple shift using a single data point. + +procedure rg_xshift (xref, yref, xlist, ylist, coeff) + +real xref[ARB] #I x reference coordinates +real yref[ARB] #I y reference coordinates +real xlist[ARB] #I x input coordinates +real ylist[ARB] #I y input coordinates +real coeff[ARB] #O output coefficient array + +begin + # Compute the x transformation. + coeff[1] = 1.0 + coeff[2] = 0.0 + coeff[3] = xref[1] - xlist[1] + + # Compute the y transformation. + coeff[4] = 0.0 + coeff[5] = 1.0 + coeff[6] = yref[1] - ylist[1] +end + + +# RG_XTWOSTAR -- Compute the transformation coefficients required to +# define a simple shift, magnification which is the same in x and y, +# and rotation using two data points. + +procedure rg_xtwostar (xref, yref, xlist, ylist, coeff) + +real xref[ARB] #I x reference coordinates +real yref[ARB] #I y reference coordinates +real xlist[ARB] #I x input coordinates +real ylist[ARB] #I y input coordinates +real coeff[ARB] #O coefficient array + +real rot, mag, dxlis, dylis, dxref, dyref, cosrot, sinrot +real rg_xposangle() + +begin + # Compute the deltas. + dxlis = xlist[2] - xlist[1] + dylis = ylist[2] - ylist[1] + dxref = xref[2] - xref[1] + dyref = yref[2] - yref[1] + + # Compute the required rotation angle. + rot = rg_xposangle (dxref, dyref) - rg_xposangle (dxlis, dylis) + cosrot = cos (rot) + sinrot = sin (rot) + + # Compute the required magnification factor. + mag = dxlis ** 2 + dylis ** 2 + if (mag <= 0.0) + mag = 0.0 + else + mag = sqrt ((dxref ** 2 + dyref ** 2) / mag) + + # Compute the transformation coefficicents. + coeff[1] = mag * cosrot + coeff[2] = - mag * sinrot + coeff[3] = xref[1] - mag * cosrot * xlist[1] + mag * sinrot * ylist[1] + coeff[4] = mag * sinrot + coeff[5] = mag * cosrot + coeff[6] = yref[1] - mag * sinrot * xlist[1] - mag * cosrot * ylist[1] +end + + +# RG_THREESTAR -- Compute the transformation coefficients required to define +# x and y shifts, x and ymagnifications, a rotation and skew, and a possible +# axis flip using three tie points. + +procedure rg_xthreestar (xref, yref, xlist, ylist, coeff) + +real xref[ARB] #I x reference coordinates +real yref[ARB] #I y reference coordinates +real xlist[ARB] #I x input coordinates +real ylist[ARB] #I y input coordinates +real coeff[ARB] #O coefficient array + +real dx23, dx13, dx12, dy23, dy13, dy12, det +bool fp_equalr() + +begin + # Compute the deltas. + dx23 = xlist[2] - xlist[3] + dx13 = xlist[1] - xlist[3] + dx12 = xlist[1] - xlist[2] + dy23 = ylist[2] - ylist[3] + dy13 = ylist[1] - ylist[3] + dy12 = ylist[1] - ylist[2] + + # Compute the determinant. + det = xlist[1] * dy23 - xlist[2] * dy13 + xlist[3] * dy12 + if (fp_equalr (det, 0.0)) { + call rg_xtwostar (xref, yref, xlist, ylist, coeff) + return + } + + # Compute the x transformation. + coeff[1] = (xref[1] * dy23 - xref[2] * dy13 + xref[3] * dy12) / det + coeff[2] = (-xref[1] * dx23 + xref[2] * dx13 - xref[3] * dx12) / det + coeff[3] = (xref[1] * (xlist[2] * ylist[3] - xlist[3] * ylist[2]) + + xref[2] * (ylist[1] * xlist[3] - xlist[1] * ylist[3]) + + xref[3] * (xlist[1] * ylist[2] - ylist[1] * xlist[2])) / det + + # Compute the y transformation. + coeff[4] = (yref[1] * dy23 - yref[2] * dy13 + yref[3] * dy12) / det + coeff[5] = (-yref[1] * dx23 + yref[2] * dx13 - yref[3] * dx12) / det + coeff[6] = (yref[1] * (xlist[2] * ylist[3] - xlist[3] * ylist[2]) + + yref[2] * (ylist[1] * xlist[3] - xlist[1] * ylist[3]) + + yref[3] * (xlist[1] * ylist[2] - ylist[1] * xlist[2])) / det +end + + +# RG_XPOSANGLE -- Compute the position angle of a 2D vector. The angle is +# measured counter-clockwise from the positive x axis. + +real procedure rg_xposangle (x, y) + +real x #I x vector component +real y #I y vector component + +real theta +bool fp_equalr() + +begin + if (fp_equalr (y, 0.0)) { + if (x > 0.0) + theta = 0.0 + else if (x < 0.0) + theta = PI + else + theta = 0.0 + } else if (fp_equalr (x, 0.0)) { + if (y > 0.0) + theta = PI / 2.0 + else if (y < 0.0) + theta = 3.0 * PI / 2.0 + else + theta = 0.0 + } else if (x > 0.0 && y > 0.0) { # 1st quadrant + theta = atan (y / x) + } else if (x > 0.0 && y < 0.0) { # 4th quadrant + theta = 2.0 * PI + atan (y / x) + } else if (x < 0.0 && y > 0.0) { # 2nd quadrant + theta = PI + atan (y / x) + } else if (x < 0.0 && y < 0.0) { # 3rd quadrant + theta = PI + atan (y / x) + } + + return (theta) +end diff --git a/pkg/images/immatch/src/xregister/t_xregister.x b/pkg/images/immatch/src/xregister/t_xregister.x new file mode 100644 index 00000000..f9fc9b22 --- /dev/null +++ b/pkg/images/immatch/src/xregister/t_xregister.x @@ -0,0 +1,440 @@ +include <imhdr.h> +include <fset.h> +include <gset.h> +include <imset.h> +include "xregister.h" + +# T_XREGISTER -- Register a list of images using cross-correlation techniques. + +procedure t_xregister() + +pointer freglist # reference regions list +pointer database # the shifts database +int dformat # use the database format for the shifts file ? +int interactive # interactive mode ? +int verbose # verbose mode +pointer interpstr # interpolant type +int boundary # boundary extension type +real constant # constant for boundary extension + +int list1, listr, list2, reglist, reflist, reclist, tfd, stat, nregions +int c1, c2, l1, l2, ncols, nlines +pointer sp, image1, image2, imtemp, str, coords +pointer gd, id, imr, im1, im2, sdb, xc, mw +real shifts[2] +bool clgetb() +int imtopen(), imtlen(), imtgetim(), fntopnb(), clgwrd(), btoi() +int rg_xregions(), fntlenb(), rg_gxtransform(), rg_xstati() +int rg_xcorr(), rg_xicorr(), fntgfnb(), access(), open() +pointer gopen(), immap(), dtmap(), mw_openim() +real clgetr(), rg_xstatr() +errchk fntopnb(), gopen() + +begin + # Set STDOUT to flush on a newline character + call fseti (STDOUT, F_FLUSHNL, YES) + + # Allocate temporary working space. + call smark (sp) + + call salloc (freglist, SZ_LINE, TY_CHAR) + call salloc (image1, SZ_FNAME, TY_CHAR) + call salloc (image2, SZ_FNAME, TY_CHAR) + call salloc (imtemp, SZ_FNAME, TY_CHAR) + call salloc (database, SZ_FNAME, TY_CHAR) + call salloc (coords, SZ_FNAME, TY_CHAR) + call salloc (interpstr, SZ_FNAME, TY_CHAR) + call salloc (str, SZ_LINE, TY_CHAR) + + # Get task parameters and open lists. + call clgstr ("input", Memc[str], SZ_LINE) + list1 = imtopen (Memc[str]) + call clgstr ("reference", Memc[str], SZ_LINE) + listr = imtopen (Memc[str]) + call clgstr ("regions", Memc[freglist], SZ_LINE) + call clgstr ("shifts", Memc[database], SZ_FNAME) + call clgstr ("output", Memc[str], SZ_LINE) + list2 = imtopen (Memc[str]) + call clgstr ("records", Memc[str], SZ_LINE) + if (Memc[str] == EOS) + reclist = NULL + else + reclist = fntopnb (Memc[str], NO) + call clgstr ("coords", Memc[coords], SZ_LINE) + + # Open the cross correlation fitting structure. + call rg_xgpars (xc) + + # Test the reference image list length. + if (rg_xstati (xc, CFUNC) != XC_FILE) { + if (imtlen (listr) <= 0) + call error (0, "The reference image list is empty.") + if (imtlen (listr) > 1 && imtlen (listr) != imtlen (list1)) + call error (0, + "The number of reference and input images is not the same.") + if (Memc[coords] == EOS) + reflist = NULL + else { + reflist = fntopnb (Memc[coords], NO) + if (imtlen (listr) != fntlenb (reflist)) + call error (0, + "The number of reference point files and images is not the same.") + } + iferr { + reglist = fntopnb (Memc[freglist], NO) + } then { + reglist = NULL + } + call rg_xsets (xc, REGIONS, Memc[freglist]) + + } else { + call imtclose (listr) + listr = NULL + reflist = NULL + reglist = NULL + call rg_xsets (xc, REGIONS, "") + } + + # Close the output image list if it is empty. + if (imtlen (list2) == 0) { + call imtclose (list2) + list2 = NULL + } + + # Check that the output image list is the same size as the input + # image list. + if (list2 != NULL) { + if (imtlen (list1) != imtlen (list2)) { + call imtclose (list1) + if (list2 != NULL) + call imtclose (list2) + call error (0, + "The number of input and output images is not the same.") + } + } + + # Check that the record list is the same length as the input + # image list length. + if (reclist != NULL) { + if (fntlenb (reclist) != imtlen (list1)) + call error (0, + "Input image and record lists are not the same length.") + } + + + # Open the database file. + dformat = btoi (clgetb ("databasefmt")) + if (rg_xstati (xc, CFUNC) == XC_FILE) { + if (dformat == YES) + sdb = dtmap (Memc[database], READ_ONLY) + else + sdb = open (Memc[database], READ_ONLY, TEXT_FILE) + } else if (clgetb ("append")) { + if (dformat == YES) + sdb = dtmap (Memc[database], APPEND) + else + sdb = open (Memc[database], NEW_FILE, TEXT_FILE) + } else if (access (Memc[database], 0, 0) == YES) { + call error (0, "The shifts database file already exists") + } else { + if (dformat == YES) + sdb = dtmap (Memc[database], NEW_FILE) + else + sdb = open (Memc[database], NEW_FILE, TEXT_FILE) + } + call rg_xsets (xc, DATABASE, Memc[database]) + + # Get the boundary extension parameters for the image shift. + call clgstr ("interp_type", Memc[interpstr], SZ_FNAME) + boundary = clgwrd ("boundary_type", Memc[str], SZ_LINE, + "|constant|nearest|reflect|wrap|") + constant = clgetr ("constant") + + if (rg_xstati (xc, CFUNC) == XC_FILE) + interactive = NO + else + interactive = btoi (clgetb ("interactive")) + if (interactive == YES) { + call clgstr ("graphics", Memc[str], SZ_FNAME) + iferr (gd = gopen (Memc[str], NEW_FILE, STDGRAPH)) + gd = NULL + call clgstr ("display", Memc[str], SZ_FNAME) + iferr (id = gopen (Memc[str], APPEND, STDIMAGE)) + id = NULL + verbose = YES + } else { + if (rg_xstati (xc, PFUNC) == XC_MARK) + call rg_xseti (xc, PFUNC, XC_CENTROID) + gd = NULL + id = NULL + verbose = btoi (clgetb ("verbose")) + } + + # Initialize the reference image filter descriptors + imr = NULL + tfd = NULL + + # Initialize the overlap section. + c1 = INDEFI + c2 = INDEFI + l1 = INDEFI + l2 = INDEFI + ncols = INDEFI + nlines = INDEFI + + # Do each set of input, reference, and output images. + while ((imtgetim (list1, Memc[image1], SZ_FNAME) != EOF)) { + + # Open the reference image, and associated regions and coordinates + # files if the correlation function is not file. + + if (rg_xstati (xc, CFUNC) != XC_FILE) { + if (imtgetim (listr, Memc[str], SZ_FNAME) != EOF) { + if (imr != NULL) + call imunmap (imr) + imr = immap (Memc[str], READ_ONLY, 0) + if (IM_NDIM(imr) > 2) + call error (0, "Reference images must be 1D or 2D") + call rg_xsets (xc, REFIMAGE, Memc[str]) + nregions = rg_xregions (reglist, imr, xc, 1) + if (nregions <= 0 && interactive == NO) + call error (0, "The regions list is empty.") + if (reflist != NULL) { + if (tfd != NULL) + call close (tfd) + tfd = rg_gxtransform (reflist, xc, Memc[str]) + call rg_xsets (xc, REFFILE, Memc[str]) + } + } + } else + call rg_xsets (xc, REFIMAGE, "reference") + + # Open the input image. + im1 = immap (Memc[image1], READ_ONLY, 0) + if (IM_NDIM(im1) > 2) { + call error (0, "Input images must be 1D or 2D") + } else if (imr != NULL) { + if (IM_NDIM(im1) != IM_NDIM(imr)) + call error (0, + "Input images must have same dimensionality as reference images") + } + call imseti (im1, IM_TYBNDRY, BT_NEAREST) + if (IM_NDIM(im1) == 1) + call imseti (im1, IM_NBNDRYPIX, IM_LEN(im1,1)) + else + call imseti (im1, IM_NBNDRYPIX, + max (IM_LEN(im1,1), IM_LEN(im1,2))) + call rg_xsets (xc, IMAGE, Memc[image1]) + + # Open the output image if any. + if (list2 == NULL) { + im2 = NULL + Memc[image2] = EOS + } else if (imtgetim (list2, Memc[image2], SZ_FNAME) != EOF) { + call xt_mkimtemp (Memc[image1], Memc[image2], Memc[imtemp], + SZ_FNAME) + im2 = immap (Memc[image2], NEW_COPY, im1) + } else { + im2 = NULL + Memc[image2] = EOS + } + call rg_xsets (xc, OUTIMAGE, Memc[image2]) + + # Get the image record name for the shifts database. + if (reclist == NULL) + call strcpy (Memc[image1], Memc[str], SZ_FNAME) + else if (fntgfnb (reclist, Memc[str], SZ_FNAME) == EOF) + call strcpy (Memc[image1], Memc[str], SZ_FNAME) + call rg_xsets (xc, RECORD, Memc[str]) + + # Compute the initial coordinate shift. + if (tfd != NULL) + call rg_xtransform (tfd, xc) + + # Perform the cross correlation function. + if (interactive == YES) { + stat = rg_xicorr (imr, im1, im2, sdb, dformat, reglist, tfd, + xc, gd, id) + } else { + stat = rg_xcorr (imr, im1, sdb, dformat, xc) + if (verbose == YES) { + call rg_xstats (xc, REFIMAGE, Memc[str], SZ_LINE) + call printf ( + "Average shift from %s to %s is %g %g pixels\n") + call pargstr (Memc[image1]) + call pargstr (Memc[str]) + call pargr (rg_xstatr (xc, TXSHIFT)) + call pargr (rg_xstatr (xc, TYSHIFT)) + } + } + + # Compute the overlap region for the images. + call rg_overlap (im1, rg_xstatr (xc, TXSHIFT), + rg_xstatr (xc,TYSHIFT), c1, c2, l1, l2, ncols, nlines) + + # Shift the image and update the wcs. + if (im2 != NULL && stat == NO) { + if (verbose == YES) { + call printf ( + "\tShifting image %s to image %s ...\n") + call pargstr (Memc[image1]) + call pargstr (Memc[imtemp]) + } + + call rg_xshiftim (im1, im2, rg_xstatr (xc, TXSHIFT), + rg_xstatr (xc, TYSHIFT), Memc[interpstr], boundary, + constant) + mw = mw_openim (im1) + shifts[1] = rg_xstatr (xc, TXSHIFT) + shifts[2] = rg_xstatr (xc, TYSHIFT) + call mw_shift (mw, shifts, 03B) + call mw_saveim (mw, im2) + call mw_close (mw) + } + + # Close up the input and output images. + call imunmap (im1) + if (im2 != NULL) { + call imunmap (im2) + if (stat == YES) + call imdelete (Memc[image2]) + else + call xt_delimtemp (Memc[image2], Memc[imtemp]) + } + + if (stat == YES) + break + call rg_xindefr (xc) + } + + if (verbose == YES) + call rg_poverlap (c1, c2, l1, l2, ncols, nlines) + + call rg_xfree (xc) + + # Close up the lists. + if (imr != NULL) + call imunmap (imr) + call imtclose (list1) + if (listr != NULL) + call imtclose (listr) + if (reglist != NULL) + call fntclsb (reglist) + if (list2 != NULL) + call imtclose (list2) + if (tfd != NULL) + call close (tfd) + if (reflist != NULL) + call fntclsb (reflist) + if (reclist != NULL) + call fntclsb (reclist) + if (dformat == YES) + call dtunmap (sdb) + else + call close (sdb) + + # Close up the graphics and display devices. + if (gd != NULL) + call gclose (gd) + if (id != NULL) + call gclose (id) + + call sfree (sp) +end + + +# RG_OVERLAP -- Compute the overlap region of the list of images. + +procedure rg_overlap (im1, xshift, yshift, x1, x2, y1, y2, ncols, nlines) + +pointer im1 # pointer to the input image +real xshift # the computed x shift of the input image +real yshift # the computed y shift of the input image +int x1, x2 # the input/output column limits +int y1, y2 # the input/output line limits +int ncols, nlines # the input/output size limits + +int ixlo, ixhi, iylo, iyhi +real xlo, xhi, ylo, yhi + +begin + if (IS_INDEFR(xshift) || IS_INDEFR(yshift)) + return + + # Compute the limits of the shifted image. + xlo = 1.0 + xshift + xhi = IM_LEN(im1,1) + xshift + ylo = 1.0 + yshift + yhi = IM_LEN(im1,2) + yshift + + # Round up or down as appropriate. + ixlo = int (xlo) + if (xlo > ixlo) + ixlo = ixlo + 1 + ixhi = int (xhi) + if (xhi < ixhi) + ixhi = ixhi - 1 + iylo = int (ylo) + if (ylo > iylo) + iylo = iylo + 1 + iyhi = int (yhi) + if (yhi < iyhi) + iyhi = iyhi - 1 + + # Determine the new limits. + if (IS_INDEFI(x1)) + x1 = ixlo + else + x1 = max (ixlo, x1) + if (IS_INDEFI(x2)) + x2 = ixhi + else + x2 = min (ixhi, x2) + if (IS_INDEFI(y1)) + y1 = iylo + else + y1 = max (iylo, y1) + if (IS_INDEFI(y2)) + y2 = iyhi + else + y2 = min (iyhi, y2) + if (IS_INDEFI(ncols)) + ncols = IM_LEN(im1,1) + else + ncols = min (ncols, IM_LEN(im1,1)) + if (IS_INDEFI(nlines)) + nlines = IM_LEN(im1,2) + else + nlines = min (nlines, IM_LEN(im1,2)) +end + + +# RG_POVERLAP -- Procedure to print the overlap and/or vignetted region. + +procedure rg_poverlap (x1, x2, y1, y2, ncols, nlines) + +int x1, x2 # the input column limits +int y1, y2 # the input line limits +int ncols, nlines # the number of lines and columns + +int vx1, vx2, vy1, vy2 + +begin + vx1 = max (1, min (x1, ncols)) + vx2 = max (1, min (x2, ncols)) + vy1 = max (1, min (y1, nlines)) + vy2 = max (1, min (y2, nlines)) + + call printf ("Overlap region: [%d:%d,%d:%d]\n") + call pargi (x1) + call pargi (x2) + call pargi (y1) + call pargi (y2) + if (vx1 != x1 || vx2 != x2 || vy1 != y1 || vy2 != y2) { + call printf ("Vignetted overlap region: [%d:%d,%d:%d]\n") + call pargi (vx1) + call pargi (vx2) + call pargi (vy1) + call pargi (vy2) + } +end diff --git a/pkg/images/immatch/src/xregister/xregister.h b/pkg/images/immatch/src/xregister/xregister.h new file mode 100644 index 00000000..16c88b1e --- /dev/null +++ b/pkg/images/immatch/src/xregister/xregister.h @@ -0,0 +1,250 @@ +# Header file for XREGISTER + +# Define the cross correlation structure + +define LEN_XCSTRUCT (50 + 12 * SZ_FNAME + 12) + +define XC_RC1 Memi[$1] # pointers to 1st column of ref regions +define XC_RC2 Memi[$1+1] # pointers to 2nd column of ref regions +define XC_RL1 Memi[$1+2] # pointers to 1st line of ref regions +define XC_RL2 Memi[$1+3] # pointers to 2nd line of ref regions +define XC_RZERO Memi[$1+4] # pointers to zero pts of ref regions +define XC_RXSLOPE Memi[$1+5] # pointers to x slopes of ref regions +define XC_RYSLOPE Memi[$1+6] # pointers to y slopes of ref regions +define XC_XSHIFTS Memi[$1+7] # pointers to x shifts of ref regions +define XC_YSHIFTS Memi[$1+8] # pointers to y shifts of ref regions +define XC_NREGIONS Memi[$1+9] # total number of regions +define XC_CREGION Memi[$1+10] # the current region + +define XC_NREFPTS Memi[$1+11] # number of reference points +define XC_XREF Memi[$1+12] # pointer to x reference points +define XC_YREF Memi[$1+13] # pointer to y reference points +define XC_TRANSFORM Memi[$1+14] # pointer to the transform +define XC_IXLAG Memi[$1+15] # initial shift in x +define XC_IYLAG Memi[$1+16] # initial shift in y +define XC_XLAG Memi[$1+17] # current shift in x +define XC_YLAG Memi[$1+18] # current shift in y +define XC_DXLAG Memi[$1+19] # incremental shift in x +define XC_DYLAG Memi[$1+20] # incremental shift in y + +define XC_BACKGRD Memi[$1+21] # type of background subtraction +define XC_BORDER Memi[$1+22] # width of background border +define XC_BVALUER Memr[P2R($1+23)] # reference background value +define XC_BVALUE Memr[P2R($1+24)] # image bacground value +define XC_LOREJECT Memr[P2R($1+25)] # low side rejection +define XC_HIREJECT Memr[P2R($1+26)] # high side rejection +define XC_APODIZE Memr[P2R($1+27)] # fraction of apodized region +define XC_FILTER Memi[$1+28] # filter type + +define XC_CFUNC Memi[$1+30] # crosscor function +define XC_XWINDOW Memi[$1+31] # width of correlation window in x +define XC_YWINDOW Memi[$1+32] # width of correlation window in y +define XC_XCOR Memi[$1+33] # pointer to cross-correlation function + +define XC_PFUNC Memi[$1+34] # correlation peak fitting function +define XC_XCBOX Memi[$1+35] # x width of cor fitting box +define XC_YCBOX Memi[$1+36] # y width of cor fitting box + +define XC_TXSHIFT Memr[P2R($1+37)] # total x shift +define XC_TYSHIFT Memr[P2R($1+38)] # total y shift + +define XC_BSTRING Memc[P2C($1+50)] # background type +define XC_FSTRING Memc[P2C($1+50+SZ_FNAME+1)] # filter string +define XC_CSTRING Memc[P2C($1+50+2*SZ_FNAME+2)] # cross-correlation type +define XC_PSTRING Memc[P2C($1+50+3*SZ_FNAME+3)] # peak centering + +define XC_IMAGE Memc[P2C($1+50+4*SZ_FNAME+4)] # input image +define XC_REFIMAGE Memc[P2C($1+50+5*SZ_FNAME+5)] # reference image +define XC_REGIONS Memc[P2C($1+50+6*SZ_FNAME+6)] # regions list +define XC_DATABASE Memc[P2C($1+50+7*SZ_FNAME+7)] # shifts database +define XC_OUTIMAGE Memc[P2C($1+50+8*SZ_FNAME+8)] # output image +define XC_REFFILE Memc[P2C($1+50+9*SZ_FNAME+9)] # coordinates file +define XC_RECORD Memc[P2C($1+50+10*SZ_FNAME+10)] # record + +# Define the id strings + +define RC1 1 +define RC2 2 +define RL1 3 +define RL2 4 +define RZERO 5 +define RXSLOPE 6 +define RYSLOPE 7 +define XSHIFTS 8 +define YSHIFTS 9 +define NREGIONS 10 +define CREGION 11 + +define NREFPTS 12 +define XREF 13 +define YREF 14 +define TRANSFORM 15 +define IXLAG 16 +define IYLAG 17 +define XLAG 18 +define YLAG 19 +define DXLAG 20 +define DYLAG 21 + +define BACKGRD 22 +define BVALUER 23 +define BVALUE 24 +define BORDER 25 +define LOREJECT 26 +define HIREJECT 27 +define APODIZE 28 +define FILTER 29 + +define CFUNC 30 +define XWINDOW 31 +define YWINDOW 32 +define XCOR 33 + +define PFUNC 34 +define XCBOX 35 +define YCBOX 36 + +define TXSHIFT 37 +define TYSHIFT 38 + +define CSTRING 39 +define BSTRING 40 +define PSTRING 41 +define FSTRING 42 + +define IMAGE 43 +define REFIMAGE 44 +define REGIONS 45 +define OUTIMAGE 46 +define REFFILE 47 +define DATABASE 48 +define RECORD 49 + +# Define the default parameter values + +define DEF_IXLAG 0 +define DEF_IYLAG 0 +define DEF_DXLAG 0 +define DEF_DYLAG 0 +define DEF_XWINDOW 5 +define DEF_YWINDOW 5 + +define DEF_BACKGRD XC_BNONE +define DEF_BORDER INDEFI +define DEF_LOREJECT INDEFR +define DEF_HIREJECT INDEFR + +define DEF_XCBOX 5 +define DEF_YCBOX 5 +define DEF_PFUNC XC_CENTROID + +# Define the background fitting techniques + +define XC_BNONE 1 +define XC_MEAN 2 +define XC_MEDIAN 3 +define XC_SLOPE 4 + +define XC_BTYPES "|none|mean|median|plane|" + +# Define the filtering options + +define XC_FNONE 1 +define XC_LAPLACE 2 + +define XC_FTYPES "|none|laplace|" + +# Define the cross correlation techniques + +define XC_DISCRETE 1 +define XC_FOURIER 2 +define XC_DIFFERENCE 3 +define XC_FILE 4 + +define XC_CTYPES "|discrete|fourier|difference|file|" + +# Define the peak fitting functions + +define XC_PNONE 1 +define XC_CENTROID 2 +define XC_SAWTOOTH 3 +define XC_PARABOLA 4 +define XC_MARK 5 + +define XC_PTYPES "|none|centroid|sawtooth|parabola|mark|" + +# Miscellaneous + +define MAX_NREGIONS 100 +define MAX_NREF 3 +define MAX_NTRANSFORM 6 + +# Commands + +define XCMDS "|reference|input|regions|shifts|output|records|transform|\ +cregion|xlag|ylag|dxlag|dylag|background|border|loreject|hireject|apodize|\ +filter|correlation|xwindow|ywindow|function|xcbox|ycbox|show|mark|" + +define XSHOW "|data|background|correlation|center|" + +define XSHOW_DATA 1 +define XSHOW_BACKGROUND 2 +define XSHOW_CORRELATION 3 +define XSHOW_PEAKCENTER 4 + +define XCMD_REFIMAGE 1 +define XCMD_IMAGE 2 +define XCMD_REGIONS 3 +define XCMD_DATABASE 4 +define XCMD_OUTIMAGE 5 +define XCMD_RECORD 6 +define XCMD_REFFILE 7 +define XCMD_CREGION 8 +define XCMD_XLAG 9 +define XCMD_YLAG 10 +define XCMD_DXLAG 11 +define XCMD_DYLAG 12 +define XCMD_BACKGROUND 13 +define XCMD_BORDER 14 +define XCMD_LOREJECT 15 +define XCMD_HIREJECT 16 +define XCMD_APODIZE 17 +define XCMD_FILTER 18 +define XCMD_CORRELATION 19 +define XCMD_XWINDOW 20 +define XCMD_YWINDOW 21 +define XCMD_PEAKCENTER 22 +define XCMD_XCBOX 23 +define XCMD_YCBOX 24 +define XCMD_SHOW 25 +define XCMD_MARK 26 + +# Keywords + +define KY_REFIMAGE "reference" +define KY_IMAGE "input" +define KY_REGIONS "regions" +define KY_DATABASE "shifts" +define KY_OUTIMAGE "output" +define KY_RECORD "record" +define KY_REFFILE "coords" +define KY_NREGIONS "nregions" +define KY_CREGION "region" +define KY_XLAG "xlag" +define KY_YLAG "ylag" +define KY_DXLAG "dxlag" +define KY_DYLAG "dylag" +define KY_BACKGROUND "background" +define KY_BORDER "border" +define KY_LOREJECT "loreject" +define KY_HIREJECT "hireject" +define KY_APODIZE "apodize" +define KY_FILTER "filter" +define KY_CORRELATION "correlation" +define KY_XWINDOW "xwindow" +define KY_YWINDOW "ywindow" +define KY_PEAKCENTER "function" +define KY_XCBOX "xcbox" +define KY_YCBOX "ycbox" +define KY_TXSHIFT "xshift" +define KY_TYSHIFT "yshift" diff --git a/pkg/images/immatch/src/xregister/xregister.key b/pkg/images/immatch/src/xregister/xregister.key new file mode 100644 index 00000000..1956c88f --- /dev/null +++ b/pkg/images/immatch/src/xregister/xregister.key @@ -0,0 +1,47 @@ + Interactive Keystroke Commands + +? Print help +: Colon commands +t Define the offset between the reference and input images +c Draw a contour plot of the cross-correlation function +x Draw a column plot of the cross-correlation function +y Draw a line plot of the cross-correlation function +r Redraw the current plot +f Recompute the cross-correlation function +o Enter the image overlay plot submenu +w Update the task parameters +q Exit + + + Colon Commands + +:mark Mark regions on the display +:show Show current values of all the parameters + + + Show/set Parameters + +:reference [string] Show/set the current reference image name +:input [string] Show/set the current input image name +:regions [string] Show/set the regions to be cross-correlated +:shifts {string] Show/set the shifts database file name +:coords [string] Show/set the current coordinates file name +:output [string] Show/set the current output image name +:records [string] Show/set the current database record name +:xlag [value] Show/set the initial lag in x +:ylag [value] Show/set the initial lag in y +:dxlag [value] Show/set the incremental lag in x +:dylag [value] Show/set the incremental lag in y +:cregion [value] Show/set the current region +:background [string] Show/set the background fitting function +:border [value] Show/set border region for background fitting +:loreject [value] Show/set low side k-sigma rejection parameter +:hireject [value] Show/set high side k-sigma rejection parameter +:apodize [value] Show/set percent of end points to apodize +:filter [string] Show/set the default spatial filter +:correlation [string] Show/set the cross-correlation function +:xwindow [value] Show/set width of cross-correlation window in x +:ywindow [value] Show/set width of cross-correlation window in y +:function [string] Show/set correlation peak centering function +:xcbox [value] Show/set the centering box width in x +:ycbox [value] Show/set the centering box width in y diff --git a/pkg/images/immatch/sregister.cl b/pkg/images/immatch/sregister.cl new file mode 100644 index 00000000..38dc84ad --- /dev/null +++ b/pkg/images/immatch/sregister.cl @@ -0,0 +1,151 @@ +# SREGISTER -- Compute the geometric transformation required to register an +# input image to a reference image using celestial coordinate WCS information +# in the input and reference image headers, and perform the registration. +# SREGISTER is a simple script task which calls the SKYXYMATCH task to compute +# the control points, the GEOMAP task to compute the transformation, and the +# GEOTRAN task to do the registration. + +procedure sregister (input, reference, output) + +file input {prompt="The input images"} +file reference {prompt="Input reference images"} +file output {prompt="The output registered images"} +real xmin {INDEF, + prompt="Minimum logical x reference coordinate value"} +real xmax {INDEF, + prompt="Maximum logical x reference coordinate value"} +real ymin {INDEF, + prompt="Minimum logical y reference coordinate value"} +real ymax {INDEF, + prompt="Maximum logical y reference coordinate value"} +int nx {10, prompt="Number of grid points in x"} +int ny {10, prompt="Number of grid points in y"} +string wcs {"world", prompt="The default world coordinate system", + enum="physical|world"} +string xformat {"%10.3f", prompt="Output logical x coordinate format"} +string yformat {"%10.3f", prompt="Output logical y coordinate format"} +string rwxformat {"", + prompt="Output reference world x coordinate format"} +string rwyformat {"", + prompt="Output reference world y coordinate format"} +string wxformat {"", prompt="Output world x coordinate format"} +string wyformat {"", prompt="Output world y coordinate format"} + +string fitgeometry {"general", + prompt="Fitting geometry", + enum="shift|xyscale|rotate|rscale|rxyscale|general"} +string function {"polynomial", + prompt="Type of coordinate surface to be computed", + enum="legendre|chebyshev|polynomial"} +int xxorder {2, prompt="Order of x fit in x"} +int xyorder {2, prompt="Order of x fit in y"} +string xxterms {"half", enum="none|half|full", + prompt="X fit cross terms type"} +int yxorder {2, prompt="Order of y fit in x"} +int yyorder {2, prompt="Order of y fit in y"} +string yxterms {"half", enum="none|half|full", + prompt="Y fit cross terms type"} +real reject {INDEF, prompt="The rejection limit in units of sigma"} +string calctype {"real", prompt="Transformation computation type", + enum="real|double"} + +string geometry {"geometric", prompt="Transformation geometry", + enum="linear|geometric"} +real xsample {1.0,prompt="X coordinate sampling interval"} +real ysample {1.0,prompt="Y coordinate sampling interval"} +string interpolant {"linear", prompt="The interpolant type"} +string boundary {"nearest", prompt="Boundary extensiontype", + enum="nearest|constant|reflect|wrap"} +real constant {0.0, prompt="Constant for constant boundary extension"} +bool fluxconserve {yes, prompt="Preserve image flux ?"} +int nxblock {512, prompt="X dimension blocking factor"} +int nyblock {512, prompt="Y dimension blocking factor"} + +bool wcsinherit {yes, prompt="Inherit wcs of the reference image ?"} + +bool verbose {yes, prompt="Print messages about progress of task?"} +bool interactive {no, prompt="Compute transformation interactively? "} +string graphics {"stdgraph", prompt="The standard graphics device"} +gcur gcommands {"", prompt="The graphics cursor"} + + +begin + # Declare local variables. + int nimages + string tinput, treference, tcoords, tcname, tdatabase, toutput + string tsections1, tsections2 + + # Get the query parameters. + tinput = input + treference = reference + toutput = output + + # Cache the sections task. + cache sections + + # Get the coordinates file list. + tsections1 = mktemp ("tmps1") + tsections2 = mktemp ("tmps2") + if (access ("imxymatch.1")) { + tcoords = mktemp ("imxymatch") + } else { + tcoords = "imxymatch" + } + sections (tinput, option="fullname", > tsections1) + nimages = sections.nimages + for (i = 1; i <= nimages; i = i + 1) { + printf ("%s\n", tcoords // "." // i, >> tsections2) + } + delete (tsections1, go_ahead+, verify-, default_action+, + allversions+, subfiles+, > "dev$null") + tcname = "@"//tsections2 + + # Get the output database file name. + if (access ("sregister.db")) { + tdatabase = mktemp ("tmpdb") + } else { + tdatabase = "sregister.db" + } + + # Compute the control points. + skyxymatch (tinput, treference, tcname, coords="grid", xmin=xmin, + xmax=xmax, ymin=ymin, ymax=ymax, nx=nx, ny=ny, wcs=wcs, + xcolumn=1, ycolumn=1, xunits="", yunits="", xformat=xformat, + yformat=yformat, rwxformat=rwxformat, rwyformat=rwyformat, + wxformat=wxformat, wyformat=wyformat, min_sigdigits=7, verbose=no) + + # Compute the transformation. + geomap (tcname, tdatabase, xmin, xmax, ymin, ymax, transforms=tinput, + results="", fitgeometry=fitgeometry, function=function, + xxorder=xxorder, xyorder=xyorder, xxterms=xxterms, yxorder=yxorder, + yyorder=yyorder, yxterms=yxterms, reject=reject, calctype=calctype, + verbose=verbose, interactive=interactive, graphics=graphics, + cursor=gcommands) + + # Register the images. + geotran (tinput, toutput, database=tdatabase, transforms=tinput, + geometry=geometry, xmin=xmin, xmax=xmax, ymin=ymin, ymax=ymax, + xscale=1.0, yscale=1.0, ncols=INDEF, nlines=INDEF, + interpolant=interpolant, boundary=boundary, constant=constant, + fluxconserve=fluxconserve, xsample=xsample, ysample=ysample, + nxblock=nxblock, nyblock=nyblock, xin=INDEF, yin=INDEF, xout=INDEF, + yout=INDEF, xshift=INDEF, yshift=INDEF, xmag=INDEF, ymag=INDEF, + xrotation=INDEF, yrotation=INDEF, verbose=verbose) + + # Copy the reference wcs to the input images. + if (wcsinherit) { + wcscopy (toutput, treference, verbose-) + } + + # Delete the coordinates files. + delete (tcname, go_ahead+, verify-, default_action+, + allversions+, subfiles+, > "dev$null") + + # Delete the coordinates file list. + delete (tsections2, go_ahead+, verify-, default_action+, + allversions+, subfiles+, > "dev$null") + + # Delete the database file. + delete (tdatabase, go_ahead+, verify-, default_action+, + allversions+, subfiles+, > "dev$null") +end diff --git a/pkg/images/immatch/wcscopy.par b/pkg/images/immatch/wcscopy.par new file mode 100644 index 00000000..a5bff29c --- /dev/null +++ b/pkg/images/immatch/wcscopy.par @@ -0,0 +1,5 @@ +# Parameter file for WCSCOPY + +images,f,a,,,,"List of input images" +refimages,f,a,,,,"List of reference images" +verbose,b,h,yes,,,"Print messages about actions taken ?" diff --git a/pkg/images/immatch/wcsmap.cl b/pkg/images/immatch/wcsmap.cl new file mode 100644 index 00000000..2a052dc0 --- /dev/null +++ b/pkg/images/immatch/wcsmap.cl @@ -0,0 +1,111 @@ +# WCSMAP -- Compute the geometric transformation required to register an +# input image to a reference image using WCS information in the input and +# reference image headers. WCSMAP is a simple script task which calls the +# WCSXYMATCH task to compute the control points followed by the GEOMAP +# task to compute the transformation. + + +procedure wcsmap (input, reference, database) + +file input {prompt="The input images"} +file reference {prompt="The input reference images"} +file database {prompt="The output database file"} +string transforms {"", prompt="The database transform names"} +string results {"", prompt="The optional results summary files"} +real xmin {INDEF, + prompt="Minimum logical x reference coordinate value"} +real xmax {INDEF, + prompt="Maximum logical x reference coordinate value"} +real ymin {INDEF, + prompt="Minimum logical y reference coordinate value"} +real ymax {INDEF, + prompt="Maximum logical y reference coordinate value"} +int nx {10, prompt="Number of grid points in x"} +int ny {10, prompt="Number of grid points in y"} +string wcs {"world", prompt="The default world coordinate system", + enum="physical|world"} +bool transpose {no, prompt="Force a world coordinate tranpose ?"} +string xformat {"%10.3f", prompt="Output logical x coordinate format"} +string yformat {"%10.3f", prompt="Output logical y coordinate format"} +string wxformat {"", prompt="Output world x coordinate format"} +string wyformat {"", prompt="Output world y coordinate format"} +string fitgeometry {"general", + prompt="Fitting geometry", + enum="shift|xyscale|rotate|rscale|rxyscale|general"} +string function {"polynomial", prompt="Surface type", + enum="legendre|chebyshev|polynomial"} +int xxorder {2, prompt="Order of x fit in x"} +int xyorder {2, prompt="Order of x fit in y"} +string xxterms {"half", enum="none|half|full", + prompt="X fit cross terms type"} +int yxorder {2, prompt="Order of y fit in x"} +int yyorder {2, prompt="Order of y fit in y"} +string yxterms {"half", enum="none|half|full", + prompt="Y fit cross terms type"} +real reject {INDEF, prompt="Rejection limit in sigma units"} +string calctype {"real", prompt="Computation precision", + enum="real|double"} +bool verbose {yes, prompt="Print messages about progress of task ?"} +bool interactive {yes, prompt="Compute transformation interactively ? "} +string graphics {"stdgraph", prompt="Default graphics device"} +gcur gcommands {"", prompt="Graphics cursor"} + + +begin + # Declare local variables. + int nimages + string tinput, treference, toutput, ttransforms, tresults, tcoords + string tsections1, tsections2, tcname + + # Cache the sections task. + cache sections + + # Get the query parameters. + tinput = input + treference = reference + toutput = database + if (transforms == "") { + ttransforms = tinput + } else { + ttransforms = transforms + } + tresults = results + + # Get the temporary coordinates file list. + tsections1 = mktemp ("tmps1") + tsections2 = mktemp ("tmps2") + if (access ("imxymatch.1")) { + tcoords = mktemp ("imxymatch") + } else { + tcoords = "imxymatch" + } + sections (tinput, option="fullname", > tsections1) + nimages = sections.nimages + for (i = 1; i <= nimages; i = i + 1) { + printf ("%s\n", tcoords // "." // i, >> tsections2) + } + delete (tsections1, go_ahead+, verify-, default_action+, + allversions+, subfiles+, > "dev$null") + tcname = "@"//tsections2 + + # Compute the control points. + wcsxymatch (tinput, treference, tcname, coords="grid", xmin=xmin, + xmax=xmax, ymin=ymin, ymax=ymax, nx=nx, ny=ny, wcs=wcs, + transpose=transpose, xcolumn=1, ycolumn=1, xunits="", yunits="", + xformat=xformat, yformat=yformat, wxformat=wxformat, + wyformat=wyformat, min_sigdigits=7, verbose=no) + + # Compute the transformation. + geomap (tcname, toutput, xmin, xmax, ymin, ymax, transforms=ttransforms, + results = tresults, fitgeometry=fitgeometry, function=function, + xxorder=xxorder, xyorder=xyorder, xxterms=xxterms, yxorder=yxorder, + yyorder=yyorder, yxterms=yxterms, reject=reject, calctype=calctype, + verbose=verbose, interactive=interactive, graphics=graphics, + cursor=gcommands) + + # Cleanup. + delete (tcname, go_ahead+, verify-, default_action+, + allversions+, subfiles+, > "dev$null") + delete (tsections2, go_ahead+, verify-, default_action+, + allversions+, subfiles+, > "dev$null") +end diff --git a/pkg/images/immatch/wcsxymatch.par b/pkg/images/immatch/wcsxymatch.par new file mode 100644 index 00000000..b7bab19e --- /dev/null +++ b/pkg/images/immatch/wcsxymatch.par @@ -0,0 +1,25 @@ +# Parameter file for the WCSXYMATCH task + +input,f,a,,,,Input images +reference,f,a,,,,Input reference images +output,f,a,,,,Output matched coordinate lists +coords,f,h,"grid",,,Reference coordinate lists +xmin,r,h,INDEF,,,Minimum logical x reference coordinate value +xmax,r,h,INDEF,,,Maximum logical x reference coordinate value +ymin,r,h,INDEF,,,Minimum logical y reference coordinate value +ymax,r,h,INDEF,,,Maximum logical y reference coordinate value +nx,i,h,10,1,,Number of grid points in x +ny,i,h,10,1,,Number of grid points in y +wcs,s,h,"world","|physical|world|",,Input coordinate system +transpose,b,h,no,,,Force a world coordinate transpose ? +xcolumn,i,h,1,1,,Input column containing x coordinate +ycolumn,i,h,2,1,,Input column containing y coordinate +xunits,s,h,"",,,Input x coordinate units +yunits,s,h,"",,,Input y coordinate units +xformat,s,h,"%10.3f",,,Output logical x coordinate format +yformat,s,h,"%10.3f",,,Output logical y coordinate format +wxformat,s,h,"",,,Output world x coordinate format +wyformat,s,h,"",,,Output world y coordinate format +min_sigdigits,i,h,7,,,Minimum number of significant digits +verbose,b,h,yes,,,Verbose mode ? +mode,s,h,ql,,, diff --git a/pkg/images/immatch/wregister.cl b/pkg/images/immatch/wregister.cl new file mode 100644 index 00000000..0817eeac --- /dev/null +++ b/pkg/images/immatch/wregister.cl @@ -0,0 +1,148 @@ +# WREGISTER -- Compute the geometric transformation required to register an +# input image to a reference image using WCS information in the input and +# reference image headers, and perform the registration. WREGISTER is a simple +# script task which calls the WCSXYMATCH task to compute the control points, +# the GEOMAP task to compute the transformation, and the GEOTRAN task to do +# the registration. + +procedure wregister (input, reference, output) + +file input {prompt="The input images"} +file reference {prompt="Input reference images"} +file output {prompt="The output registered images"} +real xmin {INDEF, + prompt="Minimum logical x reference coordinate value"} +real xmax {INDEF, + prompt="Maximum logical x reference coordinate value"} +real ymin {INDEF, + prompt="Minimum logical y reference coordinate value"} +real ymax {INDEF, + prompt="Maximum logical y reference coordinate value"} +int nx {10, prompt="Number of grid points in x"} +int ny {10, prompt="Number of grid points in y"} +string wcs {"world", prompt="The default world coordinate system", + enum="physical|world"} +bool transpose {no, prompt="Force a world coordinate tranpose ?"} +string xformat {"%10.3f", prompt="Output logical x coordinate format"} +string yformat {"%10.3f", prompt="Output logical y coordinate format"} +string wxformat {"", prompt="Output world x coordinate format"} +string wyformat {"", prompt="Output world y coordinate format"} + +string fitgeometry {"general", + prompt="Fitting geometry", + enum="shift|xyscale|rotate|rscale|rxyscale|general"} +string function {"polynomial", + prompt="Type of coordinate surface to be computed", + enum="legendre|chebyshev|polynomial"} +int xxorder {2, prompt="Order of x fit in x"} +int xyorder {2, prompt="Order of x fit in y"} +string xxterms {"half", enum="none|half|full", + prompt="X fit cross terms type"} +int yxorder {2, prompt="Order of y fit in x"} +int yyorder {2, prompt="Order of y fit in y"} +string yxterms {"half", enum="none|half|full", + prompt="Y fit cross terms type"} +real reject {INDEF, prompt="The rejection limit in units of sigma"} +string calctype {"real", prompt="Transformation computation type", + enum="real|double"} + +string geometry {"geometric", prompt="Transformation geometry", + enum="linear|geometric"} +real xsample {1.0,prompt="X coordinate sampling interval"} +real ysample {1.0,prompt="Y coordinate sampling interval"} +string interpolant {"linear", prompt="The interpolant type"} +string boundary {"nearest", prompt="Boundary extensiontype", + enum="nearest|constant|reflect|wrap"} +real constant {0.0, prompt="Constant for constant boundary extension"} +bool fluxconserve {yes, prompt="Preserve image flux ?"} +int nxblock {512, prompt="X dimension blocking factor"} +int nyblock {512, prompt="Y dimension blocking factor"} + +bool wcsinherit {yes, prompt="Inherit wcs of the reference image ?"} + +bool verbose {yes, prompt="Print messages about progress of task?"} +bool interactive {no, prompt="Compute transformation interactively? "} +string graphics {"stdgraph", prompt="The standard graphics device"} +gcur gcommands {"", prompt="The graphics cursor"} + + +begin + # Declare local variables. + int nimages + string tinput, treference, tcoords, tcname, tdatabase, toutput + string tsections1, tsections2 + + # Get the query parameters. + tinput = input + treference = reference + toutput = output + + # Cache the sections task. + cache sections + + # Get the coordinates file list. + tsections1 = mktemp ("tmps1") + tsections2 = mktemp ("tmps2") + if (access ("imxymatch.1")) { + tcoords = mktemp ("imxymatch") + } else { + tcoords = "imxymatch" + } + sections (tinput, option="fullname", > tsections1) + nimages = sections.nimages + for (i = 1; i <= nimages; i = i + 1) { + printf ("%s\n", tcoords // "." // i, >> tsections2) + } + delete (tsections1, go_ahead+, verify-, default_action+, + allversions+, subfiles+, > "dev$null") + tcname = "@"//tsections2 + + # Get the output database file name. + if (access ("wregister.db")) { + tdatabase = mktemp ("tmpdb") + } else { + tdatabase = "wregister.db" + } + + # Compute the control points. + wcsxymatch (tinput, treference, tcname, coords="grid", xmin=xmin, + xmax=xmax, ymin=ymin, ymax=ymax, nx=nx, ny=ny, wcs=wcs, + transpose=transpose, xcolumn=1, ycolumn=1, xunits="", yunits="", + xformat=xformat, yformat=yformat, wxformat=wxformat, + wyformat=wyformat, min_sigdigits=7, verbose=no) + + # Compute the transformation. + geomap (tcname, tdatabase, xmin, xmax, ymin, ymax, transforms=tinput, + results="", fitgeometry=fitgeometry, function=function, + xxorder=xxorder, xyorder=xyorder, xxterms=xxterms, yxorder=yxorder, + yyorder=yyorder, yxterms=yxterms, reject=reject, calctype=calctype, + verbose=verbose, interactive=interactive, graphics=graphics, + cursor=gcommands) + + # Register the images. + geotran (tinput, toutput, database=tdatabase, transforms=tinput, + geometry=geometry, xmin=xmin, xmax=xmax, ymin=ymin, ymax=ymax, + xscale=1.0, yscale=1.0, ncols=INDEF, nlines=INDEF, + interpolant=interpolant, boundary=boundary, constant=constant, + fluxconserve=fluxconserve, xsample=xsample, ysample=ysample, + nxblock=nxblock, nyblock=nyblock, xin=INDEF, yin=INDEF, xout=INDEF, + yout=INDEF, xshift=INDEF, yshift=INDEF, xmag=INDEF, ymag=INDEF, + xrotation=INDEF, yrotation=INDEF, verbose=verbose) + + # Copy the reference wcs to the input images. + if (wcsinherit) { + wcscopy (toutput, treference, verbose-) + } + + # Delete the coordinates files. + delete (tcname, go_ahead+, verify-, default_action+, + allversions+, subfiles+, > "dev$null") + + # Delete the coordinates file list. + delete (tsections2, go_ahead+, verify-, default_action+, + allversions+, subfiles+, > "dev$null") + + # Delete the database file. + delete (tdatabase, go_ahead+, verify-, default_action+, + allversions+, subfiles+, > "dev$null") +end diff --git a/pkg/images/immatch/xregister.par b/pkg/images/immatch/xregister.par new file mode 100644 index 00000000..6e2da00b --- /dev/null +++ b/pkg/images/immatch/xregister.par @@ -0,0 +1,42 @@ +# Parameter file for the XREGISTER task + +input,s,a,,,,Input images to be registered +reference,s,a,,,,Input reference images +regions,s,a,"",,,Reference image regions used for registration +shifts,f,a,"",,,Input/output shifts database file +output,s,h,"",,,Output registered images +databasefmt,b,h,yes,,,Write the shifts file in database format ? +append,b,h,no,,,Open shifts database for writing in append mode ? +records,s,h,"",,,List of shifts database records +coords,f,h,"",,,Input coordinate files defining the initial shifts +xlag,i,h,0,,,Initial shift in x +ylag,i,h,0,,,Initial shift in y +dxlag,i,h,0,,,Incremental shift in x +dylag,i,h,0,,,Incremental shift in y + +background,s,h,"none","|none|mean|median|plane|",,Background fitting function +border,i,h,INDEF,,,Width of border for background fitting +loreject,r,h,INDEF,,,Low side k-sigma rejection factor +hireject,r,h,INDEF,,,High side k-sigma rejection factor +apodize,r,h,0.0,0.0,0.5,Fraction of endpoints to apodize +filter,s,h,"none","|none|laplace|",,Spatially filter the data + +correlation,s,h,"discrete","|discrete|fourier|difference|file|",,Cross-correlation function +xwindow,i,h,11,3,,Width of correlation window in x +ywindow,i,h,11,3,,Width of correlation window in y + +function,s,h,"centroid","|none|centroid|sawtooth|parabola|mark|",,Correlation peak centering function +xcbox,i,h,5,3,,X box width for centering correlation peak +ycbox,i,h,5,3,,Y box width for fitting correlation peak + +interp_type,s,h,"linear",,,'Interpolant' +boundary_type,s,h,"nearest","|constant|nearest|reflect|wrap|",,'Boundary (constant,nearest,reflect,wrap)' +constant,r,h,0.0,,,Constant for constant boundary extension + +interactive,b,h,no,,,Interactive mode ? +verbose,b,h,yes,,,Verbose mode ? +graphics,s,h,"stdgraph",,,The standard graphics device +display,s,h,"stdimage",,,The standard image display device +gcommands,*gcur,h,"",,,The graphics cursor +icommands,*imcur,h,"",,,The image display cursor +mode,s,h,ql,,, diff --git a/pkg/images/immatch/xyxymatch.par b/pkg/images/immatch/xyxymatch.par new file mode 100644 index 00000000..0a644e6d --- /dev/null +++ b/pkg/images/immatch/xyxymatch.par @@ -0,0 +1,36 @@ +# Parameter file for XYXYMATCH + +input,f,a,,,,The input lists +reference,f,a,,,,The reference lists +output,f,a,,,,The output matched coordinate lists +tolerance,r,a,3,,,The matching tolerance in pixels + +refpoints,f,h,"",,,Optional list of reference points +xin,r,h,INDEF,,,X origin of input list +yin,r,h,INDEF,,,Y origin of input list +xmag,r,h,INDEF,,,X magnification required to match input to reference list +ymag,r,h,INDEF,,,Y magnification required to match input to reference list +xrotation,r,h,INDEF,,,X rotation required to match input to reference list +yrotation,r,h,INDEF,,,Y rotation required to match input to reference list +xref,r,h,INDEF,,,X origin of reference list +yref,r,h,INDEF,,,Y origin of reference list + +xcolumn,i,h,1,,,Input list column containing the x coordinate +ycolumn,i,h,2,,,Input list column containing the y coordinate +xrcolumn,i,h,1,,,Reference list column containing the x coordinate +yrcolumn,i,h,2,,,Reference list column containing the y coordinate + +separation,r,h,9.0,,,The minimum object separation +matching,s,h,"triangles","|tolerance|triangles|",,The matching algorithm +nmatch,i,h,30,,,The maximum number of points for triangles algorithm +ratio,r,h,10.0,5.0,10.0,The maximum ratio of longest to shortest side of triangle +nreject,i,h,10,,,The maximum number of rejection iterations + +xformat,s,h,"%13.3f",,,The format of the output x coordinate +yformat,s,h,"%13.3f",,,The format of the output y coordinate + +interactive,b,h,no,,,Interactive mode ? +verbose,b,h,yes,,,Verbose mode ? +icommands,*imcur,h,"",,,The image display cursor + +mode,s,h,ql,,, |