aboutsummaryrefslogtreecommitdiff
path: root/pkg/images/immatch/src/linmatch
diff options
context:
space:
mode:
authorJoseph Hunkeler <jhunkeler@gmail.com>2015-07-08 20:46:52 -0400
committerJoseph Hunkeler <jhunkeler@gmail.com>2015-07-08 20:46:52 -0400
commitfa080de7afc95aa1c19a6e6fc0e0708ced2eadc4 (patch)
treebdda434976bc09c864f2e4fa6f16ba1952b1e555 /pkg/images/immatch/src/linmatch
downloadiraf-linux-fa080de7afc95aa1c19a6e6fc0e0708ced2eadc4.tar.gz
Initial commit
Diffstat (limited to 'pkg/images/immatch/src/linmatch')
-rw-r--r--pkg/images/immatch/src/linmatch/linmatch.h298
-rw-r--r--pkg/images/immatch/src/linmatch/linmatch.key51
-rw-r--r--pkg/images/immatch/src/linmatch/lsqfit.h18
-rw-r--r--pkg/images/immatch/src/linmatch/mkpkg21
-rw-r--r--pkg/images/immatch/src/linmatch/rglcolon.x564
-rw-r--r--pkg/images/immatch/src/linmatch/rgldbio.x225
-rw-r--r--pkg/images/immatch/src/linmatch/rgldelete.x993
-rw-r--r--pkg/images/immatch/src/linmatch/rgliscale.x593
-rw-r--r--pkg/images/immatch/src/linmatch/rglpars.x104
-rw-r--r--pkg/images/immatch/src/linmatch/rglplot.x1592
-rw-r--r--pkg/images/immatch/src/linmatch/rglregions.x1084
-rw-r--r--pkg/images/immatch/src/linmatch/rglscale.x1337
-rw-r--r--pkg/images/immatch/src/linmatch/rglshow.x107
-rw-r--r--pkg/images/immatch/src/linmatch/rglsqfit.x443
-rw-r--r--pkg/images/immatch/src/linmatch/rgltools.x1017
-rw-r--r--pkg/images/immatch/src/linmatch/t_linmatch.x544
16 files changed, 8991 insertions, 0 deletions
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
generated by cgit (git 2.34.1) at 2025-09-20 10:51:59 -0400