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 --- pkg/xtools/ranges/rgpackr.x | 37 +++++++++++++++++++++++++++++++++++++ 1 file changed, 37 insertions(+) create mode 100644 pkg/xtools/ranges/rgpackr.x (limited to 'pkg/xtools/ranges/rgpackr.x') diff --git a/pkg/xtools/ranges/rgpackr.x b/pkg/xtools/ranges/rgpackr.x new file mode 100644 index 00000000..e01307a3 --- /dev/null +++ b/pkg/xtools/ranges/rgpackr.x @@ -0,0 +1,37 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include + +# RG_PACK -- Pack input data to include only points in the ranges. +# +# The output array must be large enough to contain the desired points. +# If the ranges are merged then the input and output arrays may be the same. + +procedure rg_packr (rg, a, b) + +pointer rg # Ranges +real a[ARB] # Input array +real b[ARB] # Output array + +int i, j, k, n + +begin + # Error check the range pointer. + + if (rg == NULL) + call error (0, "Range pointer undefined") + + j = 0 + do i = 1, RG_NRGS(rg) { + if (RG_X1(rg, i) > RG_X2(rg, i)) { + do k = RG_X1(rg, i), RG_X2(rg, i), -1 { + j = j + 1 + b[j] = a[k] + } + } else { + n = RG_X2(rg, i) - RG_X1(rg, i) + 1 + call amovr (a[RG_X1(rg, i)], b[j + 1], n) + j = j + n + } + } +end -- cgit