From 40e5a5811c6ffce9b0974e93cdd927cbcf60c157 Mon Sep 17 00:00:00 2001 From: Joe Hunkeler Date: Tue, 11 Aug 2015 16:51:37 -0400 Subject: Repatch (from linux) of OSX IRAF --- math/iminterp/Revisions | 7 + math/iminterp/arbpix.x | 339 ++++++++++++ math/iminterp/arider.x | 108 ++++ math/iminterp/arieval.x | 147 ++++++ math/iminterp/asider.x | 154 ++++++ math/iminterp/asieval.x | 67 +++ math/iminterp/asifit.x | 146 ++++++ math/iminterp/asifree.x | 17 + math/iminterp/asigeti.x | 25 + math/iminterp/asigetr.x | 20 + math/iminterp/asigrl.x | 194 +++++++ math/iminterp/asiinit.x | 57 ++ math/iminterp/asirestore.x | 50 ++ math/iminterp/asisave.x | 42 ++ math/iminterp/asisinit.x | 64 +++ math/iminterp/asitype.x | 90 ++++ math/iminterp/asivector.x | 56 ++ math/iminterp/doc/arbpix.hlp | 57 ++ math/iminterp/doc/arider.hlp | 59 +++ math/iminterp/doc/arieval.hlp | 48 ++ math/iminterp/doc/asider.hlp | 52 ++ math/iminterp/doc/asieval.hlp | 44 ++ math/iminterp/doc/asifit.hlp | 40 ++ math/iminterp/doc/asifree.hlp | 25 + math/iminterp/doc/asigeti.hlp | 36 ++ math/iminterp/doc/asigetr.hlp | 36 ++ math/iminterp/doc/asigrl.hlp | 40 ++ math/iminterp/doc/asiinit.hlp | 39 ++ math/iminterp/doc/asirestore.hlp | 36 ++ math/iminterp/doc/asisave.hlp | 39 ++ math/iminterp/doc/asisinit.hlp | 60 +++ math/iminterp/doc/asitype.hlp | 95 ++++ math/iminterp/doc/asivector.hlp | 52 ++ math/iminterp/doc/im1dinterp.spc | 525 ++++++++++++++++++ math/iminterp/doc/im2dinterp.spc | 432 +++++++++++++++ math/iminterp/doc/iminterp.hd | 37 ++ math/iminterp/doc/iminterp.hlp | 234 +++++++++ math/iminterp/doc/iminterp.men | 32 ++ math/iminterp/doc/iminterp.spc | 525 ++++++++++++++++++ math/iminterp/doc/mrider.hlp | 79 +++ math/iminterp/doc/mrieval.hlp | 57 ++ math/iminterp/doc/msider.hlp | 52 ++ math/iminterp/doc/msieval.hlp | 46 ++ math/iminterp/doc/msifit.hlp | 45 ++ math/iminterp/doc/msifree.hlp | 26 + math/iminterp/doc/msigeti.hlp | 35 ++ math/iminterp/doc/msigetr.hlp | 37 ++ math/iminterp/doc/msigrid.hlp | 51 ++ math/iminterp/doc/msigrl.hlp | 43 ++ math/iminterp/doc/msiinit.hlp | 41 ++ math/iminterp/doc/msirestore.hlp | 36 ++ math/iminterp/doc/msisave.hlp | 38 ++ math/iminterp/doc/msisinit.hlp | 61 +++ math/iminterp/doc/msisqgrl.hlp | 38 ++ math/iminterp/doc/msitype.hlp | 95 ++++ math/iminterp/doc/msivector.hlp | 54 ++ math/iminterp/ii_1dinteg.x | 372 +++++++++++++ math/iminterp/ii_bieval.x | 1080 ++++++++++++++++++++++++++++++++++++++ math/iminterp/ii_cubspl.f | 119 +++++ math/iminterp/ii_eval.x | 430 +++++++++++++++ math/iminterp/ii_greval.x | 859 ++++++++++++++++++++++++++++++ math/iminterp/ii_pc1deval.x | 291 ++++++++++ math/iminterp/ii_pc2deval.x | 444 ++++++++++++++++ math/iminterp/ii_polterp.x | 39 ++ math/iminterp/ii_sinctable.x | 123 +++++ math/iminterp/ii_spline.x | 56 ++ math/iminterp/ii_spline2d.x | 63 +++ math/iminterp/im1interpdef.h | 55 ++ math/iminterp/im2interpdef.h | 63 +++ math/iminterp/mkpkg | 53 ++ math/iminterp/mrider.x | 420 +++++++++++++++ math/iminterp/mrieval.x | 303 +++++++++++ math/iminterp/msider.x | 294 +++++++++++ math/iminterp/msieval.x | 74 +++ math/iminterp/msifit.x | 275 ++++++++++ math/iminterp/msifree.x | 21 + math/iminterp/msigeti.x | 24 + math/iminterp/msigetr.x | 20 + math/iminterp/msigrid.x | 65 +++ math/iminterp/msigrl.x | 238 +++++++++ math/iminterp/msiinit.x | 69 +++ math/iminterp/msirestore.x | 50 ++ math/iminterp/msisave.x | 43 ++ math/iminterp/msisinit.x | 91 ++++ math/iminterp/msisqgrl.x | 96 ++++ math/iminterp/msitype.x | 97 ++++ math/iminterp/msivector.x | 65 +++ 87 files changed, 11252 insertions(+) create mode 100644 math/iminterp/Revisions create mode 100644 math/iminterp/arbpix.x create mode 100644 math/iminterp/arider.x create mode 100644 math/iminterp/arieval.x create mode 100644 math/iminterp/asider.x create mode 100644 math/iminterp/asieval.x create mode 100644 math/iminterp/asifit.x create mode 100644 math/iminterp/asifree.x create mode 100644 math/iminterp/asigeti.x create mode 100644 math/iminterp/asigetr.x create mode 100644 math/iminterp/asigrl.x create mode 100644 math/iminterp/asiinit.x create mode 100644 math/iminterp/asirestore.x create mode 100644 math/iminterp/asisave.x create mode 100644 math/iminterp/asisinit.x create mode 100644 math/iminterp/asitype.x create mode 100644 math/iminterp/asivector.x create mode 100644 math/iminterp/doc/arbpix.hlp create mode 100644 math/iminterp/doc/arider.hlp create mode 100644 math/iminterp/doc/arieval.hlp create mode 100644 math/iminterp/doc/asider.hlp create mode 100644 math/iminterp/doc/asieval.hlp create mode 100644 math/iminterp/doc/asifit.hlp create mode 100644 math/iminterp/doc/asifree.hlp create mode 100644 math/iminterp/doc/asigeti.hlp create mode 100644 math/iminterp/doc/asigetr.hlp create mode 100644 math/iminterp/doc/asigrl.hlp create mode 100644 math/iminterp/doc/asiinit.hlp create mode 100644 math/iminterp/doc/asirestore.hlp create mode 100644 math/iminterp/doc/asisave.hlp create mode 100644 math/iminterp/doc/asisinit.hlp create mode 100644 math/iminterp/doc/asitype.hlp create mode 100644 math/iminterp/doc/asivector.hlp create mode 100644 math/iminterp/doc/im1dinterp.spc create mode 100644 math/iminterp/doc/im2dinterp.spc create mode 100644 math/iminterp/doc/iminterp.hd create mode 100644 math/iminterp/doc/iminterp.hlp create mode 100644 math/iminterp/doc/iminterp.men create mode 100644 math/iminterp/doc/iminterp.spc create mode 100644 math/iminterp/doc/mrider.hlp create mode 100644 math/iminterp/doc/mrieval.hlp create mode 100644 math/iminterp/doc/msider.hlp create mode 100644 math/iminterp/doc/msieval.hlp create mode 100644 math/iminterp/doc/msifit.hlp create mode 100644 math/iminterp/doc/msifree.hlp create mode 100644 math/iminterp/doc/msigeti.hlp create mode 100644 math/iminterp/doc/msigetr.hlp create mode 100644 math/iminterp/doc/msigrid.hlp create mode 100644 math/iminterp/doc/msigrl.hlp create mode 100644 math/iminterp/doc/msiinit.hlp create mode 100644 math/iminterp/doc/msirestore.hlp create mode 100644 math/iminterp/doc/msisave.hlp create mode 100644 math/iminterp/doc/msisinit.hlp create mode 100644 math/iminterp/doc/msisqgrl.hlp create mode 100644 math/iminterp/doc/msitype.hlp create mode 100644 math/iminterp/doc/msivector.hlp create mode 100644 math/iminterp/ii_1dinteg.x create mode 100644 math/iminterp/ii_bieval.x create mode 100644 math/iminterp/ii_cubspl.f create mode 100644 math/iminterp/ii_eval.x create mode 100644 math/iminterp/ii_greval.x create mode 100644 math/iminterp/ii_pc1deval.x create mode 100644 math/iminterp/ii_pc2deval.x create mode 100644 math/iminterp/ii_polterp.x create mode 100644 math/iminterp/ii_sinctable.x create mode 100644 math/iminterp/ii_spline.x create mode 100644 math/iminterp/ii_spline2d.x create mode 100644 math/iminterp/im1interpdef.h create mode 100644 math/iminterp/im2interpdef.h create mode 100644 math/iminterp/mkpkg create mode 100644 math/iminterp/mrider.x create mode 100644 math/iminterp/mrieval.x create mode 100644 math/iminterp/msider.x create mode 100644 math/iminterp/msieval.x create mode 100644 math/iminterp/msifit.x create mode 100644 math/iminterp/msifree.x create mode 100644 math/iminterp/msigeti.x create mode 100644 math/iminterp/msigetr.x create mode 100644 math/iminterp/msigrid.x create mode 100644 math/iminterp/msigrl.x create mode 100644 math/iminterp/msiinit.x create mode 100644 math/iminterp/msirestore.x create mode 100644 math/iminterp/msisave.x create mode 100644 math/iminterp/msisinit.x create mode 100644 math/iminterp/msisqgrl.x create mode 100644 math/iminterp/msitype.x create mode 100644 math/iminterp/msivector.x (limited to 'math/iminterp') diff --git a/math/iminterp/Revisions b/math/iminterp/Revisions new file mode 100644 index 00000000..b57a092b --- /dev/null +++ b/math/iminterp/Revisions @@ -0,0 +1,7 @@ +.help revisions Sep99 math.deboor +.nf +From Davis, September 20, 1999 + +Added some missing file dependices to the mkpkg file. +pkg/math/iminterp/mkpkg +.endhelp diff --git a/math/iminterp/arbpix.x b/math/iminterp/arbpix.x new file mode 100644 index 00000000..d22b47c6 --- /dev/null +++ b/math/iminterp/arbpix.x @@ -0,0 +1,339 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include +include +include "im1interpdef.h" + +define MIN_BDX 0.05 # minimum distance from interpolation point for sinc + +# ARBPIX -- Replace INDEF valued pixels with interpolated values. In order to +# replace bad points the spline interpolator uses a limited data array whose +# maximum total length is given by SPLPTS. + +procedure arbpix (datain, dataout, npts, interp_type, boundary_type) + +real datain[ARB] # input data array +real dataout[ARB] # output data array - cannot be same as datain +int npts # number of data points +int interp_type # interpolator type +int boundary_type # boundary type, at present must be BOUNDARY_EXT + +int i, badnc, k, ka, kb +real ii_badpix() + +begin + if (interp_type < 1 || interp_type > II_NTYPES) + call error (0, "ARBPIX: Unknown interpolator type.") + + if (boundary_type < 1 || boundary_type > II_NBOUND) + call error (0, "ARBPIX: Unknown boundary type.") + + # Count bad points. + badnc = 0 + do i = 1, npts + if (IS_INDEFR(datain[i])) + badnc = badnc + 1 + + # Return an array of INDEFS if all points bad. + if (badnc == npts) { + call amovkr (INDEFR, dataout, npts) + return + } + + # Copy input array to output array if all points good. + if (badnc == 0) { + call amovr (datain, dataout, npts) + return + } + + # If sinc interpolator use a special routine. + if (interp_type == II_SINC || interp_type == II_LSINC) { + call ii_badsinc (datain, dataout, npts, NSINC, MIN_BDX) + return + } + + # Find the first good point. + for (ka = 1; IS_INDEFR (datain[ka]); ka = ka + 1) + ; + + # Bad points below first good point are set at first good value. + do k = 1, ka - 1 + dataout[k] = datain[ka] + + # Find last good point. + for (kb = npts; IS_INDEFR (datain[kb]); kb = kb - 1) + ; + + # Bad points beyond last good point get set at good last value. + do k = npts, kb + 1, -1 + dataout[k] = datain[kb] + + # Load the other points interpolating the bad points as needed. + do k = ka, kb { + + if (IS_INDEFR(datain[k])) + dataout[k] = ii_badpix (datain[ka], kb - ka + 1, k - ka + 1, + interp_type) + else + dataout[k] = datain[k] + + } +end + + +# II_BADPIX -- This procedure fills a temporary array with good points that +# bracket the bad point and calls the interpolating routine. + +real procedure ii_badpix (datain, npix, index, interp_type) + +real datain[ARB] # datain array, y[1] and y[n] guaranteed to be good +int npix # length of y array +int index # index of bad point to replace +int interp_type # interpolator type + +int j, jj, pdown, pup, npts, ngood +real tempdata[SPLPTS], tempx[SPLPTS] +real ii_newpix() + +begin + # This code will work only if subroutines are implemented using + # static storage - i.e. the old internal values survive. This avoids + # reloading of temporary arrays if there are consequetive bad points. + + # The following test is done to improve speed. + + if (! IS_INDEFR(datain[index-1])) { + + # Set number of good points needed on each side of bad point. + switch (interp_type) { + case II_NEAREST: + ngood = 1 + case II_LINEAR: + ngood = 1 + case II_POLY3: + ngood = 2 + case II_POLY5: + ngood = 3 + case II_SPLINE3: + ngood = SPLPTS / 2 + case II_DRIZZLE: + ngood = 1 + } + + # Search down. + pdown = 0 + for (j = index - 1; j >= 1 && pdown < ngood; j = j - 1) + if (! IS_INDEFR(datain[j])) + pdown = pdown + 1 + + # Load temporary arrays for values below our INDEF. + npts = 0 + for(jj = j + 1; jj < index; jj = jj + 1) + if (! IS_INDEFR(datain[jj])) { + npts = npts + 1 + tempdata[npts] = datain[jj] + tempx[npts] = jj + } + + # Search and load up from INDEF. + pup = 0 + for (j = index + 1; j <= npix && pup < ngood; j = j + 1) + if (! IS_INDEFR(datain[j])) { + pup = pup + 1 + npts = npts + 1 + tempdata[npts] = datain[j] + tempx[npts] = j + } + } + + # Return value interpolated from these arrays. + return (ii_newpix (real(index), tempx, tempdata, + npts, pdown, interp_type)) + +end + + +# II_NEWPIX -- This procedure interpolates the temporary arrays. For the +# purposes of bad pixel replacement the drizzle replacement algorithm is +# equated with the linear interpolation replacement algorithm, an equation +# which is exact if the drizzle integration interval is exactly 1.0 pixels. +# II_NEWPIX does not represent a general puprpose routine because the +# previous routine has determined the proper indices. + +real procedure ii_newpix (x, xarray, data, npts, index, interp_type) + +real x # point to interpolate +real xarray[ARB] # x values +real data[ARB] # data values +int npts # size of data array +int index # index such that xarray[index] < x < xarray[index+1] +int interp_type # interpolator type + +int i, left, right +real cc[SPLINE3_ORDER, SPLPTS], h +real ii_polterp() + +begin + switch (interp_type) { + + case II_NEAREST: + if (x - xarray[1] > xarray[2] - x) + return (data[2]) + else + return (data[1]) + + case II_LINEAR, II_DRIZZLE: + return (data[1] + (x - xarray[1]) * + (data[2] - data[1]) / (xarray[2] - xarray[1])) + + case II_SPLINE3: + do i = 1, npts + cc[1,i] = data[i] + + cc[2,1] = 0. + cc[2,npts] = 0. + + # Use spline routine from C. de Boor's book "A Practical Guide + # to Splines + + call iicbsp (xarray, cc, npts, 2, 2) + h = x - xarray[index] + + return (cc[1,index] + h * (cc[2,index] + h * + (cc[3,index] + h * cc[4,index]/3.)/2.)) + + # One of the polynomial types. + default: + + # Allow lower order if not enough points on one side. + right = npts + left = 1 + + if (npts - index < index) { + right = 2 * (npts - index) + left = 2 * index - npts + 1 + } + + if (npts - index > index) + right = 2 * index + + # Finally polynomial interpolate. + return (ii_polterp (xarray[left], data[left], right, x)) + } +end + + +# II_BADSINC -- Procedure to evaluate bad pixels with a sinc interpolant +# This is the average of interpolation to points +-0.05 from the bad pixel. +# Sinc interpolation exactly at a pixel is undefined. Since this routine +# is intended to be a bad pixel replacement routine, no attempt has been +# made to optimize the routine by precomputing the sinc function. + +procedure ii_badsinc (datain, dataout, npts, nsinc, min_bdx) + +real datain[ARB] # input data including bad pixels with INDEF values +real dataout[ARB] # output data +int npts # number of data values +int nsinc # sinc truncation length +real min_bdx # minimum distance from interpolation point + +int i, j, k, xc +real sconst, a2, a4, dx, dx2, dx4 +real w, d, z, w1, u1, v1 + +begin + sconst = (HALFPI / nsinc) ** 2 + a2 = -0.49670 + a4 = 0.03705 + + do i = 1, npts { + + if (! IS_INDEFR(datain[i])) { + dataout[i] = datain[i] + next + } + + # Initialize. + xc = i + w = 1. + u1 = 0.0; v1 = 0.0 + + do j = 1, nsinc { + + # Get the taper. + w = -w + + # Sum the low side. + k = xc - j + if (k >= 1) + d = datain[k] + else + d = datain[1] + if (! IS_INDEFR(d)) { + dx = min_bdx + j + dx2 = sconst * j * j + dx4 = dx2 * dx2 + z = 1. / dx + w1 = w * z * (1.0 + a2 * dx2 + a4 * dx4) ** 2 + u1 = u1 + d * w1 + v1 = v1 + w1 + dx = -min_bdx + j + dx2 = sconst * j * j + dx4 = dx2 * dx2 + z = 1. / dx + w1 = -w * z * (1.0 + a2 * dx2 + a4 * dx4) ** 2 + u1 = u1 + d * w1 + v1 = v1 + w1 + } + + # Sum the high side. + k = xc + j + if (k <= npts) + d = datain[k] + else + d = datain[npts] + if (! IS_INDEFR(d)) { + dx = min_bdx - j + dx2 = sconst * j * j + dx4 = dx2 * dx2 + z = 1. / dx + w1 = w * z * (1.0 + a2 * dx2 + a4 * dx4) ** 2 + u1 = u1 + d * w1 + v1 = v1 + w1 + dx = -min_bdx - j + dx2 = sconst * j * j + dx4 = dx2 * dx2 + z = 1. / dx + w1 = -w * z * (1.0 + a2 * dx2 + a4 * dx4) ** 2 + u1 = u1 + d * w1 + v1 = v1 + w1 + } + } + + # Compute the result. + if (v1 != 0.) { + dataout[i] = u1 / v1 + } else { + do j = 1, npts { + k = xc - j + if (k >= 1) + d = datain[k] + else + d = datain[1] + if (!IS_INDEFR(d)) { + dataout[i] = d + break + } + k = xc + j + if (k <= npts) + d = datain[k] + else + d = datain[npts] + if (!IS_INDEFR(d)) { + dataout[i] = d + break + } + } + } + } +end diff --git a/math/iminterp/arider.x b/math/iminterp/arider.x new file mode 100644 index 00000000..55b3ee32 --- /dev/null +++ b/math/iminterp/arider.x @@ -0,0 +1,108 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include +include "im1interpdef.h" + +# ARIDER -- Return the derivatives of the interpolant. The sinc function +# width and precision limits are hardwired to the builtin constants NSINC +# and DX. The look-up table sinc function is aliased to the sinc function. +# The drizzle function pixel fraction is harwired to the builtin constant +# PIXFRAC. If PIXFRAC is 1.0 then the drizzle results are identical to the +# linear interpolation results. + +procedure arider (x, datain, npix, derivs, nder, interp_type) + +real x[ARB] # need 1 <= x <= n +real datain[ARB] # data values +int npix # number of data values +real derivs[ARB] # derivatives out -- derivs[1] is function value +int nder # total number of values returned in derivs +int interp_type # type of interpolator + +int i, j, k, nterms, nd, nearx +real pcoeff[MAX_NDERIVS], accum, deltax, temp, tmpx[2] + +begin + if (nder <= 0) + return + + # Zero out the derivatives array. + do i = 1, nder + derivs[i] = 0. + + switch (interp_type) { + + case II_NEAREST: + derivs[1] = datain[int (x[1] + 0.5)] + return + + case II_LINEAR: + nearx = x[1] + if (nearx >= npix) + temp = 2. * datain[nearx] - datain[nearx-1] + else + temp = datain[nearx+1] + derivs[1] = (x[1] - nearx) * temp + (nearx + 1 - x[1]) * + datain[nearx] + if (nder >= 2) + derivs[2] = temp - datain[nearx] + return + + case II_SINC, II_LSINC: + call ii_sincder (x, derivs, nder, datain, npix, NSINC, DX) + return + + case II_DRIZZLE: + call ii_driz1 (x, derivs[1], 1, datain, BADVAL) + if (nder > 1) { + deltax = x[2] - x[1] + if (deltax == 0.0) + derivs[2] = 0.0 + else { + tmpx[1] = x[1] + tmpx[2] = (x[1] + x[2]) / 2.0 + call ii_driz1 (x, temp, 1, datain, BADVAL) + tmpx[1] = tmpx[2] + tmpx[2] = x[2] + call ii_driz1 (x, derivs[2], 1, datain, BADVAL) + derivs[2] = 2.0 * (derivs[2] - temp) / deltax + } + } + return + + case II_POLY3: + call ia_pcpoly3 (x, datain, npix, pcoeff) + nterms = 4 + + case II_POLY5: + call ia_pcpoly5 (x, datain, npix, pcoeff) + nterms = 6 + + case II_SPLINE3: + call ia_pcspline3 (x, datain, npix, pcoeff) + nterms = 4 + + } + + # Evaluate the polynomial derivatives. + + nearx = x[1] + deltax = x[1] - nearx + + nd = nder + if (nder > nterms) + nd = nterms + + do k = 1, nd { + + # Evaluate using nested multiplication + accum = pcoeff[nterms - k + 1] + do j = nterms - k, 1, -1 + accum = pcoeff[j] + deltax * accum + derivs[k] = accum + + # Differentiate. + do j = 1, nterms - k + pcoeff[j] = j * pcoeff[j + 1] + } +end diff --git a/math/iminterp/arieval.x b/math/iminterp/arieval.x new file mode 100644 index 00000000..56d2c07a --- /dev/null +++ b/math/iminterp/arieval.x @@ -0,0 +1,147 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include +include "im1interpdef.h" + +# ARIEVAL -- Evaluate the interpolant at a given value of x. Arieval allows +# the interpolation of a few isolated points without the storage required for +# the sequential version. With the exception of the sinc function, the +# interpolation code is expanded directly in this routine to avoid the +# overhead of an aditional function call. The precomputed sinc function is +# not supported and is aliased to the regular sinc function. The default +# sinc function width and precision limits are hardwired to the builtin +# constants NSINC and DX. The default drizzle function pixel fraction is +# hardwired to the builtin constant PIXFRAC. If PIXFRAC is 1.0 then the +# drizzle results are identical to the linear interpolation results. + +real procedure arieval (x, datain, npts, interp_type) + +real x # x value, 1 <= x <= n +real datain[ARB] # array of data values +int npts # number of data values +int interp_type # interpolant type + +int i, k, nearx, pindex +real a[MAX_NDERIVS], cd20, cd21, cd40, cd41, deltax, deltay, hold +real bcoeff[SPLPTS+3], temp[SPLPTS+3], pcoeff[SPLINE3_ORDER] + +begin + switch (interp_type) { + + case II_NEAREST: + return (datain[int (x + 0.5)]) + + case II_LINEAR: + nearx = x + + # Protect against x = n. + if (nearx >= npts) + hold = 2. * datain[nearx] - datain[nearx - 1] + else + hold = datain[nearx+1] + + return ((x - nearx) * hold + (nearx + 1 - x) * datain[nearx]) + + case II_POLY3: + nearx = x + + # Protect against the x = 1 or x = n case. + k = 0 + for (i = nearx - 1; i <= nearx + 2; i = i + 1) { + k = k + 1 + if (i < 1) + a[k] = 2. * datain[1] - datain[2-i] + else if (i > npts) + a[k] = 2. * datain[npts] - datain[2*npts-i] + else + a[k] = datain[i] + } + + deltax = x - nearx + deltay = 1. - deltax + + # Second central differences. + cd20 = 1./6. * (a[3] - 2. * a[2] + a[1]) + cd21 = 1./6. * (a[4] - 2. * a[3] + a[2]) + + return (deltax * (a[3] + (deltax * deltax - 1.) * cd21) + + deltay * (a[2] + (deltay * deltay - 1.) * cd20)) + + case II_POLY5: + nearx = x + + # Protect against the x = 1 or x = n case. + k = 0 + for (i = nearx - 2; i <= nearx + 3; i = i + 1) { + k = k + 1 + if (i < 1) + a[k] = 2. * datain[1] - datain[2-i] + else if (i > npts) + a[k] = 2. * datain[npts] - datain[2*npts-i] + else + a[k] = datain[i] + } + + deltax = x - nearx + deltay = 1. - deltax + + # Second central differences. + cd20 = 1./6. * (a[4] - 2. * a[3] + a[2]) + cd21 = 1./6. * (a[5] - 2. * a[4] + a[3]) + + # Fourth central differences. + cd40 = 1./120. * (a[1] - 4. * a[2] + 6. * a[3] - 4. * a[4] + a[5]) + cd41 = 1./120. * (a[2] - 4. * a[3] + 6. * a[4] - 4. * a[5] + a[6]) + + return (deltax * (a[4] + (deltax * deltax - 1.) * + (cd21 + (deltax * deltax - 4.) * cd41)) + + deltay * (a[3] + (deltay * deltay - 1.) * + (cd20 + (deltay * deltay - 4.) * cd40))) + + case II_SPLINE3: + nearx = x + + deltax = x - nearx + k = 0 + + # Get the data. + for (i = nearx - SPLPTS/2 + 1; i <= nearx + SPLPTS/2; i = i + 1) { + if (i < 1 || i > npts) + ; + else { + k = k + 1 + if (k == 1) + pindex = nearx - i + 1 + bcoeff[k+1] = datain[i] + } + } + bcoeff[1] = 0. + bcoeff[k+2] = 0. + + # Compute coefficients. + call ii_spline (bcoeff, temp, k) + + pindex = pindex + 1 + bcoeff[k+3] = 0. + + pcoeff[1] = bcoeff[pindex-1] + 4. * bcoeff[pindex] + + bcoeff[pindex+1] + pcoeff[2] = 3. * (bcoeff[pindex+1] - bcoeff[pindex-1]) + pcoeff[3] = 3. * (bcoeff[pindex-1] - 2. * bcoeff[pindex] + + bcoeff[pindex+1]) + pcoeff[4] = -bcoeff[pindex-1] + 3. * bcoeff[pindex] - 3. * + bcoeff[pindex+1] + bcoeff[pindex+2] + + return (pcoeff[1] + deltax * (pcoeff[2] + deltax * + (pcoeff[3] + deltax * pcoeff[4]))) + + case II_SINC, II_LSINC: + call ii_sinc (x, hold, 1, datain, npts, NSINC, DX) + return (hold) + + case II_DRIZZLE: + call ii_driz1 (x, hold, 1, datain, BADVAL) + return (hold) + + } +end diff --git a/math/iminterp/asider.x b/math/iminterp/asider.x new file mode 100644 index 00000000..73e93b4d --- /dev/null +++ b/math/iminterp/asider.x @@ -0,0 +1,154 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include +include "im1interpdef.h" + +# ASIDER -- Calculate nder derivatives assuming that x lands in the region +# 1 <= x <= npts. + +procedure asider (asi, x, der, nder) + +pointer asi # interpolant descriptor +real x[ARB] # x value +real der[ARB] # derivatives, der[1] is value der[2] is f prime +int nder # number items returned = 1 + number of derivatives + +int nearx, i, j, k, nterms, nd +pointer c0ptr, n0 +real deltax, accum, tmpx[2], pcoeff[MAX_NDERIVS], diff[MAX_NDERIVS] + +begin + # Return zero for derivatives that are zero. + do i = 1, nder + der[i] = 0. + + # Nterms is number of terms in case polynomial type. + nterms = 0 + + # (c0ptr + 1) is the pointer to the first data point in COEFF. + c0ptr = ASI_COEFF(asi) - 1 + ASI_OFFSET(asi) + + switch (ASI_TYPE(asi)) { + + case II_NEAREST: + der[1] = COEFF(c0ptr + int(x[1] + 0.5)) + return + + case II_LINEAR: + nearx = x[1] + der[1] = (x[1] - nearx) * COEFF(c0ptr + nearx + 1) + + (nearx + 1 - x[1]) * COEFF(c0ptr + nearx) + if (nder > 1) + der[2] = COEFF(c0ptr + nearx + 1) - COEFF(c0ptr + nearx) + return + + case II_SINC, II_LSINC: + call ii_sincder (x[1], der, nder, + COEFF(ASI_COEFF(asi) + ASI_OFFSET(asi)), ASI_NCOEFF(asi), + ASI_NSINC(asi), DX) + return + + case II_DRIZZLE: + if (ASI_PIXFRAC(asi) >= 1.0) + call ii_driz1 (x, der[1], 1, COEFF(ASI_COEFF(asi) + + ASI_OFFSET(asi)), ASI_BADVAL(asi)) + else + call ii_driz (x, der[1], 1, COEFF(ASI_COEFF(asi) + + ASI_OFFSET(asi)), ASI_PIXFRAC(asi), ASI_BADVAL(asi)) + if (nder > 1) { + deltax = x[2] - x[1] + if (deltax == 0.0) + der[2] = 0.0 + else { + tmpx[1] = x[1] + tmpx[2] = (x[1] + x[2]) / 2.0 + if (ASI_PIXFRAC(asi) >= 1.0) + call ii_driz1 (tmpx, accum, 1, COEFF(ASI_COEFF(asi) + + ASI_OFFSET(asi)), ASI_BADVAL(asi)) + else + call ii_driz (tmpx, accum, 1, COEFF(ASI_COEFF(asi) + + ASI_OFFSET(asi)), ASI_PIXFRAC(asi), ASI_BADVAL(asi)) + tmpx[1] = tmpx[2] + tmpx[2] = x[2] + if (ASI_PIXFRAC(asi) >= 1.0) + call ii_driz1 (tmpx, der[2], 1, COEFF(ASI_COEFF(asi) + + ASI_OFFSET(asi)), ASI_BADVAL(asi)) + else + call ii_driz (tmpx, der[2], 1, COEFF(ASI_COEFF(asi) + + ASI_OFFSET(asi)), ASI_PIXFRAC(asi), ASI_BADVAL(asi)) + der[2] = 2.0 * (der[2] - accum) / deltax + } + } + return + + case II_POLY3: + nterms = 4 + + case II_POLY5: + nterms = 6 + + case II_SPLINE3: + nterms = 4 + + default: + call error (0, "ASIDER: Unknown interpolant type") + } + + # Routines falls through to this point if the interpolant is one of + # the higher order polynomial types or a third order spline. + + nearx = x[1] + n0 = c0ptr + nearx + deltax = x[1] - nearx + + # Compute the number of derivatives needed. + nd = nder + if (nder > nterms) + nd = nterms + + # Generate the polynomial coefficients. + + if (ASI_TYPE(asi) == II_SPLINE3) { + + pcoeff[1] = COEFF(n0-1) + 4. * COEFF(n0) + COEFF(n0+1) + pcoeff[2] = 3. * (COEFF(n0+1) - COEFF(n0-1)) + pcoeff[3] = 3. * (COEFF(n0-1) - 2. * COEFF(n0) + COEFF(n0+1)) + pcoeff[4] = -COEFF(n0-1) + 3. * COEFF(n0) - 3. * COEFF(n0+1) + + COEFF(n0+2) + + # Newton's form written in line to get polynomial from data + } else { + + # Load data. + do i = 1, nterms + diff[i] = COEFF(n0 - nterms/2 + i) + + # Generate difference table. + do k = 1, nterms - 1 + do i = 1, nterms - k + diff[i] = (diff[i+1] - diff[i]) / k + + # Shift to generate polynomial coefficients. + do k = nterms, 2, -1 + do i = 2,k + diff[i] = diff[i] + diff[i-1] * (k - i - nterms/2) + do i = 1,nterms + pcoeff[i] = diff[nterms + 1 - i] + } + + # Compute the derivatives. As the loop progresses pcoeff contains + # coefficients of higher and higher derivatives. + + do k = 1, nd { + + # Evaluate using nested multiplication. + accum = pcoeff[nterms - k + 1] + do j = nterms - k, 1, -1 + accum = pcoeff[j] + deltax * accum + der[k] = accum + + # Differentiate polynomial. + do j = 1, nterms - k + pcoeff[j] = j * pcoeff[j + 1] + } +end diff --git a/math/iminterp/asieval.x b/math/iminterp/asieval.x new file mode 100644 index 00000000..51f9a63b --- /dev/null +++ b/math/iminterp/asieval.x @@ -0,0 +1,67 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include +include "im1interpdef.h" + +# ASIEVAL -- This procedure finds the interpolated value assuming that +# x lands in the array, i.e. 1 <= x <= npts. + +real procedure asieval (asi, x) + +pointer asi # interpolator descriptor +real x[ARB] # x value + +real value + +begin + switch (ASI_TYPE(asi)) { # switch on interpolator type + + case II_NEAREST: + call ii_nearest (x, value, 1, + COEFF(ASI_COEFF(asi) + ASI_OFFSET(asi))) + return (value) + + case II_LINEAR: + call ii_linear (x, value, 1, + COEFF(ASI_COEFF(asi) + ASI_OFFSET(asi))) + return (value) + + case II_POLY3: + call ii_poly3 (x, value, 1, COEFF(ASI_COEFF(asi) + ASI_OFFSET(asi))) + return (value) + + case II_POLY5: + call ii_poly5 (x, value, 1, COEFF(ASI_COEFF(asi) + ASI_OFFSET(asi))) + return (value) + + case II_SPLINE3: + call ii_spline3 (x, value, 1, + COEFF(ASI_COEFF(asi) + ASI_OFFSET(asi))) + return (value) + + case II_SINC: + call ii_sinc (x, value, 1, + COEFF(ASI_COEFF(asi) + ASI_OFFSET(asi)), ASI_NCOEFF(asi), + ASI_NSINC(asi), DX) + return (value) + + case II_LSINC: + call ii_lsinc (x, value, 1, + COEFF(ASI_COEFF(asi) + ASI_OFFSET(asi)), ASI_NCOEFF(asi), + LTABLE(ASI_LTABLE(asi)), 2 * ASI_NSINC(asi) + 1, + ASI_NINCR(asi), DX) + return (value) + + case II_DRIZZLE: + if (ASI_PIXFRAC(asi) >= 1.0) + call ii_driz1 (x, value, 1, COEFF(ASI_COEFF(asi) + + ASI_OFFSET(asi)), ASI_BADVAL(asi)) + else + call ii_driz (x, value, 1, COEFF(ASI_COEFF(asi) + + ASI_OFFSET(asi)), ASI_PIXFRAC(asi), ASI_BADVAL(asi)) + return (value) + + default: + call error (0, "ASIEVAL: Unknown interpolator type.") + } +end diff --git a/math/iminterp/asifit.x b/math/iminterp/asifit.x new file mode 100644 index 00000000..3ea33041 --- /dev/null +++ b/math/iminterp/asifit.x @@ -0,0 +1,146 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include +include "im1interpdef.h" + +define TEMP Memr[P2P($1)] + +# ASIFIT -- Fit the interpolant to the data. + +procedure asifit (asi, datain, npix) + +pointer asi # interpolant descriptor +real datain[ARB] # data array +int npix # nunber of data points + +int i +pointer c0ptr, cdataptr, cnptr, temp + +begin + # Check the data array for size and allocate space for the coefficient + # array. + + switch (ASI_TYPE(asi)) { + + case II_SPLINE3: + if (npix < 4) + call error (0, "ASIFIT: too few points for SPLINE3") + else { + ASI_NCOEFF(asi) = npix + 3 + ASI_OFFSET(asi) = 1 + if (ASI_COEFF(asi) != NULL) + call mfree (ASI_COEFF(asi), TY_REAL) + call malloc (ASI_COEFF(asi), ASI_NCOEFF(asi), TY_REAL) + call malloc (temp, ASI_NCOEFF(asi), TY_REAL) + } + + case II_POLY5: + if (npix < 6) + call error (0,"ASIFIT: too few points for POLY5") + else { + ASI_NCOEFF(asi) = npix + 5 + ASI_OFFSET(asi) = 2 + if (ASI_COEFF(asi) != NULL) + call mfree (ASI_COEFF(asi), TY_REAL) + call malloc (ASI_COEFF(asi), ASI_NCOEFF(asi), TY_REAL) + } + + case II_POLY3: + if (npix < 4) + call error (0, "ASIFIT: too few points for POLY3") + else { + ASI_NCOEFF(asi) = npix + 3 + ASI_OFFSET(asi) = 1 + if (ASI_COEFF(asi) != NULL) + call mfree (ASI_COEFF(asi), TY_REAL) + call malloc (ASI_COEFF(asi), ASI_NCOEFF(asi), TY_REAL) + } + + case II_DRIZZLE, II_LINEAR: + if (npix < 2) + call error (0, "ASIFIT: too few points for LINEAR") + else { + ASI_NCOEFF(asi) = npix + 1 + ASI_OFFSET(asi) = 0 + if (ASI_COEFF(asi) != NULL) + call mfree (ASI_COEFF(asi), TY_REAL) + call malloc (ASI_COEFF(asi), ASI_NCOEFF(asi), TY_REAL) + } + + case II_SINC, II_LSINC: + if (npix < 1) + call error (0, "ASIFIT: too few points for SINC") + else { + ASI_NCOEFF(asi) = npix + ASI_OFFSET(asi) = 0 + if (ASI_COEFF(asi) != NULL) + call mfree (ASI_COEFF(asi), TY_REAL) + call malloc (ASI_COEFF(asi), ASI_NCOEFF(asi), TY_REAL) + } + + default: + if (npix < 1) + call error (0," ASIFIT: too few points for NEAREST") + else { + ASI_NCOEFF(asi) = npix + ASI_OFFSET(asi) = 0 + if (ASI_COEFF(asi) != NULL) + call mfree (ASI_COEFF(asi), TY_REAL) + call malloc (ASI_COEFF(asi), ASI_NCOEFF(asi), TY_REAL) + } + + } + + + # Define the pointers. + # (c0ptr + 1) points to first element in the coefficient array. + # (cdataptr + 1) points to first data element in the coefficient array. + # (cnptr + 1) points to the first element after the last data point in + # coefficient array. + + c0ptr = ASI_COEFF(asi) - 1 + cdataptr = ASI_COEFF(asi) - 1 + ASI_OFFSET(asi) + cnptr = cdataptr + npix + + # Put data into the interpolant structure. + do i = 1, npix + COEFF(cdataptr + i) = datain[i] + + # Specify the end conditions. + switch (ASI_TYPE(asi)) { + + case II_SPLINE3: + # Natural end conditions - second deriv. zero + COEFF(c0ptr + 1) = 0. + COEFF(cnptr + 1) = 0. + COEFF(cnptr + 2) = 0. # if x = npts + + # Fit spline - generate b-spline coefficients. + call ii_spline (COEFF(ASI_COEFF(asi)), TEMP(temp), npix) + call mfree (temp, TY_REAL) + + case II_NEAREST, II_SINC, II_LSINC: + # No end conditions required. + + case II_LINEAR, II_DRIZZLE: + COEFF(cnptr + 1) = 2. * COEFF(cdataptr + npix) - # if x = npts + COEFF(cdataptr + npix - 1) + + case II_POLY3: + COEFF(c0ptr + 1) = 2. * COEFF(cdataptr + 1) - COEFF(cdataptr + 2) + COEFF(cnptr + 1) = 2. * COEFF(cdataptr + npix) - + COEFF(cdataptr + npix - 1) + COEFF(cnptr + 2) = 2. * COEFF(cdataptr + npix) - + COEFF(cdataptr + npix - 2) + + case II_POLY5: + COEFF(c0ptr + 1) = 2. * COEFF(cdataptr + 1) - COEFF(cdataptr + 3) + COEFF(c0ptr + 2) = 2. * COEFF(cdataptr + 1) - COEFF(cdataptr + 2) + COEFF(cnptr + 1) = 2. * COEFF(cdataptr + npix) - + COEFF(cdataptr + npix - 1) + COEFF(cnptr + 2) = 2. * COEFF(cdataptr + npix) - + COEFF(cdataptr + npix - 2) + COEFF(cnptr + 3) = 2. * COEFF(cdataptr + npix) - + COEFF(cdataptr + npix - 3) + } +end diff --git a/math/iminterp/asifree.x b/math/iminterp/asifree.x new file mode 100644 index 00000000..2feda49b --- /dev/null +++ b/math/iminterp/asifree.x @@ -0,0 +1,17 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "im1interpdef.h" + +# ASIFREE -- Procedure to deallocate sequential interpolant structure + +procedure asifree (asi) + +pointer asi # interpolant descriptor + +begin + if (ASI_COEFF(asi) != NULL) + call mfree (ASI_COEFF(asi), TY_REAL) + if (ASI_LTABLE(asi) != NULL) + call mfree (ASI_LTABLE(asi), TY_REAL) + call mfree (asi, TY_STRUCT) +end diff --git a/math/iminterp/asigeti.x b/math/iminterp/asigeti.x new file mode 100644 index 00000000..fbf1ddc1 --- /dev/null +++ b/math/iminterp/asigeti.x @@ -0,0 +1,25 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "im1interpdef.h" +include + +# ASIGETI -- Procedure to fetch an asi integer parameter + +int procedure asigeti (asi, param) + +pointer asi # interpolant descriptor +int param # parameter to be fetched + +begin + switch (param) { + case II_ASITYPE: + return (ASI_TYPE(asi)) + case II_ASINSAVE: + return (ASI_NSINC(asi) * ASI_NINCR(asi) + ASI_NCOEFF(asi) + + ASI_SAVECOEFF) + case II_ASINSINC: + return (ASI_NSINC(asi)) + default: + call error (0, "ASIGETI: Unknown ASI parameter.") + } +end diff --git a/math/iminterp/asigetr.x b/math/iminterp/asigetr.x new file mode 100644 index 00000000..57cdd07f --- /dev/null +++ b/math/iminterp/asigetr.x @@ -0,0 +1,20 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "im1interpdef.h" +include + +# ASIGETR -- Procedure to fetch an msi real parameter + +real procedure asigetr (asi, param) + +pointer asi # interpolant descriptor +int param # parameter to be fetched + +begin + switch (param) { + case II_ASIBADVAL: + return (ASI_BADVAL(asi)) + default: + call error (0, "ASIGETR: Unknown ASI parameter.") + } +end diff --git a/math/iminterp/asigrl.x b/math/iminterp/asigrl.x new file mode 100644 index 00000000..55f2395f --- /dev/null +++ b/math/iminterp/asigrl.x @@ -0,0 +1,194 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include +include "im1interpdef.h" + +# ASIGRL -- Procedure to find the integral of the interpolant from a to +# b be assuming that both a and b land in the array. + +real procedure asigrl (asi, a, b) + +pointer asi # interpolant descriptor +real a # lower limit for integral +real b # upper limit for integral + +int neara, nearb, i, j, nterms, index +real deltaxa, deltaxb, accum, xa, xb, pcoeff[MAX_NDERIVS] +pointer c0ptr, n0ptr + +begin + # Flip order and sign at end. + xa = a + xb = b + if (a > b) { + xa = b + xb = a + } + + # Initialize. + c0ptr = ASI_COEFF(asi) - 1 + ASI_OFFSET(asi) + neara = xa + nearb = xb + accum = 0. + + switch (ASI_TYPE(asi)) { + case II_NEAREST, II_SINC, II_LSINC, II_DRIZZLE: + nterms = 0 + case II_LINEAR: + nterms = 1 + case II_POLY3: + nterms = 4 + case II_POLY5: + nterms = 6 + case II_SPLINE3: + nterms = 4 + } + + # NEAREST_NEIGHBOR, LINEAR, SINC and LSINC are handled differently + # because of storage. Also probably good for speed in the case of + # LINEAR and NEAREST_NEIGHBOUR. + + # NEAREST_NEIGHBOR + switch (ASI_TYPE(asi)) { + case II_NEAREST: + + # Reset segment to center values. + neara = xa + 0.5 + nearb = xb + 0.5 + + # Set up for first segment. + deltaxa = xa - neara + + # For clarity one segment case is handled separately. + + # Only one segment involved. + if (nearb == neara) { + deltaxb = xb - nearb + n0ptr = c0ptr + neara + accum = accum + (deltaxb - deltaxa) * COEFF(n0ptr) + + # More than one segment. + } else { + + # First segment. + n0ptr = c0ptr + neara + accum = accum + (0.5 - deltaxa) * COEFF(n0ptr) + + # Middle segment. + do j = neara + 1, nearb - 1 { + n0ptr = c0ptr + j + accum = accum + COEFF(n0ptr) + } + + # Last segment. + n0ptr = c0ptr + nearb + deltaxb = xb - nearb + accum = accum + (deltaxb + 0.5) * COEFF(n0ptr) + } + + # LINEAR + case II_LINEAR: + + # Set up for first segment. + deltaxa = xa - neara + + # For clarity one segment case is handled separately. + + # Only one segment is involved. + if (nearb == neara) { + deltaxb = xb - nearb + n0ptr = c0ptr + neara + accum = accum + (deltaxb - deltaxa) * COEFF(n0ptr) + + 0.5 * (COEFF(n0ptr+1) - COEFF(n0ptr)) * + (deltaxb * deltaxb - deltaxa * deltaxa) + + # More than one segment. + } else { + + # First segment. + n0ptr = c0ptr + neara + accum = accum + (1. - deltaxa) * COEFF(n0ptr) + + 0.5 * (COEFF(n0ptr+1) - COEFF(n0ptr)) * + (1. - deltaxa * deltaxa) + + # Middle segment. + do j = neara + 1, nearb - 1 { + n0ptr = c0ptr + j + accum = accum + 0.5 * (COEFF(n0ptr+1) + COEFF(n0ptr)) + } + + # Last segment. + n0ptr = c0ptr + nearb + deltaxb = xb - nearb + accum = accum + COEFF(n0ptr) * deltaxb + 0.5 * + (COEFF(n0ptr+1) - COEFF(n0ptr)) * deltaxb * deltaxb + } + + # SINC + case II_SINC, II_LSINC: + call ii_sincigrl (xa, xb, accum, COEFF(ASI_COEFF(asi) + + ASI_OFFSET(asi)), ASI_NCOEFF(asi), ASI_NSINC(asi), DX) + + # DRIZZLE + case II_DRIZZLE: + if (ASI_PIXFRAC(asi) >= 1.0) + call ii_dzigrl1 (xa, xb, accum, COEFF(ASI_COEFF(asi) + + ASI_OFFSET(asi))) + else + call ii_dzigrl (xa, xb, accum, COEFF(ASI_COEFF(asi) + + ASI_OFFSET(asi)), ASI_PIXFRAC(asi)) + + # A higher order interpolant. + default: + + # Set up for first segment. + deltaxa = xa - neara + + # For clarity one segment case is handled separately. + + # Only one segment involved. + if (nearb == neara) { + + deltaxb = xb - nearb + n0ptr = c0ptr + neara + index = ASI_OFFSET(asi) + neara + call ii_getpcoeff (COEFF(ASI_COEFF(asi)), index, pcoeff, + ASI_TYPE(asi)) + do i = 1, nterms + accum = accum + (1./i) * pcoeff[i] * + (deltaxb ** i - deltaxa ** i) + + # More than one segment. + } else { + + # First segment. + index = ASI_OFFSET(asi) + neara + call ii_getpcoeff (COEFF(ASI_COEFF(asi)), index, pcoeff, + ASI_TYPE(asi)) + do i = 1, nterms + accum = accum + (1./i) * pcoeff[i] * (1. - deltaxa ** i) + + # Middle segment. + do j = neara + 1, nearb - 1 { + index = ASI_OFFSET(asi) + j + call ii_getpcoeff (COEFF(ASI_COEFF(asi)), + index, pcoeff, ASI_TYPE(asi)) + do i = 1, nterms + accum = accum + (1./i) * pcoeff[i] + } + + # Last segment. + index = ASI_OFFSET(asi) + nearb + deltaxb = xb - nearb + call ii_getpcoeff (COEFF(ASI_COEFF(asi)), index, pcoeff, + ASI_TYPE(asi)) + do i = 1, nterms + accum = accum + (1./i) * pcoeff[i] * deltaxb ** i + } + } + + if (a < b) + return (accum) + else + return (-accum) +end diff --git a/math/iminterp/asiinit.x b/math/iminterp/asiinit.x new file mode 100644 index 00000000..daf99665 --- /dev/null +++ b/math/iminterp/asiinit.x @@ -0,0 +1,57 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include +include "im1interpdef.h" + +# ASIINIT -- initialize the array sequential interpolant structure + +procedure asiinit (asi, interp_type) + +pointer asi # interpolant descriptor +int interp_type # interpolant type + +int nconv + +begin + if (interp_type < 1 || interp_type > II_NTYPES) + call error (0,"ASIINIT: Illegal interpolant type.") + else { + call calloc (asi, LEN_ASISTRUCT, TY_STRUCT) + ASI_TYPE(asi) = interp_type + switch (interp_type) { + case II_LSINC: + ASI_NSINC(asi) = NSINC + ASI_NINCR(asi) = NINCR + if (ASI_NINCR(asi) > 1) + ASI_NINCR(asi) = ASI_NINCR(asi) + 1 + ASI_SHIFT(asi) = INDEFR + ASI_PIXFRAC(asi) = PIXFRAC + nconv = 2 * ASI_NSINC(asi) + 1 + call calloc (ASI_LTABLE(asi), nconv * ASI_NINCR(asi), + TY_REAL) + call ii_sinctable (Memr[ASI_LTABLE(asi)], nconv, ASI_NINCR(asi), + ASI_SHIFT(asi)) + case II_SINC: + ASI_NSINC(asi) = NSINC + ASI_NINCR(asi) = 0 + ASI_SHIFT(asi) = INDEFR + ASI_PIXFRAC(asi) = PIXFRAC + ASI_LTABLE(asi) = NULL + case II_DRIZZLE: + ASI_NSINC(asi) = 0 + ASI_NINCR(asi) = 0 + ASI_SHIFT(asi) = INDEFR + ASI_PIXFRAC(asi) = PIXFRAC + ASI_LTABLE(asi) = NULL + default: + ASI_NSINC(asi) = 0 + ASI_NINCR(asi) = 0 + ASI_SHIFT(asi) = INDEFR + ASI_PIXFRAC(asi) = PIXFRAC + ASI_LTABLE(asi) = NULL + } + ASI_BADVAL(asi) = BADVAL + ASI_COEFF(asi) = NULL + } + +end diff --git a/math/iminterp/asirestore.x b/math/iminterp/asirestore.x new file mode 100644 index 00000000..7c6c81d0 --- /dev/null +++ b/math/iminterp/asirestore.x @@ -0,0 +1,50 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "im1interpdef.h" +include + +# ASIRESTORE -- Procedure to restore the interpolant stored by ASISAVE +# for use by ASIEVAL, ASIVECTOR, ASIDER and ASIGRL. + +procedure asirestore (asi, interpolant) + +pointer asi # interpolant descriptor +real interpolant[ARB] # array containing the interpolant + +int interp_type, i, nconv +pointer cptr + +begin + interp_type = int (ASI_SAVETYPE(interpolant)) + if (interp_type < 1 || interp_type > II_NTYPES) + call error (0, "ASIRESTORE: Unknown interpolant type.") + + # Allocate the interpolant descriptor structure and restore + # interpolant parameters. + + call malloc (asi, LEN_ASISTRUCT, TY_STRUCT) + ASI_TYPE(asi) = interp_type + ASI_NSINC(asi) = nint (ASI_SAVENSINC(interpolant)) + ASI_NINCR(asi) = nint (ASI_SAVENINCR(interpolant)) + ASI_SHIFT(asi) = ASI_SAVESHIFT(interpolant) + ASI_PIXFRAC(asi) = ASI_SAVEPIXFRAC(interpolant) + ASI_NCOEFF(asi) = nint (ASI_SAVENCOEFF(interpolant)) + ASI_OFFSET(asi) = nint (ASI_SAVEOFFSET(interpolant)) + ASI_BADVAL(asi) = ASI_SAVEBADVAL(interpolant) + + # Allocate space for and restore coefficients. + call malloc (ASI_COEFF(asi), ASI_NCOEFF(asi), TY_REAL) + cptr = ASI_COEFF(asi) - 1 + do i = 1, ASI_NCOEFF(asi) + COEFF(cptr+i) = interpolant[ASI_SAVECOEFF+i] + + # Allocate space for and restore the look-up tables. + if (ASI_NINCR(asi) > 0) { + nconv = 2 * ASI_NSINC(asi) + 1 + call malloc (ASI_LTABLE(asi), nconv * ASI_NINCR(asi), TY_REAL) + cptr = ASI_LTABLE(asi) - 1 + do i = 1, nconv * ASI_NINCR(asi) + LTABLE(cptr+i) = interpolant[ASI_SAVECOEFF+ASI_NCOEFF(asi)+i] + } else + ASI_LTABLE(asi) = NULL +end diff --git a/math/iminterp/asisave.x b/math/iminterp/asisave.x new file mode 100644 index 00000000..6d6d83db --- /dev/null +++ b/math/iminterp/asisave.x @@ -0,0 +1,42 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "im1interpdef.h" +include + +# ASISAVE -- Procedure to save the interpolant for later use by ASIEVAL, +# ASIVECTOR, ASIDER and ASIGRL. + +procedure asisave (asi, interpolant) + +pointer asi # interpolant descriptor +real interpolant[ARB] # array containing the interpolant + +int i, nconv +pointer cptr + +begin + # Save the interpolant type, number of coefficients, and position of + # first data point. + + ASI_SAVETYPE(interpolant) = ASI_TYPE(asi) + ASI_SAVENSINC(interpolant) = ASI_NSINC(asi) + ASI_SAVENINCR(interpolant) = ASI_NINCR(asi) + ASI_SAVESHIFT(interpolant) = ASI_SHIFT(asi) + ASI_SAVEPIXFRAC(interpolant) = ASI_PIXFRAC(asi) + ASI_SAVENCOEFF(interpolant) = ASI_NCOEFF(asi) + ASI_SAVEOFFSET(interpolant) = ASI_OFFSET(asi) + ASI_SAVEBADVAL(interpolant) = ASI_BADVAL(asi) + + # Save the coefficients. + cptr = ASI_COEFF(asi) - 1 + do i = 1, ASI_NCOEFF(asi) + interpolant[ASI_SAVECOEFF+i] = COEFF(cptr+i) + + # Save the lookup-tables. + if (ASI_NINCR(asi) > 0) { + nconv = 2 * ASI_NSINC(asi) + 1 + cptr = ASI_LTABLE(asi) - 1 + do i = 1, nconv * ASI_NINCR(asi) + interpolant[ASI_SAVECOEFF+ASI_NCOEFF(asi)+i] = LTABLE(cptr+i) + } +end diff --git a/math/iminterp/asisinit.x b/math/iminterp/asisinit.x new file mode 100644 index 00000000..dc09ac0e --- /dev/null +++ b/math/iminterp/asisinit.x @@ -0,0 +1,64 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include +include "im1interpdef.h" + +# ASISINIT -- initialize the interpolant. This is a special entry point +# for the sinc interpolant although it will initialize the others too. + +procedure asisinit (asi, interp_type, nsinc, nincr, shift, badval) + +pointer asi # interpolant descriptor +int interp_type # interpolant type +int nsinc # sinc interpolant width +int nincr # number of sinc look-up table elements +real shift # sinc interpolant shift +real badval # drizzle bad pixel value + +int nconv + +begin + if (interp_type < 1 || interp_type > II_NTYPES) + call error (0, "ASISINIT: Illegal interpolant type") + else { + call calloc (asi, LEN_ASISTRUCT, TY_STRUCT) + ASI_TYPE(asi) = interp_type + switch (interp_type) { + case II_LSINC: + ASI_NSINC(asi) = (nsinc - 1) / 2 + ASI_NINCR(asi) = nincr + if (ASI_NINCR(asi) > 1) + ASI_NINCR(asi) = ASI_NINCR(asi) + 1 + if (nincr > 1) + ASI_SHIFT(asi) = INDEFR + else + ASI_SHIFT(asi) = shift + ASI_PIXFRAC(asi) = PIXFRAC + nconv = 2 * ASI_NSINC(asi) + 1 + call calloc (ASI_LTABLE(asi), nconv * ASI_NINCR(asi), + TY_REAL) + call ii_sinctable (Memr[ASI_LTABLE(asi)], nconv, ASI_NINCR(asi), + ASI_SHIFT(asi)) + case II_SINC: + ASI_NSINC(asi) = (nsinc - 1) / 2 + ASI_NINCR(asi) = 0 + ASI_SHIFT(asi) = INDEFR + ASI_PIXFRAC(asi) = PIXFRAC + ASI_LTABLE(asi) = NULL + case II_DRIZZLE: + ASI_NSINC(asi) = 0 + ASI_NINCR(asi) = 0 + ASI_SHIFT(asi) = INDEFR + ASI_PIXFRAC(asi) = max (MIN_PIXFRAC, min (shift, 1.0)) + ASI_LTABLE(asi) = NULL + default: + ASI_NSINC(asi) = 0 + ASI_NINCR(asi) = 0 + ASI_SHIFT(asi) = INDEFR + ASI_PIXFRAC(asi) = PIXFRAC + ASI_LTABLE(asi) = NULL + } + ASI_COEFF(asi) = NULL + ASI_BADVAL(asi) = badval + } +end diff --git a/math/iminterp/asitype.x b/math/iminterp/asitype.x new file mode 100644 index 00000000..708ebf58 --- /dev/null +++ b/math/iminterp/asitype.x @@ -0,0 +1,90 @@ +include "im1interpdef.h" +include + +# ASITYPE -- Decode the interpolation string input by the user. + +procedure asitype (interpstr, interp_type, nsinc, nincr, shift) + +char interpstr[ARB] # the input interpolation string +int interp_type # the interpolation type +int nsinc # the sinc interpolation width +int nincr # the sinc interpolation lut resolution +real shift # the predefined shift or pixfrac + +int ip +pointer sp, str +int strdic(), strncmp(), ctoi(), ctor() + +begin + call smark (sp) + call salloc (str, SZ_FNAME, TY_CHAR) + interp_type = strdic (interpstr, Memc[str], SZ_FNAME, II_FUNCTIONS) + + if (interp_type > 0) { + switch (interp_type) { + case II_LSINC: + nsinc = 2 * NSINC + 1 + nincr = NINCR + shift = INDEFR + case II_SINC: + nsinc = 2 * NSINC + 1 + nincr = 0 + shift = INDEFR + case II_DRIZZLE: + nsinc = 0 + nincr = 0 + shift = PIXFRAC + default: + nsinc = 0 + nincr = 0 + shift = INDEFR + } + } else if (strncmp (interpstr, "lsinc", 5) == 0) { + interp_type = II_LSINC + ip = 6 + if (ctoi (interpstr, ip, nsinc) <= 0) { + nsinc = 2 * NSINC + 1 + nincr = NINCR + shift = INDEFR + } else { + if (interpstr[ip] == '[') + ip = ip + 1 + if (ctor (interpstr, ip, shift) <= 0) + shift = INDEFR + if (IS_INDEFR(shift) || interpstr[ip] != ']') { + nincr = NINCR + shift = INDEFR + } else if (shift >= -0.5 && shift < 0.5) { + nincr = 1 + } else { + nincr = nint (shift) + shift = INDEFR + } + } + } else if (strncmp (interpstr, "sinc", 4) == 0) { + ip = 5 + interp_type = II_SINC + if (ctoi (interpstr, ip, nsinc) <= 0) + nsinc = 2 * NSINC + 1 + nincr = 0 + shift = INDEFR + } else if (strncmp (interpstr, "drizzle", 7) == 0) { + ip = 8 + if (interpstr[ip] == '[') + ip = ip + 1 + if (ctor (interpstr, ip, shift) <= 0) + shift = PIXFRAC + interp_type = II_DRIZZLE + nsinc = 0 + nincr = 0 + if (interpstr[ip] != ']') + shift = PIXFRAC + } else { + interp_type = 0 + nsinc = 0 + nincr = 0 + shift = INDEFR + } + + call sfree (sp) +end diff --git a/math/iminterp/asivector.x b/math/iminterp/asivector.x new file mode 100644 index 00000000..153a751a --- /dev/null +++ b/math/iminterp/asivector.x @@ -0,0 +1,56 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include +include "im1interpdef.h" + +# ASIVECTOR -- Procedure to evaluate the interpolant at an array of ordered +# points assuming that all points land in 1 <= x <= npts. + +procedure asivector (asi, x, y, npix) + +pointer asi # interpolator descriptor +real x[ARB] # ordered x array +real y[ARB] # interpolated values +int npix # number of points in x + +begin + switch (ASI_TYPE(asi)) { + + case II_NEAREST: + call ii_nearest (x, y, npix, + COEFF(ASI_COEFF(asi) + ASI_OFFSET(asi))) + + case II_LINEAR: + call ii_linear (x, y, npix, COEFF(ASI_COEFF(asi) + ASI_OFFSET(asi))) + + case II_POLY3: + call ii_poly3 (x, y, npix, COEFF(ASI_COEFF(asi) + ASI_OFFSET(asi))) + + case II_POLY5: + call ii_poly5 (x, y, npix, COEFF(ASI_COEFF(asi) + ASI_OFFSET(asi))) + + case II_SPLINE3: + call ii_spline3 (x, y, npix, COEFF(ASI_COEFF(asi) + + ASI_OFFSET(asi))) + + case II_SINC: + call ii_sinc (x, y, npix, COEFF(ASI_COEFF(asi) + ASI_OFFSET(asi)), + ASI_NCOEFF(asi), ASI_NSINC(asi), DX) + + case II_LSINC: + call ii_lsinc (x, y, npix, COEFF(ASI_COEFF(asi) + ASI_OFFSET(asi)), + ASI_NCOEFF(asi), LTABLE(ASI_LTABLE(asi)), + 2 * ASI_NSINC(asi) + 1, ASI_NINCR(asi), DX) + + case II_DRIZZLE: + if (ASI_PIXFRAC(asi) >= 1.0) + call ii_driz1 (x, y, npix, COEFF(ASI_COEFF(asi) + + ASI_OFFSET(asi)), ASI_BADVAL(asi)) + else + call ii_driz (x, y, npix, COEFF(ASI_COEFF(asi) + + ASI_OFFSET(asi)), ASI_PIXFRAC(asi), ASI_BADVAL(asi)) + + default: + call error (0, "ASIVECTOR: Unknown interpolator type.") + } +end diff --git a/math/iminterp/doc/arbpix.hlp b/math/iminterp/doc/arbpix.hlp new file mode 100644 index 00000000..0d7ec9ec --- /dev/null +++ b/math/iminterp/doc/arbpix.hlp @@ -0,0 +1,57 @@ +.help arbpix Dec98 "Image Interpolator Package" +.ih +NAME +arbpix -- replace INDEF valued pixels with interpolated values +.ih +SYNOPSIS +include + +arbpix (datain, dataout, npix, interp_type, boundary_type) + +.nf + real datain[npix] #I input data + real dataout[npix] #O output array, dataout != datain + int npix #I number of data points + int interp_type #I type of interpolant + int boundary_type #I type of boundary condition +.fi +.ih +ARGUMENTS +.ls datain +Array of input data containing 0 or more INDEF valued pixels. +.le +.ls dataout +Array of output data with INDEFS replaced by interpolated values. +The dataout array must be different from the datain array. +.le +.ls npix +Number of data points. +.le +.ls interp_type +Type of interpolant. Options are II_NEAREST, II_LINEAR, II_POLY3, II_POLY5, +II_SPLINE3, II_SINC / II_LSINC, and II_DRIZZLE. The look-up table sinc +interpolant is not supported, and defaults to the sinc interpolant. +The sinc interpolant width is 31 pixels. The drizzle interpolant is not +supported and defaults to the linear interpolant. The interpolant type +definitions are stored in the file math/iminterp.h. +.le +.ls boundary_type +Type of boundary extension. The only supported option is II_BOUNDARYEXT. +Polynomial interpolants of lower order are used if there are not enough +good pixels to define the requested interpolant. Nearest neighbor boundary +extension is used if there are not enough good points to define the sinc +interpolant. The boundary type definitions are stored in the header file +math/iminterp.h. +.le +.ih +DESCRIPTION +If there are no good points in datain, ARBPIX returns INDEFS in dataout. +Points below and above the first and last good point are replaced by the +first and last good point values respectively. +.ih +NOTES +The sinc function actually evaluates the interpolant by computing the +average of two interpolations at +-0.05 pixels about the bad pixel since +the interpolant is undefined exactly at a pixel. +.ih +SEE ALSO diff --git a/math/iminterp/doc/arider.hlp b/math/iminterp/doc/arider.hlp new file mode 100644 index 00000000..b8631eaa --- /dev/null +++ b/math/iminterp/doc/arider.hlp @@ -0,0 +1,59 @@ +.help arider Dec98 "Image Interpolator Package" +.ih +NAME +arider -- calculate the interpolant derivatives at x +.ih +SYNOPSIS +include + +arider (x, datain, npix, der, nder, interp_type) + +.nf + real x[2] #I x value, 1 <= x[1-2] <= npts + real datain[npix] #I array of data points + int npix #I number of data points + real der[nder] #O derivatives, der[1] = function value + int nder #I number of derivatives, 1 + max order + int interp_type #I interpolant type +.fi +.ih +ARGUMENTS +.ls x +Single X value, or pair of X values defining a range in the case of the +drizzle interpolant. +.le +.ls datain +Array of data values. +.le +.ls npix +Number of data points. +.le +.ls der +Array of derivatives. Der[1] contains the function value, der[2] the +first derivative, and so on. +.le +.ls nder +Number of derivatives. ARIDER checks that the requested number of derivatives +is sensible. The sinc interpolant returns the function value and the first +two derivatives. The drizzle interpolant returns the function and the first +derivative. +.le +.ls interp_type +Interpolant type. The options are II_NEAREST, II_LINEAR, II_POLY3, II_POLY5, +II_SPLINE3, II_SINC / II_LSINC, and II_DRIZZLE. The look-up table sinc +is not supported and defaults to sinc. The sinc interpolant width is 31 pixels. +The drizzle pixel fraction is 1.0. The interpolant type definitions are found +in the package header file math/iminterp.h. +.le +.ih +DESCRIPTION +ARIDER permits the evaluation of the interpolant at a few randomly spaced +points within datain without the storage requirements of the sequential +version. +.ih +NOTES +Checking for INDEF valued or out of bounds pixels is the responsibility +of the user. +.ih +SEE ALSO +asider diff --git a/math/iminterp/doc/arieval.hlp b/math/iminterp/doc/arieval.hlp new file mode 100644 index 00000000..52c62148 --- /dev/null +++ b/math/iminterp/doc/arieval.hlp @@ -0,0 +1,48 @@ +.help arieval Dec98 "Image Interpolator Package" +.ih +NAME +arieval -- evaluate the interpolant at x +.ih +SYNOPSIS +include + +y = arieval (x, datain, npix, interp_type) + +.nf + real x[2] #I x value, 1 <= x[1-2] <= npix + real datain[npix] #I data values + int npix #I number of data values + int interp_type #I interpolant type +.fi +.ih +ARGUMENTS +.ls x +Single X value, or a pair of X values specifying a range in the case +of the drizzle interpolant. +.le +.ls datain +Array of input data. +.le +.ls npix +Number of data points. +.le +.ls interp_type +Interpolant type. Options are II_NEAREST, II_LINEAR, II_POLY3, II_POLY5, +II_SPLINE3, II_SINC / II_LSINC, and II_DRIZZLE, for nearest neighbor, +linear, 3rd and fifth order polynomials, cubic spline, sinc, look-up +table sinc, and drizzle interpolants respectively. The look-up table sinc +interpolant is not supported and defaults to the sinc interpolant. The sinc +width is 31 pixels. The drizzle pixel fraction is 1.0. The interpolant +type definitions are contained in the package header file math/iminterp.h +.le +.ih +DESCRIPTION +ARIEVAL allows the evaluation of a few interpolated points without the +storage required for the sequential interpolant. +.ih +NOTES +Checking for out of bounds and INDEF valued pixels is the responsibility of +the user. +.ih +SEE ALSO +arider, asieval, asivector diff --git a/math/iminterp/doc/asider.hlp b/math/iminterp/doc/asider.hlp new file mode 100644 index 00000000..0c27ffbc --- /dev/null +++ b/math/iminterp/doc/asider.hlp @@ -0,0 +1,52 @@ +.help asider Dec98 "Image Interpolator Package" +.ih +NAME +asider -- evaluate the interpolant derivatives at x +.ih +SYNOPSIS +asider (asi, x, der, nder) + +.nf + pointer asi #I interpolant descriptor + real x[2] #I x value, 1 <= x[1-2] <= npix + real der[] #O der[1] = interpolant, der[2] = 1st derivative + int nder #I number of derivatives +.fi +.ih +ARGUMENTS +.ls asi +Pointer to the sequential interpolant descriptor. +.le +.ls x +Single X value, or pair of X values defining a range in the case of +the drizzle interpolant. +.le +.ls der +Array containing the derivatives. Der[1] = interpolant at x, der[2] the +first derivative of the interpolant at x and so on. +.le +.ls nder +Number of derivatives. Nder = 1 + order of the maximum desired derivative. +ASIDER checks that nder is reasonable. The sinc interpolant returns the +interpolant value and first two derivatives. The drizzle interpolant returns +the interpolant value and the first derivative. +.le +.ih +DESCRIPTION +The polynomial coefficients are evaluated directly from the data points +for the polynomial interpolants and from the B-spline coefficients +for the cubic spline interpolant. The derivatives are evaluated from +the polynomial coefficients using nested multiplication. The sinc +derivatives are analytic but are defined only for the first two derivatives. +The drizzle derivative is an approximation defined for the first derivative +only. +.ih +NOTES +ASIDER checks that the number of derivatives requested is reasonable. +Checking for out of bounds and INDEF valued pixels is the responsibility +of the user. ASIINIT or ASISINIT and ASIFIT must be called before ASIDER +is called. +.ih +SEE ALSO +asieval, asivector, arieval, arider +.endhelp diff --git a/math/iminterp/doc/asieval.hlp b/math/iminterp/doc/asieval.hlp new file mode 100644 index 00000000..20f70abe --- /dev/null +++ b/math/iminterp/doc/asieval.hlp @@ -0,0 +1,44 @@ +.help asieval Dec98 "Image Interpolator Package" +.ih +NAME +asieval -- procedure to evaluate interpolant at x +.ih +SYNOPSIS +y = asieval (asi, x) + +.nf + pointer asi #I interpolant descriptor + real x[2] #I x value, 1 <= x[1-2] <= npts +.fi +.ih +ARGUMENTS +.ls asi +Pointer to the sequential interpolant descriptor structure. +.le +.ls x +Single X value, or pair of X values defining a range in the case of the +drizzle interpolant. +.le +.ih +DESCRIPTION +The polynomial coefficients are calculated directly from the data points +for the polynomial interpolants, and from the B-spline coefficients for +the cubic spline interpolant. The actual calculation is done by adding and +multiplying terms according to Everett's central difference interpolation +formula. The boundary extension algorithm is projection. + +The sinc interpolant is computed using a range of data points around +the desired position. Look-up table sinc interpolation is computed +using the most appropriate entry in a precomputed look-up table. +The boundary extension algorithm is nearest neighbor. + +The drizzle interpolant is computed by summing the data over the user +supplied X interval. +.ih +NOTES +Checking for out of bounds and INDEF valued pixels is the responsibility of +the user. ASIINIT or ASISINIT and ASIFIT must be called before using ASIEVAL. +.ih +SEE ALSO +asivector, arieval +.endhelp diff --git a/math/iminterp/doc/asifit.hlp b/math/iminterp/doc/asifit.hlp new file mode 100644 index 00000000..bcd1fdc8 --- /dev/null +++ b/math/iminterp/doc/asifit.hlp @@ -0,0 +1,40 @@ +.help asifit Dec98 "Image Interpolator Package" +.ih +NAME +asifit - fit the interpolant to data +.ih +SYNOPSIS +asifit (asi, datain, npix) + +.nf + pointer asi #I interpolant descriptor + real datain[npix] #I input data + int npix #I the number of data points +.fi +.ih +ARGUMENTS +.ls asi +Pointer to sequential interpolant descriptor structure. +.le +.ls datain +Array of input data. +.le +.ls npix +Number of data points. +.le +.ih +DESCRIPTION +The datain array is checked for size, memory is allocated for the coefficient +array, and the end conditions are specified. The interior polynomial, sinc and +drizzle interpolants are saved as the data points. The polynomial coefficients +are calculated directly from the data points in the evaluation stage. The +B-spline coefficients are calculated in ASIFIT as they depend on the entire +data array. +.ih +NOTES +Checking for INDEF valued and out of bounds pixels is the responsibility +of the user. ASIINIT or ASISINIT and ASIFIT must be called before using +ASIEVAL, ASIVECTOR, ASIDER or ASIGRL. +.ih +SEE ALSO +.endhelp diff --git a/math/iminterp/doc/asifree.hlp b/math/iminterp/doc/asifree.hlp new file mode 100644 index 00000000..c61f2ce0 --- /dev/null +++ b/math/iminterp/doc/asifree.hlp @@ -0,0 +1,25 @@ +.help asifree Dec98 "Image Interpolator Package" +.ih +NAME +asifree - free sequential interpolant descriptor +.ih +SYNOPSIS +asifree (asi) + +.nf +pointer asi #U interpolant descriptor +.fi +.ih +ARGUMENTS +.ls asi +Pointer to the sequential interpolant descriptor structure. +.le +.ih +DESCRIPTION +ASIFREE frees the sequential interpolant descriptor structure allocated by +ASIINIT or ASISINIT. ASIFREE should be called when interpolation is complete. +.ih +NOTES +.ih +SEE ALSO +asiinit, asisinit diff --git a/math/iminterp/doc/asigeti.hlp b/math/iminterp/doc/asigeti.hlp new file mode 100644 index 00000000..0e9d1964 --- /dev/null +++ b/math/iminterp/doc/asigeti.hlp @@ -0,0 +1,36 @@ +.help asigeti Dec98 asigeti.hlp +.ih +NAME +asigeti -- fetch an asi integer parameter +.ih +SYNOPSIS +include + +value = asigeti (asi, param) + +.nf + pointer asi #I interpolant descriptor + int param #I parameter +.fi +.ih +ARGUMENTS +.ls asi +Pointer to the sequential interpolant descriptor structure. +.le +.ls param +The parameter to be fetched. The choices are: II_ASITYPE the interpolant +type, II_ASINSAVE the length of the saved coefficient array, and +II_ASINSINC the half-width of the sinc interpolant. The parameter +definitions are contained in the package header file math/iminterp.h. +.le +.ih +DESCRIPTION +ASIGETI is used to determine the size of the coefficient array that +must be allocated to save the sequential interpolant description structure, +and to fetch selected sequential interpolant parameters. +.ih +NOTES +.ih +SEE ALSO +asiinit, asisinit, asigetr +.endhelp diff --git a/math/iminterp/doc/asigetr.hlp b/math/iminterp/doc/asigetr.hlp new file mode 100644 index 00000000..8a31deef --- /dev/null +++ b/math/iminterp/doc/asigetr.hlp @@ -0,0 +1,36 @@ +.help asigetr Dec98 asigetr.hlp +.ih +NAME +asigetr -- fetch an asi integer parameter +.ih +SYNOPSIS +include + +value = asigetr (asi, param) + +.nf + pointer asi #I interpolant descriptor + int param #I parameter +.fi +.ih +ARGUMENTS +.ls asi +Pointer to the sequential interpolant descriptor structure. +.le +.ls param +The parameter to be fetched. The choices are: II_ASIBADVAL the undefined +pixel value for the drizzle interpolant. The parameter definitions are +contained in the package header file math/iminterp.h. +.le +.ih +DESCRIPTION +ASIGETR is used to set the value of undefined drizzle interpolant pixels. +Undefined pixels are those for which the interpolation coordinates do not +overlap the input coordinates, but are still, within the boundaries of the input +image, a situation which may occur when the pixel fraction is < 1.0. +.ih +NOTES +.ih +SEE ALSO +asiinit, asisinit, asigeti +.endhelp diff --git a/math/iminterp/doc/asigrl.hlp b/math/iminterp/doc/asigrl.hlp new file mode 100644 index 00000000..4c3087bb --- /dev/null +++ b/math/iminterp/doc/asigrl.hlp @@ -0,0 +1,40 @@ +.help asigrl Dec98 "Image Interpolator Package" +.ih +NAME +asigrl -- integrate interpolant from a to b +.ih +SYNOPSIS +integral = asigrl (asi, a, b) + +.nf + pointer asi #I interpolant descriptor + real a #I lower limit for integral, 1 <= a <= npix + real b #I upper limit for integral, 1 <= b <= npix +.fi +.ih +ARGUMENTS +.ls asi +Pointer to the sequential interpolant descriptor structure. +.le +.ls a +Lower limit to the integral, where 1 <= a <= npix. +.le +.ls b +Upper limit to the integral, where 1 <= b <= npix. +.le +.ih +DESCRIPTION +The integral is calculated assuming that the interior polynomial, sinc, and +drizzle interpolants are stored as the data points, and that the spline +interpolant is stored as an array of B-spline coefficients. + +The integral of the sinc interpolant is computed by dividing the integration +interval into a number of equal size subintervals which are at most one pixel +wide. The integral of each subinterval is the central value times the interval +width. The look-up table sinc interpolant is not supported and defaults to +the sinc interpolant. +.ih +NOTES +ASIINIT or ASISINIT and ASIFIT must be called before using ASIGRL. +.ih +SEE ALSO diff --git a/math/iminterp/doc/asiinit.hlp b/math/iminterp/doc/asiinit.hlp new file mode 100644 index 00000000..711d7969 --- /dev/null +++ b/math/iminterp/doc/asiinit.hlp @@ -0,0 +1,39 @@ +.help asiinit Dec98 "Image Interpolator Package" +.ih +NAME +asiinit -- initialize the sequential interpolant descriptor using default parameters +.ih +SYNOPSIS +include + +asiinit (asi, interp_type) + +.nf + pointer asi #O interpolant descriptor + int interp_type #I interpolant type +.fi + +.ih +ARGUMENTS +.ls asi +Pointer to sequential interpolant descriptor. +.le +.ls interp_type +Interpolant type. The options are II_NEAREST, II_LINEAR, II_POLY3, II_POLY5, +II_SPLINE3, II_SINC, II_LSINC, and II_DRIZZLE for nearest neighbor, linear, +3rd order polynomial, 5th order polynomial, cubic spline, sinc, look-up +table sinc, and drizzle respectively. The interpolant type definitions are +found in the package header file math/iminterp.h. +.le +.ih +DESCRIPTION +The interpolant descriptor is allocated and initialized. The pointer asi is +returned by ASIINIT. The sinc interpolant width defaults to 31 pixels. The +look-up table sinc interpolant resolution defaults to 20 intervals or +0.05 pixels. The drizzle pixel fraction defaults to 1.0. +.ih +NOTES +ASIINIT or ASISINIT must be called before using any other ASI routines. +.ih +SEE ALSO +asisinit, asifree diff --git a/math/iminterp/doc/asirestore.hlp b/math/iminterp/doc/asirestore.hlp new file mode 100644 index 00000000..6dd70262 --- /dev/null +++ b/math/iminterp/doc/asirestore.hlp @@ -0,0 +1,36 @@ +.help asirestore Dec98 "Image Interpolator Package" +.ih +NAME +asirestore -- restore interpolant +.ih +SYNOPSIS +asirestore (asi, interpolant) + +.nf + pointer asi #O interpolant descriptor + real interpolant[] #I array containing interpolant +.fi +.ih +ARGUMENTS +.ls asi +Pointer to the interpolant descriptor structure. +.le +.ls interpolant +Array containing the interpolant. The length of interpolant can be determined +by a call to ASIGETI. +.le + +.nf + len_interpolant = asigeti (asi, II_ASINSAVE) +.fi +.ih +DESCRIPTION +ASIRESTORE allocates space for the interpolant descriptor and restores the +parameters and coefficients stored in the interpolant array to a structure +for use with ASIEVAL, ASIVECTOR, ASIDER and ASIGRL. +.ih +NOTES +.ih +SEE ALSO +asisave +.endhelp diff --git a/math/iminterp/doc/asisave.hlp b/math/iminterp/doc/asisave.hlp new file mode 100644 index 00000000..7c8ff37a --- /dev/null +++ b/math/iminterp/doc/asisave.hlp @@ -0,0 +1,39 @@ +.help asisave Dec98 "Image Interpolator Package" +.ih +NAME +asisave -- save interpolant +.ih +SYNOPSIS +asisave (asi, interpolant) + +.nf + pointer asi #I interpolant descriptor + real interpolant[] #O array containing the interpolant +.fi +.ih +ARGUMENTS +.ls asi +Pointer to the interpolant descriptor structure. +.le +.ls interpolant +Array where the interpolant is stored. The size of interpolant can be +determined by a call to asigeti. +.le + +.nf + len_interpolant = asigeti (asi, II_ASINSAVE) +.fi +.ih +DESCRIPTION +The interpolant type, number of coefficients and the position of +the first data point in the coefficient array, along with various +parameters such as the sinc interpolant width, sinc look-up table +resolution, and drizzle pixel fraction, are stored in the first +7 elements of the interpolant array. The remaining elements contain +the coefficients calculated by ASIFIT. +.ih +NOTES +.ih +SEE ALSO +asirestore +.endhelp diff --git a/math/iminterp/doc/asisinit.hlp b/math/iminterp/doc/asisinit.hlp new file mode 100644 index 00000000..1ec9bc4e --- /dev/null +++ b/math/iminterp/doc/asisinit.hlp @@ -0,0 +1,60 @@ +.help asisinit Dec98 "Image Interpolator Package" +.ih +NAME +asisinit -- initialize the sequential interpolant descriptor using user parameters +.ih +SYNOPSIS +include + +asisinit (asi, interp_type, nsinc, nincr, rparam, badval) + +.nf + pointer asi #O interpolant descriptor + int interp_type #I interpolant type + int nsinc #I sinc interpolant width in pixels + int nincr #I sinc look-up table resolution + real pixfrac #I sinc shift or drizzle pixel fraction + real badval #I drizzle undefined pixel value +.fi + +.ih +ARGUMENTS +.ls asi +Pointer to sequential interpolant descriptor. +.le +.ls interp_type +Interpolant type. The options are II_NEAREST, II_LINEAR, II_POLY3, II_POLY5, +II_SPLINE3, II_SINC, II_LSINC, and II_DRIZZLE for the nearest neighbour, linear, +3rd order polynomial, 5th order polynomial, cubic spline, sinc, look-up +table sinc, and drizzle interpolants respectively. The interpolant type +definitions are found in the package header file math/iminterp.h. +.le +.ls nsinc +The sinc and look-up table sinc interpolant width in pixels. Nsinc is +rounded up internally to the nearest odd number. +.le +.ls nincr +The look-up table sinc resolution in number of entries. Nincr = 10 implies +a pixel resolution of 0.1 pixels, nincr = 20 a pixel resolution of 0.05 +pixels, etc. +.le +.ls pixfrac +The look-up table sinc fractional pixel shift if nincr = 1 in which case +-0.5 <= pixfrac <= 0.5 , or the drizzle pixel fraction in which case +0.0 <= pixfrac <= 1.0. A minimum value of 0.001 is imposed on pixfrac. +.le +.ls badval +The undefined pixel value for the drizzle interpolant. Pixels within +the boundaries of the input image which do not overlap the input image +pixels are assigned a value of badval. +.le +.ih +DESCRIPTION +The interpolant descriptor is allocated and initialized. The pointer asi is +returned by ASISINIT. +.ih +NOTES +ASIINIT or ASISINIT must be called before using any other ASI routines. +.ih +SEE ALSO +asisinit, asifree diff --git a/math/iminterp/doc/asitype.hlp b/math/iminterp/doc/asitype.hlp new file mode 100644 index 00000000..d8c78b44 --- /dev/null +++ b/math/iminterp/doc/asitype.hlp @@ -0,0 +1,95 @@ +.help asitype Dec98 "Image Interpolator Package" +.ih +NAME +asitype -- decode an interpolant string +.ih +SYNOPSIS +include + +asitype (interpstr, interp_type, nsinc, nincr, rparam) + +.nf + char interpstr #I the input interpolant string + int interp_type #O interpolant type + int nsinc #O sinc interpolant width in pixels + int nincr #O sinc look-up table resolution + real rparam #O sinc or drizzle pixel fraction +.fi + +.ih +ARGUMENTS +.ls interpstr +The user supplied interpolant string to be decoded. The options are +.ls nearest +Nearest neighbor interpolation. +.le +.ls linear +Linear interpolation +.le +.ls poly3 +Cubic polynomial interpolation. +.le +.ls poly5 +Quintic polynomial interpolation. +.le +.ls spline3 +Cubic spline interpolation. +.le +.ls sinc +Sinc interpolation. Users can specify the sinc interpolant width by +appending a width value to the interpolant string, e.g. sinc51 specifies +a 51 pixel wide sinc interpolant. The sinc width will be rounded up to +the nearest odd number. The default sinc width is 31. +.le +.ls lsinc +Look-up table sinc interpolation. Users can specify the look-up table sinc +interpolant width by appending a width value to the interpolant string, e.g. +lsinc51 specifies a 51 pixel wide look-up table sinc interpolant. The user +supplied sinc width will be rounded up to the nearest odd number. The default +sinc width is 31 pixels. Users can specify the resolution of the sinc lookup +up table by appending the look-up table size in square brackets to the +interpolant string, e.g. lsinc51[20] specifies a 20 element sinc look-up +table interpolant with a pixel resolution of 0.05 pixels. The default +look-up table size and resolution are 20 and 0.05 pixels respectively. +The fractional pixel shift for a 1 element look-up table sinc may be +specified by replacing the number of lookup-table elements with the fractional +shift, e.g. sinc51[0.5] will precompute a lookup table for a 0.5 pixel shift. +.le +.ls drizzle +Drizzle interpolation. Users can specify the drizzle pixel fraction by +appending the pixel fraction value to the interpolant string in square +brackets, e.g. drizzle[0.5] specifies a pixel fraction of 0.5. +The default pixel fraction is 1.0. +.le +.le +.ls interp_type +The output interpolant type. The options are II_NEAREST, II_LINEAR, II_POLY3, +II_POLY5, II_SPLINE3, II_SINC, II_LSINC, and II_DRIZZLE for the nearest +neighbor, linear, 3rd order polynomial, 5th order polynomial, cubic spline, +sinc, look-up table sinc, and drizzle interpolants respectively. The +interpolant type definitions are found in the package header file +math/iminterp.h. +.le +.ls nsinc +The output sinc and look-up table sinc interpolant width in pixels. The +default value is 31 pixels. +.le +.ls nincr +The output sinc look-up table size. Nincr = 10 implies a pixel resolution +of 0.1 pixels, nincr = 20 a pixel resolution of 0.05 pixels, etc. The +default value of nincr is 20. +.le +.ls rparam +The output look-up table sinc fractional pixel shift if nincr = 1 in which case +-0.5 <= rparam <= 0.5 , or the drizzle pixel fraction in which case +0.0 <= rparam <= 1.0. +.le +.ih +DESCRIPTION +The interpolant string is decoded into values suitable for the ASISINIT +or ASIINIT routines. +.ih +NOTES +.ih +SEE ALSO +asinit, asisinit, asifree diff --git a/math/iminterp/doc/asivector.hlp b/math/iminterp/doc/asivector.hlp new file mode 100644 index 00000000..95bac138 --- /dev/null +++ b/math/iminterp/doc/asivector.hlp @@ -0,0 +1,52 @@ +.help asivector Dec98 "Image Interpolator Package" +.ih +NAME +asivector -- evaluate the interpolant +.ih +SYNOPSIS +asivector (asi, x, y, npix) + +.nf + pointer asi #I interpolator descriptor + real x[npix/2*npix] #I x array, 1 <= x[i] <= npix + real y[npix] #O array of interpolated values + int npix #I number of x values +.fi +.ih +ARGUMENTS +.ls asi +Pointer to the sequential interpolator descriptor structure. +.le +.ls x +Array of npix x values, or array of npix x ranges if the interpolant is +drizzle. +.le +.ls y +Array of interpolated values. +.le +.ls npix +The number of x values. +.le +.ih +DESCRIPTION +The polynomial coefficients are calculated directly from the data points +for the polynomial interpolants, and from the B-spline coefficients for +the cubic spline interpolant. The actual calculation is done by adding and +multiplying terms according to Everett's central difference interpolation +formula. The boundary extension algorithm is projection. + +The sinc interpolant is computed using a range of data points around +the desired position. Look-up table sinc interpolation is computed +using the most appropriate entry in a precomputed look-up table. +The boundary extension algorithm is nearest neighbor. + +The drizzle interpolant is computed by summing the data over the user +supplied X intervals. +.ih +NOTES +Checking for out of bounds and INDEF valued pixels is the responsibility of the +user. ASIINIT or ASISINIT and ASIFIT must be called before calling ASIVECTOR. +.ih +SEE ALSO +asieval, asider, arieval, arider +.endhelp diff --git a/math/iminterp/doc/im1dinterp.spc b/math/iminterp/doc/im1dinterp.spc new file mode 100644 index 00000000..ce5b8680 --- /dev/null +++ b/math/iminterp/doc/im1dinterp.spc @@ -0,0 +1,525 @@ +.help iminterp Jul84 "Math Package" + +.ce +Specifications for the Image Interpolator Package +.ce +Lindsey Davis +.ce +Vesa Junkkarinen +.ce +August 1984 + +.sh +1. Introduction + + One of the most common operations in image processing is +interpolation in a data array. Due to the large amount of data involved, +efficiency is highly important. The advantage of having locally written +interpolators, includes the ability to optimize for uniformly spaced data +and the possibility of adding features that are useful to the final +application. + +.sh +2. Requirements + +.ls (1) +The package shall take as input a one-dimensional array containing image +data. The pixels are assumed to be equally spaced along a line. +The coordinates of a pixel are assumed to be +the same as the subscript of the pixel in the data array. +The coordinate of the first pixel in the array and the spacing between pixels +is assumed to be 1.0. All pixels are assumed to be good. +Checking for INDEF valued and out of bounds pixels is the responsibility of the +user. A routine to remove INDEF valued pixels from a data array shall be +included in the package. +.le +.ls (2) +The package is divided into array sequential interpolators and array +random interpolators. The sequential interpolators have been optimized +for returning many values as is the case when an array is shifted, or +oversampled at many points in order to produce a +smooth plot. +The random interpolators allow the evaluation of a few interpolated +points without the computing time and storage overhead required for +setting up the sequential version. +.le +.ls (3) +The quality of the interpolant will be set at run time. The options are: + +.nf + II_NEAREST - nearest neighbour + II_LINEAR - linear interpolation + II_POLY3 - 3rd order divided differences + II_POLY5 - 5th order divided differences + II_SPLINE3 - cubic spline +.fi + +The calling sequences shall be invariant to the interpolant selected. +Routines should be designed so that new interpolants can be added +with minimal changes to the code and no change to the calling sequences. +.le +.ls (4) +The interpolant parameters and the arrays necessary to store the coefficients +are stored in a structure referenced by a pointer. The pointer is returned +to the user program by the initial call to ASIINIT or ASIRESTORE and freed +by a call to ASIFREE (see section 3.1). +.le +.ls (5) +The package routines shall be able to: +.ls o +Calculate the coefficients of the interpolant and store these coefficients in +the appropriate part of the interpolant descriptor structure. +.le +.ls o +Evaluate the interplant at a given x(s) coordinate(s). +.le +.ls o +Calculate the derivatives of the interpolant at a given value of x. +.le +.ls o +Integrate the interpolant over a specified x interval. +.le +.ls o +Store the interpolant in a user supplied array. Restore the saved interpolant +to the interpolant descriptor structure for later use by ASIEVAL, ASIVECTOR, +ASIDER and ASIGRL. +.le + +.sh +3. Specifications + +.sh +3.1. The Array Sequential Interpolator Routines + + The package prefix is asi and the package routines are: + +.nf + asiinit (asi, interp_type) + asifit (asi, datain, npix) + y = asieval (asi, x) + asivector (asi, x, yfit, npix) + asider (asi, x, der, nder) + v = asigrl (asi, a, b) + asisave (asi, interpolant) + asirestore (asi, interpolant) + asifree (asi) +.fi + +.sh +3.2. The Array Random Interpolator Routines + + The package prefix is ari and the package routines are: + +.nf + y = arieval (x, datain, npix, interp_type) + arider (x, datain, npix, der, nder, interp_type) +.fi + +.sh +3.3. Miscellaneous + + A routine has been included in the package to remove INDEF valued +pixels from an array. + +.nf + arbpix (datain, dataout, npix, interp_type, boundary_type) +.fi + +.sh +3.4. Algorithms + +.sh +3.4.1. Coefficients + + The coefficient array used by the asi routines is calculated by ASIFIT. +ASIFIT accepts an array of data, checks that the number +of data points is appropriate for the interpolant selected, allocates +space for the interpolant, and calculates the coefficients. +Boundary coefficient values are calculated +using boundary projection. With the exception of the cubic spline interpolant, +the coefficients are stored as the data points. +The B-spline coefficients are +calculated using natural end conditions (Prenter 1975). +After a call to ASIFIT the coefficient array contains the following. + +.nf + case II_NEAREST: + + # no boundary conditions necessary + coeff[1] = datain[1] + . + . + . + coeff[npts] = datain[npix] + + case II_LINEAR: + + # coeff[npxix+1] required if x = npix + coeff[1] = datain[1] + . + . + . + coeff[npix] = datain[npix] + coeff[npix+1] = 2. * datain[npix] - datain[npix-1] + + case II_POLY3: + + # coeff[0] required if x = 1 + # coeff[npix+1], coeff[npix+2] required if x = npix + coeff[0] = 2. * datain[1] - datain[2] + coeff[1] = datain[1] + . + . + . + coeff[npix] = datain[npix] + coeff[npix+1] = 2. * datain[npix] - datain[npix-1] + coeff[npix+2] = 2. * datain[npix] - datain[npix-2] + + case II_POLY5: + + # coeff[1], coeff[0] reqired if x = 1 + # coeff[npix+1], coeff[npix+2], coeff[npix=3] + # required if x = npix + + coeff[-1] = 2. * datain[1] - datain[3] + coeff[0] = 2. * datain[1] - datain[2] + coeff[1] = datain[1] + . + . + . + coeff[npix] = datain[npix] + coeff[npix+1] = 2. * datain[npix] - datain[npix-1] + coeff[npix+2] = 2. * datain[npix] - datain[npix-2] + coeff[npix+3] = 2. * datain[npix] - datain[npix-3] + + case SPLINE3: + + # coeff[0] = 2nd der at x = 1, coeff[0] = 0. + # coeff[npix+1] = 2nd der at x = npts, coeff[npix+1] = 0. + # coeff[npix+2] = 0., required if x = npix + coeff[0] = b[1] + coeff[1] = b[2] + . + . + . + coeff[npix] = b[npix+1] + coeff[npix+1] = b[npix+2] + coeff[npix+2] = 0. +.fi + +.sh +3.4.2. Evaluation + + The ASIEVAL and ASIVECTOR routines have been optimized to be as efficient +as possible. The values of the II_NEAREST and II_LINEAR interpolants +are calculated directly. The II_SPLINE3 interpolant is evaluated using +polynomial coefficients calculated directly from the B-spline coefficients +(de Boor 1978). Values of the higher order polynomial interpolants +are calculated using central differences. The equations for each case are +listed below. + +.nf +case II_NEAREST: + + y = coeff[int (x + 0.5)] + +case II_LINEAR: + + nx = x + y = (x - nx) * coeff[nx+1] + (nx + 1 - x) * coeff[nx] + +case II_POLY3: + + nx = x + s = x - nx + t = 1. - s + + # second central differences + cd20 = 1./6. * (coeff[nx+1] - 2. * coeff[nx] + coeff[nx-1]) + cd21 = 1./6. * (coeff[nx+2] - 2. * coeff[nx+1] + coeff[nx]) + + y = s * (coeff[nx+1] + (s * s - 1.) * cd21) + t * (coeff[nx] + + (t * t - 1.) * cd20) + +case II_POLY5: + + nx = x + s = x - nx + t = 1. - s + + # second central differences + cd20 = 1./6. * (coeff[nx+1] - 2. * coeff[nx] + coeff[nx-1]) + cd21 = 1./6. * (coeff[nx+2] - 2. * coeff[nx+1] + coeff[nx]) + + # fourth central diffreences + cd40 = 1./120. * (coeff[nx-2] - 4. * coeff[nx-1] + 6. * coeff[nx] - 4. * + coeff[nx+1] + a[nx+2]) + cd41 = 1./120. * (coeff[nx-1] - 4. * coeff[nx] + 6. * coeff[nx+1] - 4. * + coeff[nx+2] + coeff[nx+3] + + y = s * (coeff[nx+1] + (s * s - 1.) * (cd21 + (s * s - 4.) * cd41)) + + t * (coeff[nx] + (t * t - 1.) * (cd20 + (t * t - 4.) * cd40)) + +case II_SPLINE3: + + nx = x + s = x - nx + + pc[1] = coeff[nx-1] + 4. * coeff[nx] + coeff[nx+1] + pc[2] = 3. * (coeff[nx+1] - coeff[nx-1]) + pc[3] = 3. * (coeff[nx-1] - 2. * coeff[nx] + coeff[nx+1]) + pc[4] = -coeff[nx-1] + 3. * coeff[nx] - 3. * coeff[nx+1] + coeff[nx+2] + + y = pc[1] + s * (pc[2] + s * (pc[3] + s * pc[4])) +.fi + + + The ARIEVAL routine uses the expressions above to evaluate the +interpolant. However unlike ASIEVAL, ARIEVAL does not use a previously +calculated coefficient array. Instead ARIEVAL selects the appropriate +portion of the data array, calculates the coefficients and boundary +coefficients if necessary, and evaluates the interpolant at the time it +is called. The cubic spline interpolant uses at most SPLTS (currently 16) +data points to calculate the B-spline coefficients. + +.sh +3.4.3. Derivatives + + Derivatives of the interpolant are calculated by evaluating the +derivatives of the interpolating polynomial. For all interpolants der[1] +equals the value of the interpolant at x. +For the sake of efficiency the derivatives +of the II_NEAREST and II_LINEAR interpolants are calculated directly. + +.nf + case II_NEAREST: + + der[1] = coeff[int (x+0.5)] + + case II_LINEAR: + + der[1] = (x - nx) * coeff [nx+1] + (nx + 1 - x) * coeff[nx] + der[2] = coeff[nx+1] - coeff[nx] +.fi + + In order to calculate the derivatives of the cubic spline and +polynomial interpolants +the coefficients of the interpolating polynomial must be calculated. +The polynomial +coefficients for the cubic spline interpolant are computed directly from the +B-spline coefficients (see 3.4.2.). The higher order polynomial +interpolant coefficients are calculated as follows. + +First the appropriate portion of the coefficient array is loaded. + +.nf + do i = 1, nterms + d[i] = coeff[nx - nterms/2 + i] +.fi + +Next the divided differences are calculated (Conte and de Boor 1972). + +.nf + do k = 1, nterms - 1 + do i = 1, nterms - k + d[i] = (d[i+1] - d[i]) / k +.fi + +The d[i] are the coefficients of an interpolating polynomial of the +following form. The x[i] are the nterms data points surrounding the +point of interest. + +.nf + p(x) = d[1] * (x-x[1]) * ... * (x-x[nterms-1) + + d[2] * (x-x[2]) * ... * (x-x[nterms-1]) + ... + d[nterms] +.fi + +Next a new set of polynomial coefficients are calculated +(Conte and de Boor 1972). + +.nf + do k = nterms, 2, -1 + do i = 2, k + d[i] = d[i] + d[i-1] * (k - i - nterms/2) +.fi + +The new d[i] are the coefficients of the follwoing polynomial. + +.nf + nx = x + p(x) = d[1] * (x-nx) ** (nterms-1) + d[2] * (x-nx) ** (nterms-2) + ... + d[nterms] +.fi + +The d[i] array is flipped. The value and derivatives +of the interpolant are then calculated using the d[i] array and +nested multiplication. + +.nf + s = x - nx + + do k = 1, nder { + + accum = d[nterms-k+1] + + do j = nterms - k, 1, -1 + accum = d[j] + s * accum + + der[k] = accum + + # differnetiate + do j = 1, nterms - k + d[j] = j * d[j + 1] + } +.fi + + ARIDER calculates the derivatives of the interpolant using the same +technique ASIDER. However ARIDER does not use a previously calculated +coefficient array like ASIDER. Instead ARIDER selects the appropriate portion +of the data array, calculates the coefficients and boundary coefficients, +and computes the derivatives at the time it is called. + +.sh +3.4.5. Integration + + ASIGRL calculates the integral of the interpolant between fixed limits +by integrating the interpolating polynomial. The coefficients of the +interpolating polynomial are calculated as discussed in section 3.4.4. + +.sh +4. Usage + +.sh +4.1. User Notes + +The following series of steps illustrates the use of the package. + +.ls 4 +.ls (1) +Insert an include statement in the calling program to make +the IINTERP definitions available to the user program. +.le +.ls (2) +Remove INDEF valued pixels from the data using ARBPIX. +.le +.ls (3) +Call ASIINIT to initialize the interpolant parameters. +.le +.ls (4) +Call ASIFIT to calculate the coefficients of the interpolant. +.le +.ls (5) +Evaluate the interpolant at a given value of x(s) using ASIEVAL or +ASIVECTOR. +.le +.ls (6) +Calculate the derivatives and integral or the interpolant using +ASIDER and ASIGRL. +.le +.ls (7) +Free the interpolator structure by calling ASIFREE. +.le +.le + + The interpolant can be saved and restored using ASISAVE and ASIRESTORE. +If the values and derivatives of only a few points in an array are desired +ARIEVAL and ARIDER can be called. + +.sh +4.2. Examples + +.nf +Example 1: Shift a data array by a constant amount + + include + ... + call asiinit (asi, II_POLY5) + call asifit (asi, inrow, npix) + + do i = 1, npix + outrow[i] = asieval (asi, i + shift) + + call asifree (asi) + ... + +Example 2: Calculate the integral under the data array + + include + ... + call asiinit (asi, II_POLY5) + call asifit (asi, datain, npix) + + integral = asigrl (asi, 1. real (npix)) + + call asifree (asi) + ... + +Example 2: Store interpolant for later use by ASIEVAL + LEN_INTERP must be at least npix + 8 units long where npix is + is defined in the call to ASIFIT. + + include + + real interpolant[LEN_INTERP] + ... + call asiinit (asi, II_POLY3) + call asifit (asi, datain, npix) + call asisave (asi, interpolant) + call asifree (asi) + ... + call asirestore (asi, interpolant) + do i = 1, npts + yfit[i] = asieval (asi, x[i]) + call asifree (asi) + ... +.fi +.sh +5. Detailed Design + +.sh +5.1. Interpolator Descriptor + + The interpolant parameters and coefficients are stored in a +structure listed below. + +.nf + define LEN_ASISTRUCT 4 # Length in structure units of + # interpolant descriptor + + define ASI_TYPE Memi[$1] # Interpolant type + define ASI_NCOEFF Memi[$1+1] # No. of coefficients + define ASI_OFFSET Memi[$1+2] # First "data" point in + # coefficient array + define ASI_COEFF Memi[$1+3] # Pointer to coefficient array +.fi + +.sh +5.2. Storage Requirements + + The interpolant descriptor requires LEN_ASISTRUCT storage units. The +coefficient array requires ASI_NCOEFF(asi) real storage elements, where +ASI_NCOEFF(asi) is defined as follows. + +.nf + ASI_NCOEFF(asi) = npix # II_NEAREST + ASI_NCOEFF(asi) = npix+1 # II_LINEAR + ASI_NCOEFF(asi) = npix+3 # II_POLY3 + ASI_NCOEFF(asi) = npix+5 # II_POLY5 + ASI_NCOEFF(asi) = npix+3 # II_SPLINE3 +.fi + +.sh +6. References + +.ls (1) +Carl de Boor, "A Practical Guide to Splines", 1978, Springer-Verlag New +York Inc. +.le +.ls (2) +S.D. Conte and C. de Boor, "Elementary Numerical Analysis", 1972, McGraw-Hill, +Inc. +.le +.ls (3) +P.M. Prenter, "Splines and Variational Methods", 1975, John Wiley and Sons Inc. +.le +.endhelp diff --git a/math/iminterp/doc/im2dinterp.spc b/math/iminterp/doc/im2dinterp.spc new file mode 100644 index 00000000..e4d88be3 --- /dev/null +++ b/math/iminterp/doc/im2dinterp.spc @@ -0,0 +1,432 @@ +.help iinterp Dec84 "Math Package" +.ce +Specifications for the 2D-Image Interpolator Package +.ce +Lindsey Davis +.ce +December 1984 + +.sh +1. Introduction + +One of the most common operations required in image processing is +two-dimensional interpolation in a data array. Any image operator which +physically moves pixels around requires image interpolation to calculate +the new gray levels of the pixels. The advantage +of having a locally written image interpolation package includes the ability to +optimize for uniformly spaced data and the possibility of adding features +that are useful to the final application. + +.sh +2. Requirements + +.ls (1) +The package shall take as input a 2-D array containing an image or image +section. The pixels are assumed to be equally spaced on a rectangular grid. +The coordinates of the pixels +are assumed to be the same as the subscripts of the pixel in the data array. +Therefore the coordinates of the first pixel in the array are assumed +to be (1,1). For operations on image sections the calling program must +keep track of any transformations between image and section coordinates. +All pixels are assumed to be good. +Checking for INDEF and out of bounds pixels is +the responsibility of the user. A routine to remove INDEF valued pixels +ARBPIX is available in the 1-D package. +.le +.ls (2) +The package is divided into array sequential interpolants and array random +interpolants. The sequential interpolants have been optimized for returning +many values as when an array is shifted or when an array is oversampled +at many points in order to produce a smooth surface plot. +The random interpolants +allow the evaluation of a few interpolated points without the computing +time and storage overhead required for setting up the sequential version. +.le +.ls (3) +The quality of the interpolant will be set at run time. The options are: + +.nf + II_BINEAREST # nearest neighbour + II_BILINEAR # bilinear + II_BIPOLY3 # bicubic interior polynomial + II_BIPOLY5 # biquintic interior polynomial + II_BISPLINE3 # bicubic spline +.fi + +The calling sequences shall be invariant to the interpolant selected. +Routines should be designed so that new interpolants can be added with +minimal changes to the code and no changes to the calling sequences. +.le +.ls (4) +The interpolant parameters and the arrays necessary to store the +coefficients are stored in a structure referenced by a pointer. The pointer +is returned to the user program by the initial call to MSIINIT or +MSIRESTORE and freed by a call to MSIFREE. +.le +.ls (5) +The package routines should be able to: +.ls o +Calculate the coefficients of the interpolant and store these coefficients +in the appropriate part of the interpolant descriptor structure. +.le +.ls o +Evaluate the interpolant at a given x-y(s) coordinate. +.le +.ls o +Evaluate the first nder derivatives at a given value of x-y. +.le +.ls o +Integrate the interpolant over a specified interval in x-y. +.le + +.sh +3. Specifications + +.sh +3.1. The Matrix Sequential Interpolator Routines + +The package prefix is msi and the package routines are: + +.nf + msiinit (msi, interp_type) + msifit (msi, datain, nxpix, nypix, len_datain) + y = msieval (msi, x, y) + msivector (msi, x, y, zfit, npix) + msigrid (msi, x, y, zfit, nx, ny, len_zfit) + msider (msi, x, y, der, nxder, nyder, len_der) + v = msigrl (msi, x, y, npts) + v = msisqgrl (msi, x1, x2, y1, y2) + msisave (msi, interpolant) + msirestore (msi, interpolant) + msifree (msi) +.fi + +.sh +3.2. The Matrix Random Interpolator Routines + +The package prefix is mri and the package routines are: + +.nf + y = mrieval (x, y, datain, nx, ny, len_datain, interp_type) + mrider (x, y, datain, nx, ny, len_datain, der, nxder, nyder, + len_der, interp_type) +.fi + +.sh +3.3. Miscellaneous + +A routine ARBPIX will remove INDEF valued pixels from an +array and is available in the 1-D package. + +.nf + arbpix (datain, dataout, npix, interp_type, boundary_type) +.fi + +.sh +3.4. Algorithms + +.sh +3.4.1. Coefficients + +The coefficients for the msi routines are calculated by MSIFIT. MSIFIT +accepts the input data, checks that the number of data pixels is +appropriate for the interpolant selected, and allocates space for the +interpolant. Boundary coefficient values are calculated using boundary +projection. With the exception of the II_BISPLINE3 option, the interpolant +is stored as the data points. The B-spline coefficients are calculated +using the "natural" end conditions in two steps. +First the B-spline coefficients in x at each value of y are calculated. +The B-x coefficients are then solved for the B-spline coefficients in x-y. +After a call to MSIFIT the coefficient +array contains the following. + +.nf + CASE II_BINEAREST: + + # no boundary extension required, coeff[1:nx,1:ny] + + coeff[i,j] = data[i,j] i = 1,...,nx + j = 1,...,ny + + case II_BILINEAR: + + # must extend nx by 1 and ny by 1, coeff[1:nx+1,1:ny+1] + + coeff[i,j] = data[i,j] i = 1,...,nx + j = 1,...,ny + + coeff[nx+1,j] = 2 * data[nx] - data[nx-1] j = 1,...,ny + coeff[i,ny+1] = 2 * data[ny] - data[ny-1] i = 1,...,nx + + coeff[nx+1,ny+1] = 2 * coeff[nx+1,ny] - data[nx,ny] + + case II_BIPOLY3: + + # must extend nx by -1 and 2 and ny by -1 and 2, coeff[0:nx+2,0:ny+2] + + coeff[i,j] = data[i,j] i = 1,...,nx + j = 1,...,ny + + coeff[0,j] = 2 * data[1,j] - data[2,j] j = 1,...,ny + coeff[nx+1,j] = 2 * data[nx,j] - data[nx-1,j] j = 1,...,ny + coeff[nx+2,j] = 2 * data[nx,j] - data[nx-2,j] j = 1,...,ny + + coeff[i,0] = 2 * data[i,1] - data[i,2] i = 1,...,ny + coeff[i,ny+1] = 2 * data[i,ny] - data[i,ny-1] i = 1,...,nx + coeff[i,ny+2] = 2 * data[i,ny] - data[i,ny-2] i = 1,...,nx + + # plus remaining points + + case II_BIPOLY5: + + # extend -2 and 3 in nx and -2 and 3 in ny, coeff[-1:nx+3,-1:ny+3] + + coeff[i,j] = data[i,j] i = 1,...,nx + j = 1,...,ny + + coeff[-1,j] = 2 * data[1,j] - data[3,j] j = 1,...,ny + coeff[0,j] = 2 * data[1,j] - data[2,j] j = 1,...,ny + coeff[nx+1,j] = 2 * data[nx,j] - data[nx-1,j] j = 1,...,ny + coeff[nx+2,j] = 2 * data[nx,j] - data[nx-2,j] j = 1,...,ny + coeff[nx+3,j] = 2 * data[nx,j] - data[nx-3,j] j = 1,...,ny + + coeff[i,-1] = 2 * data[i,1] - data[i,3] i = 1,...,nx + coeff[i,0] = 2 * data[i,1] - data[i,2] i = 1,...,nx + coeff[i,ny+1] = 2 * data[i,ny] - data[i,ny-1] i = 1,...,nx + coeff[i,ny+2] = 2 * data[i,ny] - data[i,ny-2] i = 1,...,nx + coeff[i,ny+3] = 2 * data[i,ny] - data[i,ny-3] i = 1,...,nx + + # plus remaining conditions + + case II_BISPLINE3: + + # the natural boundary conditions are used, coeff[0:nx+2,0:ny+2] + + coeff[i,j] = data[i,j] i = 1,...,nx + j = 1,...,ny + + coeff[i,0] = 0. i = 0,...,nx+2 + coeff[i,ny+1] = 0. i = 0,...,nx+2 + coeff[i,ny+2] = 0. i = 0,...,nx+2 + + coeff[0,j] = 0. j = 1,...,ny + coeff[nx+1,j] = 0. j = 1,...,ny + coeff[nx+2,j] = 0. j = 1,...,ny + + # plus remaining coefficients + +.fi + +.sh +3.4.2. Evaluation + +The MSIEVAL and MSIVECTOR routines will be optimized to be as efficient +as possible for evaluating arbitrarily spaced data. A special function +MSIGRID is included for evaluating closely spaced points on a rectangular grid. +For the options II_BINEAREST and II_BILINEAR the value of the +interpolant is calculated directly. The II_BISPLINE3 interpolant is +evaluated using polynomial coefficients calculated directly from the +B-spline coefficients. Values of the higher order polynomial interpolants +are calculated using Everett's central difference formula. The equations +are listed below. + +.nf +case II_BINEAREST: + + z = coeff[int (x + 0.5), int (y + 0.5)) + +case II_BILINEAR: + + sx = x - nx sy = y - ny + tx = 1. - sx ty = 1. - sy + + z = tx * ty * coeff[nx,ny] + sx * ty * coeff[nx+1,ny] + + sy * tx * coeff[nx,ny+1] + sx * sy * coeff[nx+1,ny+1] + + +case II_BIPOLY3: + + nx = x + sx = x - nx + tx = 1. - sx + + # interpolate in x + + i = 1 + + do j = ny-1, ny+2 { + + cd20[i] = 1./6. * (coeff[nx+1,j] - 2. * coeff[nx,j] + coeff[nx-1,j]) + cd21[i] = 1./6. * (coeff[nx+2,j] - 2. * coeff[nx+1,j] + coeff[nx,j]) + + z[i] = sx * (coeff[nx+1,j] + (sx * sx - 1.) * cd21[i]) + + tx * (coeff[nx,j] + (tx * tx - 1.) * cd20[i]) + + i = i + 1 + } + + ny = y + sy = y - ny + ty = 1. - sy + + # interpolate in y + + cd20y = 1./6. * (z[3] - 2. * z[2] + z[1]) + cd21y = 1./6. * (z[4] - 2. * z[3] + z[2]) + + value = sy * (z[3] + (sy * sy - 1.) * cd21y) + + ty * (z[2] + (ty * ty - 1.) *cd20y) + + +case II_BIPOLY5: + + nx = x + sx = x - nx + sx2 = sx * sx + tx = 1. - sx + tx2 = tx * tx + + # interpolate in x + + i = 1 + + do j = ny-2, ny+3 { + + cd20[i] = 1./6. * (coeff[nx+1,j] - 2. * coeff[nx,j] + coeff[nx-1,j]) + cd21[i] = 1./6. * (coeff[nx+2,j] - 2. * coeff[nx+1,j] + coeff[nx,j]) + cd40[i] = 1./120. * (coeff[nx-2,j] - 4. * coeff[nx-1,j] + + 6. * coeff[nx,j] - 4. * coeff[nx+1,j] + coeff[nx+2,j]) + cd41[i] = 1./120. * (coeff[nx-1,j] - 4. * coeff[nx,j] + + 6. * coeff[nx+1,j] - 4. * coeff[nx+2,j] + coeff[nx+3,j]) + + z[i] = sx * (coeff[nx+1,j] + (sx2 - 1.) * (cd21[j] + (sx2 - 4.) * + cd41[j])) + tx * (coeff[nx,j] + (tx2 - 1.) * + (cd20[j] + (tx2 - 4.) * cd40[j])) + + i = i + 1 + } + + ny = y + sy = y - ny + sy2 = sy * sy + ty = 1. - sy + ty2 = ty * ty + + # interpolate in y + + cd20y = 1./6. * (z[3] - 2. * z[2] + z[1]) + cd21y = 1./6. * (z[4] - 2. * z[3] + z[2]) + cd40y = 1./120. * (z[1] - 4. * z[2] + 6. * z[3] - 4. * z[4] + z[5]) + cd41y = 1./120. * (z[2] - 4. * z[3] + 6. * z[4] - 4. * z[5] + z[6]) + + value = sy * (z[4] + (sy2 - 1.) * (cd21y + (sy2 - 4.) * cd41y)) + + ty * (z[3] + (ty2 - 1.) * (cd20y + (ty2 - 4.) * cd40y)) + +case II_BISPLINE3: + + # use the B-spline representation + + value = coeff[i,j] * B[i](x) * B[j](y) + + # the B-splines are the following + + B1(x) = (x - x1) ** 3 + B2(x) = 1 + 3 * (x - x2) + 3 * (x - x2) ** 2 - 3 * (x - x2) ** 3 + B3(x) = 1 + 3 * (x3 - x) + 3 * (x3 - x) ** 2 - 3 * (x3 - x) ** 3 + B4(x) = (x4 - x) ** 3 + + # the y B-splines are identical + +.fi + +.sh +3.4.3. Derivatives + +The derivatives are calculated by evaluating the derivatives of the +interpolating polynomial. The 0-th derivative is the value of the +interpolant. The 1-st derivatives are d/dx and d/dy. The second are +d2/dx2, d2/dy2 and d2/dxdy. The derivatives in the case II_BINEAREST +and II_BILINEAR are calculated directly. + +.nf +case II_BINEAREST: + + der[1,1] = value # see previous section + +case II_BILINEAR: + + der[1] = value # see previous section + + # d/dx + der[2,1] = -ty * coeff[nx,ny] + ty * coeff[nx+1,ny] - + sy * coeff[nx,ny+1] + sy * coeff[nx+1,ny+1] + + # d/dy + der[1,2] = -tx * coeff[nx,ny] + sx * coeff[nx+1,ny] + + tx * coeff[nx,ny+1] + sx * coeff[nx+1,ny+1] + + # d2/dxdy + der[2,2] = coeff[nx,ny] - coeff[nx+1,ny] - coeff[nx,ny+1] + coeff[nx+1,ny+1] + +case II_BIPOLY3, II_BIPOLY5, II_BISPLINE3: +.fi + +For the higher order interpolants the coefficients of the interpolating +polynomial in x and y are calculated. In the case of II_BIPOLY3 and II_BIPOLY5 +this is the Everett polynomial of the 3-rd and 5-th order respectively. +In the case of II_BISPLINE3 the pp-representation is calculated for +the B-spline coefficients. The value of the interpolant and its +derivatives is calculated using nested multiplication. + +.sh +3.4.5. Integration + +Integration is most easily accomplished by integrating the interpolant in +x for each value of y. The resulting function of y can then be integrated +in y to derive the 2-D integral. The limits of the integral are assumed +to be the corners of a polygon. At minimum of three points which define +a triangular region in x-y are required. The integral will be an approximation. +A special function for integrating over a rectangular region is also +provided. + +.sh +4. Detailed Design + +.sh +4.1. Interpolant Descriptor + +The interpolant parameters and coefficients will be stored in a structure +as listed below. + +.nf + define LEN_MSISTRUCT 10 + + struct { + + int msi_type # interpolant type + int msi_nxcoeff # size of coefficient array in x + int msi_nycoeff # size of coefficient array in y + int msi_fstpnt # first datapoint in coefficient array + int asi_coeff # pointer to 1-D coefficient array + + } msistruct + +.fi + +.sh +4.2. Storage Requirements + +The interpolant descriptor requires LEN_MSISTRUCT storage units. +The coefficient array storage is dynamically allocated and requires +msi_nxcoeff * msi_nycoeff real storage elements. The requirements for +each interpolant type are listed below. + +.nf + II_BINEAREST nxpix * nypix + II_BILINEAR (nxpix + 1) * (nypix + 1) + II_BIPOLY3 (nxpix + 3) * (nypix + 3) + II_BIPOLY5 (nxpix + 5) * (nypix + 5) + II_BISPLINE3 (nxpix + 3) * (nypix + 3) +.fi + +.endhelp diff --git a/math/iminterp/doc/iminterp.hd b/math/iminterp/doc/iminterp.hd new file mode 100644 index 00000000..de836c3e --- /dev/null +++ b/math/iminterp/doc/iminterp.hd @@ -0,0 +1,37 @@ +# Help directory for the IMINTERP (image interpolator) package. + +$iminterp = "math$iminterp/" + +arbpix hlp = arbpix.hlp, src = iminterp$arbpix.x +arider hlp = arider.hlp, src = iminterp$arider.x +arieval hlp = arieval.hlp, src = iminterp$arieval.x +asider hlp = asider.hlp, src = iminterp$asider.x +asieval hlp = asieval.hlp, src = iminterp$asieval.x +asifit hlp = asifit.hlp, src = iminterp$asifit.x +asifree hlp = asifree.hlp, src = iminterp$asifree.x +asigeti hlp = asigeti.hlp, src = iminterp$asigeti.x +asigetr hlp = asigetr.hlp, src = iminterp$asigetr.x +asigrl hlp = asigrl.hlp, src = iminterp$asigrl.x +asiinit hlp = asiinit.hlp, src = iminterp$asiinit.x +asirestore hlp = asirestore.hlp, src = iminterp$asirestore.x +asisave hlp = asisave.hlp, src = iminterp$asisave.x +asisinit hlp = asisinit.hlp, src = iminterp$asisinit.x +asivector hlp = asivector.hlp, src = iminterp$asivector.x +asitype hlp = asitype.hlp, src = iminterp$asitype.x + +mrider hlp = mrider.hlp, src = iminterp$mrider.x +mrieval hlp = mrieval.hlp, src = iminterp$mrieval.x +msider hlp = msider.hlp, src = iminterp$msider.x +msieval hlp = msieval.hlp, src = iminterp$msieval.x +msifit hlp = msifit.hlp, src = iminterp$msifit.x +msifree hlp = msifree.hlp, src = iminterp$msifree.x +msigeti hlp = msigeti.hlp, src = iminterp$msigeti.x +msigetr hlp = msigetr.hlp, src = iminterp$msigetr.x +msigrid hlp = msigrid.hlp, src = iminterp$msigrid.x +msigrl hlp = msigrl.hlp, src = iminterp$msigrl.x +msiinit hlp = msiinit.hlp, src = iminterp$msiinit.x +msirestore hlp = msirestore.hlp, src = iminterp$msirestore.x +msisave hlp = msisave.hlp, src = iminterp$msisave.x +msisinit hlp = msisinit.hlp, src = iminterp$msisinit.x +msitype hlp = msitype.hlp, src = iminterp$msitype.x +msivector hlp = msivector.hlp, src = iminterp$msivector.x diff --git a/math/iminterp/doc/iminterp.hlp b/math/iminterp/doc/iminterp.hlp new file mode 100644 index 00000000..c602b43e --- /dev/null +++ b/math/iminterp/doc/iminterp.hlp @@ -0,0 +1,234 @@ +.help iminterp Dec98 "Math Package" +.ih +NAME +iminterp -- image interpolator package +.ih +SYNOPSIS + +.nf + asitype (interpstr, interp_type, nsinc, nincr, rparam) + asiinit (asi, interp_type) + asisinit (asi, interp_type, nsinc, nincr, rparam) + asifit (asi, datain, npix) +ivalue = asigeti (asi, param) +rvalue = asigetr (asi, param) + y = asieval (asi, x) + asivector (asi, x, yfit, npix) + asider (asi, x, der, nder) + v = asigrl (asi, a, b) + asisave (asi, interpolant) + asirestore (asi, interpolant) + asifree (asi) + + y = arieval (x, datain, npix, interp_type) + arider (x, datain, npix, der, nder, interp_type) + + arbpix (datain, dataout, npix, interp_type, boundary_type) +.fi + +.nf + msitype (interpstr, interp_type, nsinc, nincr, rparam) + msisinit (msi, interp_type, nsinc, nxincr, nyincr, rparam1, rparam2) + msiinit (msi, interp_type) + msifit (msi, datain, nxpix, nypix, len_datain) +ivalue = msigeti (msi, param) +rvalue = msigetr (msi, param) + y = msieval (msi, x, y) + msivector (msi, x, y, zfit, npts) + msider (msi, x, y, der, nxder, nyder, len_der) + v = msigrl (msi, x, y, npts) + v = msisqgrl (msi, x1, x2, y1, y2) + msisave (msi, interpolant) + msirestore (msi, interpolant) + msifree (msi) + + y = mrieval (x, y, datain, nxpix, nypix, len_dataina, interp_type) + mrider (x, y, datain, nxpix, nypix, len_datain, der, nxder, nyder, + len_der, interp_type) +.fi + +.ih +DESCRIPTION +The iminterp package provides a set of routines for interpolating uniformly +spaced data assuming that the spacing between data points is 1.0. The +package is divided into 1D and 2D array sequential interpolants, +prefixes asi and msi, and 1D and 2D +array random interpolants, prefixes ari and mri. +The sequential interpolants have +been optimized for returning many values as is the case when an array is +shifted. The random interpolants allow evaluation of a few interpolated +points without the computing time and storage overhead required for +setting up the sequential version. +.ih +NOTES +The interpolant is chosen at run time from the following list. + +.nf + II_NEAREST # nearest neighbour in x + II_LINEAR # linear interpolation in x + II_POLY3 # 3rd order interior polynomial in x + II_POLY5 # fifth order interior polynomial in x + II_SPLINE3 # cubic spline in x + II_SINC # sinc interpolation in x + II_LSINC # look-up table sinc interpolation in x + II_DRIZZLE # drizzle interpolation in x + + II_BINEAREST # nearest neighbour in x and y + II_BILINEAR # bilinear interpolation + II_BIPOLY3 # 3rd order interior polynomial in x and y + II_BIPOLY5 # 5th order interior polynomial in x and y + II_BISPLINE3 # bicubic spline + II_BISINC # sinc interpolation in x and y + II_BILSINC # look-up table sinc interpolation in x and y + II_BIDRIZZLE # drizzle interpolation in x and y +.fi + +The routines assume that all x (1D, 2D) and y (2D) values of interest lie in +the region 1 <= x <= nxpix, 1 <= y <= nypix. +Checking for out of bounds x and/or y values is the responsibility +of the calling program. The asi, ari, msi, and mri routines assume that INDEF +valued pixels have been removed from the data prior to entering the +package. The routine ARBPIX has been added to the package to facilitate +INDEF valued pixel removal. + +In order to make the package definitions available to the calling program +an include statement must appear in the calling program. +Either ASIINIT, ASISINIT or ASIRESTORE must be called before using the +asi routines. ASIFREE frees the space used by the asi routines. For the +msi routines the corresponding examples are MSIINIT, MSISINIT, MSIRESTORE +and MSIFREE. +.ih +EXAMPLES +.nf +Example 1: Shift a 1D data array by a constant amount using a 5th order +polynomial interpolant and the drizzle routine respectively. Note that +in this example the drizzle interpolant is equivalent to the linear +interpolant since the default drizzle pixel fraction is 1.0 and there +is no scale change. Out-of-bounds pixels are set to 0.0 + + include + ... + call asiinit (asi, II_POLY5) + call asifit (asi, inrow, npix) + + do i = 1, npix + if (i + xshift < 1.0 || i + xshift > npix) + outrow[i] = 0.0 + else + outrow[i] = asieval (asi, i + xshift) + + call asifree (asi) + ... + + + include + + real tmpx[2] + ... + call asiinit (asi, II_DRIZZLE) + call asifit (asi, inrow, npix) + + do i = 1, npix + tmpx[1] = i + xshift - 0.5 + tmpx[2] = i + xshift + 0.5 + if (tmpx[1] < 1 || tmpx[2] > npix) + outrow[i] = 0.0 + else + outrow[i] = asieval (asi, tmpx) + + call asifree (asi) + ... + + +Example 2: Shift a 2D array by a constant amount using a 3rd order polynomial +interpolant and the drizzle interpolant respectively. Note that +in this example the drizzle interpolant is equivalent to the linear +interpolant since the default drizzle pixel fraction is 1.0 and there +is no scale change. Out-of-bounds pixels are set to 0.0. + + include + ... + call msiinit (msi, II_BIPOLY3) + call msifit (msi, insection, nxpix, nypix, nxpix) + + do j = 1, nypix + if (j + yshift < 1 || j + yshift > nypix) + do i = 1, nxpix + outsection[i,j] = 0.0 + else + do i = 1, nxpix + if (i + xshift < 1 || i + xshift > nxpix) + outsection[i,j] = 0.0 + else + outsection[i,j] = msieval (msi, i + xshift, j + yshift) + + call msifree (msi) + ... + + + include + ... + real tmpx[4], tmpy[4] + ... + call msiinit (msi, II_BIDRIZZLE) + call msifit (msi, insection, nxpix, nypix, nxpix) + + do j = 1, nypix { + tmpy[1] = j + yshift - 0.5 + tmpy[2] = j + yshift - 0.5 + tmpy[3] = j + yshift + 0.5 + tmpy[4] = j + yshift + 0.5 + if (tmpy[1] < 1 || tmpy[4] > nypix) + do i = 1, nxpix + outsection[i,j] = 0.0 + else + do i = 1, nxpix + tmpx[1] = i + xshift - 0.5 + tmpx[2] = i + xshift + 0.5 + tmpx[3] = i + xshift + 0.5 + tmpx[4] = i + xshift - 0.5 + if (tmpx[1] < 1 || tmpx[2] > nxpix) + outsection[i,j] = 0.0 + else + outsection[i,j] = msieval (msi, tmpx, tmpy) + } + + call msifree (msi) + ... + + +Example 3: Calculate the integral under a 1D data array + + include + ... + call asiinit (asi, II_POLY5) + call asifit (asi, datain, npix) + + integral = asigrl (asi, 1. real (npix)) + + call asifree (asi) + ... + +Example 4: Store a 1D interpolant for later use by ASIEVAL + + include + + ... + call asiinit (asi, II_POLY3) + call asifit (asi, datain, npix) + + len_interpolant = asigeti (asi, ASINSAVE) + call salloc (interpolant, len_interpolant, TY_REAL) + call asisave (asi, Memr[interpolant]) + + call asifree (asi) + ... + call asirestore (asi, Memr[interpolant]) + + do i = 1, npts + yfit[i] = asieval (asi, x[i]) + + call asifree (asi) + ... +.fi +.endhelp diff --git a/math/iminterp/doc/iminterp.men b/math/iminterp/doc/iminterp.men new file mode 100644 index 00000000..9daf5883 --- /dev/null +++ b/math/iminterp/doc/iminterp.men @@ -0,0 +1,32 @@ + arbpix - Replace bad pixels in an array + arider - Calculate derivatives for a few points in a 1-D array + arieval - Evaluate the interpolant at a few points in a 1-D array + asider - Evaluate derivatives at x + asieval - Evaluate the interpolant at x + asifit - Fit the 1-D interpolant + asifree - Free space allocated by asiinit or asisinit + asigeti - Fetch an integer parameter + asigrl - Calculate the integral under an array + asiinit - Initialize 1-D interpolant using default parameters + asirestore - Restore interpolant parameters and coefficients + asisave - Save interpolant parameters and coefficients + asisinit - Initialize 1-D interpolant using user parameters + asitype - Decode string into interpolant type and parameters + asivector - Evaluate interpolant at an array of x + + mrider - Calculate derivatives for a few points in a 2-D array + mrieval - Evaluate the interpolant at a few points in a 2-D array + msider - Evaluate derivatives at x and y + msieval - Evaluate the interpolant at x and y + msifit - Fit the 2-D interpolant + msifree - Free space allocated by msiinit or msisinit + msigeti - Fetch an integer parameter + msigetr - Fetch a real parameter + msigrl - Calculate the integral inside a polygon + msiinit - Initialize the 2-D interpolant using default parameters + msirestore - Restore interpolant parameters and coefficients + msisave - Save 2-D interpolant parameters and coefficients + msisinit - Initialize the 2-D interpolant using user parameters + msisqgrl - Calculate the integral inside a rectangle + msitype - Decode string into interpolant type and parameters + msivector - Evaluate interpolant at an array of x and y diff --git a/math/iminterp/doc/iminterp.spc b/math/iminterp/doc/iminterp.spc new file mode 100644 index 00000000..ce5b8680 --- /dev/null +++ b/math/iminterp/doc/iminterp.spc @@ -0,0 +1,525 @@ +.help iminterp Jul84 "Math Package" + +.ce +Specifications for the Image Interpolator Package +.ce +Lindsey Davis +.ce +Vesa Junkkarinen +.ce +August 1984 + +.sh +1. Introduction + + One of the most common operations in image processing is +interpolation in a data array. Due to the large amount of data involved, +efficiency is highly important. The advantage of having locally written +interpolators, includes the ability to optimize for uniformly spaced data +and the possibility of adding features that are useful to the final +application. + +.sh +2. Requirements + +.ls (1) +The package shall take as input a one-dimensional array containing image +data. The pixels are assumed to be equally spaced along a line. +The coordinates of a pixel are assumed to be +the same as the subscript of the pixel in the data array. +The coordinate of the first pixel in the array and the spacing between pixels +is assumed to be 1.0. All pixels are assumed to be good. +Checking for INDEF valued and out of bounds pixels is the responsibility of the +user. A routine to remove INDEF valued pixels from a data array shall be +included in the package. +.le +.ls (2) +The package is divided into array sequential interpolators and array +random interpolators. The sequential interpolators have been optimized +for returning many values as is the case when an array is shifted, or +oversampled at many points in order to produce a +smooth plot. +The random interpolators allow the evaluation of a few interpolated +points without the computing time and storage overhead required for +setting up the sequential version. +.le +.ls (3) +The quality of the interpolant will be set at run time. The options are: + +.nf + II_NEAREST - nearest neighbour + II_LINEAR - linear interpolation + II_POLY3 - 3rd order divided differences + II_POLY5 - 5th order divided differences + II_SPLINE3 - cubic spline +.fi + +The calling sequences shall be invariant to the interpolant selected. +Routines should be designed so that new interpolants can be added +with minimal changes to the code and no change to the calling sequences. +.le +.ls (4) +The interpolant parameters and the arrays necessary to store the coefficients +are stored in a structure referenced by a pointer. The pointer is returned +to the user program by the initial call to ASIINIT or ASIRESTORE and freed +by a call to ASIFREE (see section 3.1). +.le +.ls (5) +The package routines shall be able to: +.ls o +Calculate the coefficients of the interpolant and store these coefficients in +the appropriate part of the interpolant descriptor structure. +.le +.ls o +Evaluate the interplant at a given x(s) coordinate(s). +.le +.ls o +Calculate the derivatives of the interpolant at a given value of x. +.le +.ls o +Integrate the interpolant over a specified x interval. +.le +.ls o +Store the interpolant in a user supplied array. Restore the saved interpolant +to the interpolant descriptor structure for later use by ASIEVAL, ASIVECTOR, +ASIDER and ASIGRL. +.le + +.sh +3. Specifications + +.sh +3.1. The Array Sequential Interpolator Routines + + The package prefix is asi and the package routines are: + +.nf + asiinit (asi, interp_type) + asifit (asi, datain, npix) + y = asieval (asi, x) + asivector (asi, x, yfit, npix) + asider (asi, x, der, nder) + v = asigrl (asi, a, b) + asisave (asi, interpolant) + asirestore (asi, interpolant) + asifree (asi) +.fi + +.sh +3.2. The Array Random Interpolator Routines + + The package prefix is ari and the package routines are: + +.nf + y = arieval (x, datain, npix, interp_type) + arider (x, datain, npix, der, nder, interp_type) +.fi + +.sh +3.3. Miscellaneous + + A routine has been included in the package to remove INDEF valued +pixels from an array. + +.nf + arbpix (datain, dataout, npix, interp_type, boundary_type) +.fi + +.sh +3.4. Algorithms + +.sh +3.4.1. Coefficients + + The coefficient array used by the asi routines is calculated by ASIFIT. +ASIFIT accepts an array of data, checks that the number +of data points is appropriate for the interpolant selected, allocates +space for the interpolant, and calculates the coefficients. +Boundary coefficient values are calculated +using boundary projection. With the exception of the cubic spline interpolant, +the coefficients are stored as the data points. +The B-spline coefficients are +calculated using natural end conditions (Prenter 1975). +After a call to ASIFIT the coefficient array contains the following. + +.nf + case II_NEAREST: + + # no boundary conditions necessary + coeff[1] = datain[1] + . + . + . + coeff[npts] = datain[npix] + + case II_LINEAR: + + # coeff[npxix+1] required if x = npix + coeff[1] = datain[1] + . + . + . + coeff[npix] = datain[npix] + coeff[npix+1] = 2. * datain[npix] - datain[npix-1] + + case II_POLY3: + + # coeff[0] required if x = 1 + # coeff[npix+1], coeff[npix+2] required if x = npix + coeff[0] = 2. * datain[1] - datain[2] + coeff[1] = datain[1] + . + . + . + coeff[npix] = datain[npix] + coeff[npix+1] = 2. * datain[npix] - datain[npix-1] + coeff[npix+2] = 2. * datain[npix] - datain[npix-2] + + case II_POLY5: + + # coeff[1], coeff[0] reqired if x = 1 + # coeff[npix+1], coeff[npix+2], coeff[npix=3] + # required if x = npix + + coeff[-1] = 2. * datain[1] - datain[3] + coeff[0] = 2. * datain[1] - datain[2] + coeff[1] = datain[1] + . + . + . + coeff[npix] = datain[npix] + coeff[npix+1] = 2. * datain[npix] - datain[npix-1] + coeff[npix+2] = 2. * datain[npix] - datain[npix-2] + coeff[npix+3] = 2. * datain[npix] - datain[npix-3] + + case SPLINE3: + + # coeff[0] = 2nd der at x = 1, coeff[0] = 0. + # coeff[npix+1] = 2nd der at x = npts, coeff[npix+1] = 0. + # coeff[npix+2] = 0., required if x = npix + coeff[0] = b[1] + coeff[1] = b[2] + . + . + . + coeff[npix] = b[npix+1] + coeff[npix+1] = b[npix+2] + coeff[npix+2] = 0. +.fi + +.sh +3.4.2. Evaluation + + The ASIEVAL and ASIVECTOR routines have been optimized to be as efficient +as possible. The values of the II_NEAREST and II_LINEAR interpolants +are calculated directly. The II_SPLINE3 interpolant is evaluated using +polynomial coefficients calculated directly from the B-spline coefficients +(de Boor 1978). Values of the higher order polynomial interpolants +are calculated using central differences. The equations for each case are +listed below. + +.nf +case II_NEAREST: + + y = coeff[int (x + 0.5)] + +case II_LINEAR: + + nx = x + y = (x - nx) * coeff[nx+1] + (nx + 1 - x) * coeff[nx] + +case II_POLY3: + + nx = x + s = x - nx + t = 1. - s + + # second central differences + cd20 = 1./6. * (coeff[nx+1] - 2. * coeff[nx] + coeff[nx-1]) + cd21 = 1./6. * (coeff[nx+2] - 2. * coeff[nx+1] + coeff[nx]) + + y = s * (coeff[nx+1] + (s * s - 1.) * cd21) + t * (coeff[nx] + + (t * t - 1.) * cd20) + +case II_POLY5: + + nx = x + s = x - nx + t = 1. - s + + # second central differences + cd20 = 1./6. * (coeff[nx+1] - 2. * coeff[nx] + coeff[nx-1]) + cd21 = 1./6. * (coeff[nx+2] - 2. * coeff[nx+1] + coeff[nx]) + + # fourth central diffreences + cd40 = 1./120. * (coeff[nx-2] - 4. * coeff[nx-1] + 6. * coeff[nx] - 4. * + coeff[nx+1] + a[nx+2]) + cd41 = 1./120. * (coeff[nx-1] - 4. * coeff[nx] + 6. * coeff[nx+1] - 4. * + coeff[nx+2] + coeff[nx+3] + + y = s * (coeff[nx+1] + (s * s - 1.) * (cd21 + (s * s - 4.) * cd41)) + + t * (coeff[nx] + (t * t - 1.) * (cd20 + (t * t - 4.) * cd40)) + +case II_SPLINE3: + + nx = x + s = x - nx + + pc[1] = coeff[nx-1] + 4. * coeff[nx] + coeff[nx+1] + pc[2] = 3. * (coeff[nx+1] - coeff[nx-1]) + pc[3] = 3. * (coeff[nx-1] - 2. * coeff[nx] + coeff[nx+1]) + pc[4] = -coeff[nx-1] + 3. * coeff[nx] - 3. * coeff[nx+1] + coeff[nx+2] + + y = pc[1] + s * (pc[2] + s * (pc[3] + s * pc[4])) +.fi + + + The ARIEVAL routine uses the expressions above to evaluate the +interpolant. However unlike ASIEVAL, ARIEVAL does not use a previously +calculated coefficient array. Instead ARIEVAL selects the appropriate +portion of the data array, calculates the coefficients and boundary +coefficients if necessary, and evaluates the interpolant at the time it +is called. The cubic spline interpolant uses at most SPLTS (currently 16) +data points to calculate the B-spline coefficients. + +.sh +3.4.3. Derivatives + + Derivatives of the interpolant are calculated by evaluating the +derivatives of the interpolating polynomial. For all interpolants der[1] +equals the value of the interpolant at x. +For the sake of efficiency the derivatives +of the II_NEAREST and II_LINEAR interpolants are calculated directly. + +.nf + case II_NEAREST: + + der[1] = coeff[int (x+0.5)] + + case II_LINEAR: + + der[1] = (x - nx) * coeff [nx+1] + (nx + 1 - x) * coeff[nx] + der[2] = coeff[nx+1] - coeff[nx] +.fi + + In order to calculate the derivatives of the cubic spline and +polynomial interpolants +the coefficients of the interpolating polynomial must be calculated. +The polynomial +coefficients for the cubic spline interpolant are computed directly from the +B-spline coefficients (see 3.4.2.). The higher order polynomial +interpolant coefficients are calculated as follows. + +First the appropriate portion of the coefficient array is loaded. + +.nf + do i = 1, nterms + d[i] = coeff[nx - nterms/2 + i] +.fi + +Next the divided differences are calculated (Conte and de Boor 1972). + +.nf + do k = 1, nterms - 1 + do i = 1, nterms - k + d[i] = (d[i+1] - d[i]) / k +.fi + +The d[i] are the coefficients of an interpolating polynomial of the +following form. The x[i] are the nterms data points surrounding the +point of interest. + +.nf + p(x) = d[1] * (x-x[1]) * ... * (x-x[nterms-1) + + d[2] * (x-x[2]) * ... * (x-x[nterms-1]) + ... + d[nterms] +.fi + +Next a new set of polynomial coefficients are calculated +(Conte and de Boor 1972). + +.nf + do k = nterms, 2, -1 + do i = 2, k + d[i] = d[i] + d[i-1] * (k - i - nterms/2) +.fi + +The new d[i] are the coefficients of the follwoing polynomial. + +.nf + nx = x + p(x) = d[1] * (x-nx) ** (nterms-1) + d[2] * (x-nx) ** (nterms-2) + ... + d[nterms] +.fi + +The d[i] array is flipped. The value and derivatives +of the interpolant are then calculated using the d[i] array and +nested multiplication. + +.nf + s = x - nx + + do k = 1, nder { + + accum = d[nterms-k+1] + + do j = nterms - k, 1, -1 + accum = d[j] + s * accum + + der[k] = accum + + # differnetiate + do j = 1, nterms - k + d[j] = j * d[j + 1] + } +.fi + + ARIDER calculates the derivatives of the interpolant using the same +technique ASIDER. However ARIDER does not use a previously calculated +coefficient array like ASIDER. Instead ARIDER selects the appropriate portion +of the data array, calculates the coefficients and boundary coefficients, +and computes the derivatives at the time it is called. + +.sh +3.4.5. Integration + + ASIGRL calculates the integral of the interpolant between fixed limits +by integrating the interpolating polynomial. The coefficients of the +interpolating polynomial are calculated as discussed in section 3.4.4. + +.sh +4. Usage + +.sh +4.1. User Notes + +The following series of steps illustrates the use of the package. + +.ls 4 +.ls (1) +Insert an include statement in the calling program to make +the IINTERP definitions available to the user program. +.le +.ls (2) +Remove INDEF valued pixels from the data using ARBPIX. +.le +.ls (3) +Call ASIINIT to initialize the interpolant parameters. +.le +.ls (4) +Call ASIFIT to calculate the coefficients of the interpolant. +.le +.ls (5) +Evaluate the interpolant at a given value of x(s) using ASIEVAL or +ASIVECTOR. +.le +.ls (6) +Calculate the derivatives and integral or the interpolant using +ASIDER and ASIGRL. +.le +.ls (7) +Free the interpolator structure by calling ASIFREE. +.le +.le + + The interpolant can be saved and restored using ASISAVE and ASIRESTORE. +If the values and derivatives of only a few points in an array are desired +ARIEVAL and ARIDER can be called. + +.sh +4.2. Examples + +.nf +Example 1: Shift a data array by a constant amount + + include + ... + call asiinit (asi, II_POLY5) + call asifit (asi, inrow, npix) + + do i = 1, npix + outrow[i] = asieval (asi, i + shift) + + call asifree (asi) + ... + +Example 2: Calculate the integral under the data array + + include + ... + call asiinit (asi, II_POLY5) + call asifit (asi, datain, npix) + + integral = asigrl (asi, 1. real (npix)) + + call asifree (asi) + ... + +Example 2: Store interpolant for later use by ASIEVAL + LEN_INTERP must be at least npix + 8 units long where npix is + is defined in the call to ASIFIT. + + include + + real interpolant[LEN_INTERP] + ... + call asiinit (asi, II_POLY3) + call asifit (asi, datain, npix) + call asisave (asi, interpolant) + call asifree (asi) + ... + call asirestore (asi, interpolant) + do i = 1, npts + yfit[i] = asieval (asi, x[i]) + call asifree (asi) + ... +.fi +.sh +5. Detailed Design + +.sh +5.1. Interpolator Descriptor + + The interpolant parameters and coefficients are stored in a +structure listed below. + +.nf + define LEN_ASISTRUCT 4 # Length in structure units of + # interpolant descriptor + + define ASI_TYPE Memi[$1] # Interpolant type + define ASI_NCOEFF Memi[$1+1] # No. of coefficients + define ASI_OFFSET Memi[$1+2] # First "data" point in + # coefficient array + define ASI_COEFF Memi[$1+3] # Pointer to coefficient array +.fi + +.sh +5.2. Storage Requirements + + The interpolant descriptor requires LEN_ASISTRUCT storage units. The +coefficient array requires ASI_NCOEFF(asi) real storage elements, where +ASI_NCOEFF(asi) is defined as follows. + +.nf + ASI_NCOEFF(asi) = npix # II_NEAREST + ASI_NCOEFF(asi) = npix+1 # II_LINEAR + ASI_NCOEFF(asi) = npix+3 # II_POLY3 + ASI_NCOEFF(asi) = npix+5 # II_POLY5 + ASI_NCOEFF(asi) = npix+3 # II_SPLINE3 +.fi + +.sh +6. References + +.ls (1) +Carl de Boor, "A Practical Guide to Splines", 1978, Springer-Verlag New +York Inc. +.le +.ls (2) +S.D. Conte and C. de Boor, "Elementary Numerical Analysis", 1972, McGraw-Hill, +Inc. +.le +.ls (3) +P.M. Prenter, "Splines and Variational Methods", 1975, John Wiley and Sons Inc. +.le +.endhelp diff --git a/math/iminterp/doc/mrider.hlp b/math/iminterp/doc/mrider.hlp new file mode 100644 index 00000000..47515c48 --- /dev/null +++ b/math/iminterp/doc/mrider.hlp @@ -0,0 +1,79 @@ +.help mrider Dec98 "Image Interpolation Package" +.ih +NAME +mrider -- calculate the derivatives at x and y +.ih +SYNOPSIS +include + +.nf +mrider (x, y, datain, nxpix, nypix, len_datain, der, nxder, nyder, len_der, + interp_type) +.fi + +.nf +real x[4] #I x value, 1. <= x[1-4] <= nxpix +real y[4] #I y value, 1. <= y[1-4] <= nypix +real datain[len_datain, ARB] #I data array +int nxpix #I number of data pixels in x +int nypix #I number of data pixels in y +int len_datain #I length of datain, len_datain >= nxpix +real der[len_der, ARB] #O derivative array +int nxder #I x order of the derivatives +int nyder #I y order of the derivatives +int len_der #I row length of der, len_der >= nxder +int interp_type #I interpolant type +.fi +.ih +ARGUMENTS +.ls x, y +The single x and y points or in the case of the drizzle interpolant the +single quadrilateral at / over which the derivatives are to be evaluated. +The quadrilateral vertices may be stored in clock-wise or counter-clockwise +order. +.le +.ls datain +Array of data values. +.le +.ls nxpix, nypix +The number of data values in the x and y directions +.le +.ls len_datain +The row length of the datain array. Len_datain must be >= nxpix. +.le +.ls der +The derivative array. Der[1,1] equals the function value at x and y and +der[2,1], der[1,2] are the first derivatives with respect to x and y +respectively. +.le +.ls nxder, nyder +The number of the derivatives in x and y to be returned. MRIDER checks +that the requested number of derivatives is sensible. The sinc interpolants +return the interpolant value and all the first and second order derivatives. +The drizzle interpolant returns the interpolant value and the first +derivative in x and y. +.le +.ls len_der +The row length of the derivative array. Len_der must be >= nxder. +.le +.ls interp_type +Interpolant type. The options are II_BINEAREST, II_BILINEAR, II_BIPOLY3, +II_BIPOLY5, II_BISPLINE3, II_SINC / II_LSINC, and II_DRIZZLE. The look-up +table sinc is not supported and defaults to the sinc interpolant. The +interpolant width is 31 pixels. The drizzle pixel fraction is 1.0. The +interpolant type definitions are found in the package header file +math/iminterp.h. +.le +.ih +DESCRIPTION +MRIDER is useful for evaluating the function and derivatives at a few +widely spaced points in a data array without the storage space required +by the sequential version. +.ih +NOTES +Checking for out of bounds and INDEF valued pixels is the +responsibility of the user. +.ih +SEE ALSO +msider +.endhelp diff --git a/math/iminterp/doc/mrieval.hlp b/math/iminterp/doc/mrieval.hlp new file mode 100644 index 00000000..35477614 --- /dev/null +++ b/math/iminterp/doc/mrieval.hlp @@ -0,0 +1,57 @@ +.help mrieval Dec98 "Image Interpolation Package" +.ih +NAME +mrieval -- evaluate the interpolant at x and y +.ih +SYNOPSIS +include + +y = mrieval (x, y, datain, nxpix, nypix, len_datain, interp_type) + +.nf + real x[4] #I x value, 1 <= x[1-4] <= nxpix + real y[4] #I y value, 1 <= y[1-4] <= nypix + real datain[len_datain, ARB] #I data array + int nxpix #I number of x values + int nypix #I number of y values + int len_datain #I length datain, len_datain >= nxpix + int interp_type #I interpolant type +.fi +.ih +ARGUMENTS +.ls x, y +The single x and y values or in the case of the drizzle interpolant the +single quadrilateral at / over which the interpolant is to be evaluated. +The vertices of the quadilateral must be defined in clock-wise or +counter-clockwise order. +.le +.ls datain +The array of data values. +.le +.ls nxpix, nypix +The number of data pixels in x and y. +.le +.ls len_datain +The row length of datain. Len_datain must be >= nxpix. +.le +.ls interp_type +Interpolant type. The options are II_BINEAREST, II_BILINEAR, II_BIPOLY3, +II_BIPOLY5, II_BISPLINE3, II_SINC / II_LSINC, and II_DRIZZLE. The look-up +table sinc interpolant is not supported and defaults to the sinc interpolant. +The sinc interpolant width is 31 pixels. The drizzle pixel fraction is 1.0. +The interpolant type definitions are found in the package header file +math/iminterp.h. +.le +.ih +DESCRIPTION +MRIEVAL is useful for evaluating the interpolant at a few selected points +in the datain array without the storage overhead required for the sequential +version. +.ih +NOTES +Checking for INDEF valued or out of bounds pixels is the +responsibility of the user. +.ih +SEE ALSO +msieval, msivector, mrider +.endhelp diff --git a/math/iminterp/doc/msider.hlp b/math/iminterp/doc/msider.hlp new file mode 100644 index 00000000..0139c0a0 --- /dev/null +++ b/math/iminterp/doc/msider.hlp @@ -0,0 +1,52 @@ +.help msider Dec98 "Image Interpolation Package" +.ih +NAME +msider -- evaluate the interpolant derivatives at x and y +.ih +SYNOPSIS +msider (msi, x, y, der, nxder, nyder, len_der) + +.nf + pointer msi #I interpolant descriptor + real x[4] #I x value, 1 <= x[1-4] <= nxpix + real y[4] #I y value, 1 <= y[1-4] <= nypix + real der[len_der, ARB] #O derivative array + int nxder #I number of x derivatives + int nyder #I number of y derivatives + int len_der #I row length of der, len_der >= nxder +.fi +.ih +ARGUMENTS +.ls msi +Pointer to the 2D sequential interpolant descriptor. +.le +.ls x, y +The single x and y values or in the case of the drizzle interpolant the +single quadrilateral at / over which the point is to be evaluated. +.le +.ls der +The array containing the derivatives. Der[1,1] contains the value of +the interpolant at x and y. Der[2,1] and der[1,2] contain the 1st +derivatives of x and y respectively. +.le +.ls nxder, nyder +The number derivatives in x and y. +.le +.ls len_der +The row length of der. Len_der must be >= nxder. +.le +.ih +DESCRIPTION +The polynomial and spline interpolants are evaluated using the polynomial +coefficients and nested multiplication. The polynomial interpolants are +stored as the data points. The spline interpolant is stored as a set of +B-spline coefficients. +.ih +NOTES +MRIDER checks that the number of derivatives requested is reasonable. +Checking for out of bounds and INDEF valued pixels is the responsibility of the +user. MSIINIT and MSIFIT must be called before using MSIDER. +.ih +SEE ALSO +mrider +.endhelp diff --git a/math/iminterp/doc/msieval.hlp b/math/iminterp/doc/msieval.hlp new file mode 100644 index 00000000..9a77c006 --- /dev/null +++ b/math/iminterp/doc/msieval.hlp @@ -0,0 +1,46 @@ +.help msieval Dec98 "Image Interpolation Package" +.ih +NAME +msieval -- procedure to evaluate the interpolant at x and y +.ih +SYNOPSIS +z = msieval (msi, x, y) + +.nf +pointer msi #I interpolant descriptor +real x[4] #I x value, 1 <= x[1-4] <= nxpix +real y[4] #I y value, 1 <= y[1-4] <= nypix +.fi +.ih +ARGUMENTS +.ls msi +The pointer to the sequential interpolant descriptor structure. +.le +.ls x, y +The single x and y values of or in the case of the drizzle interpolant +the single quadrilateral over which the point is to be evaluated. +.le +.ih +DESCRIPTION +The polynomial coefficients are calculated from the data points in the +case of the polynomial interpolants and the B-spline coefficients in +the case of the spline interpolant. The polynomial interpolants +are evaluated using Everett's central difference formula. The boundary +extension algorithm is projection. + +The sinc interpolant is evaluated using an array of data points around +the desired position. The look-up table sinc interpolant is computed +using an a pre-computed look--up table entry. The boundary extension +algorithm is nerest neighbor. + +The drizzle interpolant is computed by computing the mean value of the +data within the user supplied quadrilateral. +.ih +NOTES +Checking for out of bounds and INDEF valued pixels is the responsibility of +the user. MSIINIT or MSISINIT and MSIFIT must be called before calling +MSIEVAL. +.ih +SEE ALSO +msivector, mrieval, mrider +.endhelp diff --git a/math/iminterp/doc/msifit.hlp b/math/iminterp/doc/msifit.hlp new file mode 100644 index 00000000..9a63ae2d --- /dev/null +++ b/math/iminterp/doc/msifit.hlp @@ -0,0 +1,45 @@ +.help msifit Dec98 "Image Interpolation Package" +.ih +NAME +msifit - fit the interpolant to the data +.ih +SYNOPSIS +msifit (msi, datain, nxpix, nypix, len_datain) + +.nf + pointer msi #I interpolant descriptor + real datain[len_datain,ARB] #I data array + int nxpix #I number of x pixels + int nypix #I number of y pixels + int len_datain #I length of datain, len_datain >= nxpix +.fi +.ih +ARGUMENTS +.ls msi +Pointer to the sequential interpolant descriptor. +.le +.ls datain +Array containing the data. +.le +.ls nxpix, nypix +The number of pixels in x and y. +.le +.ls len_datain +The row length of the datain array. Len_datain must be >= nxpix. +.le +.ih +DESCRIPTION +The datain array is checked for size, memory is allocated for the coefficient +array and the end conditions are specified. The interior polynomial, sinc, +and drizzle interpolants are saved as the data points. The polynomial +coefficients are calculated from the data points in the evaluation stage. +The B-spline coefficients are calculated in MSIFIT as they depend on the +entire data array. +.ih +NOTES +Checking for INDEF valued pixels is the responsibility of the user. +MSIINIT or MSISINIT must be called before using MSIFIT. MSIFIT must be +called before using MSIEVAL, MSIVECTOR, MSIDER, MSIGRL or MSISQGRL. +.ih +SEE ALSO +.endhelp diff --git a/math/iminterp/doc/msifree.hlp b/math/iminterp/doc/msifree.hlp new file mode 100644 index 00000000..79b1966d --- /dev/null +++ b/math/iminterp/doc/msifree.hlp @@ -0,0 +1,26 @@ +.help msifree Dec98 "Image Interpolation Package" +.ih +NAME +msifree -- free sequential interpolant descriptor +.ih +SYNOPSIS +msifree (msi) + +.nf + pointer msi #U interpolant descriptor +.fi +.ih +ARGUMENTS +.ls msi +Pointer to the sequential interpolant descriptor structure. +.le +.ih +DESCRIPTION +MSIFREE frees the sequential interpolant descriptor structure. +MSIFREE should be called when interpolation is complete. +.ih +NOTES +.ih +SEE ALSO +msiinit, msisinit +.endhelp diff --git a/math/iminterp/doc/msigeti.hlp b/math/iminterp/doc/msigeti.hlp new file mode 100644 index 00000000..5ab46156 --- /dev/null +++ b/math/iminterp/doc/msigeti.hlp @@ -0,0 +1,35 @@ +.help msigeti Dec98 msigeti.hlp +.ih +NAME +msigeti -- fetch an msi integer parameter +.ih +SYNOPSIS +include + +ivalue = msigeti (msi, param) + +.nf + pointer msi #I interpolant descriptor + int param #I parameter +.fi +.ih +ARGUMENTS +.ls msi +Pointer to the sequential interpolant descriptor structure. +.le +.ls param +The parameter to be fetched. The choices are: II_MSITYPE, the interpolant +type, II_MSINSAVE, the length of the saved coefficient array, and +II_MSINSINC, the half-width of the sinc interpolant. +.le +.ih +DESCRIPTION +MSIGETI is used to determine the size of the coefficient array that +must be allocated to save the sequential interpolant description structure, +and to fetch selected sequential interpolant parameters. +.ih +NOTES +.ih +SEE ALSO +msiinit, msisinit, msigetr +.endhelp diff --git a/math/iminterp/doc/msigetr.hlp b/math/iminterp/doc/msigetr.hlp new file mode 100644 index 00000000..dadac5c2 --- /dev/null +++ b/math/iminterp/doc/msigetr.hlp @@ -0,0 +1,37 @@ +.help msigetr Dec98 msigetr.hlp +.ih +NAME +msigetr -- fetch an msi real parameter +.ih +SYNOPSIS +include + +rvalue = msigetr (msi, param) + +.nf + pointer msi #I interpolant descriptor + int param #I parameter +.fi +.ih +ARGUMENTS +.ls msi +Pointer to the sequential interpolant descriptor structure. +.le +.ls param +The parameter to be fetched. The choices are: II_MSIBADVAL, the undefined +pixel value for the drizzle interpolant. The parameter definitions are +contained in the package header file math/iminterp.h. +.le +.ih +DESCRIPTION +MSIGETR is used to set the value of undefined drizzle interpolant pixels. +Undefined pixels are those for which the interpolation coordinates do not +overlap the input coordinates, but are still, within the boundaries of the input +image, a situation which may occur when the pixel fraction is < 1.0. +.ih +.ih +NOTES +.ih +SEE ALSO +msiinit, msisinit, msigeti +.endhelp diff --git a/math/iminterp/doc/msigrid.hlp b/math/iminterp/doc/msigrid.hlp new file mode 100644 index 00000000..6bc110d5 --- /dev/null +++ b/math/iminterp/doc/msigrid.hlp @@ -0,0 +1,51 @@ +.help msigrid Dec98 "Image Interpolation Package" +.ih +NAME +msigrid -- evaluate the interpolant on a grid of points +.ih +SYNOPSIS +msigrid (msi, x, y, zfit, nx, ny, len_zfit) + +.nf + pointer msi #I interpolant descriptor + real x[2*nx] #I x values, 1 <= x[i] <= nx + real y[2*ny] #I y values, 1 <= y[i] <= ny + real zfit[len_zfit,ARB] #O grid of interpolated values + int nx #I number of x points + int ny #I number of y points + int len_zfit #I length zfit, len_zfit >= nx +.fi +.ih +ARGUMENTS +.ls msi +Pointer to the interpolant descriptor structure. +.le +.ls x, y +The x and y arrays of points to be evaluated, or in the case of the drizzle +interpolant the x and y ranges over which the points are to be evaluated. +The x and y arrays must be ordered in increasing values of x and y respectively. +.le +.ls zfit +The array of interpolated points. +.le +.ls nx, ny +The number of points in the x and y directions respectively. +.le +.ls len_zfit +The row length of the zfit array. Len_zfit >= nx. +.le +.ih +DESCRIPTION +MSIGRID evaluates the interpolant at a set of x and y values on a +rectangular grid or in the case of the drizzle interpolant within +rectangular regions. It is most efficient for evaluating the interpolant +at many values which are closely spaced in x and y. For widely spaced +points MSIVECTOR should be used. +.ih +NOTES +Checking for out of bounds and INDEF valued pixels is the responsibility +of the user. +.ih +SEE ALSO +msieval, msivector, msider, mrieval, mrider +.endhelp diff --git a/math/iminterp/doc/msigrl.hlp b/math/iminterp/doc/msigrl.hlp new file mode 100644 index 00000000..f6e2326a --- /dev/null +++ b/math/iminterp/doc/msigrl.hlp @@ -0,0 +1,43 @@ +.help msigrl Dec98 "Image Interpolation Package" +.ih +NAME +msigrl -- integrate the interpolant inside a polygon +.ih +SYNOPSIS +y = msigrl (msi, x, y, npts) + +.nf + pointer msi #I interpolant descriptor + real x[npts] #I x values, 1 <= x <= npts, x[1] = x[npts] + real y[npts] #I y values, 1 <= y <= npts, y[1] = y[npts] + int npts #I number of points +.fi +.ih +ARGUMENTS +.ls msi +Pointer to the sequential interpolant descriptor structure. +.le +.ls x, y +An array of x and y values describing a polygon, where x[1] = x[npts] and +y[1] = y[npts]. X and y describe a closed curve where any horizontal line +segment intersects the domain of integration at at most one point. +.le +.ls npts +The number of points describing the polygon. Npts must >= 4 (triangle). +.le +.ih +DESCRIPTION +MSIGRL integrates the interpolant exactly for rectangular domains +of integration. For more irregular regions of integration MSIGRL +returns an approximation whose accuracy depends on the size of the +integration region and the shape of the polygon. +.ih +NOTES +Checking for out of bound integration regimes is the responsibility of +the user. Non-rectangular partial pixel domains of integration default +to rectangular regions. MSIINIT or MSISINIT and MSIFIT must be called +before using MSIGRL. +.ih +SEE ALSO +msisqrgl +.endhelp diff --git a/math/iminterp/doc/msiinit.hlp b/math/iminterp/doc/msiinit.hlp new file mode 100644 index 00000000..68dba684 --- /dev/null +++ b/math/iminterp/doc/msiinit.hlp @@ -0,0 +1,41 @@ +.help msiinit Dec98 "Image Interpolation Package" +.ih +NAME +msiinit -- initialize the sequential interpolant descriptor +.ih +SYNOPSIS +include + +msiinit (msi, interp_type) + +.nf + pointer msi #U interpolant descriptor + int interp_type #I interpolant type +.fi +.ih +ARGUMENTS +.ls msi +Pointer to the sequential interpolant descriptor. +.le +.ls interp_type +Interpolant type. The options are II_BINEAREST, II_BILINEAR, II_BIPOLY3, +II_BIPOLY5, II_BISPLINE3, II_BISINC, II_BILSINC, and II_BIDRIZZLE, for +nearest neighbour, bilinear, 3rd and 5th order interior polynomials, bicubic +spline, sinc, look-up table sinc, and drizzle respectively. The interpolant +definitions are found in the package header file math/iminterp.h. +.le +.ih +DESCRIPTION +The interpolant type is allocated and initialized. The pointer msi is +returned by MSIINIT. The sinc interpolant width defaults to 31 pixels +in x and y. The look-up table sinc resolution defaults to 20 resolution +elements or 0.05 pixels in x and y. The drizzle pixel fraction defaults +to 1.0. +.ih +NOTES +MSIINIT, MSISINIT or MSIRESTORE must be called before using any other +MSI routines. +.ih +SEE ALSO +msirestore, msifree +.endhelp diff --git a/math/iminterp/doc/msirestore.hlp b/math/iminterp/doc/msirestore.hlp new file mode 100644 index 00000000..664c9b50 --- /dev/null +++ b/math/iminterp/doc/msirestore.hlp @@ -0,0 +1,36 @@ +.help msirestore Dec98 "Image Interpolator Package" +.ih +NAME +msirestore -- restore interpolant +.ih +SYNOPSIS +msirestore (msi, interpolant) + +.nf + pointer msi #U interpolant descriptor + real interpolant[] #I array containing interpolant +.fi +.ih +ARGUMENTS +.ls msi +Pointer to the interpolant descriptor structure. +.le +.ls interpolant +Array containing the interpolant. The amount of space required by interpolant +can be determined by a call to msigeti. +.le + +.nf + len_interpolant = msigeti (msi, II_MSINSAVE) +.fi +.ih +DESCRIPTION +MSIRESTORE allocates space for the interpolant descriptor and restores the +parameters and coefficients stored in the interpolant array to the +interpolant structure for use by MSIEVAL, MSIVECTOR, MSIDER and MSIGRL. +.ih +NOTES +.ih +SEE ALSO +msisave +.endhelp diff --git a/math/iminterp/doc/msisave.hlp b/math/iminterp/doc/msisave.hlp new file mode 100644 index 00000000..7d5f67ef --- /dev/null +++ b/math/iminterp/doc/msisave.hlp @@ -0,0 +1,38 @@ +.help msisave Dec98 "Image Interpolator Package" +.ih +NAME +msisave -- save interpolant +.ih +SYNOPSIS +msisave (msi, interpolant) + +.nf + pointer msi #I interpolant descriptor + real interpolant[] #O array containing the interpolant +.fi +.ih +ARGUMENTS +.ls msi +Pointer to the interpolant descriptor structure. +.le +.ls interpolant +Array where the interpolant is stored. The required interpolant array length +required can be determined by a call to msigeti. +.le + +.nf + len_interpolant = msigeti (msi, II_MSINSAVE) +.fi +.ih +DESCRIPTION +The interpolant type, number of coefficients in x and y, the position of +the first data point in the coefficient array, and the sinc and drizzle +interpolant parameters are stored in the first eleven elements of interpolant. +The remaining elements contain the coefficients and look-up tables +calculated by MSIFIT. +.ih +NOTES +.ih +SEE ALSO +msirestore +.endhelp diff --git a/math/iminterp/doc/msisinit.hlp b/math/iminterp/doc/msisinit.hlp new file mode 100644 index 00000000..0a05e7ab --- /dev/null +++ b/math/iminterp/doc/msisinit.hlp @@ -0,0 +1,61 @@ +.help msisinit Dec98 "Image Interpolator Package" +.ih +NAME +msisinit -- initialize the sequential interpolant descriptor using user parameters +.ih +SYNOPSIS +include + +msisinit (msi, interp_type, nsinc, nxincr, nyincr, pixfrac1, pixfrac2, badval) + +.nf + pointer msi #O interpolant descriptor + int interp_type #I interpolant type + int nsinc #I sinc interpolant width in pixels + int nxincr,nyincr #I sinc look-up table resolution + real pixfrac1,pixfrac2 #I sinc or drizzle pixel fractions + real badval #I drizzle undefined pixel value +.fi + +.ih +ARGUMENTS +.ls msi +Pointer to sequential interpolant descriptor. +.le +.ls interp_type +Interpolant type. The options are II_BINEAREST, II_BILINEAR, II_BIPOLY3, +II_BIPOLY5, II_BISPLINE3, II_BISINC, II_BILSINC, and II_BIDRIZZLE for the +nearest neighbour, linear, 3rd order polynomial, 5th order polynomial, +cubic spline, sinc, look-up table sinc, and drizzle interpolants respectively. +The interpolant type definitions are found in the package header file +math/iminterp.h. +.le +.ls nsinc +The sinc and look-up table sinc interpolant width in pixels. Nsinc is +rounded up internally to the nearest odd number. +.le +.ls nxincr, nyincr +The look-up table sinc resolution in x and y in number of entries. Nxincr = 10 +implies a pixel resolution of 0.1 pixels in x, nxincr = 20 a pixel resolution +of 0.05 pixels in x, etc. The default value of nxincr and nyincr are 20 and 20 +.le +.ls pixfrac1, pixfrac2 +The look-up table sinc fractional pixel shifts in x and y if nincr = 1 in +which case -0.5 <= rparam[1/2] <= 0.5 , or the drizzle pixel fractions in +which case 0.0 <= rparam[1/2] <= 1.0. +.le +.ls badval +The undefined pixel value for the drizzle interpolant. Pixels within +the boundaries of the input image which do not overlap the input image +pixels are assigned a value of badval. +.le +.ih +DESCRIPTION +The interpolant descriptor is allocated and initialized. The pointer msi is +returned by MSISINIT. +.ih +NOTES +MSIINIT or MSISINIT must be called before using any other MSI routines. +.ih +SEE ALSO +msisinit, msifree diff --git a/math/iminterp/doc/msisqgrl.hlp b/math/iminterp/doc/msisqgrl.hlp new file mode 100644 index 00000000..fc49514d --- /dev/null +++ b/math/iminterp/doc/msisqgrl.hlp @@ -0,0 +1,38 @@ +.help msisqgrl Dec98 "Image Interpolation Package" +.ih +NAME +msisqgrl -- integrate the interpolant over a rectangular region +.ih +SYNOPSIS +y = msisqgrl (msi, x1, x2, y1, y2) + +.nf + pointer msi #I interpolant descriptor + real x1 #I lower x limit, 1 <= x1 <= nxpix + real x2 #I upper x limit, 1 <= x2 <= nxpix + real y1 #I lower y limit, 1 <= y1 <= nypix + real y2 #I upper y limit, 1 <= y2 <= nypix +.fi +.ih +ARGUMENTS +.ls msi +Pointer to the sequential interpolant descriptor structure. +.le +.ls x1, x2 +The x limits of integration +.le +.ls y1, y2 +The y limits of integration. +.le +.ih +DESCRIPTION +MSISQGRL integrates the interpolant exactly for rectangular domains +of integration, including partial pixel regions. +.ih +NOTES +Checking for out of bound integration regimes is the responsibility of +the user. MSIFIT must be called before using MSISQGRL. +.ih +SEE ALSO +msigrl +.endhelp diff --git a/math/iminterp/doc/msitype.hlp b/math/iminterp/doc/msitype.hlp new file mode 100644 index 00000000..5da6dc6d --- /dev/null +++ b/math/iminterp/doc/msitype.hlp @@ -0,0 +1,95 @@ +.help msitype Dec98 "Image Interpolator Package" +.ih +NAME +msitype -- decode an interpolant string +.ih +SYNOPSIS +include + +msitype (interpstr, interp_type, nsinc, nincr, pixfrac) + +.nf + char interpstr #I the input interpolant string + int interp_type #O interpolant type + int nsinc #O sinc interpolant width in pixels + int nincr #O sinc look-up table resolution + real pixfrac #O sinc or drizzle pixel fraction +.fi + +.ih +ARGUMENTS +.ls interpstr +The user supplied interpolant string to be decoded. The options are +.ls nearest +Nearest neighbor interpolation. +.le +.ls linear +Bilinear interpolation +.le +.ls poly3 +Bicubic polynomial interpolation. +.le +.ls poly5 +Biquintic polynomial interpolation. +.le +.ls spline3 +Bicubic spline interpolation. +.le +.ls sinc +2D sinc interpolation. Users can specify the sinc interpolant width by +appending a width value to the interpolant string, e.g. sinc51 specifies +a 51 by 51 pixel wide sinc interpolant. The sinc width will be rounded up to +the nearest odd number. The default sinc width is 31 by 31. +.le +.ls lsinc +Look-up table sinc interpolation. Users can specify the look-up table sinc +interpolant width by appending a width value to the interpolant string, e.g. +lsinc51 specifies a 51 by 51 pixel wide look-up table sinc interpolant. The user +supplied sinc width will be rounded up to the nearest odd number. The default +sinc width is 31 by 31 pixels. Users can specify the resolution of the lookup +table sinc by appending the look-up table size in square brackets to the +interpolant string, e.g. lsinc51[20] specifies a 20 by 20 element sinc +look-up table interpolant with a pixel resolution of 0.05 pixels in x and y. +The default look-up table size and resolution are 20 by 20 and 0.05 pixels +in x and y respectively. +.le +.ls drizzle +Drizzle interpolation. Users can specify the drizzle pixel fraction by +appending the pixel fraction value to the interpolant string in square +brackets, e.g. drizzle[0.5] specifies a pixel fraction of 0.5 in x and y. +The default pixel fraction is 1.0. If either of the x or y pixel +fractions are 0.0, then both are set to 0.0. A minimum value of 0.001 +is imposed on the actual value of pixfrac. +.le +.le +.ls interp_type +The output interpolant type. The options are II_BINEAREST, II_BILINEAR, +II_BIPOLY3, II_BIPOLY5, II_BISPLINE3, II_BISINC, II_BILSINC, and II_BIDRIZZLE +for the nearest neighbor, linear, 3rd order polynomial, 5th order polynomial, +cubic spline, sinc, look-up table sinc, and drizzle interpolants respectively. +The interpolant type definitions are found in the package header file +math/iminterp.h. +.le +.ls nsinc +The output sinc and look-up table sinc interpolant width in pixels. The +default value is 31 pixels in x and y. +.le +.ls nincr +The output sinc look-up table size. Nincr = 10 implies a pixel resolution +of 0.1 pixels in x, nincr = 20 a pixel resolution of 0.05 pixels in y, etc. The +default value of nincr is 20. +.le +.ls pixfrac +The output look-up table sinc fractional pixel shift if nincr = 1 +in which case -0.5 <= pixfrac <= 0.5 , or the drizzle pixel +fraction in which case 0.0 <= pixfrac <= 1.0. +.le +.ih +DESCRIPTION +The interpolant string is decoded into values suitable for the MSISINIT +or MSIINIT routines. +.ih +NOTES +.ih +SEE ALSO +msinit, msisinit, msifree diff --git a/math/iminterp/doc/msivector.hlp b/math/iminterp/doc/msivector.hlp new file mode 100644 index 00000000..d6561be7 --- /dev/null +++ b/math/iminterp/doc/msivector.hlp @@ -0,0 +1,54 @@ +.help msivector Dec98 "Image Interpolation Package" +.ih +NAME +msivector -- evaluate the interpolant at an array of x and y points +.ih +SYNOPSIS +msivector (msi, x, y, zfit, npts) + +.nf + pointer msi #I interpolant descriptor + real x[npts/4*npts] #I x values, 1 <= x <= nxpix + real y[npts/4*npts] #I y values, 1 <= y <= nypix + real zfit[npts] #O interpolated values + int npts #I number of points +.fi +.ih +ARGUMENTS +.ls msi +The pointer to the sequential interpolant descriptor +.le +.ls x, y +The array of x and y values at or in the case tof the drizzle interpolant the +array of quadrilaterals over which to evaluate the interpolant. +.le +.ls zfit +The interpolated values. +.le +.ls npts +The number of points. +.le +.ih +DESCRIPTION +The polynomial coefficients are calculated directly from the data points, +The polynomial interpolants are evaluated using Everett's central difference +formula. The spline interpolant uses the B-spline coefficients +calculated using the MSIFIT routine. The boundary extension algorithm is +projection. + +The sinc interpolant is evaluated using a array of data points around +the point in question. The look-up table since is computed by convolving +the data with a pre-computed look-up table entry. The boundary extension +algorithm is nearest neighbor. + +The drizzle interpolant is evaluated by summing the data over the +list of user supplied quadrilaterals. +.ih +NOTES +Checking for out of bounds and INDEF valued pixels is the responsibility +of the user. MSIINIT or MSISINIT and MSIFIT must be called before using +MSIVECTOR. +.ih +SEE ALSO +msieval, mrieval +.endhelp diff --git a/math/iminterp/ii_1dinteg.x b/math/iminterp/ii_1dinteg.x new file mode 100644 index 00000000..05b80542 --- /dev/null +++ b/math/iminterp/ii_1dinteg.x @@ -0,0 +1,372 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "im1interpdef.h" +include + +# II_1DINTEG -- Find the integral of the interpolant from a to b be assuming +# that both a and b land in the array. This routine is not used directly +# in the 1D interpolation package but is actually called repeatedly from the +# 2D interpolation package. Therefore the SINC function interpolator has +# not been implemented, although it has been blocked in. + +real procedure ii_1dinteg (coeff, len_coeff, a, b, interp_type, nsinc, dx, + pixfrac) + +real coeff[ARB] # 1D array of coefficients +int len_coeff # length of coefficient array (used in sinc only) +real a # lower limit for integral +real b # upper limit for integral +int interp_type # type of 1D interpolant +int nsinc # width of sinc function +real dx # sinc precision +real pixfrac # drizzle pixel fraction + +int neara, nearb, i, j, nterms +real deltaxa, deltaxb, accum, xa, xb, pcoeff[MAX_NDERIVS] + +begin + # Flip order and sign at end. + xa = a + xb = b + if (a > b) { + xa = b + xb = a + } + + # Initialize. + neara = xa + nearb = xb + accum = 0. + + switch (interp_type) { + case II_NEAREST: + nterms = 0 + case II_LINEAR: + nterms = 1 + case II_DRIZZLE: + nterms = 0 + case II_POLY3: + nterms = 4 + case II_POLY5: + nterms = 6 + case II_SPLINE3: + nterms = 4 + case II_SINC, II_LSINC: + nterms = 0 + } + + switch (interp_type) { + # NEAREST + case II_NEAREST: + + # Reset segment to center values. + neara = xa + 0.5 + nearb = xb + 0.5 + + # Set up for first segment. + deltaxa = xa - neara + + # For clarity one segment case is handled separately. + + # Only one segment involved. + if (nearb == neara) { + + deltaxb = xb - nearb + accum = accum + (deltaxb - deltaxa) * coeff[neara] + + # More than one segment. + } else { + + # First segment. + accum = accum + (0.5 - deltaxa) * coeff[neara] + + # Middle segment. + do j = neara + 1, nearb - 1 { + accum = accum + coeff[j] + } + + # Last segment. + deltaxb = xb - nearb + accum = accum + (deltaxb + 0.5) * coeff[nearb] + } + + # LINEAR + case II_LINEAR: + + # Set up for first segment. + deltaxa = xa - neara + + # For clarity one segment case is handled separately. + + # Only one segment involved. + if (nearb == neara) { + + deltaxb = xb - nearb + accum = accum + (deltaxb - deltaxa) * coeff[neara] + + 0.5 * (coeff[neara+1] - coeff[neara]) * + (deltaxb * deltaxb - deltaxa * deltaxa) + + # More than one segment. + } else { + + # First segment. + accum = accum + (1. - deltaxa) * coeff[neara] + + 0.5 * (coeff[neara+1] - coeff[neara]) * + (1. - deltaxa * deltaxa) + + # Middle segment. + do j = neara + 1, nearb - 1 { + accum = accum + 0.5 * (coeff[j+1] + coeff[j]) + } + + # Last segment. + deltaxb = xb - nearb + accum = accum + coeff[nearb] * deltaxb + 0.5 * + (coeff[nearb+1] - coeff[nearb]) * deltaxb * deltaxb + } + + # DRIZZLE-- Note that to get get pixfrac an interface change was + # required. + case II_DRIZZLE: + if (pixfrac >= 1.0) + call ii_dzigrl1 (a, b, accum, coeff) + else + call ii_dzigrl (a, b, accum, coeff, pixfrac) + + # SINC -- Note that to get ncoeff, nsinc, and dx, an interface change + # was required. + case II_SINC, II_LSINC: + call ii_sincigrl (xa, xb, accum, coeff, len_coeff, nsinc, dx) + + # A higher order interpolant. + default: + + # Set up for first segment. + deltaxa = xa - neara + + # For clarity one segment case is handled separately. + + # Only one segment involved. + if (nearb == neara) { + + deltaxb = xb - nearb + call ii_getpcoeff (coeff, neara, pcoeff, interp_type) + do i = 1, nterms + accum = accum + (1./i) * pcoeff[i] * + (deltaxb ** i - deltaxa ** i) + + # More than one segment. + } else { + + # First segment. + call ii_getpcoeff (coeff, neara, pcoeff, interp_type) + do i = 1, nterms + accum = accum + (1./i) * pcoeff[i] * (1. - deltaxa ** i) + + # Middle segment. + do j = neara + 1, nearb - 1 { + call ii_getpcoeff (coeff, j, pcoeff, interp_type) + + do i = 1, nterms + accum = accum + (1./i) * pcoeff[i] + } + + # Last segment. + deltaxb = xb - nearb + call ii_getpcoeff (coeff, nearb, pcoeff, interp_type) + do i = 1, nterms + accum = accum + (1./i) * pcoeff[i] * deltaxb ** i + } + } + + if (a < b) + return (accum) + else + return (-accum) +end + + +# II_GETPCOEFF -- Generates polynomial coefficients if the interpolant is +# SPLINE3, POLY3 or POLY5. + +procedure ii_getpcoeff (coeff, index, pcoeff, interp_type) + +real coeff[ARB] # coefficient array +int index # coefficients wanted for index < x < index + 1 +real pcoeff[ARB] # polynomial coefficients +int interp_type # type of interpolant + +int i, k, nterms +real diff[MAX_NDERIVS] + +begin + # generate polynomial coefficients, first for spline + + if (interp_type == II_SPLINE3) { + + pcoeff[1] = coeff[index-1] + 4. * coeff[index] + coeff[index+1] + pcoeff[2] = 3. * (coeff[index+1] - coeff[index-1]) + pcoeff[3] = 3. * (coeff[index-1] - 2. * coeff[index] + + coeff[index+1]) + pcoeff[4] = -coeff[index-1] + 3. * coeff[index] - + 3. * coeff[index+1] + coeff[index+2] + } else { + + if (interp_type == II_POLY5) + nterms = 6 + + # must be POLY3 + else + nterms = 4 + + # Newton's form written in line to get polynomial from data + + # load data + do i = 1, nterms + diff[i] = coeff[index - nterms/2 + i] + + # generate difference table + do k = 1, nterms - 1 + do i = 1, nterms - k + diff[i] = (diff[i+1] - diff[i]) / k + + # shift to generate polynomial coefficients of (x - index) + do k = nterms, 2, -1 + do i = 2, k + diff[i] = diff[i] + diff[i-1] * (k - i - nterms/2) + + do i = 1, nterms + pcoeff[i] = diff[nterms + 1 - i] + } +end + + +# II_SINCIGRL -- Evaluate integral of sinc interpolator. +# The integral is computed by dividing interval into a number of equal +# size subintervals which are at most one pixel wide. The integral +# of each subinterval is the central value times the interval width. + +procedure ii_sincigrl (a, b, sum, data, npix, nsinc, mindx) + +real a, b # integral limits +real sum # output integral value +real data[npix] # input data array +int npix # number of pixels +int nsinc # sinc truncation length +real mindx # interpolation minimum + +int n +real x, y, dx, x1, x2 + +begin + x1 = min (a, b) + x2 = max (a, b) + n = max (1, nint (x2 - x1)) + dx = (x2 - x1) / n + + sum = 0. + for (x = x1 + dx / 2; x < x2; x = x + dx) { + call ii_sinc (x, y, 1, data, npix, nsinc, mindx) + sum = sum + y * dx + } +end + + +# II_DZIGRL -- Procedure to integrate the drizzle interpolant. + +procedure ii_dzigrl (a, b, sum, data, pixfrac) + +real a, b # x start and stop values, must be within [1,npts] +real sum # integgral value returned to the user +real data[ARB] # data to be interpolated +real pixfrac # the drizzle pixel fraction + +int j, neara, nearb +real hpixfrac, xa, xb, dx, accum + +begin + hpixfrac = pixfrac / 2.0 + + # Define the interval of integration. + xa = min (a, b) + xb = max (a, b) + neara = xa + 0.5 + nearb = xb + 0.5 + + # Initialize the integration + accum = 0.0 + if (neara == nearb) { + + dx = min (xb, nearb + hpixfrac) - max (xa, neara - hpixfrac) + if (dx > 0.0) + accum = accum + dx * data[neara] + + } else { + + # first segement + dx = neara + hpixfrac - max (xa, neara - hpixfrac) + if (dx > 0.0) + accum = accum + dx * data[neara] + + # interior segments. + do j = neara + 1, nearb - 1 + accum = accum + pixfrac * data[j] + + # last segment + dx = min (xb, nearb + hpixfrac) - (nearb - hpixfrac) + if (dx > 0.0) + accum = accum + dx * data[nearb] + } + + if (a > b) + sum = -accum + else + sum = accum +end + + +# II_DZIGRL1 -- Procedure to integrate the drizzle interpolant in the case +# where pixfrac = 1.0. + +procedure ii_dzigrl1 (a, b, sum, data) + +real a, b # x start and stop values, must be within [1,npts] +real sum # integgral value returned to the user +real data[ARB] # data to be interpolated + +int j, neara, nearb +real xa, xb, deltaxa, deltaxb, accum + +begin + # Define the interval of integration. + xa = min (a, b) + xb = max (a, b) + neara = xa + 0.5 + nearb = xb + 0.5 + deltaxa = xa - neara + deltaxb = xb - nearb + + # Only one segment involved. + accum = 0.0 + if (neara == nearb) { + + accum = accum + (deltaxb - deltaxa) * data[neara] + + } else { + + # First segment. + accum = accum + (0.5 - deltaxa) * data[neara] + + # Middle segment. + do j = neara + 1, nearb - 1 + accum = accum + data[j] + + # Last segment. + accum = accum + (deltaxb + 0.5) * data[nearb] + } + + if (a > b) + sum = -accum + else + sum = accum +end diff --git a/math/iminterp/ii_bieval.x b/math/iminterp/ii_bieval.x new file mode 100644 index 00000000..3469128e --- /dev/null +++ b/math/iminterp/ii_bieval.x @@ -0,0 +1,1080 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include + +# II_BINEAREST -- Procedure to evaluate the nearest neighbour interpolant. +# The real array coeff contains the coefficients of the 2D interpolant. +# The procedure assumes that 1 <= x <= nxpix and 1 <= y <= nypix and that +# coeff[1+first_point] = datain[1,1]. + +procedure ii_binearest (coeff, first_point, len_coeff, x, y, zfit, npts) + +real coeff[ARB] # 1D coefficient array +int first_point # offset of first data point +int len_coeff # row length of coeff +real x[npts] # array of x values +real y[npts] # array of y values +real zfit[npts] # array of interpolated values +int npts # number of points to be evaluated + +int nx, ny +int index +int i + +begin + do i = 1, npts { + + nx = x[i] + 0.5 + ny = y[i] + 0.5 + + # define pointer to data[nx,ny] + index = first_point + (ny - 1) * len_coeff + nx + + zfit[i] = coeff[index] + + } +end + + +# II_BILINEAR -- Procedure to evaluate the bilinear interpolant. +# The real array coeff contains the coefficients of the 2D interpolant. +# The procedure assumes that 1 <= x <= nxpix and 1 <= y <= nypix +# and that coeff[1+first_point] = datain[1,1]. + +procedure ii_bilinear (coeff, first_point, len_coeff, x, y, zfit, npts) + +real coeff[ARB] # 1D array of coefficients +int first_point # offset of first data point +int len_coeff # row length of coeff +real x[npts] # array of x values +real y[npts] # array of y values +real zfit[npts] # array of interpolated values +int npts # number of data points + +int nx, ny +int index +int i +real sx, sy, tx, ty + +begin + do i = 1, npts { + + nx = x[i] + ny = y[i] + + sx = x[i] - nx + tx = 1. - sx + sy = y[i] - ny + ty = 1. - sy + + # define pointer to data[nx,ny] + index = first_point + (ny - 1) * len_coeff + nx + + zfit[i] = tx * ty * coeff[index] + sx * ty * coeff[index + 1] + + sy * tx * coeff[index+len_coeff] + + sx * sy * coeff[index+len_coeff+1] + } +end + + +# II_BIPOLY3 -- Procedure to evaluate the bicubic polynomial interpolant. +# The real array coeff contains the coefficients of the 2D interpolant. +# The procedure assumes that 1 <= x <= nxpix and 1 <= y <= nypix +# and that coeff[1+first_point] = datain[1,1]. The interpolant is +# evaluated using Everett's central difference formula. + +procedure ii_bipoly3 (coeff, first_point, len_coeff, x, y, zfit, npts) + +real coeff[ARB] # 1D array of coefficients +int first_point # offset first point +int len_coeff # row length of the coefficient array +real x[npts] # array of x values +real y[npts] # array of y values +real zfit[npts] # array of fitted values +int npts # number of points to be evaluated + +int nxold, nyold, nx, ny +int first_row, index +int i, j +real sx, tx, sx2m1, tx2m1, sy, ty +real cd20[4], cd21[4], ztemp[4], cd20y, cd21y + +begin + nxold = -1 + nyold = -1 + + do i = 1, npts { + + nx = x[i] + sx = x[i] - nx + tx = 1. - sx + sx2m1 = sx * sx - 1. + tx2m1 = tx * tx - 1. + + ny = y[i] + sy = y[i] - ny + ty = 1. - sy + + # define pointer to datain[nx,ny-1] + first_row = first_point + (ny - 2) * len_coeff + nx + + # loop over the 4 surrounding rows of data + # calculate the central differences at each value of y + + # if new data point caculate the central differnences in x + # for each y + + index = first_row + if (nx != nxold || ny != nyold) { + do j = 1, 4 { + cd20[j] = 1./6. * (coeff[index+1] - 2. * coeff[index] + + coeff[index-1]) + cd21[j] = 1./6. * (coeff[index+2] - 2. * coeff[index+1] + + coeff[index]) + index = index + len_coeff + } + } + + # interpolate in x at each value of y + index = first_row + do j = 1, 4 { + ztemp[j] = sx * (coeff[index+1] + sx2m1 * cd21[j]) + + tx * (coeff[index] + tx2m1 * cd20[j]) + index = index + len_coeff + } + + # calculate y central differences + cd20y = 1./6. * (ztemp[3] - 2. * ztemp[2] + ztemp[1]) + cd21y = 1./6. * (ztemp[4] - 2. * ztemp[3] + ztemp[2]) + + # interpolate in y + zfit[i] = sy * (ztemp[3] + (sy * sy - 1.) * cd21y) + + ty * (ztemp[2] + (ty * ty - 1.) * cd20y) + + nxold = nx + nyold = ny + + } +end + + +# II_BIPOLY5 -- Procedure to evaluate a biquintic polynomial. +# The real array coeff contains the coefficents of the 2D interpolant. +# The routine assumes that 1 <= x <= nxpix and 1 <= y <= nypix +# and that coeff[1+first_point] = datain[1,1]. The interpolant is evaluated +# using Everett's central difference formula. + +procedure ii_bipoly5 (coeff, first_point, len_coeff, x, y, zfit, npts) + +real coeff[ARB] # 1D array of coefficients +int first_point # offset to first data point +int len_coeff # row length of coeff +real x[npts] # array of x values +real y[npts] # array of y values +real zfit[npts] # array of fitted values +int npts # number of points + +int nxold, nyold, nx, ny +int first_row, index +int i, j +real sx, sx2, sx2m1, sx2m4, tx, tx2, tx2m1, tx2m4, sy, sy2, ty, ty2 +real cd20[6], cd21[6], cd40[6], cd41[6], ztemp[6] +real cd20y, cd21y, cd40y, cd41y + +begin + nxold = -1 + nyold = -1 + + do i = 1, npts { + + nx = x[i] + sx = x[i] - nx + sx2 = sx * sx + sx2m1 = sx2 - 1. + sx2m4 = sx2 - 4. + tx = 1. - sx + tx2 = tx * tx + tx2m1 = tx2 - 1. + tx2m4 = tx2 - 4. + + ny = y[i] + sy = y[i] - ny + sy2 = sy * sy + ty = 1. - sy + ty2 = ty * ty + + # calculate value of pointer to data[nx,ny-2] + first_row = first_point + (ny - 3) * len_coeff + nx + + # calculate the central differences in x at each value of y + index = first_row + if (nx != nxold || ny != nyold) { + do j = 1, 6 { + cd20[j] = 1./6. * (coeff[index+1] - 2. * coeff[index] + + coeff[index-1]) + cd21[j] = 1./6. * (coeff[index+2] - 2. * coeff[index+1] + + coeff[index]) + cd40[j] = 1./120. * (coeff[index-2] - 4. * coeff[index-1] + + 6. * coeff[index] - 4. * coeff[index+1] + + coeff[index+2]) + cd41[j] = 1./120. * (coeff[index-1] - 4. * coeff[index] + + 6. * coeff[index+1] - 4. * coeff[index+2] + + coeff[index+3]) + index = index + len_coeff + } + } + + # interpolate in x at each value of y + index = first_row + do j = 1, 6 { + ztemp[j] = sx * (coeff[index+1] + sx2m1 * (cd21[j] + sx2m4 * + cd41[j])) + tx * (coeff[index] + tx2m1 * + (cd20[j] + tx2m4 * cd40[j])) + index = index + len_coeff + } + + # central differences in y + cd20y = 1./6. * (ztemp[4] - 2. * ztemp[3] + ztemp[2]) + cd21y = 1./6. * (ztemp[5] - 2. * ztemp[4] + ztemp[3]) + cd40y = 1./120. * (ztemp[1] - 4. * ztemp[2] + 6. * ztemp[3] - + 4. * ztemp[4] + ztemp[5]) + cd41y = 1./120. * (ztemp[2] - 4. * ztemp[3] + 6. * ztemp[4] - + 4. * ztemp[5] + ztemp[6]) + + # interpolate in y + zfit[i] = sy * (ztemp[4] + (sy2 - 1.) * (cd21y + (sy2 - 4.) * + cd41y)) + ty * (ztemp[3] + (ty2 - 1.) * (cd20y + + (ty2 - 4.) * cd40y)) + + nxold = nx + nyold = ny + + } +end + + +# II_BISPLINE3 -- Procedure to evaluate a bicubic spline. +# The real array coeff contains the B-spline coefficients. +# The procedure assumes that 1 <= x <= nxpix and 1 <= y <= nypix +# and that coeff[1+first_point] = B-spline[2]. + +procedure ii_bispline3 (coeff, first_point, len_coeff, x, y, zfit, npts) + +real coeff[ARB] # 1D array of coefficients +int first_point # offset to first data point +int len_coeff # row length of coeff +real x[npts] # array of x values +real y[npts] # array of y values +real zfit[npts] # array of interpolated values +int npts # number of points to be evaluated + +int nx, ny +int first_row, index +int i, j +real sx, tx, sy, ty +real bx[4], by[4], accum, sum + +begin + do i = 1, npts { + + nx = x[i] + sx = x[i] - nx + tx = 1. - sx + + ny = y[i] + sy = y[i] - ny + ty = 1. - sy + + + # calculate the x B-splines + bx[1] = tx ** 3 + bx[2] = 1. + tx * (3. + tx * (3. - 3. * tx)) + bx[3] = 1. + sx * (3. + sx * (3. - 3. * sx)) + bx[4] = sx ** 3 + + # calculate the y B-splines + by[1] = ty ** 3 + by[2] = 1. + ty * (3. + ty * (3. - 3. * ty)) + by[3] = 1. + sy * (3. + sy * (3. - 3. * sy)) + by[4] = sy ** 3 + + # calculate the pointer to data[nx,ny-1] + first_row = first_point + (ny - 2) * len_coeff + nx + + # evaluate spline + accum = 0. + index = first_row + do j = 1, 4 { + sum = coeff[index-1] * bx[1] + coeff[index] * bx[2] + + coeff[index+1] * bx[3] + coeff[index+2] * bx[4] + accum = accum + sum * by[j] + index = index + len_coeff + } + + zfit[i] = accum + } +end + + +# II_BISINC -- Procedure to evaluate the 2D sinc function. The real array +# coeff contains the data. The procedure assumes that 1 <= x <= nxpix and +# 1 <= y <= nypix and that coeff[1+first_point] = datain[1,1]. The since +# truncation length is nsinc. The taper is a cosbell function which is +# valid for 0 <= x <= PI / 2 (Abramowitz and Stegun, 1972, Dover Publications, +# p 76). If the point to be interpolated is less than mindx and mindy from +# a data point no interpolation is done and the data point is returned. This +# routine does not use precomputed arrays. + +procedure ii_bisinc (coeff, first_point, len_coeff, len_array, x, y, zfit, + npts, nsinc, mindx, mindy) + +real coeff[ARB] # 1D array of coefficients +int first_point # offset to first data point +int len_coeff # row length of coeff +int len_array # column length of coeff +real x[npts] # array of x values +real y[npts] # array of y values +real zfit[npts] # array of interpolated values +int npts # the number of input points. +int nsinc # sinc truncation length +real mindx # interpolation mininmum in x +real mindy # interpolation mininmum in y + +int i, j, k, nconv, nx, ny, index, mink, maxk, offk, minj, maxj, offj +int last_point +pointer sp, taper, ac, ar +real sconst, a2, a4, sdx, dx, dy, dxn, dyn, ax, ay, px, py, sumx, sumy, sum +real dx2 + +begin + # Compute the length of the convolution. + nconv = 2 * nsinc + 1 + + # Allocate working array space. + call smark (sp) + call salloc (taper, nconv, TY_REAL) + call salloc (ac, nconv, TY_REAL) + call salloc (ar, nconv, TY_REAL) + + # Compute the constants for the cosine bell taper. + sconst = (HALFPI / nsinc) ** 2 + a2 = -0.49670 + a4 = 0.03705 + + # Precompute the taper array. Incorporate the sign change portion + # of the sinc interpolator into the taper array. + if (mod (nsinc, 2) == 0) + sdx = 1.0 + else + sdx = -1.0 + do j = -nsinc, nsinc { + dx2 = sconst * j * j + Memr[taper+j+nsinc] = sdx * (1.0 + a2 * dx2 + a4 * dx2 * dx2) ** 2 + sdx = -sdx + } + + do i = 1, npts { + + # define the fractional pixel interpolation. + nx = nint (x[i]) + ny = nint (y[i]) + if (nx < 1 || nx > len_coeff || ny < 1 || ny > len_array) { + zfit[i] = 0.0 + next + } + dx = x[i] - nx + dy = y[i] - ny + + # define pointer to data[nx,ny] + if (abs (dx) < mindx && abs (dy) < mindy) { + index = first_point + (ny - 1) * len_coeff + nx + zfit[i] = coeff[index] + next + } + + # initialize. + #dxn = -1-nsinc-dx + #dyn = -1-nsinc-dy + dxn = 1 + nsinc + dx + dyn = 1 + nsinc + dy + + # Compute the x and y sinc arrays using a cosbell taper. + sumx = 0.0 + sumy = 0.0 + do j = 1, nconv { + + #ax = j + dxn + #ay = j + dyn + ax = dxn - j + ay = dyn - j + if (ax == 0.0) + px = 1.0 + else if (dx == 0.0) + px = 0.0 + else + px = Memr[taper+j-1] / ax + if (ay == 0.0) + py = 1.0 + else if (dy == 0.0) + py = 0.0 + else + py = Memr[taper+j-1] / ay + + Memr[ac+j-1] = px + Memr[ar+j-1] = py + sumx = sumx + px + sumy = sumy + py + } + + # Compute the limits of the convolution. + minj = max (1, ny - nsinc) + maxj = min (len_array, ny + nsinc) + offj = ar - ny + nsinc + mink = max (1, nx - nsinc) + maxk = min (len_coeff, nx + nsinc) + offk = ac - nx + nsinc + + # Initialize + zfit[i] = 0.0 + + # Do the convolution. + do j = ny - nsinc, minj - 1 { + sum = 0.0 + do k = nx - nsinc, mink - 1 + sum = sum + Memr[k+offk] * coeff[first_point+1] + do k = mink, maxk + sum = sum + Memr[k+offk] * coeff[first_point+k] + do k = maxk + 1, nx + nsinc + sum = sum + Memr[k+offk] * coeff[first_point+len_coeff] + + zfit[i] = zfit[i] + Memr[j+offj] * sum + } + + do j = minj, maxj { + index = first_point + (j - 1) * len_coeff + sum = 0.0 + do k = nx - nsinc, mink - 1 + sum = sum + Memr[k+offk] * coeff[index+1] + do k = mink, maxk + sum = sum + Memr[k+offk] * coeff[index+k] + do k = maxk + 1, nx + nsinc + sum = sum + Memr[k+offk] * coeff[index+len_coeff] + + zfit[i] = zfit[i] + Memr[j+offj] * sum + } + + do j = maxj + 1, ny + nsinc { + last_point = first_point + (len_array - 1) * len_coeff + sum = 0.0 + do k = nx - nsinc, mink - 1 + sum = sum + Memr[k+offk] * coeff[last_point+1] + do k = mink, maxk + sum = sum + Memr[k+offk] * coeff[last_point+k] + do k = maxk + 1, nx + nsinc + sum = sum + Memr[k+offk] * coeff[last_point+len_coeff] + + zfit[i] = zfit[i] + Memr[j+offj] * sum + } + + # Normalize. + zfit[i] = zfit[i] / sumx / sumy + } + + call sfree (sp) +end + + +# II_BILSINC -- Procedure to evaluate the 2D sinc function. The real array +# coeff contains the data. The procedure assumes that 1 <= x <= nxpix and +# 1 <= y <= nypix and that coeff[1+first_point] = datain[1,1]. The since +# truncation length is nsinc. The taper is a cosbell function which is +# valid for 0 <= x <= PI / 2 (Abramowitz and Stegun, 1972, Dover Publications, +# p 76). If the point to be interpolated is less than mindx and mindy from +# a data point no interpolation is done and the data point is returned. This +# routine does use precomputed arrays. + +procedure ii_bilsinc (coeff, first_point, len_coeff, len_array, x, y, zfit, + npts, ltable, nconv, nxincr, nyincr, mindx, mindy) + +real coeff[ARB] # 1D array of coefficients +int first_point # offset to first data point +int len_coeff # row length of coeff +int len_array # column length of coeff +real x[npts] # array of x values +real y[npts] # array of y values +real zfit[npts] # array of interpolated values +int npts # the number of input points. +real ltable[nconv,nconv,nxincr,nyincr] # the pre-computed look-up table +int nconv # the sinc truncation full width +int nxincr # the interpolation resolution in x +int nyincr # the interpolation resolution in y +real mindx # interpolation mininmum in x +real mindy # interpolation mininmum in y + +int i, j, k, nsinc, xc, yc, lutx, luty, minj, maxj, offj, mink, maxk, offk +int index, last_point +real dx, dy, sum + +begin + nsinc = (nconv - 1) / 2 + do i = 1, npts { + + # Return zero outside of data. + xc = nint (x[i]) + yc = nint (y[i]) + if (xc < 1 || xc > len_coeff || yc < 1 || yc > len_array) { + zfit[i] = 0.0 + next + } + + dx = x[i] - xc + dy = y[i] - yc + if (abs(dx) < mindx && abs(dy) < mindy) { + index = first_point + (yc - 1) * len_coeff + xc + zfit[i] = coeff[index] + } + + # Find the correct look-up table entry. + if (nxincr == 1) + lutx = 1 + else + lutx = nint ((-dx + 0.5) * (nxincr - 1)) + 1 + #lutx = int ((-dx + 0.5) * (nxincr - 1) + 0.5) + 1 + if (nyincr == 1) + luty = 1 + else + luty = nint ((-dy + 0.5) * (nyincr - 1)) + 1 + #luty = int ((-dy + 0.5) * (nyincr - 1) + 0.5) + 1 + + # Compute the convolution limits. + minj = max (1, yc - nsinc) + maxj = min (len_array, yc + nsinc) + offj = 1 - yc + nsinc + mink = max (1, xc - nsinc) + maxk = min (len_coeff, xc + nsinc) + offk = 1 - xc + nsinc + + # Initialize + zfit[i] = 0.0 + + # Do the convolution. + do j = yc - nsinc, minj - 1 { + sum = 0.0 + do k = xc - nsinc, mink - 1 + sum = sum + ltable[k+offk,j+offj,lutx,luty] * + coeff[first_point+1] + do k = mink, maxk + sum = sum + ltable[k+offk,j+offj,lutx,luty] * + coeff[first_point+k] + do k = maxk + 1, xc + nsinc + sum = sum + ltable[k+offk,j+offj,lutx,luty] * + coeff[first_point+len_coeff] + zfit[i] = zfit[i] + sum + } + + do j = minj, maxj { + index = first_point + (j - 1) * len_coeff + sum = 0.0 + do k = xc - nsinc, mink - 1 + sum = sum + ltable[k+offk,j+offj,lutx,luty] * coeff[index+1] + do k = mink, maxk + sum = sum + ltable[k+offk,j+offj,lutx,luty] * coeff[index+k] + do k = maxk + 1, xc + nsinc + sum = sum + ltable[k+offk,j+offj,lutx,luty] * + coeff[index+len_coeff] + zfit[i] = zfit[i] + sum + } + + do j = maxj + 1, yc + nsinc { + last_point = first_point + (len_array - 1) * len_coeff + sum = 0.0 + do k = xc - nsinc, mink - 1 + sum = sum + ltable[k+offk,j+offj,lutx,luty] * + coeff[last_point+1] + do k = mink, maxk + sum = sum + ltable[k+offk,j+offj,lutx,luty] * + coeff[last_point+k] + do k = maxk + 1, xc + nsinc + sum = sum + ltable[k+offk,j+offj,lutx,luty] * + coeff[last_point+len_coeff] + zfit[i] = zfit[i] + sum + } + + } +end + + +# II_BIDRIZ -- Procedure to evaluate the drizzle interpolant. +# The real array coeff contains the coefficients of the 2D interpolant. +# The procedure assumes that 1 <= x <= nxpix and 1 <= y <= nypix and that +# coeff[1+first_point] = datain[1,1]. Each x and y value is a set of 4 +# values describing the vertices of a quadrilateral in the input data. The +# integration routine was adapted from the one developed by Bill Sparks at +# ST and used the DITHER / DRIZZLE software. The 4 points describing the +# corners of each quadrilateral integration region must be in order, e.g. +# describe the vertices of a polygon in either CW or CCW order. + +procedure ii_bidriz (coeff, first_point, len_coeff, x, y, zfit, npts, + xfrac, yfrac, badval) + +real coeff[ARB] # 1D coefficient array +int first_point # offset of first data point +int len_coeff # row length of coeff +real x[ARB] # array of x values +real y[ARB] # array of y values +real zfit[npts] # array of interpolated values +int npts # number of points to be evaluated +real xfrac, yfrac # the x and y drizzle pixel fractions +real badval # undefined pixel value + +int i, ii, jj, kk, index, nearax, nearbx, nearay, nearby +real px[5], py[5], dx, xmin, xmax, m, c, ymin, ymax, xtop +real ovlap, accum, waccum, dxfrac, dyfrac, hxfrac, hyfrac, dhxfrac, dhyfrac +bool negdx + +begin + dxfrac = max (0.0, min (1.0, 1.0 - xfrac)) + hxfrac = max (0.0, min (0.5, dxfrac / 2.0)) + dhxfrac = max (0.5, min (1.0, 1.0 - hxfrac)) + dyfrac = max (0.0, min (1.0, 1.0 - yfrac)) + hyfrac = max (0.0, min (0.5, dyfrac / 2.0)) + dhyfrac = max (0.5, min (1.0, 1.0 - hyfrac)) + + do i = 1, npts { + + # Compute the limits of the integration in x and y. + nearax = nint (min (x[4*i-3], x[4*i-2], x[4*i-1], x[4*i])) + nearbx = nint (max (x[4*i-3], x[4*i-2], x[4*i-1], x[4*i])) + nearay = nint (min (y[4*i-3], y[4*i-2], y[4*i-1], y[4*i])) + nearby = nint (max (y[4*i-3], y[4*i-2], y[4*i-1], y[4*i])) + + # Initialize. + accum = 0.0 + waccum = 0.0 + + # Loop over all pixels which contribute to the integral. + do jj = nearay, nearby { + index = first_point + (jj - 1) * len_coeff + do kk = 1, 4 + py[kk] = y[4*i+kk-4] - jj + 0.5 + py[5] = py[1] + do ii = nearax, nearbx { + + # Transform the coordinates relative to a unit + # square centered at the origin of the pixel. We + # are going to approximate the new pixel area by + # a quadilateral. Close the quadilateral. + + do kk = 1, 4 + px[kk] = x[4*i+kk-4] - ii + 0.5 + px[5] = px[1] + + # Compute the area overlap of the output pixel with + # the input pixels. + ovlap = 0.0 + do kk = 1, 4 { + + # Check for vertical line segment. + dx = px[kk+1] - px[kk] + if (dx == 0.0) + next + + # Order the x integration limits. + if (px[kk] < px[kk+1]) { + xmin = px[kk] + xmax = px[kk+1] + } else { + xmin = px[kk+1] + xmax = px[kk] + } + + # Check the x limits ignoring y for now. + if ((xmin >= dhxfrac) || (xmax <= hxfrac)) + next + xmin = max (xmin, hxfrac) + xmax = min (xmax, dhxfrac) + + # Get basic info about the line y = mx + c. + if (dx < 0.0) + negdx = true + else + negdx = false + m = (py[kk+1] - py[kk]) / dx + c = py[kk] - m * px[kk] + ymin = m * xmin + c + ymax = m * xmax + c + + # Trap segment entirely below axis. + if (ymin <= hyfrac && ymax <= hyfrac) + next + + # Adjust bounds if segment crosses axis in order + # to exclude anything below the axis. + if (ymin < hyfrac) { + ymin = hyfrac + xmin = (hyfrac - c) / m + } + if (ymax < hyfrac) { + ymax = hyfrac + xmax = (hyfrac - c) / m + } + + # There are four possibilities. + + # Both y above 1.0 - hyfrac. Line segment is entirely + # above square. + if ((ymin >= dhyfrac) && (ymax >= dhyfrac)) { + + if (negdx) + ovlap = ovlap + (xmin - xmax) * yfrac + else + ovlap = ovlap + (xmax - xmin) * yfrac + + # Both y below 1.0 - hyfrac. Segment is entirely + # within square. + } else if ((ymin <= dhyfrac) && (ymax <= dhyfrac)) { + + if (negdx) + ovlap = ovlap + 0.5 * (xmin - xmax) * + (ymax + ymin - dyfrac) + else + ovlap = ovlap + 0.5 * (xmax - xmin) * + (ymax + ymin - dyfrac) + + # One of each. Segment must cross top of square. + } else { + + xtop = (dhyfrac - c) / m + + # insert precision check ? + + if (ymin < dhyfrac) { + if (negdx) + ovlap = ovlap - (0.5 * (xtop - xmin) * + (ymin + 1.0 - 3.0 * hyfrac) + + (xmax - xtop) * yfrac) + else + ovlap = ovlap + (0.5 * (xtop - xmin) * + (ymin + 1.0 - 3.0 * hyfrac) + + (xmax - xtop) * yfrac) + } else { + if (negdx) + ovlap = ovlap - (0.5 * (xmax - xtop) * + (ymax + 1.0 - 3.0 * hyfrac) + + (xtop - xmin) * yfrac) + else + ovlap = ovlap + (0.5 * (xmax - xtop) * + (ymax + 1.0 - 3.0 * hyfrac) + + (xtop - xmin) * yfrac) + } + + } + } + + accum = accum + coeff[index+ii] * ovlap + waccum = waccum + ovlap + } + } + + if (waccum == 0.0) + zfit[i] = badval + else + zfit[i] = accum / waccum + } +end + + +# II_BIDRIZ1 -- Procedure to evaluate the drizzle interpolant when xfrac and +# yfrac are 1.0. The real array coeff contains the coefficients of the 2D +# interpolant. The procedure assumes that 1 <= x <= nxpix and 1 <= y <= nypix +# and that coeff[1+first_point] = datain[1,1]. Each x and y point is a set of 4 +# values describing the vertices of a quadrilateral in the input data. The +# integration routine was adapted from the one developed by Bill Sparks at +# ST and used the DITHER / DRIZZLE software. The 4 points describing the +# corners of each quadrilateral integration region must be in order, e.g. +# describe the vertices of a polygon in either CW or CCW order. + +procedure ii_bidriz1 (coeff, first_point, len_coeff, x, y, zfit, npts, badval) + +real coeff[ARB] # 1D coefficient array +int first_point # offset of first data point +int len_coeff # row length of coeff +real x[ARB] # array of x values +real y[ARB] # array of y values +real zfit[npts] # array of interpolated values +int npts # number of points to be evaluated +real badval # undefined pixel value + +int i, ii, jj, kk, index, nearax, nearbx, nearay, nearby +real px[5], py[5], dx, xmin, xmax, m, c, ymin, ymax, xtop +real ovlap, accum, waccum +bool negdx + +begin + do i = 1, npts { + + # Compute the limits of the integration in x and y. + nearax = nint (min (x[4*i-3], x[4*i-2], x[4*i-1], x[4*i])) + nearbx = nint (max (x[4*i-3], x[4*i-2], x[4*i-1], x[4*i])) + nearay = nint (min (y[4*i-3], y[4*i-2], y[4*i-1], y[4*i])) + nearby = nint (max (y[4*i-3], y[4*i-2], y[4*i-1], y[4*i])) + + # Initialize. + accum = 0.0 + waccum = 0.0 + + # Loop over all pixels which contribute to the integral. + do jj = nearay, nearby { + index = first_point + (jj - 1) * len_coeff + do kk = 1, 4 + py[kk] = y[4*i+kk-4] - jj + 0.5 + py[5] = py[1] + do ii = nearax, nearbx { + + # Transform the coordinates relative to a unit + # square centered at the origin of the pixel. We + # are going to approximate the new pixel area by + # a quadilateral. Close the polygon. + + do kk = 1, 4 + px[kk] = x[4*i+kk-4] - ii + 0.5 + px[5] = px[1] + + # Compute the area overlap of the output pixel with + # the input pixels. + ovlap = 0.0 + do kk = 1, 4 { + + # Check for vertical line segment. + dx = px[kk+1] - px[kk] + if (dx == 0.0) + next + + # Order the x integration limits. + if (px[kk] < px[kk+1]) { + xmin = px[kk] + xmax = px[kk+1] + } else { + xmin = px[kk+1] + xmax = px[kk] + } + + # Check the x limits ignoring y for now. + if (xmin >= 1.0 || xmax <= 0.0) + next + xmin = max (xmin, 0.0) + xmax = min (xmax, 1.0) + + # Get basic info about the line y = mx + c. + if (dx < 0.0) + negdx = true + else + negdx = false + m = (py[kk+1] - py[kk]) / dx + c = py[kk] - m * px[kk] + ymin = m * xmin + c + ymax = m * xmax + c + + # Trap segment entirely below axis. + if (ymin <= 0.0 && ymax <= 0.0) + next + + # Adjust bounds if segment crosses axis in order + # to exclude anything below the axis. + if (ymin < 0.0) { + ymin = 0.0 + xmin = - c / m + } + if (ymax < 0.0) { + ymax = 0.0 + xmax = - c / m + } + + # There are four possibilities. + + # Both y above 1.0. Line segment is entirely above + # square. + if (ymin >= 1.0 && ymax >= 1.0) { + + if (negdx) + ovlap = ovlap + (xmin - xmax) + else + ovlap = ovlap + (xmax - xmin) + + # Both y below 1.0. Segment is entirely within square. + } else if (ymin <= 1.0 && ymax <= 1.0) { + + if (negdx) + ovlap = ovlap + 0.5 * (xmin - xmax) * + (ymax + ymin) + else + ovlap = ovlap + 0.5 * (xmax - xmin) * + (ymax + ymin) + + # One of each. Segment must cross top of square. + } else { + + xtop = (1.0 - c) / m + + # insert precision check, e.g. possible pixel + # overlap ? need to decide what action to take ... + + if (ymin < 1.0) { + if (negdx) + ovlap = ovlap - (0.5 * (xtop - xmin) * + (1.0 + ymin) + (xmax - xtop)) + else + ovlap = ovlap + (0.5 * (xtop - xmin) * + (1.0 + ymin) + (xmax - xtop)) + } else { + if (negdx) + ovlap = ovlap - (0.5 * (xmax - xtop) * + (1.0 + ymax) + (xtop - xmin)) + else + ovlap = ovlap + (0.5 * (xmax - xtop) * + (1.0 + ymax) + (xtop - xmin)) + } + + } + } + + accum = accum + coeff[index+ii] * ovlap + waccum = waccum + ovlap + } + } + + if (waccum == 0.0) + zfit[i] = badval + else + zfit[i] = accum / waccum + } +end + + +# II_BIDRIZ0-- Procedure to evaluate the drizzle interpolant when xfrac and +# yfrac are 0.0. The real array coeff contains the coefficients of the 2D +# interpolant. The procedure assumes that 1 <= x <= nxpix and 1 <= y <= nypix +# and that coeff[1+first_point] = datain[1,1]. Each x and y point is a set of 4 +# values describing the vertices of a quadrilateral in the input data. The +# integration routine determines whether a pixel is in, out, on the edge +# of or at a vertex of a polygon. The 4 points describing the corners of +# each quadrilateral integration region must be in order, e.g. describe +# the vertices of a polygon in either CW or CCW order. +# THIS ROUTINE IS NOT CURRENTLY BEING USED. + +procedure ii_bidriz0 (coeff, first_point, len_coeff, x, y, zfit, npts, badval) + +real coeff[ARB] # 1D coefficient array +int first_point # offset of first data point +int len_coeff # row length of coeff +real x[ARB] # array of x values +real y[ARB] # array of y values +real zfit[npts] # array of interpolated values +int npts # number of points to be evaluated +real badval # the undefined pixel value + +bool boundary, vertex +int i, jj, ii, kk, nearax, nearbx, nearay, nearby, ninter +real accum, waccum, px[5], py[5], lx, ld, u1, u2, u1u2, dx, dy, dd +real xi, ovlap, xmin, xmax + +begin + do i = 1, npts { + + # Compute the limits of the integration in x and y. + nearax = nint (min (x[4*i-3], x[4*i-2], x[4*i-1], x[4*i])) + nearbx = nint (max (x[4*i-3], x[4*i-2], x[4*i-1], x[4*i])) + nearay = nint (min (y[4*i-3], y[4*i-2], y[4*i-1], y[4*i])) + nearby = nint (max (y[4*i-3], y[4*i-2], y[4*i-1], y[4*i])) + + # Initialize. + accum = 0.0 + waccum = 0.0 + + # Loop over all pixels which contribute to the integral. + do jj = nearay, nearby { + do ii = nearax, nearbx { + + # Transform the coordinates relative to a unit + # square centered at the origin of the pixel. We + # are going to approximate the new pixel area by + # a quadilateral. Close the quadrilateral. + + do kk = 1, 4 { + px[kk] = x[4*i+kk-4] - ii + 0.5 + py[kk] = y[4*i+kk-4] - jj + 0.5 + } + px[5] = px[1] + py[5] = py[1] + + # Initialize the integration. + ovlap = 0.0 + ninter = 0 + + # Define a line segment which begins at the point x = 0.5 + # y = 0.5 and runs parallel to the y axis. + call alimr (px, 5, xmin, xmax) + lx = xmax - xmin + ld = 0.5 * lx + u1 = -lx * py[1] + ld + boundary = false + vertex = false + do kk = 2, 5 { + + u2 = -lx * py[kk] + ld + u1u2 = u1 * u2 + + # No intersection. + if (u1*u2 > 0.0) { + ; + + # Intersection with polygon line segment. + } else if (u1 != 0.0 && u2 != 0.0) { + dy = py[kk-1] - py[kk] + dx = px[kk-1] - px[kk] + dd = px[kk-1] * py[kk] - py[kk-1] * px[kk] + xi = (dx * ld - lx * dd) / (dy * lx) + if (xi > 0.5) + ninter = ninter + 1 + if (xi == 0.5) + boundary = true + + # Collinearity. + } else if (u1 == 0.0 && u2 == 0.0) { + xmin = min (px[kk-1], px[kk]) + xmax = max (px[kk-1], px[kk]) + if (xmin == 0.5 || xmax == 0.5) + vertex = true + else if (xmin < 0.5 && xmax > 0.5) + boundary = true + + # Vertex. + } else if (u1 != 0.0) { + if (px[kk] == 0.5) + vertex = true + } + + u1 = u2 + } + + if (vertex) + ovlap = 0.25 + else if (boundary) + ovlap = 0.5 + else if (mod (ninter, 2) == 0) + ovlap = 0.0 + else + ovlap = 1.0 + waccum = waccum + ovlap + accum = accum + ovlap * + coeff[first_point+(jj-1)*len_coeff+ii] + } + } + + if (waccum == 0.0) + zfit[i] = badval + else + zfit[i] = accum / waccum + } + +end diff --git a/math/iminterp/ii_cubspl.f b/math/iminterp/ii_cubspl.f new file mode 100644 index 00000000..29407862 --- /dev/null +++ b/math/iminterp/ii_cubspl.f @@ -0,0 +1,119 @@ + subroutine iicbsp (tau, c, n, ibcbeg, ibcend) +c from * a practical guide to splines * by c. de boor +c ************************ input *************************** +c n = number of data points. assumed to be .ge. 2. +c (tau(i), c(1,i), i=1,...,n) = abscissae and ordinates of the +c data points. tau is assumed to be strictly increasing. +c ibcbeg, ibcend = boundary condition indicators, and +c c(2,1), c(2,n) = boundary condition information. specifically, +c ibcbeg = 0 means no boundary condition at tau(1) is given. +c in this case, the not-a-knot condition is used, i.e. the +c jump in the third derivative across tau(2) is forced to +c zero, thus the first and the second cubic polynomial pieces +c are made to coincide.) +c ibcbeg = 1 means that the slope at tau(1) is made to equal +c c(2,1), supplied by input. +c ibcbeg = 2 means that the second derivative at tau(1) is +c made to equal c(2,1), supplied by input. +c ibcend = 0, 1, or 2 has analogous meaning concerning the +c boundary condition at tau(n), with the additional infor- +c mation taken from c(2,n). +c *********************** output ************************** +c c(j,i), j=1,...,4; i=1,...,l (= n-1) = the polynomial coefficients +c of the cubic interpolating spline with interior knots (or +c joints) tau(2), ..., tau(n-1). precisely, in the interval +c interval (tau(i), tau(i+1)), the spline f is given by +c f(x) = c(1,i)+h*(c(2,i)+h*(c(3,i)+h*c(4,i)/3.)/2.) +c where h = x - tau(i). the function program *ppvalu* may be +c used to evaluate f or its derivatives from tau,c, l = n-1, +c and k=4. + integer ibcbeg,ibcend,n, i,j,l,m + real c(4,n),tau(n), divdf1,divdf3,dtau,g +c****** a tridiagonal linear system for the unknown slopes s(i) of +c f at tau(i), i=1,...,n, is generated and then solved by gauss elim- +c ination, with s(i) ending up in c(2,i), all i. +c c(3,.) and c(4,.) are used initially for temporary storage. + l = n-1 +compute first differences of tau sequence and store in c(3,.). also, +compute first divided difference of data and store in c(4,.). + do 10 m=2,n + c(3,m) = tau(m) - tau(m-1) + 10 c(4,m) = (c(1,m) - c(1,m-1))/c(3,m) +construct first equation from the boundary condition, of the form +c c(4,1)*s(1) + c(3,1)*s(2) = c(2,1) + if (ibcbeg-1) 11,15,16 + 11 if (n .gt. 2) go to 12 +c no condition at left end and n = 2. + c(4,1) = 1. + c(3,1) = 1. + c(2,1) = 2.*c(4,2) + go to 25 +c not-a-knot condition at left end and n .gt. 2. + 12 c(4,1) = c(3,3) + c(3,1) = c(3,2) + c(3,3) + c(2,1) =((c(3,2)+2.*c(3,1))*c(4,2)*c(3,3)+c(3,2)**2*c(4,3))/c(3,1) + go to 19 +c slope prescribed at left end. + 15 c(4,1) = 1. + c(3,1) = 0. + go to 18 +c second derivative prescribed at left end. + 16 c(4,1) = 2. + c(3,1) = 1. + c(2,1) = 3.*c(4,2) - c(3,2)/2.*c(2,1) + 18 if(n .eq. 2) go to 25 +c if there are interior knots, generate the corresp. equations and car- +c ry out the forward pass of gauss elimination, after which the m-th +c equation reads c(4,m)*s(m) + c(3,m)*s(m+1) = c(2,m). + 19 do 20 m=2,l + g = -c(3,m+1)/c(4,m-1) + c(2,m) = g*c(2,m-1) + 3.*(c(3,m)*c(4,m+1)+c(3,m+1)*c(4,m)) + 20 c(4,m) = g*c(3,m-1) + 2.*(c(3,m) + c(3,m+1)) +construct last equation from the second boundary condition, of the form +c (-g*c(4,n-1))*s(n-1) + c(4,n)*s(n) = c(2,n) +c if slope is prescribed at right end, one can go directly to back- +c substitution, since c array happens to be set up just right for it +c at this point. + if (ibcend-1) 21,30,24 + 21 if (n .eq. 3 .and. ibcbeg .eq. 0) go to 22 +c not-a-knot and n .ge. 3, and either n.gt.3 or also not-a-knot at +c left end point. + g = c(3,n-1) + c(3,n) + c(2,n) = ((c(3,n)+2.*g)*c(4,n)*c(3,n-1) + * + c(3,n)**2*(c(1,n-1)-c(1,n-2))/c(3,n-1))/g + g = -g/c(4,n-1) + c(4,n) = c(3,n-1) + go to 29 +c either (n=3 and not-a-knot also at left) or (n=2 and not not-a- +c knot at left end point). + 22 c(2,n) = 2.*c(4,n) + c(4,n) = 1. + go to 28 +c second derivative prescribed at right endpoint. + 24 c(2,n) = 3.*c(4,n) + c(3,n)/2.*c(2,n) + c(4,n) = 2. + go to 28 + 25 if (ibcend-1) 26,30,24 + 26 if (ibcbeg .gt. 0) go to 22 +c not-a-knot at right endpoint and at left endpoint and n = 2. + c(2,n) = c(4,n) + go to 30 + 28 g = -1./c(4,n-1) +complete forward pass of gauss elimination. + 29 c(4,n) = g*c(3,n-1) + c(4,n) + c(2,n) = (g*c(2,n-1) + c(2,n))/c(4,n) +carry out back substitution + 30 j = l + 40 c(2,j) = (c(2,j) - c(3,j)*c(2,j+1))/c(4,j) + j = j - 1 + if (j .gt. 0) go to 40 +c****** generate cubic coefficients in each interval, i.e., the deriv.s +c at its left endpoint, from value and slope at its endpoints. + do 50 i=2,n + dtau = c(3,i) + divdf1 = (c(1,i) - c(1,i-1))/dtau + divdf3 = c(2,i-1) + c(2,i) - 2.*divdf1 + c(3,i-1) = 2.*(divdf1 - c(2,i-1) - divdf3)/dtau + 50 c(4,i-1) = (divdf3/dtau)*(6./dtau) + return + end diff --git a/math/iminterp/ii_eval.x b/math/iminterp/ii_eval.x new file mode 100644 index 00000000..2e4cbb37 --- /dev/null +++ b/math/iminterp/ii_eval.x @@ -0,0 +1,430 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include + + +# II_NEAREST -- Procedure to evaluate the nearest neighbour interpolant. + +procedure ii_nearest (x, y, npts, data) + +real x[ARB] # x values, must be within [1,npts] +real y[ARB] # interpolated values returned to user +int npts # number of x values +real data[ARB] # data to be interpolated + +int i + +begin + do i = 1, npts + y[i] = data[int(x[i] + 0.5)] +end + + +# II_LINEAR -- Procedure to evaluate the linear interpolant. + +procedure ii_linear (x, y, npts, data) + +real x[ARB] # x values, must be within [1,npts] +real y[ARB] # interpolated values returned to user +int npts # number of x values +real data[ARB] # data to be interpolated + +int i, nx + +begin + do i = 1, npts { + nx = x[i] + y[i] = (x[i] - nx) * data[nx + 1] + (nx + 1 - x[i]) * data[nx] + } +end + + +# II_POLY3 -- Procedure to evaluate the cubic polynomial interpolant. + +procedure ii_poly3 (x, y, npts, data) + +real x[ARB] # x values, must be within [1,npts] +real y[ARB] # interpolated values returned to user +int npts # number of x values +real data[ARB] # data to be interpolated from a[0] to a[npts+2] + +int i, nx, nxold +real deltax, deltay, cd20, cd21 + +begin + nxold = -1 + do i = 1, npts { + nx = x[i] + deltax = x[i] - nx + deltay = 1. - deltax + + if (nx != nxold) { + # second central differences: + cd20 = 1./6. * (data[nx+1] - 2. * data[nx] + data[nx-1]) + cd21 = 1./6. * (data[nx+2] - 2. * data[nx+1] + data[nx]) + nxold = nx + } + + y[i] = deltax * (data[nx+1] + (deltax * deltax - 1.) * cd21) + + deltay * (data[nx] + (deltay * deltay - 1.) * cd20) + } +end + + +# II_POLY5 -- Procedure to evaluate the fifth order polynomial interpolant. + +procedure ii_poly5 (x, y, npts, data) + +real x[ARB] # x values, must be within [1,npts] +real y[ARB] # interpolated values returned to user +int npts # number of x values +real data[ARB] # data to be interpolated - from a[-1] to a[npts+3] + +int i, nx, nxold +real deltax, deltay, cd20, cd21, cd40, cd41 + +begin + nxold = -1 + do i = 1, npts { + nx = x[i] + deltax = x[i] - nx + deltay = 1. - deltax + + if (nx != nxold) { + cd20 = 1./6. * (data[nx+1] - 2. * data[nx] + data[nx-1]) + cd21 = 1./6. * (data[nx+2] - 2. * data[nx+1] + data[nx]) + # fourth central differences + cd40 = 1./120. * (data[nx-2] - 4. * data[nx-1] + + 6. * data[nx] - 4. * data[nx+1] + data[nx+2]) + cd41 = 1./120. * (data[nx-1] - 4. * data[nx] + + 6. * data[nx+1] - 4. * data[nx+2] + data[nx+3]) + nxold = nx + } + + y[i] = deltax * (data[nx+1] + (deltax * deltax - 1.) * + (cd21 + (deltax * deltax - 4.) * cd41)) + + deltay * (data[nx] + (deltay * deltay - 1.) * + (cd20 + (deltay * deltay - 4.) * cd40)) + } +end + + +# II_SPLINE3 -- Procedure to evaluate the cubic spline interpolant. + +procedure ii_spline3 (x, y, npts, bcoeff) + +real x[ARB] # x values, must be within [1,npts] +real y[ARB] # interpolated values returned to user +int npts # number of x values +real bcoeff[ARB] # basis spline coefficients - from a[0] to a[npts+1] + +int i, nx, nxold +real deltax, c0, c1, c2, c3 + +begin + nxold = -1 + do i = 1, npts { + nx = x[i] + deltax = x[i] - nx + + if (nx != nxold) { + # convert b-spline coeff's to poly. coeff's + c0 = bcoeff[nx-1] + 4. * bcoeff[nx] + bcoeff[nx+1] + c1 = 3. * (bcoeff[nx+1] - bcoeff[nx-1]) + c2 = 3. * (bcoeff[nx-1] - 2. * bcoeff[nx] + bcoeff[nx+1]) + c3 = -bcoeff[nx-1] + 3. * bcoeff[nx] - 3. * bcoeff[nx+1] + + bcoeff[nx+2] + nxold = nx + } + + y[i] = c0 + deltax * (c1 + deltax * (c2 + deltax * c3)) + } +end + + +# II_SINC -- Procedure to evaluate the sinc interpolant. The sinc +# truncation length is nsinc. The taper is a cosbell function which is +# approximated by a quartic polynomial which is valid for 0 <= x <= PI / 2 +# (Abramowitz and Stegun, 1972, Dover Publications, p 76). If the point to +# be interpolated is less than mindx from a data point no interpolation is +# done and the data point itself is returned. + +procedure ii_sinc (x, y, npts, data, npix, nsinc, mindx) + +real x[ARB] # x values, must be within [1,npts] +real y[ARB] # interpolated values returned to user +int npts # number of x values +real data[ARB] # data to be interpolated +int npix # number of data pixels +int nsinc # sinc truncation length +real mindx # interpolation minimum + +int i, j, xc, minj, maxj, offj +pointer sp, taper +real dx, dxn, dx2, w1, sconst, a2, a4, sum, sumw + +begin + # Compute the constants for the cosine bell taper. + sconst = (HALFPI / nsinc) ** 2 + a2 = -0.49670 + a4 = 0.03705 + + # Pre-compute the taper array. Incorporate the sign change portion + # of the sinc interpolator into the taper array. + call smark (sp) + call salloc (taper, 2 * nsinc + 1, TY_REAL) + if (mod (nsinc, 2) == 0) + w1 = 1.0 + else + w1 = -1.0 + do j = -nsinc, nsinc { + dx2 = sconst * j * j + Memr[taper+j+nsinc] = w1 * (1.0 + a2 * dx2 + a4 * dx2 * dx2) ** 2 + w1 = -w1 + } + + do i = 1, npts { + + # Return zero outside of data. + xc = nint (x[i]) + if (xc < 1 || xc > npix) { + y[i] = 0. + next + } + + # Return the data value if x is too close to x[i]. + dx = x[i] - xc + if (abs (dx) < mindx) { + y[i] = data[xc] + next + } + + # Compute the limits of the true convolution. + minj = max (1, xc - nsinc) + maxj = min (npix, xc + nsinc) + offj = -xc + nsinc + + # Do the convolution. + sum = 0.0 + sumw = 0.0 + dxn = dx + xc + do j = xc - nsinc, minj - 1 { + w1 = Memr[taper+j+offj] / (dxn - j) + sum = sum + w1 * data[1] + sumw = sumw + w1 + } + do j = minj, maxj { + w1 = Memr[taper+j+offj] / (dxn - j) + sum = sum + w1 * data[j] + sumw = sumw + w1 + } + do j = maxj + 1, xc + nsinc { + w1 = Memr[taper+j+offj] / (dxn - j) + sum = sum + w1 * data[npix] + sumw = sumw + w1 + } + + # Compute value. + y[i] = sum / sumw + } + + call sfree (sp) +end + + +# II_LSINC -- Procedure to evaluate the sinc interpolant using a +# precomputed look-up table. The sinc truncation length is nsinc. The taper +# is a cosbell function which is approximated by a quartic polynomial which +# is valid for 0 <= x <= PI / 2 (Abramowitz and Stegun, 1972, Dover +# Publications, p 76). If the point to be interpolated is less than mindx +# from a data point no interpolation is done and the data point itself is +# returned. + +procedure ii_lsinc (x, y, npts, data, npix, ltable, nconv, nincr, mindx) + +real x[ARB] # x values, must be within [1,npix] +real y[ARB] # interpolated values returned to user +int npts # number of x values +real data[ARB] # data to be interpolated +int npix # number of data pixels +real ltable[nconv,nincr] # the sinc look-up table +int nconv # sinc truncation length +int nincr # the number of look-up table entries +real mindx # interpolation minimum (don't use) + +int i, j, nsinc, xc, lut, minj, maxj, offj +real dx, sum + +begin + nsinc = (nconv - 1) / 2 + do i = 1, npts { + + # Return zero outside of data. + xc = nint (x[i]) + if (xc < 1 || xc > npix) { + y[i] = 0. + next + } + + # Return data point if dx is too small. + dx = x[i] - xc + if (abs (dx) < mindx) { + y[i] = data[xc] + next + } + + # Find the correct look-up table entry. + if (nincr == 1) + lut = 1 + else + lut = nint ((-dx + 0.5) * (nincr - 1)) + 1 + #lut = int ((-dx + 0.5) * (nincr - 1) + 0.5) + 1 + + # Compute the convolution limits. + minj = max (1, xc - nsinc) + maxj = min (npix, xc + nsinc) + offj = -xc + nsinc + 1 + + # Do the convolution. + sum = 0.0 + do j = xc - nsinc, minj - 1 + sum = sum + ltable[j+offj,lut] * data[1] + do j = minj, maxj + sum = sum + ltable[j+offj,lut] * data[j] + do j = maxj + 1, xc + nsinc + sum = sum + ltable[j+offj,lut] * data[npix] + + # Compute the value. + y[i] = sum + } +end + + +# II_DRIZ -- Procedure to evaluate the drizzle interpolant. + +procedure ii_driz (x, y, npts, data, pixfrac, badval) + +real x[ARB] # x start and stop values, must be within [1,npts] +real y[ARB] # interpolated values returned to user +int npts # number of x values +real data[ARB] # data to be interpolated +real pixfrac # the drizzle pixel fraction +real badval # value for undefined pixels + +int i, j, neara, nearb +real hpixfrac, xa, xb, dx, accum, waccum + +begin + hpixfrac = pixfrac / 2.0 + do i = 1, npts { + + # Define the interval of integration. + xa = min (x[2*i-1], x[2*i]) + xb = max (x[2*i-1], x[2*i]) + neara = xa + 0.5 + nearb = xb + 0.5 + + # Initialize the integration + accum = 0.0 + waccum = 0.0 + if (neara == nearb) { + + dx = min (xb, nearb + hpixfrac) - max (xa, neara - hpixfrac) + + if (dx > 0.0) { + accum = accum + dx * data[neara] + waccum = waccum + dx + } + + } else { + + # first segement + dx = neara + hpixfrac - max (xa, neara - hpixfrac) + + if (dx > 0.0) { + accum = accum + dx * data[neara] + waccum = waccum + dx + } + + # interior segments. + do j = neara + 1, nearb - 1 { + accum = accum + pixfrac * data[j] + waccum = waccum + pixfrac + } + + # last segment + dx = min (xb, nearb + hpixfrac) - (nearb - hpixfrac) + + if (dx > 0.0) { + accum = accum + dx * data[nearb] + waccum = waccum + dx + } + } + + if (waccum == 0.0) + y[i] = badval + else + y[i] = accum / waccum + } +end + + +# II_DRIZ1 -- Procedure to evaluate the drizzle interpolant in the case where +# pixfrac = 1.0. + +procedure ii_driz1 (x, y, npts, data, badval) + +real x[ARB] # x start and stop values, must be within [1,npts] +real y[ARB] # interpolated values returned to user +int npts # number of x values +real data[ARB] # data to be interpolated +real badval # undefined pixel value + +int i, j, neara, nearb +real xa, xb, deltaxa, deltaxb, dx, accum, waccum + +begin + do i = 1, npts { + + # Define the interval of integration. + xa = min (x[2*i-1], x[2*i]) + xb = max (x[2*i-1], x[2*i]) + neara = xa + 0.5 + nearb = xb + 0.5 + deltaxa = xa - neara + deltaxb = xb - nearb + + # Only one segment involved. + accum = 0.0 + waccum = 0.0 + if (neara == nearb) { + + dx = deltaxb - deltaxa + accum = accum + dx * data[neara] + waccum = waccum + dx + + } else { + + # First segment. + dx = 0.5 - deltaxa + accum = accum + dx * data[neara] + waccum = waccum + dx + + # Middle segment. + do j = neara + 1, nearb - 1 { + accum = accum + data[j] + waccum = waccum + 1.0 + } + + # Last segment. + dx = deltaxb + 0.5 + accum = accum + dx * data[nearb] + waccum = waccum + dx + } + + if (waccum == 0.0) + y[i] = badval + else + y[i] = accum / waccum + } +end diff --git a/math/iminterp/ii_greval.x b/math/iminterp/ii_greval.x new file mode 100644 index 00000000..6b5d75b2 --- /dev/null +++ b/math/iminterp/ii_greval.x @@ -0,0 +1,859 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include +include + +# II_GRNEAREST -- Procedure to evaluate the nearest neighbour interpolant on +# a rectangular grid. The procedure assumes that 1 <= x <= nxpix and +# that 1 <= y <= nypix. The x and y vectors must be sorted in increasing +# value of x and y such that x[i] < x[i+1] and y[i] < y[i+1]. The routine +# outputs a grid of nxpix by nypix points using the coeff array where +# coeff[1+first_point] = datain[1,1] + +procedure ii_grnearest (coeff, first_point, len_coeff, x, y, zfit, nxpts, + nypts, len_zfit) + +real coeff[ARB] # 1D coefficient array +int first_point # offset of first data point +int len_coeff # row length of coeff +real x[nxpts] # array of x values +real y[nypts] # array of y values +real zfit[len_zfit,ARB] # array of interpolatedvalues +int nxpts # number of x values +int nypts # number of y values +int len_zfit # row length of zfit + +int ny +int index +int i, j +pointer sp, nx + +errchk smark, salloc, sfree + +begin + call smark (sp) + call salloc (nx, nxpts, TY_INT) + + # calculate the nearest x + do i = 1, nxpts + Memi[nx+i-1] = x[i] + 0.5 + + # loop over the rows + do j = 1, nypts { + + # calculate pointer to the ny-th row of data + ny = y[j] + 0.5 + index = first_point + (ny - 1) * len_coeff + + # loop over the columns + do i = 1, nxpts + zfit[i,j] = coeff[index + Memi[nx+i-1]] + } + + call sfree (sp) +end + + +# II_GRLINEAR -- Procedure to evaluate the bilinear interpolant +# on a rectangular grid. The procedure assumes that 1 <= x <= nxpix and that +# 1 <= y <= nypix. The x and y vectors are assumed to be sorted in increasing +# order of x and y such that x[i] < x[i+1] and y[i] < y[i+1]. The routine +# produces a grid of nxpix * nypix evaluated points using the coeff array +# where coeff[1+first_point] = datain[1,1]. + +procedure ii_grlinear (coeff, first_point, len_coeff, x, y, zfit, nxpts, + nypts, len_zfit) + +real coeff[ARB] # 1D array of coefficients +int first_point # offset of first data point +int len_coeff # row length of coeff +real x[nxpts] # array of x values +real y[nypts] # array of y values +real zfit[len_zfit,ARB] # array of interpolated values +int nxpts # number of x values +int nypts # number of y values +int len_zfit # row length of zfit + +int i, j, ny +int nymin, nymax, nylines +int row_index, xindex +pointer sp, nx, sx, tx, work, lbuf1, lbuf2 +real sy, ty + +errchk smark, salloc, sfree + +begin + # calculate the x and y limits + nymin = y[1] + nymax = int (y[nypts]) + 1 + nylines = nymax - nymin + 1 + + # allocate storage for work array + call smark (sp) + call salloc (nx, nxpts, TY_INT) + call salloc (sx, nxpts, TY_REAL) + call salloc (tx, nxpts, TY_REAL) + call salloc (work, nxpts * nylines, TY_REAL) + + # initialize + call achtri (x, Memi[nx], nxpts) + do i = 1, nxpts { + Memr[sx+i-1] = x[i] - Memi[nx+i-1] + Memr[tx+i-1] = 1. - Memr[sx+i-1] + } + + # for each value of y interpolate in x and store in work array + lbuf1 = work + do j = 1, nylines { + + # define pointer to appropriate row + row_index = first_point + (j + nymin - 2) * len_coeff + + # interpolate in x at each y + do i = 1, nxpts { + xindex = row_index + Memi[nx+i-1] + Memr[lbuf1+i-1] = Memr[tx+i-1] * coeff[xindex] + + Memr[sx+i-1] * coeff[xindex+1] + } + + lbuf1 = lbuf1 + nxpts + } + + # at each x interpolate in y and store in temporary work array + do j = 1, nypts { + + ny = y[j] + sy = y[j] - ny + ty = 1. - sy + + lbuf1 = work + nxpts * (ny - nymin) + lbuf2 = lbuf1 + nxpts + + call awsur (Memr[lbuf1], Memr[lbuf2], zfit[1,j], nxpts, + ty, sy) + + } + + # deallocate work space + call sfree (sp) +end + + +# II_GRPOLY3 -- Procedure to evaluate the bicubic polynomial interpolant +# on a rectangular grid. The points to be evaluated are assumed +# to lie in the range 1 <= x <= nxpix and 1 <= y <= nypix. The x and y vectors +# are assumed to be sorted in increasing order of x and y such that +# x[i] < x[i+1] and y[i] < y[i+1]. The interpolation is done using +# Everett's central difference formula and separation of variables +# and assuming that coeff[1+first_point] = datain[1,1]. + +procedure ii_grpoly3 (coeff, first_point, len_coeff, x, y, zfit, nxpts, nypts, + len_zfit) + +real coeff[ARB] # 1D array of coefficients +int first_point # offset of first data point +int len_coeff # length of row of coeffcient +real x[nxpts] # array of x values +real y[nypts] # array of y values +real zfit[len_zfit,ARB] # array of interpolatedvalues +int nxpts # number of x points +int nypts # number of y points +int len_zfit # row length of zfit + +int nymin, nymax, nylines +int nxold, nyold +int row_index, xindex +int i, j, ny +pointer sp, nx, sx, sx2m1, tx, tx2m1, work +pointer lbuf, lbufp1, lbufp2, lbufm1 +real cd20x, cd21x, cd20y, cd21y +real sy, ty, sy2m1, ty2m1 + +errchk smark, salloc, sfree + +begin + # find y limits + nymin = int (y[1]) - 1 + nymax = int (y[nypts]) + 2 + nylines = nymax - nymin + 1 + + # allocate work space + call smark (sp) + call salloc (nx, nxpts, TY_INT) + call salloc (sx, nxpts, TY_REAL) + call salloc (sx2m1, nxpts, TY_REAL) + call salloc (tx, nxpts, TY_REAL) + call salloc (tx2m1, nxpts, TY_REAL) + call salloc (work, nxpts * nylines, TY_REAL) + + # initialize + call achtri (x, Memi[nx], nxpts) + do i = 1, nxpts { + Memr[sx+i-1] = x[i] - Memi[nx+i-1] + Memr[sx2m1+i-1] = Memr[sx+i-1] * Memr[sx+i-1] - 1. + Memr[tx+i-1] = 1. - Memr[sx+i-1] + Memr[tx2m1+i-1] = Memr[tx+i-1] * Memr[tx+i-1] - 1. + } + + # for each value of y interpolate in x + lbuf = work + do j = 1, nylines { + + # calculate pointer to a row + row_index = first_point + (j + nymin - 2) * len_coeff + + # interpolate in x at each y + nxold = -1 + do i = 1, nxpts { + + xindex= row_index + Memi[nx+i-1] + + if (Memi[nx+i-1] != nxold) { + #cd20x = 1./6. * (coeff[xindex+1] - 2. * coeff[xindex] + + #coeff[xindex-1]) + #cd21x = 1./6. * (coeff[xindex+2] - 2. * coeff[xindex+1] + + #coeff[xindex]) + cd20x = (coeff[xindex+1] - 2. * coeff[xindex] + + coeff[xindex-1]) / 6. + cd21x = (coeff[xindex+2] - 2. * coeff[xindex+1] + + coeff[xindex]) / 6.0 + } + + Memr[lbuf+i-1] = Memr[sx+i-1] * (coeff[xindex+1] + + Memr[sx2m1+i-1] * cd21x) + + Memr[tx+i-1] * (coeff[xindex] + + Memr[tx2m1+i-1] * cd20x) + + nxold = Memi[nx+i-1] + } + + lbuf = lbuf + nxpts + } + + # interpolate in y at each x + nyold = -1 + do j = 1, nypts { + + ny = y[j] + sy = y[j] - ny + ty = 1. - sy + sy2m1 = sy ** 2 - 1. + ty2m1 = ty ** 2 - 1. + + lbuf = work + nxpts * (ny - nymin) + lbufm1 = lbuf - nxpts + lbufp1 = lbuf + nxpts + lbufp2 = lbufp1 + nxpts + + do i = 1, nxpts { + + # calculate central differences in y + #if (nyold != ny) { + #cd20y = 1./6. * (Memr[lbufp1+i-1] - 2. * Memr[lbuf+i-1] + + #Memr[lbufm1+i-1]) + #cd21y = 1./6. * (Memr[lbufp2+i-1] - 2. * + #Memr[lbufp1+i-1] + Memr[lbuf+i-1]) + cd20y = (Memr[lbufp1+i-1] - 2. * Memr[lbuf+i-1] + + Memr[lbufm1+i-1]) / 6.0 + cd21y = (Memr[lbufp2+i-1] - 2. * Memr[lbufp1+i-1] + + Memr[lbuf+i-1]) / 6.0 + #} + + # interpolate in y + zfit[i,j] = sy * (Memr[lbufp1+i-1] + sy2m1 * cd21y) + + ty * (Memr[lbuf+i-1] + ty2m1 * cd20y) + + } + + #nyold = ny + } + + # free work space + call sfree (sp) +end + + +# II_GRPOLY5 -- Procedure to evaluate the biquintic polynomial interpolant +# on a rectangular grid. The routine assumes that 1 <= x <= nxpix and +# 1 <= y <= nypix. The vectors x and y are assumed to be sorted in +# increasing order such that x[i] < x[i+1] and y[i] < y[i+1]. The +# interpolation is done using Everett's interpolation formula and +# separation of variables and assuming that coeff[1+first_point] = +# datain[1,1]. + +procedure ii_grpoly5 (coeff, first_point, len_coeff, x, y, zfit, nxpts, + nypts, len_zfit) + +real coeff[ARB] # 1D array of coefficients +int first_point # offset of first data point +int len_coeff # row length of coeff +real x[nxpts] # array of x values +real y[nypts] # array of y values +real zfit[len_zfit,ARB] # array of fitted values +int nxpts # number of x points +int nypts # number of y points +int len_zfit # row length of zfit + +int nymax, nymin, nylines, nxold, nyold +int row_index, xindex +int i, j, ny +pointer sp, nx, sx, tx, sx2m1, sx2m4, tx2m1, tx2m4, work +pointer lbuf, lbufp1, lbufp2, lbufp3, lbufm1, lbufm2 +real cd20x, cd21x, cd40x, cd41x +real cd20y, cd21y, cd40y, cd41y +real sy, ty, sy2m1, sy2m4, ty2m1, ty2m4 + +errchk smark, salloc, sfree + +begin + # find the y limits + nymin = int (y[1]) - 2 + nymax = int (y[nypts]) + 3 + nylines = nymax - nymin + 1 + + # allocate space + call smark (sp) + call salloc (nx, nxpts, TY_INT) + call salloc (sx, nxpts, TY_REAL) + call salloc (sx2m1, nxpts, TY_REAL) + call salloc (sx2m4, nxpts, TY_REAL) + call salloc (tx, nxpts, TY_REAL) + call salloc (tx2m1, nxpts, TY_REAL) + call salloc (tx2m4, nxpts, TY_REAL) + call salloc (work, nxpts * nylines, TY_REAL) + + # intialize + call achtri (x, Memi[nx], nxpts) + do i = 1, nxpts { + Memr[sx+i-1] = x[i] - Memi[nx+i-1] + Memr[sx2m1+i-1] = Memr[sx+i-1] ** 2 - 1. + Memr[sx2m4+i-1] = Memr[sx2m1+i-1] - 3. + Memr[tx+i-1] = 1. - Memr[sx+i-1] + Memr[tx2m1+i-1] = Memr[tx+i-1] ** 2 - 1. + Memr[tx2m4+i-1] = Memr[tx2m1+i-1] - 3. + } + + + # for each value of y interpolate in x + lbuf = work + do j = 1, nylines { + + # calculate pointer to a row + row_index = first_point + (j + nymin - 2) * len_coeff + + # interpolate in x at each y + nxold = -1 + do i = 1, nxpts { + + xindex = row_index + Memi[nx+i-1] + + if (Memi[nx+i-1] != nxold) { + #cd20x = 1./6. * (coeff[xindex+1] - 2. * coeff[xindex] + + #coeff[xindex-1]) + #cd21x = 1./6. * (coeff[xindex+2] - 2. * coeff[xindex+1] + + #coeff[xindex]) + cd20x = (coeff[xindex+1] - 2. * coeff[xindex] + + coeff[xindex-1]) / 6.0 + cd21x = (coeff[xindex+2] - 2. * coeff[xindex+1] + + coeff[xindex]) / 6.0 + #cd40x = 1./120. * (coeff[xindex-2] - 4. * coeff[xindex-1] + + #6. * coeff[xindex] - 4. * coeff[xindex+1] + + #coeff[xindex+2]) + #cd41x = 1./120. * (coeff[xindex-1] - 4. * coeff[xindex] + + #6. * coeff[xindex+1] - 4. * coeff[xindex+2] + + #coeff[xindex+3]) + cd40x = (coeff[xindex-2] - 4. * coeff[xindex-1] + + 6. * coeff[xindex] - 4. * coeff[xindex+1] + + coeff[xindex+2]) / 120.0 + cd41x = (coeff[xindex-1] - 4. * coeff[xindex] + + 6. * coeff[xindex+1] - 4. * coeff[xindex+2] + + coeff[xindex+3]) / 120.0 + } + + Memr[lbuf+i-1] = Memr[sx+i-1] * (coeff[xindex+1] + + Memr[sx2m1+i-1] * (cd21x + + Memr[sx2m4+i-1] * cd41x)) + + Memr[tx+i-1] * (coeff[xindex] + + Memr[tx2m1+i-1] * (cd20x + + Memr[tx2m4+i-1] * cd40x)) + + + nxold = Memi[nx+i-1] + + } + + lbuf = lbuf + nxpts + } + + # at each x interpolate in y + nyold = -1 + do j = 1, nypts { + + ny = y[j] + sy = y[j] - ny + sy2m1 = sy ** 2 - 1. + sy2m4 = sy2m1 - 3. + ty = 1. - sy + ty2m1 = ty ** 2 - 1. + ty2m4 = ty2m1 - 3. + + lbuf = work + nxpts * (ny - nymin) + lbufp1 = lbuf + nxpts + lbufp2 = lbufp1 + nxpts + lbufp3 = lbufp2 + nxpts + lbufm1 = lbuf - nxpts + lbufm2 = lbufm1 - nxpts + + do i = 1, nxpts { + + # calculate central differences + #if (nyold != ny) { + #cd20y = 1./6. * (Memr[lbufp1+i-1] - 2. * Memr[lbuf+i-1] + + #Memr[lbufm1+i-1]) + #cd21y = 1./6. * (Memr[lbufp2+i-1] - 2. * + #Memr[lbufp1+i-1] + Memr[lbuf+i-1]) + cd20y = (Memr[lbufp1+i-1] - 2. * Memr[lbuf+i-1] + + Memr[lbufm1+i-1]) / 6. + cd21y = (Memr[lbufp2+i-1] - 2. * + Memr[lbufp1+i-1] + Memr[lbuf+i-1]) / 6. + #cd40y = 1./120. * (Memr[lbufm2+i-1] - + #4. * Memr[lbufm1+i-1] + 6. * Memr[lbuf+i-1] - + #4. * Memr[lbufp1+i-1] + Memr[lbufp2+i-1]) + #cd41y = 1./120. * (Memr[lbufm1+i-1] - 4. * + #Memr[lbuf+i-1] + 6. * Memr[lbufp1+i-1] - 4. * + #Memr[lbufp2+i-1] + Memr[lbufp3+i-1]) + cd40y = (Memr[lbufm2+i-1] - + 4. * Memr[lbufm1+i-1] + 6. * Memr[lbuf+i-1] - + 4. * Memr[lbufp1+i-1] + Memr[lbufp2+i-1]) / 120. + cd41y = (Memr[lbufm1+i-1] - 4. * + Memr[lbuf+i-1] + 6. * Memr[lbufp1+i-1] - 4. * + Memr[lbufp2+i-1] + Memr[lbufp3+i-1]) / 120.0 + #} + + # interpolate in y + zfit[i,j] = sy * (Memr[lbufp1+i-1] + sy2m1 * + (cd21y + sy2m4 * cd41y)) + + ty * (Memr[lbuf+i-1] + ty2m1 * + (cd20y + ty2m4 * cd40y)) + + } + + #nyold = ny + } + + # release work space + call sfree (sp) + +end + + +# II_GRSPLINE3 -- Procedure to evaluate the bicubic spline interpolant +# on a rectangular grid. The program assumes that 1 <= x <= nxpix and +# 1 <= y <= nypix. The routine assumes that x and y vectors are sorted +# such that x[i] < x[i+1] and y[i] < y[i+1]. The interpolant is evaluated +# by calculating the polynomial coefficients in x and y. + +procedure ii_grspline3 (coeff, first_point, len_coeff, x, y, zfit, nxpts, + nypts, len_zfit) + +real coeff[ARB] # 1D array of coefficients +int first_point # offset of first data point +int len_coeff # row length of coeff +real x[nxpts] # array of x values +real y[nypts] # array of y values +real zfit[len_zfit,ARB] # array of interpolated values +int nxpts # number of x values +int nypts # number of y values +int len_zfit # row length of zfit + +int ny, nymin, nymax, nylines +int row_index, xindex +int i, j +pointer sp, nx, sx, tx, sx3, tx3, work, lbuf, lbufp1, lbufp2, lbufm1 +real sy, ty, ty3, sy3 + +errchk smark, salloc, sfree + +begin + # find the y limits + nymin = int (y[1]) - 1 + nymax = int (y[nypts]) + 2 + nylines = nymax - nymin + 1 + + # allocate space for work array + call smark (sp) + call salloc (nx, nxpts, TY_INT) + call salloc (sx, nxpts, TY_REAL) + call salloc (sx3, nxpts, TY_REAL) + call salloc (tx, nxpts, TY_REAL) + call salloc (tx3, nxpts, TY_REAL) + call salloc (work, nylines * nxpts, TY_REAL) + + # intialize + call achtri (x, Memi[nx], nxpts) + do j = 1, nxpts { + Memr[sx+j-1] = x[j] - Memi[nx+j-1] + Memr[tx+j-1] = 1. - Memr[sx+j-1] + } + call apowkr (Memr[sx], 3, Memr[sx3], nxpts) + call apowkr (Memr[tx], 3, Memr[tx3], nxpts) + do j = 1, nxpts { + Memr[sx+j-1] = 1. + Memr[sx+j-1] * (3. + Memr[sx+j-1] * + (3. - 3. * Memr[sx+j-1])) + Memr[tx+j-1] = 1. + Memr[tx+j-1] * (3. + Memr[tx+j-1] * + (3. - 3. * Memr[tx+j-1])) + } + + # interpolate in x for each y + lbuf = work + do i = 1, nylines { + + # find appropriate row + row_index = first_point + (i + nymin - 2) * len_coeff + + # x interpolation + do j = 1, nxpts { + + xindex = row_index + Memi[nx+j-1] + Memr[lbuf+j-1] = Memr[tx3+j-1] * coeff[xindex-1] + + Memr[tx+j-1] * coeff[xindex] + + Memr[sx+j-1] * coeff[xindex+1] + + Memr[sx3+j-1] * coeff[xindex+2] + } + lbuf = lbuf + nxpts + } + + # interpolate in y + do i = 1, nypts { + + ny = y[i] + sy = y[i] - ny + ty = 1. - sy + sy3 = sy ** 3 + ty3 = ty ** 3 + sy = 1. + sy * (3. + sy * (3. - 3. * sy)) + ty = 1. + ty * (3. + ty * (3. - 3. * ty)) + + lbuf = work + nxpts * (ny - nymin) + lbufp1 = lbuf + nxpts + lbufp2 = lbufp1 + nxpts + lbufm1 = lbuf - nxpts + + do j = 1, nxpts + zfit[j,i] = ty3 * Memr[lbufm1+j-1] + ty * Memr[lbuf+j-1] + + sy * Memr[lbufp1+j-1] + sy3 * Memr[lbufp2+j-1] + } + + # release working space + call sfree (sp) +end + +# II_GRSINC -- Procedure to evaluate the sinc interpolant on a rectangular +# grid. The procedure assumes that 1 <= x <= nxpix and that 1 <= y <= nypix. +# The x and y vectors must be sorted in increasing value of x and y such that +# x[i] < x[i+1] and y[i] < y[i+1]. The routine outputs a grid of nxpix by +# nypix points using the coeff array where coeff[1+first_point] = datain[1,1] +# The sinc truncation length is nsinc. The taper is a cosine bell function +# which is approximated by a quartic polynomial which is valid for 0 <= x +# <= PI / 2 (Abramowitz and Stegun 1972, Dover Publications, p 76). If the +# point to be interpolated is less than mindx and mindy from a data point +# no interpolation is done and the data point itself is returned. + +procedure ii_grsinc (coeff, first_point, len_coeff, len_array, x, y, zfit, + nxpts, nypts, len_zfit, nsinc, mindx, mindy) + +real coeff[ARB] # 1D coefficient array +int first_point # offset of first data point +int len_coeff # row length of coeff +int len_array # column length of coeff +real x[nxpts] # array of x values +real y[nypts] # array of y values +real zfit[len_zfit,ARB] # array of interpolatedvalues +int nxpts # number of x values +int nypts # number of y values +int len_zfit # row length of zfit +int nsinc # sinc interpolant truncation length +real mindx, mindy # the precision of the interpolant. + +int i, j, k, nconv, nymin, nymax, nylines +int ixy, index, minj, maxj, offj +pointer sp, taper, ac, ixn, work, pac, pwork, ppwork +real sconst, a2, a4, dxy, dxyn, dx2, axy, pxy, sumxy, fdxy + +begin + # Compute the limits of the convolution in y. + nconv = 2 * nsinc + 1 + nymin = max (1, nint (y[1]) - nsinc) + #nymin = max (1, int (y[1]) - nsinc) + nymax = min (len_array, nint (y[nypts]) + nsinc) + #nymax = min (len_array, int (y[nypts]) + nsinc) + nylines = nymax - nymin + 1 + + # Allocate working space. + call smark (sp) + call salloc (taper, nconv, TY_REAL) + call salloc (ac, nconv * max (nxpts, nypts), TY_REAL) + call salloc (ixn, max (nxpts, nypts), TY_INT) + call salloc (work, nxpts * nylines, TY_REAL) + + # Compute the parameters of the cosine bell taper. + sconst = (HALFPI / nsinc) ** 2 + a2 = -0.49670 + a4 = 0.03705 + if (mod (nsinc, 2) == 0) + fdxy = 1.0 + else + fdxy = -1.0 + do i = -nsinc, nsinc { + dx2 = sconst * i * i + Memr[taper+i+nsinc] = fdxy * (1.0 + a2 * dx2 + a4 * dx2 * dx2) ** 2 + fdxy = -fdxy + } + + # Compute the x interpolants for each shift in x. + pac = ac + do i = 1, nxpts { + ixy = nint (x[i]) + Memi[ixn+i-1] = ixy + dxy = x[i] - ixy + #dxyn = -1 - nsinc - dxy + dxyn = 1 + nsinc + dxy + sumxy = 0.0 + do j = 1, nconv { + #axy = j + dxyn + axy = dxyn - j + if (axy == 0.0) + pxy = 1.0 + else if (dxy == 0.0) + pxy = 0.0 + else + pxy = Memr[taper+j-1] / axy + Memr[pac+j-1] = pxy + sumxy = sumxy + pxy + } + call adivkr (Memr[pac], sumxy, Memr[pac], nconv) + pac = pac + nconv + } + + # Do the convolutions in the x direction. + pwork = work + do k = nymin, nymax { + index = first_point + (k - 1) * len_coeff + pac = ac + do i = 1, nxpts { + sumxy = 0.0 + ixy = Memi[ixn+i-1] + minj = max (1, ixy - nsinc) + maxj = min (len_coeff, ixy + nsinc) + offj = -ixy + nsinc + do j = ixy - nsinc, minj - 1 + sumxy = sumxy + Memr[pac+j+offj] * coeff[index+1] + do j = minj, maxj + sumxy = sumxy + Memr[pac+j+offj] * coeff[index+j] + do j = maxj + 1, ixy + nsinc + sumxy = sumxy + Memr[pac+j+offj] * coeff[index+len_coeff] + Memr[pwork+i-1] = sumxy + pac = pac + nconv + } + pwork = pwork + nxpts + } + + # Compute the y interpolants for each shift in y. + pac = ac + do i = 1, nypts { + ixy = nint (y[i]) + dxy = y[i] - ixy + Memi[ixn+i-1] = ixy - nsinc - nymin + 1 + #dxyn = -1 - nsinc - dxy + dxyn = 1 + nsinc + dxy + sumxy = 0.0 + do j = 1, nconv { + #axy = j + dxyn + axy = dxyn - j + if (axy == 0.0) + pxy = 1.0 + else if (dxy == 0.0) + pxy = 0.0 + else + pxy = Memr[taper+j-1] / axy + Memr[pac+j-1] = pxy + sumxy = sumxy + pxy + } + call adivkr (Memr[pac], sumxy, Memr[pac], nconv) + pac = pac + nconv + } + + # Do the interpolation in y. + do k = 1, nxpts { + pwork = work + k - 1 + pac = ac + do i = 1, nypts { + ixy = min (nylines, max (1, Memi[ixn+i-1])) + ppwork = pwork + (ixy - 1) * nxpts + sumxy = 0.0 + do j = 1, nconv { + sumxy = sumxy + Memr[pac+j-1] * Memr[ppwork] + ppwork = ppwork + nxpts + } + pac = pac + nconv + zfit[k,i] = sumxy + } + } + + call sfree (sp) +end + + +# II_GRLSINC -- Procedure to evaluate the sinc interpolant on a rectangular +# grid. The procedure assumes that 1 <= x <= nxpix and that 1 <= y <= nypix. +# The x and y vectors must be sorted in increasing value of x and y such that +# x[i] < x[i+1] and y[i] < y[i+1]. The routine outputs a grid of nxpix by +# nypix points using the coeff array where coeff[1+first_point] = datain[1,1] +# The sinc truncation length is nsinc. The taper is a cosine bell function +# which is approximated by a quartic polynomial which is valid for 0 <= x +# <= PI / 2 (Abramowitz and Stegun 1972, Dover Publications, p 76). If the +# point to be interpolated is less than mindx and mindy from a data point +# no interpolation is done and the data point itself is returned. + +procedure ii_grlsinc (coeff, first_point, len_coeff, len_array, x, y, zfit, + nxpts, nypts, len_zfit, ltable, nconv, nxincr, nyincr, + mindx, mindy) + +real coeff[ARB] # 1D coefficient array +int first_point # offset of first data point +int len_coeff # row length of coeff +int len_array # column length of coeff +real x[nxpts] # array of x values +real y[nypts] # array of y values +real zfit[len_zfit,ARB] # array of interpolated values +int nxpts # number of x values +int nypts # number of y values +int len_zfit # row length of zfit +real ltable[nconv,nconv,nxincr,nyincr] # pre-computed sinc lut +int nconv # sinc trunction full-width +int nxincr, nyincr # resolution of look-up table +real mindx, mindy # the precision of interpolant + +int j +pointer sp, ytmp + +begin + # Allocate working space. + call smark (sp) + call salloc (ytmp, nxpts, TY_REAL) + + do j = 1, nypts { + call amovkr (y[j], Memr[ytmp], nxpts) + call ii_bilsinc (coeff, first_point, len_coeff, len_array, x, + Memr[ytmp], zfit[1,j], nxpts, ltable, nconv, nxincr, nyincr, + mindx, mindy) + } + + call sfree (sp) +end + + +# II_GRDRIZ -- Procedure to evaluate the drizzle interpolant on a rectangular +# grid. The procedure assumes that the x and y intervals are ordered from +# smallest to largest + +procedure ii_grdriz (coeff, first_point, len_coeff, len_array, x, y, zfit, + nxpts, nypts, len_zfit, xfrac, yfrac, badval) + +real coeff[ARB] # 1D coefficient array +int first_point # offset of first data point +int len_coeff # row length of coeff +int len_array # column length of coeff +real x[ARB] # array of x values +real y[ARB] # array of y values +real zfit[len_zfit,ARB] # array of interpolatedvalues +int nxpts # number of x values +int nypts # number of y values +int len_zfit # row length of zfit +real xfrac, yfrac # the x and y pixel fractions +real badval # bad value + +int i, j, jj, nylmin, nylmax, nylines +int cindex, neara, nearb +pointer sp, work, xindex +real ymin, ymax, dy, accum, waccum, hyfrac + +begin + ymin = min (y[1], y[2]) + ymax = max (y[2*nypts-1], y[2*nypts]) + nylmin = int (ymin + 0.5) + nylmax = int (ymax + 0.5) + nylines = nylmax - nylmin + 1 + + call smark (sp) + call salloc (work, nxpts * nylines, TY_REAL) + + # For each in range y integrate in x. + cindex = 1 + first_point + (nylmin - 1) * len_coeff + xindex = work + do j = nylmin, nylmax { + if (xfrac >= 1.0) + call ii_driz1 (x, Memr[xindex], nxpts, coeff[cindex], badval) + else + call ii_driz (x, Memr[xindex], nxpts, coeff[cindex], xfrac, + badval) + xindex = xindex + nxpts + cindex = cindex + len_coeff + } + + # For each range in x integrate in y. This may need to be vectorized? + hyfrac = yfrac / 2.0 + do i = 1, nxpts { + + xindex = work + i - 1 + + do j = 1, nypts { + + ymin = min (y[2*j-1], y[2*j]) + ymax = max (y[2*j-1], y[2*j]) + neara = ymin + 0.5 + nearb = ymax + 0.5 + + accum = 0.0 + waccum = 0.0 + if (neara == nearb) { + + dy = min (ymax, nearb + hyfrac) - max (ymin, + neara - hyfrac) + if (dy > 0.0) { + accum = accum + dy * Memr[xindex+(neara-nylmin)*nxpts] + waccum = waccum + dy + } + + } else { + + # First segment. + dy = neara + hyfrac - max (ymin, neara - hyfrac) + if (dy > 0.0) { + accum = accum + dy * Memr[xindex+(neara-nylmin)*nxpts] + waccum = waccum + dy + } + + # Interior segments. + do jj = neara + 1, nearb - 1 { + accum = accum + yfrac * Memr[xindex+(jj-nylmin)*nxpts] + waccum = waccum + yfrac + } + + # Last segment. + dy = min (ymax, nearb + hyfrac) - (nearb - hyfrac) + if (dy > 0.0) { + accum = accum + dy * Memr[xindex+(nearb-nylmin)*nxpts] + waccum = waccum + dy + } + } + + if (waccum <= 0.0) + zfit[i,j] = 0.0 + else + zfit[i,j] = accum / waccum + } + } + + call sfree (sp) +end diff --git a/math/iminterp/ii_pc1deval.x b/math/iminterp/ii_pc1deval.x new file mode 100644 index 00000000..7eca5304 --- /dev/null +++ b/math/iminterp/ii_pc1deval.x @@ -0,0 +1,291 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include +include "im1interpdef.h" + +# IA_PCPOLY3 -- Calculate the coefficients of a 3rd order polynomial. + +procedure ia_pcpoly3 (x, datain, npts, pcoeff) + +real x # x value +real datain[ARB] # array of input data +int npts # number of data points +real pcoeff[ARB] # array of polynomial coefficients + +int i, k, nearx, nterms +real temp[POLY3_ORDER] + +begin + nearx = x + + # Check for edge problems. + k = 0 + for(i = nearx - 1; i <= nearx + 2; i = i + 1) { + k = k + 1 + + # project data points into temporary array + if (i < 1) + temp[k] = 2. * datain[1] - datain[2-i] + else if (i > npts) + temp[k] = 2. * datain[npts] - datain[2*npts-i] + else + temp[k] = datain[i] + } + + nterms = 4 + + # Generate the difference table for Newton's form. + do k = 1, nterms - 1 + do i = 1, nterms - k + temp[i] = (temp[i+1] - temp[i]) / k + + # Shift to generate polynomial coefficients. + do k = nterms, 2, -1 + do i = 2, k + temp[i] = temp[i] + temp[i-1] * (k- i - nterms/2) + do i = 1, nterms + pcoeff[i] = temp[nterms+1-i] +end + + +# IA_PCPOLY5 -- Calculate the coefficients of a fifth order polynomial. + +procedure ia_pcpoly5 (x, datain, npts, pcoeff) + +real x # x value +real datain[ARB] # array of input data +int npts # number of data points +real pcoeff[ARB] # array of polynomial coefficients + +int i, k, nearx, nterms +real temp[POLY5_ORDER] + +begin + nearx = x + + # Check for edge effects. + k = 0 + for (i = nearx - 2; i <= nearx + 3; i = i + 1) { + k = k + 1 + # project data points into temporary array + if (i < 1) + temp[k] = 2. * datain[1] - datain[2-i] + else if (i > npts) + temp[k] = 2. * datain[npts] - datain[2*npts-i] + else + temp[k] = datain[i] + } + + nterms = 6 + + # Generate difference table for Newton's form. + do k = 1, nterms - 1 + do i = 1, nterms - k + temp[i] = (temp[i+1] - temp[i]) / k + + # Shift to generate polynomial coefficients. + do k = nterms, 2, -1 + do i = 2, k + temp[i] = temp[i] + temp[i-1] * (k - i - nterms/2) + do i = 1, nterms + pcoeff[i] = temp[nterms+1-i] +end + + +# IA_PCSPLINE3 -- Calculate the derivatives of a cubic spline. + +procedure ia_pcspline3 (x, datain, npts, pcoeff) + +real x # x value +real datain[ARB] # data array +int npts # number of data points +real pcoeff[ARB] # array of polynomial coefficients + +int i, k, nearx, px +real temp[SPLPTS+3], bcoeff[SPLPTS+3] + +begin + nearx = x + k = 0 + + # Check for edge effects. + for (i = nearx - SPLPTS/2 + 1; i <= nearx + SPLPTS/2; i = i + 1) { + if(i < 1 || i > npts) + ; + else { + k = k + 1 + if (k == 1) + px = nearx - i + 1 + bcoeff[k+1] = datain[i] + } + } + + bcoeff[1] = 0. + bcoeff[k+2] = 0. + + # Use special routine for cardinal splines. + call ii_spline (bcoeff, temp, k) + + px = px + 1 + bcoeff[k+3] = 0. + + # Calculate polynomial coefficients. + pcoeff[1] = bcoeff[px-1] + 4. * bcoeff[px] + bcoeff[px+1] + pcoeff[2] = 3. * (bcoeff[px+1] - bcoeff[px-1]) + pcoeff[3] = 3. * (bcoeff[px-1] - 2. * bcoeff[px] + bcoeff[px+1]) + pcoeff[4] = -bcoeff[px-1] + 3. * bcoeff[px] - 3. * bcoeff[px+1] + + bcoeff[px+2] +end + + +# II_SINCDER -- Evaluate derivatives of the sinc interpolator. If the +# function value only is needed call ii_sinc. This routine computes only +# the first two derivatives. The second derivative is computed even if only +# the first derivative is needed. The sinc truncation length is nsinc. +# The taper is a cosbell function approximated by a quartic polynomial. +# The data value is returned if x is closer to x[i] than mindx. + +procedure ii_sincder (x, der, nder, data, npix, nsinc, mindx) + +real x # x value +real der[ARB] # derivatives to return +int nder # number of derivatives +real data[npix] # data to be interpolated +int npix # number of pixels +int nsinc # sinc truncation length +real mindx # interpolation minimum + +int i, j, xc +real dx, w, a, d, z, sconst, a2, a4, dx2, taper +real w1, w2, w3, u1, u2, u3, v1, v2, v3 + +begin + # Return if no derivatives. + if (nder == 0) + return + + # Set derivatives intially to zero. + do i = 1, nder + der[i] = 0. + + # Return if outside data range. + xc = nint (x) + if (xc < 1 || xc > npix) + return + + # Call ii_sinc if only the function value is needed. + if (nder == 1) { + call ii_sinc (x, der, 1, data, npix, nsinc, mindx) + return + } + + # Compute the constants for the cosine bell taper approximation. + sconst = (HALFPI / nsinc) ** 2 + a2 = -0.49670 + a4 = 0.03705 + + # Compute the derivatives by doing the required convolutions. + dx = x - xc + if (abs (dx) < mindx) { + + w = 1. + d = data[xc] + w1 = 1.; u1 = d * w1; v1 = w1 + w2 = 0.; u2 = 0.; v2 = 0. + w3 = -1./3.; u3 = d * w3; v3 = w3 + + # Derivative at the center of a pixel. + do i = 1, nsinc { + + w = -w + dx2 = sconst * i * i + taper = (1.0 + a2 * dx2 + a4 * dx2 * dx2) ** 2 + + j = xc - i + z = 1. / i + if (j >= 1) + d = data[j] + else + d = data[1] + w2 = w * z * taper + u2 = u2 + d * w2 + v2 = v2 + w2 + w3 = -2 * w2 * z + u3 = u3 + d * w3 + v3 = v3 + w3 + + j = xc + i + if (j <= npix) + d = data[j] + else + d = data[npix] + w2 = -w * z * taper + u2 = u2 + d * w2 + v2 = v2 + w2 + w3 = 2 * w2 * z + u3 = u3 + d * w3 + v3 = v3 + w3 + } + + } else { + + w = 1.0 + a = 1 / tan (PI * dx) + + d = data[xc] + z = 1. / dx + w1 = w * z; u1 = d * w1; v1 = w1 + w2 = w1 * (a - z); u2 = d * w2; v2 = w2 + w3 = -w1 * (1 + 2 * z * (a - z)); u3 = d * w3; v3 = w3 + + # Derivative off center of a pixel. + do i = 1, nsinc { + + w = -w + dx2 = sconst * i * i + taper = (1.0 + a2 * dx2 + a4 * dx2 * dx2) ** 2 + + j = xc - i + if (j >= 1) + d = data[j] + else + d = data[1] + z = 1. / (dx + i) + w1 = w * z * taper + u1 = u1 + d * w1 + v1 = v1 + w1 + w2 = w1 * (a - z) + u2 = u2 + d * w2 + v2 = v2 + w2 + w3 = -w1 * (1 + 2*z*(a-z)) + u3 = u3 + d * w3 + v3 = v3 + w3 + + j = xc + i + if (j <= npix) + d = data[j] + else + d = data[npix] + z = 1. / (dx - i) + w1 = w * z * taper + u1 = u1 + d * w1 + v1 = v1 + w1 + w2 = w1 * (a - z) + u2 = u2 + d * w2 + v2 = v2 + w2 + w3 = -w1 * (1 + 2*z*(a-z)) + u3 = u3 + d * w3 + v3 = v3 + w3 + } + } + + # Compute the derivatives. + w1 = v1 + w2 = v1 * w1 + w3 = v1 * w2 + der[1] = u1 / w1 + if (nder > 1) + der[2] = (u2 * v1 - u1 * v2) / w2 + if (nder > 2) + der[3] = u3 / w1 - 2*u2*v2 / w2 + 2*u1*v2*v2 / w3 - u1*v3 / w2 +end diff --git a/math/iminterp/ii_pc2deval.x b/math/iminterp/ii_pc2deval.x new file mode 100644 index 00000000..c26d2095 --- /dev/null +++ b/math/iminterp/ii_pc2deval.x @@ -0,0 +1,444 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include + +# II_PCPOLY3 -- Procedure to evaluate the polynomial coefficients +# of third order in x and y using Everetts formuala. + +procedure ii_pcpoly3 (coeff, index, len_coeff, pcoeff, len_pcoeff) + +real coeff[ARB] # 1D array of interpolant coeffcients +int index # pointer into coeff array +int len_coeff # row length of coeffcients +real pcoeff[len_pcoeff,ARB] # polynomial coefficients +int len_pcoeff # row length of pcoeff + +int tptr +int i, j +real cd20, cd21, temp[4] + +begin + # determine polynomial coefficients in x + tptr = index + do i = 1, 4 { + + # calculate the central differences + cd20 = 1./6. * (coeff[tptr+1] - 2. * coeff[tptr] + coeff[tptr-1]) + cd21 = 1./6. * (coeff[tptr+2] - 2. * coeff[tptr+1] + coeff[tptr]) + + # calculate the polynomial coefficients in x at each y + pcoeff[1,i] = coeff[tptr] + pcoeff[2,i] = coeff[tptr+1] - coeff[tptr] - 2. * cd20 - cd21 + pcoeff[3,i] = 3. * cd20 + pcoeff[4,i] = cd21 - cd20 + + tptr = tptr + len_coeff + } + + # calculate polynomial coefficients in y + do j = 1, 4 { + + # calculate the central differences + cd20 = 1./6. * (pcoeff[j,3] - 2. * pcoeff[j,2] + pcoeff[j,1]) + cd21 = 1./6. * (pcoeff[j,4] - 2. * pcoeff[j,3] + pcoeff[j,2]) + + # calculate the final coefficients + temp[1] = pcoeff[j,2] + temp[2] = pcoeff[j,3] - pcoeff[j,2] - 2. * cd20 - cd21 + temp[3] = 3. * cd20 + temp[4] = cd21 - cd20 + + do i = 1, 4 + pcoeff[j,i] = temp[i] + } +end + + +# II_PCPOLY5 -- Procedure to evaluate the polynomial coefficients +# of fifth order in x and y using Everetts formuala. + +procedure ii_pcpoly5 (coeff, index, len_coeff, pcoeff, len_pcoeff) + +real coeff[ARB] # 1D array of interpolant coeffcients +int index # pointer into coeff array +int len_coeff # row length of coeffcients +real pcoeff[len_pcoeff,ARB] # polynomial coefficients +int len_pcoeff # row length of pcoeff array + +int tptr +int i, j +real cd20, cd21, cd40, cd41, temp[6] + +begin + # determine polynomial coefficients in x + tptr = index + do i = 1, 6 { + + # calculate the central differences + cd20 = 1./6. * (coeff[tptr+1] - 2. * coeff[tptr] + coeff[tptr-1]) + cd21 = 1./6. * (coeff[tptr+2] - 2. * coeff[tptr+1] + coeff[tptr]) + cd40 = 1./120. * (coeff[tptr-2] - 4. * coeff[tptr-1] + + 6. * coeff[tptr] - 4. * coeff[tptr+1] + + coeff[tptr+2]) + cd41 = 1./120. * (coeff[tptr-1] - 4. * coeff[tptr] + + 6. * coeff[tptr+1] - 4. * coeff[tptr+2] + + coeff[tptr+3]) + + # calculate coefficients in x for each y + pcoeff[1,i] = coeff[tptr] + pcoeff[2,i] = coeff[tptr+1] - coeff[tptr] - 2. * cd20 - cd21 + + 6. * cd40 + 4. * cd41 + pcoeff[3,i] = 3. * cd20 - 5. * cd40 + pcoeff[4,i] = cd21 - cd20 - 5. * (cd40 + cd41) + pcoeff[5,i] = 5. * cd40 + pcoeff[6,i] = cd41 - cd40 + + tptr = tptr + len_coeff + } + + # calculate polynomial coefficients in y + do j = 1, 6 { + + # calculate the central differences + cd20 = 1./6. * (pcoeff[j,4] - 2. * pcoeff[j,3] + pcoeff[j,2]) + cd21 = 1./6. * (pcoeff[j,5] - 2. * pcoeff[j,4] + pcoeff[j,3]) + cd40 = 1./120. * (pcoeff[j,1] - 4. * pcoeff[j,2] + + 6. * pcoeff[j,3] - 4. * pcoeff[j,4] + pcoeff[j,5]) + cd41 = 1./120. * (pcoeff[j,2] - 4. * pcoeff[j,3] + + 6. * pcoeff[j,4] - 4. * pcoeff[j,5] + pcoeff[j,6]) + + # calculate the final coefficients + temp[1] = pcoeff[j,3] + temp[2] = pcoeff[j,4] - pcoeff[j,3] - 2. * cd20 - cd21 + + 6. * cd40 + 4. * cd41 + temp[3] = 3. * cd20 - 5. * cd40 + temp[4] = cd21 - cd20 - 5. * (cd40 + cd41) + temp[5] = 5. * cd40 + temp[6] = cd41 - cd40 + + do i = 1, 6 + pcoeff[j,i] = temp[i] + + } + +end + + +# II_PCSPLINE3 -- Procedure to evaluate the polynomial coefficients +# of bicubic spline. + +procedure ii_pcspline3 (coeff, index, len_coeff, pcoeff, len_pcoeff) + +real coeff[ARB] # 1D array of interpolant coeffcients +int index # pointer into coeff array +int len_coeff # row length of coeffcients +real pcoeff[len_pcoeff,ARB] # polynomial coefficients +int len_pcoeff # row length of pcoeff + +int tptr +int i, j +real temp[4] + +begin + # determine polynomial coefficients in x + tptr = index + do i = 1, 4 { + + pcoeff[1,i] = coeff[tptr+1] + 4. * coeff[tptr] + coeff[tptr-1] + pcoeff[2,i] = 3. * (coeff[tptr+1] - coeff[tptr-1]) + pcoeff[3,i] = 3. * (coeff[tptr-1] - 2. * coeff[tptr] + + coeff[tptr+1]) + pcoeff[4,i] = -coeff[tptr-1] + 3. * coeff[tptr] - + 3. * coeff[tptr+1] + coeff[tptr+2] + + tptr = tptr + len_coeff + } + + # calculate polynomial coefficients in y + do j = 1, 4 { + + temp[1] = pcoeff[j,3] + 4. * pcoeff[j,2] + pcoeff[j,1] + temp[2] = 3. * (pcoeff[j,3] - pcoeff[j,1]) + temp[3] = 3. * (pcoeff[j,1] - 2. * pcoeff[j,2] + pcoeff[j,3]) + temp[4] = -pcoeff[j,1] + 3. * pcoeff[j,2] - 3. * pcoeff[j,3] + + pcoeff[j,4] + + do i = 1, 4 + pcoeff[j,i] = temp[i] + } +end + +# II_BISINCDER -- Evaluate the derivatives of the 2D sinc interpolator. If the +# function value only is needed call ii_bisinc. This routine computes only +# the first 2 derivatives in x and y. The second derivative is computed +# even if only the first derivative is needed. The sinc truncation length +# is nsinc. The taper is a cosbell approximated by a quartic polynomial. +# The data value if returned if x is closer to x[i] than mindx and y is +# closer to y[i] than mindy. + +procedure ii_bisincder (x, y, der, nxder, nyder, len_der, coeff, first_point, + nxpix, nypix, nsinc, mindx, mindy) + +real x, y # the input x and y values +real der[len_der,ARB] # the output derivatives array +int nxder, nyder # the number of derivatives to compute +int len_der # the width of the derivatives array +real coeff[ARB] # the coefficient array +int first_point # offset of first data point into the array +int nxpix, nypix # size of the coefficient array +int nsinc # the sinc truncation length +real mindx, mindy # the precision of the sinc interpolant + +double sumx, normx[3], normy[3], norm[3,3], sum[3,3] +int i, j, k, jj, kk, xc, yc, nconv, index +int minj, maxj, offj, mink, maxk, offk, last_point +pointer sp, ac, ar +real sconst, a2, a4, dx, dy, dxn, dyn, dx2, taper, sdx, ax, ay, ctanx, ctany +real zx, zy +real px[3], py[3] + +begin + # Return if no derivatives ar to be computed. + if (nxder == 0 || nyder == 0) + return + + # Initialize the derivatives to zero. + do jj = 1, nyder { + do kk = 1, nxder + der[kk,jj] = 0.0 + } + + # Return if the data is outside range. + xc = nint (x) + yc = nint (y) + if (xc < 1 || xc > nxpix || yc < 1 || yc > nypix) + return + + # Call ii_bsinc if only the function value is requested. + if (nxder == 1 && nyder == 1) { + call ii_bisinc (coeff, first_point, nxpix, nypix, x, y, der[1,1], + 1, nsinc, mindx, mindy) + return + } + + # Compute the constants for the cosine bell taper approximation. + sconst = (HALFPI / nsinc) ** 2 + a2 = -0.49670 + a4 = 0.03705 + + # Allocate some working space. + nconv = 2 * nsinc + 1 + call smark (sp) + call salloc (ac, 3 * nconv, TY_REAL) + call salloc (ar, 3 * nconv, TY_REAL) + call aclrr (Memr[ac], 3 * nconv) + call aclrr (Memr[ar], 3 * nconv) + + # Initialize. + dx = x - xc + dy = y - yc + if (dx == 0.0) + ctanx = 0.0 + else + ctanx = 1.0 / tan (PI * dx) + if (dy == 0.0) + ctany = 0.0 + else + ctany = 1.0 / tan (PI * dy) + index = - 1 - nsinc + dxn = -1 - nsinc - dx + dyn = -1 - nsinc - dy + if (mod (nsinc, 2) == 0) + sdx = 1.0 + else + sdx = -1.0 + do jj = 1, 3 { + normy[jj] = 0.0d0 + normx[jj] = 0.0d0 + } + + do i = 1, nconv { + dx2 = sconst * (i + index) ** 2 + taper = sdx * (1.0 + a2 * dx2 + a4 * dx2 * dx2) ** 2 + #ax = dxn + i + #ay = dyn + i + ax = -dxn - i + ay = -dyn - i + if (ax == 0.0) { + px[1] = 1.0 + px[2] = 0.0 + px[3] = - 1.0 / 3.0 + } else if (dx == 0.0) { + px[1] = 0.0 + px[2] = 0.0 + px[3] = 0.0 + } else { + zx = 1.0 / ax + px[1] = taper * zx + px[2] = px[1] * (ctanx - zx) + px[3] = -px[1] * (1.0 + 2.0 * zx * (ctanx - zx)) + } + if (ay == 0.0) { + py[1] = 1.0 + py[2] = 0.0 + py[3] = - 1.0 / 3.0 + } else if (dy == 0.0) { + py[1] = 0.0 + py[2] = 0.0 + py[3] = 0.0 + } else { + zy = 1.0 / ay + py[1] = taper * zy + py[2] = py[1] * (ctany - zy) + py[3] = -py[1] * (1.0 + 2.0 * zy * (ctany - zy)) + } + + Memr[ac+i-1] = px[1] + Memr[ac+nconv+i-1] = px[2] + Memr[ac+2*nconv+i-1] = px[3] + Memr[ar+i-1] = py[1] + Memr[ar+nconv+i-1] = py[2] + Memr[ar+2*nconv+i-1] = py[3] + + do jj = 1, 3 { + normx[jj] = normx[jj] + px[jj] + normy[jj] = normy[jj] + py[jj] + } + + sdx = -sdx + } + + # Normalize. + do jj = 1, 3 { + do kk = 1, 3 + norm[kk,jj] = normx[kk] * normy[jj] + } + + + # Do the convolution. + minj = max (1, yc - nsinc) + maxj = min (nypix, yc + nsinc) + mink = max (1, xc - nsinc) + maxk = min (nxpix, xc + nsinc) + do jj = 1, nyder { + offj = ar + (jj - 1) * nconv - yc + nsinc + do kk = 1, nxder { + offk = ac + (kk - 1) * nconv - xc + nsinc + sum[kk,jj] = 0.0d0 + + # Do the convolutions. + do j = yc - nsinc, minj - 1 { + sumx = 0.0d0 + do k = xc - nsinc, mink - 1 + sumx = sumx + Memr[k+offk] * coeff[first_point+1] + do k = mink, maxk + sumx = sumx + Memr[k+offk] * coeff[first_point+k] + do k = maxk + 1, xc + nsinc + sumx = sumx + Memr[k+offk] * coeff[first_point+nxpix] + + sum[kk,jj] = sum[kk,jj] + Memr[j+offj] * sumx + } + + + do j = minj, maxj { + index = first_point + (j - 1) * nxpix + sumx = 0.0d0 + do k = xc - nsinc, mink - 1 + sumx = sumx + Memr[k+offk] * coeff[index+1] + do k = mink, maxk + sumx = sumx + Memr[k+offk] * coeff[index+k] + do k = maxk + 1, xc + nsinc + sumx = sumx + Memr[k+offk] * coeff[index+nxpix] + + sum[kk,jj] = sum[kk,jj] + Memr[j+offj] * sumx + } + + do j = maxj + 1, yc + nsinc { + last_point = first_point + (nypix - 1) * nxpix + sumx = 0.0d0 + do k = xc - nsinc, mink - 1 + sumx = sumx + Memr[k+offk] * coeff[last_point+1] + do k = mink, maxk + sumx = sumx + Memr[k+offk] * coeff[last_point+k] + do k = maxk + 1, xc + nsinc + sumx = sumx + Memr[k+offk] * coeff[last_point+nxpix] + + sum[kk,jj] = sum[kk,jj] + Memr[j+offj] * sumx + } + + } + } + + # Build the derivatives. + der[1,1] = sum[1,1] / norm[1,1] + if (nxder > 1) + der[2,1] = sum[2,1] / norm[1,1] - (sum[1,1] * norm[2,1]) / + norm[1,1] ** 2 + if (nxder > 2) + der[3,1] = sum[3,1] / norm[1,1] - (norm[3,1] * sum[1,1] + + 2.0d0 * sum[2,1] * norm[2,1]) / norm[1,1] ** 2 + + 2.0d0 * sum[1,1] * norm[2,1] * norm[2,1] / norm[1,1] ** 3 + if (nyder > 1) { + der[1,2] = sum[1,2] / norm[1,1] - (sum[1,1] * norm[1,2]) / + norm[1,1] ** 2 + if (nxder > 1) + der[2,2] = sum[2,2] / norm[1,1] - (sum[2,1] * norm[1,2] + + sum[1,2] * norm[2,1] + norm[2,2] * sum[1,1]) / + norm[1,1] ** 2 + (2.0d0 * sum[1,1] * norm[2,1] * + norm[1,2]) / norm[1,1] ** 3 + if (nxder > 2) + der[3,2] = sum[3,2] / norm[1,1] - (sum[3,1] * norm[1,2] + + 2.0 * norm[2,2] * sum[2,1] + 2.0 * sum[2,2] * + norm[2,1] + norm[3,1] * sum[1,2] + norm[3,2] * + sum[1,1]) / norm[1,1] ** 2 + (4.0 * norm[2,1] * + sum[2,1] * norm[1,2] + 2.0 * norm[2,1] * sum[1,2] * + norm[2,1] + 4.0 * norm[2,1] * norm[2,2] * sum[1,1] + + 2.0 * norm[3,1] * norm[1,2] * sum[1,1]) / + norm[1,1] ** 3 - 6.0 * norm[2,1] * norm[2,1] * + norm[1,2] * sum[1,1] / norm[1,1] ** 4 + + } + if (nyder > 2) { + der[1,3] = sum[1,3] / norm[1,1] - (norm[1,3] * sum[1,1] + + 2.0d0 * sum[1,2] * norm[1,2]) / norm[1,1] ** 2 + + 2.0d0 * sum[1,1] * norm[1,2] * norm[1,2] / norm[1,1] ** 3 + if (nxder > 1) + der[2,3] = sum[2,3] / norm[1,1] - (sum[1,3] * norm[2,1] + + 2.0 * norm[2,2] * sum[1,2] + 2.0 * sum[2,2] * + norm[1,2] + norm[1,3] * sum[2,1] + norm[2,3] * + sum[1,1]) / norm[1,1] ** 2 + (4.0 * norm[1,2] * + sum[1,2] * norm[2,1] + 2.0 * norm[1,2] * sum[2,1] * + norm[1,2] + 4.0 * norm[1,2] * norm[2,2] * sum[1,1] + + 2.0 * norm[1,3] * norm[2,1] * sum[1,1]) / + norm[1,1] ** 3 - 6.0 * norm[1,2] * norm[1,2] * + norm[2,1] * sum[1,1] / norm[1,1] ** 4 + if (nxder > 2) + der[3,3] = sum[3,3] / norm[1,1] - (2.0 * sum[2,3] * norm[2,1] + + norm[3,1] * sum[1,3] + 2.0 * norm[3,2] * sum[1,2] + + 4.0 * sum[2,2] * norm[2,2] + 2.0 * sum[3,2] * + norm[1,2] + 2.0 * norm[2,3] * sum[2,1] + sum[3,1] * + norm[1,3] + norm[3,3] * sum[1,1]) / norm[1,1] ** 2 + + (2.0 * norm[2,1] * norm[2,1] * sum[1,3] + 8.0 * + norm[2,1] * sum[1,2] * norm[2,2] + 8.0 * norm[2,1] * + norm[1,2] * sum[2,2] + 4.0 * norm[2,1] * sum[2,1] * + norm[1,3] + 4.0 * norm[2,1] * norm[2,3] * sum[1,1] + + 4.0 * norm[1,2] * sum[1,2] * norm[3,1] + 8.0 * + norm[2,2] * sum[2,1] * norm[1,2] + 2.0 * norm[1,2] * + norm[1,2] * sum[3,1] + 4.0 * norm[2,2] * norm[2,2] * + sum[1,1] + 4.0 * norm[1,2] * norm[3,2] * sum[1,1] + + 2.0 * norm[1,3] * norm[3,1] * sum[1,1]) / + norm[1,1] ** 3 - (12.0 * norm[2,1] * norm[2,1] * + norm[1,2] * sum[1,2] + 12.0 * norm[2,1] * norm[1,2] * + norm[1,2] * sum[2,1] + 24.0 * norm[2,1] * norm[1,2] * + norm[2,2] * sum[1,1] + 6.0 * norm[2,1] * norm[2,1] * + norm[1,3] * sum[1,1] + 6.0 * norm[1,2] * norm[1,2] * + norm[3,1] * sum[1,1]) / norm[1,1] ** 4 + ( 24.0 * + norm[1,2] * norm[1,2] * norm[2,1] * norm[2,1] * + sum[1,1]) / norm[1,1] ** 5 + } + + + + + call sfree (sp) +end diff --git a/math/iminterp/ii_polterp.x b/math/iminterp/ii_polterp.x new file mode 100644 index 00000000..24216751 --- /dev/null +++ b/math/iminterp/ii_polterp.x @@ -0,0 +1,39 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "im1interpdef.h" + +# II_POLTERP -- polynomial interpolator with x and y arrays given. +# This algorithm is based on the Newton form as described in +# C. de Boor's book, "A Practical Guide to Splines", 1978. +# There is no error checking - this is meant to be used only by calls +# from more complete routines that take care of such things. + +# Maximum number of terms is MAX_NDERIVS. + +real procedure ii_polterp (x, y, n, x0) + +real x[ARB],y[ARB] # x and y array +real x0 # desired x +int n # number of points in x and y = number of + # terms in polynomial = order + 1 + +int k,i +real d[MAX_NDERIVS] + +begin + + # Fill in entries for divided difference table. + do i = 1, n + d[i] = y[i] + + # Generate divided differences + do k = 1, n - 1 + do i = 1, n - k + d[i] = (d[i+1] - d[i])/(x[i+k] - x[i]) + + # Shift divided difference table to center on x0 + do i = 2, n + d[i] = d[i] + d[i-1] * (x0 - x[i]) + + return (d[n]) +end diff --git a/math/iminterp/ii_sinctable.x b/math/iminterp/ii_sinctable.x new file mode 100644 index 00000000..e062e9d0 --- /dev/null +++ b/math/iminterp/ii_sinctable.x @@ -0,0 +1,123 @@ +include + +# II_SINCTABLE -- Compute the 1D sinc function look-up tables given the +# width of the sinc function and the number of increments. + +procedure ii_sinctable (table, nconv, nincr, xshift) + +real table[nconv,nincr] #O the computed look-up table +int nconv #I the sinc truncation length +int nincr #I the number of look-up tables +real xshift #I the shift of the look up table + +int i, j, nsinc +real sconst, a2, a4, fsign, xsign, sum, dx, dx2, x, f + +begin + # Set up some constants. + nsinc = (nconv - 1) / 2 + sconst = (HALFPI / nsinc) ** 2 + a2 = -0.49670 + a4 = 0.03705 + if (mod (nsinc, 2) == 0) + fsign = 1.0 + else + fsign = -1.0 + + # Create a one entry look-up table. + if (! IS_INDEFR(xshift)) { + + dx = xshift + x = -nsinc - dx + xsign = fsign + sum = 0.0 + do j = 1, nconv { + if (x == 0.0) + f = 1.0 + else if (dx == 0.0) + f = 0.0 + else { + dx2 = sconst * (j - nsinc - 1) ** 2 + f = xsign / x * (1.0 + a2 * dx2 + a4 * dx2 * dx2) ** 2 + } + table[j,1] = f + sum = sum + f + x = x + 1.0 + xsign = -xsign + } + do j = 1, nconv + table[j,1] = table[j,1] / sum + + # Create a multi-entry evenly spaced look-up table. + } else { + + do i = 1, nincr { + dx = -0.5 + real (i - 1) / real (nincr - 1) + x = -nsinc + dx + xsign = fsign + sum = 0.0 + do j = 1, nconv { + if ((x >= - 0.5 / (nincr - 1)) && (x < 0.5 / (nincr - 1))) + f = 1.0 + else if ((dx >= -0.5 / (nincr - 1)) && + (dx < 0.5 / (nincr - 1))) + f = 0.0 + else { + dx2 = sconst * (j - nsinc - 1) ** 2 + f = xsign / x * (1.0 + a2 * dx2 + a4 * dx2 * dx2) ** 2 + } + table[j,i] = f + sum = sum + f + x = x + 1.0 + xsign = -xsign + } + do j = 1, nconv + table[j,i] = table[j,i] / sum + } + } +end + + +# II_BISINCTABLE -- Compute the 2D sinc function look-up tables given the +# width of the sinc function and the number of increments. + +procedure ii_bisinctable (table, nconv, nxincr, nyincr, xshift, yshift) + +real table[nconv,nconv,nxincr,nyincr] #O the computed look-up table +int nconv #I the sinc truncation length +int nxincr, nyincr #I the number of look-up tables +real xshift, yshift #I the shift of the look up table + +int j, ii, jj +pointer sp, fx, fy + +begin + # Allocate some working memory. + call smark (sp) + call salloc (fx, nconv * nxincr, TY_REAL) + call salloc (fy, nconv * nyincr, TY_REAL) + + # Create a one entry look-up table. + if (! IS_INDEFR(xshift) && ! IS_INDEFR(yshift)) { + + call ii_sinctable (Memr[fx], nconv, 1, xshift) + call ii_sinctable (Memr[fy], nconv, 1, yshift) + do j = 1, nconv { + call amulkr (Memr[fx], Memr[fy+j-1], table[1,j,1,1], nconv) + } + + } else { + + call ii_sinctable (Memr[fx], nconv, nxincr, xshift) + call ii_sinctable (Memr[fy], nconv, nyincr, yshift) + do jj = 1, nyincr { + do ii = 1, nxincr { + do j = 1, nconv + call amulkr (Memr[fx+(ii-1)*nconv], + Memr[fy+(jj-1)*nconv+j-1], table[1,j,ii,jj], nconv) + } + } + } + + call sfree (sp) +end diff --git a/math/iminterp/ii_spline.x b/math/iminterp/ii_spline.x new file mode 100644 index 00000000..c04a94de --- /dev/null +++ b/math/iminterp/ii_spline.x @@ -0,0 +1,56 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# II_SPLINE -- This procedure fits uniformly spaced data with a cubic +# spline. The spline is given as basis-spline coefficients that replace +# the data values. +# +# Storage at call time: +# +# bcoeff[1] = second derivative at x = 1 +# bcoeff[2] = first data point y[1] +# bcoeff[3] = y[2] +# +# bcoeff[n+1] = y[n] +# bcoeff[n+2] = second derivative at x = n +# +# Storage after call: +# +# bcoeff[1] ... bcoeff[n+2] = the n + 2 basis-spline coefficients for the +# basis splines as defined in P.M. Prenter's book "Splines and Variational +# Methods", Wiley, 1975. + +procedure ii_spline (bcoeff, diag, npts) + +real bcoeff[ARB] # data in and also bspline coefficients out +real diag[ARB] # needed for offdiagnol matrix elements +int npts # number of data points + +int i + +begin + diag[1] = -2. + bcoeff[1] = bcoeff[1] / 6. + + diag[2] = 0. + bcoeff[2] = (bcoeff[2] - bcoeff[1]) / 6. + + # Gaussian elimination - diagnol below main is made zero + # and main diagnol is made all 1's + do i = 3, npts + 1 { + diag[i] = 1. / (4. - diag[i-1]) + bcoeff[i] = diag[i] * (bcoeff[i] - bcoeff[i-1]) + } + + # Find last b spline coefficient first - overlay r.h.s.'s + bcoeff[npts+2] = ((diag[npts] + 2.) * bcoeff[npts+1] - bcoeff[npts] + + bcoeff[npts+2] / 6.) / (1. + diag[npts+1] * (diag[npts] + 2.)) + + # back substitute filling in coefficients for b splines + # note bcoeff[npts+1] is evaluated correctly as can be checked + # bcoeff[2] is already set since offdiagnol is 0. + do i = npts + 1, 3, -1 + bcoeff[i] = bcoeff[i] - diag[i] * bcoeff[i+1] + + # evaluate bcoeff[1] + bcoeff[1] = bcoeff[1] + 2. * bcoeff[2] - bcoeff[3] +end diff --git a/math/iminterp/ii_spline2d.x b/math/iminterp/ii_spline2d.x new file mode 100644 index 00000000..037e799c --- /dev/null +++ b/math/iminterp/ii_spline2d.x @@ -0,0 +1,63 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +# II_SPLINE2D -- This procedure calculates the univariate B-spline coefficients +# for each row of data. The data are assumed to be uniformly spaced with a +# spacing of 1. The first element of each row of data is assumed to contain +# the second derivative of the data at x = 1. The nxpix + 2-th element of each +# row is assumed to contain the second derivative of the function at x = nxpix. +# Therfore if each row of data contains nxpix points, nxpix+2 B-spline +# coefficients will be calculated. The univariate B-spline coefficients +# for the i-th row of data are output to the i-th column of coeff. +# Therefore two calls to II_SPLINE2D are required to calculate the 2D B-spline +# coefficients. + +procedure ii_spline2d (data, coeff, nxpix, nvectors, len_data, len_coeff) + +real data[len_data,ARB] # input data array +real coeff[len_coeff,ARB] # output array of univariate coefficients in x +int nxpix # number of x data points +int nvectors # number of univariate splines to calculate +int len_data # row dimension of data +int len_coeff # row dimension of coeff + +int i, j +pointer diag + +errchk malloc, mfree + +begin + # allocate space for off-diagonal elements + call malloc (diag, nxpix+1, TY_REAL) + + # calculate off-diagonal elements by Gaussian elimination + Memr[diag] = -2. + Memr[diag+1] = 0. + do i = 3, nxpix + 1 + Memr[diag+i-1] = 1. / (4. - Memr[diag+i-2]) + + # loop over the nvectors rows of input data + do j = 1, nvectors { + + # copy the j-th row of data to the j-th column of coeff + do i = 1, nxpix + 2 + coeff[j,i] = data[i,j] + + # forward substitution + coeff[j,1] = coeff[j,1] / 6. + coeff[j,2] = (coeff[j,2] - coeff[j,1]) / 6. + do i = 3, nxpix + 1 + coeff[j,i] = Memr[diag+i-1] * (coeff[j,i] - coeff[j,i-1]) + + # back subsitution + coeff[j,nxpix+2] = ((Memr[diag+nxpix-1] + 2.) * coeff[j,nxpix+1] - + coeff[j,nxpix] + coeff[j,nxpix+2] / 6.) / + (1. + Memr[diag+nxpix] * (Memr[diag+nxpix-1] + 2.)) + do i = nxpix + 1, 3, - 1 + coeff[j,i] = coeff[j,i] - Memr[diag+i-1] * coeff[j,i+1] + coeff[j,1] = coeff[j,1] + 2. * coeff[j,2] - coeff[j,3] + + } + + # free space used for off-diagonal element storage + call mfree (diag, TY_REAL) +end diff --git a/math/iminterp/im1interpdef.h b/math/iminterp/im1interpdef.h new file mode 100644 index 00000000..3e6c69e7 --- /dev/null +++ b/math/iminterp/im1interpdef.h @@ -0,0 +1,55 @@ +# Header file for asi package + +# set up the asi descriptor + +define LEN_ASISTRUCT 10 + +define ASI_TYPE Memi[$1] # interpolator type +define ASI_NSINC Memi[$1+1] # sinc interpolator half-width +define ASI_NINCR Memi[$1+2] # number of sinc interpolator luts +define ASI_SHIFT Memr[P2R($1+3)] # sinc interpolator shift +define ASI_PIXFRAC Memr[P2R($1+4)] # pixel fraction for drizzle +define ASI_NCOEFF Memi[$1+5] # number of coefficients +define ASI_OFFSET Memi[$1+6] # offset of first data point +define ASI_COEFF Memi[$1+7] # pointer to coefficient array +define ASI_LTABLE Memi[$1+8] # pointer to sinc look-up table array +define ASI_BADVAL Memr[P2R($1+9)] # bad value for drizzle + +# define element of the coefficient array + +define COEFF Memr[P2P($1)] # element of the coefficient matrix +define LTABLE Memr[P2P($1)] # element of the look-up table + +# define structure for ASISAVE and ASIRESTORE + +define ASI_SAVETYPE $1[1] +define ASI_SAVENSINC $1[2] +define ASI_SAVENINCR $1[3] +define ASI_SAVESHIFT $1[4] +define ASI_SAVEPIXFRAC $1[5] +define ASI_SAVENCOEFF $1[6] +define ASI_SAVEOFFSET $1[7] +define ASI_SAVEBADVAL $1[8] +define ASI_SAVECOEFF 8 + +# define the sinc function truncation length, taper and precision parameters +# These should be identical to the definitions in im2interpdef.h. + +define NSINC 15 # the sinc truncation length +define NINCR 20 # the number of sinc look-up tables +define DX 0.001 # sinc interpolation minimum +define PIXFRAC 1.0 # drizzle pixel fraction +define MIN_PIXFRAC 0.001 # the minimum drizzle pixel fraction +define BADVAL 0.0 + +# define number of points used in spline interpolation for ARIEVAL, ARIDER +# and ARBPIX + +define SPLPTS 16 + +# miscellaneous + +define SPLINE3_ORDER 4 +define POLY3_ORDER 4 +define POLY5_ORDER 6 +define MAX_NDERIVS 6 diff --git a/math/iminterp/im2interpdef.h b/math/iminterp/im2interpdef.h new file mode 100644 index 00000000..6be7366d --- /dev/null +++ b/math/iminterp/im2interpdef.h @@ -0,0 +1,63 @@ +# Internal definitions for the 2D interpolator structure + +define LEN_MSISTRUCT 14 + +define MSI_TYPE Memi[$1] # interpolant type +define MSI_NSINC Memi[$1+1] # interpolant type +define MSI_NXINCR Memi[$1+2] # interpolant type +define MSI_NYINCR Memi[$1+3] # interpolant type +define MSI_XSHIFT Memr[P2R($1+4)] # x shift +define MSI_YSHIFT Memr[P2R($1+5)] # y shift +define MSI_XPIXFRAC Memr[P2R($1+6)] # x pixel fraction for drizzle +define MSI_YPIXFRAC Memr[P2R($1+7)] # y pixel fraction for drizzle +define MSI_NXCOEFF Memi[$1+8] # x dimension of coefficient array +define MSI_NYCOEFF Memi[$1+9] # y dimension of coefficient array +define MSI_COEFF Memi[$1+10] # pointer to coefficient array +define MSI_FSTPNT Memi[$1+11] # offset to first data point in coeff +define MSI_LTABLE Memi[$1+12] # offset to first data point in coeff +define MSI_BADVAL Memr[P2R($1+13)]# undefined pixel value for drizzle + +# Definitions for msisave and msirestore + +define MSI_SAVETYPE $1[1] +define MSI_SAVENSINC $1[2] +define MSI_SAVENXINCR $1[3] +define MSI_SAVENYINCR $1[4] +define MSI_SAVEXSHIFT $1[5] +define MSI_SAVEYSHIFT $1[6] +define MSI_SAVEXPIXFRAC $1[7] +define MSI_SAVEYPIXFRAC $1[8] +define MSI_SAVENXCOEFF $1[9] +define MSI_SAVENYCOEFF $1[10] +define MSI_SAVEFSTPNT $1[11] +define MSI_SAVEBADVAL $1[12] +define MSI_SAVECOEFF 12 + +# Array element definitions +# TEMP and DIAG for spline only + +define COEFF Memr[P2P($1)] # element of coefficient array +define LTABLE Memr[P2P($1)] # element of look-up array +define TEMP Memr[P2P($1)] # element of temporary array +define DIAG Memr[P2P($1)] # element of diagonal + +# The since function truncation length, taper, and precision definitions +# These should be identical to those in im1interpdef.h except for the DY +# definition. + +define NSINC 15 +define NINCR 20 +define DX 0.001 +define DY 0.001 +define PIXFRAC 1.0 +define MIN_PIXFRAC 0.001 +define BADVAL 0.0 + +# miscellaneous defintions + +define FNROWS 5 # maximum number or rows involved in + # boundary extension low side +define LNROWS 7 # maximum number of rows involved in + # high side boundary extension +define SPLPTS 16 # number of points for spline in mrieval +define MAX_NTERMS 6 # maximun number of terms in polynomials diff --git a/math/iminterp/mkpkg b/math/iminterp/mkpkg new file mode 100644 index 00000000..21941853 --- /dev/null +++ b/math/iminterp/mkpkg @@ -0,0 +1,53 @@ +# Image interpolator tools library. + +$checkout libiminterp.a ../ +$update libiminterp.a +$checkin libiminterp.a ../ +$exit + +libiminterp.a: + arbpix.x im1interpdef.h + arider.x im1interpdef.h + arieval.x im1interpdef.h + asider.x im1interpdef.h + asieval.x im1interpdef.h + asifit.x im1interpdef.h + asifree.x im1interpdef.h + asigeti.x im1interpdef.h + asigetr.x im1interpdef.h + asigrl.x im1interpdef.h + asiinit.x im1interpdef.h + asisinit.x im1interpdef.h + asirestore.x im1interpdef.h + asisave.x im1interpdef.h + asitype.x im1interpdef.h + asivector.x im1interpdef.h + ii_1dinteg.x im1interpdef.h + ii_bieval.x + ii_cubspl.f + ii_eval.x + ii_greval.x + ii_pc1deval.x im1interpdef.h + ii_pc2deval.x + ii_polterp.x im1interpdef.h + ii_sinctable.x + ii_spline.x + ii_spline2d.x + mrider.x im2interpdef.h + mrieval.x im2interpdef.h + msider.x im2interpdef.h + msieval.x im2interpdef.h + msifit.x im2interpdef.h + msifree.x im2interpdef.h + msigeti.x im2interpdef.h + msigetr.x im2interpdef.h + msigrid.x im2interpdef.h + msigrl.x im2interpdef.h + msiinit.x im2interpdef.h + msisinit.x im2interpdef.h + msirestore.x im2interpdef.h + msisave.x im2interpdef.h + msisqgrl.x im2interpdef.h + msivector.x im2interpdef.h + msitype.x im2interpdef.h + ; diff --git a/math/iminterp/mrider.x b/math/iminterp/mrider.x new file mode 100644 index 00000000..8413df55 --- /dev/null +++ b/math/iminterp/mrider.x @@ -0,0 +1,420 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "im2interpdef.h" +include + +# MRIDER -- Procedure to evaluate the derivatives of the interpolant +# without the storage overhead required by the sequential version. +# The derivatives are stored such that der[1,1] = the value of the +# interpolant at x and y, der[2,1] = the first derivative in x and +# der[2,1] = the first derivative in y. + +procedure mrider (x, y, datain, nxpix, nypix, len_datain, der, nxder, nyder, + len_der, interp_type) + +real x[ARB] # x value +real y[ARB] # y value +real datain[len_datain,ARB] # data array +int nxpix # number of x data points +int nypix # number of y data points +int len_datain # row length of datain +real der[len_der, ARB] # array of derivatives +int nxder # number of derivatives in x +int nyder # number of derivatives in y +int len_der # row length of der, len_der >= nxder +int interp_type # interpolant type + +int nx, ny, nxterms, nyterms, row_length +int index, xindex, yindex, first_row, last_row +int i, j, ii, jj, kx, ky +pointer tmp +real coeff[SPLPTS+3,SPLPTS+3], pcoeff[MAX_NTERMS,MAX_NTERMS] +real pctemp[MAX_NTERMS,MAX_NTERMS], sum[MAX_NTERMS] +real hold21, hold12, hold22, accum, deltax, deltay, tmpx[4], tmpy[4] +real xmin, xmax, ymin, ymax, sx, sy, tx, ty + +errchk malloc, calloc, mfree + +begin + if (nxder < 1 || nyder < 1) + return + + # zero the derivatives + do j = 1, nyder { + do i = 1, nxder + der[i,j] = 0. + } + + switch (interp_type) { + + case II_BINEAREST: + + der[1,1] = datain[int (x[1]+.5), int (y[1]+.5)] + + return + + case II_BISINC, II_BILSINC: + + call ii_bisincder (x[1], y[1], der, nxder, nyder, len_der, datain, + 0, len_datain, nypix, NSINC, DX, DY) + + return + + case II_BILINEAR: + + nx = x[1] + sx = x[1] - nx + tx = 1. - sx + + ny = y[1] + sy = y[1] - ny + ty = 1. - sy + + # protect against the case where x = nxpix and/or y = nypix + if (nx >= nxpix) + hold21 = 2. * datain[nx,ny] - datain[nx-1,ny] + else + hold21 = datain[nx+1,ny] + if (ny >= nypix) + hold12 = 2. * datain[nx,ny] - datain[nx,ny-1] + else + hold12 = datain[nx,ny+1] + if (nx >= nxpix && ny >= nypix) + hold22 = 2. * hold21 - (2. * datain[nx,ny-1] - + datain[nx-1,ny-1]) + else if (nx >= nxpix) + hold22 = 2. * hold12 - datain[nx-1,ny+1] + else if (ny >= nypix) + hold 22 = 2. * hold21 - datain[nx+1,ny-1] + else + hold22 = datain[nx+1,ny+1] + + # evaluate the derivatives + der[1,1] = tx * ty * datain[nx,ny] + sx * ty * hold21 + + sy * tx * hold12 + sx * sy * hold22 + if (nxder > 1) + der[2,1] = - ty * datain[nx,ny] + ty * hold21 - + sy * hold12 + sy * hold22 + if (nyder > 1) + der[1,2] = - tx * datain[nx,ny] - sx * hold21 + + tx * hold12 + sx * hold22 + if (nxder > 1 && nyder > 1) + der[2,2] = datain[nx,ny] - hold21 - hold12 + hold22 + + + return + + case II_BIDRIZZLE: + call ii_bidriz1 (datain, 0, len_datain, x, y, der[1,1], 1, BADVAL) + if (nxder > 1) { + xmax = max (x[1], x[2], x[3], x[4]) + xmin = min (x[1], x[2], x[3], x[4]) + ymax = max (y[1], y[2], y[3], y[4]) + ymin = min (y[1], y[2], y[3], y[4]) + deltax = xmax - xmin + if (deltax == 0.0) + der[2,1] = 0.0 + else { + tmpx[1] = xmin; tmpy[1] = ymin + tmpx[2] = (xmax - xmin) / 2.0; tmpy[2] = ymin + tmpx[3] = (xmax - xmin) / 2.0; tmpy[3] = ymax + tmpx[4] = xmin; tmpy[4] = ymax + call ii_bidriz1 (datain, 0, len_datain, tmpx, tmpy, + accum, 1, BADVAL) + tmpx[1] = (xmax - xmin) / 2.0; tmpy[1] = ymin + tmpx[2] = xmax; tmpy[2] = ymin + tmpx[3] = xmax; tmpy[3] = ymax + tmpx[4] = (xmax - xmin) / 2.0; tmpy[4] = ymax + call ii_bidriz1 (datain, 0, len_datain, tmpx, tmpy, + der[2,1], 1, BADVAL) + der[2,1] = 2.0 * (der[2,1] - accum) / deltax + } + } + if (nyder > 1) { + deltay = ymax - ymin + if (deltay == 0.0) + der[1,2] = 0.0 + else { + tmpx[1] = xmin; tmpy[1] = ymin + tmpx[2] = xmax; tmpy[2] = ymin + tmpx[3] = xmax; tmpy[3] = (ymax - ymin) / 2.0 + tmpx[4] = xmin; tmpy[4] = (ymax - ymin) / 2.0 + call ii_bidriz1 (datain, 0, len_datain, tmpx, tmpy, + accum, 1, BADVAL) + tmpx[1] = xmin; tmpy[1] = (ymax - ymin) / 2.0 + tmpx[2] = xmax; tmpy[2] = (ymax - ymin) / 2.0 + tmpx[3] = xmax; tmpy[3] = ymax + tmpx[4] = xmin; tmpy[4] = ymax + call ii_bidriz1 (datain, 0, len_datain, tmpx, tmpy, + der[1,2], 1, BADVAL) + der[1,2] = 2.0 * (der[1,2] - accum) / deltay + } + } + + return + + case II_BIPOLY3: + + row_length = SPLPTS + 3 + + nxterms = 4 + nyterms = 4 + + nx = x[1] + ny = y[1] + + sx = x[1] - nx + sy = y[1] - ny + + # use boundary projection to extend the data rows + yindex = 1 + for (j = ny - 1; j <= ny + 2; j = j + 1) { + + # check that the data row is defined + if (j >= 1 && j <= nypix) { + + # extend the rows + xindex = 1 + for (i = nx - 1; i <= nx + 2; i = i + 1) { + if (i < 1) + coeff[xindex,yindex] = 2. * datain[1,j] - + datain[2-i,j] + else if (i > nxpix) + coeff[xindex,yindex] = 2. * datain[nxpix,j] - + datain[2*nxpix-i,j] + else + coeff[xindex,yindex] = datain[i,j] + xindex = xindex + 1 + } + } else if (j == (nypix + 2)) { + + # allow for the final row + xindex = 1 + for (i = nx - 1; i <= nx + 2; i = i + 1) { + if (i < 1) + coeff[xindex,nyterms] = 2. * datain[1,nypix-2] - + datain[2-i,nypix-2] + else if (i > nxpix) + coeff[xindex,nyterms] = 2. * datain[nxpix,nypix-2] - + datain[2*nxpix-i,nypix-2] + else + coeff[xindex,nyterms] = datain[i,nypix-2] + xindex = xindex + 1 + } + + } + + yindex = yindex + 1 + } + + + # project columns + first_row = max (1, 3 - ny) + if (first_row > 1) { + for (j = 1; j < first_row; j = j + 1) + call awsur (coeff[1, first_row], coeff[1, 2*first_row-j], + coeff[1,j], nxterms, 2., -1.) + } + + last_row = min (nxterms, nypix - ny + 2) + if (last_row < nxterms) { + for (j = last_row + 1; j <= nxterms - 1; j = j + 1) + call awsur (coeff[1,last_row], coeff[1,2*last_row-j], + coeff[1,j], nxterms, 2., -1.) + if (last_row == 2) + call awsur (coeff[1,last_row], coeff[1,4], coeff[1,4], + nxterms, 2., -1.) + else + call awsur (coeff[1,last_row], coeff[1,2*last_row-4], + coeff[1,4], nxterms, 2., -1.) + } + + # calculate the coefficients of the bicubic polynomial + call ii_pcpoly3 (coeff, 2, row_length, pcoeff, MAX_NTERMS) + + case II_BIPOLY5: + row_length = SPLPTS + 3 + + nxterms = 6 + nyterms = 6 + + nx = x[1] + ny = y[1] + + sx = x[1] - nx + sy = y[1] - ny + + # extend rows of data + yindex = 1 + for (j = ny - 2; j <= ny + 3; j = j + 1) { + + # select the rows containing data + if (j >= 1 && j <= nypix) { + + # extend the rows + xindex = 1 + for (i = nx - 2; i <= nx + 3; i = i + 1) { + if (i < 1) + coeff[xindex,yindex] = 2. * datain[1,j] - + datain[2-i,j] + else if (i > nxpix) + coeff[xindex,yindex] = 2. * datain[nxpix,j] - + datain[2*nxpix-i,j] + else + coeff[xindex,yindex] = datain[i,j] + xindex = xindex + 1 + } + + } else if (j == (ny + 3)) { + + # extend the rows + xindex = 1 + for (i = nx - 2; i <= nx + 3; i = i + 1) { + if (i < 1) + coeff[xindex,yindex] = 2. * datain[1,nypix-3] - + datain[2-i,nypix-3] + else if (i > nxpix) + coeff[xindex,yindex] = 2. * datain[nxpix,nypix-3] - + datain[2*nxpix-i,nypix-3] + else + coeff[xindex,yindex] = datain[i,nypix-3] + xindex = xindex + 1 + } + + } + + yindex = yindex + 1 + } + + # project columns + + first_row = max (1, 4 - ny) + if (first_row > 1) { + for (j = 1; j < first_row; j = j + 1) + call awsur (coeff[1,first_row], coeff[1,2*first_row-j], + coeff[1,j], nxterms, 2., -1.) + } + + last_row = min (nxterms, nypix - ny + 3) + if (last_row < nxterms) { + for (j = last_row + 1; j <= nxterms - 1; j = j + 1) + call awsur (coeff[1,last_row], coeff[1,2*last_row-j], + coeff[1,j], nxterms, 2., -1.) + if (last_row == 3) + call awsur (coeff[1,last_row], coeff[1,6], coeff[1,6], + nxterms, 2., -1.) + else + call awsur (coeff[1,last_row], coeff[1,2*last_row-6], + coeff[1,6], nxterms, 2., -1.) + } + + # caculate the polynomial coeffcients + call ii_pcpoly5 (coeff, 3, row_length, pcoeff, MAX_NTERMS) + + + case II_BISPLINE3: + row_length = SPLPTS + 3 + + nxterms = 4 + nyterms = 4 + + nx = x[1] + ny = y[1] + + sx = x[1] - nx + sy = y[1] - ny + + # allocate space for temporary array and 0 file + call calloc (tmp, row_length * row_length, TY_REAL) + + ky = 0 + # maximum number of points used in each direction is SPLPTS + for (j = ny - SPLPTS/2 + 1; j <= ny + SPLPTS/2; j = j + 1) { + + if (j < 1 || j > nypix) + ; + else { + ky = ky + 1 + if (ky == 1) + yindex = ny - j + 1 + + kx = 0 + for (i = nx - SPLPTS/2 + 1; i <= nx + SPLPTS/2; i = i + 1) { + if (i < 1 || i > nxpix) + ; + else { + kx = kx + 1 + if (kx == 1) + xindex = nx - i + 1 + coeff[kx+1,ky+1] = datain[i,j] + } + } + + coeff[1,ky+1] = 0. + coeff[kx+2,ky+1] = 0. + coeff[kx+3,ky+1] = 0. + + } + } + + # zero out 1st and last 2 rows + call amovkr (0., coeff[1,1], kx+3) + call amovkr (0., coeff[1,ky+2], kx+3) + call amovkr (0., coeff[1,ky+3],kx+3) + + # calculate the spline coefficients + call ii_spline2d (coeff, Memr[tmp], kx, ky+2, row_length, + row_length) + call ii_spline2d (Memr[tmp], coeff, ky, kx+2, row_length, + row_length) + + # calculate the polynomial coefficients + index = (yindex - 1) * row_length + xindex + 1 + call ii_pcspline3 (coeff, index, row_length, pcoeff, MAX_NTERMS) + + # free space + call mfree (tmp, TY_REAL) + } + + # evaluate the derivatives of the higher order interpolants + do j = 1, nyder { + + # set pctemp + do jj = nyterms, j, -1 { + do ii = 1, nxterms + pctemp[ii,jj] = pcoeff[ii,jj] + } + + do i = 1, nxder { + + # accumulate the partial sums in x + do jj = nyterms, j, -1 { + sum[jj] = pctemp[nxterms,jj] + do ii = nxterms - 1, i, -1 + sum[jj] = pctemp[ii,jj] + sum[jj] * sx + } + + # accumulate the sum in y + accum = sum[nyterms] + do jj = nyterms - 1, j, -1 + accum = sum[jj] + accum * sy + + # evaulate the derivative + der[i,j] = accum + + # differentiate in x + do jj = nyterms, j, -1 { + do ii = nxterms, i + 1, -1 + pctemp[ii,jj] = (ii - i) * pctemp[ii,jj] + } + + } + + # differentiate in y + do jj = 1, nxterms { + do ii = nyterms, j + 1, -1 + pcoeff[jj,ii] = (ii - j) * pcoeff[jj,ii] + } + + } +end diff --git a/math/iminterp/mrieval.x b/math/iminterp/mrieval.x new file mode 100644 index 00000000..6d89c456 --- /dev/null +++ b/math/iminterp/mrieval.x @@ -0,0 +1,303 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "im2interpdef.h" +include + +# MRIEVAL -- Procedure to evaluate the 2D interpolant at a given value +# of x and y. MRIEVAL allows the interpolation of a few interpolated +# points without the computing time and storage required for the +# sequential version. The routine assumes that 1 <= x <= nxpix and +# 1 <= y <= nypix. + +real procedure mrieval (x, y, datain, nxpix, nypix, len_datain, interp_type) + +real x[ARB] # x value +real y[ARB] # y value +real datain[len_datain,ARB] # data array +int nxpix # number of x data points +int nypix # number of y data points +int len_datain # row length of datain +int interp_type # interpolant type + +int nx, ny, nterms, row_length +int xindex, yindex, first_row, last_row +int kx, ky +int i, j +pointer tmp +real coeff[SPLPTS+3,SPLPTS+3] +real hold21, hold12, hold22 +real sx, sy, tx, ty +real xval, yval, value +errchk malloc, calloc, mfree + +begin + switch (interp_type) { + + case II_BINEAREST: + return (datain[int (x[1]+0.5), int (y[1]+0.5)]) + + case II_BILINEAR: + nx = x[1] + sx = x[1] - nx + tx = 1. - sx + + ny = y[1] + sy = y[1] - ny + ty = 1. - sy + + # protect against the case where x = nxpix and/or y = nypix + if (nx >= nxpix) + hold21 = 2. * datain[nx,ny] - datain[nx-1,ny] + else + hold21 = datain[nx+1,ny] + if (ny >= nypix) + hold12 = 2. * datain[nx,ny] - datain[nx,ny-1] + else + hold12 = datain[nx,ny+1] + if (nx >= nxpix && ny >= nypix) + hold22 = 2. * hold21 - (2. * datain[nx,ny-1] - + datain[nx-1,ny-1]) + else if (nx >= nxpix) + hold22 = 2. * hold12 - datain[nx-1,ny+1] + else if (ny >= nypix) + hold22 = 2. * hold21 - datain[nx+1,ny-1] + else + hold22 = datain[nx+1,ny+1] + + # evaluate the interpolant + value = tx * ty * datain[nx,ny] + sx * ty * hold21 + + sy * tx * hold12 + sx * sy * hold22 + + return (value) + + case II_BIDRIZZLE: + call ii_bidriz1 (datain, 0, len_datain, x, y, value, 1, BADVAL) + + return (value) + + case II_BIPOLY3: + row_length = SPLPTS + 3 + nterms = 4 + nx = x[1] + ny = y[1] + + # major problem is that near the edge the interior polynomial + # must be defined + + # use boundary projection to extend the data rows + yindex = 1 + for (j = ny - 1; j <= ny + 2; j = j + 1) { + + # check that the data row is defined + if (j >= 1 && j <= nypix) { + + # extend the rows + xindex = 1 + for (i = nx - 1; i <= nx + 2; i = i + 1) { + if (i < 1) + coeff[xindex,yindex] = 2. * datain[1,j] - + datain[2-i,j] + else if (i > nxpix) + coeff[xindex,yindex] = 2. * datain[nxpix,j] - + datain[2*nxpix-i,j] + else + coeff[xindex,yindex] = datain[i,j] + xindex = xindex + 1 + } + + } else if (j == (ny + 2)) { + + # extend the rows + xindex = 1 + for (i = nx - 1; i <= nx + 2; i = i + 1) { + if (i < 1) + coeff[xindex,yindex] = 2. * datain[1,nypix-2] - + datain[2-i,nypix-2] + else if (i > nxpix) + coeff[xindex,yindex] = 2. * datain[nxpix,nypix-2] - + datain[2*nxpix-i,nypix-2] + else + coeff[xindex,yindex] = datain[i,nypix-2] + xindex = xindex + 1 + } + + } + + yindex = yindex + 1 + } + + # project columns + + first_row = max (1, 3 - ny) + if (first_row > 1) { + for (j = 1; j < first_row; j = j + 1) + call awsur (coeff[1, first_row], coeff[1, 2*first_row-j], + coeff[1,j], nterms, 2., -1.) + } + + last_row = min (nterms, nypix - ny + 2) + if (last_row < nterms) { + for (j = last_row + 1; j <= nterms - 1; j = j + 1) + call awsur (coeff[1,last_row], coeff[1,2*last_row-j], + coeff[1,j], nterms, 2., -1.) + if (last_row == 2) + call awsur (coeff[1,last_row], coeff[1,4], coeff[1,4], + nterms, 2., -1.) + else + call awsur (coeff[1,last_row], coeff[1,2*last_row-4], + coeff[1,4], nterms, 2., -1.) + } + + + # center the x value and call evaluation routine + xval = 2 + (x[1] - nx) + yval = 2 + (y[1] - ny) + call ii_bipoly3 (coeff, 0, row_length, xval, yval, value, 1) + + return (value) + + case II_BIPOLY5: + row_length = SPLPTS + 3 + nterms = 6 + nx = x[1] + ny = y[1] + + # major problem is to define interior polynomial near the edge + + # loop over the rows of data + yindex = 1 + for (j = ny - 2; j <= ny + 3; j = j + 1) { + + # select the rows containing data + if (j >= 1 && j <= nypix) { + + # extend the rows + xindex = 1 + for (i = nx - 2; i <= nx + 3; i = i + 1) { + if (i < 1) + coeff[xindex,yindex] = 2. * datain[1,j] - + datain[2-i,j] + else if (i > nxpix) + coeff[xindex,yindex] = 2. * datain[nxpix,j] - + datain[2*nxpix-i,j] + else + coeff[xindex,yindex] = datain[i,j] + xindex = xindex + 1 + } + + } else if (j == (ny + 3)) { + + # extend the rows + xindex = 1 + for (i = nx - 2; i <= nx + 3; i = i + 1) { + if (i < 1) + coeff[xindex,yindex] = 2. * datain[1,nypix-3] - + datain[2-i,nypix-3] + else if (i > nxpix) + coeff[xindex,yindex] = 2. * datain[nxpix,nypix-3] - + datain[2*nxpix-i,nypix-3] + else + coeff[xindex,yindex] = datain[i,nypix-3] + xindex = xindex + 1 + } + + } + + yindex = yindex + 1 + } + + # project columns + + first_row = max (1, 4 - ny) + if (first_row > 1) { + for (j = 1; j < first_row; j = j + 1) + call awsur (coeff[1,first_row], coeff[1,2*first_row-j], + coeff[1,j], nterms, 2., -1.) + } + + last_row = min (nterms, nypix - ny + 3) + if (last_row < nterms) { + for (j = last_row + 1; j <= nterms - 1; j = j + 1) + call awsur (coeff[1,last_row], coeff[1,2*last_row-j], + coeff[1,j], nterms, 2., -1.) + if (last_row == 3) + call awsur (coeff[1,last_row], coeff[1,6], coeff[1,6], + nterms, 2., -1.) + else + call awsur (coeff[1,last_row], coeff[1,2*last_row-6], + coeff[1,6], nterms, 2., -1.) + } + + # call evaluation routine + xval = 3 + (x[1] - nx) + yval = 3 + (y[1] - ny) + call ii_bipoly5 (coeff, 0, row_length, xval, yval, value, 1) + + return (value) + + case II_BISPLINE3: + row_length = SPLPTS + 3 + nx = x[1] + ny = y[1] + + # allocate space for temporary array and 0 file + call calloc (tmp, row_length * row_length, TY_REAL) + + ky = 0 + # maximum number of points used in each direction is SPLPTS + for (j = ny - SPLPTS/2 + 1; j <= ny + SPLPTS/2; j = j + 1) { + + if (j < 1 || j > nypix) + ; + else { + ky = ky + 1 + if (ky == 1) + yindex = ny - j + 1 + + kx = 0 + for (i = nx - SPLPTS/2 + 1; i <= nx + SPLPTS/2; i = i + 1) { + if (i < 1 || i > nxpix) + ; + else { + kx = kx + 1 + if (kx == 1) + xindex = nx - i + 1 + coeff[kx+1,ky+1] = datain[i,j] + } + } + + coeff[1,ky+1] = 0. + coeff[kx+2,ky+1] = 0. + coeff[kx+3,ky+1] = 0. + + } + } + + # zero out 1st and last 2 rows + call amovkr (0., coeff[1,1], kx+3) + call amovkr (0., coeff[1,ky+2], kx+3) + call amovkr (0., coeff[1,ky+3],kx+3) + + # calculate the spline coefficients + call ii_spline2d (coeff, Memr[tmp], kx, ky+2, row_length, + row_length) + call ii_spline2d (Memr[tmp], coeff, ky, kx+2, row_length, + row_length) + + # evaluate spline + xval = xindex + 1 + (x[1] - nx) + yval = yindex + 1 + (y[1] - ny) + call ii_bispline3 (coeff, 0, row_length, xval, yval, value, 1) + + # free space + call mfree (tmp, TY_REAL) + + return (value) + + case II_BISINC, II_BILSINC: + call ii_bisinc (datain, 0, len_datain, nypix, x, y, value, 1, + NSINC, DX, DY) + + return (value) + } +end diff --git a/math/iminterp/msider.x b/math/iminterp/msider.x new file mode 100644 index 00000000..e66d9119 --- /dev/null +++ b/math/iminterp/msider.x @@ -0,0 +1,294 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "im2interpdef.h" +include + +# MSIDER -- Calculate the derivatives of the interpolant. The derivative +# der[i,j] = d f(x,y) / dx (i-1) dy (j-1). Therefore der[1,1] contains +# the value of the interpolant, der[2,1] the 1st derivative in x and +# der[1,2] the first derivative in y. + +procedure msider (msi, x, y, der, nxder, nyder, len_der) + +pointer msi # pointer to interpolant descriptor structure +real x[ARB] # x value +real y[ARB] # y value +real der[len_der,ARB] # derivative array +int nxder # number of x derivatives +int nyder # number of y derivatives +int len_der # row length of der, len_der >= nxder + +int first_point, len_coeff +int nxterms, nyterms, nx, ny, nyd, nxd +int i, j, ii, jj +real sx, sy, tx, ty, xmin, xmax, ymin, ymax +real pcoeff[MAX_NTERMS,MAX_NTERMS], pctemp[MAX_NTERMS,MAX_NTERMS] +real sum[MAX_NTERMS], accum, deltax, deltay, tmpx[4], tmpy[4] +pointer index, ptr + +begin + if (nxder < 1 || nyder < 1) + return + + # set up coefficient array parameters + len_coeff = MSI_NXCOEFF(msi) + index = MSI_COEFF(msi) + MSI_FSTPNT(msi) - 1 + + # zero the derivatives + do j = 1, nyder { + do i = 1, nxder + der[i,j] = 0. + } + + # calculate the appropriate number of terms of the polynomials in + # x and y + + switch (MSI_TYPE(msi)) { + + case II_BINEAREST: + + nx = x[1] + 0.5 + ny = y[1] + 0.5 + + ptr = index + (ny - 1) * len_coeff + nx + der[1,1] = COEFF(ptr) + + return + + case II_BISINC, II_BILSINC: + + call ii_bisincder (x[1], y[1], der, nxder, nyder, len_der, + COEFF(MSI_COEFF(msi)), MSI_FSTPNT(msi), MSI_NXCOEFF(msi), + MSI_NYCOEFF(msi), MSI_NSINC(msi), DX, DY) + + return + + case II_BILINEAR: + + nx = x[1] + ny = y[1] + sx = x[1] - nx + sy = y[1] - ny + tx = 1. - sx + ty = 1. - sy + + ptr = index + (ny - 1) * len_coeff + nx + der[1,1] = tx * ty * COEFF(ptr) + sx * ty * COEFF(ptr+1) + + sy * tx * COEFF(ptr+len_coeff) + + sx * sy * COEFF(ptr+len_coeff+1) + + if (nxder > 1) + der[2,1] = -ty * COEFF(ptr) + ty * COEFF(ptr+1) - + sy * COEFF(ptr+len_coeff) + + sy * COEFF(ptr+len_coeff+1) + + if (nyder > 1) + der[1,2] = -tx * COEFF(ptr) - sx * COEFF(ptr+1) + + tx * COEFF(ptr+len_coeff) + + sx * COEFF(ptr+len_coeff+1) + + if (nyder > 1 && nxder > 1) + der[2,2] = COEFF(ptr) - COEFF(ptr+1) - COEFF(ptr+len_coeff) + + COEFF(ptr+len_coeff+1) + + return + + case II_BIDRIZZLE: + if (MSI_XPIXFRAC(msi) >= 1.0 && MSI_YPIXFRAC(msi) >= 1.0) + call ii_bidriz1 (COEFF(MSI_COEFF(msi)), MSI_FSTPNT(msi), + MSI_NXCOEFF(msi), x, y, der[1,1], 1, MSI_BADVAL(msi)) + #else if (MSI_XPIXFRAC(msi) <= 0.0 && MSI_YPIXFRAC(msi) <= 0.0) + #call ii_bidriz0 (COEFF(MSI_COEFF(msi)), MSI_FSTPNT(msi), + #MSI_NXCOEFF(msi), x, y, der[1,1], 1, MSI_BADVAL(msi)) + else + call ii_bidriz (COEFF(MSI_COEFF(msi)), MSI_FSTPNT(msi), + MSI_NXCOEFF(msi), x, y, der[1,1], 1, MSI_XPIXFRAC(msi), + MSI_YPIXFRAC(msi), MSI_BADVAL(msi)) + + if (nxder > 1) { + xmax = max (x[1], x[2], x[3], x[4]) + xmin = min (x[1], x[2], x[3], x[4]) + ymax = max (y[1], y[2], y[3], y[4]) + ymin = min (y[1], y[2], y[3], y[4]) + deltax = xmax - xmin + if (deltax == 0.0) + der[2,1] = 0.0 + else { + tmpx[1] = xmin; tmpy[1] = ymin + tmpx[2] = (xmax - xmin) / 2.0; tmpy[2] = ymin + tmpx[3] = (xmax - xmin) / 2.0; tmpy[3] = ymax + tmpx[4] = xmin; tmpy[4] = ymax + if (MSI_XPIXFRAC(msi) >= 1.0 && MSI_YPIXFRAC(msi) >= 1.0) + call ii_bidriz1 (COEFF(MSI_COEFF(msi)), MSI_FSTPNT(msi), + MSI_NXCOEFF(msi), tmpx, tmpy, accum, 1, + MSI_BADVAL(msi)) + #else if (MSI_XPIXFRAC(msi) <= 0.0 && + #MSI_YPIXFRAC(msi) <= 0.0) + #call ii_bidriz0 (COEFF(MSI_COEFF(msi)), + #MSI_FSTPNT(msi), MSI_NXCOEFF(msi), tmpx, tmpy, + #accum, 1, MSI_BADVAL(msi)) + else + call ii_bidriz (COEFF(MSI_COEFF(msi)), MSI_FSTPNT(msi), + MSI_NXCOEFF(msi), tmpx, tmpy, accum, 1, + MSI_XPIXFRAC(msi), MSI_YPIXFRAC(msi), + MSI_BADVAL(msi)) + tmpx[1] = (xmax - xmin) / 2.0; tmpy[1] = ymin + tmpx[2] = xmax; tmpy[2] = ymin + tmpx[3] = xmax; tmpy[3] = ymax + tmpx[4] = (xmax - xmin) / 2.0; tmpy[4] = ymax + if (MSI_XPIXFRAC(msi) >= 1.0 && MSI_YPIXFRAC(msi) >= 1.0) + call ii_bidriz1 (COEFF(MSI_COEFF(msi)), MSI_FSTPNT(msi), + MSI_NXCOEFF(msi), tmpx, tmpy, der[2,1], 1, + MSI_BADVAL(msi)) + #else if (MSI_XPIXFRAC(msi) <= 0.0 && + #MSI_YPIXFRAC(msi) <= 0.0) + #call ii_bidriz0 (COEFF(MSI_COEFF(msi)), + #MSI_FSTPNT(msi), MSI_NXCOEFF(msi), tmpx, tmpy, + #der[2,1], 1, MSI_BADVAL(msi)) + else + call ii_bidriz (COEFF(MSI_COEFF(msi)), MSI_FSTPNT(msi), + MSI_NXCOEFF(msi), tmpx, tmpy, der[2,1], 1, + MSI_XPIXFRAC(msi), MSI_YPIXFRAC(msi), + MSI_BADVAL(msi)) + der[2,1] = 2.0 * (der[2,1] - accum) / deltax + } + } + if (nyder > 1) { + deltay = ymax - ymin + if (deltay == 0.0) + der[1,2] = 0.0 + else { + tmpx[1] = xmin; tmpy[1] = ymin + tmpx[2] = xmax; tmpy[2] = ymin + tmpx[3] = xmax; tmpy[3] = (ymax - ymin) / 2.0 + tmpx[4] = xmin; tmpy[4] = (ymax - ymin) / 2.0 + if (MSI_XPIXFRAC(msi) >= 1.0 && MSI_YPIXFRAC(msi) >= 1.0) + call ii_bidriz1 (COEFF(MSI_COEFF(msi)), MSI_FSTPNT(msi), + MSI_NXCOEFF(msi), tmpx, tmpy, accum, 1, + MSI_BADVAL(msi)) + #else if (MSI_XPIXFRAC(msi) <= 0.0 && + #MSI_YPIXFRAC(msi) <= 0.0) + #call ii_bidriz0 (COEFF(MSI_COEFF(msi)), + #MSI_FSTPNT(msi), MSI_NXCOEFF(msi), tmpx, tmpy, + #accum, 1, MSI_BADVAL(msi)) + else + call ii_bidriz (COEFF(MSI_COEFF(msi)), MSI_FSTPNT(msi), + MSI_NXCOEFF(msi), tmpx, tmpy, accum, 1, + MSI_XPIXFRAC(msi), MSI_YPIXFRAC(msi), + MSI_BADVAL(msi)) + tmpx[1] = xmin; tmpy[1] = (ymax - ymin) / 2.0 + tmpx[2] = xmax; tmpy[2] = (ymax - ymin) / 2.0 + tmpx[3] = xmax; tmpy[3] = ymax + tmpx[4] = xmin; tmpy[4] = ymax + if (MSI_XPIXFRAC(msi) >= 1.0 && MSI_YPIXFRAC(msi) >= 1.0) + call ii_bidriz1 (COEFF(MSI_COEFF(msi)), MSI_FSTPNT(msi), + MSI_NXCOEFF(msi), tmpx, tmpy, der[1,2], 1, + MSI_BADVAL(msi)) + #else if (MSI_XPIXFRAC(msi) <= 0.0 && + #MSI_YPIXFRAC(msi) <= 0.0) + #call ii_bidriz0 (COEFF(MSI_COEFF(msi)), + #MSI_FSTPNT(msi), MSI_NXCOEFF(msi), tmpx, tmpy, + #der[1,2], 1, MSI_BADVAL(msi)) + else + call ii_bidriz (COEFF(MSI_COEFF(msi)), MSI_FSTPNT(msi), + MSI_NXCOEFF(msi), tmpx, tmpy, der[1,2], 1, + MSI_XPIXFRAC(msi), MSI_YPIXFRAC(msi), + MSI_BADVAL(msi)) + der[1,2] = 2.0 * (der[1,2] - accum) / deltay + } + } + + return + + case II_BIPOLY3: + + nxterms = 4 + nyterms = 4 + + nxd = min (nxder, 4) + nyd = min (nyder, 4) + + nx = x[1] + sx = x[1] - nx + ny = y[1] + sy = y[1] - ny + + first_point = MSI_FSTPNT(msi) + (ny - 2) * len_coeff + nx + call ii_pcpoly3 (COEFF(MSI_COEFF(msi)), first_point, len_coeff, + pcoeff, 6) + + case II_BIPOLY5: + + nxterms = 6 + nyterms = 6 + + nxd = min (nxder, 6) + nyd = min (nyder, 6) + + nx = x[1] + sx = x[1] - nx + ny = y[1] + sy = y[1] - ny + + first_point = MSI_FSTPNT(msi) + (ny - 3) * len_coeff + nx + call ii_pcpoly5 (COEFF(MSI_COEFF(msi)), first_point, len_coeff, + pcoeff, 6) + + case II_BISPLINE3: + + nxterms = 4 + nyterms = 4 + + nxd = min (nxder, 4) + nyd = min (nyder, 4) + + nx = x[1] + sx = x[1] - nx + ny = y[1] + sy = y[1] - ny + + first_point = MSI_FSTPNT(msi) + (ny - 2) * len_coeff + nx + call ii_pcspline3 (COEFF(MSI_COEFF(msi)), first_point, len_coeff, + pcoeff, 6) + } + + # evaluate the derivatives by nested multiplication + do j = 1, nyd { + + # set pctemp + do jj = nyterms, j, -1 { + do ii = 1, nxterms + pctemp[ii,jj] = pcoeff[ii,jj] + } + + do i = 1, nxd { + + # accumulate the partial sums in x + do jj = nyterms, j, -1 { + sum[jj] = pctemp[nxterms,jj] + do ii = nxterms - 1, i, -1 + sum[jj] = pctemp[ii,jj] + sum[jj] * sx + } + + # accumulate the sum in y + accum = sum[nyterms] + do jj = nyterms - 1, j, -1 + accum = sum[jj] + accum * sy + + # evaluate derivative + der[i,j] = accum + + # differentiate in x + do jj = nyterms, j, -1 { + do ii = nxterms, i + 1, -1 + pctemp[ii,jj] = (ii - i) * pctemp[ii,jj] + } + } + + # differentiate in y + do jj = 1, nxterms { + do ii = nyterms, j + 1, -1 + pcoeff[jj,ii] = (ii - j) * pcoeff[jj,ii] + } + } +end diff --git a/math/iminterp/msieval.x b/math/iminterp/msieval.x new file mode 100644 index 00000000..26af75b6 --- /dev/null +++ b/math/iminterp/msieval.x @@ -0,0 +1,74 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "im2interpdef.h" +include + +# MSIEVAL -- Procedure to evaluate the interpolant at a single point. +# The procedure assumes that 1 <= x <= nxpix and that 1 <= y <= nypix. +# Checking for out of bounds pixels is the responsibility of the calling +# program. + +real procedure msieval (msi, x, y) + +pointer msi # pointer to the interpolant descriptor +real x[ARB] # x data value +real y[ARB] # y data value + +real value + +begin + switch (MSI_TYPE(msi)) { + + case II_BINEAREST: + call ii_binearest (COEFF(MSI_COEFF(msi)), MSI_FSTPNT(msi), + MSI_NXCOEFF(msi), x, y, value, 1) + return (value) + + case II_BILINEAR: + call ii_bilinear (COEFF(MSI_COEFF(msi)), MSI_FSTPNT(msi), + MSI_NXCOEFF(msi), x, y, value, 1) + return (value) + + case II_BIPOLY3: + call ii_bipoly3 (COEFF(MSI_COEFF(msi)), MSI_FSTPNT(msi), + MSI_NXCOEFF(msi), x, y, value, 1) + return (value) + + case II_BIPOLY5: + call ii_bipoly5 (COEFF(MSI_COEFF(msi)), MSI_FSTPNT(msi), + MSI_NXCOEFF(msi), x, y, value, 1) + return (value) + + case II_BISPLINE3: + call ii_bispline3 (COEFF(MSI_COEFF(msi)), MSI_FSTPNT(msi), + MSI_NXCOEFF(msi), x, y, value, 1) + return (value) + + case II_BISINC: + call ii_bisinc (COEFF(MSI_COEFF(msi)), MSI_FSTPNT(msi), + MSI_NXCOEFF(msi), MSI_NYCOEFF(msi), x, y, value, 1, + MSI_NSINC(msi), DX, DY) + return (value) + + case II_BILSINC: + call ii_bilsinc (COEFF(MSI_COEFF(msi)), MSI_FSTPNT(msi), + MSI_NXCOEFF(msi), MSI_NYCOEFF(msi), x, y, value, 1, + LTABLE(MSI_LTABLE(msi)), 2 * MSI_NSINC(msi) + 1, + MSI_NXINCR(msi), MSI_NYINCR(msi), DX, DY) + return (value) + + case II_BIDRIZZLE: + if (MSI_XPIXFRAC(msi) >= 1.0 && MSI_YPIXFRAC(msi) >= 1.0) + call ii_bidriz1 (COEFF(MSI_COEFF(msi)), MSI_FSTPNT(msi), + MSI_NXCOEFF(msi), x, y, value, 1, MSI_BADVAL(msi)) + #else if (MSI_XPIXFRAC(msi) <= 0.0 && MSI_YPIXFRAC(msi) <= 0.0) + #call ii_bidriz0 (COEFF(MSI_COEFF(msi)), MSI_FSTPNT(msi), + #MSI_NXCOEFF(msi), x, y, value, 1, MSI_BADVAL(msi)) + else + call ii_bidriz (COEFF(MSI_COEFF(msi)), MSI_FSTPNT(msi), + MSI_NXCOEFF(msi), x, y, value, 1, MSI_XPIXFRAC(msi), + MSI_YPIXFRAC(msi), MSI_BADVAL(msi)) + return (value) + + } +end diff --git a/math/iminterp/msifit.x b/math/iminterp/msifit.x new file mode 100644 index 00000000..27d861ff --- /dev/null +++ b/math/iminterp/msifit.x @@ -0,0 +1,275 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "im2interpdef.h" +include + +# MSIFIT -- MSIFIT calculates the coefficients of the interpolant. +# With the exception of the bicubic spline interpolant the coefficients +# are stored as the data points. The 2D B-spline coefficients are +# calculated using the routines II_SPLINE2D. MSIFIT checks that the +# dimensions of the data array are appropriate for the interpolant selected +# and allocates space for the coefficient array. +# Boundary extension is performed using boundary projection. + +procedure msifit (msi, datain, nxpix, nypix, len_datain) + +pointer msi # pointer to interpolant descriptor structure +real datain[len_datain,ARB] # data array +int nxpix # number of points in the x dimension +int nypix # number of points in the y dimension +int len_datain # row length of datain + +int i, j +pointer fptr, nptr, rptr +pointer tmp +pointer rptrf[FNROWS] +pointer rptrl[LNROWS] + +errchk calloc, mfree + +begin + # check the row length of datain + if (len_datain < nxpix) + call error (0, "MSIFIT: Row length of datain too small.") + + # check that the number of data points in x and y is + # appropriate for the interpolant type selected and + # allocate space for the coefficient array allowing + # sufficient storage for boundary extension + + switch (MSI_TYPE(msi)) { + + case II_BINEAREST: + + if (nxpix < 1 || nypix < 1) { + call error (0, "MSIFIT: Too few data points.") + return + } else { + MSI_NXCOEFF(msi) = nxpix + MSI_NYCOEFF(msi) = nypix + MSI_FSTPNT(msi) = 0 + if (MSI_COEFF(msi) != NULL) + call mfree (MSI_COEFF(msi), TY_REAL) + call malloc (MSI_COEFF(msi), nxpix * nypix, TY_REAL) + } + + case II_BILINEAR, II_BIDRIZZLE: + + if (nxpix < 2 || nypix < 2) { + call error (0, "MSIFIT: Too few data points.") + return + } else { + MSI_NXCOEFF(msi) = nxpix + 1 + MSI_NYCOEFF(msi) = nypix + 1 + MSI_FSTPNT(msi) = 0 + if (MSI_COEFF(msi) != NULL) + call mfree (MSI_COEFF(msi), TY_REAL) + call malloc (MSI_COEFF(msi), + MSI_NXCOEFF(msi) * MSI_NYCOEFF(msi), TY_REAL) + } + + case II_BIPOLY3: + + if (nxpix < 4 || nypix < 4) { + call error (0, "MSIFIT: Too few data points.") + return + } else { + MSI_NXCOEFF(msi) = nxpix + 3 + MSI_NYCOEFF(msi) = nypix + 3 + MSI_FSTPNT(msi) = MSI_NXCOEFF(msi) + 1 + if (MSI_COEFF(msi) != NULL) + call mfree (MSI_COEFF(msi), TY_REAL) + call malloc (MSI_COEFF(msi), + MSI_NXCOEFF(msi) * MSI_NYCOEFF(msi), TY_REAL) + } + + case II_BIPOLY5: + + if (nxpix < 6 || nypix < 6) { + call error (0, "MSIFIT: Too few data points.") + return + } else { + MSI_NXCOEFF(msi) = nxpix + 5 + MSI_NYCOEFF(msi) = nypix + 5 + MSI_FSTPNT(msi) = 2 * MSI_NXCOEFF(msi) + 2 + if (MSI_COEFF(msi) != NULL) + call mfree (MSI_COEFF(msi), TY_REAL) + call malloc (MSI_COEFF(msi), + MSI_NXCOEFF(msi) * MSI_NYCOEFF(msi), TY_REAL) + } + + case II_BISPLINE3: + + if (nxpix < 4 || nypix < 4) { + call error (0, "MSIFIT: Too few data points.") + return + } else { + MSI_NXCOEFF(msi) = nxpix + 3 + MSI_NYCOEFF(msi) = nypix + 3 + MSI_FSTPNT(msi) = MSI_NXCOEFF(msi) + 1 + if (MSI_COEFF(msi) != NULL) + call mfree (MSI_COEFF(msi), TY_REAL) + call calloc (MSI_COEFF(msi), + MSI_NXCOEFF(msi) * MSI_NYCOEFF(msi), TY_REAL) + } + + case II_BISINC, II_BILSINC: + + if (nxpix < 1 || nypix < 1) { + call error (0, "MSIFIT: Too few data points.") + return + } else { + MSI_NXCOEFF(msi) = nxpix + MSI_NYCOEFF(msi) = nypix + MSI_FSTPNT(msi) = 0 + if (MSI_COEFF(msi) != NULL) + call mfree (MSI_COEFF(msi), TY_REAL) + call calloc (MSI_COEFF(msi), nxpix * nypix, TY_REAL) + } + + } + + # index the coefficient pointer so that COEFF(fptr+1) points to the + # first data point in the coefficient array + fptr = MSI_COEFF(msi) - 1 + MSI_FSTPNT(msi) + + # load data into coefficient array + rptr = fptr + do j = 1, nypix { + call amovr (datain[1,j], COEFF(rptr+1), nxpix) + rptr = rptr + MSI_NXCOEFF(msi) + } + + # calculate the coefficients of the interpolant + # boundary extension is performed using boundary projection + + switch (MSI_TYPE(msi)) { + + case II_BINEAREST, II_BISINC, II_BILSINC: + + # no end conditions necessary, coefficients stored as data + + case II_BILINEAR, II_BIDRIZZLE: + + # extend the rows + rptr = fptr + nxpix + do j = 1, nypix { + COEFF(rptr+1) = 2. * COEFF(rptr) - COEFF(rptr-1) + rptr = rptr + MSI_NXCOEFF(msi) + } + + # define the pointers to the last, 2nd last and third last rows + rptrl[1] = MSI_COEFF(msi) + (MSI_NYCOEFF(msi) - 1) * + MSI_NXCOEFF(msi) + do i = 2, 3 + rptrl[i] = rptrl[i-1] - MSI_NXCOEFF(msi) + + # define the last row by extending the columns + call awsur (COEFF(rptrl[2]), COEFF(rptrl[3]), COEFF(rptrl[1]), + MSI_NXCOEFF(msi), 2., -1.) + + case II_BIPOLY3: + + # extend the rows + rptr = fptr + nptr = fptr + nxpix + do j = 1, nypix { + COEFF(rptr) = 2. * COEFF(rptr+1) - COEFF(rptr+2) + COEFF(nptr+1) = 2. * COEFF(nptr) - COEFF(nptr-1) + COEFF(nptr+2) = 2. * COEFF(nptr) - COEFF(nptr-2) + rptr = rptr + MSI_NXCOEFF(msi) + nptr = nptr + MSI_NXCOEFF(msi) + } + + # define pointers to first, second and third rows + rptrf[1] = MSI_COEFF(msi) + do i = 2, 3 + rptrf[i] = rptrf[i-1] + MSI_NXCOEFF(msi) + + # extend the columns, first row + call awsur (COEFF(rptrf[2]), COEFF(rptrf[3]), COEFF(rptrf[1]), + MSI_NXCOEFF(msi), 2., -1.) + + # define the pointers to the last to fifth last rows + rptrl[1] = MSI_COEFF(msi) + (MSI_NYCOEFF(msi) - 1) * + MSI_NXCOEFF(msi) + do i = 2, 5 + rptrl[i] = rptrl[i-1] - MSI_NXCOEFF(msi) + + # extend the columns, define 2nd last row + call awsur (COEFF(rptrl[3]), COEFF(rptrl[4]), COEFF(rptrl[2]), + MSI_NXCOEFF(msi), 2., -1.) + + # extend the columns, define last row + call awsur (COEFF(rptrl[3]), COEFF(rptrl[5]), COEFF(rptrl[1]), + MSI_NXCOEFF(msi), 2., -1.) + + case II_BIPOLY5: + + # extend the rows + rptr = fptr + nptr = fptr + nxpix + do j = 1, nypix { + COEFF(rptr-1) = 2. * COEFF(rptr+1) - COEFF(rptr+3) + COEFF(rptr) = 2. * COEFF(rptr+1) - COEFF(rptr+2) + COEFF(nptr+1) = 2. * COEFF(nptr) - COEFF(nptr-1) + COEFF(nptr+2) = 2. * COEFF(nptr) - COEFF(nptr-2) + COEFF(nptr+3) = 2. * COEFF(nptr) - COEFF(nptr-3) + rptr = rptr + MSI_NXCOEFF(msi) + nptr = nptr + MSI_NXCOEFF(msi) + } + + # define pointers to first five rows + rptrf[1] = MSI_COEFF(msi) + do i = 2, 5 + rptrf[i] = rptrf[i-1] + MSI_NXCOEFF(msi) + + # extend the columns, define first row + call awsur (COEFF(rptrf[3]), COEFF(rptrf[5]), COEFF(rptrf[1]), + MSI_NXCOEFF(msi), 2., -1.) + + # extend the columns, define second row + call awsur (COEFF(rptrf[3]), COEFF(rptrf[4]), COEFF(rptrf[2]), + MSI_NXCOEFF(msi), 2., -1.) + + # define pointers last seven rows + rptrl[1] = MSI_COEFF(msi) + (MSI_NYCOEFF(msi) - 1) * + MSI_NXCOEFF(msi) + do i = 2, 7 + rptrl[i] = rptrl[i-1] - MSI_NXCOEFF(msi) + + # extend the columns, last row + call awsur (COEFF(rptrl[4]), COEFF(rptrl[7]), COEFF(rptrl[1]), + MSI_NXCOEFF(msi), 2., -1.) + + # extend the columns, 2nd last row + call awsur (COEFF(rptrl[4]), COEFF(rptrl[6]), COEFF(rptrl[2]), + MSI_NXCOEFF(msi), 2., -1.) + + # extend the columns, 3rd last row + call awsur (COEFF(rptrl[4]), COEFF(rptrl[5]), COEFF(rptrl[3]), + MSI_NXCOEFF(msi), 2., -1.) + + case II_BISPLINE3: + + # allocate space for a temporary work arrays + call calloc (tmp, MSI_NXCOEFF(msi) * MSI_NYCOEFF(msi), TY_REAL) + + # the B-spline coefficients are calculated using the + # natural end conditions, end coefficents are set to + # zero + + # calculate the univariate B_spline coefficients in x + call ii_spline2d (COEFF(MSI_COEFF(msi)), TEMP(tmp), + nxpix, MSI_NYCOEFF(msi), MSI_NXCOEFF(msi), MSI_NYCOEFF(msi)) + + + # calculate the univariate B-spline coefficients in y to + # results of x interpolation + call ii_spline2d (TEMP(tmp), COEFF(MSI_COEFF(msi)), + nypix, MSI_NXCOEFF(msi), MSI_NYCOEFF(msi), MSI_NXCOEFF(msi)) + + # deallocate storage for temporary arrays + call mfree (tmp, TY_REAL) + } +end diff --git a/math/iminterp/msifree.x b/math/iminterp/msifree.x new file mode 100644 index 00000000..0740e2ee --- /dev/null +++ b/math/iminterp/msifree.x @@ -0,0 +1,21 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "im2interpdef.h" + +# MSIFREE -- Procedure to deallocate the interpolant descriptor structure. + +procedure msifree (msi) + +pointer msi # pointer to the interpolant descriptor structure +errchk mfree + +begin + # free coefficient array + if (MSI_COEFF(msi) != NULL) + call mfree (MSI_COEFF(msi), TY_REAL) + if (MSI_LTABLE(msi) != NULL) + call mfree (MSI_LTABLE(msi), TY_REAL) + + # free interpolant descriptor + call mfree (msi, TY_STRUCT) +end diff --git a/math/iminterp/msigeti.x b/math/iminterp/msigeti.x new file mode 100644 index 00000000..5ff14bfc --- /dev/null +++ b/math/iminterp/msigeti.x @@ -0,0 +1,24 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "im2interpdef.h" +include + +# MSIGETI -- Procedure to fetch an asi integer parameter + +int procedure msigeti (msi, param) + +pointer msi # interpolant descriptor +int param # parameter to be fetched + +begin + switch (param) { + case II_MSITYPE: + return (MSI_TYPE(msi)) + case II_MSINSAVE: + return (MSI_NXCOEFF(msi) * MSI_NYCOEFF(msi) + MSI_SAVECOEFF) + case II_MSINSINC: + return (MSI_NSINC(msi)) + default: + call error (0, "MSIGETI: Unknown MSI parameter.") + } +end diff --git a/math/iminterp/msigetr.x b/math/iminterp/msigetr.x new file mode 100644 index 00000000..7fd66597 --- /dev/null +++ b/math/iminterp/msigetr.x @@ -0,0 +1,20 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "im2interpdef.h" +include + +# MSIGETR -- Procedure to fetch an msi real parameter + +real procedure msigetr (msi, param) + +pointer msi # interpolant descriptor +int param # parameter to be fetched + +begin + switch (param) { + case II_MSIBADVAL: + return (MSI_BADVAL(msi)) + default: + call error (0, "MSIGETR: Unknown MSI parameter.") + } +end diff --git a/math/iminterp/msigrid.x b/math/iminterp/msigrid.x new file mode 100644 index 00000000..01d114a2 --- /dev/null +++ b/math/iminterp/msigrid.x @@ -0,0 +1,65 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "im2interpdef.h" +include + +# MSIGRID -- Procedure to evaluate the interpolant on a rectangular +# grid. The procedure assumes that 1 <= x <= nxpix and 1 <= y <= nypix. +# The x and y vectors must be ordered such that x[i] < x[i+1] and +# y[i] < y[i+1]. + +procedure msigrid (msi, x, y, zfit, nx, ny, len_zfit) + +pointer msi # pointer to interpolant descriptor structure +real x[ARB] # array of x values +real y[ARB] # array of y values +real zfit[len_zfit,ARB] # array of fitted values +int nx # number of x points +int ny # number of y points +int len_zfit # row length of zfit + +errchk ii_grnearest, ii_grlinear, ii_grpoly3, ii_grpoly5, ii_grspline3 +errchk ii_grsinc, ii_grlsinc, ii_grdirz + +begin + + switch (MSI_TYPE(msi)) { + + case II_BINEAREST: + call ii_grnearest (COEFF(MSI_COEFF(msi)), MSI_FSTPNT(msi), + MSI_NXCOEFF(msi), x, y, zfit, nx, ny, len_zfit) + + case II_BILINEAR: + call ii_grlinear (COEFF(MSI_COEFF(msi)), MSI_FSTPNT(msi), + MSI_NXCOEFF(msi), x, y, zfit, nx, ny, len_zfit) + + case II_BIPOLY3: + call ii_grpoly3 (COEFF(MSI_COEFF(msi)), MSI_FSTPNT(msi), + MSI_NXCOEFF(msi), x, y, zfit, nx, ny, len_zfit) + + case II_BIPOLY5: + call ii_grpoly5 (COEFF(MSI_COEFF(msi)), MSI_FSTPNT(msi), + MSI_NXCOEFF(msi), x, y, zfit, nx, ny, len_zfit) + + case II_BISPLINE3: + call ii_grspline3 (COEFF(MSI_COEFF(msi)), MSI_FSTPNT(msi), + MSI_NXCOEFF(msi), x, y, zfit, nx, ny, len_zfit) + + case II_BISINC: + call ii_grsinc (COEFF(MSI_COEFF(msi)), MSI_FSTPNT(msi), + MSI_NXCOEFF(msi), MSI_NYCOEFF(msi), x, y, zfit, nx, ny, len_zfit, + MSI_NSINC(msi), DX, DY) + + case II_BILSINC: + call ii_grlsinc (COEFF(MSI_COEFF(msi)), MSI_FSTPNT(msi), + MSI_NXCOEFF(msi), MSI_NYCOEFF(msi), x, y, zfit, nx, ny, len_zfit, + LTABLE(MSI_LTABLE(msi)), 2 * MSI_NSINC(msi) + 1, MSI_NXINCR(msi), + MSI_NYINCR(msi), DX, DY) + + case II_BIDRIZZLE: + call ii_grdriz (COEFF(MSI_COEFF(msi)), MSI_FSTPNT(msi), + MSI_NXCOEFF(msi), MSI_NYCOEFF(msi), x, y, zfit, nx, ny, + len_zfit, MSI_XPIXFRAC(msi), MSI_YPIXFRAC(msi), + MSI_BADVAL(msi)) + } +end diff --git a/math/iminterp/msigrl.x b/math/iminterp/msigrl.x new file mode 100644 index 00000000..7baeac34 --- /dev/null +++ b/math/iminterp/msigrl.x @@ -0,0 +1,238 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include +include "im2interpdef.h" +include + +# MSIGRL -- Procedure to integrate the 2D interpolant over a specified area. +# The x and y arrays are assumed to describe a polygon which is the domain over +# which the integration is to be performed. The x and y must describe a closed +# curve and npts must be >= 4 with the last vertex equal to the first vertex. +# The routine uses the technique of separation of variables. The restriction on +# the polygon is that horizontal lines have at most one segment in common with +# the domain of integration. Polygons which do not fit this restriction can be +# split into one or more polygons before calling msigrl and the results can +# then be summed. + +real procedure msigrl (msi, x, y, npts) + +pointer msi # pointer to the interpolant descriptor structure +real x[npts] # array of x values +real y[npts] # array of y values +int npts # number of points which describe the boundary + +int i, interp_type, nylmin, nylmax, offset +pointer x1lim, x2lim, xintegrl, ptr +real xmin, xmax, ymin, ymax, accum +real ii_1dinteg() + +begin + # set up 1D interpolant type + switch (MSI_TYPE(msi)) { + case II_BINEAREST: + interp_type = II_NEAREST + case II_BILINEAR: + interp_type = II_LINEAR + case II_BIDRIZZLE: + interp_type = II_DRIZZLE + case II_BIPOLY3: + interp_type = II_POLY3 + case II_BIPOLY5: + interp_type = II_POLY5 + case II_BISPLINE3: + interp_type = II_SPLINE3 + case II_BISINC: + interp_type = II_SINC + case II_BILSINC: + interp_type = II_LSINC + } + + # set up temporary storage for x limits and the x integrals + call calloc (x1lim, MSI_NYCOEFF(msi), TY_REAL) + call calloc (x2lim, MSI_NYCOEFF(msi), TY_REAL) + call calloc (xintegrl, MSI_NYCOEFF(msi), TY_REAL) + + # offset of first data point from edge of coefficient array + offset = mod (MSI_FSTPNT(msi), MSI_NXCOEFF(msi)) + + # convert the (x,y) points which describe the polygon into + # two arrays of x limits x1lim and x2lim and two y limits ymin and ymax + call ii_find_limits (x, y, npts, 0, 0, MSI_NYCOEFF(msi), + Memr[x1lim+offset], Memr[x2lim+offset], ymin, ymax, nylmin, nylmax) + nylmin = nylmin + offset + nylmax = nylmax + offset + + # integrate in x + ptr = MSI_COEFF(msi) + offset + (nylmin - 1) * MSI_NXCOEFF(msi) + do i = nylmin, nylmax { + xmin = min (Memr[x1lim+i-1], Memr[x2lim+i-1]) + xmax = max (Memr[x1lim+i-1], Memr[x2lim+i-1]) + Memr[xintegrl+i-1] = ii_1dinteg (COEFF(ptr), MSI_NXCOEFF(msi), + xmin, xmax, interp_type, MSI_NSINC(msi), DX, MSI_XPIXFRAC(msi)) + ptr = ptr + MSI_NXCOEFF(msi) + } + + # integrate in y + if (interp_type == II_SPLINE3) { + call amulkr (Memr[xintegrl], 6.0, Memr[xintegrl], MSI_NYCOEFF(msi)) + accum = ii_1dinteg (Memr[xintegrl+offset], MSI_NYCOEFF(msi), ymin, + ymax, II_NEAREST, MSI_NSINC(msi), DY, MSI_YPIXFRAC(msi)) + } else { + accum = ii_1dinteg (Memr[xintegrl+offset], MSI_NYCOEFF(msi), ymin, + ymax, II_NEAREST, MSI_NSINC(msi), DY, MSI_YPIXFRAC(msi)) + } + + # free space + call mfree (xintegrl, TY_REAL) + call mfree (x1lim, TY_REAL) + call mfree (x2lim, TY_REAL) + + return (accum) +end + + +# II_FIND_LIMITS -- Procedure to transform a set of (x,y)'s describing a +# polygon into a set of limits. + +procedure ii_find_limits (x, y, npts, xboff, xeoff, max_nylines, x1lim, x2lim, +ymin, ymax, nylmin, nylmax) + +real x[npts] # array of x values +real y[npts] # array of y values +int npts # number of data points +int xboff, xeoff # boundary extension limits +int max_nylines # max number of lines to integrate +real x1lim[ARB] # array of x1 limits +real x2lim[ARB] # array of x2 limits +real ymin # minimum y value for integration +real ymax # maximum y value for integration +int nylmin # minimum line number for x integration +int nylmax # maximum line number for x integration + +int i, ninter +pointer sp, xintr, yintr +real xmin, xmax, lx, ld +int ii_pyclip() + +begin + call smark (sp) + call salloc (xintr, npts, TY_REAL) + call salloc (yintr, npts, TY_REAL) + + # find x and y limits and their indicess + call alimr (x, npts, xmin, xmax) + call alimr (y, npts, ymin, ymax) + + # calculate the line limits for integration + nylmin = max (1, min (int (ymin + 0.5) - xboff, max_nylines)) + nylmax = min (max_nylines, max (1, int (ymax + 0.5) + xeoff)) + + # initialize + lx = xmax - xmin + + # calculate the limits + for (i = nylmin; i <= nylmax; i = i + 1) { + + if (ymin > i) + ld = min (i + 0.5, ymax) * lx + else if (ymax < i) + ld = max (i - 0.5, ymin) * lx + else + ld = i * lx + ninter = ii_pyclip (x, y, Memr[xintr], Memr[yintr], npts, lx, ld) + if (ninter <= 0) { + x1lim[i] = xmin + x2lim[i] = xmin + } else { + x1lim[i] = min (Memr[xintr], Memr[xintr+1]) + x2lim[i] = max (Memr[xintr], Memr[xintr+1]) + } + } + + call sfree (sp) +end + + +# II_YCLIP -- Procedure to determine the intersection points of a +# horizontal image line with an arbitrary polygon. + +int procedure ii_pyclip (xver, yver, xintr, yintr, nver, lx, ld) + +real xver[ARB] # x vertex coords +real yver[ARB] # y vertex coords +real xintr[ARB] # x intersection coords +real yintr[ARB] # y intersection coords +int nver # number of vertices +real lx, ld # equation of image line + +int i, nintr +real u1, u2, u1u2, dx, dy, dd, xa, ya, wa + +begin + nintr = 0 + u1 = - lx * yver[1] + ld + do i = 2, nver { + + u2 = - lx * yver[i] + ld + u1u2 = u1 * u2 + + # Test whether polygon line segment intersects image line or not. + if (u1u2 <= 0.0) { + + + # Compute the intersection coords. + if (u1 != 0.0 && u2 != 0.0) { + + dy = yver[i-1] - yver[i] + dx = xver[i-1] - xver[i] + dd = xver[i-1] * yver[i] - yver[i-1] * xver[i] + xa = (dx * ld - lx * dd) + ya = dy * ld + wa = dy * lx + nintr = nintr + 1 + xintr[nintr] = xa / wa + yintr[nintr] = ya / wa + + # Test for collinearity. + } else if (u1 == 0.0 && u2 == 0.0) { + + nintr = nintr + 1 + xintr[nintr] = xver[i-1] + yintr[nintr] = yver[i-1] + nintr = nintr + 1 + xintr[nintr] = xver[i] + yintr[nintr] = yver[i] + + } else if (u1 != 0.0) { + + if (i == 1) { + dy = (yver[2] - yver[1]) + dd = (yver[nver-1] - yver[1]) + } else if (i == nver) { + dy = (yver[2] - yver[nver]) + dd = dy * (yver[nver-1] - yver[nver]) + } else { + dy = (yver[i+1] - yver[i]) + dd = dy * (yver[i-1] - yver[i]) + } + + if (dy != 0.0) { + nintr = nintr + 1 + xintr[nintr] = xver[i] + yintr[nintr] = yver[i] + } + + if (dd > 0.0) { + nintr = nintr + 1 + xintr[nintr] = xver[i] + yintr[nintr] = yver[i] + } + + } + } + + u1 = u2 + } + + return (nintr) +end diff --git a/math/iminterp/msiinit.x b/math/iminterp/msiinit.x new file mode 100644 index 00000000..895470e4 --- /dev/null +++ b/math/iminterp/msiinit.x @@ -0,0 +1,69 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "im2interpdef.h" +include + +# MSIINIT -- Procedure to initialize the sewquential 2D image interpolation +# package. MSIINIT checks that the interpolant is one of the permitted +# types and allocates space for the interpolant descriptor structure. +# MSIINIT returns the pointer to the interpolant descriptor structure. + +procedure msiinit (msi, interp_type) + +pointer msi # pointer to the interpolant descriptor structure +int interp_type # interpolant type + +int nconv +errchk malloc + +begin + if (interp_type < 1 || interp_type > II_NTYPES2D) { + call error (0, "MSIINIT: Illegal interpolant.") + } else { + call calloc (msi, LEN_MSISTRUCT, TY_STRUCT) + MSI_TYPE(msi) = interp_type + switch (interp_type) { + case II_BILSINC: + MSI_NSINC(msi) = NSINC + MSI_NXINCR(msi) = NINCR + if (MSI_NXINCR(msi) > 1) + MSI_NXINCR(msi) = MSI_NXINCR(msi) + 1 + MSI_NYINCR(msi) = NINCR + if (MSI_NYINCR(msi) > 1) + MSI_NYINCR(msi) = MSI_NYINCR(msi) + 1 + MSI_XSHIFT(msi) = INDEFR + MSI_YSHIFT(msi) = INDEFR + nconv = 2 * MSI_NSINC(msi) + 1 + call calloc (MSI_LTABLE(msi), nconv * MSI_NXINCR(msi) * nconv * + MSI_NYINCR(msi), TY_REAL) + call ii_bisinctable (LTABLE(MSI_LTABLE(msi)), nconv, + MSI_NXINCR(msi), MSI_NYINCR(msi), MSI_XSHIFT(msi), + MSI_YSHIFT(msi)) + case II_BISINC: + MSI_NSINC(msi) = NSINC + MSI_NXINCR(msi) = 0 + MSI_NYINCR(msi) = 0 + MSI_XSHIFT(msi) = INDEFR + MSI_YSHIFT(msi) = INDEFR + MSI_LTABLE(msi) = NULL + case II_BIDRIZZLE: + MSI_NSINC(msi) = 0 + MSI_NXINCR(msi) = 0 + MSI_NYINCR(msi) = 0 + MSI_XSHIFT(msi) = INDEFR + MSI_YSHIFT(msi) = INDEFR + MSI_XPIXFRAC(msi) = PIXFRAC + MSI_YPIXFRAC(msi) = PIXFRAC + MSI_LTABLE(msi) = NULL + default: + MSI_NSINC(msi) = 0 + MSI_NXINCR(msi) = 0 + MSI_NYINCR(msi) = 0 + MSI_XSHIFT(msi) = INDEFR + MSI_YSHIFT(msi) = INDEFR + MSI_LTABLE(msi) = NULL + } + MSI_COEFF(msi) = NULL + MSI_BADVAL(msi) = BADVAL + } +end diff --git a/math/iminterp/msirestore.x b/math/iminterp/msirestore.x new file mode 100644 index 00000000..1a6b4c1c --- /dev/null +++ b/math/iminterp/msirestore.x @@ -0,0 +1,50 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "im2interpdef.h" +include + +# MSIRESTORE -- Procedure to restore the interpolant stored by MSISAVE +# for use by MSIEVAL, MSIVECTOR, MSIDER and MSIGRL. + +procedure msirestore (msi, interpolant) + +pointer msi # interpolant descriptor +real interpolant[ARB] # array containing the interpolant + +int interp_type, npix + +begin + interp_type = nint (MSI_SAVETYPE(interpolant)) + if (interp_type < 1 || interp_type > II_NTYPES) + call error (0, "MSIRESTORE: Unknown interpolant type.") + + # allocate the interpolant descriptor structure and restore + # interpolant parameters + call malloc (msi, LEN_MSISTRUCT, TY_STRUCT) + MSI_TYPE(msi) = interp_type + MSI_NSINC(msi) = nint (MSI_SAVENSINC(interpolant)) + MSI_NXINCR(msi) = nint (MSI_SAVENXINCR(interpolant)) + MSI_NYINCR(msi) = nint (MSI_SAVENYINCR(interpolant)) + MSI_XSHIFT(msi) = MSI_SAVEXSHIFT(interpolant) + MSI_YSHIFT(msi) = MSI_SAVEYSHIFT(interpolant) + MSI_XPIXFRAC(msi) = MSI_SAVEXPIXFRAC(interpolant) + MSI_YPIXFRAC(msi) = MSI_SAVEYPIXFRAC(interpolant) + MSI_NXCOEFF(msi) = nint (MSI_SAVENXCOEFF(interpolant)) + MSI_NYCOEFF(msi) = nint (MSI_SAVENYCOEFF(interpolant)) + MSI_FSTPNT(msi) = nint (MSI_SAVEFSTPNT(interpolant)) + MSI_BADVAL(msi) = MSI_SAVEBADVAL(interpolant) + + # allocate space for and restore coefficients + call malloc (MSI_COEFF(msi), MSI_NXCOEFF(msi) * MSI_NYCOEFF(msi), + TY_REAL) + call amovr (interpolant[1+MSI_SAVECOEFF], COEFF(MSI_COEFF(msi)), + MSI_NXCOEFF(msi) * MSI_NYCOEFF(msi)) + + # allocate space for and restore the look-up table + if (MSI_NXINCR(msi) > 0 && MSI_NYINCR(msi) > 0) { + npix = (2.0 * MSI_NSINC(msi) + 1) ** 2 * MSI_NXINCR(msi) * + MSI_NYINCR(msi) + call amovr (interpolant[1+MSI_SAVECOEFF+MSI_NXCOEFF(msi) * + MSI_NYCOEFF(msi)], LTABLE(MSI_LTABLE(msi)), npix) + } +end diff --git a/math/iminterp/msisave.x b/math/iminterp/msisave.x new file mode 100644 index 00000000..109e9698 --- /dev/null +++ b/math/iminterp/msisave.x @@ -0,0 +1,43 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "im2interpdef.h" +include + +# MSISAVE -- Procedure to save the interpolant for later use by MSIEVAL, +# MSIVECTOR, MSIDER and MSIGRL. + +procedure msisave (msi, interpolant) + +pointer msi # interpolant descriptor +real interpolant[ARB] # array containing the interpolant + +int npix + +begin + # save interpolant type, number of coefficients and position of + # first data point + MSI_SAVETYPE(interpolant) = MSI_TYPE(msi) + MSI_SAVENSINC(interpolant) = MSI_NSINC(msi) + MSI_SAVENXINCR(interpolant) = MSI_NXINCR(msi) + MSI_SAVENYINCR(interpolant) = MSI_NYINCR(msi) + MSI_SAVEXSHIFT(interpolant) = MSI_XSHIFT(msi) + MSI_SAVEYSHIFT(interpolant) = MSI_YSHIFT(msi) + MSI_SAVEXPIXFRAC(interpolant) = MSI_XPIXFRAC(msi) + MSI_SAVEYPIXFRAC(interpolant) = MSI_YPIXFRAC(msi) + MSI_SAVENXCOEFF(interpolant) = MSI_NXCOEFF(msi) + MSI_SAVENYCOEFF(interpolant) = MSI_NYCOEFF(msi) + MSI_SAVEFSTPNT(interpolant) = MSI_FSTPNT(msi) + MSI_SAVEBADVAL(interpolant) = MSI_BADVAL(msi) + + # save coefficients + call amovr (COEFF(MSI_COEFF(msi)), interpolant[MSI_SAVECOEFF+1], + MSI_NXCOEFF(msi) * MSI_NYCOEFF(msi)) + + # save look-up table + if (MSI_NXINCR(msi) > 0 && MSI_NYINCR(msi) > 0) { + npix = (2 * MSI_NSINC(msi) + 1) ** 2 * + MSI_NXINCR(msi) * MSI_NYINCR(msi) + call amovr (LTABLE(MSI_LTABLE(msi)), interpolant[MSI_SAVECOEFF+1+ + MSI_NXCOEFF(msi) * MSI_NYCOEFF(msi)], npix) + } +end diff --git a/math/iminterp/msisinit.x b/math/iminterp/msisinit.x new file mode 100644 index 00000000..6208331c --- /dev/null +++ b/math/iminterp/msisinit.x @@ -0,0 +1,91 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "im2interpdef.h" +include + +# MSISINIT -- Procedure to initialize the sewquential 2D image interpolation +# package. MSISINIT checks that the interpolant is one of the permitted +# types and allocates space for the interpolant descriptor structure. +# MSIINIT returns the pointer to the interpolant descriptor structure. + +procedure msisinit (msi, interp_type, nsinc, nxincr, nyincr, xshift, yshift, + badval) + +pointer msi # pointer to the interpolant descriptor structure +int interp_type # interpolant type +int nsinc # nsinc interpolation width +int nxincr, nyincr # number of look-up table elements in x and y +real xshift, yshift # the x and y shifts +real badval # undefined value for drizzle interpolant + +int nconv +errchk malloc + +begin + if (interp_type < 1 || interp_type > II_NTYPES2D) { + call error (0, "MSIINIT: Illegal interpolant.") + } else { + call calloc (msi, LEN_MSISTRUCT, TY_STRUCT) + MSI_TYPE(msi) = interp_type + switch (interp_type) { + + case II_BILSINC: + MSI_NSINC(msi) = (nsinc - 1) / 2 + MSI_NXINCR(msi) = nxincr + MSI_NYINCR(msi) = nyincr + if (nxincr > 1) { + MSI_NXINCR(msi) = MSI_NXINCR(msi) + 1 + MSI_XSHIFT(msi) = INDEFR + } else { + MSI_XSHIFT(msi) = xshift + } + if (nyincr > 1) { + MSI_YSHIFT(msi) = INDEFR + MSI_NYINCR(msi) = MSI_NYINCR(msi) + 1 + } else { + MSI_YSHIFT(msi) = yshift + } + MSI_XPIXFRAC(msi) = PIXFRAC + MSI_YPIXFRAC(msi) = PIXFRAC + nconv = 2 * MSI_NSINC(msi) + 1 + call calloc (MSI_LTABLE(msi), nconv * MSI_NXINCR(msi) * nconv * + MSI_NYINCR(msi), TY_REAL) + call ii_bisinctable (LTABLE(MSI_LTABLE(msi)), nconv, + MSI_NXINCR(msi), MSI_NYINCR(msi), MSI_XSHIFT(msi), + MSI_YSHIFT(msi)) + + case II_BISINC: + MSI_NSINC(msi) = (nsinc - 1) / 2 + MSI_NXINCR(msi) = 0 + MSI_NYINCR(msi) = 0 + MSI_XSHIFT(msi) = INDEFR + MSI_YSHIFT(msi) = INDEFR + MSI_XPIXFRAC(msi) = PIXFRAC + MSI_YPIXFRAC(msi) = PIXFRAC + MSI_LTABLE(msi) = NULL + + case II_BIDRIZZLE: + MSI_NSINC(msi) = 0 + MSI_NXINCR(msi) = 0 + MSI_NYINCR(msi) = 0 + MSI_XSHIFT(msi) = INDEFR + MSI_YSHIFT(msi) = INDEFR + MSI_XPIXFRAC(msi) = max (MIN_PIXFRAC, min (xshift, 1.0)) + MSI_YPIXFRAC(msi) = max (MIN_PIXFRAC, min (yshift, 1.0)) + MSI_LTABLE(msi) = NULL + + default: + MSI_NSINC(msi) = 0 + MSI_NXINCR(msi) = 0 + MSI_NYINCR(msi) = 0 + MSI_XSHIFT(msi) = INDEFR + MSI_YSHIFT(msi) = INDEFR + MSI_XPIXFRAC(msi) = PIXFRAC + MSI_YPIXFRAC(msi) = PIXFRAC + MSI_LTABLE(msi) = NULL + + } + MSI_COEFF(msi) = NULL + MSI_BADVAL(msi) = badval + } +end diff --git a/math/iminterp/msisqgrl.x b/math/iminterp/msisqgrl.x new file mode 100644 index 00000000..82a3122b --- /dev/null +++ b/math/iminterp/msisqgrl.x @@ -0,0 +1,96 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include +include "im2interpdef.h" +include + +# MSISQGRL -- Procedure to integrate the 2D interpolant over a rectangular +# region. + +real procedure msisqgrl (msi, x1, x2, y1, y2) + +pointer msi # pointer to the interpolant descriptor structure +real x1, x2 # x integration limits +real y1, y2 # y integration limits + +int i, interp_type, nylmin, nylmax, offset +pointer xintegrl, ptr +real xmin, xmax, ymin, ymax, accum +real ii_1dinteg() + +begin + # set up 1D interpolant type to match 2-D interpolant + switch (MSI_TYPE(msi)) { + case II_BINEAREST: + interp_type = II_NEAREST + case II_BILINEAR: + interp_type = II_LINEAR + case II_BIDRIZZLE: + interp_type = II_DRIZZLE + case II_BIPOLY3: + interp_type = II_POLY3 + case II_BIPOLY5: + interp_type = II_POLY5 + case II_BISPLINE3: + interp_type = II_SPLINE3 + case II_BISINC: + interp_type = II_SINC + case II_BILSINC: + interp_type = II_LSINC + } + + # set up temporary storage for x integrals + call calloc (xintegrl, MSI_NYCOEFF(msi), TY_REAL) + + # switch order of x integration at the end + xmin = x1 + xmax = x2 + if (x2 < x1) { + xmax = x2 + xmin = x1 + } + + # switch order of y integration at end + ymin = y1 + ymax = y2 + if (y2 < y1) { + ymax = y2 + ymin = y1 + } + + # find the appropriate range in y in the coeff array + offset = mod (MSI_FSTPNT(msi), MSI_NXCOEFF(msi)) + nylmin = max (1, min (MSI_NYCOEFF(msi), int (ymin + 0.5))) + nylmax = min (MSI_NYCOEFF(msi), max (1, int (ymax + 0.5))) + nylmin = nylmin + offset + nylmax = nylmax + offset + + # integrate in x + ptr = MSI_COEFF(msi) + offset + (nylmin - 1) * MSI_NXCOEFF(msi) + do i = nylmin, nylmax { + Memr[xintegrl+i-1] = ii_1dinteg (COEFF(ptr), MSI_NXCOEFF(msi), + xmin, xmax, interp_type, MSI_NSINC(msi), DX, MSI_XPIXFRAC(msi)) + if (x2 < x1) + Memr[xintegrl+i-1] = - Memr[xintegrl+i-1] + ptr = ptr + MSI_NXCOEFF(msi) + } + + # integrate in y + if (interp_type == II_SPLINE3) { + call amulkr (Memr[xintegrl], 6.0, Memr[xintegrl], + MSI_NYCOEFF(msi)) + accum = ii_1dinteg (Memr[xintegrl+offset], MSI_NYCOEFF(msi), + ymin, ymax, II_NEAREST, MSI_NSINC(msi), DY, MSI_YPIXFRAC(msi)) + } else + accum = ii_1dinteg (Memr[xintegrl+offset], MSI_NYCOEFF(msi), + ymin, ymax, II_NEAREST, MSI_NSINC(msi), DY, MSI_YPIXFRAC(msi)) + + # free space + call mfree (xintegrl, TY_REAL) + + # correct for integration error. + if (y2 < y1) + return (-accum) + else + return (accum) +end diff --git a/math/iminterp/msitype.x b/math/iminterp/msitype.x new file mode 100644 index 00000000..27bea8ac --- /dev/null +++ b/math/iminterp/msitype.x @@ -0,0 +1,97 @@ +include "im2interpdef.h" +include + +# MSITYPE -- Decode the interpolation string input by the user. + +procedure msitype (interpstr, interp_type, nsinc, nincr, shift) + +char interpstr[ARB] # the input interpolation string +int interp_type # the interpolation type +int nsinc # the sinc interpolation width +int nincr # the sinc interpolation lut resolution +real shift # the predefined shift / pixfrac + +int ip +pointer sp, str +int strdic(), strncmp(), ctoi(), ctor() + +begin + call smark (sp) + call salloc (str, SZ_FNAME, TY_CHAR) + interp_type = strdic (interpstr, Memc[str], SZ_FNAME, II_BFUNCTIONS) + + # Use the default interpolant parameters. + if (interp_type > 0) { + switch (interp_type) { + case II_BILSINC: + nsinc = 2 * NSINC + 1 + nincr = NINCR + shift = INDEFR + case II_BISINC: + nsinc = 2 * NSINC + 1 + nincr = 0 + shift = INDEFR + case II_BIDRIZZLE: + nsinc = 0 + nincr = 0 + shift = PIXFRAC + default: + nsinc = 0 + nincr = 0 + shift = INDEFR + } + + # Try to decode the look-up table sinc parameters. + } else if (strncmp (interpstr, "lsinc", 5) == 0) { + ip = 6 + interp_type = II_BILSINC + if (ctoi (interpstr, ip, nsinc) <= 0) { + nsinc = 2 * NSINC + 1 + nincr = NINCR + shift = INDEFR + } else { + if (interpstr[ip] == '[') + ip = ip + 1 + if (ctor (interpstr, ip, shift) <= 0) + shift = INDEFR + if (IS_INDEFR(shift) || interpstr[ip] != ']') { + nincr = NINCR + shift = INDEFR + } else if (shift >= -0.5 && shift < 0.5) { + nincr = 1 + } else { + nincr = nint (shift) + shift = INDEFR + } + } + + # Try to decode the sinc parameters. + } else if (strncmp (interpstr, "sinc", 4) == 0) { + ip = 5 + interp_type = II_BISINC + if (ctoi (interpstr, ip, nsinc) <= 0) + nsinc = 2 * NSINC + 1 + nincr = 0 + shift = INDEFR + } else if (strncmp (interpstr, "drizzle", 7) == 0) { + ip = 8 + if (interpstr[ip] == '[') + ip = ip + 1 + if (ctor (interpstr, ip, shift) <= 0) + shift = PIXFRAC + interp_type = II_DRIZZLE + nsinc = 0 + nincr = 0 + if (interpstr[ip] != ']') + shift = PIXFRAC + else if (shift < 0.0 || shift > 1.0) + shift = PIXFRAC + } else { + interp_type = 0 + nsinc = 0 + nincr = 0 + shift = INDEFR + } + + call sfree (sp) +end diff --git a/math/iminterp/msivector.x b/math/iminterp/msivector.x new file mode 100644 index 00000000..dcc0915d --- /dev/null +++ b/math/iminterp/msivector.x @@ -0,0 +1,65 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include "im2interpdef.h" +include + +# MSIVECTOR -- Procedure to evaluate the interpolant at an array of arbitrarily +# spaced points. The routines assume that 1 <= x <= nxpix and 1 <= y <= nypix. +# Checking for out of bounds pixels is the responsibility of the calling +# program. + +procedure msivector (msi, x, y, zfit, npts) + +pointer msi # pointer to the interpolant descriptor structure +real x[ARB] # array of x values +real y[ARB] # array of y values +real zfit[npts] # array of interpolated values +int npts # number of points to be evaluated + +begin + switch (MSI_TYPE(msi)) { + + case II_BINEAREST: + call ii_binearest (COEFF(MSI_COEFF(msi)), MSI_FSTPNT(msi), + MSI_NXCOEFF(msi), x, y, zfit, npts) + + case II_BILINEAR: + call ii_bilinear (COEFF(MSI_COEFF(msi)), MSI_FSTPNT(msi), + MSI_NXCOEFF(msi), x, y, zfit, npts) + + case II_BIPOLY3: + call ii_bipoly3 (COEFF(MSI_COEFF(msi)), MSI_FSTPNT(msi), + MSI_NXCOEFF(msi), x, y, zfit, npts) + + case II_BIPOLY5: + call ii_bipoly5 (COEFF(MSI_COEFF(msi)), MSI_FSTPNT(msi), + MSI_NXCOEFF(msi), x, y, zfit, npts) + + case II_BISPLINE3: + call ii_bispline3 (COEFF(MSI_COEFF(msi)), MSI_FSTPNT(msi), + MSI_NXCOEFF(msi), x, y, zfit, npts) + + case II_BISINC: + call ii_bisinc (COEFF(MSI_COEFF(msi)), MSI_FSTPNT(msi), + MSI_NXCOEFF(msi), MSI_NYCOEFF(msi), x, y, zfit, npts, + MSI_NSINC(msi), DX, DY) + + case II_BILSINC: + call ii_bilsinc (COEFF(MSI_COEFF(msi)), MSI_FSTPNT(msi), + MSI_NXCOEFF(msi), MSI_NYCOEFF(msi), x, y, zfit, npts, + LTABLE(MSI_LTABLE(msi)), 2 * MSI_NSINC(msi) + 1, + MSI_NXINCR(msi), MSI_NYINCR(msi), DX, DY) + + case II_BIDRIZZLE: + if (MSI_XPIXFRAC(msi) >= 1.0 && MSI_YPIXFRAC(msi) >= 1.0) + call ii_bidriz1 (COEFF(MSI_COEFF(msi)), MSI_FSTPNT(msi), + MSI_NXCOEFF(msi), x, y, zfit, npts, MSI_BADVAL(msi)) + #else if (MSI_XPIXFRAC(msi) <= 0.0 && MSI_YPIXFRAC(msi) <= 0.0) + #call ii_bidriz0 (COEFF(MSI_COEFF(msi)), MSI_FSTPNT(msi), + #MSI_NXCOEFF(msi), x, y, zfit, npts, MSI_BADVAL(msi)) + else + call ii_bidriz (COEFF(MSI_COEFF(msi)), MSI_FSTPNT(msi), + MSI_NXCOEFF(msi), x, y, zfit, npts, MSI_XPIXFRAC(msi), + MSI_YPIXFRAC(msi), MSI_BADVAL(msi)) + } +end -- cgit