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/rgunpackr.x | 37 +++++++++++++++++++++++++++++++++++++ 1 file changed, 37 insertions(+) create mode 100644 pkg/xtools/ranges/rgunpackr.x (limited to 'pkg/xtools/ranges/rgunpackr.x') diff --git a/pkg/xtools/ranges/rgunpackr.x b/pkg/xtools/ranges/rgunpackr.x new file mode 100644 index 00000000..6c96f5f8 --- /dev/null +++ b/pkg/xtools/ranges/rgunpackr.x @@ -0,0 +1,37 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include + +# RG_UNPACK -- Unpack a packed array. +# +# There is no checking on the size of the arrays. The points in the +# unpacked array which are not covered by the packed array are left unchanged. +# The packed and unpacked arrays should not be the same. + +procedure rg_unpackr (rg, packed, unpacked) + +pointer rg # Ranges +real packed[ARB] # Packed array +real unpacked[ARB] # Unpacked array + +int i, j, x1, x2, nx + +begin + if (rg == NULL) + call error (0, "Range descriptor undefined") + + j = 1 + do i = 1, RG_NRGS(rg) { + if (RG_X1(rg, i) < RG_X2(rg, i)) { + x1 = RG_X1(rg, i) + x2 = RG_X2(rg, i) + } else { + x1 = RG_X2(rg, i) + x2 = RG_X1(rg, i) + } + + nx = x2 - x1 + 1 + call amovr (packed[j], unpacked[x1], nx) + j = j + nx + } +end -- cgit